Documentation -> Tutorials -> Perl

Replace 183 early media reply with 180 (Ringing)

Task

We want to catch all 183 status responses, remove the SDP body and send a plain 180 reply instead. This example script has also been posted to the OpenSIPS-Users mailinglist and should show the possibilities of the OpenSIPS Perl module.

Usage

loadmodule "perl.so"
modparam("perl", "filename", "/etc/opensips/perlfunctions.pl")

onreply_route[1]
{
    ...
    if(t_check_status("183")) {
        perl_exec("sendReplyAs180");
        drop();
    }
}

Example script (Perl code)

#####################################################################
# Example perl script, sending 180 Ringing for a given reply packet
#
# Description
#
# <to be done - no time right now, script has been discussed on IRC>
#
# WARNING:
#
# This software is given as is, without any warranty and support.
# It may destroy all your servers, delete all your data, kill your
# little dog and hurt your little sister.
#
# I'm not responsible for such side effects - therefore you should
# absolutely NOT use this script unless you exactly understand what
# it will do to your environment.
#
# Author      : Thomas Gelf <thomas@gelf.net>
# License     : Unsure, but: just use it, I'll for sure not sue you!
# Last change : 2009/04/12
#
#####################################################################

use OpenSIPS qw ( log );
use OpenSIPS::Constants;

###
# Create a hashref out of ab=123;bc=45
##
sub splitKeyValue {
    my @parts = split /\;/, shift;
    my $avp;
    my $key;
    my $val;
    while (my $part = shift(@parts)) {
        ($key, $val) = split /=/, $part, 2;
        $avp->{$key} = $val;
    }
    return $avp;
}

###
# Return a hashref of arrays with all headers found in given string,
# grouped by header name (case sensitive!)
##
sub parseHeaderLines {
    my $header = shift;
    my @lines = split /\r?\n/, $header;
    my $headers;
    my $key;
    my $val;
    while ($line = shift @lines) {
        ($key, $val) = split /:\s*/, $line, 2;
        my @values = split /,/, $val;
        push @{$headers->{$key}}, @values;
    }
    return $headers;
}

###
# Should be called for 183 replies, that need to be "converted" to
# SDP-less 180 Ringing replies
##
sub sendReplyAs180 {
    my $vias;
    my $via;
    my $via_params;
    my $top_via;
    my $new_header;
    my $headers;
    my $status_line;
    my $port = 5060;
    my $message = shift;
    my @header_lines = split /\r\n/, $message->getFullHeader();

    # Separate Via lines from the rest of the header
    foreach (@header_lines) {
        if (/^Via:/) {
            $via .= $_ . "\r\n";
        } else {
            if (! $status_line) {
                $status_line = $_ . "\r\n";
            } else {
                # Skip Content-* lines
                $headers .= $_ . "\r\n" if ! /^Content-/i;
            }
        }
    }

    # Add Content-Length: 0
    $headers .= "Content-Length: 0\r\n\r\n";

    # Start new header with different status line
    $new_header = "SIP/2.0 180 Ringing\r\n";

    # Remove topmost Via
    $vias = parseHeaderLines($via);
    shift @{$vias->{Via}};
    foreach $key (keys %$vias) {
        # Add remaining Via's to new header
        foreach (@{$vias->{$key}}) {
            $new_header .= "Via: $_\r\n";
        }
    }

    # Re-add other headers
    $new_header .= $headers;

    # Retrieve destination ip and port, with respect to received and rport
    $top_via = $vias->{Via}[0];
    ($dummy, $top_via) = split /\s+/, $top_via, 2;
    ($ip, $top_via) = split /;/, $top_via, 2;
    my $via_params = splitKeyValue($top_via);
    if ($ip =~ /^(.+)\:(.+)$/) {
        $ip = $1;
        $port = $2;
    }
    $ip = $via_params->{received} if $via_params->{received} =~ /^[0-9\.]+$/;
    $port = $via_params->{rport} if $via_params->{rport} =~ /^\d{4,5}$/;

    # Finally send out the packet
    log(L_INFO, "Sending reply transformed to 180 Ringing to $ip:$port");
    sendSipMessage($ip, $port, $new_header);
    return 1;
}

###
# Send a given SIP message to given IP and port
##
sub sendSipMessage {
    my $ip = shift;
    my $port = shift;
    my $msg = shift;
    my $sock = new IO::Socket::INET (
        PeerAddr  => $ip, 
        PeerPort  => $port,
        Proto     => 'udp',
        LocalPort => '5060',
        ReuseAddr => '1'
    );
    return unless $sock;
    print $sock $msg;
    close($sock);
}