###########################################################################
# Simple answer machine:
# - Register and listen
# - On incoming call send welcome message and send data to file, hangup
# after specified time
# - Recorded data will be saved as %d_%s_.pcmu-8000 where %d is the
# timestamp from time() and %s is the data from the SP 'From' header.
# to convert this to something more usable you might use 'sox' from
# sox.sf.net, e.g for converting to OGG:
# sox -t raw -b -U -c 1 -r 8000 file.pcmu-8000 file.ogg
# - Recording starts already at the beginning, not after the welcome
# message is done
###########################################################################
use strict;
use warnings;
use IO::Socket::INET;
use Getopt::Long qw(:config posix_default bundling);
use Net::SIP;
use Net::SIP::Util ':all';
use Net::SIP::Debug;
sub usage {
print STDERR "ERROR: @_\n" if @_;
print STDERR <<EOS;
usage: $0 [ options ] FROM
Listens on SIP address FROM for incoming calls. Sends
welcome message and records data from user in PCMU/800 format.
Options:
-d|--debug [level] Enable debugging
-h|--help Help (this info)
-R|--registrar host[:port] register at given address
-W|--welcome filename welcome message
-T|--timeout time record at most time seconds (default 60)
-D|--savedir directory where to save received messages (default .)
--username name username for authorization
--password pass password for authorization
Example:
$0 -T 20 -W welcome.data --register 192.168.178.3 sip:30\@example.com
EOS
exit( @_ ? 1:0 );
}
###################################################
# Get options
###################################################
my $welcome_default = 'welcome.pmcu-8000';
my $hangup = 60;
my $savedir = '.';
my ($welcome,$registrar,$username,$password,$debug);
GetOptions(
'd|debug:i' => \$debug,
'h|help' => sub { usage() },
'R|registrar=s' => \$registrar,
'W|welcome=s' => \$welcome,
'D|savedir=s' => \$savedir,
'T|timeout=i' => \$hangup,
'username=s' =>\$username,
'password=s' =>\$password,
) || usage( "bad option" );
Net::SIP::Debug->level( $debug || 1 ) if defined $debug;
my $from = shift(@ARGV);
$from || usage( "no local address" );
$welcome ||= -f $welcome_default && $welcome_default;
$welcome || usage( "no welcome message" );
###################################################
# if no proxy is given we need to find out
# about the leg using the IP given from FROM
###################################################
my $leg;
if ( !$registrar ) {
my ($host,$port) = $from =~m{\@([\w\-\.]+)(?::(\d+))?}
or die "cannot find SIP domain in '$from'";
my $addr = gethostbyname( $host )
|| die "cannot get IP from SIP domain '$host'";
$addr = inet_ntoa( $addr );
$leg = IO::Socket::INET->new(
Proto => 'udp',
LocalAddr => $addr,
LocalPort => $port || 5060,
);
# if no port given and port 5060 is already used try another one
if ( !$leg && !$port ) {
$leg = IO::Socket::INET->new(
Proto => 'udp',
LocalAddr => $addr,
LocalPort => 0
) || die "cannot create leg at $addr: $!";
}
}
###################################################
# SIP code starts here
###################################################
# create necessary legs
my @legs;
push @legs,$leg if $leg;
if ( $registrar ) {
if ( ! grep { $_->can_deliver_to( $registrar ) } @legs ) {
my $sock = create_socket_to($registrar)
|| die "cannot create socket to $registrar";
push @legs, Net::SIP::Leg->new( sock => $sock );
}
}
# create user agent
my $ua = Net::SIP::Simple->new(
from => $from,
legs => \@legs,
$username ? ( auth => [ $username,$password ] ):(),
);
# optional registration
if ( $registrar ) {
my $sub_register;
$sub_register = sub {
my $expire = $ua->register( registrar => $registrar )
|| die "registration failed: ".$ua->error;
# need to refresh registration periodically
DEBUG( "registered \@$registrar, expires=$expire" );
$ua->add_timer( $expire/2, $sub_register );
};
$sub_register->();
}
# listen
$ua->listen(
init_media => [ \&play_welcome, $welcome,$hangup,$savedir ],
recv_bye => sub {
my $param = shift;
my $t = delete $param->{stop_rtp_timer};
$t && $t->cancel;
}
);
$ua->loop;
###################################################
# sub to play welcome message, save the peers
# message and stop the call after a specific time
###################################################
sub play_welcome {
my ($welcome,$hangup,$savedir,$call,$param) = @_;
my $from = $call->get_peer;
my $filename = sprintf "%d_%s_.pcmu-8000", time(),$from;
$filename =~s{[/<>:\.[:^print:]]}{_}g; # normalize
DEBUG( "call=$call param=$param peer=$from filename='$filename'" );
$filename = $savedir."/".$filename if $savedir;
# callback for sending data to peer
my ($fd,$lastbuf);
my $play_welcome = sub {
$fd || open( $fd,'<',$welcome ) || die $!;
if ( read( $fd, my $buf,160 )) {
# still data in $welcome
$lastbuf = $buf;
return $buf;
} else {
# no more data in welcome. Play last packet again
# while the peer is talking to us.
return $lastbuf;
}
};
# timer for restring time the peer can speak
$param->{stop_rtp_timer} = $call->add_timer( $hangup, [
sub {
DEBUG( "connection closed because record time too big" );
shift->bye
},
$call
]);
my $rtp = $call->rtp( 'media_send_recv', $play_welcome,1,$filename );
return invoke_callback( $rtp,$call,$param );
}