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