#!perl -w
use strict;
$|=1;
package PPPParser;
use strict;

sub new {
    my ($class, $filename)= @_;
    my $self= bless { req=>{data=>""}, rsp=>{data=>""} }, $class;
    $self->{cap}= PCAPFile->new($filename) if ($filename);
    $self->{last}= {};
    return $self;
}
sub process {
    my ($self, $data)= @_;
    return if ($self->{chan} ne "DATA1");

    $self->{$self->{dir}}{data} .= $data;

    # todo: fix bug in handling frame with missing 0x7e
    # -> now it is assumed to be the closing 0x7e, while usually it is the opening 0x7e
    my $i0= index($self->{$self->{dir}}{data}, "\x7e");
    if ($i0>0) {
        $self->log("warning: DROPPING %s", unpack("H*", substr($self->{$self->{dir}}{data}, 0, $i0)));
        $self->{$self->{dir}}{data}= substr($self->{$self->{dir}}{data}, $i0);
    }
    elsif ($i0<0) {
        $self->log("warning: DROPPING %s", unpack("H*", $self->{$self->{dir}}{data}));
        $self->{$self->{dir}}{data}= "";
        return;
    }

    while (1)
    {
        my $i1= index($self->{$self->{dir}}{data}, "\x7e", 1);
        if ($i1<0) {
            return;
        }
        elsif ($i1==1) {
            $self->log("warning: DROPPING 7e");
            $self->{$self->{dir}}{data}= substr($self->{$self->{dir}}{data}, 1);
            next;
        }

        $self->decodeppp(substr($self->{$self->{dir}}{data}, 1, $i1-1));
        $self->{$self->{dir}}{data}= substr($self->{$self->{dir}}{data}, $i1+1);
    }
}
sub decodeppp {
    my ($self, $data)= @_;

    $data =~ s/\x7d(.)/$1 ^ " "/gse;

    $data= substr($data, 0, -2);  # remove checksum

    $self->{cap}->write($data) if $self->{cap};

    my $off= 0;
    $off += 2 if (substr($data, $off, 2) eq "\xff\x03");
    my $proto= unpack("C", substr($data, $off++, 1));
    if ($proto>=0x80) {
        $proto<<=8;
        $proto |= unpack("C", substr($data, $off++, 1));
    }

    if ($proto==0x21) {
        $self->{sockid}= "IP";
        $self->parseIp(substr($data, $off));
    }
    elsif ($proto==0x8021) {    # see ../xsrc/rfc1332.txt
        $self->{sockid}= "IPCP";
        $self->parseLCP_IPCP($proto, substr($data, $off));
    }
    elsif ($proto==0x8057) {    # see ../xsrc/rfc5072.txt
        $self->{sockid}= "IP6CP";
        $self->parseLCP_IPCP($proto, substr($data, $off));
    }
    elsif ($proto==0xc021) {    # see ../xsrc/rfc1661.txt  ../xsrc/rfc1570.txt
        $self->{sockid}= "LCP";
        $self->parseLCP_IPCP($proto, substr($data, $off));
    }
    elsif ($proto==0xc023) {    # see ../xsrc/rfc1334.txt
        $self->{sockid}= "PAP";
        $self->parsePAP(substr($data, $off));
    }
    else {
        $self->{sockid}= sprintf("ppp:%04x", $proto);
        $self->log("warning: not handling ppp proto %04x", $proto);
    }
}

our %lcpoptionnames= (
  1=>'MRU',    2=>'AsyCtlMap', 3=>'AuthProto', 4=>'QualProto', 5=>'MagicNum', 7=>'ProtoComp', 8=>'AdrCtlComp',
  9=>'FCSalt', 10=>'padding',
  11=>'nummode', 12=>'multilink',
  13=>'callback', 14=>'connettime', 15=>'compframe',
  16=>'dataencap', 17=>'multilinkMRU', 18=>'multilinkShortHdr', 19=>'multilinkEndpt',
  21=>'DCEident',
);

# see ../xsrc/rfc1877.txt, 
# see ../xsrc/rfc1332.txt, 
our %ipcpoptionnames= (
  1=>'IpAddrs', 2=>'IpComp', 3=>'IpAddr', 4=>'MobileIp',
  129=>'DNSSvr1', 130=>'NBNSSvr1',
  131=>'DNSSvr2', 132=>'NBNSSvr2',
);
our %ip6cpoptionnames= (
  1=>'interface',
);
sub pppoptionname {
    my ($proto, $o)=@_;
    if ($proto==0x8021) {
        if (!exists $ipcpoptionnames{$o}) { return sprintf("UNKNOWNIPCPOPTION_%d", $o); }
        return $ipcpoptionnames{$o}
    }
    elsif ($proto==0xc021) {
        if (!exists $lcpoptionnames{$o}) { return sprintf("UNKNOWNLCPOPTION_%d", $o); }
        return $lcpoptionnames{$o}
    }
    elsif ($proto==0x8057) {
        if (!exists $ip6cpoptionnames{$o}) { return sprintf("UNKNOWNIP6CPOPTION_%d", $o); }
        return $ip6cpoptionnames{$o}
    }
    else {
        return sprintf("UNKNOWN%04xOPTION_%d", $proto, $o);
    }
}
our %codenames= (
1 => 'ConfReq', 2 => 'ConfAck', 3 => 'ConfNak', 4 => 'ConfRej', 5 => 'TermReq', 6 => 'TermAck', 7 => 'CodeRej', 8 => 'ProtRej',
9 => 'EchoReq', 10 => 'EchoRep', 11 => 'DiscReq', 12=>'ident', 13=>'timeremain'
);
sub pppcodename {
    my $o=shift;
    if (!exists $codenames{$o}) { return sprintf("UNKNOWNCODE_%d", $o); }
    return $codenames{$o}
}
our %protonames= (
0x8021=>'ipcp', 0x8057=>'ip6cp', 0xc021=>'lcp', 0xc023=>'pap'
);
sub pppprotoname {
    my $o=shift;
    if (!exists $protonames{$o}) { return sprintf("UNKNOWNPROTO_%04x", $o); }
    return $protonames{$o}
}
sub parsePppOptions {
    my ($self, $proto, $code, $id, $data)= @_;
    my @options;
    my $ofs=0;
    while ($ofs<length($data)) {
        my ($type, $len)= unpack("CC", substr($data, $ofs, 2));
        push @options, sprintf("%s[%s]", pppoptionname($proto, $type), unpack("H*", substr($data, $ofs+2, $len-2)));
        $ofs += $len;
    }
    $self->log("%s %s %02x : %s", pppprotoname($proto), pppcodename($code), $id, join(",",@options));
}
sub parseLCP_IPCP {
    my ($self, $proto, $data)= @_;
    if (length($data)<4) {
        $self->log("warning: PPP pkt too short: %s", unpack("H*", $data));
        return;
    }
    my ($code, $id, $len)= unpack("CCn", $data);
    if (length($data)<$len) {
        $self->log("warning: PPP pkt too short: %s", unpack("H*", $data));
        return;
    }
    # ConfReq .. ConfRej
    if ($code>=1 && $code <= 4) {
        $self->parsePppOptions($proto, $code, $id, substr($data, 4));
    }
    else {
        $self->log("%s %s %02x : %s", pppprotoname($proto), pppcodename($code), $id, unpack("H*", substr($data, 4)));
    }
}
our %papcodenames= (
1 => 'AuthReq', 2 => 'AuthAck', 3 => 'AuthNak',
);
sub papcodename {
    my $o=shift;
    if (!exists $papcodenames{$o}) { return sprintf("UNKNOWNCODE_%d", $o); }
    return $papcodenames{$o}
}
sub parsePAP {
    my ($self, $data)= @_;
    if (length($data)<4) {
        $self->log("warning: PAP pkt too short: %s", unpack("H*", $data));
        return;
    }
    my ($code, $id, $len)= unpack("CCn", $data);
    if ($len!=length($data)) {
        $self->log("warning: PAP len=0x%x, datalen=0x%x", $len, length($data));
    }
    $self->log("PAP: %s %02x %s", papcodename($code), $id, unpack("H*", substr($data, 4)));
}

sub parseIp {
    my ($self, $data)= @_;
    if (length($data)<20) {
        $self->log("warning: IP pkt too short: %s", unpack("H*", $data));
        return;
    }
    my $v= unpack("C", $data);
    if (($v>>4)!=4) {
        $self->log("warning: not handling IPv%d packet: %s", $v>>4, unpack("H*", $data));
        return;
    }
    my $hlen= ($v&15)*4;
    if (length($data)<$hlen) {
        $self->log("warning: IP pkt missing options: %s", unpack("H*", $data));
        return;
    }
    my $proto= unpack("C", substr($data, 9, 1));
    my $srcip= unpack("N", substr($data, 12, 4));
    my $dstip= unpack("N", substr($data, 16, 4));
    if ($proto==0x11) {
        $self->{sockid}= "UDP:".join ",", sort "$srcip", "$dstip";
        $self->parseUdp($srcip, $dstip, substr($data, $hlen));
    }
    elsif ($proto==6) {
        $self->{sockid}= "TCP:".join ",", sort "$srcip", "$dstip";
        $self->parseTcp($srcip, $dstip, substr($data, $hlen));
    }
    else {
        $self->{sockid}= sprintf("IP:%02x:%s", $proto, join(",", sort "$srcip", "$dstip"));
        # note: 41 = ipv6 encapsulation ( rfc2473 )
        # 45 00 00 44 00 0e 00 00 80 29 77 57 6d 2a 32 a8 c0 58 63 01 60 00 00 00 00 08 3a 01 20 02 6d 2a 32 a8 00 00 00 00 00 00 6d 2a 32 a8 20 02 c0 58 63 01 00 00 00 00 00 00 c0 58 63 01 80 00 b9 5e 00 00 00 01
        $self->log("warning: not handling IP proto %d", $proto);
        return;
    }
}
sub parseUdp {
    my ($self, $srcip, $dstip, $data)= @_;
    if (length($data)<8) {
        $self->log("warning: UDP pkt too short: %s", unpack("H*", $data));
        return;
    }

    my ($src, $dst, $ulen, $csum)= unpack("nnnn", $data);
    if (length($data)<$ulen) {
        $self->log("warning: UDP pkt too short(d=0x%x, l=0x%x): %s", length($data), $ulen, unpack("H*", $data));
        return;
    }

    $self->{sockid}= 'udp:'.join ",", sort "$srcip:$src", "$dstip:$dst";
    $self->log("UDP %08x:%05d > %08x:%05d  %s",
        $srcip, $src, $dstip, $dst, unpack("H*", substr($data, 8)));
}
sub tcpflags {
    my ($flags)= @_;
    return join("", 
            ($flags&0x01)?"F":"",
            ($flags&0x02)?"S":"",
            ($flags&0x04)?"R":"",
            ($flags&0x08)?"P":"",
            ($flags&0x10)?"A":"",
            ($flags&0x20)?"U":"");
}
sub parseTcp {
    my ($self, $srcip, $dstip, $data)= @_;
    if (length($data)<20) {
        $self->log("warning: TCP pkt too short: %s", unpack("H*", $data));
        return;
    }

    my ($src, $dst, $seq, $ack, $flags, $window, $csum, $urg)= unpack("nnNNnnnn", $data);
    my $hlen= int($flags>>12)*4;
    if (length($data)<$hlen) {
        $self->log("warning: TCP options too short: %s", unpack("H*", $data));
        return;
    }

    $self->{sockid}= 'tcp:'.join ",", sort "$srcip:$src", "$dstip:$dst";
    $self->log("TCP %08x:%05d > %08x:%05d %-5s %s", 
        $srcip, $src, $dstip, $dst, tcpflags($flags), $hlen<length($data) ? unpack("H*", substr($data, $hlen)) : $hlen==length($data) ? "-" : sprintf("hlen>data: %04x>%04x", $hlen, length($data)));
}
sub stamp {
    my ($self, $stamp, $time, $uxtime)= @_;
    $self->{stamp}= $stamp;
    $self->{'time'}= $time;
    $self->{cap}->stamp($stamp, $uxtime) if $self->{cap};
}
sub prop {
    my ($self, $chan, $dir)= @_;
    $self->{chan}= $chan;
    $self->{dir}= $dir;

    $self->{sockid}= "$dir:$chan";
}

sub log {
    my ($self, $fmt, @args)= @_;

    # time since last pkt
    # time since last pkt in same dir
    # time since last pkt on same socket
    printf("%08x(%6d)(%6d)(%6d) %s %s %s\n", $self->{stamp},
        defined $self->{last}{stamp} ? $self->{stamp}-$self->{last}{stamp} : 0,
        defined $self->{last}{$self->{dir}} ? $self->{stamp}-$self->{last}{$self->{dir}} : 0,
        defined $self->{last}{$self->{sockid}} ? $self->{stamp}-$self->{last}{$self->{sockid}} : 0,
        $self->{time},
        $self->{dir}, sprintf($fmt, @args));
    $self->{last}{$self->{sockid}}= $self->{last}{$self->{dir}}= $self->{last}{stamp}= $self->{stamp};
}
package PCAPFile;
use strict;
use IO::File;
sub new {
    my ($class, $filename)= @_;
    my $fh= IO::File->new($filename, "w");
    binmode $fh;
    my $self= bless {
        fh=>$fh
    }, $class;
    $self->writeheader();
    return $self
}
sub writeheader {
    my ($self)= @_;
    # linktype 9 = DLT_PPP : ff 03 ...
    # linktype 50= DLT_PPP_SERIAL : 
    $self->{fh}->print(pack("LSSLLLL", 0xa1b2c3d4, 2, 4, 0, 0, 0x10000, 9));
}
sub write {
    my ($self, $frame)= @_;
    $self->{fh}->print(pack("LLLL", $self->{t0}+int(($self->{stamp}-$self->{stamp0})/1000), ($self->{stamp}%1000)*1000, length($frame), length($frame)));
    $self->{fh}->print($frame);
}
sub stamp {
    my ($self, $stamp, $time)= @_;
    $self->{stamp}= $stamp;
    if (!defined $self->{t0}) {
        $self->{stamp0}= $stamp;
        $self->{t0}= $time;
    }
}
package main;
use strict;
use POSIX;
use Getopt::Long;
my $savefilename;
GetOptions(
    "w=s" => \$savefilename,
);

my $ppp= PPPParser->new($savefilename);
sub makestamp {
    my ($y, $m, $d, $H, $M, $S, $ms)= @_;
    our ($prevsec, $prevmsec, $msecoffset);

    my $secs= POSIX::mktime($S, $M, $H, $d, $m-1, $y-1900);
    my $msecs= hex($ms);

    if (!defined $prevsec) {
        $prevsec= $secs;
        $prevmsec= $msecs;
        $msecoffset= -$prevmsec;
        return $msecs+$msecoffset;
    }
    if (abs(($secs-$prevsec) -($msecs-$prevmsec)/1000)>5) {
        $msecoffset += ($secs-$prevsec)*1000;
        printf("adjusting msec %08x+%08x\n", $prevmsec, ($secs-$prevsec)*1000);
    }

    $prevsec= $secs;
    $prevmsec= $msecs;
    return $msecs+$msecoffset;
}
sub unixtime { return our $prevsec; }
while (<>) {
    s/\s+$//;
    if (/TIMESTAMP: (\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+) @(\w+)\(\+\s*\d+\)\s+\w+\s+(\w+)\s+(req|rsp)/) {
        my ($y, $m, $d, $H, $M, $S, $mshex, $chan, $dir)= ($1, $2, $3, $4, $5, $6, $7, $8, $9);
        my $curstamp= makestamp($y, $m, $d, $H, $M, $S, $mshex);
        my $curtime= sprintf("%04d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S);
        $ppp->stamp($curstamp, $curtime, unixtime());
        $ppp->prop($chan, $dir);
    }
    elsif (/^ (\w.*\w)/) {
        (my $hex= $1) =~ s/\s//g;
        my $data= pack("H*", $hex);
        $ppp->process($data);
    }
    elsif (/\[WCDMA\]/) {
        $ppp->{sockid}= "gsm";
        $ppp->log("%s", $_);
    }
    else {
#       printf("<< %s", $_);
    }
}