#!/usr/bin/perl -w
 
use IO::Socket;
 
$ataip = '192.168.1.158';       
$ataport = 5060;              
$server = 'voipserver';       
 
$lport = 5070;                  # port to listen on
$dgs = new IO::Socket::INET(LocalPort => $lport, Proto => 'udp') or die "Socket: $!\n";
while (1) {
    $rcv = $dgs->recv($ibuf, 2000, 0);
    next unless $rcv && length($rcv) >= 8; # ignore errors
    $raddr = inet_ntoa((sockaddr_in($rcv))[1]); # get source addr
    if ($raddr eq $ataip) {      # packet from ATA
        $ibuf =~ s/(nonce=\"\w+_\w+)_[\w\-]+/$1/; # send original nonce to server
        $dpaddr = sockaddr_in(5070, inet_aton($server));
        $dgs->send($ibuf, 0, $dpaddr); # send to server
    }
    elsif ($raddr eq $server) { # packet from server
        if (($nonce) = $ibuf =~ /nonce=\"(\w+)/) { # need to fix nonce
            ($callid) = $ibuf =~ /Call-ID: ([\w\-]+)/ or die;
            $enonce = '_';      # compute extended nonce
            $enonce .= substr($callid, hex(substr($nonce, $_, 1)), 1) for (0..7);
            $ibuf =~ s/(nonce=\"\w+)/$1$enonce/; # pass new nonce to ATA
        }
        $dpaddr = sockaddr_in($ataport, inet_aton($ataip));
        $dgs->send($ibuf, 0, $dpaddr); # send to ATA
    }
}