1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
#!/usr/bin/perl
###########################################################################
# creates a UAC and a UAS using Net::SIP::Simple
# and makes call from UAC to UAS,
# transfer RTP data during call, then hang up
###########################################################################
use strict;
use warnings;
use Test::More tests => 8*6;
do './testlib.pl' || do './t/testlib.pl' || die "no testlib";
use Net::SIP ':all';
use IO::Socket;
use File::Temp;
my @tests;
for my $transport (qw(udp tcp tls)) {
for my $family (qw(ip4 ip6)) {
push @tests, [ $transport, $family ];
}
}
for my $t (@tests) {
my ($transport,$family) = @$t;
SKIP: {
if (my $err = test_use_config($family,$transport)) {
skip $err,8;
next;
}
note("------- test with family $family transport $transport");
do_test($transport);
}
}
sub do_test {
my $transport = shift;
# create leg for UAS on dynamic port
my ($sock_uas,$uas_addr) = create_socket($transport);
note( "UAS on $uas_addr" );
# fork UAS and make call from UAC to UAS
pipe( my $read,my $write); # for status updates
defined( my $pid = fork() ) || die $!;
if ( $pid == 0 ) {
# CHILD = UAS
$SIG{__DIE__} = undef;
close($read);
$write->autoflush;
uas( $sock_uas, $write );
exit(0);
}
local $SIG{__DIE__} = sub { kill 9,$pid if $pid; ok( 0,'died' ) };
local $SIG{ALRM} = sub { kill 9,$pid if $pid; ok( 0,'timed out' ) };
alarm(30);
# PARENT = UAC
close( $sock_uas );
close($write);
uac(test_sip_uri($uas_addr), $read);
ok( <$read>, "UAS finished" );
killall();
}
###############################################
# UAC
###############################################
sub uac {
my ($peer_uri,$pipe) = @_;
Debug->set_prefix( "DEBUG(uac):" );
my $packets = 100;
my $send_something = sub {
return unless $packets-- > 0;
my $buf = sprintf "%010d",$packets;
$buf .= "1234567890" x 15;
return $buf; # 160 bytes for PCMU/8000
};
# create Net::SIP::Simple object
my $rtp_done;
my ($transport) = sip_uri2sockinfo($peer_uri);
my ($lsock,$laddr) = create_socket($transport);
note( "UAC on $laddr" );
my $uac = Simple->new(
from => 'me.uac@example.com',
domain2proxy => { 'example.com' => $peer_uri },
leg => Net::SIP::Leg->new(
sock => $lsock,
test_leg_args('caller.sip.test'),
),
);
ok( $uac, 'UAC created' );
# wait until UAS is ready and listening
ok( <$pipe>, "UAS ready\n" );
# Call UAS
my $call = $uac->invite(
'you.uas@example.com',
init_media => $uac->rtp( 'send_recv', $send_something ),
cb_rtp_done => \$rtp_done,
);
ok( ! $uac->error, 'no error on UAC' );
ok( $call, 'Call established' );
$call->loop( \$rtp_done, 10 );
ok( $rtp_done, "Done sending RTP" );
my $stop;
$call->bye( cb_final => \$stop );
$call->loop( \$stop,10 );
ok( $stop, 'UAS down' );
ok( <$pipe>, "UAS RTP ok\n" );
$uac->cleanup;
}
###############################################
# UAS
###############################################
sub uas {
my ($sock,$pipe) = @_;
Debug->set_prefix( "DEBUG(uas):" );
my $uas = Simple->new(
domain => 'example.com',
leg => Net::SIP::Leg->new(
sock => $sock,
test_leg_args('listen.sip.test'),
),
) || die $!;
# store received RTP data in array
my @received;
my $save_rtp = sub {
my $buf = shift;
push @received,$buf;
#warn substr( $buf,0,10)."\n";
};
# Listen
my $call_closed;
$uas->listen(
cb_create => sub { note( 'call created' );1 },
cb_established => sub { note( 'call established' ) },
cb_cleanup => sub {
note( 'call cleaned up' );
$call_closed =1;
},
init_media => $uas->rtp( 'recv_echo', $save_rtp ),
);
# notify UAC process that I'm listening
print $pipe "UAS ready\n";
# Loop until call is closed, at most 10 seconds
$uas->loop( \$call_closed, 10 );
$uas->cleanup;
note( "received ".int(@received)."/100 packets" );
# at least 20% of all RTP packets should come through
if ( @received > 20 ) {
print $pipe "UAS RTP ok\n"
} else {
print $pipe "UAS RTP received only ".int(@received)."/100 packets\n";
}
# done
if ( $call_closed ) {
print $pipe "UAS finished\n";
} else {
print $pipe "call closed by timeout not stopvar\n";
}
}
|
