r65513 - in /trunk/libnet-sip-perl: ./ debian/ debian/patches/ lib/Net/ lib/Net/SIP/ lib/Net/SIP/Endpoint/

ansgar at users.alioth.debian.org ansgar at users.alioth.debian.org
Sat Dec 4 11:16:06 UTC 2010


Author: ansgar
Date: Sat Dec  4 11:15:59 2010
New Revision: 65513

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=65513
Log:
* New upstream release.
* debian/copyright: Refer to "Debian systems" instead of "Debian GNU/Linux
  systems".
* debian/rules: Use "find -delete" instead of "find | xargs rm".
* Bump Standards-Version to 3.9.1.
* Add myself to Uploaders.

Modified:
    trunk/libnet-sip-perl/Changes
    trunk/libnet-sip-perl/META.yml
    trunk/libnet-sip-perl/debian/changelog
    trunk/libnet-sip-perl/debian/control
    trunk/libnet-sip-perl/debian/copyright
    trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch
    trunk/libnet-sip-perl/debian/patches/pod2man_item.patch
    trunk/libnet-sip-perl/debian/rules
    trunk/libnet-sip-perl/lib/Net/SIP.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod
    trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod
    trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod
    trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod
    trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Util.pm

Modified: trunk/libnet-sip-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/Changes?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/Changes (original)
+++ trunk/libnet-sip-perl/Changes Sat Dec  4 11:15:59 2010
@@ -1,5 +1,47 @@
 Revision history for Net::SIP
 
+0.60 2010-11-30
+- overwrite route header from record-route only for INVITE.
+  Thanks to vitspec[AT]gmail[DOT]com for reporting.
+0.59_11 2010-11-02
+- overwrite a given route header for any new request if there is
+  already a route information for the given context.
+  Thanks to vitspec[AT]gmail[DOT]com for reporting.
+0.59_10 2010-11-01
+- the route header in ACK must be set to the route it got by 
+  record-route from the response (if any), instead of using the
+  route from the INVITE.
+  Thanks to vitspec[AT]gmail[DOT]com for reporting the bug. 
+0.59_9 2010-09-09
+- bugfix rport handling by DetlefPilzecker[AT]web[DOT]de
+- clarify documentation of Net::SIP::Packet, e.g. that it die()s if
+  it cannot parse string as SIP packet
+0.59_8 2010-08-20
+- fixes to 0.59_7 from DetlefPilzecker[AT]web[DOT]de
+- added documentation for filter in Authorize
+0.59_7 2010-08-17
+- additional authorization based on idea of 
+  DetlefPilzecker[AT]web[DOT]de
+0.59_6 2010-08-09 
+- fix unitialized warning in Authorize if user neither in user2a1
+  nor in user2pass. 
+- dispatcher: add recieved + rport to via only for requests
+- Thanks again to DetlefPilzecker[AT]web[DOT]de
+0.59_5 2010-08-09 
+- fix Registrar to get the address for registration from 'To' header, 
+  not 'From' header. Thanks again to DetlefPilzecker[AT]web[DOT]de
+0.59_4 2010-08-08 
+- fix rport handling. Thanks again to DetlefPilzecker[AT]web[DOT]de
+0.59_3 2010-07-26
+- fix Via:..;received= handling - should by IP of sending host, not
+  of receiving leg. Moved setting it to dispatcher, and set target addr
+  from received in Statelessproxy instead of lookup for leg with this
+  addr.  Thanks again to DetlefPilzecker[AT]web[DOT]de
+- added rport support to Via header (RFC 3581)
+0.59_1 2010-07-22
+- Leg: Via..received= should only contain ip, not ip:port.
+  Thanks to DetlefPilzecker[AT]web[DOT]de for pointing out. Fix
+  Leg and StatelessProxy (where it expects to get port)
 0.59 2010-07-12
 - Dispatcher::cancel_delivery returns true if delivery was canceled
 - Blocker blocks all ACKS if all INVITE will be blocked, no mattter

Modified: trunk/libnet-sip-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/META.yml?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/META.yml (original)
+++ trunk/libnet-sip-perl/META.yml Sat Dec  4 11:15:59 2010
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Net-SIP
-version:            0.59
+version:            0.60
 abstract:           ~
 author:  []
 license:            unknown

Modified: trunk/libnet-sip-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/changelog?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/changelog (original)
+++ trunk/libnet-sip-perl/debian/changelog Sat Dec  4 11:15:59 2010
@@ -1,3 +1,14 @@
+libnet-sip-perl (0.60-1) unstable; urgency=low
+
+  * New upstream release.
+  * debian/copyright: Refer to "Debian systems" instead of "Debian GNU/Linux
+    systems".
+  * debian/rules: Use "find -delete" instead of "find | xargs rm".
+  * Bump Standards-Version to 3.9.1.
+  * Add myself to Uploaders.
+
+ -- Ansgar Burchardt <ansgar at debian.org>  Sat, 04 Dec 2010 12:14:59 +0100
+
 libnet-sip-perl (0.59-1) unstable; urgency=low
 
   * New upstream release.

Modified: trunk/libnet-sip-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/control?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/control (original)
+++ trunk/libnet-sip-perl/debian/control Sat Dec  4 11:15:59 2010
@@ -6,8 +6,9 @@
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
 Uploaders: Damyan Ivanov <dmn at debian.org>, Rene Mayorga <rmayorga at debian.org>,
  gregor herrmann <gregoa at debian.org>, Martín Ferrari <tincho at debian.org>,
- Jose Luis Rivas <ghostbar38 at gmail.com>, Jonathan Yu <jawnsy at cpan.org>
-Standards-Version: 3.9.0
+ Jose Luis Rivas <ghostbar38 at gmail.com>, Jonathan Yu <jawnsy at cpan.org>,
+ Ansgar Burchardt <ansgar at debian.org>
+Standards-Version: 3.9.1
 Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libnet-sip-perl/
 Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libnet-sip-perl/
 Homepage: http://search.cpan.org/dist/Net-SIP/

Modified: trunk/libnet-sip-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/copyright?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/copyright (original)
+++ trunk/libnet-sip-perl/debian/copyright Sat Dec  4 11:15:59 2010
@@ -20,8 +20,8 @@
  This program is free software; you can redistribute it and/or modify
  it under the terms of the Artistic License, which comes with Perl.
  .
- On Debian GNU/Linux systems, the complete text of the Artistic License
- can be found in `/usr/share/common-licenses/Artistic'
+ On Debian systems, the complete text of the Artistic License can be
+ found in `/usr/share/common-licenses/Artistic'.
 
 License: GPL-1+
  This program is free software; you can redistribute it and/or modify
@@ -29,5 +29,5 @@
  the Free Software Foundation; either version 1, or (at your option)
  any later version.
  .
- On Debian GNU/Linux systems, the complete text of the GNU General
- Public License can be found in `/usr/share/common-licenses/GPL-1'
+ On Debian systems, the complete text of version 1 of the GNU General
+ Public License can be found in `/usr/share/common-licenses/GPL-1'.

Modified: trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch (original)
+++ trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch Sat Dec  4 11:15:59 2010
@@ -5,8 +5,8 @@
 Reviewed-by: gregor herrmann <gregoa at debian.org>
 Last-Update: 2010-07-12
 
---- a/lib/Net/SIP/Endpoint.pod
-+++ b/lib/Net/SIP/Endpoint.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Endpoint.pod
++++ libnet-sip-perl/lib/Net/SIP/Endpoint.pod
 @@ -133,7 +133,7 @@
  
  =item from
@@ -16,8 +16,8 @@
  
  =item contact
  
---- a/lib/Net/SIP/Leg.pod
-+++ b/lib/Net/SIP/Leg.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Leg.pod
++++ libnet-sip-perl/lib/Net/SIP/Leg.pod
 @@ -111,7 +111,7 @@
  ADDR is a hostname which can be prefixed by the protocol ( e.g. C<udp:host> )
  and postfixed by the port ( C<host:port>, C<tcp:host:port>,... ).
@@ -27,8 +27,8 @@
  it can call the method with %SPEC instead.
  
  Right now it has now way to check if the leg can deliver to a specific
---- a/lib/Net/SIP/Request.pod
-+++ b/lib/Net/SIP/Request.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Request.pod
++++ libnet-sip-perl/lib/Net/SIP/Request.pod
 @@ -77,7 +77,7 @@
  
  Returns Net::SIP::Response packet for the received request C<$self> with
@@ -38,8 +38,8 @@
  If MSG is not given (e.g. argument is missing, second argument is \%HEADER
  already) a builtin message for the code will be used.
  
---- a/lib/Net/SIP/Simple.pod
-+++ b/lib/Net/SIP/Simple.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Simple.pod
++++ libnet-sip-perl/lib/Net/SIP/Simple.pod
 @@ -67,8 +67,8 @@
  \@List of legs or single leg. Leg can be an existing L<Net::SIP::Leg> (or derived)
  object, an L<IO::Handle> (existing socket), a hash reference which can be used
@@ -51,8 +51,8 @@
  
  Either B<legs> or B<outgoing_proxy> has to be provided, e.g. it needs at least one
  leg.
---- a/lib/Net/SIP/Simple/Call.pod
-+++ b/lib/Net/SIP/Simple/Call.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Simple/Call.pod
++++ libnet-sip-perl/lib/Net/SIP/Simple/Call.pod
 @@ -159,7 +159,7 @@
  
  =item ...

Modified: trunk/libnet-sip-perl/debian/patches/pod2man_item.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/patches/pod2man_item.patch?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/patches/pod2man_item.patch (original)
+++ trunk/libnet-sip-perl/debian/patches/pod2man_item.patch Sat Dec  4 11:15:59 2010
@@ -3,8 +3,8 @@
 Author: gregor herrmann <gregoa at debian.org>
 Last-Update: 2010-07-12
 
---- a/lib/Net/SIP/Debug.pod
-+++ b/lib/Net/SIP/Debug.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Debug.pod
++++ libnet-sip-perl/lib/Net/SIP/Debug.pod
 @@ -23,27 +23,27 @@
  
  =over 4

Modified: trunk/libnet-sip-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/rules?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/rules (original)
+++ trunk/libnet-sip-perl/debian/rules Sat Dec  4 11:15:59 2010
@@ -8,4 +8,4 @@
 
 override_dh_auto_install:
 	dh_auto_install
-	find $(TMP)/usr/share/perl5 -name "*.pod" | xargs rm
+	find $(TMP)/usr/share/perl5 -name "*.pod" -delete

Modified: trunk/libnet-sip-perl/lib/Net/SIP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP.pm Sat Dec  4 11:15:59 2010
@@ -4,7 +4,7 @@
 require 5.008;
 
 package Net::SIP;
-our $VERSION = '0.59';
+our $VERSION = '0.60';
 
 # this includes nearly everything else
 use Net::SIP::Simple ();

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm Sat Dec  4 11:15:59 2010
@@ -13,7 +13,7 @@
 use Net::SIP::Debug;
 use Net::SIP::Util ':all';
 use Digest::MD5 'md5_hex';
-use fields qw( realm opaque user2pass user2a1 i_am_proxy dispatcher );
+use fields qw( realm opaque user2pass user2a1 i_am_proxy dispatcher filter );
 
 ###########################################################################
 # creates new Authorize object
@@ -24,6 +24,19 @@
 #        password if given username
 #     dispatcher: Dispatcher object
 #     i_am_proxy: true if should send Proxy-Authenticate, not WWW-Authenticate
+#     filter: hashref with extra verification chain, see packages below.
+#      Usage:
+#      filter => {
+#       # filter chain for registration
+#       REGISTER => [
+#        # all of this three must succeed (user can regist himself)
+#        [ 'ToIsFrom','FromIsRealm','FromIsAuthUser' ],
+#        # or this must succeed
+#        \&call_back, # callback. If arrayref you MUST set [ \&call_back ]
+#       ]
+#       # filter chain for invites
+#       INVITE => 'FromIsRealm',
+#      }
 # Returns: $self
 ###########################################################################
 sub new {
@@ -38,6 +51,36 @@
 	$self->{user2a1} = $args{user2a1};
 	$self->{i_am_proxy} = $args{i_am_proxy};
 	$self->{dispatcher} = $args{dispatcher} || croak 'no dispatcher';
+
+	if ( my $f = $args{filter}) {
+		croak 'filter must be hashref' if ref($f) ne 'HASH';
+		my %filter;
+		while (my($method,$chain) = each %$f) {
+			$chain = [ $chain ] if ref($chain) ne 'ARRAY';
+			map { $_ = [$_] if ref($_) ne 'ARRAY' } @$chain;
+			# now we have:
+			# method => [[ cb00,cb01,cb02,..],[ cb10,cb11,cb12,..],...]
+			# where either the cb0* chain or the cb1* chain or the cbX* has to succeed
+			for my $or (@$chain) {
+				for (@$or) {
+					if (ref($_)) {
+						# assume callback
+					} else {
+						# must have authorize class with verify method
+						my $pkg = __PACKAGE__."::$_";
+						my $sub = UNIVERSAL::can($pkg,'verify') || do {
+							# load package
+							eval "require $pkg";
+							UNIVERSAL::can($pkg,'verify')
+						} or die "cannot find sub ${pkg}::verify";
+						$_ = $sub;
+					}
+				}
+			}
+			$filter{uc($method)} = $chain;
+		}
+		$self->{filter} = \%filter;
+	}
 	return $self;
 }
 
@@ -122,6 +165,8 @@
 			last if ! defined $pass;
 			$a1_hex = md5_hex(join( ':',$user,$realm,$pass ));
 		}
+
+		last if ! defined $a1_hex; # not in user2a1 || user2pass
 
 		# ACK just reuse the authorization from INVITE, so they should
 		# be checked against method INVITE
@@ -154,7 +199,21 @@
 			}
 
 			if ( $resp eq $want_response ) {
-				$authorized = 1;
+				if ($self->{filter} and my $or = $self->{filter}{$method}) {
+					for my $and (@$or) {
+						$authorized = 1;
+						for my $cb (@$and) {
+							if ( ! invoke_callback(
+								$cb,$packet,$leg,$addr,$user,$realm)) {
+								$authorized = 0;
+								last;
+							}
+						}
+						last if $authorized;
+					}
+				} else {
+					$authorized = 1;
+				}
 				last;
 			}
 		}
@@ -200,4 +259,62 @@
 	return $acode;
 }
 
+###########################################################################
+# additional verifications
+#  Net::SIP::Authorize::FromIsRealm - checks if the domain in 'From' is
+#   the same as the realm in 'Authorization'
+#  Net::SIP::Authorize::FromIsAuthUser - checks if the user in 'From' is
+#   the same as the username in 'Authorization'
+#  Net::SIP::Authorize::ToIsFrom - checks if 'To' and 'From' are equal
+#
+# Args each: ($packet,$leg,$addr,$auth_user,$auth_realm)
+#  $packet: Net::SIP::Request
+#  $leg: Net::SIP::Leg where request came in (and response gets send out)
+#  $addr: ip:port where request came from and response will be send
+#  $auth_user: username from 'Authorization'
+#  $auth_realm: realm from 'Authorization'
+# Returns: TRUE (1) | FALSE (0)
+###########################################################################
+
+package Net::SIP::Authorize::FromIsRealm;
+use Net::SIP::Util qw( sip_hdrval2parts sip_uri2parts );
+use Net::SIP::Debug;
+sub verify {
+	my ($packet,$leg,$addr,$auth_user,$auth_realm) = @_;
+	my $from = $packet->get_header('from');
+	($from) = sip_hdrval2parts( from => $from );
+	my ($domain) = sip_uri2parts($from);
+	return 1 if lc($domain) eq lc($auth_realm); # exact domain
+	return 1 if $domain =~m{\.\Q$auth_realm\E$}i; # subdomain
+	DEBUG( 10, "No Auth-success: From-domain is '$domain' and realm is '$auth_realm'" );
+	return 0;
+}
+
+package Net::SIP::Authorize::FromIsAuthUser;
+use Net::SIP::Util qw( sip_hdrval2parts sip_uri2parts );
+use Net::SIP::Debug;
+sub verify {
+	my ($packet,$leg,$addr,$auth_user,$auth_realm) = @_;
+	my $from = $packet->get_header('from');
+	($from) = sip_hdrval2parts( from => $from );
+	my (undef,$user) = sip_uri2parts($from);
+	return 1 if lc($user) eq lc($auth_user);
+	DEBUG( 10, "No Auth-success: From-user is '$user' and auth_user is '$auth_user'" );
+	return 0;
+}
+
+package Net::SIP::Authorize::ToIsFrom;
+use Net::SIP::Util qw( sip_hdrval2parts );
+use Net::SIP::Debug;
+sub verify {
+	my ($packet,$leg,$addr,$auth_user,$auth_realm) = @_;
+	my $from = $packet->get_header('from');
+	($from) = sip_hdrval2parts( from => $from );
+	my $to = $packet->get_header('to');
+	($to) = sip_hdrval2parts( to => $to );
+	return 1 if lc($from) eq lc($to);
+	DEBUG( 10, "No Auth-success: To is '$to' and From is '$from'" );
+	return 0;
+}
+
 1;

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod Sat Dec  4 11:15:59 2010
@@ -66,6 +66,61 @@
 (e.g. L<Net::SIP::Endpoint>, L<Net::SIP::Registrar>) which sends
 C<WWW-Authenticate>.
 
+=item filter
+
+Additional filter for authorization, e.g. if authorization based on
+username and passwort succeeded it might still fail because of these
+filters. Filter is a hash with the method as key.
+
+The value can be an additional authorization (in which case it
+must succeed), a list of authorizations (all of them must succeed),
+or a list with a list of authorizations (at least one of the inner
+lists must succeed).
+
+The additional authorization can be a name of a L<Net::SIP::Authorize>
+subclass (e.g. C<ToIsFrom> means C<Net::SIP::Authorize::ToIsFrom>)
+which has a C<verify> function or a C<[\&callback]>.
+
+The verify function or callback will be called with
+C<($packet,$leg,$addr,$auth_user,$auth_realm)> where C<$packet> is
+the request, C<$leg> the L<Net::SIP::Leg> object where the packet
+came in, C<$addr> the senders address, C<$auth_user> the
+username from the authorized user and C<$auth_realm> the realm
+which was used for authorization.
+Success for verification means that the function must return true.
+
+The following authorization subclasses are defined:
+
+=over 4
+
+=item FromIsRealm
+
+Succeeds if the senders domain is the realm or a subdomain of the realm.
+
+=item FromIsAuthUser
+
+Succeeds if the username of the sender equals the username used for
+authorization.
+
+=item ToIsFrom
+
+Succeeds if To header equals From header. This can be used to make sure, that a
+user can only call REGISTER for itself.
+
+=back
+
+Example:
+
+  filter => {
+    REGISTER => [
+      # all of these must succeed
+      [ 'ToIsFrom','FromIsRealm','FromIsAuthUser' ],
+      # or this
+      [ \&callback ],
+    ],
+    INVITE => 'FromIsRealm',
+  }
+
 =back
 
 =back

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod Sat Dec  4 11:15:59 2010
@@ -6,12 +6,12 @@
 =head1 SYNOPSIS
 
   my $block = Net::SIP::Blocker->new(
-      block => { 'SUBSCRIBE' => 405, '...' => ... },
-      dispatcher => $disp,
+	  block => { 'SUBSCRIBE' => 405, '...' => ... },
+	  dispatcher => $disp,
   );
 
   my $chain = Net::SIP::ReceiveChain->new(
-      [ $block, ... ]
+	  [ $block, ... ]
   );
 
 =head1 DESCRIPTION

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm Sat Dec  4 11:15:59 2010
@@ -187,8 +187,35 @@
 						return;
 					};
 
+					if ($packet->is_request) {
+						# add received and rport to top via
+						$packet->scan_header( via => [ sub {
+							my ($vref,$hdr) = @_;
+							return if $$vref++;
+							my ($d,$h) = sip_hdrval2parts(via => $hdr->{value});
+							# FIXME: not IPv6 save
+							my ($host,$port) = $d =~m{^\S+\s+(\S+?)(?::(\d+))?$};
+							my ($addr,$rport) = $from =~m{^(\S+)(?::(\d+))$};
+							my %nh;
+							if ( exists $h->{rport} and ! defined $h->{rport}) {
+								$nh{rport} = $rport;
+							}
+							if ( $host ne $addr or $nh{rport}) { 
+								# either hostname or different IP or required because
+								# rport was set
+								$nh{received} = $addr;
+							}
+							if (%nh) {
+								$hdr->{value} = sip_parts2hdrval('via',$d,{ %$h,%nh});
+								$hdr->set_modified;
+							}
+						}, \( my $cvia )]);
+					}
+
 					# handle received packet
 					$self->receive( $packet,$leg,$from );
+
+
 				};
 				if ($@) {
 					DEBUG(1,"dispatcher croaked: $@");

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm Sat Dec  4 11:15:59 2010
@@ -54,7 +54,7 @@
 #   @args: either single \%args (hash-ref) or %args (hash) with at least
 #     values for from and to
 #     callid,cseq will be generated if not given
-#     routes will default to [] and usually set from record-route header
+#     routes will default to undef and usually set from record-route header
 #     in response packets
 # Returns: $self
 ############################################################################
@@ -65,7 +65,6 @@
 	%$self = %args;
 	$self->{callid} ||= md5_hex( time(), rand(2**32) );
 	$self->{cseq} ||= 0;
-	$self->{route} ||= [];
 	$self->{_transactions} = [];
 	$self->{_cseq_incoming} = 0;
 
@@ -159,6 +158,7 @@
 		# already a request object
 		$request = $method;
 		$method = $request->method;
+
 	} else {
 
 		# increase cseq unless its explicitly specified
@@ -187,15 +187,17 @@
 				from => $from,
 				to => $to,
 				$self->{contact} ? ( contact => $self->{contact} ):(),
-				route => $self->{route},
 				cseq => "$cseq $method",
 				'call-id' => $self->{callid},
 				'max-forwards' => 70,
-				%args
+				%args,
 			},
 			$body
-		)
-	}
+		);
+	}
+
+	# overwrite any route header in request if we already learned a route
+	$request->set_header( route => $self->{route} ) if $self->{route};
 
 	# create new transaction
 	my %trans = (
@@ -417,7 +419,7 @@
 	} elsif ( $code == 305 ) {
 		# 21.3.4 305 use proxy
 		# set proxy as the first route and insert request again
-		my $route = $self->{route};
+		my $route = $self->{route} ||= [];
 		unshift @$route,$response->get_header( 'contact' );
 		( my $r = $tr->{request} )->set_header( route => $route );
 		$r->set_cseq( ++$self->{cseq} );
@@ -489,7 +491,9 @@
 	my @arg = ($endpoint,$self);
 
 	# extract route information for future requests to the UAC (re-invites)
-	if ( my @route = $request->get_header( 'record-route' )) {
+	# only for INVITE (rfc3261,12.1.1)
+	if ( $method eq 'INVITE' and 
+		my @route = $request->get_header( 'record-route' )) {
 		$self->{route} = \@route;
 	}
 

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm Sat Dec  4 11:15:59 2010
@@ -129,19 +129,6 @@
 			return [ undef,'max-forwards reached 0, dropping' ];
 		}
 		$packet->set_header( 'max-forwards',$maxf );
-
-		# add received to top via
-		my $via;
-		$packet->scan_header( via => [ sub {
-			my ($vref,$hdr) = @_;
-			if ( !$$vref ) {
-				# XXXXXXX maybe check that no received header existed before
-				$$vref = $hdr->{value}.=
-					";received=$self->{addr}:$self->{port}";
-				$hdr->set_modified;
-			}
-		}, \$via ]);
-
 
 		# check if last hop was strict router
 		# remove myself from route

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod Sat Dec  4 11:15:59 2010
@@ -6,7 +6,8 @@
 =head1 SYNOPSIS
 
   use Net::SIP::Packet;
-  my $pkt = Net::SIP::Packet->new( $sip_string );
+  my $pkt = eval { Net::SIP::Packet->new( $sip_string ) }
+    or die "invalid SIP packet";
   $pkt->get_header( 'call-id' ) || die "no call-id";
   $pkt->set_header( via => \@via );
   print $pkt->as_string;
@@ -67,6 +68,7 @@
 
 Interprets STRING as a SIP request or response and creates L<Net::SIP::Request>
 or L<Net::SIP::Response> object accordingly.
+Will die() if it cannot parse the string as a SIP packet.
 
 =item new_from_parts ( CODE|METHOD, TEXT|URI, \%HEADER|\@HEADER, [ BODY ] )
 
@@ -88,7 +90,7 @@
 The order of the fields in the resulting SIP packet will be the same as in
 the array.
 
-The BODY is optinal and can be given either as a string or as an reference to an
+The BODY is optional and can be given either as a string or as an reference to an
 object which has a method B<as_string>, like L<Net::SIP::SDP>. If the BODY is an
 object which has a method B<content_type> it will set the C<content-type> header
 of the SIP object based on the result of C<< BODY->content_type >> unless a

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm Sat Dec  4 11:15:59 2010
@@ -83,21 +83,21 @@
 		return; # propagate to next in chain
 	}
 
-	my $from = $packet->get_header( 'from' ) or do {
-		DEBUG( 1,"no from in register request. DROP" );
+	my $to = $packet->get_header( 'to' ) or do {
+		DEBUG( 1,"no to in register request. DROP" );
 		return;
 	};
 
 	# what address will be registered
-	($from) = sip_hdrval2parts( from => $from );
-	if ( my ($domain,$user,$proto) = sip_uri2parts( $from ) ) {
+	($to) = sip_hdrval2parts( to => $to );
+	if ( my ($domain,$user,$proto) = sip_uri2parts( $to ) ) {
 		# normalize if possible
-		$from = "$proto:$user\@$domain";
+		$to = "$proto:$user\@$domain";
 	}
 
 	# check if domain is allowed
 	if ( my $rd = $self->{domains} ) {
-		my ($domain) = $from =~m{\@([\w\-\.]+)};
+		my ($domain) = $to =~m{\@([\w\-\.]+)};
 		if ( ! first { $domain =~m{\.?\Q$_\E$}i || $_ eq '*' } @$rd ) {
 			DEBUG( 1, "$domain matches none of my own domains. DROP" );
 			return;
@@ -135,7 +135,7 @@
 		$curr{$c_addr} = $expire;
 	}
 
-	$self->{store}{ $from } = \%curr;
+	$self->{store}{ $to } = \%curr;
 
 	# expire now!
 	$self->expire();
@@ -179,8 +179,8 @@
 	my $now = $loop->looptime;
 
 	my $store = $self->{store};
-	my (@drop_from,$next_exp);
-	while ( my ($from,$contact) = each %$store ) {
+	my (@drop_addr,$next_exp);
+	while ( my ($addr,$contact) = each %$store ) {
 		my @drop_where;
 		while ( my ($where,$expire) = each %$contact ) {
 			if ( $expire<$now ) {
@@ -191,10 +191,10 @@
 		}
 		if ( @drop_where ) {
 			delete @{$contact}{ @drop_where };
-			push @drop_from,$from if !%$contact;
-		}
-	}
-	delete @{$store}{ @drop_from } if @drop_from;
+			push @drop_addr,$addr if !%$contact;
+		}
+	}
+	delete @{$store}{ @drop_addr } if @drop_addr;
 
 	# add timer for next expire
 	if ( $next_exp ) {

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod Sat Dec  4 11:15:59 2010
@@ -17,6 +17,10 @@
 This package implements a simple SIP registrar. In the current implementation
 registry information are only kept in memory, e.g. they are not preserved over
 restarts.
+
+The implementation itself does not checking if the UAC is authorized to 
+register the given address. This can be done with using an appropriate 
+Authorize Module inside a ReceiveChain in front of the registrar.
 
 =head1 CONSTRUCTOR
 

Modified: trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm Sat Dec  4 11:15:59 2010
@@ -159,10 +159,11 @@
 	my ($addr,$port) = $first =~m{([\w\-\.]+)(?::(\d+))?\s*$};
 	$port ||= 5060; # FIXME default for sip, not sips!
 	$addr = $param->{maddr} if $param->{maddr};
+	$addr = $param->{received} if $param->{received}; # where it came from
+	$port = $param->{rport} if $param->{rport}; # where it came from
 	@{ $entry->{dst_addr}} = ( "$addr:$port" );
 	DEBUG( 50,"get dst_addr from via header: $first -> $addr:$port" );
 
-	$entry->{via_received} = $param->{received};
 	if ( $addr !~m{^[0-9\.]+$} ) {
 		$self->{dispatcher}->dns_host2ip(
 			$addr,
@@ -176,8 +177,6 @@
 ###########################################################################
 # Called from _forward_response directly or indirectly after resolving
 # hostname of destination.
-# If received parameter was in Via header it will try to find the leg
-# based on it.
 # Calls __forward_packet_final at the end to deliver packet
 ###########################################################################
 sub __forward_response_1 {
@@ -191,29 +190,6 @@
 		}
 		# replace host part in dst_addr with ip
 		$entry->{dst_addr}[0] =~s{^(udp:|tcp:)?([^:]+)}{$1$ip};
-	}
-
-	if ( my $received = $entry->{via_received} ) {
-		# FIXME: we assume that the received entry is done by us
-		# and that we only put IP addresses inside
-		my ($addr,$port) = split( ':',$received,2 );
-		my @received_legs = $self->{dispatcher}->get_legs(
-			addr => $addr, port => $port );
-		my $dst_addr = $entry->{dst_addr};
-		my @legs;
-		foreach my $addr (@$dst_addr) {
-			push @legs, grep { $_->can_deliver_to( $addr ) } @received_legs;
-		}
-
-		if ( !@legs ) {
-			# FIXME: should we really drop packet if we don't have the specified leg?
-			# or should we use any leg which could deliver to $dst_addr
-			DEBUG( 10,"cannot find leg for $received which can deliver to $dst_addr" );
-			return;
-		}
-
-		@{ $entry->{outgoing_leg} } = @legs;
-		DEBUG( 50,"getting leg from received=$received" );
 	}
 
 	__forward_packet_final( $self,$entry );

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Util.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Util.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Util.pm Sat Dec  4 11:15:59 2010
@@ -130,8 +130,9 @@
 	}
 
 	my $val = $data; # FIXME: need to escape $data?
-	while ( my ($k,$v) = each %$param ) {
+	for my $k ( sort keys %$param ) {
 		$val .= $delim.$k;
+		my $v = $param->{$k};
 		if ( defined $v ) {
 			# escape special chars
 			$v =~s{([%\r\n\t"[:^print:]])}{ sprintf "%%%02x",ord($1) }sg;




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