r12078 - in /branches/upstream/libnet-sip-perl/current: ./ 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 01:34:02 UTC 2008
Author: rmayorga-guest
Date: Sun Jan 6 01:34:01 2008
New Revision: 12078
URL: http://svn.debian.org/wsvn/?sc=1&rev=12078
Log:
[svn-upgrade] Integrating new upstream version, libnet-sip-perl (0.41)
Modified:
branches/upstream/libnet-sip-perl/current/Changes
branches/upstream/libnet-sip-perl/current/META.yml
branches/upstream/libnet-sip-perl/current/README
branches/upstream/libnet-sip-perl/current/THANKS
branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Request.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pod
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/Call.pm
branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl
branches/upstream/libnet-sip-perl/current/t/03_forward_stateless.t
Modified: branches/upstream/libnet-sip-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/Changes?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/Changes (original)
+++ branches/upstream/libnet-sip-perl/current/Changes Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/META.yml?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/META.yml (original)
+++ branches/upstream/libnet-sip-perl/current/META.yml Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/README?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/README (original)
+++ branches/upstream/libnet-sip-perl/current/README Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/THANKS
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/THANKS?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/THANKS (original)
+++ branches/upstream/libnet-sip-perl/current/THANKS Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pm Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Request.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Request.pm?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Request.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Request.pm Sun Jan 6 01:34:01 2008
@@ -30,6 +30,7 @@
sub set_uri {
my Net::SIP::Request $self = shift;
+ $self->_update_string;
$self->{text} = shift;
}
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pm?rev=12078&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 Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pod?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pod (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple.pod Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/Call.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/Call.pm?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/Call.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/Call.pm Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl (original)
+++ branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl Sun Jan 6 01:34:01 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: branches/upstream/libnet-sip-perl/current/t/03_forward_stateless.t
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/t/03_forward_stateless.t?rev=12078&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/t/03_forward_stateless.t (original)
+++ branches/upstream/libnet-sip-perl/current/t/03_forward_stateless.t Sun Jan 6 01:34:01 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