r12093 - in /trunk/libnet-sip-perl: ./ debian/ lib/Net/ lib/Net/SIP/ lib/Net/SIP/Simple/ samples/ t/

rmayorga-guest at users.alioth.debian.org rmayorga-guest at users.alioth.debian.org
Sun Jan 6 02:49:45 UTC 2008


Author: rmayorga-guest
Date: Sun Jan  6 02:49:45 2008
New Revision: 12093

URL: http://svn.debian.org/wsvn/?sc=1&rev=12093
Log:
* New upstream release
* debian/rules
  + use dh_listpackages instead of harcode the name of the package
  + check for /usr/lib/perl5 exist before try to delete it

Modified:
    trunk/libnet-sip-perl/Changes
    trunk/libnet-sip-perl/META.yml
    trunk/libnet-sip-perl/README
    trunk/libnet-sip-perl/THANKS
    trunk/libnet-sip-perl/debian/changelog
    trunk/libnet-sip-perl/debian/control
    trunk/libnet-sip-perl/debian/rules
    trunk/libnet-sip-perl/lib/Net/SIP.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Request.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm
    trunk/libnet-sip-perl/lib/Net/SIP/Simple.pod
    trunk/libnet-sip-perl/lib/Net/SIP/Simple/Call.pm
    trunk/libnet-sip-perl/samples/invite_and_recv.pl
    trunk/libnet-sip-perl/t/03_forward_stateless.t

Modified: trunk/libnet-sip-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/Changes?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/Changes (original)
+++ trunk/libnet-sip-perl/Changes Sun Jan  6 02:49:45 2008
@@ -1,4 +1,14 @@
 Revision history for Net::SIP
+
+0.41
+   - give 'contact' header to Net::SIP::Simple which is then used for
+     invite and register
+   - more checks of data when parsing SIP header, more knowledge about 
+     keys, where the values cannot be comma-seperated
+     (http://rt.cpan.org/Public/Bug/Display.html?id=31236)
+   - fix wrong call of ok() in t/03_forward_stateless
+   - fix http://rt.cpan.org/Public/Bug/Display.html?id=31284
+     (Net::SIP::Request::set_uri did not update string representation)
 
 0.40
   - Net::SIP::Simple::RTP - when sending data from file set the timestamp

Modified: trunk/libnet-sip-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/META.yml?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/META.yml (original)
+++ trunk/libnet-sip-perl/META.yml Sun Jan  6 02:49:45 2008
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Net-SIP
-version:      0.40
+version:      0.41
 version_from: lib/Net/SIP.pm
 installdirs:  site
 requires:

Modified: trunk/libnet-sip-perl/README
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/README?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/README (original)
+++ trunk/libnet-sip-perl/README Sun Jan  6 02:49:45 2008
@@ -14,9 +14,9 @@
 either integrate it in your own event handling or you can use 
 the simple event handling which is included.
 
-It was tested on Linux (Ubuntu 6.10, 7.04), MacOSX 10.3+10.4,
+It was tested on Linux (Ubuntu 6.10,7.04,7.10), MacOSX 10.3+10.4,
 OpenBSD3.9+4.1 with various perl versions starting with 
-perl5.8.7, including 5.9.5.
+perl5.8.7, including 5.10
 
 Sample Code was tested with Snom 300 Phones, Asterisk 1.2,
 Fritz!Box and KPhone.

Modified: trunk/libnet-sip-perl/THANKS
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/THANKS?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/THANKS (original)
+++ trunk/libnet-sip-perl/THANKS Sun Jan  6 02:49:45 2008
@@ -1,9 +1,10 @@
 Thanks to GeNUA mbh www.genua.de to let me work on this code and release
 it to the public.
 
-Thanks for bugreports and fixes from:
+Thanks for bugreports, fixes, testing and other feedback from:
 <mtve1927[AT]gmail[DOT]com>
 cpan:POLETTIX
 <karme[AT]berlios[DOT]de>
 <t-cpan.org[AT]tobias[DOT]org>
 <franz[AT]rzk[DOT]com>
+otherwiseguy <tlwilsonii [...] yahoo.com>

Modified: trunk/libnet-sip-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/debian/changelog?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/changelog (original)
+++ trunk/libnet-sip-perl/debian/changelog Sun Jan  6 02:49:45 2008
@@ -1,3 +1,12 @@
+libnet-sip-perl (0.41-1) unstable; urgency=low
+
+  * New upstream release
+  * debian/rules
+    + use dh_listpackages instead of harcode the name of the package
+    + check for /usr/lib/perl5 exist before try to delete it
+
+ -- Rene Mayorga <rmayorga at debian.org.sv>  Sat, 05 Jan 2008 19:35:57 -0600
+
 libnet-sip-perl (0.40-1) unstable; urgency=low
 
   * New upstream release

Modified: trunk/libnet-sip-perl/debian/control
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/debian/control?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/control (original)
+++ trunk/libnet-sip-perl/debian/control Sun Jan  6 02:49:45 2008
@@ -13,7 +13,7 @@
 Homepage: http://search.cpan.org/dist/Net-SIP/
 
 
-Package: libnet-sip-perl
+Package: libnet-sip-perlzo
 Architecture: all
 Depends: ${perl:Depends}, ${misc:Depends}, libnet-dns-perl
 Description: SIP handler Perl module

Modified: trunk/libnet-sip-perl/debian/rules
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/debian/rules?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/rules (original)
+++ trunk/libnet-sip-perl/debian/rules Sun Jan  6 02:49:45 2008
@@ -7,8 +7,8 @@
 	PERL = /usr/bin/perl
 endif
 
-TMP=$(CURDIR)/debian/libnet-sip-perl
-
+PACKAGE = $(shell dh_listpackages)
+TMP     = $(CURDIR)/debian/$(PACKAGE)
 
 build: build-stamp
 build-stamp: 
@@ -30,7 +30,9 @@
 	dh_testroot
 	dh_clean -k
 	$(MAKE) install_vendor PREFIX=$(TMP)/usr
-	rmdir --ignore-fail-on-non-empty --parents $(TMP)/usr/lib/perl5
+	[ ! -d $(TMP)/usr/lib/perl5 ] || \
+	     rmdir --ignore-fail-on-non-empty --parents --verbose \
+	         $(TMP)/usr/lib/perl5
 	touch $@
 
 binary-arch:

Modified: trunk/libnet-sip-perl/lib/Net/SIP.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/lib/Net/SIP.pm?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP.pm Sun Jan  6 02:49:45 2008
@@ -4,7 +4,7 @@
 require 5.008;
 
 package Net::SIP;
-our $VERSION = '0.40';
+our $VERSION = '0.41';
 
 # this includes nearly everything else
 use Net::SIP::Simple ();

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Packet.pm Sun Jan  6 02:49:45 2008
@@ -494,86 +494,133 @@
 	return @{$self}{qw(code text header body)} if $self->{code};
 }
 
-sub _string2parts {
-	my $string = shift;
-	my %result = ( as_string => $string );
-
-	# otherwise parse request
-	my ($header,$body) = split( m{\r?\n\r?\n}, $string,2 );
-	my @header = split( m{\r?\n}, $header );
-
-	if ( $header[0] =~m{^SIP/2.0\s+(\d+)\s+(\S.*?)\s*$} ) {
-		# Response, e.g. SIP/2.0 407 Authorization required
-		$result{code} = $1;
-		$result{text} = $2;
-	} elsif ( $header[0] =~m{^(\w+)\s+(\S.*?)\s+SIP/2\.0\s*$} ) {
-		# Request, e.g. INVITE <sip:bla at fasel> SIP/2.0
-		$result{code} = $1;
-		$result{text} = $2;
-	} else {
-		die "bad request: starts with '$header[0]'";
-	}
-	shift(@header);
-
-	$result{body} = $body;
-
-	my @hdr;
-	my @lines;
-	while (@header) {
-		my ($k,$v) = $header[0] =~m{^([^\s:]+)\s*:\s*(.*)}
-			or die "bad header line $header[0]";
-		my $line = shift(@header);
-		while ( @header && $header[0] =~m{^\s+(.*)} ) {
-			# continuation line
-			$v .= "\n$1";
-			$line .= shift(@header);
-		}
-		my $nk = _normalize_hdrkey($k);
-
-		my @v;
-		if ( $nk eq 'www-authenticate'
-			|| $nk eq 'proxy-authenticate'
-			|| $nk eq 'authorization'
-			|| $nk eq 'proxy-authorization' ) {
-			# don't split on ','
-			@v = $v;
+{
+	my $word_rx = qr{[\w\-\.!%\*+`'~()<>:"/?{}\x1c\x1b\x1d]+};
+	my $callid_rx = qr{^$word_rx(?:\@$word_rx)?$};
+	my %key2parser = (
+
+		# FIXME: More of these should be more strict to filter out invalid values
+		# for now they are only given here to distinguish them from the keys, which
+		# can be given multiple times either on different lines or on the same delimited
+		# by comma
+
+		'www-authenticate' => \&_hdrkey_parse_keep,
+		'authorization' => \&_hdrkey_parse_keep,
+		'proxy-authenticate' => \&_hdrkey_parse_keep,
+		'proxy-authorization' => \&_hdrkey_parse_keep,
+		'date' => \&_hdrkey_parse_keep,
+		'content-disposition' => \&_hdrkey_parse_keep,
+		'content-type' => \&_hdrkey_parse_keep,
+		'mime-version' => \&_hdrkey_parse_keep,
+		'organization' => \&_hdrkey_parse_keep,
+		'priority' => \&_hdrkey_parse_keep,
+		'reply-to' => \&_hdrkey_parse_keep,
+		'retry-after' => \&_hdrkey_parse_keep,
+		'server' => \&_hdrkey_parse_keep,
+		'to' => \&_hdrkey_parse_keep,
+		'user-agent' => \&_hdrkey_parse_keep,
+
+		'content-length' => \&_hdrkey_parse_num,
+		'expires' => \&_hdrkey_parse_num,
+		'max-forwards' => \&_hdrkey_parse_num,
+		'min-expires' => \&_hdrkey_parse_num,
+
+		'call-id' => sub { 
+			$_[0] =~ $callid_rx or die "invalid callid, should be 'word [@ word]'";
+			return $_[0];
+		},
+		'cseq' => sub { 
+			$_[0] =~ m{^\d+\s+\w+\s*$} or die "invalid cseq, should be 'number method'";
+			return $_[0];
+		},
+	);
+
+	sub _hdrkey_parse_keep { return $_[0] };
+	sub _hdrkey_parse_num {
+		my ($v,$k) = @_;
+		$v =~m{^(\d+)\s*$} || die "invalid $k, should be number";
+		return $1;
+	};
+
+	sub _hdrkey_parse_comma_seperated {
+		my ($v,$k) = @_;
+		my @v = ( '' );
+		my $quoted = 0;
+		# split on komma (but not if quoted)
+		while (1) {
+			if ( $v =~m{\G(.*?)([\\",])}gc ) {
+				if ( $2 eq "\\" ) {
+					$v[-1].=$1.$2.substr( $v,pos($v),1 );
+					pos($v)++;
+				} elsif ( $2 eq '"' ) {
+					$v[-1].=$1.$2;
+					$quoted = !$quoted;
+				} elsif ( $2 eq ',' ) {
+					# next item if not quoted
+					( $v[-1].=$1 ) =~s{\s+$}{}; # strip trailing space
+					push @v,'' if !$quoted;
+					$v =~m{\G\s+}gc; # skip space after ','
+				}
+			} else {
+				# add rest to last from @v
+				$v[-1].= substr($v,pos($v)||0 );
+				last;
+			}
+		}
+		return @v;
+	}
+
+	sub _string2parts {
+		my $string = shift;
+		my %result = ( as_string => $string );
+
+		# otherwise parse request
+		my ($header,$body) = split( m{\r?\n\r?\n}, $string,2 );
+		my @header = split( m{\r?\n}, $header );
+
+		if ( $header[0] =~m{^SIP/2.0\s+(\d+)\s+(\S.*?)\s*$} ) {
+			# Response, e.g. SIP/2.0 407 Authorization required
+			$result{code} = $1;
+			$result{text} = $2;
+		} elsif ( $header[0] =~m{^(\w+)\s+(\S.*?)\s+SIP/2\.0\s*$} ) {
+			# Request, e.g. INVITE <sip:bla at fasel> SIP/2.0
+			$result{code} = $1;
+			$result{text} = $2;
 		} else {
-			# split on komma (but not if quoted)
-			push @v,'';
-			my $quoted = 0;
-			while (1) {
-				if ( $v =~m{\G(.*?)([\\",])}gc ) {
-					if ( $2 eq "\\" ) {
-						$v[-1].=$1.$2.substr( $v,pos($v),1 );
-						pos($v)++;
-					} elsif ( $2 eq '"' ) {
-						$v[-1].=$1.$2;
-						$quoted = !$quoted;
-					} elsif ( $2 eq ',' ) {
-						# next item if not quoted
-						( $v[-1].=$1 ) =~s{\s+$}{}; # strip trailing space
-						push @v,'' if !$quoted;
-						$v =~m{\G\s+}gc; # skip space after ','
-					}
-				} else {
-					# add rest to last from @v
-					$v[-1].= substr($v,pos($v)||0 );
-					last;
+			die "bad request: starts with '$header[0]'";
+		}
+		shift(@header);
+
+		$result{body} = $body;
+
+		my @hdr;
+		my @lines;
+		while (@header) {
+			my ($k,$v) = $header[0] =~m{^([^\s:]+)\s*:\s*(.*)}
+				or die "bad header line $header[0]";
+			my $line = shift(@header);
+			while ( @header && $header[0] =~m{^\s+(.*)} ) {
+				# continuation line
+				$v .= "\n$1";
+				$line .= shift(@header);
+			}
+			my $nk = _normalize_hdrkey($k);
+
+			my $parse = $key2parser{$nk};
+			my @v = $parse ? $parse->($v,$nk) : _hdrkey_parse_comma_seperated($v,$nk);
+			if ( @v>1 ) {
+				for( my $i=0;$i<@v;$i++ ) {
+					push @hdr, Net::SIP::HeaderPair->new( $k,$v[$i],scalar(@lines),$i );
 				}
+			} else {
+				push @hdr, Net::SIP::HeaderPair->new( $k,$v[0],scalar(@lines) );
 			}
-		}
-		if ( @v>1 ) {
-			for( my $i=0;$i<@v;$i++ ) {
-				push @hdr, Net::SIP::HeaderPair->new( $k,$v[$i],scalar(@lines),$i );
-			}
-		} else {
-			push @hdr, Net::SIP::HeaderPair->new( $k,$v[0],scalar(@lines) );
-		}
-		push @lines, [ $line, int(@v) ];
-	}
-	$result{header} = \@hdr;
-	$result{lines}  = \@lines;
-	return \%result;
+			push @lines, [ $line, int(@v) ];
+		}
+		$result{header} = \@hdr;
+		$result{lines}  = \@lines;
+		return \%result;
+	}
 }
 
 ###########################################################################

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Request.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/lib/Net/SIP/Request.pm?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Request.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Request.pm Sun Jan  6 02:49:45 2008
@@ -30,6 +30,7 @@
 
 sub set_uri {
 	my Net::SIP::Request $self = shift;
+	$self->_update_string;
 	$self->{text} = shift;
 }
 

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm Sun Jan  6 02:49:45 2008
@@ -21,6 +21,7 @@
 	'registrar',          # optional registrar (addr:port)
 	'auth',               # Auth data, see Net::SIP::Endpoint
 	'from',               # SIP address of caller
+	'contact',            # optional local contact address
 	'domain',             # default domain for SIP addresses
 	'last_error',         # last error
 	'options',            # hash with field,values for response to OPTIONS request
@@ -59,6 +60,7 @@
 #     registrar      - use registrar for registration
 #     auth           - auth data: see Request->authorize for format
 #     from           - myself, used for calls and registration
+#     contact        - optional local contact address
 #     options        - hash with fields,values for reply to OPTIONS request
 #     loop           - predefined Net::SIP::Dispatcher::Eventloop, used if
 #                      shared between UAs
@@ -81,6 +83,7 @@
 	my $registrar = delete $args{registrar};
 
 	my $from = delete $args{from};
+	my $contact = delete $args{contact};
 	my $domain = delete $args{domain};
 	if ($from) {
 		$domain = $1 if !defined($domain)
@@ -170,6 +173,7 @@
 	%$self = (
 		auth => $auth,
 		from => $from,
+		contact => $contact,
 		domain => $domain,
 		endpoint => $endpoint,
 		registrar => $registrar,
@@ -295,7 +299,7 @@
 
 	my $from = delete $args{from} || $self->{from}
 		|| croak( "unknown from" );
-	my $contact = $from;
+	my $contact = delete $args{contact} || $self->{contact} || $from;
 	my $local = $leg->{addr}.':'.$leg->{port};
 	$contact.= '@'.$local unless $contact =~s{\@([\w\-\.]+)}{\@$local};
 

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Simple.pod
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/lib/Net/SIP/Simple.pod?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Simple.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Simple.pod Sun Jan  6 02:49:45 2008
@@ -88,6 +88,11 @@
 SIP address of local sender, either full SIP address or only part before \@, in which
 case B<domain> has to be provided.
 
+=item contact
+
+SIP address of local sender, which should be used in the contact header of REGISTER
+and INVITE requests. If not given B<from> will be used.
+
 =item options
 
 This is a hash reference containing headers (header-key,value) for replies to an 

Modified: trunk/libnet-sip-perl/lib/Net/SIP/Simple/Call.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/lib/Net/SIP/Simple/Call.pm?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Simple/Call.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Simple/Call.pm Sun Jan  6 02:49:45 2008
@@ -77,6 +77,7 @@
 	$self->{ctx} = ref($ctx) ? $ctx : {
 		to => $ctx,
 		from => $self->{from},
+		contact => $self->{contact},
 		auth => $self->{auth},
 		route => $self->{route},
 	};

Modified: trunk/libnet-sip-perl/samples/invite_and_recv.pl
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/samples/invite_and_recv.pl?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/samples/invite_and_recv.pl (original)
+++ trunk/libnet-sip-perl/samples/invite_and_recv.pl Sun Jan  6 02:49:45 2008
@@ -30,6 +30,7 @@
   -O|--outfile filename        write received RTP data to file
   -T|--time interval           hang up after interval seconds
   -L|--leg ip[:port]           use given local ip[:port] for outgoing leg
+  -C|--contact sipaddr         use given contact address for contact in register and invite
   --username name              username for authorization
   --password pass              password for authorization
   --route host[:port]          add SIP route, can be specified multiple times
@@ -48,7 +49,7 @@
 # Get options
 ###################################################
 
-my ($proxy,$outfile,$registrar,$username,$password,$hangup,$local_leg);
+my ($proxy,$outfile,$registrar,$username,$password,$hangup,$local_leg,$contact);
 my (@routes,$debug);
 GetOptions(
 	'd|debug:i' => \$debug,
@@ -58,6 +59,7 @@
 	'O|outfile=s' => \$outfile,
 	'T|time=i' => \$hangup,
 	'L|leg=s' => \$local_leg,
+	'C|contact=s' => \$contact,
 	'username=s' =>\$username,
 	'password=s' =>\$password,
 	'route=s' => \@routes,
@@ -131,6 +133,7 @@
 	outgoing_proxy => $proxy,
 	route => \@routes,
 	legs => \@legs,
+	$contact ? ( contact => $contact ):(),
 	$username ? ( auth => [ $username,$password ] ):(),
 );
 

Modified: trunk/libnet-sip-perl/t/03_forward_stateless.t
URL: http://svn.debian.org/wsvn/trunk/libnet-sip-perl/t/03_forward_stateless.t?rev=12093&op=diff
==============================================================================
--- trunk/libnet-sip-perl/t/03_forward_stateless.t (original)
+++ trunk/libnet-sip-perl/t/03_forward_stateless.t Sun Jan  6 02:49:45 2008
@@ -78,7 +78,7 @@
 	});
 	$disp->receive( $request,$incoming_leg,'127.0.0.1:282' );
 	$loop->loop(1,\$delivered_via );
-	ok( $delivered_via, $expected_outgoing_leg );
+	ok( $delivered_via == $expected_outgoing_leg, 'expected leg' );
 }
 
 




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