r25642 - in /branches/upstream/libnet-sip-perl/current: Changes META.yml THANKS bin/stateless_proxy.pl lib/Net/SIP.pm lib/Net/SIP/Leg.pm lib/Net/SIP/Util.pm lib/Net/SIP/Util.pod t/testlib.pl
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Fri Sep 26 15:07:44 UTC 2008
Author: gregoa
Date: Fri Sep 26 15:07:42 2008
New Revision: 25642
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=25642
Log:
[svn-upgrade] Integrating new upstream version, libnet-sip-perl (0.48.1)
Modified:
branches/upstream/libnet-sip-perl/current/Changes
branches/upstream/libnet-sip-perl/current/META.yml
branches/upstream/libnet-sip-perl/current/THANKS
branches/upstream/libnet-sip-perl/current/bin/stateless_proxy.pl
branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Leg.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pod
branches/upstream/libnet-sip-perl/current/t/testlib.pl
Modified: branches/upstream/libnet-sip-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/Changes?rev=25642&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/Changes (original)
+++ branches/upstream/libnet-sip-perl/current/Changes Fri Sep 26 15:07:42 2008
@@ -1,5 +1,22 @@
Revision history for Net::SIP
+
+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
+ to INVITE, on 2xx responses to OPTIONS and on 405 responses
+ - force Contact header only on INVITE req and it's 2xx response
+
+0.48
+ - new function Net::SIP::Util::sip_uri_eq to check if two URIs mean the
+ same
+ - fix bugs reported by gilad[AT]summit-tech[DOT]ca:
+ - when comparing Route header in incoming/outgoing request with myself
+ use sip_uri_eq instead of simple eq, because the URIs might be
+ the same, but one might specify a default port while the other not
+ - when adding record-route header in forward_outgoing check that the
+ top record-route header isn't myself (in case incoming and outgoing
+ leg are the same)
0.47
- if contact header changes the URI of the dialog send the ACK with
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=25642&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/META.yml (original)
+++ branches/upstream/libnet-sip-perl/current/META.yml Fri Sep 26 15:07:42 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-SIP
-version: 0.47
+version: 0.48_1
abstract: ~
license: ~
author: ~
Modified: branches/upstream/libnet-sip-perl/current/THANKS
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/THANKS?rev=25642&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/THANKS (original)
+++ branches/upstream/libnet-sip-perl/current/THANKS Fri Sep 26 15:07:42 2008
@@ -1,5 +1,5 @@
-Thanks to GeNUA mbh www.genua.de to let me work on this code and release
-it to the public.
+Thanks to GeNUA mbh http://www.genua.de to let me work on this
+code and release it to the public.
Thanks for bugreports, fixes, testing and other feedback from:
<mtve1927[AT]gmail[DOT]com>
@@ -12,3 +12,4 @@
<andrew[DOT]pogrebennyk[AT]portaone[DOT]com>
Roland Mas <lolando[AT]debian[DOT]org>
Alex Revetski <revetski[AT]gmail[DOT]com>
+Gilad Novik gilad[AT]summit-tech[DOT]ca
Modified: branches/upstream/libnet-sip-perl/current/bin/stateless_proxy.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/bin/stateless_proxy.pl?rev=25642&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/bin/stateless_proxy.pl (original)
+++ branches/upstream/libnet-sip-perl/current/bin/stateless_proxy.pl Fri Sep 26 15:07:42 2008
@@ -417,7 +417,7 @@
my $legs = $entry->{outgoing_leg};
# if leg was given by route try to check for Registrar there
- if ( $entry->{has_route} && ( my $reg = $self->{leg2registrar}{$legs->[0]} )) {
+ if ( @$legs && $entry->{has_route} && ( my $reg = $self->{leg2registrar}{$legs->[0]} )) {
#### try if the registrar has the address on the leg
#### if, then set the outgoing leg and rewrite the packet to
#### reflect the new URI
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=25642&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm Fri Sep 26 15:07:42 2008
@@ -4,7 +4,7 @@
require 5.008;
package Net::SIP;
-our $VERSION = '0.47';
+our $VERSION = '0.48_1';
# this includes nearly everything else
use Net::SIP::Simple ();
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Leg.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Leg.pm?rev=25642&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Leg.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Leg.pm Fri Sep 26 15:07:42 2008
@@ -11,7 +11,7 @@
use Digest::MD5 'md5_hex';
use Socket;
use Net::SIP::Debug;
-use Net::SIP::Util qw( sip_hdrval2parts invoke_callback );
+use Net::SIP::Util qw( sip_hdrval2parts invoke_callback sip_uri_eq );
use Net::SIP::Packet;
use Net::SIP::Request;
use Net::SIP::Response;
@@ -169,7 +169,7 @@
my $route = $route[0];
$route = $1 if $route =~m{^<(.*)>};
($route) = sip_hdrval2parts( route => $route );
- if ( $route eq $self->{contact} ) {
+ if ( sip_uri_eq( $route,$self->{contact}) ) {
# top route was me
$remove_route = 0;
}
@@ -226,15 +226,22 @@
# This is necessary, because these information are used in in new requests
# from UAC to UAS, but also from UAS to UAC and UAS should talk to this leg
# and not to the leg, where the request came in.
- $packet->insert_header( 'record-route', '<'.$self->{contact}.';lr>' )
- if $packet->method ne 'REGISTER';
+ # don't add if the upper record-route is already me, this is the case
+ # when incoming and outgoing leg are the same
+ if ( $packet->method ne 'REGISTER' ) {
+ my $rr;
+ unless ( (($rr) = $packet->get_header( 'record-route' ))
+ and sip_uri_eq( $rr,$self->{contact} )) {
+ $packet->insert_header( 'record-route', '<'.$self->{contact}.';lr>' )
+ }
+ }
# strip myself from route header, because I'm done
if ( my @route = $packet->get_header( 'route' ) ) {
my $route = $route[0];
$route = $1 if $route =~m{^<(.*)>};
($route) = sip_hdrval2parts( route => $route );
- if ( $route eq $self->{contact} ) {
+ if ( sip_uri_eq( $route,$self->{contact} )) {
# top route was me, remove it
my $remove_route = 0;
$packet->scan_header( route => [ sub {
@@ -277,37 +284,45 @@
$packet->insert_header( via => $via );
}
- # 2xx responses and INVITE requests must have a contact header
- # They should have an Allow header too und Supported would be good to
- if ( $isrq and $packet->method eq 'INVITE' or !$isrq and $packet->code =~m{^2} ) {
- if ( ! ( my @c = $packet->get_header( 'contact' ))) {
- # needs contact header, create from this leg and user part of from/to
- my ($user) = sip_hdrval2parts( $isrq
- ? ( from => scalar($packet->get_header('from')) )
- : ( to => scalar($packet->get_header('to')) )
- );
- my $contact = ( $user =~m{([^<>\@\s]+)\@} ? $1 : $user ).
- "\@$self->{addr}:$self->{port}";
- $contact = 'sip:'.$contact if $contact !~m{^\w+:};
- $packet->insert_header( contact => $contact );
- }
- # allow and supported can be multiple so enforce array context
- unless ( my @a = $packet->get_header( 'allow' )) {
- # add the default set
- $packet->insert_header( allow => 'INVITE, ACK, OPTIONS, CANCEL, BYE' );
- }
- unless ( my @a = $packet->get_header( 'supported' )) {
- # set as empty
- $packet->insert_header( supported => '' );
- }
- }
-
+ # 2xx responses to INVITE requests and the request itself must have a
+ # Contact, Allow and Supported header, 2xx Responses to OPTIONS need
+ # Allow and Supported, 405 Responses should have Allow and Supported
+
+ my ($need_contact,$need_allow,$need_supported);
+ my $method = $packet->method;
+ my $code = ! $isrq && $packet->code;
+ if ( $method eq 'INVITE' and ( $isrq or $code =~m{^2} )) {
+ $need_contact = $need_allow = $need_supported =1;
+ } elsif ( !$isrq and (
+ $code == 405 or
+ ( $method eq 'OPTIONS' and $code =~m{^2} ))) {
+ $need_allow = $need_supported =1;
+ }
+ if ( $need_contact && ! ( my @a = $packet->get_header( 'contact' ))) {
+ # needs contact header, create from this leg and user part of from/to
+ my ($user) = sip_hdrval2parts( $isrq
+ ? ( from => scalar($packet->get_header('from')) )
+ : ( to => scalar($packet->get_header('to')) )
+ );
+ my $contact = ( $user =~m{([^<>\@\s]+)\@} ? $1 : $user ).
+ "\@$self->{addr}:$self->{port}";
+ $contact = 'sip:'.$contact if $contact !~m{^\w+:};
+ $packet->insert_header( contact => $contact );
+ }
+ if ( $need_allow && ! ( my @a = $packet->get_header( 'allow' ))) {
+ # insert default methods
+ $packet->insert_header( allow => 'INVITE, ACK, OPTIONS, CANCEL, BYE' );
+ }
+ if ( $need_supported && ! ( my @a = $packet->get_header( 'supported' ))) {
+ # set as empty
+ $packet->insert_header( supported => '' );
+ }
my ($proto,$host,$port) =
$addr =~m{^(?:(\w+):)?([\w\-\.]+)(?::(\d+))?$};
#DEBUG( "%s -> %s %s %s",$addr,$proto||'',$host, $port||'' );
- $port ||= 5060; # only right for sip, not sips!
+ $port ||= $proto eq 'sips' ? 5061: 5060;
$self->sendto( $packet->as_string, $host,$port,$callback )
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pm?rev=25642&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pm Fri Sep 26 15:07:42 2008
@@ -22,6 +22,7 @@
create_socket_to
create_rtp_sockets
invoke_callback
+ sip_uri_eq
);
our %EXPORT_TAGS = ( all => \@EXPORT_OK );
@@ -165,6 +166,26 @@
}
###########################################################################
+# returns true if two URIs are the same
+# Args: $uri1,$uri2
+# Returns: true if both URI point to same address
+###########################################################################
+sub sip_uri_eq {
+ my ($uri1,$uri2) = @_;
+ return 1 if $uri1 eq $uri2; # shortcut for common case
+ my ($d1,$u1,$p1) = sip_uri2parts($uri1);
+ my ($d2,$u2,$p2) = sip_uri2parts($uri2);
+ my $port1 = $d1 =~s{:(\d+)$|\[(\d+)\]$}{} ? $1||$2
+ : $p1 eq 'sips' ? 5061 : 5060;
+ my $port2 = $d2 =~s{:(\d+)$|\[(\d+)\]$}{} ? $1||$2
+ : $p2 eq 'sips' ? 5061 : 5060;
+ return lc($d1) eq lc($d2)
+ && $port1 == $port2
+ && ( defined($u1) ? defined($u2) && $u1 eq $u2 : ! defined($u2))
+ && $p1 eq $p2;
+}
+
+###########################################################################
# create socket preferable on port 5060 from which one might reach the given IP
# Args: ($dst_addr;$proto)
# $dst_addr: the adress which must be reachable from this socket
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pod?rev=25642&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pod (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.pod Fri Sep 26 15:07:42 2008
@@ -161,6 +161,13 @@
=back
+=item sip_uri_eq ( URI1, URI2 )
+
+Returns true if both URIs point to the same SIP address.
+This compares user part case sensitive, domain part case insensitive (does
+no DNS resolution) protocol and ports in domain (assumes default ports
+for protocol if no port is given).
+
=back
Modified: branches/upstream/libnet-sip-perl/current/t/testlib.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/t/testlib.pl?rev=25642&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/t/testlib.pl (original)
+++ branches/upstream/libnet-sip-perl/current/t/testlib.pl Fri Sep 26 15:07:42 2008
@@ -15,7 +15,7 @@
my ($bool,$desc) = @_;
print $bool ? "ok ":"not ok ", '# ',$desc || '',"\n";
};
- *{'diag'} = sub { print STDERR "@_\n"; };
+ *{'diag'} = sub { print "# @_\n"; };
*{'like'} = sub {
my ( $data,$rx,$desc ) = @_;
ok( $data =~ $rx ? 1:0, $desc );
More information about the Pkg-perl-cvs-commits
mailing list