r28308 - in /branches/upstream/libnet-sip-perl/current: COPYRIGHT Changes MANIFEST META.yml lib/Net/SIP.pm lib/Net/SIP/Endpoint/Context.pm t/14_bugfix_0.51.t
rmayorga-guest at users.alioth.debian.org
rmayorga-guest at users.alioth.debian.org
Wed Dec 17 06:04:44 UTC 2008
Author: rmayorga-guest
Date: Wed Dec 17 06:04:41 2008
New Revision: 28308
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28308
Log:
[svn-upgrade] Integrating new upstream version, libnet-sip-perl (0.51)
Added:
branches/upstream/libnet-sip-perl/current/t/14_bugfix_0.51.t
Modified:
branches/upstream/libnet-sip-perl/current/COPYRIGHT
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/Endpoint/Context.pm
Modified: branches/upstream/libnet-sip-perl/current/COPYRIGHT
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/COPYRIGHT?rev=28308&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/COPYRIGHT (original)
+++ branches/upstream/libnet-sip-perl/current/COPYRIGHT Wed Dec 17 06:04:41 2008
@@ -1,4 +1,4 @@
-These modules are copyright (c) 2006-2007, Steffen Ullrich.
+These modules are copyright (c) 2006-2008, Steffen Ullrich.
All Rights Reserved.
These modules are free software. They may be used, redistributed
and/or modified under the same terms as Perl itself.
Modified: branches/upstream/libnet-sip-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/Changes?rev=28308&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/Changes (original)
+++ branches/upstream/libnet-sip-perl/current/Changes Wed Dec 17 06:04:41 2008
@@ -1,5 +1,9 @@
Revision history for Net::SIP
+
+0.51 2008-12-16
+- get to+tag from 2xx response on invite only when call is outgoing,
+ e.g. not on re-INVITE from UAS where UAC send initial INVITE
0.50 2008-10-31
- release 0.49_3 as 0.50
Modified: branches/upstream/libnet-sip-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/MANIFEST?rev=28308&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-sip-perl/current/MANIFEST Wed Dec 17 06:04:41 2008
@@ -67,6 +67,7 @@
t/11_invite_timeout.t
t/12_maddr.t
t/13_maddr_proxy.t
+t/14_bugfix_0.51.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=28308&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/META.yml (original)
+++ branches/upstream/libnet-sip-perl/current/META.yml Wed Dec 17 06:04:41 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-SIP
-version: 0.50
+version: 0.51
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=28308&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm Wed Dec 17 06:04:41 2008
@@ -4,7 +4,7 @@
require 5.008;
package Net::SIP;
-our $VERSION = '0.50';
+our $VERSION = '0.51';
# this includes nearly everything else
use Net::SIP::Simple ();
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Endpoint/Context.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Endpoint/Context.pm?rev=28308&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Endpoint/Context.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Endpoint/Context.pm Wed Dec 17 06:04:41 2008
@@ -368,7 +368,7 @@
# FIXME: this should probably be better done by the upper layer
# which decides, which call to accept (in case of call-forking with
# multiple 2xx responses)
- $self->{to} = $response->get_header( 'to' );
+ $self->{to} = $response->get_header( 'to' ) if ! $self->{incoming};
} else {
# response to ACK, REGISTER...
Added: branches/upstream/libnet-sip-perl/current/t/14_bugfix_0.51.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/t/14_bugfix_0.51.t?rev=28308&op=file
==============================================================================
--- branches/upstream/libnet-sip-perl/current/t/14_bugfix_0.51.t (added)
+++ branches/upstream/libnet-sip-perl/current/t/14_bugfix_0.51.t Wed Dec 17 06:04:41 2008
@@ -1,0 +1,142 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 12;
+do './testlib.pl' || do './t/testlib.pl' || die "no testlib";
+
+use Net::SIP ':all';
+use Net::SIP::SDP;
+use Data::Dumper;
+
+my $HOST = '127.0.0.1';
+
+my ($luac,$luas,$lproxy);
+for ( $luac,$luas,$lproxy) {
+ my ($sock,$addr) = create_socket_to( $HOST );
+ $_ = { sock => $sock, addr => $addr };
+}
+
+diag( "UAS on $luas->{addr} " );
+diag( "UAC on $luac->{addr} " );
+diag( "PROXY on $lproxy->{addr} " );
+
+# start Proxy
+my $proxy = fork_sub( 'proxy', $lproxy );
+fd_grep_ok( 'Listening',$proxy );
+
+# start UAS
+my $uas = fork_sub( 'uas', $luas, $lproxy->{addr} );
+fd_grep_ok( 'Listening',$uas );
+
+# start UAC once UAS is ready
+my $uac = fork_sub( 'uac', $luac, $lproxy->{addr} );
+fd_grep_ok( 'Started',$uac );
+fd_grep_ok( 'Call accepted',$uas );
+
+# then re-invite
+fd_grep_ok( 'Starting ReInvite', $uas );
+fd_grep_ok( 'Got ReInvite', $uac );
+
+# BYE from UAS
+fd_grep_ok( 'Send BYE',$uas );
+fd_grep_ok( 'Received BYE',$uac );
+fd_grep_ok( 'BYE done',$uas );
+
+killall();
+
+# --------------------------------------------------------------
+# PROXY
+# --------------------------------------------------------------
+sub proxy {
+ my $lsock = shift;
+ my $proxy = Net::SIP::Simple->new( leg => $lsock );
+ $proxy->create_chain([
+ $proxy->create_registrar,
+ $proxy->create_stateless_proxy,
+ ]);
+ print "Listening\n";
+ $proxy->loop;
+}
+
+# --------------------------------------------------------------
+# UAC
+# --------------------------------------------------------------
+
+sub uac {
+ my ($lsock,$paddr) = @_;
+
+ my $ua = Simple->new(
+ leg => $lsock->{leg},
+ outgoing_proxy => $paddr,
+ from => "sip:uac\@$paddr",
+ );
+ print "Started\n";
+
+ my ($call,$reinvite);
+ $ua->invite( "sip:uas\@$paddr", cb_established => sub {
+ (undef,$call) = @_;
+ $reinvite = 1;
+ }) || die;
+
+ # wait for reinvite done
+ $reinvite = 0;
+ $ua->loop( 10,\$reinvite );
+ $reinvite || die;
+ print "Got ReInvite\n";
+
+ # wait for BYE
+ $call->set_param( recv_bye => \( my $recv_bye ));
+ $ua->loop( 5,\$recv_bye );
+ print "Received BYE\n" if $recv_bye;
+}
+
+# --------------------------------------------------------------
+# UAS
+# --------------------------------------------------------------
+
+sub uas {
+ my ($lsock,$paddr) = @_;
+ my $ua = Simple->new(
+ domain => $paddr,
+ registrar => $paddr,
+ outgoing_proxy => $paddr,
+ leg => $lsock->{leg},
+ from => "sip:uas\@$paddr",
+ );
+
+ # registration
+ $ua->register;
+ die "registration failed: ".$ua->error if $ua->error;
+
+ # accept call and send some data, set $stop once
+ # the call was established
+ my $stop = 0;
+ my $call;
+ $ua->listen( cb_established => sub {
+ (undef,$call) = @_;
+ $stop = 1
+ });
+ print "Listening\n";
+ $ua->loop( \$stop );
+ print "Call accepted\n";
+
+ # Reinvite
+ print "Starting ReInvite\n";
+ $stop = 0;
+ $call->reinvite( cb_final => \$stop );
+ $ua->loop( 10,\$stop );
+
+ # Bug fixed in 0.51:
+ # to of context should be uas, from should be uac, context should be incoming
+ die "from is $call->{ctx}{from}" if $call->{ctx}{from} !~m{uac\@};
+ die "from is $call->{ctx}{to}" if $call->{ctx}{to} !~m{uas\@};
+ die "ctx is not incoming" if ! $call->{ctx}{incoming};
+
+ # and bye
+ print "Send BYE\n";
+ $call->bye( cb_final => \( my $bye_ok ));
+ $ua->loop( 10,\$bye_ok );
+ print "BYE done\n" if $bye_ok;
+}
+
More information about the Pkg-perl-cvs-commits
mailing list