line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
########################################################################### |
2
|
|
|
|
|
|
|
# package Net::SIP::Redirect |
3
|
|
|
|
|
|
|
# uses Registrar to redirect incoming calls based on the information |
4
|
|
|
|
|
|
|
# provided by the registrar |
5
|
|
|
|
|
|
|
########################################################################### |
6
|
|
|
|
|
|
|
|
7
|
43
|
|
|
43
|
|
260
|
use strict; |
|
43
|
|
|
|
|
68
|
|
|
43
|
|
|
|
|
1168
|
|
8
|
43
|
|
|
43
|
|
186
|
use warnings; |
|
43
|
|
|
|
|
74
|
|
|
43
|
|
|
|
|
2012
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
package Net::SIP::Redirect; |
11
|
43
|
|
|
43
|
|
224
|
use fields qw(dispatcher registrar); |
|
43
|
|
|
|
|
85
|
|
|
43
|
|
|
|
|
215
|
|
12
|
43
|
|
|
43
|
|
2896
|
use Net::SIP::Debug; |
|
43
|
|
|
|
|
148
|
|
|
43
|
|
|
|
|
333
|
|
13
|
43
|
|
|
43
|
|
250
|
use Net::SIP::Util ':all'; |
|
43
|
|
|
|
|
81
|
|
|
43
|
|
|
|
|
18202
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
0
|
|
|
0
|
1
|
|
my ($class,%args) = @_; |
17
|
0
|
|
|
|
|
|
my $self = fields::new($class); |
18
|
0
|
|
|
|
|
|
%$self = %args; |
19
|
0
|
0
|
|
|
|
|
$self->{dispatcher} or croak( "no dispatcher given" ); |
20
|
0
|
0
|
|
|
|
|
$self->{registrar} or croak( "no registrar given" ); |
21
|
0
|
|
|
|
|
|
return $self; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub receive { |
25
|
0
|
|
|
0
|
1
|
|
my Net::SIP::Redirect $self = shift; |
26
|
0
|
|
|
|
|
|
my ($packet,$leg,$addr) = @_; |
27
|
|
|
|
|
|
|
|
28
|
0
|
0
|
|
|
|
|
$packet->is_request or return; # don't handle responses |
29
|
|
|
|
|
|
|
|
30
|
0
|
|
|
|
|
|
my $method = $packet->method; |
31
|
0
|
|
|
|
|
|
my $resp; |
32
|
0
|
0
|
|
|
|
|
if ( $method eq 'ACK' ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# if I got an ACK cancel delivery of response to INVITE |
34
|
0
|
|
|
|
|
|
$self->{dispatcher}->cancel_delivery( $packet->tid ); |
35
|
0
|
|
|
|
|
|
return -1; # don't process in next part of chain |
36
|
|
|
|
|
|
|
} elsif ( $method eq 'CANCEL' ) { |
37
|
0
|
|
|
|
|
|
$resp = $packet->create_response(200); |
38
|
|
|
|
|
|
|
} elsif ( $method eq 'REGISTER' ) { |
39
|
0
|
|
|
|
|
|
return; # don't process myself |
40
|
|
|
|
|
|
|
} else { |
41
|
0
|
|
|
|
|
|
my $key = sip_parts2uri((sip_uri2parts($packet->uri))[0,1,2]); |
42
|
0
|
0
|
|
|
|
|
if ( my @contacts = $self->{registrar}->query($key)) { |
43
|
0
|
|
|
|
|
|
$resp = $packet->create_response('302','Moved Temporarily'); |
44
|
0
|
|
|
|
|
|
$resp->add_header( contact => $_ ) for(@contacts); |
45
|
|
|
|
|
|
|
} else { |
46
|
0
|
|
|
|
|
|
$resp = $packet->create_response('404','Not found'); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
0
|
|
|
|
|
|
$self->{dispatcher}->deliver($resp,leg => $leg,dst_addr => $addr); |
51
|
0
|
|
|
|
|
|
return $resp->code; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
1; |