r51882 - in /branches/upstream/libnet-sip-perl/current: Changes MANIFEST META.yml lib/Net/SIP.pm lib/Net/SIP/Authorize.pm lib/Net/SIP/Redirect.pm lib/Net/SIP/Redirect.pod lib/Net/SIP/Registrar.pod lib/Net/SIP/Simple.pm

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Sat Jan 30 17:43:46 UTC 2010


Author: jawnsy-guest
Date: Sat Jan 30 17:43:41 2010
New Revision: 51882

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=51882
Log:
[svn-upgrade] Integrating new upstream version, libnet-sip-perl (0.55)

Added:
    branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pm
    branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pod
Modified:
    branches/upstream/libnet-sip-perl/current/Changes
    branches/upstream/libnet-sip-perl/current/MANIFEST
    branches/upstream/libnet-sip-perl/current/META.yml
    branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
    branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pm
    branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod
    branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pm

Modified: branches/upstream/libnet-sip-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/Changes?rev=51882&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/Changes (original)
+++ branches/upstream/libnet-sip-perl/current/Changes Sat Jan 30 17:43:41 2010
@@ -1,4 +1,13 @@
 Revision history for Net::SIP
+
+0.55 2010-01-27
+- Net::SIP::Redirect provides functionlity to redirect INVITES using
+  information from registrar. Sample program
+  samples/register_and_redirect.pl
+- fixes for Net::SIP::Authorize if no pass is known for user (or user
+  is not known).
+- fixes for Net::SIP::Authorize for ACK an CANCEL (no challenge 
+  possible, credentials should be compared against INVITE method)
 
 0.54 2009-09-04
 - bugfix in Net::SIP::Packet::new_from_parts when the header was already

Modified: branches/upstream/libnet-sip-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/MANIFEST?rev=51882&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-sip-perl/current/MANIFEST Sat Jan 30 17:43:41 2010
@@ -32,6 +32,8 @@
 lib/Net/SIP/Endpoint.pod
 lib/Net/SIP/Endpoint/Context.pm
 lib/Net/SIP/Endpoint/Context.pod
+lib/Net/SIP/Redirect.pm
+lib/Net/SIP/Redirect.pod
 lib/Net/SIP/Registrar.pm
 lib/Net/SIP/Registrar.pod
 lib/Net/SIP/StatelessProxy.pm

Modified: branches/upstream/libnet-sip-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/META.yml?rev=51882&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/META.yml (original)
+++ branches/upstream/libnet-sip-perl/current/META.yml Sat Jan 30 17:43:41 2010
@@ -1,13 +1,21 @@
 --- #YAML:1.0
-name:                Net-SIP
-version:             0.54
-abstract:            ~
-license:             ~
-author:              ~
-generated_by:        ExtUtils::MakeMaker version 6.42
-distribution_type:   module
-requires:     
-    Net::DNS:                      0.56
+name:               Net-SIP
+version:            0.55
+abstract:           ~
+author:  []
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
+requires:
+    Net::DNS:  0.56
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.54
 meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
-    version: 1.3
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm?rev=51882&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm Sat Jan 30 17:43:41 2010
@@ -4,7 +4,7 @@
 require 5.008;
 
 package Net::SIP;
-our $VERSION = '0.54';
+our $VERSION = '0.55';
 
 # this includes nearly everything else
 use Net::SIP::Simple ();
@@ -30,6 +30,7 @@
 		Net::SIP::Simple::RTP
 		Net::SIP::Dispatcher
 		Net::SIP::Dispatcher::Eventloop
+		Net::SIP::Redirect
 		Net::SIP::Registrar
 		Net::SIP::StatelessProxy
 		Net::SIP::ReceiveChain

Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pm?rev=51882&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pm Sat Jan 30 17:43:41 2010
@@ -58,6 +58,7 @@
 		DEBUG( 100,"pass thru response" );
 		return;
 	}
+	my $method = $packet->method;
 
 	# check authorization on request
 	my ($rq_key,$rs_key,$acode) = $self->{i_am_proxy}
@@ -100,9 +101,14 @@
 			next;
 		};
 
+		# ACK|CANCEL just reuse the authorization from INVITE, so they should
+		# be checked against method INVITE
+		my $a2 = join( ':',
+			( $method eq 'ACK' || $method eq 'CANCEL' ) ? 'INVITE' : $method,
+			$uri );
+
 		# we support with and w/o qop	
 		# get a1_hex from either user2a1 or user2pass
-		my $a2 = join( ':',$packet->method,$uri );
 		my $a1_hex;
 		if ( ref($user2a1)) {
 			if ( ref($user2a1) eq 'HASH' ) {
@@ -118,6 +124,8 @@
 			} else {
 				$pass = invoke_callback( $user2pass,$user );
 			}
+			# if wrong credentials ask again for authorization
+			last if ! defined $pass; 
 			$a1_hex = md5_hex(join( ':',$user,$realm,$pass ));
 		} 
 
@@ -155,6 +163,17 @@
 		return;
 	}
 
+	# CANCEL or ACK cannot be prompted for authorization, so
+	# they should provide the right data already
+	return $acode if $method eq 'CANCEL'; # unauthorized CANCEL
+	if ( $method eq 'ACK' ) {
+		# in case the ACK just acks that UAC received response
+		# we accept it w/o authorization
+		# but if it contains a (SDP) body we better need authorization
+		return $acode if ($packet->as_parts)[3];
+		return; # no body
+	}
+
 	# not authorized yet, ask to authenticate
 	# keep it simple RFC2069 style
 	my $digest = qq[Digest algorithm=MD5, realm="$realm",].

Added: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pm?rev=51882&op=file
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pm (added)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pm Sat Jan 30 17:43:41 2010
@@ -1,0 +1,52 @@
+###########################################################################
+# package Net::SIP::Redirect
+# uses Registrar to redirect incoming calls based on the information 
+# provided by the registrar
+###########################################################################
+
+use strict;
+use warnings;
+
+package Net::SIP::Redirect;
+use fields qw(dispatcher registrar);
+use Net::SIP::Debug;
+use Net::SIP::Util ':all';
+
+sub new {
+	my ($class,%args) = @_;
+	my $self = fields::new($class);
+	%$self = %args;
+	$self->{dispatcher} or croak( "no dispatcher given" );
+	$self->{registrar} or croak( "no registrar given" );
+	return $self;
+}
+
+sub receive {
+	my Net::SIP::Redirect $self = shift;
+	my ($packet,$leg,$addr) = @_;
+
+	# accept only INVITEs
+	$packet->is_request or return;
+	my $method = $packet->method;
+	if ( $method eq 'ACK' ) {
+		# if I got an ACK cancel delivery of response to INVITE
+		 $self->{dispatcher}->cancel_delivery( $packet->tid );
+		 return -1; # don't process in next part of chain
+	} elsif ( $method ne 'INVITE' ) {
+		return; # don't process myself
+	}
+		
+	my $key = (sip_uri2parts($packet->uri))[3];
+	my $resp;
+	if ( my @contacts = $self->{registrar}->query($key)) {
+		$resp = $packet->create_response('302','Moved Temporarily');
+		$resp->add_header( contact => $_ ) for(@contacts);
+	} else {
+		$resp = $packet->create_response('404','Not found');
+	}
+	$self->{dispatcher}->deliver( $resp, 
+		leg => $leg, dst_addr => $addr );
+	return $resp->code;
+}
+
+1;

Added: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pod?rev=51882&op=file
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pod (added)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Redirect.pod Sat Jan 30 17:43:41 2010
@@ -1,0 +1,62 @@
+
+=head1 NAME
+
+Net::SIP::Redirect - Send redirect to INVITEs based on lookup at a registrar
+
+=head1 SYNOPSIS
+
+  my $reg = Net::SIP::Registrar->new(...);
+  my $redir = Net::SIP::Redirect(
+	dispatcher => $dispatcher,
+	registrar => $reg,
+  );
+
+=head1 DESCRIPTION
+
+This package implements a simple redirection of INVITEs using the information
+provided by a registrar. 
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( %ARGS )
+
+This creates a new redirect object, %ARGS can have the following keys:
+
+=over 8
+
+=item dispatcher
+
+L<Net::SIP::Dispatcher> object manging the registar. Mandatory.
+
+=item registrar
+
+Registrar object. This is an object like a L<Net::SIP::Registrar>, which 
+has a C<query(address)> method which returns a list of contacts.
+
+=back
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item receive ( PACKET,LEG,FROM )
+
+PACKET is the incoming packet,
+LEG is the L<Net::SIP::Leg> where the packet arrived and FROM
+is the C<< "ip:port" >> of the sender. Responses will be send
+back to the sender through the same leg.
+
+Called from the managing L<Net::SIP::Dispatcher> object if a new
+packet arrives. Will return C<()> and ignore the packet if it's
+not an INVITE or ACK request.
+
+For INVITEs it will query the registrar and return either 
+C<< 302 Moved Temporarily >> with the list of contacts or
+C<< 404 Not found >> if the address is not registered.
+
+
+=back

Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod?rev=51882&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod Sat Jan 30 17:43:41 2010
@@ -5,7 +5,7 @@
 
 =head1 SYNOPSIS
 
-  my $reg = Net::SIP::Registry->new(
+  my $reg = Net::SIP::Registrar->new(
 	dispatcher => $dispatcher,
 	min_expires => 10,
 	max_expires => 60,

Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pm?rev=51882&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pm Sat Jan 30 17:43:41 2010
@@ -32,6 +32,7 @@
 use Net::SIP::Dispatcher;
 use Net::SIP::Dispatcher::Eventloop;
 use Net::SIP::Endpoint;
+use Net::SIP::Redirect;
 use Net::SIP::Registrar;
 use Net::SIP::StatelessProxy;
 use Net::SIP::Authorize;




More information about the Pkg-perl-cvs-commits mailing list