1###########################################################################
2# Simple answer machine:
3# - Register and listen
4# - On incoming call send welcome message and send data to file, hangup
5#   after specified time
6# - Recorded data will be saved as %d_%s_.pcmu-8000 where %d is the
7#   timestamp from time() and %s is the data from the SP 'From' header.
8#   to convert this to something more usable you might use 'sox' from
9#   sox.sf.net, e.g for converting to OGG:
10#   sox -t raw -b -U -c 1 -r 8000  file.pcmu-8000 file.ogg
11# - Recording starts already at the beginning, not after the welcome
12#   message is done
13###########################################################################
14
15use strict;
16use warnings;
17use IO::Socket::INET;
18use Getopt::Long qw(:config posix_default bundling);
19
20use Net::SIP;
21use Net::SIP::Util ':all';
22use Net::SIP::Debug;
23
24sub usage {
25    print STDERR "ERROR: @_\n" if @_;
26    print STDERR <<EOS;
27usage: $0 [ options ] FROM
28Listens on SIP address FROM for incoming calls. Sends
29welcome message and records data from user in PCMU/800 format.
30
31Options:
32  -d|--debug [level]           Enable debugging
33  -h|--help                    Help (this info)
34  -R|--registrar host[:port]   register at given address
35  -W|--welcome filename        welcome message
36  -T|--timeout time            record at most time seconds (default 60)
37  -D|--savedir directory       where to save received messages (default .)
38  --username name              username for authorization
39  --password pass              password for authorization
40
41Example:
42  $0 -T 20 -W welcome.data --register 192.168.178.3 sip:30\@example.com
43
44EOS
45    exit( @_ ? 1:0 );
46}
47
48
49###################################################
50# Get options
51###################################################
52
53my $welcome_default = 'welcome.pmcu-8000';
54
55my $hangup = 60;
56my $savedir = '.';
57my ($welcome,$registrar,$username,$password,$debug);
58GetOptions(
59    'd|debug:i' => \$debug,
60    'h|help' => sub { usage() },
61    'R|registrar=s' => \$registrar,
62    'W|welcome=s' => \$welcome,
63    'D|savedir=s' => \$savedir,
64    'T|timeout=i' => \$hangup,
65    'username=s' =>\$username,
66    'password=s' =>\$password,
67) || usage( "bad option" );
68
69
70Net::SIP::Debug->level( $debug || 1 ) if defined $debug;
71my $from = shift(@ARGV);
72$from || usage( "no local address" );
73$welcome ||= -f $welcome_default && $welcome_default;
74$welcome || usage( "no welcome message" );
75
76###################################################
77# if no proxy is given we need to find out
78# about the leg using the IP given from FROM
79###################################################
80my $leg;
81if ( !$registrar ) {
82    my ($host,$port) = $from =~m{\@([\w\-\.]+)(?::(\d+))?}
83	or die "cannot find SIP domain in '$from'";
84    my $addr = gethostbyname( $host )
85	|| die "cannot get IP from SIP domain '$host'";
86    $addr = inet_ntoa( $addr );
87
88    $leg = IO::Socket::INET->new(
89	Proto => 'udp',
90	LocalAddr => $addr,
91	LocalPort => $port || 5060,
92    );
93
94    # if no port given and port 5060 is already used try another one
95    if ( !$leg && !$port ) {
96	$leg = IO::Socket::INET->new(
97	    Proto => 'udp',
98	    LocalAddr => $addr,
99	    LocalPort => 0
100	) || die "cannot create leg at $addr: $!";
101    }
102}
103
104###################################################
105# SIP code starts here
106###################################################
107
108# create necessary legs
109my @legs;
110push @legs,$leg if $leg;
111if ( $registrar ) {
112    if ( ! grep { $_->can_deliver_to( $registrar ) } @legs ) {
113	my $sock = create_socket_to($registrar)
114	    || die "cannot create socket to $registrar";
115	push @legs, Net::SIP::Leg->new( sock => $sock );
116    }
117}
118
119# create user agent
120my $ua = Net::SIP::Simple->new(
121    from => $from,
122    legs => \@legs,
123    $username ? ( auth => [ $username,$password ] ):(),
124);
125
126# optional registration
127if ( $registrar ) {
128    my $sub_register;
129    $sub_register = sub {
130	my $expire = $ua->register( registrar => $registrar )
131	    || die "registration failed: ".$ua->error;
132	# need to refresh registration periodically
133	DEBUG( "registered \@$registrar, expires=$expire" );
134	$ua->add_timer( $expire/2, $sub_register );
135    };
136    $sub_register->();
137}
138
139
140# listen
141$ua->listen(
142    init_media => [ \&play_welcome, $welcome,$hangup,$savedir ],
143    recv_bye => sub {
144	my $param = shift;
145	my $t = delete $param->{stop_rtp_timer};
146	$t && $t->cancel;
147    }
148);
149
150$ua->loop;
151
152###################################################
153# sub to play welcome message, save the peers
154# message and stop the call after a specific time
155###################################################
156sub play_welcome {
157    my ($welcome,$hangup,$savedir,$call,$param) = @_;
158
159    my $from = $call->get_peer;
160    my $filename = sprintf "%d_%s_.pcmu-8000", time(),$from;
161    $filename =~s{[/<>:\.[:^print:]]}{_}g; # normalize
162    DEBUG( "call=$call param=$param peer=$from filename='$filename'" );
163    $filename = $savedir."/".$filename if $savedir;
164
165    # callback for sending data to peer
166    my ($fd,$lastbuf);
167    my $play_welcome = sub {
168	$fd || open( $fd,'<',$welcome ) || die $!;
169	if ( read( $fd, my $buf,160 )) {
170	    # still data in $welcome
171	    $lastbuf = $buf;
172	    return $buf;
173	} else {
174	    # no more data in welcome. Play last packet again
175	    # while the peer is talking to us.
176	    return $lastbuf;
177	}
178    };
179
180    # timer for restring time the peer can speak
181    $param->{stop_rtp_timer} = $call->add_timer( $hangup, [
182	sub {
183	    DEBUG( "connection closed because record time too big" );
184	    shift->bye
185	},
186	$call
187    ]);
188
189    my $rtp = $call->rtp( 'media_send_recv', $play_welcome,1,$filename );
190    return invoke_callback( $rtp,$call,$param );
191}
192