File: invite_and_recv.pl

package info (click to toggle)
libnet-sip-perl 0.46-1
  • links: PTS, VCS
  • area: main
  • in suites: lenny
  • size: 720 kB
  • ctags: 328
  • sloc: perl: 7,312; makefile: 2
file content (167 lines) | stat: -rw-r--r-- 5,064 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
###########################################################################
# Invite other party, recv RTP data for some seconds or until other side
# hangs up, then BYE
# optional registration
#
# Most of the code is option parsing and usage, the Net::SIP related code
# is at the end
###########################################################################

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, optional record data
and optional hang up after some time
Options:
  -d|--debug [level]           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
  -O|--outfile filename        write received RTP data to file
  -T|--time interval           hang up after interval seconds
  -L|--leg ip[:port]           use given local ip[:port] for outgoing leg
  -C|--contact sipaddr         use given contact address for contact in register and invite
  --username name              username for authorization
  --password pass              password for authorization
  --route host[:port]          add SIP route, can be specified multiple times

Examples:
  $0 -T 10 -O record.data sip:30\@192.168.178.4 sip:31\@192.168.178.1
  $0 --username 30 --password secret --proxy=192.168.178.3 sip:30\@example.com 31
  $0 --username 30 --password secret --leg 192.168.178.4 sip:30\@example.com 31

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


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

my ($proxy,$outfile,$registrar,$username,$password,$hangup,$local_leg,$contact);
my (@routes,$debug);
GetOptions(
	'd|debug:i' => \$debug,
	'h|help' => sub { usage() },
	'P|proxy=s' => \$proxy,
	'R|registrar=s' => \$registrar,
	'O|outfile=s' => \$outfile,
	'T|time=i' => \$hangup,
	'L|leg=s' => \$local_leg,
	'C|contact=s' => \$contact,
	'username=s' =>\$username,
	'password=s' =>\$password,
	'route=s' => \@routes,
) || 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,
	route => \@routes,
	legs => \@legs,
	$contact ? ( contact => $contact ):(),
	$username ? ( auth => [ $username,$password ] ):(),
);

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

# invite peer
my $peer_hangup; # did peer hang up?
my $call = $ua->invite( $to,
	# echo back, use -1 instead of 0 for not echoing back
	init_media => $ua->rtp( 'recv_echo', $outfile,0 ),
	recv_bye => \$peer_hangup,
) || die "invite failed: ".$ua->error;
die "invite failed(call): ".$call->error if $call->error;

# mainloop until other party hangs up or we hang up after
# $hangup seconds
my $stopvar;
$ua->add_timer( $hangup, \$stopvar ) if $hangup;
$ua->loop( \$stopvar,\$peer_hangup );

# timeout, I need to hang up
if ( $stopvar ) {
	$stopvar = undef;
	$call->bye( cb_final => \$stopvar );
	$ua->loop( \$stopvar );
}