File Coverage

blib/lib/Net/SIP/Endpoint.pm

Criterion	Covered	Total	%
statement	99	109	90.8
branch	19	28	67.8
condition	6	11	54.5
subroutine	19	20	95.0
pod	11	11	100.0
total	154	179	86.0

############################################################################
# package Net::SIP::Endpoint
# implements the behavior of an endpoint (SIP phone).
# packet managment (lower layer) is done by Net::SIP::Dispatcher while
# call managment is done with Net::SIP::Endpoint::Context
############################################################################

use strict;
use warnings;
package Net::SIP::Endpoint;
use fields (
    'dispatcher',   # lower layer, delivers and receives packets through the legs
    'application',  # upper layer, e.g user interface..
    'ctx'           # hash of ( callid => Net::SIP::Endpoint::Context )
);

use Net::SIP::Debug;
use Net::SIP::Endpoint::Context;
use Net::SIP::Util qw(invoke_callback);
use Scalar::Util 'weaken';

############################################################################
# create a new endpoint
# Args: ($class,$dispatcher)
#  $dispatcher: lower layer which handles the delivery and receiving of packets
# Returns: $self
############################################################################
sub new {
    my ($class,$dispatcher) = @_;
    my $self = fields::new($class);

    $self->{dispatcher} = $dispatcher;
    $self->{ctx} = {}; # \%hash with ( callid => $ctx )

    # announce myself as upper layer for incoming packets to
    # the dispatcher
    my $cb = [ \&receive,$self ];
    weaken( $cb->[1] );
    $dispatcher->set_receiver( $cb );

    return $self;
}

############################################################################
# set upper layer (application)
# Args: ($self,$app)
#  $app: upper layer which needs to have method receive( $request )
#    to handle new request, which this layer cannot handle alone
#    (e.g INVITE to a new dialog)
#    or this can be \&sub, [ \&sub,@arg ]...
# Returns: NONE
############################################################################
sub set_application {
    my Net::SIP::Endpoint $self = shift;
    my $app = shift;
    my $cb;
    if ( my $sub = UNIVERSAL::can( $app,'receive' )) {
	$cb = [ $sub,$app ];
    } else {
	$cb = $app; # already callback
    }
    $self->{application} = $cb;
}

############################################################################
# create a new call or re-invite on a existing call
# wrapper around new_request()
# Args: ($self,$ctx;$callback,$body,%args)
#   $ctx: Context|\%args, see new_request()
#   $callback: optional Callback, see new_request()
#   $body: optional Body
#   %args: additional args for Net::SIP::Request::new
# Returns: $ctx
#   $ctx: see new_request()
############################################################################
sub invite {
    my Net::SIP::Endpoint $self = shift;
    my ($ctx,$callback,$body,%args) = @_;
    return $self->new_request( 'INVITE',$ctx,$callback,$body,%args );
}

############################################################################
# registers UAC
# Args: ($self,%args)
#  %args: at minimum there must be
#    from:    the sip-address to register
#    contact: to which local address should it registered
#    registrar: SIP address of registrar
#  there can be:
#    expires: Expires header, defaults to 900 if not given
#    callback: callback which will be called on response
#    callid: callid used for calling context
#  all other args will be used in creation of request
# Returns: NONE
############################################################################
sub register {
    my Net::SIP::Endpoint $self = shift;
    my %args = @_;

    my ($me,$registrar,$contact) =
	delete @args{qw( from registrar contact )};

    my $expires = delete $args{expires};
    $expires = 900 if !defined($expires);

    my %ctx = (
	to      => $me,
	from    => $me,
	contact => $contact,
	auth    => delete $args{auth},
	callid  => delete $args{callid},
    );
    return $self->new_request(
	'REGISTER',
	\%ctx,
	delete($args{callback}),
	undef,
	uri => $registrar,
	expires => $expires,
	%args,
    );
}


############################################################################
# starts new request, e.g creates request packet and delivers it
# Args: ($self,$method,$ctx;$callback,$body,%args)
#   $method: method name, e.g. 'INVITE','REGISTER',..
#     can also be a full Net::SIP::Request already (used for retries after
#     302,305 responses)
#   $ctx: already established context (Net::SIP::Endpoint::Context)
#     or \%hash to create a new one (see Net::SIP::Endpoint::Context->new)
#   $callback: [ \&sub,@arg ] which will be called if the layer receives
#     responses important to the upper layer (e.g 180 Ringing, 200 Ok,
#     401/407 Authorization required...)
#     if callback is omitted the callback from the context is used,
#     if callback is set it will be the new callback for the context
#   $body: optional Body, either scalar or smth with method as_string
#     (like Net::SIP::SDP)
#   %args: additional args for Net::SIP::Endpoint::Context::new_request
# Returns: $ctx
#    $ctx: context, eg the original one or newly created
# Comment: if it cannot create a new context (because of missing args)
#   or something else fatal happens it will die()
############################################################################
sub new_request {
    my Net::SIP::Endpoint $self = shift;
    my ($method,$ctx,$callback,$body,%args) = @_;

    die "cannot redefine call-id" if delete $args{ 'call-id' };

    if ( ! UNIVERSAL::isa( $ctx,'Net::SIP::Endpoint::Context' )) {
	$ctx = Net::SIP::Endpoint::Context->new(%$ctx, method => $method);
	$self->{ctx}{ $ctx->callid } = $ctx; # make sure we manage the context
	DEBUG( 10,"create new request for $method within new call ".$ctx->callid );
    } else {
	DEBUG( 10,"create new request for $method within existing call ".$ctx->callid );
    }

    $ctx->set_callback( $callback ) if $callback;

    my $request = $ctx->new_request( $method,$body,%args );
    DEBUG( 50,"request=".$request->as_string );

    my $tid = $request->tid;
    $self->{dispatcher}->deliver( $request,
	id => $tid,
	callback => [ \&_request_delivery_callback, $self,$ctx ],
	leg => $args{leg},
	dst_addr => $args{dst_addr},
    );

    return $ctx;
}

############################################################################
# Cancel last pending INVITE request
# Args: ($self,$ctx,$request,$cb)
#   $ctx: context for call
#   $request: request to cancel, will only cancel it, if request is
#     outstanding in context, will cancel latest INVITE if not given
#   $cb: callback for generated CANCEL request
# Returns: number of requests canceled (e.g 0 if no outstanding INVITE)
############################################################################
sub cancel_invite {
    my Net::SIP::Endpoint $self = shift;
    my Net::SIP::Endpoint::Context $ctx = shift;
    my ($request,$callback) = @_;
    my ($pkt) = $ctx->find_outstanding_requests(
	$request ? ( request => $request ) : ( method => 'INVITE' )
    ) or return;
    $self->new_request( $pkt->create_cancel, $ctx, $callback );
    return 1;
}

############################################################################
# internal callback used for delivery
# will be called from dispatcher if the request was definitely successfully
# delivered (tcp only) or an error occurred
# Args: ($self,$ctx,$error,$delivery_packet)
#   $ctx: Net::SIP::Endpoint::Context
#   $error: errno if error occurred
#   $delivery_packet: Net::SIP::Dispatcher::Packet which encapsulates
#     the original request and information about leg, dst_addr...
#     and has method use_next_dstaddr to try the next dstaddr if for the
#     current no (more) retries are possible
# Returns: NONE
############################################################################
sub _request_delivery_callback {
    my Net::SIP::Endpoint $self = shift;
    my ($ctx,$error,$delivery_packet) = @_;

    my $tid = $delivery_packet->tid;

    # either successfully send over reliable transport
    # or permanently failed, e.g no (more) retries possible
    $ctx->request_delivery_done( $self,$tid,$error )
}

############################################################################
# remove context from Endpoint and cancel all outstanding deliveries
# Args: ($self,$id)
#  $id: either id for ctx or context object or SIP packet
# Returns: $ctx
#  $ctx: removed context object
############################################################################
sub close_context {
    my Net::SIP::Endpoint $self = shift;
    my $id = shift;
    $id = $id->callid if ref($id);
    DEBUG( 10,"close context call-id $id " );
    my $ctx = delete $self->{ctx}{$id} || do {
	DEBUG( 50,"no context for call-id $id found" );
	return;
    };
    # cancel all outstanding deliveries
    $self->{dispatcher}->cancel_delivery( callid => $id );
    return $ctx;
}


############################################################################
# receive packet from dispatcher and forwards it to receive_response
# or receive_request depending on type of packet
# Args: ($self,$packet,$leg,$from)
#   $packet: Net::SIP::Packet
#   $leg: Net::SIP::Leg through which the packets was received
#   $from: hash with information where it got packet from
# Returns: NONE
############################################################################
sub receive {
    my Net::SIP::Endpoint $self = shift || return;
    my ($packet,$leg,$from) = @_;
    return $packet->is_response
	? $self->receive_response( $packet,$leg,$from )
	: $self->receive_request( $packet,$leg,$from )
	;
}

############################################################################
# Handle incoming response packet
# Args: ($self,$response,$leg,$from)
#  $response: incoming Net::SIP::Response packet
#  $leg: where response came in
#  $from: hash with information where it got response from
# Returns: NONE
############################################################################
sub receive_response {
    my Net::SIP::Endpoint $self = shift;
    my ($response,$leg,$from) = @_;

    # find context for response or drop
    my $callid = $response->get_header( 'call-id' );
    my $ctx = $self->{ctx}{$callid} || do {
	DEBUG( 50,"cannot find context for packet with callid=$callid. DROP");
	return;
    };

    DEBUG( 10,"received reply for tid=".$response->tid );
    $self->{dispatcher}->cancel_delivery( $response->tid );
    $ctx->handle_response( $response,$leg,$from,$self );
}

############################################################################
# Handle incoming request packet
# Args: ($self,$request,$leg,$from)
#  $request: incoming Net::SIP::Request packet
#  $leg: where response came in
#  $from: hash with information where it got response from
# Returns: NONE
############################################################################
sub receive_request {
    my Net::SIP::Endpoint $self = shift;
    my ($request,$leg,$from) = @_;

    # this might be a request for an existing context or for a new context
    my $callid = $request->get_header( 'call-id' );
    my $ctx = $self->{ctx}{$callid};

    my $method = $request->method;
    if ( ! $ctx ) {
	if ( $method eq 'BYE' || $method eq 'CANCEL' ) {
	    # no context for this call, reply with 481 call does not exist
	    # (RFC3261 15.1.2)
	    $self->new_response(
		undef,
		$request->create_response( 481,'call does not exist' ),
		$leg,  # send back thru same leg
		$from, # and back to the sender
	    );
	    return;
	} elsif ( $method eq 'ACK' ) {
	    # call not exists (maybe closed because of CANCEL)
	    DEBUG(99,'ignoring ACK for non-existing call');
	    return;
	}

	# create a new context;
	$ctx = Net::SIP::Endpoint::Context->new(
	    incoming => 1,
	    method => $method,
	    from => scalar( $request->get_header( 'from' )),
	    to   => scalar( $request->get_header( 'to' )),
	    remote_contact => scalar( $request->get_header( 'contact' )),
	    callid => scalar( $request->get_header( 'call-id' )),
	    via  => [ $request->get_header( 'via' ) ],
	);

	$ctx->set_callback( sub {
	    my ($self,$ctx,undef,undef,$request,$leg,$from) = @_;
	    invoke_callback( $self->{application}, $self,$ctx,$request,$leg,$from );
	});
    }

    # if I got an ACK cancel delivery of Response to INVITE
    if ( $method eq 'ACK' ) {
	$self->{dispatcher}->cancel_delivery( $request->tid );
    }

    $ctx->handle_request( $request,$leg,$from,$self );
}

############################################################################
# deliver a response packet
# Args: ($self,$ctx,$response,$leg,$addr)
#   $ctx     : Net::SIP::Endpoint::Context which generated response
#   $response: Net::SIP::Response packet
#   $leg     : leg to send out response, eg where the request came in
#   $addr    : where to send respone (ip:port), eg where the request came from
# Returns: NONE
############################################################################
sub new_response {
    my Net::SIP::Endpoint $self = shift;
    my ($ctx,$response,$leg,$addr) = @_;

    $self->{ctx}{ $ctx->callid } = $ctx if $ctx; # keep context
    $self->{dispatcher}->deliver( $response,
	leg      => $leg,
	dst_addr => $addr,
    );
}


1;