r6692 - in /branches/upstream/libnet-sip-perl/current: Changes MANIFEST META.yml lib/Net/SIP.pm lib/Net/SIP/Registrar.pm samples/invite_and_recv.pl samples/invite_and_send.pl samples/test_registrar_and_proxy.pl
rmayorga-guest at users.alioth.debian.org
rmayorga-guest at users.alioth.debian.org
Thu Aug 16 01:59:12 UTC 2007
Author: rmayorga-guest
Date: Thu Aug 16 01:59:12 2007
New Revision: 6692
URL: http://svn.debian.org/wsvn/?sc=1&rev=6692
Log:
[svn-upgrade] Integrating new upstream version, libnet-sip-perl (0.32)
Added:
branches/upstream/libnet-sip-perl/current/samples/test_registrar_and_proxy.pl
Modified:
branches/upstream/libnet-sip-perl/current/Changes
branches/upstream/libnet-sip-perl/current/MANIFEST
branches/upstream/libnet-sip-perl/current/META.yml
branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pm
branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl
branches/upstream/libnet-sip-perl/current/samples/invite_and_send.pl
Modified: branches/upstream/libnet-sip-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/Changes?rev=6692&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/Changes (original)
+++ branches/upstream/libnet-sip-perl/current/Changes Thu Aug 16 01:59:12 2007
@@ -1,4 +1,12 @@
Revision history for Net::SIP
+
+0.32
+ - Net::SIP::Registrar checks on non-REGISTER requests if the
+ target it registered with itself and then rewrites the URI in
+ the packet. This can be used for a combined Registar+Proxy,
+ see samples/test_registrar_and_proxy.pl
+ - samples/invite_and_*.pl have now option -L|--leg to specify
+ a local address
0.31
- make it usable for perl5.9, tested with 5.9.5
Modified: branches/upstream/libnet-sip-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/MANIFEST?rev=6692&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-sip-perl/current/MANIFEST Thu Aug 16 01:59:12 2007
@@ -65,6 +65,7 @@
t/testlib.pl
samples/invite_and_recv.pl
samples/invite_and_send.pl
+samples/test_registrar_and_proxy.pl
samples/3pcc.pl
bin/nathelper.pl
bin/stateless_proxy.pl
Modified: branches/upstream/libnet-sip-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/META.yml?rev=6692&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/META.yml (original)
+++ branches/upstream/libnet-sip-perl/current/META.yml Thu Aug 16 01:59:12 2007
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Net-SIP
-version: 0.31
+version: 0.32
version_from: lib/Net/SIP.pm
installdirs: site
requires:
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm?rev=6692&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm (original)
+++ branches/upstream/libnet-sip-perl/current/lib/Net/SIP.pm Thu Aug 16 01:59:12 2007
@@ -4,7 +4,7 @@
require 5.008;
package Net::SIP;
-our $VERSION = '0.31';
+our $VERSION = '0.32';
# this includes nearly everything else
use Net::SIP::Simple ();
Modified: branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/lib/Net/SIP/Registrar.pm?rev=6692&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 Thu Aug 16 01:59:12 2007
@@ -62,7 +62,16 @@
# accept only REGISTER
$packet->is_request || return;
- $packet->method eq 'REGISTER' || return;
+ if ( $packet->method ne 'REGISTER' ) {
+ # if we know the target rewrite the destination URI
+ my $uri = $packet->uri;
+ DEBUG( 1,"method ".$packet->method." uri=<$uri>" );
+ my @found = $self->query( $uri );
+ @found or return;
+ DEBUG( 1,"rewrite URI $uri in ".$packet->method." to $found[0]" );
+ $packet->set_uri( $found[0] );
+ return; # propagate to next in chain
+ }
my $from = $packet->get_header( 'from' ) or do {
DEBUG( 1,"no from in register request. DROP" );
Modified: branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl?rev=6692&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl (original)
+++ branches/upstream/libnet-sip-perl/current/samples/invite_and_recv.pl Thu Aug 16 01:59:12 2007
@@ -29,6 +29,7 @@
-R|--registrar host[:port] register at given address
-O|--outfile filename write received RTP data to file
-T|--time interval hang up after interval seconds
+ -L|--leg ip[:port] use given local ip[:port] for outgoing leg
--username name username for authorization
--password pass password for authorization
--route host[:port] add SIP route, can be specified multiple times
@@ -36,6 +37,7 @@
Examples:
$0 -T 10 -O record.data sip:30\@192.168.178.4 sip:31\@192.168.178.1
$0 --username 30 --password secret --proxy=192.168.178.3 sip:30\@example.com 31
+ $0 --username 30 --password secret --leg 192.168.178.4 sip:30\@example.com 31
EOS
exit( @_ ? 1:0 );
@@ -46,7 +48,7 @@
# Get options
###################################################
-my ($proxy,$outfile,$registrar,$username,$password,$hangup);
+my ($proxy,$outfile,$registrar,$username,$password,$hangup,$local_leg);
my (@routes,$debug);
GetOptions(
'd|debug:i' => \$debug,
@@ -55,6 +57,7 @@
'R|registrar=s' => \$registrar,
'O|outfile=s' => \$outfile,
'T|time=i' => \$hangup,
+ 'L|leg=s' => \$local_leg,
'username=s' =>\$username,
'password=s' =>\$password,
'route=s' => \@routes,
@@ -69,25 +72,32 @@
$registrar ||= $proxy;
###################################################
-# if no proxy is given we need to find out
-# about the leg using the IP given from FROM
+# find local leg
###################################################
+my ($local_host,$local_port);
+if ( $local_leg ) {
+ ($local_host,$local_port) = split( m/:/,$local_leg,2 );
+} elsif ( ! $proxy ) {
+ # if no proxy is given we need to find out
+ # about the leg using the IP given from FROM
+ ($local_host,$local_port) = $from =~m{\@([\w\-\.]+)(?::(\d+))?}
+ or die "cannot find SIP domain in '$from'";
+}
+
my $leg;
-if ( !$proxy ) {
- my ($host,$port) = $from =~m{\@([\w\-\.]+)(?::(\d+))?}
- or die "cannot find SIP domain in '$from'";
- my $addr = gethostbyname( $host )
- || die "cannot get IP from SIP domain '$host'";
+if ( $local_host ) {
+ my $addr = gethostbyname( $local_host )
+ || die "cannot get IP from SIP domain '$local_host'";
$addr = inet_ntoa( $addr );
$leg = IO::Socket::INET->new(
Proto => 'udp',
LocalAddr => $addr,
- LocalPort => $port || 5060,
+ LocalPort => $local_port || 5060,
);
# if no port given and port 5060 is already used try another one
- if ( !$leg && !$port ) {
+ if ( !$leg && !$local_port ) {
$leg = IO::Socket::INET->new(
Proto => 'udp',
LocalAddr => $addr,
Modified: branches/upstream/libnet-sip-perl/current/samples/invite_and_send.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/samples/invite_and_send.pl?rev=6692&op=diff
==============================================================================
--- branches/upstream/libnet-sip-perl/current/samples/invite_and_send.pl (original)
+++ branches/upstream/libnet-sip-perl/current/samples/invite_and_send.pl Thu Aug 16 01:59:12 2007
@@ -32,6 +32,7 @@
-P|--proxy host[:port] use outgoing proxy, register there unless registrar given
-R|--registrar host[:port] register at given address
-S|--send filename send content of file, can be given multiple times
+ -L|--leg ip[:port] use given local ip[:port] for outgoing leg
--username name username for authorization
--password pass password for authorization
@@ -49,7 +50,7 @@
# Get options
###################################################
-my ($proxy, at files,$registrar,$username,$password);
+my ($proxy, at files,$registrar,$username,$password,$local_leg);
my ($debug,$hangup);
GetOptions(
'd|debug:i' => \$debug,
@@ -57,6 +58,7 @@
'P|proxy=s' => \$proxy,
'R|registrar=s' => \$registrar,
'S|send=s' => \@files,
+ 'L|leg=s' => \$local_leg,
'username=s' =>\$username,
'password=s' =>\$password,
) || usage( "bad option" );
@@ -70,33 +72,42 @@
$registrar ||= $proxy;
###################################################
-# if no proxy is given we need to find out
-# about the leg using the IP given from FROM
+# find local leg
###################################################
+my ($local_host,$local_port);
+if ( $local_leg ) {
+ ($local_host,$local_port) = split( m/:/,$local_leg,2 );
+} elsif ( ! $proxy ) {
+ # if no proxy is given we need to find out
+ # about the leg using the IP given from FROM
+ ($local_host,$local_port) = $from =~m{\@([\w\-\.]+)(?::(\d+))?}
+ or die "cannot find SIP domain in '$from'";
+}
+
my $leg;
-if ( !$proxy ) {
- my ($host,$port) = $from =~m{\@([\w\-\.]+)(?::(\d+))?}
- or die "cannot find SIP domain in '$from'";
- my $addr = gethostbyname( $host )
- || die "cannot get IP from SIP domain '$host'";
+if ( $local_host ) {
+ my $addr = gethostbyname( $local_host )
+ || die "cannot get IP from SIP domain '$local_host'";
$addr = inet_ntoa( $addr );
$leg = IO::Socket::INET->new(
Proto => 'udp',
LocalAddr => $addr,
- LocalPort => $port || 5060,
+ LocalPort => $local_port || 5060,
);
# if no port given and port 5060 is already used try another one
- if ( !$leg && !$port ) {
+ if ( !$leg && !$local_port ) {
$leg = IO::Socket::INET->new(
Proto => 'udp',
LocalAddr => $addr,
LocalPort => 0
) || die "cannot create leg at $addr: $!";
}
+
$leg = Net::SIP::Leg->new( sock => $leg );
}
+
###################################################
# SIP code starts here
Added: branches/upstream/libnet-sip-perl/current/samples/test_registrar_and_proxy.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-sip-perl/current/samples/test_registrar_and_proxy.pl?rev=6692&op=file
==============================================================================
--- branches/upstream/libnet-sip-perl/current/samples/test_registrar_and_proxy.pl (added)
+++ branches/upstream/libnet-sip-perl/current/samples/test_registrar_and_proxy.pl Thu Aug 16 01:59:12 2007
@@ -1,0 +1,20 @@
+use strict;
+use warnings;
+use Net::SIP;
+
+# This is a simple registrar + proxy which listens on 192.168.178.2
+# for requests. Anybody can register with any address and if somebody
+# invites somebody using over this proxy it will first check if the
+# target address is locally registered and in this case forward the
+# invitation to the registered party. Otherwise it will try to resolve
+# the target using DNS and forward the request.
+#
+# Because it accepts any registration w/o passwords it's good for testing
+# but don't use it in production
+
+my $ua = Net::SIP::Simple->new( leg => '192.168.178.2:5060' );
+$ua->create_chain([
+ $ua->create_registrar,
+ $ua->create_stateless_proxy,
+]);
+$ua->loop;
More information about the Pkg-perl-cvs-commits
mailing list