Commit a0847c43 authored by gregor herrmann's avatar gregor herrmann

New upstream version 0.802

parent 8855dfbf
Revision history for Net::SIP
0.802 2016-11-25
- various small fixes primarily related to TLS
- Util::sip_sockinfo2uri accepts hash for convinience
- lots of improvements for code readibility and better documentation based on
feedback from BLUHM
0.801 2016-11-23
- bugfix Util::ip_string2parts
0.800 2016-11-23
- added support for TLS (SIPS) when IO::Socket::SSL >= 1.956 is installed
- make the requirement for Net::DNS optional, i.e. only needed if actually used
for DNS lookups.
- fully non-blocking DNS lookups in Dispatcher (dns_host2ip, dns_domain2srv)
- new/extended API
- easy way to do own DNS resolving with dnsresolv argument to Dispatcher
- new function Util::ip_is_v46
- Util ip_string2parts, ip_sockaddr2parts return hash on wantarray and the
reverse functions ip_parts2string, ip_parts2sockaddr accept hash reference
- Leg->laddr(2) uses hostname instead of IP address
- important, partly incompatible API changes
- Leg::new and Simple::new now croak when unexpected arguments are given
- Internals changed for more code reability and to take care of TLS where the
hostname is needed for certificate validatin. Lots of structures are now
managed by (restricted) hashes which were previously implemented as arrays.
Anybody grabbing in the internals will probably need to adjust code.
Affects partly the more public functions of Leg and Dispatcher too.
0.703 2016-11-20
- fix to support Perl 5.14.x and lower
0.702 2016-11-18
- fix wrong TCP connect timeout triggered long after successful connect
- fix reading of partial SIP packet with TCP
......
......@@ -82,6 +82,10 @@ t/16_drop_invite.t
t/17_call_with_reinvite_and_auth.t
t/18_register_with_auth_step_by_step.t
t/19_call_with_dtmf.t
t/certs/caller.sip.test.pem
t/certs/listen.sip.test.pem
t/certs/proxy.sip.test.pem
t/certs/ca.pem
t/testlib.pl
samples/README
samples/invite_and_recv.pl
......
......@@ -32,7 +32,6 @@
},
"runtime" : {
"requires" : {
"Net::DNS" : "0.56",
"Socket" : "1.95"
}
}
......@@ -50,5 +49,5 @@
"url" : "https://github.com/noxxi/p5-net-sip"
}
},
"version" : "0.702"
"version" : "0.802"
}
......@@ -18,11 +18,10 @@ no_index:
- t
- inc
requires:
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
version: 0.702
version: 0.802
use ExtUtils::MakeMaker;
require 5.008;
require 5.10.0;
$^O =~m{Win32}i and die "OS unsupported";
WriteMakefile(
NAME => 'Net::SIP',
VERSION_FROM => 'lib/Net/SIP.pm',
PREREQ_PM => {
'Net::DNS' => 0.56,
# 'Net::DNS' => 0.56, # optional
# 'IO::Socket::SSL' => 1.956, # optional
'Socket' => 1.95,
},
$ExtUtils::MakeMaker::VERSION >= 6.46 ? (
......
= TODO later
- forward keep-alive \r\n in TCP in stateless proxy. See RFC 5626 4.4.1
......@@ -6,7 +7,6 @@
- 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
which can do tcp
- more tests
......
......@@ -4,7 +4,7 @@ use warnings;
require 5.008;
package Net::SIP;
our $VERSION = '0.702';
our $VERSION = '0.802';
# this includes nearly everything else
use Net::SIP::Simple ();
......
This diff is collapsed.
......@@ -43,10 +43,7 @@ event loop package.
=item outgoing_proxy
Specifies C<< "ip:port" >> of outgoing proxy, e.g the proxy which will
be used for all outgoing packets.
If no leg but an outgoing proxy is specified a leg will be created
which can reach the outgoing proxy by udp.
be used for all outgoing packets. A leg to reach this proxy need to exist.
=item do_retransmits
......@@ -67,6 +64,15 @@ and '*.domain' to include not only the domain but the subdomains
too.
See sub B<deliver> for more details.
=item dnsresolv
Optional function to be used for DNS resolving instead of Net::DNS. This is
intended for testing or for interfacing with own resolver code.
The function is called with C<< (type,name,callback) >> and is expected to
invoke the callback with the answer. C<type> can be SRV, A or AAAA and the
answer is expected to be a list consisting of C<< ['SRV',prio,host,port] >>,
C<< ['A',ip,host] >> and C<< ['AAAA',ip,host] >>.
=back
The constructor will create a timer using the eventloop which
......@@ -144,7 +150,7 @@ REPEAT is the optional repeat interval for the timer.
=item deliver ( PACKET, %ARGS )
Delivers B<Net::SIP::Packet> PACKET.
%ARGS can speciffy hints for delivery:
%ARGS can specify hints for delivery:
=over 8
......@@ -174,8 +180,9 @@ incoming leg for the request.
=item dst_addr
Destionation, i.e. where to deliver the packet as C<< [ip, port, family] >>.
This is necessary for responses, for requests it can be find out based on the
Destination, i.e. where to deliver the packet. This should be given as a hash
with the keys C<proto> (udp|tcp|tls), C<host>, C<addr>, C<port> and C<family>.
This is necessary for responses, for requests it can be found out based on the
requests URI.
=item do_retransmits
......
......@@ -74,7 +74,7 @@ sub addFD {
sub delFD {
my Net::SIP::Dispatcher::Eventloop $self = shift;
my $fd = shift;
defined( my $fn = fileno($fd)) || return;
defined( my $fn = $fd && fileno($fd)) || return;
if (!@_) {
$DEBUG && DEBUG(99, "$self delete fn=$fn sock="
. eval { ip_sockaddr2string(getsockname($fd)) });
......@@ -195,7 +195,11 @@ sub loop {
# wait for selected fds
my $fds = $self->{fd};
my @vec = @{$self->{vec}};
$DEBUG && DEBUG(100,"BEFORE read=%s write=%s",
unpack("b*",$vec[0]), unpack("b*",$vec[1]));
my $nfound = select($vec[0],$vec[1], undef, $to);
$DEBUG && DEBUG(100,"AFTER read=%s write=%s nfound=%d",
unpack("b*",$vec[0]), unpack("b*",$vec[1]), $nfound);
if ($nfound<0) {
next if $! == EINTR;
die $!
......
......@@ -157,7 +157,7 @@ sub run {
};
# enter ip,port into db
my ($ip,$port) = @{$from}[1,2];
my ($ip,$port) = ($from->{addr},$from->{port});
$self->{data}{$ip}{$port}{ time() }++;
$self->savedb();
......
......@@ -247,7 +247,7 @@ sub close_context {
# Args: ($self,$packet,$leg,$from)
# $packet: Net::SIP::Packet
# $leg: Net::SIP::Leg through which the packets was received
# $from: ip:port where it got packet from
# $from: hash with information where it got packet from
# Returns: NONE
############################################################################
sub receive {
......@@ -264,7 +264,7 @@ sub receive {
# Args: ($self,$response,$leg,$from)
# $response: incoming Net::SIP::Response packet
# $leg: where response came in
# $from: ip:port where it got response from
# $from: hash with information where it got response from
# Returns: NONE
############################################################################
sub receive_response {
......@@ -288,7 +288,7 @@ sub receive_response {
# Args: ($self,$request,$leg,$from)
# $request: incoming Net::SIP::Request packet
# $leg: where response came in
# $from: ip:port where it got response from
# $from: hash with information where it got response from
# Returns: NONE
############################################################################
sub receive_request {
......
......@@ -78,7 +78,8 @@ with FROM used to send response packet back to peer.
=item FROM
C<< "ip:port" >> of the sender of the request.
Hash with information about the sender of the request (keys C<proto>, C<addr>,
C<host>, C<port> and C<family>)
=back
......@@ -215,7 +216,7 @@ of active calls.
Called from dispatcher on incoming packets.
PACKET is the incoming L<Net::SIP::Packet>, LEG the L<Net::SIP::Leg>
where the packet came in and FROM the C<< "ip:port" >> of the sender.
where the packet came in and FROM the hash with the sender info.
Just forwards to B<receive_request> or B<receive_response> based
on the type of packet.
......@@ -240,7 +241,7 @@ Calls B<handle_request> on the existing/new context object.
=item new_response ( CTX, RESPONSE, LEG, ADDR )
Delivers L<Net::SIP::Response> packet RESPONSE through the endpoints
dispatcher to ADDR (C<< "ip:port" >>) using L<Net::SIP::Leg> LEG.
dispatcher to ADDR (hash) using L<Net::SIP::Leg> LEG.
LEG and ADDR are usually the leg and the senders address where the
associated request came in.
......
......@@ -269,7 +269,7 @@ sub request_delivery_done {
# Args: ($self,$response,$leg,$from,$endpoint)
# $response: incoming Net::SIP::Response packet
# $leg: Net::SIP::Leg through which the response came in
# $from: ip:port where response came in
# $from: hash with information where response came in
# $endpoint: endpoint responsable for this context, used for redeliveries...
# Returns: NONE
############################################################################
......@@ -321,7 +321,7 @@ sub handle_response {
# must create ACK
DEBUG( 50,"code=$code, must generate ACK" );
my $ack = $tr->{request}->create_ack( $response );
$endpoint->new_request( $ack,$self,undef,undef,leg => $leg, dst_addr => $from );
$endpoint->new_request( $ack,$self,undef,undef,leg => $leg);
}
# transaction is not done
......@@ -382,7 +382,7 @@ sub handle_response {
# and propagate to upper layer
my $req = $tr->{request};
# extract route information on INVIE, but not on re-INVITE
# extract route information on INVITE, but not on re-INVITE
# we assume, that it is a re-INVITE, if we have a remote_contact
# already
if ( ! $self->{remote_contact}
......@@ -409,7 +409,7 @@ sub handle_response {
# if 2xx response changed contact use it as the new URI
my $ack = $req->create_ack( $response );
invoke_callback($cb,@arg,0,$code,$response,$leg,$from,$ack);
$endpoint->new_request( $ack,$self,undef,undef,leg => $leg, dst_addr => $from );
$endpoint->new_request( $ack,$self,undef,undef,leg => $leg);
} else {
......
This diff is collapsed.
......@@ -42,9 +42,16 @@ by calling B<master> on the given B<SocketPool> object.
=item addr
The local address of the socket. If this is given but no port it
The local IP address of the socket. If this is given but no port it
will extract port from addr, if it's in the format C<< host:port >>.
=item host
The hostname matching C<addr>. This is used to create default contact
information and the Via header. If not given defaults to the IP address.
Use of hostname instead of IP address is relevant for TLS where the
name is needed in validation of the peers certificate.
=item port
The port of the socket. Defaults to 5060.
......@@ -55,11 +62,12 @@ The family of the socket. Will be determined from C<addr> if omitted.
=item proto
The connection protocol, e.g. 'tcp' or 'udp'. Defaults to 'udp'.
The connection protocol, e.g. 'udp', 'tcp' or 'tls'. Defaults to 'udp'.
=item dst
The optional fixed target of the leg as C<< [ip, port, family] >>.
The optional fixed target of the leg as hash with keys C<host>, C<addr>, C<port>
and C<family>.
=item contact
......@@ -68,12 +76,19 @@ to outgoing requests and used within Contact header for 200 Responses to
INVITE. If not given it will be created based on C<addr>, C<port>
and C<proto>.
=item tls
Optional arguments to be used in creating a TLS connection, as expected by
L<IO::Socket::SSL>.
These are used for both incoming and outgoing TLS connection. Typically this
involves C<SSL_cert_file>, C<SSL_key_file> and C<SSL_ca_file> or similar.
=back
If no socket is given with C<sock> it will be created based on C<addr>, C<port>
and C<proto>. If this fails the constructur will C<< die() >>.
The constructor will creeate a uniq branch tag for this leg.
The constructor will create a uniq branch tag for this leg.
=back
......@@ -98,8 +113,8 @@ remove itself from B<Route>.
=item deliver ( PACKET, ADDR, [ CALLBACK ] )
Delivers L<Net::SIP::Packet> PACKET through the leg C<$self> to ADDR, which
is C<< [ip, port, family] >>.
Delivers L<Net::SIP::Packet> PACKET through the leg C<$self> to ADDR.
ADDR is a hash with the keys C<host>, C<addr>, C<port> and C<family>.
Usually this method will be call from within L<Net::SIP::Dispatcher>.
If the packet was received by the other end (which is
......@@ -113,8 +128,9 @@ While delivering requests it adds a B<Via> header.
=item receive(PACKET, FROM)
This is called from the dispatcher if the the L<Net::SIP::Packet> B<PACKET> was
received from B<FROM> (given as C<< [ip, port, family] >>). This function might
process the packet further or block it.
received from B<FROM>. FROM is given as hash with keys C<addr>, C<port>,
C<family> and C<proto>.
This function might process the packet further or block it.
It will return C<< (PACKET, FROM) >> in the normal case or C<()> if blocked.
......
......@@ -54,6 +54,7 @@ use Net::SIP::Debug;
# leg can be (derived from) Net::SIP::Leg, a IO::Handle (socket),
# a hash reference for constructing Net::SIP::Leg or a string
# with a SIP address (i.e. sip:ip:port;transport=TCP)
# tls - common TLS settings used when creating a leg
# outgoing_proxy - specify outgoing proxy, will create leg if necessary
# proxy - alias to outgoing_proxy
# route|routes - \@list with SIP routes in right syntax "<sip:host:port;lr>"...
......@@ -81,16 +82,7 @@ sub new {
my ($class,%args) = @_;
my $auth = delete $args{auth};
my $registrar = delete $args{registrar};
my $from = delete $args{from};
my $contact = delete $args{contact};
my $domain = delete $args{domain};
if ($from) {
$domain = $1 if !defined($domain)
&& $from =~m{\bsips?:[^@]+\@([\w\-\.]+)};
$from = "$from <sip:$from\@$domain>"
if $from !~m{\s} && $from !~m{\@};
}
my $tls = delete $args{tls};
my $ua_cleanup = [];
my $self = fields::new( $class );
......@@ -110,55 +102,79 @@ sub new {
}
}
my $disp = delete $args{dispatcher};
my $loop = $disp && $disp->loop
|| delete $args{loop}
|| Net::SIP::Dispatcher::Eventloop->new;
my $proxy = delete $args{outgoing_proxy} || delete $args{proxy};
my $d2p = delete $args{domain2proxy} || delete $args{d2p};
$disp ||= Net::SIP::Dispatcher->new(
[],
$loop,
domain2proxy => $d2p,
);
my $legs = delete $args{legs} || delete $args{leg};
$legs = [ $legs ] if $legs && ref($legs) ne 'ARRAY';
$legs ||= [];
my $host2ip = sub {
my $host = shift;
my $ip;
$disp->dns_host2ip($host,sub { $ip = shift // \0 });
$loop->loop(15,\$ip);
die "failed to resolve $host".($ip ? '':' - timed out')
if ! defined $ip || ref($ip);
return ($ip,ip_is_v46($ip));
};
foreach ($legs ? @$legs : ()) {
if ( UNIVERSAL::isa( $_, 'Net::SIP::Leg' )) {
# keep
} elsif ( UNIVERSAL::isa( $_, 'IO::Handle' )) {
# socket
$_ = Net::SIP::Leg->new( sock => $_ )
$_ = Net::SIP::Leg->new(
sock => $_,
tls => $tls
)
} elsif ( UNIVERSAL::isa( $_, 'HASH' )) {
# create leg from hash
$_ = Net::SIP::Leg->new( %$_ )
$_ = Net::SIP::Leg->new(tls => $tls, %$_)
} elsif (my ($proto,$host,$port,$family) = sip_uri2sockinfo($_)) {
$_ = Net::SIP::Leg->new(proto => $proto,
addr => $host, port => $port, family => $family);
(my $addr,$family) = $family ? ($host,$family) : $host2ip->($host);
$_ = Net::SIP::Leg->new(
proto => $proto,
tls => $tls,
host => $host,
addr => $addr,
port => $port,
family => $family
);
} else {
die "invalid leg specification: $_";
}
}
my $ob = delete $args{outgoing_proxy}
|| delete $args{proxy};
for my $dst ($registrar, $ob) {
$_ or next;
for my $dst ($registrar, $proxy) {
$dst or next;
first { $_->can_deliver_to($dst) } @$legs and next;
my ($proto,$addr,$port,$family) = sip_uri2sockinfo($dst);
my ($proto,$host,$port,$family) = sip_uri2sockinfo($dst);
(my $addr,$family) = $family ? ($host,$family) : $host2ip->($host);
push @$legs, Net::SIP::Leg->new(
proto => $proto,
dst => [ $addr, $port, $family ],
tls => $tls,
dst => {
host => $host,
addr => $addr,
port => $port,
family => $family,
}
);
}
my $loop = delete $args{loop}
|| Net::SIP::Dispatcher::Eventloop->new;
$disp->add_leg(@$legs) if @$legs;
$disp->outgoing_proxy($proxy) if $proxy;
my $d2p = delete $args{domain2proxy} || delete $args{d2p};
my $disp;
if ( $disp = delete $args{dispatcher} ) {
$disp->add_leg( @$legs );
} else {
$disp = Net::SIP::Dispatcher->new(
$legs,
$loop,
outgoing_proxy => $ob,
domain2proxy => $d2p,
);
}
push @$ua_cleanup, [
sub {
my ($self,$legs) = @_;
......@@ -170,6 +186,22 @@ sub new {
my $endpoint = Net::SIP::Endpoint->new( $disp );
my $routes = delete $args{routes} || delete $args{route};
my $from = delete $args{from};
my $contact = delete $args{contact};
my $domain = delete $args{domain};
if ($from) {
if (!defined($domain) && $from =~m{\bsips?:[^@]+\@([\w\-\.]+)}) {
$domain = $1;
}
if ($from !~m{\s} && $from !~m{\@}) {
my $sip_proto = $disp->get_legs(proto => 'tls') ? 'sips' : 'sip';
$from = "$from <$sip_proto:$from\@$domain>";
}
}
die "unhandled arguments: ".join(", ", keys %args) if %args;
%$self = (
auth => $auth,
from => $from,
......@@ -305,7 +337,7 @@ sub register {
my $contact = delete $args{contact} || $self->{contact};
if ( ! $contact) {
$contact = $from;
my $local = $leg->laddr(1);
my $local = $leg->laddr(2);
$contact.= '@'.$local unless $contact =~s{\@([^\s;,>]+)}{\@$local};
}
......@@ -376,7 +408,9 @@ sub invite {
$to || croak( "need peer of call" );
if ( $to !~m{\s} && $to !~m{\@} ) {;
croak( "no domain and no fully qualified to" ) if ! $self->{domain};
$to = "$to <sip:$to\@$self->{domain}>";
my $sip_proto = $self->{dispatcher}->get_legs(proto => 'tls')
? 'sips' : 'sip';
$to = "$to <$sip_proto:$to\@$self->{domain}>";
$ctx->{to} = $to if $ctx;
}
my $call = Net::SIP::Simple::Call->new( $self,$ctx||$to );
......
......@@ -120,6 +120,11 @@ objects.
Hash with mapping between domain and upstream proxy. See same key in the constructor
of L<Net::SIP::Dispatcher> for more details.
=item tls
Common TLS settings for all legs which will be created by this object. See
C<new> in L<Net::SIP::Leg> for more details.
=back
=back
......
This diff is collapsed.
......@@ -15,6 +15,7 @@ use Net::SIP::Util ':all';
use Digest::MD5 qw(md5_hex md5);
use Carp 'croak';
use List::Util 'first';
use Hash::Util 'lock_ref_keys';
use Net::SIP::Debug;
###########################################################################
......@@ -144,9 +145,9 @@ sub _default_rewrite_contact {
}
###########################################################################
# handle incoming requests
# handle incoming packets
# Args: ($self,$packet,$leg,$from)
# $packet: Net::SIP::Request
# $packet: Net::SIP::Packet
# $leg: incoming leg
# $from: ip:port where packet came from
# Returns: TRUE if packet was fully handled
......@@ -250,23 +251,40 @@ sub __forward_response {
my ($first,$param) = sip_hdrval2parts( via => $via );
$first =~m{^SIP/\d\.\d(?:/(\S+))?\s+(.*)};
my $proto = lc($1) || 'udp';
my ($addr,$port,$family) = ip_string2parts($2);
$port ||= 5060; # FIXME default for sip, not sips!
$addr = $param->{maddr} if $param->{maddr};
$addr = $param->{received} if $param->{received}; # where it came from
my ($host,$port,$family) = ip_string2parts($2);
my $addr = $family && $host;
$port ||= $proto eq 'tls' ? 5061 : 5060;
if (my $alt_addr = $param->{received} || $param->{maddr}) {
my $alt_fam = ip_is_v46($alt_addr);
if ($alt_fam) {
$addr = $alt_addr;
$family = $alt_fam;
} else {
DEBUG(10,"ignoring maddr/received because of invalid IP $alt_addr");
}
}
$port = $param->{rport} if $param->{rport}; # where it came from
@{ $entry->{dst_addr}} = [ $proto,$addr,$port,$family ];
$DEBUG && DEBUG(50, "get dst_addr from via header: %s -> %s",
$first, ip_parts2string(@{$entry->{dst_addr}[0]}[1..3]));
if ( $addr !~m{^[0-9\.]+$|:} ) {
$self->{dispatcher}->dns_host2ip(
$addr,
[ \&__forward_response_1,$self,$entry ]
);
} else {
__forward_response_1($self,$entry);
my $nexthop = lock_ref_keys({
proto => $proto,
host => $host || $addr,
addr => $addr,
port => $port,
family => $family
});
if ($addr) {
@{$entry->{dst_addr}} = $nexthop;
$DEBUG && DEBUG(50, "get dst_addr from via header: %s -> %s",
$first, ip_parts2string($nexthop));
return __forward_response_1($self,$entry);
}
return $self->{dispatcher}->resolve_uri(
sip_sockinfo2uri($nexthop),
$entry->{dst_addr},
$entry->{outgoing_leg},
[ \&__forward_response_1,$self,$entry ],
undef,
);
}
###########################################################################
......@@ -277,17 +295,11 @@ sub __forward_response {
sub __forward_response_1 {
my Net::SIP::StatelessProxy $self = shift;
my $entry = shift;
if ( @_ ) {
my ($errno,$ip) = @_;
unless ( $ip ) {
$DEBUG && DEBUG( 10,"cannot resolve address %s ",
ip_parts2string(@{$entry->{dst_addr}[0]}[1..3]));
return;
}
# replace host part in dst_addr with ip
$entry->{dst_addr}[0][1] = $ip;
if (@_) {
$DEBUG && DEBUG( 10,"cannot resolve address %s: @_",
ip_parts2string($entry->{dst_addr}[0]));
return;
}
__forward_packet_final( $self,$entry );
}
......@@ -319,12 +331,11 @@ sub __forward_request_getleg {
}
} else {
my ($data,$param) = sip_hdrval2parts( route => $route );
my ($addr,$port) = ip_string2parts(
(sip_uri2parts($data))[0],
$param->{maddr} ? 1:0, # accept anything as addr if we have maddr
);
$port ||= 5060; # FIXME sips
my @legs = $self->{dispatcher}->get_legs(addr => $addr, port => $port);
my ($proto, $addr, $port, $family) =
sip_uri2sockinfo($data, $param->{maddr} ? 1:0);
$port ||= $proto eq 'tls' ? 5061 : 5060;
my @legs = $self->{dispatcher}->get_legs(
addr => $addr, port => $port, family => $family);
if ( ! @legs and $param->{maddr} ) {
@legs = $self->{dispatcher}->get_legs(
addr => $param->{maddr},
......@@ -341,15 +352,9 @@ sub __forward_request_getleg {
}
if ( @route ) {
# still routing infos. Use next route as nexthop
my $route = $route[0] =~m{<([^\s>]+)>} && $1 || $route[0];
my ($data,$param) = sip_hdrval2parts( route => $route );
my ($addr,$port) = ip_string2parts(
(sip_uri2parts($data))[0],
$param->{maddr} ? 1:0, # accept anything as addr if we have maddr
);
$port ||= 5060; # FIXME sips
$entry->{nexthop} = ip_parts2string($param->{maddr} || $addr,$port);
DEBUG( 50, "setting nexthop from route $route to $entry->{nexthop}" );
my ($data,$param) = sip_hdrval2parts( route => $route[0] );
$entry->{nexthop} = $data;
DEBUG(50, "setting nexthop from route $route[0] to $entry->{nexthop}");
}
return $self->__forward_request_getdaddr($entry)
......@@ -368,15 +373,14 @@ sub __forward_request_getdaddr {
return __forward_request_1( $self,$entry )
if @{ $entry->{dst_addr}};
my $proto = $entry->{incoming_leg}{proto} eq 'tcp' ? [ 'tcp','udp' ]:undef;
$entry->{nexthop} ||= $entry->{packet}->uri,
DEBUG(50,"need to resolve $entry->{nexthop} proto=".($proto ? "@$proto": ''));
DEBUG(50,"need to resolve $entry->{nexthop}");
return $self->{dispatcher}->resolve_uri(
$entry->{nexthop},
$entry->{dst_addr},
$entry->{outgoing_leg},
[ \&__forward_request_1,$self,$entry ],
$proto,
undef,
);
}
......@@ -388,6 +392,11 @@ sub __forward_request_1 {
my Net::SIP::StatelessProxy $self = shift;
my $entry = shift;
if (@_) {
DEBUG(10,"failed to resolve URI: @_");
return;
}
my $dst_addr = $entry->{dst_addr};
if ( ! @$dst_addr ) {
DEBUG( 10,"cannot find dst for uri ".$entry->{packet}->uri );
......@@ -396,7 +405,7 @@ sub __forward_request_1 {
my %hostnames;
foreach (@$dst_addr) {
ref($_) or Carp::confess("expected reference: $_");
$hostnames{$_->[0]} = $_->[0] if ! $_->[2];
$hostnames{$_->{host}} = $_->{host} if ! $_->{addr};
}
if ( %hostnames ) {
$self->{dispatcher}->dns_host2ip(
......@@ -420,11 +429,11 @@ sub __forward_request_2 {
while ( my ($host,$ip) = each %$host2ip ) {
unless ( $ip ) {
DEBUG( 10,"cannot resolve address $host" );
@$dst_addr = grep { $_->[1] ne $host } @$dst_addr;
@$dst_addr = grep { $_->{host} ne $host } @$dst_addr;
next;
} else {
DEBUG( 50,"resolved $host -> $ip" );
$_->[1] = $ip for grep { $_->[1] eq $host } @$dst_addr;
$_->{addr} = $ip for grep { $_->{host} eq $host } @$dst_addr;</