1#!/usr/bin/perl 2 3############################################################################# 4# 5# very similar to t/06_call_with_reinvite.t, except that the reinvite 6# puts the UAS on hold 7# - UAS listens 8# - UAC calls UAS 9# - UAS accepts call 10# - UAC sends some data to UAS 11# - after some time UAS re-invites UAC, but with c=0.0.0.0, e.g 12# it puts the call on hold 13# - UAC accepts 14# - UAS sends some data to UAC, UAC does not send back even if 15# recv_echo is used 16# - after a while UAC hangs up 17# 18############################################################################# 19 20use strict; 21use warnings; 22use Test::More tests => 16*6; 23do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 24 25use Net::SIP ':all'; 26 27my @tests; 28for my $transport (qw(udp tcp tls)) { 29 for my $family (qw(ip4 ip6)) { 30 push @tests, [ $transport, $family ]; 31 } 32} 33 34for my $t (@tests) { 35 my ($transport,$family) = @$t; 36 SKIP: { 37 if (my $err = test_use_config($family,$transport)) { 38 skip $err,16; 39 next; 40 } 41 note("------- test with family $family transport $transport"); 42 43 my ($csock,$caddr) = create_socket($transport); 44 my ($ssock,$saddr) = create_socket($transport); 45 46 # start UAS 47 my $uas = fork_sub( 'uas',$ssock,$caddr,$saddr ); 48 fd_grep_ok( 'Listening',$uas ); 49 50 # start UAC once UAS is ready 51 my $uac = fork_sub( 'uac',$csock,$caddr,$saddr ); 52 fd_grep_ok( 'Started',$uac ); 53 fd_grep_ok( 'Call accepted',$uas ); 54 55 # first RTP from UAC to UAS 56 fd_grep_ok( 'Start RTP', $uac ); 57 fd_grep_ok( 'RTP#50#', $uac ); 58 fd_grep_ok( 'got rtp packet#50', $uas ); 59 60 # then re-invite 61 fd_grep_ok( 'Starting ReInvite', $uas ); 62 fd_grep_ok( 'Got ReInvite', $uac ); 63 64 # RTP from UAS to UAC 65 fd_grep_ok( 'Start RTP', $uas ); 66 fd_grep_ok( 'RTP#50#', $uas ); 67 fd_grep_ok( 'got rtp packet#50', $uac ); 68 69 # BYE from UAC 70 # UAS should not receive anything 71 fd_grep_ok( 'Send BYE',$uac ); 72 fd_grep_ok( 'Received BYE after 0 bytes read',$uas ); 73 fd_grep_ok( 'BYE done',$uac ); 74 } 75} 76 77 78killall(); 79 80 81############################################################################# 82# UAC 83############################################################################# 84 85sub uac { 86 my ($lsock,$laddr,$peer) = @_; 87 my $ua = Simple->new( 88 from => test_sip_uri("uac\@$laddr"), 89 leg => Net::SIP::Leg->new( 90 sock => $lsock, 91 test_leg_args('caller.sip.test'), 92 ) 93 ); 94 print "Started\n"; 95 96 # call and transfer data until I get reinvite 97 # then change RTP handling to recv_echo and stop after 50 packets 98 99 my ($reinvite,$stop_rtp50); 100 my $switch_media_on_reinvite = sub { 101 my ($ok,$call) = @_; 102 DEBUG( "switch media" ); 103 $call->set_param( 104 init_media => $call->rtp( 'recv_echo', [ \&_recv_rtp, \( my $i=0 ), \$stop_rtp50 ] ), 105 ); 106 $reinvite = 1; 107 }; 108 109 my $call = $ua->invite( test_sip_uri("uas\@$peer"), 110 init_media => $ua->rtp( 'send_recv', [ \&_send_rtp, \( my $i = 0) ] ), 111 cb_established => $switch_media_on_reinvite, 112 clear_sdp => 1, # don't reuse sockets from last RTP session 113 ) || die; 114 115 # wait for reinvite done 116 $ua->loop( 10,\$reinvite ); 117 $reinvite || die; 118 print "Got ReInvite\n"; 119 120 # wait until 50 packets received from the new connection 121 $ua->loop( 5,\$stop_rtp50 ); 122 123 # and bye 124 print "Send BYE\n"; 125 $call->bye( cb_final => \( my $bye_ok )); 126 $ua->loop( 10,\$bye_ok ); 127 $ua->cleanup; 128 print "BYE done\n" if $bye_ok; 129 130 131} 132 133 134############################################################################# 135# UAS 136############################################################################# 137 138sub uas { 139 my ($lsock,$laddr,$peer) = @_; 140 my $ua = Simple->new( 141 from => test_sip_uri("uas\@$laddr"), 142 leg => Net::SIP::Leg->new( 143 sock => $lsock, 144 test_leg_args('listen.sip.test'), 145 ) 146 ); 147 148 # accept call and send some data, set $stop once 149 # the call was established 150 my $stop = 0; 151 my $stop_rtp50 = 0; 152 my $call; 153 my $init_media_recv = sub { 154 (undef,$call) = @_; 155 DEBUG( "accepted call" ); 156 $call->set_param( init_media => 157 $call->rtp( 'recv_echo', [ \&_recv_rtp, \( my $i=0 ), \$stop_rtp50 ],-1 ) 158 ); 159 $stop = 1; 160 }; 161 $ua->listen( cb_established => $init_media_recv ); 162 print "Listening\n"; 163 $ua->loop( \$stop ); 164 print "Call accepted\n"; 165 166 # wait until I got 50 packets 167 $ua->loop( \$stop_rtp50 ); 168 169 # Reinvite and send data until I get BYE 170 print "Starting ReInvite\n"; 171 my $bytes = 0; 172 my $write_bytes = sub { $bytes += length($_[0]) }; 173 my $recv_bye = 0; 174 my $init_media_send = sub { 175 my ($ok,$call) = @_; 176 DEBUG( "init media because re-invite was $ok" ); 177 $stop = 1; 178 $ok eq 'OK' or die; 179 $call->set_param( 180 init_media => $call->rtp( 181 'send_recv', 182 [ \&_send_rtp, \( my $i=0 ) ], 183 1, 184 $write_bytes, 185 ), 186 recv_bye => \$recv_bye, 187 ); 188 }; 189 $stop = 0; 190 $call->reinvite( 191 clear_sdp => 1, 192 cb_final => $init_media_send, 193 call_on_hold => 1, 194 ); 195 196 # wait until INVITE succeeds 197 $ua->loop( 10,\$stop ); 198 print "ReInvite succeeded\n" if $stop eq 'OK'; 199 print "ReInvite FAILED\n" if $stop eq 'FAIL'; 200 201 # wait until I got BYE 202 $ua->loop( 10, \$recv_bye ); 203 print "Received BYE after $bytes bytes read\n" if $recv_bye; 204 205 # make sure the reply for the BYE makes it on the wire 206 $ua->loop(1); 207 $ua->cleanup; 208} 209 210 211sub _send_rtp { 212 my $iref = shift; 213 $$iref++; 214 if ( $$iref == 1 ) { 215 print "Start RTP\n"; 216 } elsif ( $$iref % 50 == 0 ) { 217 # log after each seconds 218 print "RTP#$$iref#\n"; 219 } 220 #DEBUG( "send packet $$iref" ); 221 return "0123456789" x 16; 222} 223 224sub _recv_rtp { 225 my ($iref,$stopvar,$payload) = @_; 226 $$iref++; 227 #DEBUG( 50,"got data $$iref" ); 228 if ( $$iref == 50 ) { 229 print "got rtp packet#50\n"; 230 $$stopvar = 1; 231 } 232} 233