r26506 - in /branches/upstream/libnet-sip-perl/current: Changes MANIFEST META.yml lib/Net/SIP.pm lib/Net/SIP/Dispatcher.pm lib/Net/SIP/Simple/RTP.pm lib/Net/SIP/StatelessProxy.pm t/12_maddr.t t/13_maddr_proxy.t
ghostbar-guest at users.alioth.debian.org
ghostbar-guest at users.alioth.debian.org
Sun Nov 2 06:34:08 UTC 2008
Author: ghostbar-guest
Date: Sun Nov 2 06:34:05 2008
New Revision: 26506
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26506
Log:
[svn-upgrade] Integrating new upstream version, libnet-sip-perl (0.50)
Added:
branches/upstream/libnet-sip-perl/current/t/12_maddr.t
branches/upstream/libnet-sip-perl/current/t/13_maddr_proxy.t
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/Dispatcher.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/RTP.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/StatelessProxy.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=26506&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/Changes (original)
+++ branches/upstream/libnet-sip-perl/current/Changes Sun Nov 2 06:34:05 2008
@@ -1,10 +1,21 @@
Revision history for Net::SIP
+
+0.50 2008-10-31
+- release 0.49_3 as 0.50
+0.49_3 2008-10-29
+- Net::SIP::StatelessProxy - observe maddr of URI when forwarding
+0.49_2 2008-10-29
+- Net::SIP::Dispatcher - observe maddr and transport parameter of URI
+ when finding peer
+0.49_1 2008-10-23
+- fixed code in Net::SIP::Simple::RTP where it dropped packets
+ (and subsequently terminated the connection due to inactivity)
+ when the 16bit RTP sequence counter overflowed
0.49 2008-09-30
- fixed Socket6::inet_pton based check for valid IP6 address in
Net::SIP::SDP
-
0.48_1
- fix bugs reported by gilad[AT]summit-tech[DOT]ca:
- force Allow and Supported header only on INVITE req and 2xx response
Modified: branches/upstream/libnet-sip-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/MANIFEST?rev=26506&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-sip-perl/current/MANIFEST Sun Nov 2 06:34:05 2008
@@ -65,6 +65,8 @@
t/09_fdleak.t
t/10_fdleak.t
t/11_invite_timeout.t
+t/12_maddr.t
+t/13_maddr_proxy.t
t/testlib.pl
samples/README
samples/invite_and_recv.pl
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=26506&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/META.yml (original)
+++ branches/upstream/libnet-sip-perl/current/META.yml Sun Nov 2 06:34:05 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-SIP
-version: 0.49
+version: 0.50
abstract: ~
license: ~
author: ~
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=26506&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm Sun Nov 2 06:34:05 2008
@@ -4,7 +4,7 @@
require 5.008;
package Net::SIP;
-our $VERSION = '0.49';
+our $VERSION = '0.50';
# this includes nearly everything else
use Net::SIP::Simple ();
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm?rev=26506&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm Sun Nov 2 06:34:05 2008
@@ -653,6 +653,12 @@
@$dst_addr = ( $ip_addr );
}
+ # is param maddr set?
+ if ( my $ip = $param->{maddr} ) {
+ @$dst_addr = ( $ip )
+ if $ip =~m{^[\d\.]+$} && eval { inet_aton($ip) };
+ }
+
# entries in form [ prio,proto,ip,port ]
my @resp;
foreach my $addr ( @$dst_addr ) {
@@ -665,6 +671,11 @@
my $port = $3 ? $3 : $default_port;
push @resp, map { [ -1,$_,$host,$port ] } @$proto;
}
+ }
+
+ # should we use a fixed transport?
+ if ( my $proto = $param->{transport} ) {
+ @resp = grep { lc($_->[1]) eq lc($proto) } @resp;
}
my @param = ( $dst_addr,$legs,$allowed_legs,$default_port,$callback );
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/RTP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/RTP.pm?rev=26506&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/RTP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Simple/RTP.pm Sun Nov 2 06:34:05 2008
@@ -241,7 +241,8 @@
my $payload = $padding ? substr( $buf,0,length($buf)-$padding ): $buf;
DEBUG( 100,"payload=$seq/%d xh=%d padding=%d cc=%d", length($payload),$xh,$padding,$cc );
- if ( $targs->{rseq} && $seq<= $targs->{rseq} ) {
+ if ( $targs->{rseq} && $seq<= $targs->{rseq}
+ && $targs->{rseq} - $seq < 60000 ) {
DEBUG( 10,"seq=$seq last=$targs->{rseq} - dropped" );
return;
}
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/StatelessProxy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/StatelessProxy.pm?rev=26506&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/StatelessProxy.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/StatelessProxy.pm Sun Nov 2 06:34:05 2008
@@ -155,6 +155,7 @@
my ($first,$param) = sip_hdrval2parts( via => $via );
my ($addr,$port) = $first =~m{([\w\-\.]+)(?::(\d+))?\s*$};
$port ||= 5060; # FIXME default for sip, not sips!
+ $addr = $param->{maddr} if $param->{maddr};
@{ $entry->{dst_addr}} = ( "$addr:$port" );
DEBUG( 50,"get dst_addr from via header: $first -> $addr:$port" );
@@ -170,7 +171,7 @@
}
###########################################################################
-# Called from _forward_response directly or inderectly after resolving
+# 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.
@@ -233,10 +234,14 @@
# if the top route header points to a local leg we use this as outgoing leg
if ( my @route = $packet->get_header( 'route' ) ) {
$route[0] =~s{.*<}{} && $route[0] =~s{>.*}{};
- my ($data) = sip_hdrval2parts( route => $route[0] );
+ my ($data,$param) = sip_hdrval2parts( route => $route[0] );
my ($addr,$port) = $data =~m{([\w\-\.]+)(?::(\d+))?\s*$};
$port ||= 5060; # FIXME sips
my @legs = $disp->get_legs( addr => $addr, port => $port );
+ if ( ! @legs ) {
+ $addr = $param->{maddr} if $param->{maddr};
+ @legs = $disp->get_legs( addr => $addr, port => $port );
+ }
if ( @legs ) {
DEBUG( 50,"setting leg from our route header: $data -> ".$legs[0]->dump );
$entry->{outgoing_leg} = \@legs;
@@ -247,11 +252,16 @@
if ( @route ) {
# still routing infos. Use next route as dst_addr
$route[0] =~s{.*<}{} && $route[0] =~s{>.*}{};
- my ($data) = sip_hdrval2parts( route => $route[0] );
+ my ($data,$param) = sip_hdrval2parts( route => $route[0] );
my ($addr,$port) = $data =~m{([\w\-\.]+)(?::(\d+))?\s*$};
$port ||= 5060; # FIXME sips
+ if ( my $m = $param->{maddr} ) {
+ $addr = $m;
+ DEBUG( 50, "setting dst_addr from route $data;maddr=$m to $addr:$port" );
+ } else {
+ DEBUG( 50, "setting dst_addr from route $data to $addr:$port" );
+ }
@{ $entry->{dst_addr} } = ( "$addr:$port" );
- DEBUG( 50, "setting dst_addr from route $data to $addr:$port" );
}
} else {
DEBUG( 50,'no route header' );
Added: branches/upstream/libnet-sip-perl/current/t/12_maddr.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/t/12_maddr.t?rev=26506&op=file
==============================================================================
--- branches/upstream/libnet-sip-perl/current/t/12_maddr.t (added)
+++ branches/upstream/libnet-sip-perl/current/t/12_maddr.t Sun Nov 2 06:34:05 2008
@@ -1,0 +1,116 @@
+#!/usr/bin/perl
+
+###########################################################################
+# creates a UAC and a UAS using Net::SIP::Simple
+# and makes call from UAC to UAS,
+# Call does not involve transfer of RTP data
+###########################################################################
+
+use strict;
+use warnings;
+use Test::More tests => 8;
+
+use Net::SIP;
+use Net::SIP::Util ':all';
+use IO::Socket;
+
+# create leg for UAS on dynamic port
+my $sock_uas = IO::Socket::INET->new(
+ Proto => 'udp',
+ LocalAddr => '127.0.0.1',
+ LocalPort => 0, # let system pick one
+);
+ok( $sock_uas, 'create UAS socket' );
+
+# get address for UAS
+my $uas_addr = $sock_uas->sockhost.':'.$sock_uas->sockport;
+
+
+# fork UAS and make call from UAC to UAS
+pipe( my $read,my $write); # to sync UAC with UAS
+my $pid = fork();
+if ( defined($pid) && $pid == 0 ) {
+ close($read);
+ $write->autoflush;
+ uas( $sock_uas, $write );
+ exit(0);
+}
+
+ok( $pid, "fork successful" );
+close( $sock_uas );
+close($write);
+
+alarm(15);
+$SIG{__DIE__} = $SIG{ALRM} = sub { kill 9,$pid; ok( 0,'died' ) };
+
+uac( $uas_addr,$read );
+ok( <$read>, "UAS finished" );
+wait;
+
+###############################################
+# UAC
+###############################################
+
+sub uac {
+ my ($peer,$pipe) = @_;
+ Net::SIP::Debug->set_prefix( "DEBUG(uac):" );
+
+ ok( <$pipe>, "UAS created\n" ); # wait until UAS is ready
+ my $uac = Net::SIP::Simple->new(
+ from => 'me.uac at example.com',
+ leg => scalar(create_socket_to( $peer )),
+ );
+ ok( $uac, 'UAC created' );
+
+ ok( <$pipe>, "UAS ready\n" ); # wait until UAS is ready
+ my $ringing = 0;
+ my ($peer_addr,$peer_port) = split( ':',$peer );
+ my $call = $uac->invite(
+ "<sip:you.uas\@example.com:$peer_port;maddr=$peer_addr>",
+ );
+ my $stop;
+ if ( $call ) {
+ ok( $call, 'Call established' );
+ $call->loop(1);
+ $call->bye( cb_final => \$stop );
+ $call->loop( \$stop,10 );
+ }
+ ok( $stop, 'UAS down' );
+}
+
+###############################################
+# UAS
+###############################################
+
+sub uas {
+ my ($sock,$pipe) = @_;
+ Net::SIP::Debug->set_prefix( "DEBUG(uas):" );
+ my $uas = Net::SIP::Simple->new(
+ domain => 'example.com',
+ leg => $sock
+ ) || die $!;
+ print $pipe "UAS created\n";
+
+ # Listen
+ my $call_closed;
+ $uas->listen(
+ cb_established => sub { diag( 'call established' ) },
+ cb_cleanup => sub {
+ diag( 'call cleaned up' );
+ $call_closed =1;
+ },
+ );
+
+ # notify UAC process that I'm listening
+ print $pipe "UAS ready\n";
+
+ # Loop until call is closed, at most 10 seconds
+ $uas->loop( \$call_closed, 10 );
+
+ # done
+ if ( $call_closed ) {
+ print $pipe "UAS finished\n";
+ } else {
+ print $pipe "call closed by timeout not stopvar\n";
+ }
+}
Added: branches/upstream/libnet-sip-perl/current/t/13_maddr_proxy.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/t/13_maddr_proxy.t?rev=26506&op=file
==============================================================================
--- branches/upstream/libnet-sip-perl/current/t/13_maddr_proxy.t (added)
+++ branches/upstream/libnet-sip-perl/current/t/13_maddr_proxy.t Sun Nov 2 06:34:05 2008
@@ -1,0 +1,53 @@
+#!/usr/bin/perl
+
+###########################################################################
+# creates a UAC and a UAS using Net::SIP::Simple
+# and makes call from UAC to UAS,
+# Call does not involve transfer of RTP data
+###########################################################################
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+use Net::SIP ':all';
+
+my $leg = myLeg->new(
+ sock => \*STDOUT,
+ addr => '10.0.105.10',
+ port => '5062'
+);
+my $ua = Simple->new( legs => [ $leg ] );
+$ua->create_stateless_proxy;
+
+my $packet = Net::SIP::Packet->new( <<'PKT' );
+NOTIFY sip:john at 10.0.100.189:5060 SIP/2.0
+Via: SIP/2.0/UDP 10.0.105.10:5066;branch=z9hG4bK75852cbf.3a07466d.64f68271
+Max-Forwards: 70
+Route: <sip:10.0.105.10:5062;lr>
+Route: <sip:3Zqkv7%0Baqqhyaacc4qsip%3Ajohn%40dgged.dhhd.ahhdgd:7070;maddr=172.25.2.1;lr>
+Contact: <sip:CGP1 at 10.0.105.10:5066>
+To: <sip:john at 10.0.100.189:5060>;tag=nura947nd1hc6sd009bj
+From: <sip:john at dgged.dhhd.ahhdgd>;tag=13cb22556957d43f-57b1b5d5.0
+Call-ID: HuOAA9-5oIe1iM9neZbyp4fPeoAGdt
+CSeq: 929505408 NOTIFY
+Event: nexos
+Content-Type: application/vnd.ericsson.lmc.sipuaconfig+xml
+P-Asserted-Identity: <sip:john at 10.0.100.189:5060>
+Subscription-State: active;expires=3600
+Content-Length: 0
+
+PKT
+my $disp = $ua->{dispatcher};
+$disp->receive( $packet, $leg, '127.0.0.1:1919' );
+
+###########################################################################
+package myLeg;
+use base 'Net::SIP::Leg';
+use Test::More;
+
+sub sendto {
+ my myLeg $self = shift;
+ my ($data,$host,$port,$callback) = @_;
+ ok( "$host:$port" eq "172.25.2.1:7070", "got target from maddr" );
+}
More information about the Pkg-perl-cvs-commits
mailing list