File Coverage

blib/lib/Net/SIP/Authorize.pm
Criterion Covered Total %
statement 97 159 61.0
branch 23 70 32.8
condition 9 29 31.0
subroutine 15 18 83.3
pod 2 2 100.0
total 146 278 52.5


line stmt bran cond sub pod time code
1             ###########################################################################
2             # package Net::SIP::Authorize
3             # use in ReceiveChain in front of StatelessProxy, Endpoint.. to authorize request
4             # by enforcing authorization and only handling request only if it was
5             # fully authorized
6             ###########################################################################
7              
8 43     43   261 use strict;
  43         98  
  43         1138  
9 43     43   202 use warnings;
  43         75  
  43         1644  
10              
11             package Net::SIP::Authorize;
12 43     43   244 use Carp 'croak';
  43         326  
  43         1917  
13 43     43   213 use Net::SIP::Debug;
  43         67  
  43         498  
14 43     43   243 use Net::SIP::Util ':all';
  43         88  
  43         6510  
15 43     43   348 use Digest::MD5 'md5_hex';
  43         82  
  43         2122  
16 43     43   352 use fields qw( realm opaque user2pass user2a1 i_am_proxy dispatcher filter );
  43         75  
  43         272  
17              
18             ###########################################################################
19             # creates new Authorize object
20             # Args: ($class,%args)
21             # %args
22             # realm: which realm to announce
23             # user2pass: hash of (username => password) or callback which returns
24             # password if given username
25             # dispatcher: Dispatcher object
26             # i_am_proxy: true if should send Proxy-Authenticate, not WWW-Authenticate
27             # filter: hashref with extra verification chain, see packages below.
28             # Usage:
29             # filter => {
30             # # filter chain for registration
31             # REGISTER => [
32             # # all of this three must succeed (user can regist himself)
33             # [ 'ToIsFrom','FromIsRealm','FromIsAuthUser' ],
34             # # or this must succeed
35             # \&call_back, # callback. If arrayref you MUST set [ \&call_back ]
36             # ]
37             # # filter chain for invites
38             # INVITE => 'FromIsRealm',
39             # }
40             # Returns: $self
41             ###########################################################################
42             sub new {
43 1     1 1 9 my ($class,%args) = @_;
44 1         6 my $self = fields::new( $class );
45 1   50     497 $self->{realm} = $args{realm} || 'p5-net-sip';
46 1         4 $self->{opaque} = $args{opaque};
47              
48 1 0 33     3 $args{user2pass} || $args{user2a1} || croak 'no user2pass or user2a1 known';
49              
50 1         2 $self->{user2pass} = $args{user2pass};
51 1         33 $self->{user2a1} = $args{user2a1};
52 1         1 $self->{i_am_proxy} = $args{i_am_proxy};
53 1   33     3 $self->{dispatcher} = $args{dispatcher} || croak 'no dispatcher';
54              
55 1 50       4 if ( my $f = $args{filter}) {
56 0 0       0 croak 'filter must be hashref' if ref($f) ne 'HASH';
57 0         0 my %filter;
58 0         0 while (my($method,$chain) = each %$f) {
59 0 0       0 $chain = [ $chain ] if ref($chain) ne 'ARRAY';
60 0 0       0 map { $_ = [$_] if ref($_) ne 'ARRAY' } @$chain;
  0         0  
61             # now we have:
62             # method => [[ cb00,cb01,cb02,..],[ cb10,cb11,cb12,..],...]
63             # where either the cb0* chain or the cb1* chain or the cbX* has to succeed
64 0         0 for my $or (@$chain) {
65 0         0 for (@$or) {
66 0 0       0 if (ref($_)) {
67             # assume callback
68             } else {
69             # must have authorize class with verify method
70 0         0 my $pkg = __PACKAGE__."::$_";
71 0 0 0     0 my $sub = UNIVERSAL::can($pkg,'verify') || do {
72             # load package
73             eval "require $pkg";
74             UNIVERSAL::can($pkg,'verify')
75             } or die "cannot find sub ${pkg}::verify";
76 0         0 $_ = $sub;
77             }
78             }
79             }
80 0         0 $filter{uc($method)} = $chain;
81             }
82 0         0 $self->{filter} = \%filter;
83             }
84 1         8 return $self;
85             }
86              
87             ###########################################################################
88             # handle packet, called from Net::SIP::Dispatcher on incoming requests
89             # Args: ($self,$packet,$leg,$addr)
90             # $packet: Net::SIP::Request
91             # $leg: Net::SIP::Leg where request came in (and response gets send out)
92             # $addr: ip:port where request came from and response will be send
93             # Returns: TRUE if it handled the packet
94             ###########################################################################
95             sub receive {
96 10     10 1 24 my Net::SIP::Authorize $self = shift;
97 10         33 my ($packet,$leg,$addr) = @_;
98              
99             # don't handle responses
100 10 50       27 if ( $packet->is_response ) {
101 0         0 DEBUG( 100,"pass thru response" );
102 0         0 return;
103             }
104 10         29 my $method = $packet->method;
105              
106             # check authorization on request
107             my ($rq_key,$rs_key,$acode) = $self->{i_am_proxy}
108 10 50       49 ? ( 'proxy-authorization', 'proxy-authenticate',407 )
109             : ( 'authorization','www-authenticate',401 )
110             ;
111 10         44 my @auth = $packet->get_header( $rq_key );
112 10         17 my $user2pass = $self->{user2pass};
113 10         19 my $user2a1 = $self->{user2a1};
114 10         19 my $realm = $self->{realm};
115 10         12 my $opaque = $self->{opaque};
116              
117             # there might be multiple auth, pick the right realm
118 10         87 my (@keep_auth,$authorized);
119              
120 10         35 foreach my $auth ( @auth ) {
121             # RFC 2617
122 5         16 my ($data,$param) = sip_hdrval2parts( $rq_key => $auth );
123 5 50       20 if ( $param->{realm} ne $realm ) {
124             # not for me
125 0         0 push @keep_auth,$auth;
126 0         0 next;
127             }
128 5 50       13 if ( defined $opaque ) {
129 0 0       0 if ( ! defined $param->{opaque} ) {
    0          
130 0         0 DEBUG( 10,"expected opaque value, but got nothing" );
131 0         0 next;
132             } elsif ( $param->{opaque} ne $opaque ) {
133 0         0 DEBUG( 10,"got wrong opaque value '$param->{opaque}', expected '$opaque'" );
134 0         0 next;
135             }
136             }
137              
138             my ($user,$nonce,$uri,$resp,$qop,$cnonce,$algo ) =
139 5         13 @{$param}{ qw/ username nonce uri response qop cnonce algorithm / };
  5         21  
140 5 50 33     67 if ( lc($data) ne 'digest'
      33        
      33        
      33        
141             || ( $algo && lc($algo) ne 'md5' )
142             || ( $qop && $qop ne 'auth' ) ) {
143 0         0 DEBUG( 10,"unsupported response: $auth" );
144 0         0 next;
145             };
146              
147             # we support with and w/o qop
148             # get a1_hex from either user2a1 or user2pass
149 5         11 my $a1_hex;
150 5 50       19 if ( ref($user2a1)) {
151 0 0       0 if ( ref($user2a1) eq 'HASH' ) {
152 0         0 $a1_hex = $user2a1->{$user}
153             } else {
154 0         0 $a1_hex = invoke_callback( $user2a1,$user,$realm );
155             }
156             }
157 5 50 33     32 if ( ! defined($a1_hex) && ref($user2pass)) {
158 5         6 my $pass;
159 5 50       19 if ( ref($user2pass) eq 'HASH' ) {
160 5         15 $pass = $user2pass->{$user}
161             } else {
162 0         0 $pass = invoke_callback( $user2pass,$user );
163             }
164             # if wrong credentials ask again for authorization
165 5 50       11 last if ! defined $pass;
166 5         138 $a1_hex = md5_hex(join( ':',$user,$realm,$pass ));
167             }
168              
169 5 50       17 last if ! defined $a1_hex; # not in user2a1 || user2pass
170              
171             # ACK just reuse the authorization from INVITE, so they should
172             # be checked against method INVITE
173             # for CANCEL the RFC doesn't say anything, so we assume it uses
174             # CANCEL but try INVITE if this fails
175 5 50       24 my @a2 =
    100          
176             $method eq 'ACK' ? ("INVITE:$uri") :
177             $method eq 'CANCEL' ? ("CANCEL:$uri","INVITE:$uri") :
178             ("$method:$uri");
179              
180 5         20 while (my $a2 = shift(@a2)) {
181 5         10 my $want_response;
182 5 50       12 if ( $qop ) {
183             # 3.2.2.1
184 0         0 $want_response = md5_hex( join( ':',
185             $a1_hex,
186             $nonce,
187             1,
188             $cnonce,
189             $qop,
190             md5_hex($a2)
191             ));
192             } else {
193             # 3.2.2.1 compability with RFC2069
194 5         29 $want_response = md5_hex( join( ':',
195             $a1_hex,
196             $nonce,
197             md5_hex($a2)
198             ));
199             }
200              
201 5 50       23 if ( $resp eq $want_response ) {
202 5 50 33     18 if ($self->{filter} and my $or = $self->{filter}{$method}) {
203 0         0 for my $and (@$or) {
204 0         0 $authorized = 1;
205 0         0 for my $cb (@$and) {
206 0 0       0 if ( ! invoke_callback(
207             $cb,$packet,$leg,$addr,$user,$realm)) {
208 0         0 $authorized = 0;
209 0         0 last;
210             }
211             }
212 0 0       0 last if $authorized;
213             }
214             } else {
215 5         14 $authorized = 1;
216             }
217 5         17 last;
218             }
219             }
220             }
221              
222             # if authorized remove authorization data from this realm
223             # and pass packet thru
224 10 100       35 if ( $authorized ) {
225 5         33 DEBUG( 10, "Request authorized ". $packet->dump );
226             # set header again
227 5         76 $packet->set_header( $rq_key => \@keep_auth );
228 5         92 return;
229             }
230              
231             # CANCEL or ACK cannot be prompted for authorization, so
232             # they should provide the right data already
233             # unauthorized CANCEL or ACK are only valid as response to
234             # 401/407 from this Authorize, so they should not be propagated
235 5 100       24 if ($method eq 'ACK') {
    50          
236             # cancel delivery of response to INVITE
237 2         13 $self->{dispatcher}->cancel_delivery( $packet->tid );
238 2         8 return $acode;
239             } elsif ($method eq 'CANCEL') {
240 0         0 return $acode;
241             }
242              
243             # not authorized yet, ask to authenticate
244             # keep it simple RFC2069 style
245 3 50       109 my $digest = qq[Digest algorithm=MD5, realm="$realm",].
246             ( defined($opaque) ? qq[ opaque="$opaque",] : '' ).
247             ' nonce="'. md5_hex( $realm.rand(2**32)).'"';
248              
249 3         33 my $resp = $packet->create_response(
250             $acode,
251             'Authorization required',
252             { $rs_key => $digest }
253             );
254              
255 3         23 $self->{dispatcher}->deliver( $resp, leg => $leg, dst_addr => $addr );
256              
257             # return $acode (TRUE) to show that packet should
258             # not passed thru
259 3         13 return $acode;
260             }
261              
262             ###########################################################################
263             # additional verifications
264             # Net::SIP::Authorize::FromIsRealm - checks if the domain in 'From' is
265             # the same as the realm in 'Authorization'
266             # Net::SIP::Authorize::FromIsAuthUser - checks if the user in 'From' is
267             # the same as the username in 'Authorization'
268             # Net::SIP::Authorize::ToIsFrom - checks if 'To' and 'From' are equal
269             #
270             # Args each: ($packet,$leg,$addr,$auth_user,$auth_realm)
271             # $packet: Net::SIP::Request
272             # $leg: Net::SIP::Leg where request came in (and response gets send out)
273             # $addr: ip:port where request came from and response will be send
274             # $auth_user: username from 'Authorization'
275             # $auth_realm: realm from 'Authorization'
276             # Returns: TRUE (1) | FALSE (0)
277             ###########################################################################
278              
279             package Net::SIP::Authorize::FromIsRealm;
280 43     43   45616 use Net::SIP::Util qw( sip_hdrval2parts sip_uri2parts );
  43         88  
  43         2052  
281 43     43   270 use Net::SIP::Debug;
  43         84  
  43         195  
282             sub verify {
283 0     0     my ($packet,$leg,$addr,$auth_user,$auth_realm) = @_;
284 0           my $from = $packet->get_header('from');
285 0           ($from) = sip_hdrval2parts( from => $from );
286 0           my ($domain) = sip_uri2parts($from);
287 0           $domain =~s{:\w+$}{};
288 0 0         return 1 if lc($domain) eq lc($auth_realm); # exact domain
289 0 0         return 1 if $domain =~m{\.\Q$auth_realm\E$}i; # subdomain
290 0           DEBUG( 10, "No Auth-success: From-domain is '$domain' and realm is '$auth_realm'" );
291 0           return 0;
292             }
293              
294             package Net::SIP::Authorize::FromIsAuthUser;
295 43     43   341 use Net::SIP::Util qw( sip_hdrval2parts sip_uri2parts );
  43         123  
  43         2018  
296 43     43   245 use Net::SIP::Debug;
  43         136  
  43         169  
297             sub verify {
298 0     0     my ($packet,$leg,$addr,$auth_user,$auth_realm) = @_;
299 0           my $from = $packet->get_header('from');
300 0           ($from) = sip_hdrval2parts( from => $from );
301 0           my (undef,$user) = sip_uri2parts($from);
302 0 0         return 1 if lc($user) eq lc($auth_user);
303 0           DEBUG( 10, "No Auth-success: From-user is '$user' and auth_user is '$auth_user'" );
304 0           return 0;
305             }
306              
307             package Net::SIP::Authorize::ToIsFrom;
308 43     43   322 use Net::SIP::Util qw( sip_hdrval2parts );
  43         78  
  43         1746  
309 43     43   285 use Net::SIP::Debug;
  43         87  
  43         188  
310             sub verify {
311 0     0     my ($packet,$leg,$addr,$auth_user,$auth_realm) = @_;
312 0           my $from = $packet->get_header('from');
313 0           ($from) = sip_hdrval2parts( from => $from );
314 0           my $to = $packet->get_header('to');
315 0           ($to) = sip_hdrval2parts( to => $to );
316 0 0         return 1 if lc($from) eq lc($to);
317 0           DEBUG( 10, "No Auth-success: To is '$to' and From is '$from'" );
318 0           return 0;
319             }
320              
321             1;