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
|
#!/usr/bin/perl
###########################################################################
# creates a UAC and a UAS using Net::SIP::Simple
# and makes call from UAC to UAS,
# Call does not involve transfer of RTP data
###########################################################################
use strict;
use warnings;
use Test::More tests => 8;
use Net::SIP ':alias';
use Net::SIP::Util ':all';
use IO::Socket;
use Net::SIP::Blocker;
# create leg for UAS on dynamic port
my $sock_uas = IO::Socket::INET->new(
Proto => 'udp',
LocalAddr => '127.0.0.1',
LocalPort => 0, # let system pick one
);
ok( $sock_uas, 'create UAS socket' );
# get address for UAS
my $uas_addr = do {
my ($port,$host) = unpack_sockaddr_in ( getsockname($sock_uas));
inet_ntoa( $host ).":$port"
};
# fork UAS and make call from UAC to UAS
pipe( my $read,my $write); # to sync UAC with UAS
my $pid = fork();
if ( defined($pid) && $pid == 0 ) {
close($read);
$write->autoflush;
uas( $sock_uas, $write );
exit(0);
}
ok( $pid, "fork successful" );
close( $sock_uas );
close($write);
alarm(10);
$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):" );
ok( <$pipe>, "UAS created\n" ); # wait until UAS is ready
my $uac = Simple->new(
from => 'me.uac@example.com',
leg => scalar(create_socket_to( $peer_addr )),
domain2proxy => { 'example.com' => $peer_addr },
);
ok( $uac, 'UAC created' );
my $blocking;
my $call = $uac->invite(
'you.uas@example.com',
cb_final => sub {
my ($status,$self,%info) = @_;
$blocking++ if $info{code} == 405;
}
);
ok( ! $uac->error, 'UAC ready' );
ok( <$pipe>, "UAS ready\n" ); # wait until UAS is ready
$call->loop(\$blocking, 5);
ok( $blocking,'UAC got block 405 and finished' );
# done
if ( $blocking ) {
print $pipe "UAC finished\n";
} else {
print $pipe "call closed by timeout not stopvar\n";
}
}
###############################################
# UAS
###############################################
sub uas {
my ($sock,$pipe) = @_;
Debug->set_prefix( "DEBUG(uas):" );
my $leg = Leg->new( sock => $sock );
my $loop = Dispatcher_Eventloop->new;
my $disp = Dispatcher->new( [ $leg ],$loop ) || die $!;
print $pipe "UAS created\n";
# Blocking
my $block = Net::SIP::Blocker->new(
block => { 'INVITE' => 405 },
dispatcher => $disp,
);
$disp->set_receiver( $block );
print $pipe "UAS ready\n";
$loop->loop(2);
print $pipe "UAS finished\n";
}
|
