[OpenSIPS-Users] Perl Script

[spady]

Hi Brett and all, after some tests i can use the perl script but it has to be
adjusted to fit my enviroment.
Now i see on opensips log that the $ip is missing, infact i have this error:

*Oct 15 16:48:17 opensips /usr/local/opensips_proxy/sbin/opensips[31821]:
INFO:core:XS_OpenSIPS_log: Sending reply transformed to 180 Ringing to :5060
Oct 15 16:48:17 opensips /usr/local/opensips_proxy/sbin/opensips[31821]:
ERROR:core:parse_uri: uri too short: <183> (3)
Oct 15 16:48:17 opensips /usr/local/opensips_proxy/sbin/opensips[31821]:
ERROR:core:do_action: bad uri <183>, dropping packet
Oct 15 16:48:17 opensips /usr/local/opensips_proxy/sbin/opensips[31821]:
CRITICAL:tm:w_t_relay: unsupported route type: 4                           
*

As you can see, the IP is not inserted.

Here is the entire perl code used:

*
use OpenSIPS qw ( log );
use OpenSIPS::Constants;
use IO::Socket;

###
# 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);
}
*

Is there a way to output in some logs the builded new SIP MESSAGE? In
opensips log i can only see the error log but not how is builded.

Why $ip results null???
Thanks



--
View this message in context: http://opensips-open-sip-server.1449251.n2.nabble.com/Perl-Script-tp7582291p7582302.html
Sent from the OpenSIPS - Users mailing list archive at Nabble.com.