r60253 - in /trunk/libnet-sip-perl: ./ debian/ lib/Net/ lib/Net/SIP/ lib/Net/SIP/Endpoint/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Mon Jul 12 15:30:16 UTC 2010
Author: gregoa
Date: Mon Jul 12 15:29:54 2010
New Revision: 60253
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=60253
Log:
New upstream release.
Added:
trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pm
- copied unchanged from r60252, branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Blocker.pm
trunk/libnet-sip-perl/lib/Net/SIP/Blocker.pod
- copied unchanged from r60252, branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Blocker.pod
trunk/libnet-sip-perl/t/15_block_invite.t
- copied unchanged from r60252, branches/upstream/libnet-sip-perl/current/t/15_block_invite.t
Modified:
trunk/libnet-sip-perl/Changes
trunk/libnet-sip-perl/MANIFEST
trunk/libnet-sip-perl/META.yml
trunk/libnet-sip-perl/THANKS
trunk/libnet-sip-perl/TODO
trunk/libnet-sip-perl/debian/changelog
trunk/libnet-sip-perl/lib/Net/SIP.pm
trunk/libnet-sip-perl/lib/Net/SIP.pod
trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm
trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm
trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pod
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/ReceiveChain.pm
trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pm
trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pod
trunk/libnet-sip-perl/lib/Net/SIP/Request.pm
trunk/libnet-sip-perl/lib/Net/SIP/Request.pod
trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm
Modified: trunk/libnet-sip-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/Changes?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/Changes (original)
+++ trunk/libnet-sip-perl/Changes Mon Jul 12 15:29:54 2010
@@ -1,4 +1,53 @@
Revision history for Net::SIP
+
+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
+ if the response is in delivery queue. Thanks to
+ DetlefPilzecker[AT]web[DOT]de
+0.58_11 2010-07-09
+- fix for Blocker + test from DetlefPilzecker[AT]web[DOT]de
+0.58_10 2010-06-24
+- if qop=auth,auth-int given respond with qop=auth
+0.58_9 2010-06-24
+- Endpoint::Context::request_delivery_done - do not remove
+ transaction, because in case of tcp delivery done will be called
+ once request is send. transaction will be removed in handle_response
+ already
+0.58_8 2010-06-24
+- Request::authorize - accept qop="auth,auth-int".., e.g. es long
+ auth is specifified its ok. Based on Bug report from
+ alain[AT]knaff[DOT]lu
+0.58_7 2010-06-11
+- removed unused field outgoing_leg from Net::SIP::Dispatcher.
+ Thanks to DetlefPilzecker[AT]web[DOT]de for pointing this out
+0.58_6 2010-06-02
+- fixes on Authorize.pm based on reports from
+ DetlefPilzecker[AT]web[DOT]de:
+ - cancel_delivery in Authorize on ACK
+0.58_4 2010-05-31
+- fixes on Redirect.pm based on reports from
+ DetlefPilzecker[AT]web[DOT]de:
+ - respond 200 to CANCEL
+ - redirect everything except REGISTER, not only INVITE
+0.58_3 2010-05-31
+Based on patches from DetlefPilzecker[AT]web[DOT]de
+- Net::SIP::Request::create_response - msg is optional, if not given
+ a builtin msg for the code will be used.
+- new functionality: Net::SIP::Blocker provides way to block requests
+ by method name with custom code
+0.58_2 2010-05-31
+- fix Net::SIP::Simple::register, so that it uses an explicitly
+ given contact unchanged. Bug report by
+ stefano[DOT]pisani[AT]omnianet[DOT]it
+0.58_1 2010-05-28
+various fixes based on feedback and patches from
+DetlefPilzecker[AT]web[DOT]de
+- check authorization for CANCEL not only against INVITE:uri but also
+ against CANCEL:uri. The RFC is not specific in this area
+- Authorize: don't forward unauthorized ACKs
+- ReceiveChain: filter callback need not to be code ref, especially
+ if methods arg was used. Now called with invoke_callback instead
0.58 2010-04-15
- with 'perl -MNet::SIP=rtp:min-max' the ports to used for RTP can be
Modified: trunk/libnet-sip-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/MANIFEST?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/MANIFEST (original)
+++ trunk/libnet-sip-perl/MANIFEST Mon Jul 12 15:29:54 2010
@@ -38,6 +38,8 @@
lib/Net/SIP/Registrar.pod
lib/Net/SIP/StatelessProxy.pm
lib/Net/SIP/StatelessProxy.pod
+lib/Net/SIP/Blocker.pm
+lib/Net/SIP/Blocker.pod
lib/Net/SIP/ReceiveChain.pm
lib/Net/SIP/ReceiveChain.pod
lib/Net/SIP/Authorize.pm
@@ -70,6 +72,7 @@
t/12_maddr.t
t/13_maddr_proxy.t
t/14_bugfix_0.51.t
+t/15_block_invite.t
t/testlib.pl
samples/README
samples/invite_and_recv.pl
Modified: trunk/libnet-sip-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/META.yml?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/META.yml (original)
+++ trunk/libnet-sip-perl/META.yml Mon Jul 12 15:29:54 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-SIP
-version: 0.58
+version: 0.59
abstract: ~
author: []
license: unknown
@@ -15,7 +15,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.54
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: trunk/libnet-sip-perl/THANKS
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/THANKS?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/THANKS (original)
+++ trunk/libnet-sip-perl/THANKS Mon Jul 12 15:29:54 2010
@@ -13,3 +13,4 @@
Roland Mas <lolando[AT]debian[DOT]org>
Alex Revetski <revetski[AT]gmail[DOT]com>
Gilad Novik gilad[AT]summit-tech[DOT]ca
+DetlefPilzecker[AT]web[DOT]de
Modified: trunk/libnet-sip-perl/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/TODO?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/TODO (original)
+++ trunk/libnet-sip-perl/TODO Mon Jul 12 15:29:54 2010
@@ -1,29 +1,12 @@
-PrioA:
-* document dns_host2ip and dns_domain2srv in Net::SIP::Dispatcher
+
+- Redirect only specific domains, ignore rest so that it can be
+ chained with proxy for the rest
+- document dns_host2ip and dns_domain2srv in Net::SIP::Dispatcher
and make it truly asnychronous
-* do not look up tcp in Dispatcher::resolve_uri if we have no leg
+- do not look up tcp in Dispatcher::resolve_uri if we have no leg
which can do tcp
-
------
-
- more tests
- * invite + listen using proxy + registrar
- * call-on-hold ( c=0.0.0.0 in SDP )
- * use sdp_on_ack, asymetric_rtp in tests
- * tests using re-invites (from UAC and from UAS)
- * tests, where either the UAC or the UAS issues a BYE
- * tests with bad relay in between, which forgets
- packets, so that retransmits will be tested
- * proxy with NAT where SDP data come in
- * 18x + 2xx + INVITE
- * 2xx + ACK
- * tests for delivering packets using Net::SIP::Dispatcher:resolve_uri
- * tests for forwarding packets in stateless proxy
- based on route, via, uri,...
- * tests for samples/ and bin/
-
- more documentation
* samples for integration with other loops
-
- implementation
* full support for TCP
Modified: trunk/libnet-sip-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/debian/changelog?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/debian/changelog (original)
+++ trunk/libnet-sip-perl/debian/changelog Mon Jul 12 15:29:54 2010
@@ -1,3 +1,9 @@
+libnet-sip-perl (0.59-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Mon, 12 Jul 2010 17:28:22 +0200
+
libnet-sip-perl (0.58-1) unstable; urgency=low
* New upstream release.
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=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP.pm Mon Jul 12 15:29:54 2010
@@ -4,7 +4,7 @@
require 5.008;
package Net::SIP;
-our $VERSION = '0.58';
+our $VERSION = '0.59';
# this includes nearly everything else
use Net::SIP::Simple ();
@@ -33,6 +33,7 @@
Net::SIP::Redirect
Net::SIP::Registrar
Net::SIP::StatelessProxy
+ Net::SIP::Blocker
Net::SIP::ReceiveChain
Net::SIP::Authorize
Net::SIP::Endpoint
Modified: trunk/libnet-sip-perl/lib/Net/SIP.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP.pod?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP.pod Mon Jul 12 15:29:54 2010
@@ -103,6 +103,25 @@
probably be implemented by putting multiple L<Net::SIP::Endpoint>s
together.
+=item L<Net::SIP::Blocker>
+
+Can block requests by method name with custom error code.
+
+=item L<Net::SIP::ReceiveChain>
+
+Can contain various objects for processing objects. Useful
+in connection with L<Net::SIP::Authorize>.
+
+=item L<Net::SIP::Redirect>
+
+Works together with a registrar and redirects requests.
+
+=item L<Net::SIP::Authorize>
+
+If put into a L<Net::SIP::ReceiveChain> it requests and checks
+authorization and gives only authorized requests to the next
+member of the chain.
+
=back
=head2 Simplified Layer for common tasks
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=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Authorize.pm Mon Jul 12 15:29:54 2010
@@ -101,12 +101,6 @@
next;
};
- # ACK|CANCEL just reuse the authorization from INVITE, so they should
- # be checked against method INVITE
- my $a2 = join( ':',
- ( $method eq 'ACK' || $method eq 'CANCEL' ) ? 'INVITE' : $method,
- $uri );
-
# we support with and w/o qop
# get a1_hex from either user2a1 or user2pass
my $a1_hex;
@@ -129,35 +123,47 @@
$a1_hex = md5_hex(join( ':',$user,$realm,$pass ));
}
- my $want_response;
- if ( $qop ) {
- # 3.2.2.1
- $want_response = md5_hex( join( ':',
- $a1_hex,
- $nonce,
- 1,
- $cnonce,
- $qop,
- md5_hex($a2)
- ));
- } else {
- # 3.2.2.1 compability with RFC2069
- $want_response = md5_hex( join( ':',
- $a1_hex,
- $nonce,
- md5_hex($a2)
- ));
- }
-
- if ( $resp eq $want_response ) {
- $authorized = 1;
+ # ACK just reuse the authorization from INVITE, so they should
+ # be checked against method INVITE
+ # for CANCEL the RFC doesn't say anything, so we assume it uses
+ # CANCEL but try INVITE if this fails
+ my @a2 =
+ $method eq 'ACK' ? ("INVITE:$uri") :
+ $method eq 'CANCEL' ? ("CANCEL:$uri","INVITE:$uri") :
+ ("$method:$uri");
+
+ while (my $a2 = shift(@a2)) {
+ my $want_response;
+ if ( $qop ) {
+ # 3.2.2.1
+ $want_response = md5_hex( join( ':',
+ $a1_hex,
+ $nonce,
+ 1,
+ $cnonce,
+ $qop,
+ md5_hex($a2)
+ ));
+ } else {
+ # 3.2.2.1 compability with RFC2069
+ $want_response = md5_hex( join( ':',
+ $a1_hex,
+ $nonce,
+ md5_hex($a2)
+ ));
+ }
+
+ if ( $resp eq $want_response ) {
+ $authorized = 1;
+ last;
+ }
}
}
# if authorized remove authorization data from this realm
# and pass packet thru
if ( $authorized ) {
- DEBUG( 10, "Request authorized". $packet->dump );
+ DEBUG( 10, "Request authorized ". $packet->dump );
# set header again
$packet->set_header( $rq_key => \@keep_auth );
return;
@@ -165,13 +171,14 @@
# CANCEL or ACK cannot be prompted for authorization, so
# they should provide the right data already
- return $acode if $method eq 'CANCEL'; # unauthorized CANCEL
- if ( $method eq 'ACK' ) {
- # in case the ACK just acks that UAC received response
- # we accept it w/o authorization
- # but if it contains a (SDP) body we better need authorization
- return $acode if ($packet->as_parts)[3];
- return; # no body
+ # unauthorized CANCEL or ACK are only valid as response to
+ # 401/407 from this Authorize, so they should not be propagated
+ if ($method eq 'ACK') {
+ # cancel delivery of response to INVITE
+ $self->{dispatcher}->cancel_delivery( $packet->tid );
+ return $acode;
+ } elsif ($method eq 'CANCEL') {
+ return $acode;
}
# not authorized yet, ask to authenticate
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=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pm Mon Jul 12 15:29:54 2010
@@ -21,7 +21,6 @@
'domain2proxy', # optional mapping between SIP domains and proxies (otherwise use DNS)
# internals
'do_retransmits', # flag if retransmits will be done (false for stateless proxy)
- 'outgoing_leg', # Leg for outgoing_proxy
'queue', # \@list of outstanding Net::SIP::Dispatcher::Packet
'response_cache', # Cache of responses, used to reply to retransmits
'disp_expire', # expire/retransmit timer
@@ -84,7 +83,6 @@
legs => [],
queue => [],
outgoing_proxy => undef,
- outgoing_leg => undef,
response_cache => {},
do_retransmits => defined( $do_retransmits ) ? $do_retransmits : 1,
eventloop => $eventloop,
@@ -97,7 +95,6 @@
my $leg = $self->_find_leg4addr( $outgoing_proxy )
|| die "cannot find leg for destination $outgoing_proxy";
$self->{outgoing_proxy} = $outgoing_proxy;
- $self->{outgoing_leg} = $leg;
}
@@ -325,7 +322,7 @@
# $typ: what to cancel, e.g. 'id','callid' or 'qentry', optional,
# defaults to 'id' if $id is not ref or 'qentry' if $id is ref
# $id: id to cancel, can also be queue entry
-# Returns: NONE
+# Returns: bool, true if the was something canceled
###########################################################################
sub cancel_delivery {
my Net::SIP::Dispatcher $self = shift;
@@ -346,6 +343,7 @@
}
}
my $q = $self->{queue};
+ my $qn = @$q;
if ( $qentry ) {
# it's a *::Dispatcher::Packet
DEBUG( 100,"cancel packet id: $qentry->{id}" );
@@ -361,6 +359,7 @@
} else {
croak( "cancel_delivery w/o id" );
}
+ return @$q < $qn; # true if items got deleted
}
@@ -992,7 +991,7 @@
my Net::SIP::Dispatcher::Packet $self = shift;
my $error = shift;
my $cb = $self->{callback} || return;
- invoke_callback( $cb, $error ? ($error,$self):() );
+ invoke_callback( $cb,$error,$self);
return 1;
}
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pod?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Dispatcher.pod Mon Jul 12 15:29:54 2010
@@ -280,9 +280,12 @@
If TYP given packets can be canceled by something else. TYP can be
C<callid>, in which case all deliveries for a specific call will be
canceled. It can be C<id> which will cancel the packet with id ID.
-Or itcan be C<qentry> in which case ID will be interpreted as
+Or it can be C<qentry> in which case ID will be interpreted as
the L<Net::SIP::Dispatcher::Packet> object in the queue and it will
cancel this packet.
+
+Will return true if the item was canceled, false if no such item
+was found in delivery queue.
=item receive ( PACKET, LEG, FROM )
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=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Endpoint/Context.pm Mon Jul 12 15:29:54 2010
@@ -169,7 +169,7 @@
$method = uc($method);
my $uri = delete $args{uri};
- my ($to,$from) = $self->{incoming} ? ($self->{from},$self->{to})
+ my ($to,$from) = $self->{incoming} ? ($self->{from},$self->{to})
: ($self->{to},$self->{from});
if ( !$uri ) {
($uri) = sip_hdrval2parts( to => $self->{remote_contact}||$to);
@@ -234,12 +234,14 @@
sub request_delivery_done {
my Net::SIP::Endpoint::Context $self = shift;
my ($endpoint,$tid,$error) = @_;
+ return if ! $error; # notify of success once I get response
+
my $trans = $self->{_transactions};
my @ntrans;
foreach my $tr (@$trans) {
if ( $tr->{tid} eq $tid ) {
$self->{_transactions} = \@ntrans;
- if ( $error && ( my $cb = $tr->{callback} )) {
+ if ( my $cb = $tr->{callback} ) {
# permanently failed
invoke_callback( $cb, $self,$endpoint,$error );
}
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=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Leg.pm Mon Jul 12 15:29:54 2010
@@ -263,7 +263,7 @@
# $addr: ip:port where to deliver
# $callback: optional callback, if an error occured the callback will
# be called with $! as argument. If no error occured and the
-# proto is tcp the callback will be called with ENOERR to show
+# proto is tcp the callback will be called with error=0 to show
# that the packet was definitly delivered (and need not retried)
###########################################################################
sub deliver {
@@ -376,7 +376,7 @@
return;
}
- # XXXX dont forget to call callback back with ENOERR if
+ # XXXX dont forget to call callback back with error=0 if
# delivery by tcp successful
return 1;
}
Modified: trunk/libnet-sip-perl/lib/Net/SIP/ReceiveChain.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/ReceiveChain.pm?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/ReceiveChain.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/ReceiveChain.pm Mon Jul 12 15:29:54 2010
@@ -13,8 +13,7 @@
package Net::SIP::ReceiveChain;
use fields qw( objects filter );
-use Carp 'croak';
-use Net::SIP::Debug;
+use Net::SIP::Util 'invoke_callback';
###########################################################################
# creates new ReceiveChain object
@@ -58,7 +57,7 @@
if ( my $f = $self->{filter} ) {
# check if packet should be handled by filter
- return if ! $f->($packet,$leg,$addr);
+ return if ! invoke_callback($f,$packet,$leg,$addr);
}
foreach my $object (@{ $self->{objects} }) {
my $handled = $object->receive($packet,$leg,$addr);
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pm?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pm Mon Jul 12 15:29:54 2010
@@ -25,27 +25,29 @@
my Net::SIP::Redirect $self = shift;
my ($packet,$leg,$addr) = @_;
- # accept only INVITEs
- $packet->is_request or return;
+ $packet->is_request or return; # don't handle responses
+
my $method = $packet->method;
+ my $resp;
if ( $method eq 'ACK' ) {
# if I got an ACK cancel delivery of response to INVITE
- $self->{dispatcher}->cancel_delivery( $packet->tid );
- return -1; # don't process in next part of chain
- } elsif ( $method ne 'INVITE' ) {
+ $self->{dispatcher}->cancel_delivery( $packet->tid );
+ return -1; # don't process in next part of chain
+ } elsif ( $method eq 'CANCEL' ) {
+ $resp = $packet->create_response(200);
+ } elsif ( $method eq 'REGISTER' ) {
return; # don't process myself
+ } else {
+ my $key = (sip_uri2parts($packet->uri))[3];
+ if ( my @contacts = $self->{registrar}->query($key)) {
+ $resp = $packet->create_response('302','Moved Temporarily');
+ $resp->add_header( contact => $_ ) for(@contacts);
+ } else {
+ $resp = $packet->create_response('404','Not found');
+ }
}
- my $key = (sip_uri2parts($packet->uri))[3];
- my $resp;
- if ( my @contacts = $self->{registrar}->query($key)) {
- $resp = $packet->create_response('302','Moved Temporarily');
- $resp->add_header( contact => $_ ) for(@contacts);
- } else {
- $resp = $packet->create_response('404','Not found');
- }
- $self->{dispatcher}->deliver( $resp,
- leg => $leg, dst_addr => $addr );
+ $self->{dispatcher}->deliver($resp,leg => $leg,dst_addr => $addr);
return $resp->code;
}
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pod?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Redirect.pod Mon Jul 12 15:29:54 2010
@@ -1,7 +1,7 @@
=head1 NAME
-Net::SIP::Redirect - Send redirect to INVITEs based on lookup at a registrar
+Net::SIP::Redirect - Send redirect to Requests based on lookup at a registrar
=head1 SYNOPSIS
@@ -13,7 +13,7 @@
=head1 DESCRIPTION
-This package implements a simple redirection of INVITEs using the information
+This package implements a simple redirection of Requests using the information
provided by a registrar.
=head1 CONSTRUCTOR
@@ -52,11 +52,12 @@
Called from the managing L<Net::SIP::Dispatcher> object if a new
packet arrives. Will return C<()> and ignore the packet if it's
-not an INVITE or ACK request.
+an REGISTER request.
-For INVITEs it will query the registrar and return either
+For Requests it will query the registrar and return either
C<< 302 Moved Temporarily >> with the list of contacts or
C<< 404 Not found >> if the address is not registered.
+
=back
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Request.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Request.pm?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Request.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Request.pm Mon Jul 12 15:29:54 2010
@@ -15,6 +15,70 @@
use Net::SIP::Util 'invoke_callback';
use Digest::MD5 'md5_hex';
+
+my %ResponseCode = (
+ # Informational
+ 100 => 'Trying',
+ 180 => 'Ringing',
+ 181 => 'Call Is Being Forwarded',
+ 182 => 'Queued',
+ 183 => 'Session Progress',
+
+ # Success
+ 200 => 'OK',
+
+ # Redirection
+ 300 => 'Multiple Choices',
+ 301 => 'Moved Permanently',
+ 302 => 'Moved Temporarily',
+ 305 => 'Use Proxy',
+ 380 => 'Alternative Service',
+
+ # Client-Error
+ 400 => 'Bad Request',
+ 401 => 'Unauthorized',
+ 402 => 'Payment Required',
+ 403 => 'Forbidden',
+ 404 => 'Not Found',
+ 405 => 'Method Not Allowed',
+ 406 => 'Not Acceptable',
+ 407 => 'Proxy Authentication Required',
+ 408 => 'Request Timeout',
+ 410 => 'Gone',
+ 413 => 'Request Entity Too Large',
+ 414 => 'Request-URI Too Large',
+ 415 => 'Unsupported Media Type',
+ 416 => 'Unsupported URI Scheme',
+ 420 => 'Bad Extension',
+ 421 => 'Extension Required',
+ 423 => 'Interval Too Brief',
+ 480 => 'Temporarily not available',
+ 481 => 'Call Leg/Transaction Does Not Exist',
+ 482 => 'Loop Detected',
+ 483 => 'Too Many Hops',
+ 484 => 'Address Incomplete',
+ 485 => 'Ambiguous',
+ 486 => 'Busy Here',
+ 487 => 'Request Terminated',
+ 488 => 'Not Acceptable Here',
+ 491 => 'Request Pending',
+ 493 => 'Undecipherable',
+
+ # Server-Error
+ 500 => 'Internal Server Error',
+ 501 => 'Not Implemented',
+ 502 => 'Bad Gateway',
+ 503 => 'Service Unavailable',
+ 504 => 'Server Time-out',
+ 505 => 'SIP Version not supported',
+ 513 => 'Message Too Large',
+
+ # Global-Failure
+ 600 => 'Busy Everywhere',
+ 603 => 'Decline',
+ 604 => 'Does not exist anywhere',
+ 606 => 'Not Acceptable',
+);
###########################################################################
# Redefine methods from Net::SIP::Packet, no need to find out dynamically
@@ -98,9 +162,9 @@
###########################################################################
# Create response to request
-# Args: ($self,$code,$msg;$args,$body)
+# Args: ($self,$code,[$msg],[$args,$body])
# $code: numerical response code
-# $msg: text for response code
+# $msg: msg for code, if arg not given it will be used from %ResponseCode
# $args: additional args for SIP header
# $body: body as string
# Returns: $response
@@ -108,8 +172,9 @@
###########################################################################
sub create_response {
my Net::SIP::Request $self = shift;
- my ($code,$msg,$args,$body) = @_;
-
+ my $code = shift;
+ my ($msg,$args,$body) = ( defined $_[0] && ref($_[0]) ) ? (undef, at _):@_;
+ $msg = $ResponseCode{$code} if ! defined $msg;
my %header = (
cseq => scalar($self->get_header('cseq')),
'call-id' => scalar($self->get_header('call-id')),
@@ -185,9 +250,9 @@
if ( lc($a->{data}) ne 'digest'
|| $h->{algorithm} && lc($h->{algorithm}) ne 'md5'
- || $h->{qop} && lc($h->{qop}) ne 'auth' ) {
+ || $h->{qop} && $h->{qop} !~ m{(?:^|,\s*)auth(?:$|,)}i ) {
no warnings;
- #warn "unsupported authorization method $a->{data} method=$h->{method} qop=$h->{qop}";
+ DEBUG(10,"unsupported authorization method $a->{data} method=$h->{method} qop=$h->{qop}");
next;
}
my $realm = $h->{realm};
@@ -211,6 +276,7 @@
# 3.2.2.1
if ( $h->{qop} ) {
+ $h->{qop} = 'auth'; # in case it was 'auth,auth-int'
my $nc = $digest{nc} = '00000001';
my $cnonce = $digest{cnonce} = sprintf("%08x",rand(2**32));
$digest{qop} = $h->{qop};
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Request.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Request.pod?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Request.pod (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Request.pod Mon Jul 12 15:29:54 2010
@@ -73,11 +73,13 @@
Returns Net::SIP::Request object to cancel request in C<$self>.
-=item create_response ( CODE, MSG, [ \%HEADER, BODY ] )
+=item create_response ( CODE, [MSG,] [ \%HEADER, BODY ] )
Returns Net::SIP::Response packet for the received request C<$self> with
numerical code CODE and text message MSG. Header for the response will
be based on the request, but can be added or overriden using \%HEADER.
+If MSG is not given (e.g. argument is missing, second argument is \%HEADER
+already) a builtin message for the code will be used.
For details to \%HEADER and BODY see B<new_from_parts> in L<Net::SIP::Packet>.
Modified: trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm?rev=60253&op=diff
==============================================================================
--- trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm (original)
+++ trunk/libnet-sip-perl/lib/Net/SIP/Simple.pm Mon Jul 12 15:29:54 2010
@@ -300,9 +300,13 @@
my $from = delete $args{from} || $self->{from}
|| croak( "unknown from" );
- my $contact = delete $args{contact} || $self->{contact} || $from;
- my $local = $leg->{addr}.':'.$leg->{port};
- $contact.= '@'.$local unless $contact =~s{\@([\w\-\.:]+)}{\@$local};
+
+ my $contact = delete $args{contact} || $self->{contact};
+ if ( ! $contact) {
+ $contact = $from;
+ my $local = $leg->{addr}.':'.$leg->{port};
+ $contact.= '@'.$local unless $contact =~s{\@([\w\-\.:]+)}{\@$local};
+ }
my %rarg = (
from => $from,
More information about the Pkg-perl-cvs-commits
mailing list