###########################################################################
# 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 );
}