Коллеги, выручайте!
В перле ни ганджубас :(
Отсюда:
http://ipo.wikidot.com/sniff

Вот скрипт:

#!/usr/bin/perl -w

use Config::Tiny;
use Net::TFTP;
use IO::Socket::INET;
use POSIX;

## Avaya Fn Description

%TAIL = (             ## this is tail exceptions (normal is 0x44)
    0x0526 => 0x4e,
    0x0705 => 0x48,
    0x071d => 0x43,
    0x0726 => 0x4e,
    0x0426 => 0x4e
);

@KNOWN = (            ## Functions known (and loved)
    0x0200,
    0x0405, 0x0408, 0x0409, 0x040a, 0x040d, 0x040e, 0x041f, 0x0425, 0x0426,
    0x0505, 0x0506, 0x0507, 0x0508, 0x050a, 0x050b, 0x050c, 0x050e, 0x0526, 0x052b,
    0x0705, 0x0706, 0x0707, 0x0708, 0x070a, 0x070b, 0x070c, 0x070e, 0x071c, 0x071d, 0x071e, 0x071f, 0x0722, 0x0726, 0x072b, 0x072c,
    0x0800
);

foreach (@KNOWN)    {
    $known{$_} = 1;
}

# Reading config
$Config = Config::Tiny->read( 'phoneavay.ini' );

$user = $Config->{_}->{User};
$pass = $Config->{_}->{Password};
$pbx  = $Config->{_}->{IPOffice};
$pref = $Config->{_}->{Prefer0x07};

$TIMEOUT=5;        ## UDP Timeout

$reqstr = "";        ## request string with name and password
$counter = 0;        ## Counter for the packets

# Making password encoded
$s = $pass;
for($i=0; length($s) != 0; $s = substr($s,1))    {
    $c = unpack("C", $s);
    $nc = $c + 0x10 - $i;
    $ps .= pack("C", $nc);
    $i++;
}
print tftp_get_str("nasystem/who_is")."\n";
tftp_get_str("nasystem/user_list2");
tftp_get_str("nasystem/licence_list");
tftp_get_str("nasystem/user_list4");
tftp_get_str("nasystem/extn_list");
$reqstr = sprintf("%c%s%c%s", length($user), $user, length($ps), $ps);

# Preparing UDP
$ipo = new IO::Socket::INET->new(PeerPort=>50796,Proto=>'udp',PeerAddr=>$pbx) || die;

## Running listening thread

login_to_pbx();

$| = 1;

while(1)    {
    next    if(! ($s = read_reply()));
    $counter = unpack("C", substr($s,1,1));
    send_ok();
    process_reply($s)    if(defined($s));
    last     if(substr($s,0,1) eq "\x02");
}

print "Well done";

logout_from_pbx();

exit;

sub read_reply {
    my $packet = undef;
    eval {
        local $SIG{ALRM} = sub { die "alarm time out" };
        alarm $TIMEOUT;
        $ipo->recv($packet, 1024)      or die "recv: $!";
        alarm 0;
    };
    return $packet;
}

# *************
# decode_passtr(buff) - decode pascal string (len)str
# returns array (str,rest_part)
#    str - resulting string
#    rest_part - rest part of data just after string

sub decode_passtr    {
    my $b = shift;
    my $s = "";
    my $len = unpack("C", $b);
    $b = substr($b,1);
    while($len--)    {
        $s .= substr($b,0,1);
        $b = substr($b,1);
    };
    return ($s, $b);
}

sub process_reply    {
    my $packet = shift;
    $fn = unpack("C", $packet);
    $counter = unpack("C", substr($packet,1));
    if($fn == 0x02)    {
        print "Logout\n";
    } elsif($fn == 0x08)    {
#        print "OK\n";
    } else    {            # getting subfn
        $fn = avaya_fn($packet);
        if(defined($known{$fn}))    {
            return    if(length($packet) < 0x1a);    # ignore short packets
        # decoding payload
            $dddd = unpack("N", substr($packet, 0x1a, 4));
            $vc = unpack("N", substr($packet, 0x11, 4));
            ($s1, $s2, $s3, $s4, $packet) = decode_dddd(substr($packet, 0x1a));
            $off = 0x44;        # standard offset
            $off = $TAIL{$fn}    if(defined($TAIL{$fn}));
            ($sp, $packet) = decode_passtr(substr($packet, $off));
        # analyze it
            return    if($fn == 0x071f || $fn == 0x041f);    # skip "i'm alive"
            if($fn == 0x0405)    {
                print strftime("%H:%M", localtime(time)), " handset lifted, ";
            } elsif($fn == 0x071d)    {
                $sp =~ s/[\r\n]+//g;
                print "($sp)";
            } elsif($fn == 0x0409)    {
                print "$s1";
            } elsif($fn == 0x071c)    {
                print "connected $s3->$s1";
            } elsif($fn == 0x070e)    {
                print " hang up\n";
            } elsif($fn == 0x0506 || $fn == 0x0706)    {
                return if(ignored($fn));
                print "[$s1 ($sp) dialed]"    if($s1 ne "");
                # skip
            } elsif($fn == 0x0507 || $fn == 0x0707)    {
                # skip
            } elsif($fn == 0x052b || $fn == 0x072b)    {
                # skip
            } elsif($fn == 0x050e || $fn == 0x040e)    {
                # skip
            } elsif($fn == 0x050a || $fn == 0x070a)    {
                # skip
            } elsif($fn == 0x070b || $fn == 0x050b)    {
                # skip
            } elsif($fn == 0x0425)    {
                print "(second call)";
            } elsif($fn == 0x0423)    {
                print "(call retrieved)";
            } elsif($fn == 0x040d)    {
                # skip
            } elsif($fn == 0x0722)    {
                # skip
            } elsif($fn == 0x051c)    {
                # skip
            } elsif($fn == 0x0408)    {
                # skip
            } elsif($fn == 0x0508 || $fn == 0x0708)    {
                return if(ignored($fn));
                print " waiting ";
            } elsif($fn == 0x040a)    {
                # skip
            } elsif($fn == 0x0505 || $fn == 0x0705)    {
                return if(ignored($fn));
                print strftime("%H:%M", localtime(time)), " incoming $sp($s3)";
            } elsif($fn == 0x0526 || $fn == 0x0726)    {
                return if(ignored($fn));
                print "  VM: $s1: $s2 $s3\n";
            } else {    # print function
                $sp = printable_str($sp);
                printf "S: 0x%04x", $fn;
                printf " VC=%d", $vc;
                printf " %08x:($s1)($s2)($s3)($s4)", $dddd;
                print "+($sp)\n";
            }
        } else {
            printf " unknown %04x", $fn;
            dump_hex($packet);
        }
    }
}

# returns string from PBX
sub tftp_get_str    {
    my $rrq = shift;

    my $tftp = Net::TFTP->new("$pbx", Mode => "octet");
    $fh = $tftp->get("$rrq");
    $s = <$fh>;
    chomp $s;
    return $s;
}

# Send a request to pbx
#   send_to_pbx ( function, payload);
#
sub send_to_pbx    {
    my ($fn, $req) = (shift, shift);
    my $s = sprintf("%c%c$reqstr$req", $fn, $counter);
    $ipo -> send($s);
#    print "\nSent:";
#    dump_hex($s);
}

sub send_ok    {
    send_to_pbx(0x08, "");
}

# Try to login to PBX
sub login_to_pbx {
    send_to_pbx(0x03, "\x01\x01\x00\x01\x00\x01\x00\x00\x00\x00");
    my $reply = read_reply();
    if(substr($reply,0,1) eq "\x0a")    {    ## name/pass error
        ($s1, $reply) = decode_passtr(substr($reply, 2));
        ($s2, $reply) = decode_passtr($reply);
        return "$s1: $s2";
    } else {
        return "Ok";
    }
}

sub logout_from_pbx    {
    send_to_pbx(0x02, "");
    read_reply();
}

# dumps the string out in hex
sub dump_hex    {
    my $data = shift;
    my $i;
    my $ascii = "";
    for($i=0;$i != length($data); $i++)      {
        if(($i & 0x1f) == 0)    {
            print "$ascii\n";
            $ascii = "    ";
        }
        $rc = substr($data, $i, 1);
        $c = unpack("C", $rc);
        printf " %02x", $c;
        $rc =~ s/[\x00-\x1f\x80-\xff]/./;
        $ascii .= $rc;
    }
    print "   " x (34-length($ascii))."      $ascii\n";
}

# decode dddd reply
# Returns:
# (s1,s2,s3,s4,rest)
# s1/s2 - first 2 strings
# s3/s4 - second strings
# rest  - rest part
sub decode_dddd {
    my $data = shift;
    my ($s1, $s2, $s3, $s4);
    ($s1, $data) = decode_passtr(substr($data,4));
    ($s2, $data) = decode_passtr($data);
    ($s3, $data) = decode_passtr(substr($data,4));
    ($s4, $data) = decode_passtr($data);
    return ($s1, $s2, $s3, $s4, substr($data,4));
}

sub avaya_fn    {
    my $data = shift;
    return unpack("v", substr($data,4,1).substr($data,0,1));
}

sub printable_str    {
    $_ = shift;
    s/[\x00-\x1f\x80-\xff]/sprintf("\\x%02x", unpack("C", $&))/ge;
    return $_;
}

sub ignored    {
    my $a = shift;
    return ($pref == 1 && ($a >> 8) == 5) || ($pref == 0 && ($a >> 8) == 7);
}

Берет с тел. станции информацию в Windows-1251.
А вывод требуется в UTF-8
Как туда декодирование добавить?