File: answer_machine.pl

package info (click to toggle)
libnet-sip-perl 0.838-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,132 kB
  • sloc: perl: 11,988; makefile: 6
file content (191 lines) | stat: -rw-r--r-- 5,659 bytes parent folder | download | duplicates (6)
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
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
###########################################################################
# 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 );
}