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