| Subject: | [PATCH] Timeout support for Net::SIP |
| Date: | Mon, 31 Mar 2008 18:53:20 +0200 |
| To: | bug-Net-SIP [...] rt.cpan.org |
| From: | Roland Mas <lolando [...] debian.org> |
Hi,
I didn't find a simple way of handling the situation where a client
written with Net::SIP initiates a connection but the peer does not
respond. As far as I can see, there's no such feature in version
0.44.1. So I started working on it, and I think I reached a point
where the patch is not too ugly (while still working). So I'm
proposing it for review and inclusion into future versions of
Net::SIP.
I patched one of the sample clients to demonstrate basic usage.
Roland.
--
Roland Mas
When you have a hammer in your hand, most things look like a nail.
--- libnet-sip-perl-0.44.1.orig/lib/Net/SIP/Endpoint/Context.pm
+++ libnet-sip-perl-0.44.1/lib/Net/SIP/Endpoint/Context.pm
@@ -276,7 +276,7 @@
my $method = $tr->{request}->method;
$response->cseq =~m{^\d+\s+(\w+)};
- if ($method ne $1 ) {
+ if ( ($method ne $1) and !($method eq 'INVITE' and $1 eq 'CANCEL') and !($method eq 'ACK' and $1 eq 'INVITE') ){
DEBUG( 10,"got response to method $1 but current method is $method. DROP" );
return;
}
--- libnet-sip-perl-0.44.1.orig/lib/Net/SIP/Simple/Call.pm
+++ libnet-sip-perl-0.44.1/lib/Net/SIP/Simple/Call.pm
@@ -224,6 +224,24 @@
invoke_callback( $param->{init_media},$self,$param );
};
+ my $noanswercb = sub {
+ my Net::SIP::Simple::Call $self = shift || return;
+ my ($endpoint,$ctx,$errno,$code,$packet,$leg,$from,$ack) = @_;
+
+ invoke_callback( $param->{cb_noanswer}, 'NOANSWER',$self,errno => $errno,code => $code,packet => $packet );
+
+ # response to CANCEL
+ # all other responses will not be propagated to this callback
+ my $param = $self->{param};
+
+ if ( $code =~ m{^2\d\d} ) {
+ DEBUG(10,"got response of %s|%s to CANCEL",$code,$packet->msg );
+ invoke_callback( $param->{cb_final},'NOANSWER',$self,code => $code );
+ return;
+ }
+
+ };
+
my $stopvar = 0;
$param->{cb_final} ||= \$stopvar;
$cb = [ $cb,$self ];
@@ -232,9 +250,22 @@
$ctx, $cb, $sdp,
$param->{sip_header} ? %{ $param->{sip_header} } : ()
);
+
+ $noanswercb = [ $noanswercb,$self ];
+ weaken( $noanswercb->[1] );
+
if ( $param->{cb_final} == \$stopvar ) {
# wait until final response
- $self->loop( \$stopvar );
+ $self->loop( $param->{ring_time}, \$stopvar );
+
+ unless ($stopvar) { # Timing out
+ my $cur_req = $self->{ctx}->{_transactions}->[0]->{request} ;
+
+ $self->{endpoint}->new_request($cur_req->create_cancel,
+ $self->{ctx}, $noanswercb) ;
+
+ $stopvar = 'NOANSWER' ;
+ }
$param->{cb_final} = undef;
}
return $self->{ctx};
--- libnet-sip-perl-0.44.1.orig/samples/invite_and_send.pl
+++ libnet-sip-perl-0.44.1/samples/invite_and_send.pl
@@ -142,17 +142,22 @@
# invite peer, send first file
my $peer_hangup; # did peer hang up?
+my $no_answer; # or didn't it even answer?
my $rtp_done; # was sending file completed?
my $call = $ua->invite( $to,
# echo back, use -1 instead of 0 for not echoing back
init_media => $ua->rtp( 'send_recv', $files[0] ),
cb_rtp_done => \$rtp_done,
recv_bye => \$peer_hangup,
+ cb_noanswer => \$no_answer,
+ ring_time => 30,
) || die "invite failed: ".$ua->error;
die "invite failed(call): ".$call->error if $call->error;
-DEBUG( "sending first file $files[0]" );
-$ua->loop( \$rtp_done,\$peer_hangup );
+DEBUG( "Call established (maybe), sending first file $files[0]" );
+$ua->loop( \$rtp_done,\$peer_hangup,\$no_answer );
+
+die "Ooops, no answer." if $no_answer;
# mainloop until other party hangs up or we are done
# send one file after the other using re-invites