use strict;
use warnings;
while (<>) {
    if (/^ 7e (.*) 7e/) {
        my @pkts= map { s/7d (\w\w)/sprintf("%02x", hex($1)^0x20)/eg; s/\s//g; s/\w\w\w\w$//; pack 'H*', $_ } split / 7e 7e /, $1;
        for my $pkt (@pkts) {
            my ($a,$b)= unpack("CC", $pkt);
            my $proto= ($a&1) ? $a : ($a<<8)|$b;
            my $ofs= ($a&1) ? 1 : 2;
            if ($proto==0x21) {
                print_ip(substr($pkt,$ofs));
            }
            else {
                printf("PPP:%04x %s\n", $proto, unpack("H*", substr($pkt, $ofs)));
            }
        }

    }
    else {
        print $_;
    }
}
sub print_ip {
    my $pkt=shift;
    my $proto= ord(substr($pkt,9,1));
    my $hlen= 4*(ord(substr($pkt,0,1))&0xf);
    my $plen= unpack("n", substr($pkt,2,2));
    my $srcip= sprintf("%d.%d.%d.%d", unpack("C*", substr($pkt,12,4)));
    my $dstip= sprintf("%d.%d.%d.%d", unpack("C*", substr($pkt,16,4)));
    if ($proto==0x11) {
        print_udp($srcip, $dstip, substr($pkt,$hlen, $plen-$hlen));
    }
    elsif ($proto==0x06) {
        print_tcp($srcip, $dstip, substr($pkt,$hlen, $plen-$hlen));
    }
    else {
        printf("IP:%02x: %s > %s : %s", $proto, $srcip, $dstip, unpack("H*", $pkt));
    }
#0  1  2  3  4  5  6  7  8  9  a  b  c  d  e  f  
#45 00 01 13 00 00 00 00 80 11 aa 94 5a ba 34 8c ff ff ff ff 
}
sub print_udp {
    my ($srcip,$dstip,$pkt)=@_;
    my ($src, $dst, $len)= unpack("nnn", $pkt);
    printf("UDP: %s:%d > %s:%d  %s\n", $srcip, $src, $dstip, $dst, unpack("H*", substr($pkt,8,$len-8)));
#0  1  2  3  4  5  6  7  8  9  a  b  c  d  e  f  
#00 44 00 43 00 ff 00 00 01 08 06 00 12 34 56 78 00 06 00 00 5a ba 34 8c 00 00 00 00 00 00 00 00 00 00 00 00 00 53 45 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 63 82 53 63 35 01 08 37 01 0f ff
}
sub print_tcp {
    my ($srcip,$dstip,$pkt)=@_;
    my ($src, $dst, $seq, $ack, $ofs, $flags, $win, $chk, $urg)= unpack("nnNNCCnnn", $pkt);
    my $f="";
    $f .= 'U' if ($flags&0x20);
    $f .= 'A' if ($flags&0x10);
    $f .= 'P' if ($flags&0x08);
    $f .= 'R' if ($flags&0x04);
    $f .= 'S' if ($flags&0x02);
    $f .= 'F' if ($flags&0x01);
    my $hlen= 4*($ofs>>4);
    printf("TCP: %s:%d > %s:%d [%s] %s\n", $srcip, $src, $dstip, $dst, $f, unpack("H*", substr($pkt,$hlen)));
}