File: invite_and_send.pl

package info (click to toggle)
libnet-sip-perl 0.59-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 856 kB
  • ctags: 338
  • sloc: perl: 7,864; makefile: 7
file content (189 lines) | stat: -rw-r--r-- 5,756 bytes parent folder | download | duplicates (3)
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
182
183
184
185
186
187
188
189
###########################################################################
# Invite other party, and send some files. Uses re-INVITEs to support
# sending of multiple files. Exits once done or when peer hangs
# up
#
# Most of the code is option parsing and usage, the Net::SIP related code
# is at the end. The code is very similar to samples/invite_and_recv.pl,
# the main difference is at the end, using media_send_recv instead of
# media_recv_echo and doing re-invites on the same call
###########################################################################

use strict;
use warnings;
use IO::Socket::INET;
use Getopt::Long qw(:config posix_default bundling);

use Net::SIP;
use Net::SIP::Util 'create_socket_to';
use Net::SIP::Debug;

sub usage {
	print STDERR "ERROR: @_\n" if @_;
	print STDERR <<EOS;
usage: $0 [ options ] FROM TO
Makes SIP call from FROM to TO, sends voice from multiple
files to peer. Content in files need to be PCMU/8000 and
could be recorded with samples/invite_and_recv.pl

Options:
  -d|--debug                   Enable debugging
  -h|--help                    Help (this info)
  -P|--proxy host[:port]       use outgoing proxy, register there unless registrar given
  -R|--registrar host[:port]   register at given address
  -S|--send filename           send content of file, can be given multiple times
  -L|--leg ip[:port]           use given local ip[:port] for outgoing leg
  -T|--timeout T               timeout and cancel invite after T seconds, default 30
  --username name              username for authorization
  --password pass              password for authorization

Examples:
  $0 -T 10 -S welcome.data -S announce.data sip:30\@192.168.178.4 sip:31\@192.168.178.1
  $0 --username 30 -password secret --proxy=192.168.178.3 \
     -S holy_shit.data sip:30\@example.com 31

EOS
	exit( @_ ? 1:0 );
}


###################################################
# Get options
###################################################

my $ring_time = 30;
my ($proxy,@files,$registrar,$username,$password,$local_leg);
my ($debug,$hangup);
GetOptions(
	'd|debug:i' => \$debug,
	'h|help' => sub { usage() },
	'P|proxy=s' => \$proxy,
	'R|registrar=s' => \$registrar,
	'S|send=s' => \@files,
	'L|leg=s' => \$local_leg,
	'T|timeout=s' => \$ring_time,
	'username=s' =>\$username,
	'password=s' =>\$password,
) || usage( "bad option" );


Net::SIP::Debug->level( $debug || 1 ) if defined $debug;
my ($from,$to) = @ARGV;
$to || usage( "no target" );

# register at proxy if proxy given and no registrar
$registrar ||= $proxy;

###################################################
# find local leg
###################################################
my ($local_host,$local_port);
if ( $local_leg ) {
	($local_host,$local_port) = split( m/:/,$local_leg,2 );
} elsif ( ! $proxy ) {
	# if no proxy is given we need to find out
	# about the leg using the IP given from FROM
	($local_host,$local_port) = $from =~m{\@([\w\-\.]+)(?::(\d+))?}
		or die "cannot find SIP domain in '$from'";
}

my $leg;
if ( $local_host ) {
	my $addr = gethostbyname( $local_host )
		|| die "cannot get IP from SIP domain '$local_host'";
	$addr = inet_ntoa( $addr );

	$leg = IO::Socket::INET->new(
		Proto => 'udp',
		LocalAddr => $addr,
		LocalPort => $local_port || 5060,
	);

	# if no port given and port 5060 is already used try another one
	if ( !$leg && !$local_port ) {
		$leg = IO::Socket::INET->new(
			Proto => 'udp',
			LocalAddr => $addr,
			LocalPort => 0
		) || die "cannot create leg at $addr: $!";
	}

	$leg = Net::SIP::Leg->new( sock => $leg );
}


###################################################
# SIP code starts here
###################################################

# create necessary legs
# If I have an only outgoing proxy I could skip this step because constructor
# can make leg to outgoing_proxy itself
my @legs;
push @legs,$leg if $leg;
foreach my $addr ( $proxy,$registrar) {
	$addr || next;
	if ( ! grep { $_->can_deliver_to( $addr ) } @legs ) {
		my $sock = create_socket_to($addr) || die "cannot create socket to $addr";
		push @legs, Net::SIP::Leg->new( sock => $sock );
	}
}

# create user agent
my $ua = Net::SIP::Simple->new(
	from => $from,
	outgoing_proxy => $proxy,
	legs => \@legs,
	$username ? ( auth => [ $username,$password ] ):(),
);

# optional registration
if ( $registrar && $registrar ne '-' ) {
	$ua->register( registrar => $registrar );
	die "registration failed: ".$ua->error if $ua->error
}

# invite peer, send first file
my $peer_hangup; # did peer hang up?
my $no_answer; # or didn't it even answer?
my $rtp_done; # was sending file completed?
my $call = $ua->invite( $to,
	# echo back, use -1 instead of 0 for not echoing back
	init_media => $ua->rtp( 'send_recv', $files[0] ),
	cb_rtp_done => \$rtp_done,
	recv_bye => \$peer_hangup,
	cb_noanswer => \$no_answer,
	ring_time => $ring_time,
) || die "invite failed: ".$ua->error;
die "invite failed(call): ".$call->error if $call->error;

DEBUG( "Call established (maybe), sending first file $files[0]" );
$ua->loop( \$rtp_done,\$peer_hangup,\$no_answer );

die "Ooops, no answer." if $no_answer;

# mainloop until other party hangs up or we are done
# send one file after the other using re-invites
while ( ! $peer_hangup ) {

	shift(@files); # done with file
	@files || last;

	# re-invite on current call for next file
	DEBUG( "rtp_done=$rtp_done" );
	my $rtp_done;
	$call->reinvite(
		init_media => $ua->rtp( 'send_recv', $files[0] ),
		cb_rtp_done => \$rtp_done,
		recv_bye => \$peer_hangup, # FIXME: do we need to repeat this?
	);
	DEBUG( "sending next file $files[0]" );
	$ua->loop( \$rtp_done,\$peer_hangup );
}

unless ( $peer_hangup ) {
	# no more files: hangup
	my $stopvar;
	$call->bye( cb_final => \$stopvar );
	$ua->loop( \$stopvar );
}