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
|
#!/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
# UAS will on ring, but never 200 Ok, UAC will cancel call
###########################################################################
use strict;
use warnings;
use Test::More tests => 7;
use Net::SIP;
use Net::SIP::Util ':all';
use IO::Socket;
# 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(15);
$SIG{__DIE__} = $SIG{ALRM} = sub { kill 9,$pid; ok( 0,'died' ) };
uac( $uas_addr,$read );
ok( <$read>, "done" );
wait;
###############################################
# UAC
###############################################
sub uac {
my ($peer_addr,$pipe) = @_;
Net::SIP::Debug->set_prefix( "DEBUG(uac):" );
ok( <$pipe>, "UAS created\n" ); # wait until UAS is ready
my $uac = Net::SIP::Simple->new(
from => 'me.uac@example.com',
leg => scalar(create_socket_to( $peer_addr )),
domain2proxy => { 'example.com' => $peer_addr },
);
ok( $uac, 'UAC created' );
ok( <$pipe>, "UAS ready\n" ); # wait until UAS is ready
my $canceled = 0;
my $call = $uac->invite(
'you.uas@example.com',
cb_noanswer => \$canceled,
ring_time => 3,
);
ok( $canceled,"request was canceled" );
}
###############################################
# UAS
###############################################
sub uas {
my ($sock,$pipe) = @_;
Net::SIP::Debug->set_prefix( "DEBUG(uas):" );
my $uas = Net::SIP::Simple->new(
domain => 'example.com',
leg => $sock
) || die $!;
print $pipe "UAS created\n";
my $timer;
my $got_cancel;
my $my_receive = sub {
my ($self,$endpoint,$ctx,$error,$code,$packet,$leg,$from) = @_;
if ( $packet->is_request && $packet->method eq 'INVITE' ) {
# just ring
my $ring = $packet->create_response( 180,'Ringing' );
$timer ||= $endpoint->{dispatcher}->add_timer( 1,
sub { $endpoint->new_response( $ctx,$ring,$leg,$from ) },
1 );
return;
}
if ( $timer && $packet->is_request && $packet->method eq 'CANCEL' ) {
$timer->cancel;
$got_cancel =1;
}
goto &Net::SIP::Simple::Call::receive;
};
# Listen
$uas->listen( cb_create => sub { return $my_receive } );
# notify UAC process that I'm listening
print $pipe "UAS ready\n";
# Loop at most 10 seconds
$uas->loop( 10,\$got_cancel );
$uas->loop( 1 );
print $pipe "UAS done\n";
}
|