use
fields
qw( realm opaque user2pass user2a1 i_am_proxy dispatcher )
;
sub
new {
my
(
$class
,
%args
) =
@_
;
my
$self
= fields::new(
$class
);
$self
->{realm} =
$args
{realm} ||
'p5-net-sip'
;
$self
->{opaque} =
$args
{opaque};
$args
{user2pass} ||
$args
{user2a1} || croak
'no user2pass or user2a1 known'
;
$self
->{user2pass} =
$args
{user2pass};
$self
->{user2a1} =
$args
{user2a1};
$self
->{i_am_proxy} =
$args
{i_am_proxy};
$self
->{dispatcher} =
$args
{dispatcher} || croak
'no dispatcher'
;
return
$self
;
}
sub
receive {
my
Net::SIP::Authorize
$self
=
shift
;
my
(
$packet
,
$leg
,
$addr
) =
@_
;
if
(
$packet
->is_response ) {
DEBUG( 100,
"pass thru response"
);
return
;
}
my
$method
=
$packet
->method;
my
(
$rq_key
,
$rs_key
,
$acode
) =
$self
->{i_am_proxy}
? (
'proxy-authorization'
,
'proxy-authenticate'
,407 )
: (
'authorization'
,
'www-authenticate'
,401 )
;
my
@auth
=
$packet
->get_header(
$rq_key
);
my
$user2pass
=
$self
->{user2pass};
my
$user2a1
=
$self
->{user2a1};
my
$realm
=
$self
->{realm};
my
$opaque
=
$self
->{opaque};
my
(
@keep_auth
,
$authorized
);
foreach
my
$auth
(
@auth
) {
my
(
$data
,
$param
) = sip_hdrval2parts(
$rq_key
=>
$auth
);
if
(
$param
->{realm} ne
$realm
) {
push
@keep_auth
,
$auth
;
next
;
}
if
(
defined
$opaque
) {
if
( !
defined
$param
->{opaque} ) {
DEBUG( 10,
"expected opaque value, but got nothing"
);
next
;
}
elsif
(
$param
->{opaque} ne
$opaque
) {
DEBUG( 10,
"got wrong opaque value '$param->{opaque}', expected '$opaque'"
);
next
;
}
}
my
(
$user
,
$nonce
,
$uri
,
$resp
,
$qop
,
$cnonce
,
$algo
) =
@{
$param
}{
qw/ username nonce uri response qop cnonce algorithm /
};
if
(
lc
(
$data
) ne
'digest'
|| (
$algo
&&
lc
(
$algo
) ne
'md5'
)
|| (
$qop
&&
$qop
ne
'auth'
) ) {
DEBUG( 10,
"unsupported response: $auth"
);
next
;
};
my
$a2
=
join
(
':'
,
(
$method
eq
'ACK'
||
$method
eq
'CANCEL'
) ?
'INVITE'
:
$method
,
$uri
);
my
$a1_hex
;
if
(
ref
(
$user2a1
)) {
if
(
ref
(
$user2a1
) eq
'HASH'
) {
$a1_hex
=
$user2a1
->{
$user
}
}
else
{
$a1_hex
= invoke_callback(
$user2a1
,
$user
,
$realm
);
}
}
if
( !
defined
(
$a1_hex
) &&
ref
(
$user2pass
)) {
my
$pass
;
if
(
ref
(
$user2pass
) eq
'HASH'
) {
$pass
=
$user2pass
->{
$user
}
}
else
{
$pass
= invoke_callback(
$user2pass
,
$user
);
}
last
if
!
defined
$pass
;
$a1_hex
= md5_hex(
join
(
':'
,
$user
,
$realm
,
$pass
));
}
my
$want_response
;
if
(
$qop
) {
$want_response
= md5_hex(
join
(
':'
,
$a1_hex
,
$nonce
,
1,
$cnonce
,
$qop
,
md5_hex(
$a2
)
));
}
else
{
$want_response
= md5_hex(
join
(
':'
,
$a1_hex
,
$nonce
,
md5_hex(
$a2
)
));
}
if
(
$resp
eq
$want_response
) {
$authorized
= 1;
}
}
if
(
$authorized
) {
DEBUG( 10,
"Request authorized"
.
$packet
->
dump
);
$packet
->set_header(
$rq_key
=> \
@keep_auth
);
return
;
}
return
$acode
if
$method
eq
'CANCEL'
;
if
(
$method
eq
'ACK'
) {
return
$acode
if
(
$packet
->as_parts)[3];
return
;
}
my
$digest
=
qq[Digest algorithm=MD5, realm="$realm",]
.
(
defined
(
$opaque
) ?
qq[ opaque="$opaque",]
:
''
).
' nonce="'
. md5_hex(
$realm
.
rand
(2**32)).
'"'
;
my
$resp
=
$packet
->create_response(
$acode
,
'Authorization required'
,
{
$rs_key
=>
$digest
}
);
$self
->{dispatcher}->deliver(
$resp
,
leg
=>
$leg
,
dst_addr
=>
$addr
);
return
$acode
;
}
1;