r65513 - in /trunk/libnet-sip-perl: ./ debian/ debian/patches/ lib/Net/ lib/Net/SIP/ lib/Net/SIP/Endpoint/
ansgar at users.alioth.debian.org
ansgar at users.alioth.debian.org
Sat Dec 4 11:16:06 UTC 2010
Author: ansgar
Date: Sat Dec 4 11:15:59 2010
New Revision: 65513
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=65513
Log:
* New upstream release.
* debian/copyright: Refer to "Debian systems" instead of "Debian GNU/Linux
systems".
* debian/rules: Use "find -delete" instead of "find | xargs rm".
* Bump Standards-Version to 3.9.1.
* Add myself to Uploaders.
Modified:
trunk/libnet-sip-perl/Changes
trunk/libnet-sip-perl/META.yml
trunk/libnet-sip-perl/debian/changelog
trunk/libnet-sip-perl/debian/control
trunk/libnet-sip-perl/debian/copyright
trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch
trunk/libnet-sip-perl/debian/patches/pod2man_item.patch
trunk/libnet-sip-perl/debian/rules
trunk/libnet-sip-perl/lib/Net/SIP.pm
trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm
trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod
trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod
trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm
trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm
trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm
trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod
trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm
trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod
trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm
trunk/libnet-sip-perl/lib/Net/SIP/Util.pm
Modified: trunk/libnet-sip-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/Changes?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/Changes (original)
+++ trunk/libnet-sip-perl/Changes Sat Dec 4 11:15:59 2010
@@ -1,5 +1,47 @@
Revision history for Net::SIP
+0.60 2010-11-30
+- overwrite route header from record-route only for INVITE.
+ Thanks to vitspec[AT]gmail[DOT]com for reporting.
+0.59_11 2010-11-02
+- overwrite a given route header for any new request if there is
+ already a route information for the given context.
+ Thanks to vitspec[AT]gmail[DOT]com for reporting.
+0.59_10 2010-11-01
+- the route header in ACK must be set to the route it got by
+ record-route from the response (if any), instead of using the
+ route from the INVITE.
+ Thanks to vitspec[AT]gmail[DOT]com for reporting the bug.
+0.59_9 2010-09-09
+- bugfix rport handling by DetlefPilzecker[AT]web[DOT]de
+- clarify documentation of Net::SIP::Packet, e.g. that it die()s if
+ it cannot parse string as SIP packet
+0.59_8 2010-08-20
+- fixes to 0.59_7 from DetlefPilzecker[AT]web[DOT]de
+- added documentation for filter in Authorize
+0.59_7 2010-08-17
+- additional authorization based on idea of
+ DetlefPilzecker[AT]web[DOT]de
+0.59_6 2010-08-09
+- fix unitialized warning in Authorize if user neither in user2a1
+ nor in user2pass.
+- dispatcher: add recieved + rport to via only for requests
+- Thanks again to DetlefPilzecker[AT]web[DOT]de
+0.59_5 2010-08-09
+- fix Registrar to get the address for registration from 'To' header,
+ not 'From' header. Thanks again to DetlefPilzecker[AT]web[DOT]de
+0.59_4 2010-08-08
+- fix rport handling. Thanks again to DetlefPilzecker[AT]web[DOT]de
+0.59_3 2010-07-26
+- fix Via:..;received= handling - should by IP of sending host, not
+ of receiving leg. Moved setting it to dispatcher, and set target addr
+ from received in Statelessproxy instead of lookup for leg with this
+ addr. Thanks again to DetlefPilzecker[AT]web[DOT]de
+- added rport support to Via header (RFC 3581)
+0.59_1 2010-07-22
+- Leg: Via..received= should only contain ip, not ip:port.
+ Thanks to DetlefPilzecker[AT]web[DOT]de for pointing out. Fix
+ Leg and StatelessProxy (where it expects to get port)
0.59 2010-07-12
- Dispatcher::cancel_delivery returns true if delivery was canceled
- Blocker blocks all ACKS if all INVITE will be blocked, no mattter
Modified: trunk/libnet-sip-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/META.yml?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/META.yml (original)
+++ trunk/libnet-sip-perl/META.yml Sat Dec 4 11:15:59 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-SIP
-version: 0.59
+version: 0.60
abstract: ~
author: []
license: unknown
Modified: trunk/libnet-sip-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/changelog?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/changelog (original)
+++ trunk/libnet-sip-perl/debian/changelog Sat Dec 4 11:15:59 2010
@@ -1,3 +1,14 @@
+libnet-sip-perl (0.60-1) unstable; urgency=low
+
+ * New upstream release.
+ * debian/copyright: Refer to "Debian systems" instead of "Debian GNU/Linux
+ systems".
+ * debian/rules: Use "find -delete" instead of "find | xargs rm".
+ * Bump Standards-Version to 3.9.1.
+ * Add myself to Uploaders.
+
+ -- Ansgar Burchardt <ansgar at debian.org> Sat, 04 Dec 2010 12:14:59 +0100
+
libnet-sip-perl (0.59-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libnet-sip-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/control?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/control (original)
+++ trunk/libnet-sip-perl/debian/control Sat Dec 4 11:15:59 2010
@@ -6,8 +6,9 @@
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Damyan Ivanov <dmn at debian.org>, Rene Mayorga <rmayorga at debian.org>,
gregor herrmann <gregoa at debian.org>, MartÃn Ferrari <tincho at debian.org>,
- Jose Luis Rivas <ghostbar38 at gmail.com>, Jonathan Yu <jawnsy at cpan.org>
-Standards-Version: 3.9.0
+ Jose Luis Rivas <ghostbar38 at gmail.com>, Jonathan Yu <jawnsy at cpan.org>,
+ Ansgar Burchardt <ansgar at debian.org>
+Standards-Version: 3.9.1
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libnet-sip-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libnet-sip-perl/
Homepage: http://search.cpan.org/dist/Net-SIP/
Modified: trunk/libnet-sip-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/copyright?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/copyright (original)
+++ trunk/libnet-sip-perl/debian/copyright Sat Dec 4 11:15:59 2010
@@ -20,8 +20,8 @@
This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License, which comes with Perl.
.
- On Debian GNU/Linux systems, the complete text of the Artistic License
- can be found in `/usr/share/common-licenses/Artistic'
+ On Debian systems, the complete text of the Artistic License can be
+ found in `/usr/share/common-licenses/Artistic'.
License: GPL-1+
This program is free software; you can redistribute it and/or modify
@@ -29,5 +29,5 @@
the Free Software Foundation; either version 1, or (at your option)
any later version.
.
- On Debian GNU/Linux systems, the complete text of the GNU General
- Public License can be found in `/usr/share/common-licenses/GPL-1'
+ On Debian systems, the complete text of version 1 of the GNU General
+ Public License can be found in `/usr/share/common-licenses/GPL-1'.
Modified: trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch (original)
+++ trunk/libnet-sip-perl/debian/patches/fix-pod-spelling.patch Sat Dec 4 11:15:59 2010
@@ -5,8 +5,8 @@
Reviewed-by: gregor herrmann <gregoa at debian.org>
Last-Update: 2010-07-12
---- a/lib/Net/SIP/Endpoint.pod
-+++ b/lib/Net/SIP/Endpoint.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Endpoint.pod
++++ libnet-sip-perl/lib/Net/SIP/Endpoint.pod
@@ -133,7 +133,7 @@
=item from
@@ -16,8 +16,8 @@
=item contact
---- a/lib/Net/SIP/Leg.pod
-+++ b/lib/Net/SIP/Leg.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Leg.pod
++++ libnet-sip-perl/lib/Net/SIP/Leg.pod
@@ -111,7 +111,7 @@
ADDR is a hostname which can be prefixed by the protocol ( e.g. C<udp:host> )
and postfixed by the port ( C<host:port>, C<tcp:host:port>,... ).
@@ -27,8 +27,8 @@
it can call the method with %SPEC instead.
Right now it has now way to check if the leg can deliver to a specific
---- a/lib/Net/SIP/Request.pod
-+++ b/lib/Net/SIP/Request.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Request.pod
++++ libnet-sip-perl/lib/Net/SIP/Request.pod
@@ -77,7 +77,7 @@
Returns Net::SIP::Response packet for the received request C<$self> with
@@ -38,8 +38,8 @@
If MSG is not given (e.g. argument is missing, second argument is \%HEADER
already) a builtin message for the code will be used.
---- a/lib/Net/SIP/Simple.pod
-+++ b/lib/Net/SIP/Simple.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Simple.pod
++++ libnet-sip-perl/lib/Net/SIP/Simple.pod
@@ -67,8 +67,8 @@
\@List of legs or single leg. Leg can be an existing L<Net::SIP::Leg> (or derived)
object, an L<IO::Handle> (existing socket), a hash reference which can be used
@@ -51,8 +51,8 @@
Either B<legs> or B<outgoing_proxy> has to be provided, e.g. it needs at least one
leg.
---- a/lib/Net/SIP/Simple/Call.pod
-+++ b/lib/Net/SIP/Simple/Call.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Simple/Call.pod
++++ libnet-sip-perl/lib/Net/SIP/Simple/Call.pod
@@ -159,7 +159,7 @@
=item ...
Modified: trunk/libnet-sip-perl/debian/patches/pod2man_item.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/patches/pod2man_item.patch?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/patches/pod2man_item.patch (original)
+++ trunk/libnet-sip-perl/debian/patches/pod2man_item.patch Sat Dec 4 11:15:59 2010
@@ -3,8 +3,8 @@
Author: gregor herrmann <gregoa at debian.org>
Last-Update: 2010-07-12
---- a/lib/Net/SIP/Debug.pod
-+++ b/lib/Net/SIP/Debug.pod
+--- libnet-sip-perl.orig/lib/Net/SIP/Debug.pod
++++ libnet-sip-perl/lib/Net/SIP/Debug.pod
@@ -23,27 +23,27 @@
=over 4
Modified: trunk/libnet-sip-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/rules?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/rules (original)
+++ trunk/libnet-sip-perl/debian/rules Sat Dec 4 11:15:59 2010
@@ -8,4 +8,4 @@
override_dh_auto_install:
dh_auto_install
- find $(TMP)/usr/share/perl5 -name "*.pod" | xargs rm
+ find $(TMP)/usr/share/perl5 -name "*.pod" -delete
Modified: trunk/libnet-sip-perl/lib/Net/SIP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP.pm Sat Dec 4 11:15:59 2010
@@ -4,7 +4,7 @@
require 5.008;
package Net::SIP;
-our $VERSION = '0.59';
+our $VERSION = '0.60';
# this includes nearly everything else
use Net::SIP::Simple ();
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm Sat Dec 4 11:15:59 2010
@@ -13,7 +13,7 @@
use Net::SIP::Debug;
use Net::SIP::Util ':all';
use Digest::MD5 'md5_hex';
-use fields qw( realm opaque user2pass user2a1 i_am_proxy dispatcher );
+use fields qw( realm opaque user2pass user2a1 i_am_proxy dispatcher filter );
###########################################################################
# creates new Authorize object
@@ -24,6 +24,19 @@
# password if given username
# dispatcher: Dispatcher object
# i_am_proxy: true if should send Proxy-Authenticate, not WWW-Authenticate
+# filter: hashref with extra verification chain, see packages below.
+# Usage:
+# filter => {
+# # filter chain for registration
+# REGISTER => [
+# # all of this three must succeed (user can regist himself)
+# [ 'ToIsFrom','FromIsRealm','FromIsAuthUser' ],
+# # or this must succeed
+# \&call_back, # callback. If arrayref you MUST set [ \&call_back ]
+# ]
+# # filter chain for invites
+# INVITE => 'FromIsRealm',
+# }
# Returns: $self
###########################################################################
sub new {
@@ -38,6 +51,36 @@
$self->{user2a1} = $args{user2a1};
$self->{i_am_proxy} = $args{i_am_proxy};
$self->{dispatcher} = $args{dispatcher} || croak 'no dispatcher';
+
+ if ( my $f = $args{filter}) {
+ croak 'filter must be hashref' if ref($f) ne 'HASH';
+ my %filter;
+ while (my($method,$chain) = each %$f) {
+ $chain = [ $chain ] if ref($chain) ne 'ARRAY';
+ map { $_ = [$_] if ref($_) ne 'ARRAY' } @$chain;
+ # now we have:
+ # method => [[ cb00,cb01,cb02,..],[ cb10,cb11,cb12,..],...]
+ # where either the cb0* chain or the cb1* chain or the cbX* has to succeed
+ for my $or (@$chain) {
+ for (@$or) {
+ if (ref($_)) {
+ # assume callback
+ } else {
+ # must have authorize class with verify method
+ my $pkg = __PACKAGE__."::$_";
+ my $sub = UNIVERSAL::can($pkg,'verify') || do {
+ # load package
+ eval "require $pkg";
+ UNIVERSAL::can($pkg,'verify')
+ } or die "cannot find sub ${pkg}::verify";
+ $_ = $sub;
+ }
+ }
+ }
+ $filter{uc($method)} = $chain;
+ }
+ $self->{filter} = \%filter;
+ }
return $self;
}
@@ -122,6 +165,8 @@
last if ! defined $pass;
$a1_hex = md5_hex(join( ':',$user,$realm,$pass ));
}
+
+ last if ! defined $a1_hex; # not in user2a1 || user2pass
# ACK just reuse the authorization from INVITE, so they should
# be checked against method INVITE
@@ -154,7 +199,21 @@
}
if ( $resp eq $want_response ) {
- $authorized = 1;
+ if ($self->{filter} and my $or = $self->{filter}{$method}) {
+ for my $and (@$or) {
+ $authorized = 1;
+ for my $cb (@$and) {
+ if ( ! invoke_callback(
+ $cb,$packet,$leg,$addr,$user,$realm)) {
+ $authorized = 0;
+ last;
+ }
+ }
+ last if $authorized;
+ }
+ } else {
+ $authorized = 1;
+ }
last;
}
}
@@ -200,4 +259,62 @@
return $acode;
}
+###########################################################################
+# additional verifications
+# Net::SIP::Authorize::FromIsRealm - checks if the domain in 'From' is
+# the same as the realm in 'Authorization'
+# Net::SIP::Authorize::FromIsAuthUser - checks if the user in 'From' is
+# the same as the username in 'Authorization'
+# Net::SIP::Authorize::ToIsFrom - checks if 'To' and 'From' are equal
+#
+# Args each: ($packet,$leg,$addr,$auth_user,$auth_realm)
+# $packet: Net::SIP::Request
+# $leg: Net::SIP::Leg where request came in (and response gets send out)
+# $addr: ip:port where request came from and response will be send
+# $auth_user: username from 'Authorization'
+# $auth_realm: realm from 'Authorization'
+# Returns: TRUE (1) | FALSE (0)
+###########################################################################
+
+package Net::SIP::Authorize::FromIsRealm;
+use Net::SIP::Util qw( sip_hdrval2parts sip_uri2parts );
+use Net::SIP::Debug;
+sub verify {
+ my ($packet,$leg,$addr,$auth_user,$auth_realm) = @_;
+ my $from = $packet->get_header('from');
+ ($from) = sip_hdrval2parts( from => $from );
+ my ($domain) = sip_uri2parts($from);
+ return 1 if lc($domain) eq lc($auth_realm); # exact domain
+ return 1 if $domain =~m{\.\Q$auth_realm\E$}i; # subdomain
+ DEBUG( 10, "No Auth-success: From-domain is '$domain' and realm is '$auth_realm'" );
+ return 0;
+}
+
+package Net::SIP::Authorize::FromIsAuthUser;
+use Net::SIP::Util qw( sip_hdrval2parts sip_uri2parts );
+use Net::SIP::Debug;
+sub verify {
+ my ($packet,$leg,$addr,$auth_user,$auth_realm) = @_;
+ my $from = $packet->get_header('from');
+ ($from) = sip_hdrval2parts( from => $from );
+ my (undef,$user) = sip_uri2parts($from);
+ return 1 if lc($user) eq lc($auth_user);
+ DEBUG( 10, "No Auth-success: From-user is '$user' and auth_user is '$auth_user'" );
+ return 0;
+}
+
+package Net::SIP::Authorize::ToIsFrom;
+use Net::SIP::Util qw( sip_hdrval2parts );
+use Net::SIP::Debug;
+sub verify {
+ my ($packet,$leg,$addr,$auth_user,$auth_realm) = @_;
+ my $from = $packet->get_header('from');
+ ($from) = sip_hdrval2parts( from => $from );
+ my $to = $packet->get_header('to');
+ ($to) = sip_hdrval2parts( to => $to );
+ return 1 if lc($from) eq lc($to);
+ DEBUG( 10, "No Auth-success: To is '$to' and From is '$from'" );
+ return 0;
+}
+
1;
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pod Sat Dec 4 11:15:59 2010
@@ -66,6 +66,61 @@
(e.g. L<Net::SIP::Endpoint>, L<Net::SIP::Registrar>) which sends
C<WWW-Authenticate>.
+=item filter
+
+Additional filter for authorization, e.g. if authorization based on
+username and passwort succeeded it might still fail because of these
+filters. Filter is a hash with the method as key.
+
+The value can be an additional authorization (in which case it
+must succeed), a list of authorizations (all of them must succeed),
+or a list with a list of authorizations (at least one of the inner
+lists must succeed).
+
+The additional authorization can be a name of a L<Net::SIP::Authorize>
+subclass (e.g. C<ToIsFrom> means C<Net::SIP::Authorize::ToIsFrom>)
+which has a C<verify> function or a C<[\&callback]>.
+
+The verify function or callback will be called with
+C<($packet,$leg,$addr,$auth_user,$auth_realm)> where C<$packet> is
+the request, C<$leg> the L<Net::SIP::Leg> object where the packet
+came in, C<$addr> the senders address, C<$auth_user> the
+username from the authorized user and C<$auth_realm> the realm
+which was used for authorization.
+Success for verification means that the function must return true.
+
+The following authorization subclasses are defined:
+
+=over 4
+
+=item FromIsRealm
+
+Succeeds if the senders domain is the realm or a subdomain of the realm.
+
+=item FromIsAuthUser
+
+Succeeds if the username of the sender equals the username used for
+authorization.
+
+=item ToIsFrom
+
+Succeeds if To header equals From header. This can be used to make sure, that a
+user can only call REGISTER for itself.
+
+=back
+
+Example:
+
+ filter => {
+ REGISTER => [
+ # all of these must succeed
+ [ 'ToIsFrom','FromIsRealm','FromIsAuthUser' ],
+ # or this
+ [ \&callback ],
+ ],
+ INVITE => 'FromIsRealm',
+ }
+
=back
=back
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod Sat Dec 4 11:15:59 2010
@@ -6,12 +6,12 @@
=head1 SYNOPSIS
my $block = Net::SIP::Blocker->new(
- block => { 'SUBSCRIBE' => 405, '...' => ... },
- dispatcher => $disp,
+ block => { 'SUBSCRIBE' => 405, '...' => ... },
+ dispatcher => $disp,
);
my $chain = Net::SIP::ReceiveChain->new(
- [ $block, ... ]
+ [ $block, ... ]
);
=head1 DESCRIPTION
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm Sat Dec 4 11:15:59 2010
@@ -187,8 +187,35 @@
return;
};
+ if ($packet->is_request) {
+ # add received and rport to top via
+ $packet->scan_header( via => [ sub {
+ my ($vref,$hdr) = @_;
+ return if $$vref++;
+ my ($d,$h) = sip_hdrval2parts(via => $hdr->{value});
+ # FIXME: not IPv6 save
+ my ($host,$port) = $d =~m{^\S+\s+(\S+?)(?::(\d+))?$};
+ my ($addr,$rport) = $from =~m{^(\S+)(?::(\d+))$};
+ my %nh;
+ if ( exists $h->{rport} and ! defined $h->{rport}) {
+ $nh{rport} = $rport;
+ }
+ if ( $host ne $addr or $nh{rport}) {
+ # either hostname or different IP or required because
+ # rport was set
+ $nh{received} = $addr;
+ }
+ if (%nh) {
+ $hdr->{value} = sip_parts2hdrval('via',$d,{ %$h,%nh});
+ $hdr->set_modified;
+ }
+ }, \( my $cvia )]);
+ }
+
# handle received packet
$self->receive( $packet,$leg,$from );
+
+
};
if ($@) {
DEBUG(1,"dispatcher croaked: $@");
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm Sat Dec 4 11:15:59 2010
@@ -54,7 +54,7 @@
# @args: either single \%args (hash-ref) or %args (hash) with at least
# values for from and to
# callid,cseq will be generated if not given
-# routes will default to [] and usually set from record-route header
+# routes will default to undef and usually set from record-route header
# in response packets
# Returns: $self
############################################################################
@@ -65,7 +65,6 @@
%$self = %args;
$self->{callid} ||= md5_hex( time(), rand(2**32) );
$self->{cseq} ||= 0;
- $self->{route} ||= [];
$self->{_transactions} = [];
$self->{_cseq_incoming} = 0;
@@ -159,6 +158,7 @@
# already a request object
$request = $method;
$method = $request->method;
+
} else {
# increase cseq unless its explicitly specified
@@ -187,15 +187,17 @@
from => $from,
to => $to,
$self->{contact} ? ( contact => $self->{contact} ):(),
- route => $self->{route},
cseq => "$cseq $method",
'call-id' => $self->{callid},
'max-forwards' => 70,
- %args
+ %args,
},
$body
- )
- }
+ );
+ }
+
+ # overwrite any route header in request if we already learned a route
+ $request->set_header( route => $self->{route} ) if $self->{route};
# create new transaction
my %trans = (
@@ -417,7 +419,7 @@
} elsif ( $code == 305 ) {
# 21.3.4 305 use proxy
# set proxy as the first route and insert request again
- my $route = $self->{route};
+ my $route = $self->{route} ||= [];
unshift @$route,$response->get_header( 'contact' );
( my $r = $tr->{request} )->set_header( route => $route );
$r->set_cseq( ++$self->{cseq} );
@@ -489,7 +491,9 @@
my @arg = ($endpoint,$self);
# extract route information for future requests to the UAC (re-invites)
- if ( my @route = $request->get_header( 'record-route' )) {
+ # only for INVITE (rfc3261,12.1.1)
+ if ( $method eq 'INVITE' and
+ my @route = $request->get_header( 'record-route' )) {
$self->{route} = \@route;
}
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm Sat Dec 4 11:15:59 2010
@@ -129,19 +129,6 @@
return [ undef,'max-forwards reached 0, dropping' ];
}
$packet->set_header( 'max-forwards',$maxf );
-
- # add received to top via
- my $via;
- $packet->scan_header( via => [ sub {
- my ($vref,$hdr) = @_;
- if ( !$$vref ) {
- # XXXXXXX maybe check that no received header existed before
- $$vref = $hdr->{value}.=
- ";received=$self->{addr}:$self->{port}";
- $hdr->set_modified;
- }
- }, \$via ]);
-
# check if last hop was strict router
# remove myself from route
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Packet.pod Sat Dec 4 11:15:59 2010
@@ -6,7 +6,8 @@
=head1 SYNOPSIS
use Net::SIP::Packet;
- my $pkt = Net::SIP::Packet->new( $sip_string );
+ my $pkt = eval { Net::SIP::Packet->new( $sip_string ) }
+ or die "invalid SIP packet";
$pkt->get_header( 'call-id' ) || die "no call-id";
$pkt->set_header( via => \@via );
print $pkt->as_string;
@@ -67,6 +68,7 @@
Interprets STRING as a SIP request or response and creates L<Net::SIP::Request>
or L<Net::SIP::Response> object accordingly.
+Will die() if it cannot parse the string as a SIP packet.
=item new_from_parts ( CODE|METHOD, TEXT|URI, \%HEADER|\@HEADER, [ BODY ] )
@@ -88,7 +90,7 @@
The order of the fields in the resulting SIP packet will be the same as in
the array.
-The BODY is optinal and can be given either as a string or as an reference to an
+The BODY is optional and can be given either as a string or as an reference to an
object which has a method B<as_string>, like L<Net::SIP::SDP>. If the BODY is an
object which has a method B<content_type> it will set the C<content-type> header
of the SIP object based on the result of C<< BODY->content_type >> unless a
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pm Sat Dec 4 11:15:59 2010
@@ -83,21 +83,21 @@
return; # propagate to next in chain
}
- my $from = $packet->get_header( 'from' ) or do {
- DEBUG( 1,"no from in register request. DROP" );
+ my $to = $packet->get_header( 'to' ) or do {
+ DEBUG( 1,"no to in register request. DROP" );
return;
};
# what address will be registered
- ($from) = sip_hdrval2parts( from => $from );
- if ( my ($domain,$user,$proto) = sip_uri2parts( $from ) ) {
+ ($to) = sip_hdrval2parts( to => $to );
+ if ( my ($domain,$user,$proto) = sip_uri2parts( $to ) ) {
# normalize if possible
- $from = "$proto:$user\@$domain";
+ $to = "$proto:$user\@$domain";
}
# check if domain is allowed
if ( my $rd = $self->{domains} ) {
- my ($domain) = $from =~m{\@([\w\-\.]+)};
+ my ($domain) = $to =~m{\@([\w\-\.]+)};
if ( ! first { $domain =~m{\.?\Q$_\E$}i || $_ eq '*' } @$rd ) {
DEBUG( 1, "$domain matches none of my own domains. DROP" );
return;
@@ -135,7 +135,7 @@
$curr{$c_addr} = $expire;
}
- $self->{store}{ $from } = \%curr;
+ $self->{store}{ $to } = \%curr;
# expire now!
$self->expire();
@@ -179,8 +179,8 @@
my $now = $loop->looptime;
my $store = $self->{store};
- my (@drop_from,$next_exp);
- while ( my ($from,$contact) = each %$store ) {
+ my (@drop_addr,$next_exp);
+ while ( my ($addr,$contact) = each %$store ) {
my @drop_where;
while ( my ($where,$expire) = each %$contact ) {
if ( $expire<$now ) {
@@ -191,10 +191,10 @@
}
if ( @drop_where ) {
delete @{$contact}{ @drop_where };
- push @drop_from,$from if !%$contact;
- }
- }
- delete @{$store}{ @drop_from } if @drop_from;
+ push @drop_addr,$addr if !%$contact;
+ }
+ }
+ delete @{$store}{ @drop_addr } if @drop_addr;
# add timer for next expire
if ( $next_exp ) {
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Registrar.pod Sat Dec 4 11:15:59 2010
@@ -17,6 +17,10 @@
This package implements a simple SIP registrar. In the current implementation
registry information are only kept in memory, e.g. they are not preserved over
restarts.
+
+The implementation itself does not checking if the UAC is authorized to
+register the given address. This can be done with using an appropriate
+Authorize Module inside a ReceiveChain in front of the registrar.
=head1 CONSTRUCTOR
Modified: trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/StatelessProxy.pm Sat Dec 4 11:15:59 2010
@@ -159,10 +159,11 @@
my ($addr,$port) = $first =~m{([\w\-\.]+)(?::(\d+))?\s*$};
$port ||= 5060; # FIXME default for sip, not sips!
$addr = $param->{maddr} if $param->{maddr};
+ $addr = $param->{received} if $param->{received}; # where it came from
+ $port = $param->{rport} if $param->{rport}; # where it came from
@{ $entry->{dst_addr}} = ( "$addr:$port" );
DEBUG( 50,"get dst_addr from via header: $first -> $addr:$port" );
- $entry->{via_received} = $param->{received};
if ( $addr !~m{^[0-9\.]+$} ) {
$self->{dispatcher}->dns_host2ip(
$addr,
@@ -176,8 +177,6 @@
###########################################################################
# 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.
# Calls __forward_packet_final at the end to deliver packet
###########################################################################
sub __forward_response_1 {
@@ -191,29 +190,6 @@
}
# replace host part in dst_addr with ip
$entry->{dst_addr}[0] =~s{^(udp:|tcp:)?([^:]+)}{$1$ip};
- }
-
- if ( my $received = $entry->{via_received} ) {
- # FIXME: we assume that the received entry is done by us
- # and that we only put IP addresses inside
- my ($addr,$port) = split( ':',$received,2 );
- my @received_legs = $self->{dispatcher}->get_legs(
- addr => $addr, port => $port );
- my $dst_addr = $entry->{dst_addr};
- my @legs;
- foreach my $addr (@$dst_addr) {
- push @legs, grep { $_->can_deliver_to( $addr ) } @received_legs;
- }
-
- if ( !@legs ) {
- # FIXME: should we really drop packet if we don't have the specified leg?
- # or should we use any leg which could deliver to $dst_addr
- DEBUG( 10,"cannot find leg for $received which can deliver to $dst_addr" );
- return;
- }
-
- @{ $entry->{outgoing_leg} } = @legs;
- DEBUG( 50,"getting leg from received=$received" );
}
__forward_packet_final( $self,$entry );
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Util.pm?rev=65513&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Util.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Util.pm Sat Dec 4 11:15:59 2010
@@ -130,8 +130,9 @@
}
my $val = $data; # FIXME: need to escape $data?
- while ( my ($k,$v) = each %$param ) {
+ for my $k ( sort keys %$param ) {
$val .= $delim.$k;
+ my $v = $param->{$k};
if ( defined $v ) {
# escape special chars
$v =~s{([%\r\n\t"[:^print:]])}{ sprintf "%%%02x",ord($1) }sg;
More information about the Pkg-perl-cvs-commits
mailing list