File Coverage

blib/lib/Net/SAP.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Net::SAP;

################
#
# SAP: Session Announcement Protocol (RFC2974)
#
# Nicholas J Humfrey
# [e-mail]
#

use strict;
use Carp;

use Net::SAP::Packet;
use Socket qw/ unpack_sockaddr_in /;
use Socket6 qw/ inet_ntop inet_pton unpack_sockaddr_in6 /;
use IO::Socket::Multicast6;

use vars qw/$VERSION/;
our $VERSION="0.10";



# User friendly names for multicast groups
my %groups = (
	'ipv4'=>		'224.2.127.254',
	'ipv4-local'=>	'239.255.255.255',
	'ipv4-org'=>	'239.195.255.255',
	'ipv4-global'=>	'224.2.127.254',

	'ipv6-node'=>	'FF01::2:7FFE',
	'ipv6-link'=>	'FF02::2:7FFE',
	'ipv6-site'=>	'FF05::2:7FFE',
	'ipv6-org'=>	'FF08::2:7FFE',
	'ipv6-global'=>	'FF0E::2:7FFE',
);

my $SAP_PORT = 9875;



sub new {
    my $class = shift;
    my ($group) = @_;


	# Work out the multicast group to use
    croak "Missing group parameter" unless defined $group;
    if (exists $groups{$group}) {
    	$group = $groups{$group};
    }


	# Store parameters
    my $self = {
    	'group'	=> $group,
    	'port'	=> $SAP_PORT
    };


    # Create Multicast Socket
	$self->{'socket'} = new IO::Socket::Multicast6(
			LocalAddr => $self->{'group'},
			LocalPort => $SAP_PORT )
	|| return undef;

	# Set the TTL for transmitted packets
	$self->{'socket'}->mcast_ttl( 127 );

	# Join the multicast group
	$self->{'socket'}->mcast_add( $self->{'group'} ) ||
	die "Failed to join multicast group: $!";


    bless $self, $class;
	return $self;
}


#
# Returns the multicast group the socket is bound to
#
sub group {
	my $self = shift;
	return $self->{'group'};
}


#
# Sets the TTL for packets sent
#
sub ttl {
	my $self = shift;
	my ($ttl) = @_;

	# Set new TTL if specified
	if (defined $ttl) {
		return undef if ($ttl<0 or $ttl>127);
		$self->{'socket'}->mcast_ttl($ttl);
	}

	return $self->{'socket'}->mcast_ttl();
}


#
# Blocks until a valid SAP packet is received
#
sub receive {
	my $self = shift;
	my $sap_packet = undef;


	while(!defined $sap_packet) {

		# Receive a packet
		my $data = undef;
		my $from = $self->{'socket'}->recv( $data, 1500 );
		die "Failed to receive packet: $!" unless (defined $from);
		next unless (defined $data and length($data));

		# Create new packet object from the data we received
		$sap_packet = new Net::SAP::Packet( $data );
		next unless (defined $sap_packet);

		# Correct the origin on Stupid packets !
		if ($sap_packet->origin_address() eq '' or
		    $sap_packet->origin_address() eq '0.0.0.0' or
			$sap_packet->origin_address() eq '1.2.3.4' )
		{
			if (sockaddr_family($from)==AF_INET) {
				my ($from_port, $from_ip) = unpack_sockaddr_in( $from );
				$from = inet_ntop( AF_INET, $from_ip );
			} elsif (sockaddr_family($from)==AF_INET6) {
				my ($from_port, $from_ip) = unpack_sockaddr_in6( $from );
				$from = inet_ntop( AF_INET6, $from_ip );
			} else {
				warn "Unknown address family (family=".sockaddr_family($from).")\n";
			}
			$sap_packet->origin_address( $from );
		}
	}

	return $sap_packet;
}


sub send {
	my $self = shift;
	my ($packet) = @_;

	croak "Missing data to send." unless defined $packet;


	# If it isn't a packet object, turn it into one
	if (ref $packet eq 'Net::SDP') {
		my $data = $packet->generate();
		$packet = new Net::SAP::Packet();
		$packet->payload( $data );
	}
	elsif (ref $packet ne 'Net::SAP::Packet') {
		my $data = $packet;
		$packet = new Net::SAP::Packet();
		$packet->payload( $data );
	}


	# Assemble and send the packet
	my $data = $packet->generate();
	if (!defined $data) {
		warn "Failed to create binary packet.";
		return -1;
	} elsif (length $data > 1024) {
		warn "Packet is more than 1024 bytes, not sending.";
		return -1;
	} else {
		return $self->{'socket'}->mcast_send( $data, $self->{'group'}, $self->{'port'} );
	}
}


sub close {
	my $self=shift;

	# Close the multicast socket
	$self->{'socket'}->close();
	undef $self->{'socket'};

}


sub DESTROY {
    my $self=shift;

    if (exists $self->{'socket'} and defined $self->{'socket'}) {
    	$self->close();
    }
}


1;

__END__