Perl Script

classic Classic list List threaded Threaded
14 messages Options
Reply | Threaded
Open this post in threaded view
|

Perl Script

Spady#7
Hi all, I am trying to use the perl script that is present under tutorial section of opensips web site but i have and error on opensips logs and i don't know why, here is the log:

Oct 15 15:11:14 opensips /usr/local/opensips_proxy/sbin/opensips[28780]: ERROR:core:XS_OpenSIPS__Message_log: perl error: Can't locate object method "new" via package "IO::Socket::INET" (perhaps you forgot to load "IO::Socket::INET"?) at /usr/local/opensips_proxy/etc/opensips/perlfunctions.pl line 134.#012

and here is the snippet of code involved :

ub 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'
    );


Have i to modify the line "my $sock = new IO::Socket::INET" ?? or i really missed to load something?
Sorry, for dummy question, but i searched on forum but there is nothing that give me a clue.

Thanks
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Brett Nemeroff
You have a "use" line at the top of your PERL script For that module?

-Brett

On Oct 15, 2012, at 8:32 AM, spady <[hidden email]> wrote:

> Hi all, I am trying to use the perl script that is present under tutorial
> section of opensips web site but i have and error on opensips logs and i
> don't know why, here is the log:
>
> *Oct 15 15:11:14 opensips /usr/local/opensips_proxy/sbin/opensips[28780]:
> ERROR:core:XS_OpenSIPS__Message_log: perl error: Can't locate object method
> "new" via package "IO::Socket::INET" (perhaps you forgot to load
> "IO::Socket::INET"?) at
> /usr/local/opensips_proxy/etc/opensips/perlfunctions.pl line 134.#012 *
>
> and here is the snippet of code involved :
>
> *ub 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'
>    );
> *
>
> Have i to modify the line "my $sock = new IO::Socket::INET" ?? or i really
> missed to load something?
> Sorry, for dummy question, but i searched on forum but there is nothing that
> give me a clue.
>
> Thanks
>
>
>
> --
> View this message in context: http://opensips-open-sip-server.1449251.n2.nabble.com/Perl-Script-tp7582291.html
> Sent from the OpenSIPS - Users mailing list archive at Nabble.com.
>
> _______________________________________________
> Users mailing list
> [hidden email]
> http://lists.opensips.org/cgi-bin/mailman/listinfo/users

_______________________________________________
Users mailing list
[hidden email]
http://lists.opensips.org/cgi-bin/mailman/listinfo/users
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Spady#7
Hi Brett, here is the code:

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);
}
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Brett Nemeroff
So below the line:

> use OpenSIPS::Constants

Put

Use IO::Socket;

Try that

-Brett

On Oct 15, 2012, at 8:36 AM, spady <[hidden email]> wrote:

> Hi Brett, here is the code:
>
> 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);
> }
>
>
>
>
> --
> View this message in context: http://opensips-open-sip-server.1449251.n2.nabble.com/Perl-Script-tp7582291p7582294.html
> Sent from the OpenSIPS - Users mailing list archive at Nabble.com.
>
> _______________________________________________
> Users mailing list
> [hidden email]
> http://lists.opensips.org/cgi-bin/mailman/listinfo/users

_______________________________________________
Users mailing list
[hidden email]
http://lists.opensips.org/cgi-bin/mailman/listinfo/users
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Spady#7
Tried but when restart Opensips I get this error:

Oct 15 15:46:31 opensips /usr/local/opensips_proxy/sbin/opensips[29672]: ERROR:core:XS_OpenSIPS__Message_log: perl error: Can't locate object method "Use" via package "IO::Socket" (perhaps you forgot to load "IO::Socket"?) at /usr/local/opensips_proxy/etc/opensips/perlfunctions.pl line 26.#012

Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Brett Nemeroff
Sorry,
Replying on my iPhone. "Use" should be all lower case:

use IO::Socket;


-Brett

On Oct 15, 2012, at 8:45 AM, spady <[hidden email]> wrote:

> Tried but when restart Opensips I get this error:
>
> *Oct 15 15:46:31 opensips /usr/local/opensips_proxy/sbin/opensips[29672]:
> ERROR:core:XS_OpenSIPS__Message_log: perl error: Can't locate object method
> "Use" via package "IO::Socket" (perhaps you forgot to load "IO::Socket"?) at
> /usr/local/opensips_proxy/etc/opensips/perlfunctions.pl line 26.#012 *
>
>
>
>
>
> --
> View this message in context: http://opensips-open-sip-server.1449251.n2.nabble.com/Perl-Script-tp7582291p7582296.html
> Sent from the OpenSIPS - Users mailing list archive at Nabble.com.
>
> _______________________________________________
> Users mailing list
> [hidden email]
> http://lists.opensips.org/cgi-bin/mailman/listinfo/users

_______________________________________________
Users mailing list
[hidden email]
http://lists.opensips.org/cgi-bin/mailman/listinfo/users
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Spady#7
Ok Brett!!
That's was the problem.
Thanks a lot!!!!
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Spady#7
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
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Spady#7
Is there a way to test "offline" the perl script to check what's wrong?
Seems that script can't extract IP from VIA header of 183 message.
Am I wrong?
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Spady#7
No one as idea?
Just in case, is there another way to convert 183 into 180?
Thanks
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Muhammad Shahzad

I used the script long time ago and had no problem. I will check it again today against new opensips version and let you know if i find anything.

Thank you.

On Oct 18, 2012 10:40 AM, "spady" <[hidden email]> wrote:
>
> No one as idea?
> Just in case, is there another way to convert 183 into 180?
> Thanks
>
>
>
> --
> View this message in context: http://opensips-open-sip-server.1449251.n2.nabble.com/Perl-Script-tp7582291p7582359.html
> Sent from the OpenSIPS - Users mailing list archive at Nabble.com.
>
> _______________________________________________
> Users mailing list
> [hidden email]
> http://lists.opensips.org/cgi-bin/mailman/listinfo/users


_______________________________________________
Users mailing list
[hidden email]
http://lists.opensips.org/cgi-bin/mailman/listinfo/users
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Binan83
In reply to this post by Spady#7
Hi,

Use change_reply_status(code, reason) in sipmsgops module
http://www.opensips.org/html/docs/modules/devel/sipmsgops.html#change_reply_status

// Binan

Från: spady <[hidden email]>
Till: [hidden email]
Skickat: torsdag, 18 oktober 2012 10:40
Ämne: Re: [OpenSIPS-Users] Perl Script

No one as idea?
Just in case, is there another way to convert 183 into 180?
Thanks



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

_______________________________________________
Users mailing list
[hidden email]
http://lists.opensips.org/cgi-bin/mailman/listinfo/users



_______________________________________________
Users mailing list
[hidden email]
http://lists.opensips.org/cgi-bin/mailman/listinfo/users
voipmagazine.wordpress.com/
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Spady#7
In reply to this post by Muhammad Shahzad
Thanks Muhammad,
i will wait for your reply.
Btw, I am using OpenSIPS v. 1.8.0
Reply | Threaded
Open this post in threaded view
|

Re: Perl Script

Spady#7
In reply to this post by Binan83
Hi Binan, thanks for your hint. I resolved my problem, without using perl script.
Thanks to everybody.