1package Net::SAP; 2 3################ 4# 5# SAP: Session Announcement Protocol (RFC2974) 6# 7# Nicholas J Humfrey 8# njh@cpan.org 9# 10 11use strict; 12use Carp; 13 14use Net::SAP::Packet; 15use Socket qw/ unpack_sockaddr_in /; 16use Socket6 qw/ inet_ntop inet_pton unpack_sockaddr_in6 /; 17use IO::Socket::Multicast6; 18 19use vars qw/$VERSION/; 20our $VERSION="0.10"; 21 22 23 24# User friendly names for multicast groups 25my %groups = ( 26 'ipv4'=> '224.2.127.254', 27 'ipv4-local'=> '239.255.255.255', 28 'ipv4-org'=> '239.195.255.255', 29 'ipv4-global'=> '224.2.127.254', 30 31 'ipv6-node'=> 'FF01::2:7FFE', 32 'ipv6-link'=> 'FF02::2:7FFE', 33 'ipv6-site'=> 'FF05::2:7FFE', 34 'ipv6-org'=> 'FF08::2:7FFE', 35 'ipv6-global'=> 'FF0E::2:7FFE', 36); 37 38my $SAP_PORT = 9875; 39 40 41 42sub new { 43 my $class = shift; 44 my ($group) = @_; 45 46 47 # Work out the multicast group to use 48 croak "Missing group parameter" unless defined $group; 49 if (exists $groups{$group}) { 50 $group = $groups{$group}; 51 } 52 53 54 # Store parameters 55 my $self = { 56 'group' => $group, 57 'port' => $SAP_PORT 58 }; 59 60 61 # Create Multicast Socket 62 $self->{'socket'} = new IO::Socket::Multicast6( 63 LocalAddr => $self->{'group'}, 64 LocalPort => $SAP_PORT ) 65 || return undef; 66 67 # Set the TTL for transmitted packets 68 $self->{'socket'}->mcast_ttl( 127 ); 69 70 # Join the multicast group 71 $self->{'socket'}->mcast_add( $self->{'group'} ) || 72 die "Failed to join multicast group: $!"; 73 74 75 bless $self, $class; 76 return $self; 77} 78 79 80# 81# Returns the multicast group the socket is bound to 82# 83sub group { 84 my $self = shift; 85 return $self->{'group'}; 86} 87 88 89# 90# Sets the TTL for packets sent 91# 92sub ttl { 93 my $self = shift; 94 my ($ttl) = @_; 95 96 # Set new TTL if specified 97 if (defined $ttl) { 98 return undef if ($ttl<0 or $ttl>127); 99 $self->{'socket'}->mcast_ttl($ttl); 100 } 101 102 return $self->{'socket'}->mcast_ttl(); 103} 104 105 106# 107# Blocks until a valid SAP packet is received 108# 109sub receive { 110 my $self = shift; 111 my $sap_packet = undef; 112 113 114 while(!defined $sap_packet) { 115 116 # Receive a packet 117 my $data = undef; 118 my $from = $self->{'socket'}->recv( $data, 1500 ); 119 die "Failed to receive packet: $!" unless (defined $from); 120 next unless (defined $data and length($data)); 121 122 # Create new packet object from the data we received 123 $sap_packet = new Net::SAP::Packet( $data ); 124 next unless (defined $sap_packet); 125 126 # Correct the origin on Stupid packets ! 127 if ($sap_packet->origin_address() eq '' or 128 $sap_packet->origin_address() eq '0.0.0.0' or 129 $sap_packet->origin_address() eq '1.2.3.4' ) 130 { 131 if (sockaddr_family($from)==AF_INET) { 132 my ($from_port, $from_ip) = unpack_sockaddr_in( $from ); 133 $from = inet_ntop( AF_INET, $from_ip ); 134 } elsif (sockaddr_family($from)==AF_INET6) { 135 my ($from_port, $from_ip) = unpack_sockaddr_in6( $from ); 136 $from = inet_ntop( AF_INET6, $from_ip ); 137 } else { 138 warn "Unknown address family (family=".sockaddr_family($from).")\n"; 139 } 140 $sap_packet->origin_address( $from ); 141 } 142 } 143 144 return $sap_packet; 145} 146 147 148sub send { 149 my $self = shift; 150 my ($packet) = @_; 151 152 croak "Missing data to send." unless defined $packet; 153 154 155 # If it isn't a packet object, turn it into one 156 if (ref $packet eq 'Net::SDP') { 157 my $data = $packet->generate(); 158 $packet = new Net::SAP::Packet(); 159 $packet->payload( $data ); 160 } 161 elsif (ref $packet ne 'Net::SAP::Packet') { 162 my $data = $packet; 163 $packet = new Net::SAP::Packet(); 164 $packet->payload( $data ); 165 } 166 167 168 # Assemble and send the packet 169 my $data = $packet->generate(); 170 if (!defined $data) { 171 warn "Failed to create binary packet."; 172 return -1; 173 } elsif (length $data > 1024) { 174 warn "Packet is more than 1024 bytes, not sending."; 175 return -1; 176 } else { 177 return $self->{'socket'}->mcast_send( $data, $self->{'group'}, $self->{'port'} ); 178 } 179} 180 181 182sub close { 183 my $self=shift; 184 185 # Close the multicast socket 186 $self->{'socket'}->close(); 187 undef $self->{'socket'}; 188 189} 190 191 192sub DESTROY { 193 my $self=shift; 194 195 if (exists $self->{'socket'} and defined $self->{'socket'}) { 196 $self->close(); 197 } 198} 199 200 2011; 202 203__END__ 204 205=pod 206 207=head1 NAME 208 209Net::SAP - Session Announcement Protocol (rfc2974) 210 211=head1 SYNOPSIS 212 213 use Net::SAP; 214 215 my $sap = Net::SAP->new( 'ipv6-global' ); 216 217 my $packet = $sap->receive(); 218 219 $sap->close(); 220 221 222=head1 DESCRIPTION 223 224Net::SAP allows receiving and sending of SAP (RFC2974) 225multicast packets over IPv4 and IPv6. 226 227=head2 METHODS 228 229=over 4 230 231=item $sap = Net::SAP->new( $group ) 232 233The new() method is the constructor for the C<Net::SAP> class. 234You must specify the SAP multicast group you want to join: 235 236 ipv4-local 237 ipv4-org 238 ipv4-global 239 ipv6-node 240 ipv6-link 241 ipv6-site 242 ipv6-org 243 ipv6-global 244 245Alternatively you may pass the address of the multicast group 246directly. When the C<Net::SAP> object is created, it joins the 247multicast group, ready to start receiving or sending packets. 248 249 250=item $packet = $sap->receive() 251 252This method blocks until a valid SAP packet has been received. 253The packet is parsed, decompressed and returned as a 254C<Net::SAP::Packet> object. 255 256 257=item $sap->send( $data ) 258 259This method sends out SAP packet on the multicast group that the 260C<Net::SAP> object to bound to. The $data parameter can either be 261a C<Net::SAP::Packet> object, a C<Net::SDP> object or raw SDP data. 262 263Passing a C<Net::SAP::Packet> object gives the greatest control 264over what is sent. Otherwise default values will be used. 265 266If no origin_address has been set, then it is set to the IP address 267of the first network interface. 268 269Packets greater than 1024 bytes will not be sent. This method 270returns 0 if packet was sent successfully. 271 272 273=item $group = $sap->group() 274 275Returns the address of the multicast group that the socket is bound to. 276 277 278=item $ttl = $sap->ttl( [$value] ) 279 280Gets or sets the TTL of outgoing packets. 281 282=item $sap->close() 283 284Leave the SAP multicast group and close the socket. 285 286=back 287 288=head1 TODO 289 290=over 291 292=item add automatic detection of IPv6 origin address 293 294=item add method of choosing the network interface to use for multicast 295 296=item Packet decryption and validation 297 298=back 299 300=head1 SEE ALSO 301 302L<Net::SAP::Packet>, L<Net::SDP>, perl(1) 303 304L<http://www.ietf.org/rfc/rfc2974.txt> 305 306=head1 BUGS 307 308Please report any bugs or feature requests to 309C<bug-net-sap@rt.cpan.org>, or through the web interface at 310L<http://rt.cpan.org>. I will be notified, and then you will automatically 311be notified of progress on your bug as I make changes. 312 313=head1 AUTHOR 314 315Nicholas J Humfrey, njh@cpan.org 316 317=head1 COPYRIGHT AND LICENSE 318 319Copyright (C) 2004-2006 University of Southampton 320 321This library is free software; you can redistribute it and/or modify 322it under the same terms as Perl itself, either Perl version 5.005 or, 323at your option, any later version of Perl 5 you may have available. 324 325=cut 326