r65511 - in /branches/upstream/libnet-sip-perl/current: ./ lib/Net/ lib/Net/SIP/ lib/Net/SIP/Endpoint/
ansgar at users.alioth.debian.org
ansgar at users.alioth.debian.org
Sat Dec 4 10:48:07 UTC 2010
Author: ansgar
Date: Sat Dec 4 10:48:02 2010
New Revision: 65511
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=65511
Log:
[svn-upgrade] new version libnet-sip-perl (0.60)
Modified:
branches/upstream/libnet-sip-perl/current/Changes
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/Authorize.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pod
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Blocker.pod
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Dispatcher.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Endpoint/Context.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Leg.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pod
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/StatelessProxy.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Util.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=65511&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/Changes (original)
+++ branches/upstream/libnet-sip-perl/current/Changes Sat Dec 4 10:48:02 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: 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=65511&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/META.yml (original)
+++ branches/upstream/libnet-sip-perl/current/META.yml Sat Dec 4 10:48:02 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-SIP
-version: 0.59
+version: 0.60
abstract: ~
author: []
license: unknown
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=65511&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm Sat Dec 4 10:48:02 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pm?rev=65511&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pm Sat Dec 4 10:48:02 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pod?rev=65511&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pod (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Authorize.pod Sat Dec 4 10:48:02 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Blocker.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Blocker.pod?rev=65511&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Blocker.pod (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Blocker.pod Sat Dec 4 10:48:02 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: 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=65511&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 Sat Dec 4 10:48:02 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: 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=65511&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 Sat Dec 4 10:48:02 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: 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=65511&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 Sat Dec 4 10:48:02 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pod?rev=65511&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pod (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Packet.pod Sat Dec 4 10:48:02 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pm?rev=65511&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pm Sat Dec 4 10:48:02 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: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod?rev=65511&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pod Sat Dec 4 10:48:02 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: 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=65511&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 Sat Dec 4 10:48:02 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: 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=65511&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 Sat Dec 4 10:48:02 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