#####################################################################
# 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/10
#
#####################################################################

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

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;
}

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;
}

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/, $m->getFullHeader();

    foreach (@header_lines) {
        if (/^Via:/) {
            $via .= $_ . "\r\n";
        } else {
            if (! $status_line) {
                $status_line = $_ . "\r\n";
            } else {
                $headers .= $_ . "\r\n";
            }
        }
    }
    $new_header = $status_line;
    $new_header =~ s/^SIP\/2\.0\s\d{3}\s.+$/SIP\/2.0 180 Ringing/;

    $vias = parseHeaderLines($via);
    shift @{$vias->{Via}};
    foreach $key (keys %$vias) {
        foreach (@{$vias->{$key}}) {
            $new_header .= "Via: $_\r\n";
        }
    }
    $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}$/;
    $new_header .= $headers;
    sendSipMessage($new_header);
    return 1;
}

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'
    );
    return unless $sock;
    print $sock $msg;
    close($sock);
}