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
|
#!/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;
do './testlib.pl' || do './t/testlib.pl' || die "no testlib";
use Net::SIP ':all';
use IO::Socket;
use File::Temp;
# create leg for UAS on dynamic port
my ($sock_uas,$uas_addr) = create_socket();
diag( "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
close($read);
$write->autoflush;
uas( $sock_uas, $write );
exit(0);
}
# PARENT = UAC
close( $sock_uas );
close($write);
alarm(15);
$SIG{__DIE__} = $SIG{ALRM} = sub { kill 9,$pid; ok( 0,'died' ) };
uac( $uas_addr,$read );
ok( <$read>, "UAS finished" );
wait;
###############################################
# UAC
###############################################
sub uac {
my ($peer_addr,$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 ($lsock,$laddr) = create_socket_to( $peer_addr );
diag( "UAC on $laddr" );
my $uac = Simple->new(
from => 'me.uac@example.com',
leg => $lsock,
domain2proxy => { 'example.com' => $peer_addr },
);
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" );
}
###############################################
# UAS
###############################################
sub uas {
my ($sock,$pipe) = @_;
Debug->set_prefix( "DEBUG(uas):" );
my $uas = Simple->new(
domain => 'example.com',
leg => $sock
) || 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 { diag( 'call created' );1 },
cb_established => sub { diag( 'call established' ) },
cb_cleanup => sub {
diag( '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 );
diag( "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";
}
}
|
