###########################################################################
# Net::SIP::Simple::Call
# manages a call, contains Net::SIP::Endpoint::Context
# has hooks for some RTP handling
###########################################################################
use
strict;
use
warnings;
package
Net::SIP::Simple::Call;
###########################################################################
# call_cleanup: callbacks for cleaning up call, called at the end
# rtp_cleanup: callbacks for cleaning up RTP connections, called
# on reINVITEs and at the end
# ctx: Net::SIP::Endpoint::Context object for this call
# param: various parameter to control behavior
# leg: thru which leg the call should be directed (default: first leg)
# init_media: initialize handling for media (RTP) data, see
# Net::SIP::Simple::RTP
# sdp : predefined Net::SIP::SDP or data accepted from NET::SIP::SDP->new
# media_lsocks: if sdp is provided the sockets has to be provided too
# \@list of sockets for each media, each element in the list is
# either the socket (udp) or [ rtp_socket,rtpc_socket ]
# sdp_on_ack: send SDP data on ACK, not on INVITE
# asymetric_rtp: socket for sending media to peer are not the same as
# the sockets, where the media gets received, creates media_ssocks
# media_ssocks: sockets used to send media to peer. If not given
# and asymetric_rtp is used the sockets will be created, if not given
# and not !asymetric_rtp media_lsocks will be used, e.g. symetric RTP
# recv_bye: callback or scalar-ref used when call is closed by peer
# send_bye: callback or scalar-ref used when call is closed by local side
# sdp_peer: Net::SIP::SDP from peer
# clear_sdp: ' causes that keys sdp,sdp_peer,media_ssocks and
# media_lsocks gets cleared on new invite, so that a new SDP session
# need to be established
# cb_final: callback which will be called on final response in INVITE
# with (status,self,%args) where status is OK|FAIL
# cb_preliminary: callback which will be called on preliminary response
# in INVITE with (self,code,packet)
# cb_established: callback which will be called on receiving ACK in INVITE
# with (status,self) where status is OK|FAIL
# sip_header: hashref of SIP headers to add
# call_on_hold: one-shot parameter to set local media addr to 0.0.0.0,
# will be set to false after use
# rtp_param: [ pt,size,interval,name ] RTP payload type, packet size and interval
# between packets managed in Net::SIP::Simple::RTP, default is PCMU/8000,
# e.g [ 0,160,160/8000 ]
# a name can be added in which case an rtpmap and ptme entry will be created in the
# SDP, e.g. [ 97,240,0.03,'iLBC/8000' ]
###########################################################################
use
Net::SIP::Debug;
use
Socket;
###########################################################################
# create a new call based on a controller
# Args: ($class,$control,$ctx;$param)
# $control: Net::SIP::Simple object which controls this call
# $ctx: SIP address of peer for new call or NET::SIP::Endpoint::Context
# or hashref for constructing NET::SIP::Endpoint::Context
# $param: see description of field 'param'
# Returns: $self
###########################################################################
sub
new {
my
(
$class
,
$control
,
$ctx
,
$param
) =
@_
;
my
$self
= fields::new(
$class
);
%$self
=
%$control
;
$self
->{ua_cleanup} = [];
$self
->{ctx} =
ref
(
$ctx
) ?
$ctx
: {
to
=>
$ctx
,
from
=>
$self
->{from},
contact
=>
$self
->{contact},
auth
=>
$self
->{auth},
route
=>
$self
->{route},
};
$self
->{call_cleanup} = [];
$self
->{rtp_cleanup} = [];
$self
->{param} =
$param
||= {};
$param
->{init_media} ||=
$self
->rtp(
'media_recv_echo'
);
$param
->{rtp_param} ||= [ 0,160,160/8000 ];
# PCMU/8000: 5*160 bytes/second
return
$self
;
}
###########################################################################
# Cleanups
# explicit cleanups might be necessary if callbacks reference back into
# the object so that it cannot be cleaned up by simple ref-counting alone
###########################################################################
sub
cleanup {
my
Net::SIP::Simple::Call
$self
=
shift
;
$self
->rtp_cleanup;
while
(
my
$cb
=
shift
@{
$self
->{call_cleanup} } ) {
invoke_callback(
$cb
,
$self
)
}
if
(
my
$ctx
=
$self
->{ctx} ) {
$self
->{endpoint}->close_context(
$ctx
);
}
$self
->{param} = {};
$self
->SUPER::cleanup;
}
sub
rtp_cleanup {
my
Net::SIP::Simple::Call
$self
=
shift
;
while
(
my
$cb
=
shift
@{
$self
->{rtp_cleanup} } ) {
invoke_callback(
$cb
,
$self
)
}
DEBUG( 100,
"done"
);
}
sub
DESTROY {
DEBUG( 100,
"done"
);
}
###########################################################################
# return peer of call
# Args: $self
# Returns: $peer
###########################################################################
sub
get_peer {
my
Net::SIP::Simple::Call
$self
=
shift
;
return
$self
->{ctx}->peer;
}
###########################################################################
# set parameter
# Args: ($self,%param)
# Returns: $self
###########################################################################
sub
set_param {
my
Net::SIP::Simple::Call
$self
=
shift
;
my
%args
=
@_
;
@{
$self
->{param} }{
keys
%args
} =
values
%args
;
return
$self
;
}
###########################################################################
# get value for parameter(s)
# Args: ($self,@keys)
# Returns: @values|$value[0]
###########################################################################
sub
get_param {
my
Net::SIP::Simple::Call
$self
=
shift
;
my
@v
= @{
$self
->{param}}{
@_
};
return
wantarray
?
@v
:
$v
[0];
}
###########################################################################
# (Re-)Invite other party
# Args: ($self;%param)
# %param: see description of field 'param', gets merged with param
# already on object so that the values are valid for future use
# Returns: Net::SIP::Endpoint::Context
# Comment:
# If cb_final callback was not given it will loop until it got a final
# response, otherwise it will return immediatly
###########################################################################
sub
reinvite {
my
Net::SIP::Simple::Call
$self
=
shift
;
my
%args
=
@_
;
my
$param
=
$self
->{param};
my
$clear_sdp
=
delete
$args
{clear_sdp};
$clear_sdp
=
$param
->{clear_sdp}
if
!
defined
$clear_sdp
;
if
(
$clear_sdp
) {
# clear SDP keys so that a new SDP session will be created
@{
$param
}{
qw( sdp _sdp_saved sdp_peer media_ssocks media_lsocks )
} = ()
}
$self
->{param} =
$param
= {
%$param
,
%args
}
if
%args
;
my
$leg
=
$param
->{leg};
if
( !
$leg
) {
(
$leg
) =
$self
->{dispatcher}->get_legs();
$param
->{leg} =
$leg
;
}
my
$ctx
=
$self
->{ctx};
my
$sdp
;
if
( !
$param
->{sdp_on_ack} ) {
$self
->_setup_local_rtp_socks;
$sdp
=
$param
->{sdp}
}
# predefined callback
my
$cb
=
sub
{
my
Net::SIP::Simple::Call
$self
=
shift
||
return
;
my
(
$endpoint
,
$ctx
,
$errno
,
$code
,
$packet
,
$leg
,
$from
,
$ack
) =
@_
;
if
(
$errno
) {
if
(
$code
== 487 ) {
# request was canceled, probably be me -> ignore
}
else
{
$self
->error(
"Failed with error $errno"
.(
$code
?
" code=$code"
:
""
) );
}
invoke_callback(
$param
->{cb_final},
'FAIL'
,
$self
,
errno
=>
$errno
,
code
=>
$code
,
packet
=>
$packet
);
return
;
}
# new requests in existing call are handled in receive()
return
$self
->receive(
@_
)
if
$packet
->is_request;
# response to INVITE
# all other responses will not be propagated to this callback
my
$param
=
$self
->{param};
if
(
$code
=~m{^1\d\d} ) {
# preliminary response, ignore
DEBUG(10,
"got preliminary response of %s|%s to INVITE"
,
$code
,
$packet
->msg );
invoke_callback(
$param
->{cb_preliminary},
$self
,
$code
,
$packet
);
return
;
}
elsif
(
$code
!~m{^2\d\d} ) {
DEBUG(10,
"got response of %s|%s to INVITE"
,
$code
,
$packet
->msg );
invoke_callback(
$param
->{cb_final},
'FAIL'
,
$self
,
code
=>
$code
);
return
;
}
# cleanup RTP from last call
$self
->rtp_cleanup;
$self
->_setup_peer_rtp_socks(
$packet
) ||
do
{
invoke_callback(
$param
->{cb_final},
'FAIL'
,
$self
);
return
;
};
if
(
$param
->{sdp_on_ack} &&
$ack
) {
$self
->_setup_local_rtp_socks;
$ack
->set_body(
$param
->{sdp} );
}
invoke_callback(
$param
->{cb_final},
'OK'
,
$self
);
invoke_callback(
$param
->{init_media},
$self
,
$param
);
};
my
$stopvar
= 0;
$param
->{cb_final} ||= \
$stopvar
;
$cb
= [
$cb
,
$self
];
weaken(
$cb
->[1] );
$self
->{ctx} =
$self
->{endpoint}->invite(
$ctx
,
$cb
,
$sdp
,
$param
->{sip_header} ? %{
$param
->{sip_header} } : ()
);
if
(
$param
->{cb_final} == \
$stopvar
) {
# This callback will be called on timeout or response to cancel which
# got send after ring_time was over
my
$noanswercb
;
if
(
$param
->{ring_time} ) {
$noanswercb
=
sub
{
my
Net::SIP::Simple::Call
$self
=
shift
||
return
;
my
(
$endpoint
,
$ctx
,
$errno
,
$code
,
$packet
,
$leg
,
$from
,
$ack
) =
@_
;
$stopvar
=
'NOANSWER'
;
my
$param
=
$self
->{param};
invoke_callback(
$param
->{cb_noanswer},
'NOANSWER'
,
$self
,
errno
=>
$errno
,
code
=>
$code
,
packet
=>
$packet
);
if
(
$code
=~ m{^2\d\d} ) {
DEBUG(10,
"got response of %s|%s to CANCEL"
,
$code
,
$packet
->msg );
invoke_callback(
$param
->{cb_final},
'NOANSWER'
,
$self
,
code
=>
$code
);
}
};
$noanswercb
= [
$noanswercb
,
$self
];
weaken(
$noanswercb
->[1] );
# wait until final response
$self
->loop(
$param
->{ring_time}, \
$stopvar
);
unless
(
$stopvar
) {
# timed out
$self
->{endpoint}->cancel_invite(
$self
->{ctx},
undef
,
$noanswercb
);
$self
->loop( \
$stopvar
);
}
}
else
{
# wait until final response
$self
->loop( \
$stopvar
);
}
$param
->{cb_final} =
undef
;
}
return
$self
->{ctx};
}
###########################################################################
# cancel call
# Args: ($self,%args)
# %args:
# cb_final: callback when CANCEL was delivered. If not given send_cancel
# callback on Call object will be used
# Returns: true if call could be canceled
# Comment: cb_final gets triggered if the reply for the CANCEL is received
# or waiting for the reply timed out
###########################################################################
sub
cancel {
my
Net::SIP::Simple::Call
$self
=
shift
;
my
%args
=
@_
;
my
$cb
=
delete
$args
{cb_final};
%args
= ( %{
$self
->{param} },
%args
);
$cb
||=
$args
{send_cancel};
my
$cancel_cb
= [
sub
{
my
Net::SIP::Simple::Call
$self
=
shift
||
return
;
my
(
$cb
,
$args
,
$endpoint
,
$ctx
,
$error
,
$code
) =
@_
;
# we don't care about the cause of this callback
# it might be a successful or failed reply packet or no reply
# packet at all (timeout) - the call is considered closed
# in any case except for 1xx responses
if
(
$code
&&
$code
=~m{^1\d\d} ) {
DEBUG( 10,
"got prelimary response for CANCEL"
);
return
;
}
invoke_callback(
$cb
,
$args
);
},
$self
,
$cb
,\
%args
];
weaken(
$cancel_cb
->[1] );
return
$self
->{endpoint}->cancel_invite(
$self
->{ctx},
undef
,
$cancel_cb
);
}
###########################################################################
# end call
# Args: ($self,%args)
# %args:
# cb_final: callback when BYE was delivered. If not given send_bye
# callback on Call object will be used
# Returns: NONE
# Comment: cb_final gets triggered if the reply for the BYE is received
# or waiting for the reply timed out
###########################################################################
sub
bye {
my
Net::SIP::Simple::Call
$self
=
shift
;
my
%args
=
@_
;
my
$cb
=
delete
$args
{cb_final};
%args
= ( %{
$self
->{param} },
%args
);
$cb
||=
$args
{send_bye};
my
$bye_cb
= [
sub
{
my
Net::SIP::Simple::Call
$self
=
shift
||
return
;
my
(
$cb
,
$args
,
$endpoint
,
$ctx
,
$error
,
$code
) =
@_
;
# we don't care about the cause of this callback
# it might be a successful or failed reply packet or no reply
# packet at all (timeout) - the call is considered closed
# in any case except for 1xx responses
# FIXME: should we check for 302 moved etc?
if
(
$code
&&
$code
=~m{^1\d\d} ) {
DEBUG( 10,
"got prelimary response for BYE"
);
return
;
}
invoke_callback(
$cb
,
$args
);
$self
->cleanup;
},
$self
,
$cb
,\
%args
];
weaken(
$bye_cb
->[1] );
$self
->{endpoint}->new_request(
'BYE'
,
$self
->{ctx},
$bye_cb
);
}
###########################################################################
# handle new packets within existing call
# Args: ($self,$endpoint,$ctx,$error,$code,$packet,$leg,$from)
# $endpoint: the endpoint
# $ctx: context for call
# $error: errno if error occured
# $code: code from responses
# $packet: incoming packet
# $leg: leg where packet came in
# $from: addr from where packet came
# Returns: NONE
###########################################################################
sub
receive {
my
(
$self
,
$endpoint
,
$ctx
,
$error
,
$code
,
$packet
,
$leg
,
$from
) =
@_
;
if
( !
$packet
) {
$self
->error(
"error occured: $error"
);
}
elsif
(
$packet
->is_request ) {
my
$method
=
$packet
->method;
my
$param
=
$self
->{param};
if
(
$method
eq
'BYE'
||
$method
eq
'CANCEL'
) {
# tear down
$self
->cleanup;
invoke_callback(
$param
->{recv_bye},
$param
);
# everything else already handled by Net::SIP::Endpoint::Context
}
elsif
(
$method
eq
'ACK'
||
$method
eq
'INVITE'
) {
# can transport sdp data
if
(
my
$sdp_peer
=
$packet
->sdp_body ) {
DEBUG( 50,
"got sdp data from peer: "
.
$sdp_peer
->as_string );
$self
->_setup_peer_rtp_socks(
$sdp_peer
);
}
if
(
$method
eq
'INVITE'
) {
if
(
$param
->{clear_sdp} ) {
# clear SDP keys so that a new SDP session will be created
@{
$param
}{
qw( sdp _sdp_saved sdp_peer media_ssocks media_lsocks )
} = ()
}
$param
->{leg} ||=
$leg
;
$self
->_setup_local_rtp_socks;
# send 200 OK with sdp body
my
$response
=
$packet
->create_response(
'200'
,
'OK'
,{},
$param
->{sdp} );
DEBUG( 100,
'created response '
.
$response
->as_string );
$self
->{endpoint}->new_response(
$ctx
,
$response
,
$leg
,
$from
);
}
elsif
(
$method
eq
'ACK'
) {
$self
->rtp_cleanup;
# close last RTP session
invoke_callback(
$param
->{cb_established},
'OK'
,
$self
);
invoke_callback(
$param
->{init_media},
$self
,
$param
);
}
}
elsif
(
$method
eq
'OPTIONS'
) {
my
$response
=
$packet
->create_response(
'200'
,
'OK'
,
$self
->{options} );
$self
->{endpoint}->new_response(
$ctx
,
$response
,
$leg
,
$from
);
}
}
else
{
# don't expect any responses.
# Response to BYE is handled by Net::SIP::Endpoint::Context
# other responses from the peer I don't expect
DEBUG( 100,
"got response. WHY? DROP."
);
}
}
###########################################################################
# setup $self->{param} for remote socks from remote SDP data
# Args: ($self,$data)
# $data: packet containing sdp_body (Net::SIP::Packet) or
# SDP data (Net::SIP::SDP)
# Returns: NONE
###########################################################################
sub
_setup_peer_rtp_socks {
my
Net::SIP::Simple::Call
$self
=
shift
;
my
$param
=
$self
->{param};
my
$data
=
shift
||
$param
->{sdp_peer};
my
$sdp_peer
;
if
( UNIVERSAL::isa(
$data
,
'Net::SIP::Packet'
)) {
$sdp_peer
=
$data
->sdp_body or
do
{
$self
->error(
"No SDP body in packet"
);
return
;
};
}
else
{
$sdp_peer
=
$data
}
$param
->{sdp_peer} =
$sdp_peer
;
my
@media
=
$sdp_peer
->get_media;
my
$ls
=
$param
->{media_lsocks};
if
(
$ls
&&
@$ls
&&
@media
!=
@$ls
) {
$self
->error(
"Unexpected number of media entries in SDP from peer"
);
return
;
}
my
$raddr
=
$param
->{media_raddr} = [];
my
$null_address
=
pack
(
'CCCC'
,0,0,0,0 );
# c=0.0.0.0 => call on hold
foreach
my
$m
(
@media
) {
my
$range
=
$m
->{range} || 1;
my
$paddr
= inet_aton(
$m
->{addr} );
if
(
$paddr
eq
$null_address
) {
# on-hold for this media
push
@$raddr
,
undef
;
}
else
{
my
@socks
=
map
{
scalar
(sockaddr_in(
$m
->{port}+
$_
,
$paddr
)) }
(0..
$range
-1);
push
@$raddr
,
@socks
== 1 ?
$socks
[0] : \
@socks
;
}
}
return
1;
}
###########################################################################
# setup local RTP socks
# Args: $self
# Returns: NONE
# Comments: set sdp,media_lsocks,media_ssocks in self->{param}
###########################################################################
sub
_setup_local_rtp_socks {
my
Net::SIP::Simple::Call
$self
=
shift
;
my
$param
=
$self
->{param};
my
$call_on_hold
=
$param
->{call_on_hold};
$param
->{call_on_hold} = 0;
# one-shot
my
$sdp
=
$param
->{_sdp_saved} ||
$param
->{sdp};
if
(
$sdp
&& !UNIVERSAL::isa(
$sdp
,
'Net::SIP::SDP'
)) {
$sdp
= Net::SIP::SDP->new(
$sdp
);
}
my
$laddr
=
$param
->{leg}{addr};
if
( !
$sdp
) {
# create SDP body
my
$raddr
=
$param
->{media_rsocks};
# if no raddr yet just assume one
my
@media
;
if
(
my
$sdp_peer
=
$param
->{sdp_peer} ) {
foreach
my
$m
(
$sdp_peer
->get_media ) {
if
(
$m
->{proto} ne
'RTP/AVP'
) {
$self
->error(
"only RTP/AVP supported"
);
return
;
}
if
(
$m
->{media} eq
'audio'
) {
# enforce PCMU/8000 for now
$m
= {
%$m
,
fmt
=>
'0'
}
}
push
@media
, {
media
=>
$m
->{media},
proto
=>
$m
->{proto},
range
=>
$m
->{range},
fmt
=>
$m
->{fmt},
};
}
}
else
{
my
$rp
=
$param
->{rtp_param};
push
@media
, {
proto
=>
'RTP/AVP'
,
media
=>
'audio'
,
fmt
=>
$rp
->[0] || 0,
# PCMU/8000
$rp
->[3] ? (
a
=> [
"rtpmap:$rp->[0] $rp->[3]"
,
"ptime:"
.
$rp
->[2]*1000 ]
) :(),
}
}
my
$lsocks
=
$param
->{media_lsocks} = [];
foreach
my
$m
(
@media
) {
my
(
$port
,
@socks
) = create_rtp_sockets(
$laddr
,
$m
->{range} )
or
die
$!;
push
@$lsocks
,
@socks
== 1 ?
$socks
[0] : \
@socks
;
$m
->{port} =
$port
;
}
$sdp
=
$param
->{sdp} = Net::SIP::SDP->new(
{
addr
=>
$laddr
},
@media
);
}
unless
(
$param
->{media_lsocks} ) {
# SDP body was provided, but sockets not
croak(
'not supported: if you provide SDP body you need to provide sockets too'
);
}
# asymetric_rtp, e.g. source socket of packet to peer is not the socket where RTP
# from peer gets received
if
( !
$param
->{media_ssocks} &&
$param
->{asymetric_rtp} ) {
my
@arg
= (
Proto
=>
'udp'
,
LocalAddr
=> (
$param
->{rtp_addr} ||
$laddr
)
);
my
$msocks
=
$param
->{media_ssocks} = [];
foreach
my
$m
(@{
$param
->{media_lsocks} }) {
my
$socks
;
if
( UNIVERSAL::isa(
$m
,
'ARRAY'
)) {
$socks
= [];
foreach
my
$sock
(
@$m
) {
push
@$socks
, IO::Socket::INET->new(
@arg
) ||
die
$!;
}
}
else
{
$socks
= IO::Socket::INET->new(
@arg
) ||
die
$!;
}
push
@$msocks
,
$socks
;
}
}
$param
->{_sdp_saved} =
$sdp
;
if
(
$call_on_hold
) {
$sdp
= dclone(
$sdp
);
# make changes on clone
my
@new
=
map
{ [
'0.0.0.0'
,
$_
->{port} ] }
$sdp
->get_media;
$sdp
->replace_media_listen(
@new
);
$param
->{sdp} =
$sdp
;
}
}
1;