Commit c41c6ed2 authored by gregor herrmann's avatar gregor herrmann

New upstream version 0.690

parent a953215d
Revision history for Net::SIP
0.690 2016-10-30
- fix target hostname vs. IP detection in StatelessProxy with IPv6
0.689 2016-10-28
- some IPv6 fixes and enhancements in parts based on review by BLUHM
0.688 2016-10-26
- support for IPv6
0.687 2014-02-11
StatelessProxy:
- better encryption for rewritten contact and way to define its own
......@@ -256,7 +262,7 @@ DetlefPilzecker[AT]web[DOT]de
Thanks to <vitspec[AT]gmail[DOT]com> for pointing out the problem.
0.56 2010-02-02
- fix CANCEL handling: instead of closing the context immediatly:
- fix CANCEL handling: instead of closing the context immediately:
- server should return 487 to client before closing the context
- server should ignore ACKs for unknown contexts instead of
replying with 481
......
......@@ -96,4 +96,5 @@ bin/stateless_proxy.pl
bin/answer_machine.pl
bin/README
tools/generate-dtmf.pl
META.yml Module meta-data (added by MakeMaker)
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
{
"abstract" : "unknown",
"author" : [
"unknown"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Net-SIP",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Net::DNS" : "0.56",
"Socket" : "1.95"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://rt.cpan.org/Dist/Display.html?Queue=Net-SIP"
},
"homepage" : "https://github.com/noxxi/p5-net-sip",
"license" : [
"http://dev.perl.org/licenses/"
],
"repository" : {
"url" : "https://github.com/noxxi/p5-net-sip"
}
},
"version" : "0.690"
}
--- #YAML:1.0
name: Net-SIP
version: 0.687
abstract: ~
author: []
license: unknown
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
---
abstract: unknown
author:
- unknown
build_requires:
ExtUtils::MakeMaker: 0
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Net-SIP
no_index:
directory:
- t
- inc
requires:
Net::DNS: 0.56
Net::DNS: 0.56
Socket: 1.95
resources:
bugtracker: https://rt.cpan.org/Dist/Display.html?Queue=Net-SIP
homepage: https://github.com/noxxi/p5-net-sip
license: http://dev.perl.org/licenses/
repository: https://github.com/noxxi/p5-net-sip
no_index:
directory:
- t
- inc
generated_by: ExtUtils::MakeMaker version 6.57_05
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
bugtracker: https://rt.cpan.org/Dist/Display.html?Queue=Net-SIP
homepage: https://github.com/noxxi/p5-net-sip
license: http://dev.perl.org/licenses/
repository: https://github.com/noxxi/p5-net-sip
version: 0.690
......@@ -6,6 +6,7 @@ WriteMakefile(
VERSION_FROM => 'lib/Net/SIP.pm',
PREREQ_PM => {
'Net::DNS' => 0.56,
'Socket' => 1.95,
},
$ExtUtils::MakeMaker::VERSION >= 6.46 ? (
'META_MERGE' => {
......
This is a module for handling SIP, the IETF standard for VOIP
(RFC3261).
It is written completly in perl.
It is written completely in perl.
With the help of this module you can write SIP endpoints (e.g
phones, answer machines), SIP proxies and registrars.
It contains no GUI and no real code for working with video or
audio, but is has some support for RTP (no RTCP) and working
audio, but has some support for RTP (no RTCP) and working
with PCMU/8000 data, enough for sending PCMU/8000 encoded
audio to a SIP peer and for receiving and saving PCMU/8000
audio data.
audio data.
The module is designed to be completly asynchronous, e.g. you
either integrate it in your own event handling or you can use
The module is designed to be completely asynchronous, e.g. you
either integrate it in your own event handling or you can use
the simple event handling which is included.
It was tested on Linux (Ubuntu 6.10,7.04,7.10), MacOSX 10.3+10.4,
OpenBSD3.9+4.1 with various perl versions starting with
OpenBSD3.9+4.1 with various perl versions starting with
perl5.8.7, including 5.10
Sample Code was tested with Snom 300 Phones, Asterisk 1.2,
......
......@@ -4,7 +4,7 @@ use warnings;
require 5.008;
package Net::SIP;
our $VERSION = '0.687';
our $VERSION = '0.690';
# this includes nearly everything else
use Net::SIP::Simple ();
......
......@@ -15,9 +15,9 @@ and on top of all that a simplified layer for common tasks.
Addionally L<Net::SIP::Util> provides utility functions
and L<Net::SIP::Debug> provides a debugging layer used
by all these packets. Especially it provides the function
B<invoke_callback> which is used for all callback unless
otherwise in the documentation specified. This function
by all these packages. Especially it provides the function
B<invoke_callback> which is used for all callbacks unless
documentation specifies otherwise. This function
supports a variety of different callback styles.
For first and simple applications you best start with L<Net::SIP::Simple>.
......@@ -26,7 +26,7 @@ L<Net::SIP::Dispatcher>, L<Net::SIP::Endpoint>,
L<Net::SIP::Register> and L<Net::SIP::StatelessProxy>.
Although these packages are in itself well documented the functionality
and the design is best understandable if you look how it gets used
in tghe source of L<Net::SIP::Simple>.
in the source of L<Net::SIP::Simple>.
=head2 SIP packet handling
......@@ -34,19 +34,19 @@ in tghe source of L<Net::SIP::Simple>.
=item L<SIP::Net::Packet>
Is the base class for handling SIP packets and provides ways to
The base class for handling SIP packets and provides ways to
parse, construct and manipulate SIP packets.
=item L<SIP::Net::Request>
Is derived from L<SIP::Net::Packet> and handles the request packets.
Derived from L<SIP::Net::Packet> and handles the request packets.
Provides ways to create special requests like ACK or CANCEL based
on previous requests and responses, for creating responses based
on requests, for authorization of requests.
=item L<SIP::Net::Response>
Is derived from L<SIP::Net::Packet> and handles the response packets.
Derived from L<SIP::Net::Packet> and handles the response packets.
=item L<SIP::Net::SDP>
......@@ -90,7 +90,7 @@ L<Lib::Event> or L<POE>.
=item L<Net::SIP::Endpoint>
Implements a SIP endpoint (UAC,UAS). Provides ways to INVITE or BYE
calls or to handle incoming calls. Calls itself will be handled by
calls or to handle incoming calls. Calls themselves will be handled by
L<Net::SIP::Endpoint::Context>.
=item L<Net::SIP::Registrar>
......@@ -142,8 +142,8 @@ is possible to handle simple RTP data (PCMU/8000).
Unless otherwise documented the common way to propagate errors is to
raise an exception, e.g. call die(). This might especially happen
when parsing packets from strings, so unless you want to crash your
application on bad input you should catch these exceptions with
eval.
application on bad input you should catch these exceptions with
eval.
=head1 EXPORTS
......
......@@ -36,7 +36,7 @@ sub dtmf_generator {
my ($event,$duration,%pargs) = @_;
# empty or invalid stuff will cause pause/silence
$event = '' if ! defined $event or $event !~m{(\d)|([A-D])|(\*)|(\#)}i;
$event = '' if ! defined $event or $event !~ m{[\dA-D\*\#]}i;
if ( defined( my $type = $pargs{rfc2833_type} )) {
# create RFC2833 payload
......
......@@ -23,29 +23,29 @@ The following levels are used:
=over 4
=item 1
=item
Debug messages for users
1 - Debug messages for users.
=item 2
=item
Includes short SIP packet dumps of incoming and outgoing data
2 - Includes short SIP packet dumps of incoming and outgoing data.
=item 5
=item
Includes detailed SIP packet dumps for incoming and outgoing data
5 - Includes detailed SIP packet dumps for incoming and outgoing data.
=item 10
=item
Includes information about call flow, e.g. why packets get dropped etc.
10 - Includes information about call flow, e.g. why packets get dropped etc.
=item 50
=item
Detailed debugging for programmers using L<Net::SIP>.
50 - Detailed debugging for programmers using L<Net::SIP>.
=item 100
=item
Detailed debugging for core developers of L<Net::SIP>.
100 - Detailed debugging for core developers of L<Net::SIP>.
=back
......@@ -89,7 +89,7 @@ L<Net::SIP::Endpoint::Context> too.
Similar to the previous item, but this sets debugging level to
NUMBER for the specified packages and thus can also be used to
selectivly disable debugging for some packages.
selectively disable debugging for some packages.
=back
......@@ -112,7 +112,7 @@ be useful to change this to "DEBUG($$):" or similar.
=item DEBUG|debug ( [ LEVEL ],( MESSAGE | FMT,@ARG ))
If debugging is enabled it will print to STDERR debugging info.
If debugging is enabled it will print debugging info to STDERR.
If multiple arguments are given to the function they will be
fed into B<sprintf> to create a single message.
......@@ -122,7 +122,7 @@ for this message, e.g. if it is higher than the user specified
debug level the message will not be printed.
The MESSAGE (or the result from C<< sprintf(FMT,@ARG) >>) will be
prefixed by the callers package, the callers function and the line
prefixed by the caller package, the caller function and the line
from which DEBUG was called. In front of the prefix the current time
(as float time_t) and the string "DEBUG:" will be added.
......
......@@ -68,10 +68,10 @@ sub new {
$domain2proxy ||= {};
foreach ( values %$domain2proxy ) {
if ( ref($_) ) { # should be \@list of [ prio,proto,ip,port ]
} elsif ( m{^(?:(udp|tcp):)?([^:]+)(?::(\d+))?$} ) {
} elsif (m{^(?:(udp|tcp):)?(.+)}) {
my @proto = $1 ? ( $1 ) : ( 'udp','tcp' );
my $host = $2;
my $port = $3 || 5060;
my ($host,$port) = ip_string2parts($2);
$port ||= 5060;
$_ = [ map { [ -1, $_, $host, $port ] } @proto ];
} else {
croak( "invalid entry in domain2proxy: $_" );
......@@ -193,9 +193,9 @@ sub add_leg {
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 ($host,$port) = $d =~m{^\S+\s+(\S+)$}
? ip_string2parts($1):();
my ($addr,$rport) = ip_string2parts($from);
my %nh;
if ( exists $h->{rport} and ! defined $h->{rport}) {
$nh{rport} = $rport;
......@@ -451,7 +451,7 @@ sub queue_expire {
}
if ( !@$retransmits ) {
# completly expired
# completely expired
DEBUG( 50,"entry %s expired because expire=%.2f but now=%d", $qe->tid,$retransmit,$now );
$changed++;
$qe->trigger_callback( ETIMEDOUT );
......@@ -641,15 +641,15 @@ sub resolve_uri {
};
my $ip_addr;
if ( $domain =~m{^(\d+\.\d+\.\d+\.\d+)(?::(\d+))?$} ) {
# if domain part of URI is IPv4[:port]
$default_port = $2 if defined $2;
$ip_addr = $1;
# e.g. 10.0.3.4 should match *.3.0.10.in-addr.arpa
$domain = join( '.', reverse split( m{\.},$ip_addr )).'.in-addr.arpa';
} else {
$domain =~s{\.*(?::(\d+))?$}{}; # remove trailing dots + port
$default_port = $1 if defined $1;
{
($ip_addr,my $port,my $family) = ip_string2parts($domain);
$default_port = $port if defined $port;
if ($family) {
$domain = ip_ptr($ip_addr,$family);
} else {
$domain = $ip_addr;
$ip_addr = undef; # not an IP address but hostname
}
}
DEBUG( 100,"domain=$domain" );
......@@ -687,8 +687,7 @@ sub resolve_uri {
# is param maddr set?
if ( my $ip = $param->{maddr} ) {
@$dst_addr = ( $ip )
if $ip =~m{^[\d\.]+$} && eval { inet_aton($ip) };
@$dst_addr = ($ip) if ip_is_v4($ip) || ip_is_v6($ip);
}
# entries in form [ prio,proto,ip,port ]
......@@ -696,12 +695,13 @@ sub resolve_uri {
foreach my $addr ( @$dst_addr ) {
if ( ref($addr)) {
push @resp,$addr; # right format: see domain2proxy
} elsif ($addr =~ m{^(?:(udp|tcp):)?(.+)}) {
my @proto = $1 ? ( $1 ) : ( 'udp','tcp' );
my ($host,$port) = ip_string2parts($2);
$port ||= $default_port;
push @resp, map { [ -1, $_, $host, $port ] } @proto;
} else {
$addr =~m{^(?:(udp|tcp):)?([^:]+)(?::(\d+))?$} || next;
my $host = $2;
my $proto = $1 ? [ $1 ] : \@proto;
my $port = $3 ? $3 : $default_port;
push @resp, map { [ -1,$_,$host,$port ] } @$proto;
next;
}
}
......@@ -750,10 +750,10 @@ sub __resolve_uri_final {
)} @$allowed_legs;
if ( $leg ) {
push @$dst_addr, "$r->[1]:$r->[2]:$r->[3]";
push @$dst_addr, "$r->[1]:".ip_parts2string($r->[2],$r->[3]);
push @$legs,$leg;
} else {
DEBUG( 50,"no leg for $r->[1]:$r->[2]:$r->[3]" );
DEBUG( 50,"no leg for $r->[1]:".ip_parts2string($r->[2],$r->[3]));
}
}
......@@ -765,7 +765,8 @@ sub __resolve_uri_final {
sub _find_leg4addr {
my Net::SIP::Dispatcher $self = shift;
my $dst_addr = shift;
my ($proto,$ip) = $dst_addr =~m{^(?:(tcp|udp):)?([^:]+)};
my ($proto,$ip) = $dst_addr =~m{^(?:(tcp|udp):)?(\S+)};
($ip) = ip_string2parts($ip);
my @legs;
foreach my $leg (@{ $self->{legs} }) {
push @legs,$leg if $leg->can_deliver_to( addr => $ip, proto => $proto );
......@@ -789,16 +790,19 @@ sub dns_host2ip {
if ( ref($host)) {
my $err;
foreach ( keys %$host ) {
if ( my $addr = gethostbyname( $_ )) {
$host->{$_} = inet_ntoa($addr);
if ( my $addr = hostname2ip($_)) {
$host->{$_} = $addr;
} else {
$err = EINVAL;
}
}
invoke_callback( $callback, $err,$host );
} else {
my $addr = gethostbyname( $host );
invoke_callback( $callback, $addr ? ( undef,inet_ntoa($addr) ) : ( $? ));
my $addr = hostname2ip($host);
invoke_callback(
$callback,
$addr ? ( undef,$addr ) : ( $? )
);
}
}
......@@ -825,7 +829,7 @@ sub dns_domain2srv {
foreach my $proto ( @$protos ) {
if ( my $q = $dns->query( '_'.$sip_proto.'._'.$proto.'.'.$domain,'SRV' )) {
foreach my $rr ( $q->answer ) {
if ( $rr->type eq 'A' ) {
if ( $rr->type eq 'A' or CAN_IPV6 && $rr->type eq 'AAAA' ) {
push @{ $addr2ip{$rr->name} }, $rr->address;
} elsif ( $rr->type eq 'SRV' ) {
push @resp,[ $rr->priority, $proto,$rr->target,$rr->port ]
......@@ -847,11 +851,11 @@ sub dns_domain2srv {
# either already IP or no additional data for resolving -> later
my @cp = @$r;
# XXX fixme blocking DNS lookup
my $ipn = gethostbyname( $r->[2] ) or do {
my $ip = hostname2ip($r->[2]) or do {
DEBUG( 1,"cannot resolve $r->[2]" );
next;
};
$cp[2] = inet_ntoa($ipn);
$cp[2] = $ip;
push @resp_resolved, \@cp;
}
}
......@@ -861,11 +865,17 @@ sub dns_domain2srv {
unless (@resp) {
# try addr directly
my $default_port = $sip_proto eq 'sips' ? 5061:5060;
if ( CAN_IPV6 and my $q = $dns->query( $domain,'AAAA' )) {
foreach my $rr ($q->answer ) {
$rr->type eq 'AAAA' || next;
push @resp,map {
[ -1, $_ , $rr->address,$default_port ]
} @$protos;
}
}
if ( my $q = $dns->query( $domain,'A' )) {
foreach my $rr ($q->answer ) {
$rr->type eq 'A' || next;
# XXX fixme, check that name in response corresponds to query
# (beware of CNAMEs!)
push @resp,map {
[ -1, $_ , $rr->address,$default_port ]
} @$protos;
......
......@@ -139,7 +139,7 @@ be decided based on the value of WHEN). Absolute times will be
specified in time_t (seconds since 1970-01-01 00:00:00) and
relative time will be specified in seconds.
WHEN can be floating point to specifiy subseconds.
WHEN can be C<0> to trigger the timer immediatly.
WHEN can be C<0> to trigger the timer immediately.
CALLBACK is a callback usable by B<invoke_callback> in L<Net::SIP::Util>.
......
......@@ -45,7 +45,7 @@ sub addFD {
my Net::SIP::Dispatcher::Eventloop $self = shift;
my ($fd,$callback,$name) = @_;
defined( my $fn = fileno($fd)) || return;
#DEBUG( 100, "$self added fn=$fn sock=".eval { my ($port,$addr) = unpack_sockaddr_in( getsockname($fd)); inet_ntoa($addr).':'.$port } );
#DEBUG( 100, "$self added fn=$fn sock=".ip_sockaddr2string(getsockname($fd)));
$self->{fd}[$fn] = [ $fd,$callback,$name ];
}
......@@ -59,7 +59,7 @@ sub delFD {
my Net::SIP::Dispatcher::Eventloop $self = shift;
my ($fd) = @_;
defined( my $fn = fileno($fd)) || return;
#DEBUG( 100, "$self delete fn=$fn sock=".eval { my ($port,$addr) = unpack_sockaddr_in( getsockname($fd)); inet_ntoa($addr).':'.$port } );
#DEBUG( 100, "$self delete fn=$fn sock=".ip_sockaddr2string(getsockname($fd)));
delete $self->{fd}[$fn];
}
......
......@@ -249,7 +249,7 @@ sub data {
=pod
=back 4
=back
=cut
......
......@@ -197,7 +197,7 @@ sub cancel_invite {
############################################################################
# internal callback used for delivery
# will be called from dispatcher if the request was definitly successfully
# will be called from dispatcher if the request was definitely successfully
# delivered (tcp only) or an error occurred
# Args: ($self,$ctx,$error,$delivery_packet)
# $ctx: Net::SIP::Endpoint::Context
......
......@@ -234,8 +234,8 @@ If the response is a successful final response to a request
other then INVITE it will invoke callback which should fully
handle the response.
If the response code is 401 (Authorization required) or
407 (Proxy Authorization required) and if the context has
If the response code is 401 (Unauthorized) or
407 (Proxy Authentication Required) and if the context has
authorization info (key B<auth> in the constructor)) it
will try to authorize the request based on the realms
given in the response and if it can find authorization info
......@@ -243,14 +243,14 @@ for at least parts of the required realms it will
redeliver the request. Otherwise it will invoke the callback
with an error of EPERM.
If the response code is 300 (multiple choice) or 301
If the response code is 300 (Multiple Choices) or 301
(moved permanently) it will invoke the callback because
it cannot resolve the issue automatically.
But if it's 302 (moved temporally) it will rewrite the
But if it's 302 (Moved Temporarily) it will rewrite the
request based on the B<Contact> header in the response
and redeliver it automatically.
If the response is 305 (use proxy) it will take the information
If the response is 305 (Use Proxy) it will take the information
from B<Contact> as the upstream proxy and insert it into
the routes, so that it will use it as the next hop.
Then it rewrites the request for the new routes and redelivers it.
......
......@@ -11,7 +11,12 @@ package Net::SIP::Leg;
use Digest::MD5 'md5_hex';
use Socket;
use Net::SIP::Debug;
use Net::SIP::Util qw( sip_hdrval2parts invoke_callback sip_uri_eq );
use Net::SIP::Util qw(
sip_hdrval2parts sip_uri_eq
ip_parts2string ip_string2parts ip_parts2sockaddr ip_sockaddr2parts
invoke_callback
INETSOCK
);
use Net::SIP::Packet;
use Net::SIP::Request;
use Net::SIP::Response;
......@@ -43,42 +48,43 @@ sub new {
my ($class,%args) = @_;
my $self = fields::new($class);
my $family;
if ( my $addr = delete $args{addr} ) {
my $port = delete $args{port};
# port = 0 -> get port from system
if ( ! defined $port ) {
$port = $1 if $addr =~s{:(\d+)$}{};
$port ||= 5060;
}
($addr,my $port_a, $family) = ip_string2parts($addr);
die "port given both as argument and contained in address"
if $port && $port_a && $port != $port_a;
# port defined and 0 -> get port from system
$port = $port_a || 5060 if ! defined $port;
my $proto = $self->{proto} = delete $args{proto} || 'udp';
if ( ! ( $self->{sock} = delete $args{sock} ) ) {
$self->{sock} = IO::Socket::INET->new(
$self->{sock} = INETSOCK(
Proto => $proto,
Family => $family,
LocalPort => $port,
LocalAddr => $addr,
) || die "failed $proto $addr:$port $!";
}
if ( ! $port ) {
# get the assigned port
($port) = unpack_sockaddr_in( getsockname( $self->{sock} ));
) or die "failed $proto "
. ip_parts2string($addr,$port,$family).": $!";
}
$port ||= $self->{sock}->sockport; # use the assigned port
$self->{port} = $port;
$self->{addr} = $addr;
} elsif ( my $sock = $self->{sock} = delete $args{sock} ) {
# get data from socket
($self->{port}, my $addr) = unpack_sockaddr_in( $sock->sockname );
$self->{addr} = inet_ntoa( $addr );
$self->{proto} = ( $sock->socktype == SOCK_STREAM ) ? 'tcp':'udp'
$self->{port} = $sock->sockport;
$self->{addr} = $sock->sockhost;
$self->{proto} = ( $sock->socktype == SOCK_STREAM ) ? 'tcp':'udp';
$family = $sock->sockdomain;
}
my ($port,$sip_proto) =
$self->{port} == 5060 ? ( '','sip' ) :
( $self->{port} == 5061 and $self->{proto} eq 'tcp' ) ? ( '','sips' ) :
( ":$self->{port}",'sip' )
$self->{port} == 5060 ? ( 0,'sip' ) :
( $self->{port} == 5061 and $self->{proto} eq 'tcp' ) ? ( 0,'sips' ) :
( $self->{port},'sip' )
;
my $leg_addr = $self->{addr}.$port;
my $leg_addr = ip_parts2string($self->{addr},$port,$family,1);
$self->{contact} = delete $args{contact} || "$sip_proto:$leg_addr";
$self->{branch} = 'z9hG4bK'.
......@@ -250,7 +256,7 @@ sub forward_outgoing {
# $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 error=0 to show
# that the packet was definitly delivered (and need not retried)
# that the packet was definitely delivered (and there's no need to retry)
###########################################################################
sub deliver {
my Net::SIP::Leg $self = shift;
......@@ -302,15 +308,16 @@ sub deliver {
}
my ($proto,$host,$port) =
$addr =~m{^(?:(\w+):)?([\w\-\.]+)(?::(\d+))?$};
$addr =~m{^(?:(sips?|udp|tcp):)?(.+)};
my $proto = $1 || 'sip';
my ($host,$port) = ip_string2parts($2);
$port ||= $proto eq 'sips' ? 5061 : 5060;
#DEBUG( "%s -> %s %s %s",$addr,$proto||'',$host, $port||'' );
$port ||= $proto eq 'sips' ? 5061: 5060;
$self->sendto( $packet->as_string, $host,$port,$callback )
|| return;
DEBUG( 2, "delivery from $self->{addr}:$self->{port} to $addr OK:\n%s",
DEBUG( 2, "delivery from %s to %s OK:\n%s",
ip_parts2string($self->{addr},$self->{port}), $addr,
$packet->dump( Net::SIP::Debug->level -2 ) );
}
......@@ -345,14 +352,13 @@ sub sendto {
invoke_callback( $callback, EINVAL );
}
my $host4 = inet_aton( $host ) or do {
my $target = ip_parts2sockaddr($host,$port) or do {
# this should not happen because host should better be IP
DEBUG( 1, "lookup problems of $host?" );
invoke_callback( $callback, EINVAL );
return;
};
my $target = sockaddr_in( $port,$host4 );
unless ( $self->{sock}->send( $data,0,$target )) {
DEBUG( 1,"send failed: callback=$callback error=$!" );
invoke_callback( $callback, $! );
......@@ -399,12 +405,14 @@ sub receive {
return;
};
my ($port,$host) = unpack_sockaddr_in( $from );
$host = inet_ntoa($host);
DEBUG( 2,"received on $self->{addr}:$self->{port} from $host:$port packet\n%s",
$packet->dump( Net::SIP::Debug->level -2 ));
my ($host,$port,$family) = ip_sockaddr2parts($from);
DEBUG( 2,"received on %s from %s packet\n%s",
ip_parts2string($self->{addr},$self->{port},$family),
ip_parts2string($host,$port,$family),
$packet->dump( Net::SIP::Debug->level -2 )
);
return ($packet,"$host:$port");
return ($packet,ip_parts2string($host,$port,$family));
}
###########################################################################
......
......@@ -30,7 +30,7 @@ The following keys are used from %ARGS:
=item sock
The socket as IO::Socket::INET object. C<addr>, C<port> and C<proto>
The socket as IO::Socket object. C<addr>, C<port> and C<proto>
will be determined from this object and not from %ARGS.