#!/usr/bin/env perl

#  Copyright (c) 2005-2008 Frédéric Senault.  All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. Neither the name of the author or any contributors may be used to
#    endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE AHTOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

use strict;
use Getopt::Long qw(:config bundling);

my $md5=1;
eval {
	require Digest::MD5;
	import Digest::MD5 qw(md5 md5_hex);
};
$md5=0 if($@);
undef $@;
undef $!;

sub usage {
	print "$0 (-d|-s|-t) [(-H|-a)] [-r dir] < file\n";
	print "$0 -c [-r dir] name ...\n\n";
	print "Mode can be :\n";
	print "   d : (default) read from a foregrounded racoon session\n";
	print "   s : read from a sylog extract\n";
	print "   t : read from a tcpdump session (only the beginning of ph1)\n";
	print "   a : translate hex strings in ASCII (only printable chars)\n";
	print "   c : shows a constant value in bot decimal and hex\n";
	print "   r : a directory where racoon header files may be found.\n";
	print "   H : for html output.\n";
	print "   C : to read from CGI.\n";
	print "\n";
	print "To exploit raccon traces, the log level must be debug or higher.\n";
	print "If a full log is provided, about half of the output will be\n";
	print "garbage - the good news being that the other half is actaully\n";
	print "usable.\n";
	exit(1);
}
my $ncols=5;
my $mode='';
my $rp='/home/fred/site/lacave/cgi-bin/racoon-src';
my $adump=0;
my $cdump=0;
my $html=0;
my $docgi=0;
my @in=();

if($0=~/_cgi/) {
	$docgi=1;
	require CGI;
	my $cgi=new CGI;
	$html=($cgi->param('text')?0:1);
	print "Content-Type: text/plain\n\n" unless($html);
	if($cgi->param('tcpdump')) {
		$mode='t';
	} elsif($cgi->param('syslog')) {
		$mode='s';
	} else {
		$mode='d';
	}
	@in=split(/[\r\n]+/,$cgi->param('dump'));
	undef $cgi;
} else {
	GetOptions('d' => \&setmode,
		   's' => \&setmode,
		   't' => \&setmode,
		   'a' => \$adump,
		   'c' => \$cdump,
		   'r' => \$rp,
		   'H' => \$html,
		   'C' => \$docgi);
}

sub setmode {
	usage if($mode);
	$mode=shift;
}

if($cdump) {
	usage if(scalar(@ARGV)==0);
}

my @lh=($rp.'/oakley.h',
	$rp.'/isakmp.h',
	$rp.'/ipsec_doi.h',
	$rp.'/isakmp_xauth.h',
	$rp.'/isakmp_unity.h',
	$rp.'/isakmp_cfg.h',
	);
my @lm=($rp.'/strnames.c',
	$rp.'/isakmp_read.h'
	);
my %CONST;
my %NAMES;
my %LINKS;
my %NCNST;
my %VNDID;
my @ab;
my @onp;
my @cs;

{
	foreach my $h (@lh) {
		open(H,$h) && do {
			while(<H>) {
				if(/^\s*#\s*define\s*(\S+)\s*(\S+)/) {
					$CONST{$1}=eval($2);
				}
			}
			close(H);
		};
		if($!) {
			print "$h : $!\n";
			$!=0;
		}
	}
	foreach my $l (@lm) {
		open(L,$l) && do {
			my $cs=0;
			while(<L>) {
				if(/\s*static struct ksmap (\S+)\s*\[\]\s*=\s*/) {
					$cs=$1;
					$cs=~s/names?_//;
					push(@cs,$cs);
				}
				if($cs && /\s*{\s*(\S+)\s*,\s*"([^"]+)"(?:\s*,\s*(\S+))?/) {
					my $k;
					if(exists($CONST{$1})) {
						$k=$cs.'.'.$CONST{$1};
						$NCNST{$cs.'.'.$1}=$1;
					} else {
						$k=$cs.'.'.$1;
					}
					$NAMES{$k}=$2;
					if($3 && $3 ne 'NULL') {
						$LINKS{$k}=$3;
						$LINKS{$k}=~s/^(s_|names?_)//;
					}
				}
				if(/;/) {
					$cs='';
				}
			}
			close(L);
		};
		if($!) {
			print "$l : $!\n";
			$!=0;
		}
	}
	if($md5) {
		open(V,$rp.'/vendorid.c') && do {
			my $vs=0;
			while(<V>) {
				if(/static struct vendor_id/) {
					$vs=1;
				}
				if($vs && /^\s*{\s*(\S+)\s*,\s*"([^"]+)"\s*}/) {
					my $k=$1;
					my $v=$2;
					$k=~s/VENDORID_//;
					$v=~s/\\n/\n/g;
					$v=lc(md5_hex($v));
					if($k eq 'UNITY') {
						$v=~s/....$/0100/;
					} elsif($k eq 'XAUTH') {
						$v=substr($v,0,16);
					} elsif($k eq 'DPD') {
						$v='afcad71368a1f1c96b8696fc77570100';
					}
					$VNDID{$v}=$k;
				}
				last if(/^\s*};/);
			}
			close(V);
		};
		if($!) {
			print "$rp/vendorid.c : $!\n";
			$!=0;
		}
	}
}

if($cdump) {
	while(my $c=shift) {
		print $c." = ";
		my $C=$CONST{$c};
		if($C) {
			printf('0x%x = %d',$C,$C);
			foreach my $cs (@cs) {
				if(exists($NCNST{$cs.'.'.$c})) {
					print " (".$NAMES{$cs.'.'.$C}.")";
				}
			}
		}
		print "\n";
	}
	exit(0);
}

if($html) {
	print "Content-Type: text/html\n\n";
	print "<?xml version='1.0'?>\n";
	print "<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.1//EN' ";
	print "'http://www.w3.org/TR/xhtml1/DTD/xhtml11.dtd'>\n";
	print "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en'>\n";
	print "<head>\n";
	print "  <link rel='stylesheet' type='text/css' href='/~fred/css/fred.css' />\n";
	print "  <link rel='stylesheet' type='text/css' href='/~fred/css/racoon.css' />\n";
	print "  <meta http-equiv='Content-Type' content='text/html; charset=iso-8859-1' />\n";
	print "  <title>Packet analysis.</title>\n";
	print "</head>\n";
	print "<body>\n";
	print "<h1>Packet analysis</h1>\n";
	print "<table>\n";
	print "<tr class='sep'>\n";
	print "<td style='width: ".(int(40/($ncols-1)))."%'>&nbsp;</td>\n" for((1..$ncols-1));
	print "<td style='width: 60%'>&nbsp;</td>\n";
	print "</tr>\n";
}

{
	my $from='unk';
	my $to='unk';
	my $i=1;
	my $f=1;
	my $c=0;
	my $sz=0;
	my $trig=0;
	my $d=0;
	while(1) {
		if($docgi) {
			$_=shift(@in);
			$c=1 if($_ eq '' && scalar(@in)==0);
		} else {
			$_=<>;
			$c=1 if(eof());
		}
		s/[\r\n]+//g;
		chomp;
		if(@ab) {
			my $p=0;
			if($mode eq 's') {
				$p=1;
			} elsif($mode eq 't') {
				if(/^[^\s]/ || $c) {
					$p=1;
					slurp(42); # Header UDP
				}
			} else {
				$p=1 if(/(DEBUG|INFO|DEBUG2|NOTICE|WARNING)/ || $c);
			}
			if($p) {
				if($adump) {
					dump_packet($i++,$from,$to);
				} else {
					if(parse_packet($i++,$from,$to,1)==-1) {
						dump_packet($i-1,$from,$to);
					}
				}
				@ab=();
				@onp=();
				$trig=0;
				$d=0;
			}
		}
		last if($c);
		my $sl=0;
		$trig=1 if($f);
		if($mode eq 't') {
			if(/IP (?:\([^)]+\)\s*)?(\S+) > (\S+):/) {
				$from=$1;
				$to=$2;
				$from=~s/\.([^.]+)$/[$1]/;
				$to=~s/\.([^.]+)$/[$1]/;
				$trig=1;
			}
			if(s/\s+0x[a-fA-F0-9]+:\s*((?:[a-fA-F0-9]{4}\s)+).*/$1/) {
				$sl=1;
			}
		} else {
			if(/DEBUG:\s(\d+)\sbytes\s
			    from\s([0-9.\[\]]+)\sto\s([0-9.\[\]]+)/x) {
				$sz=$1;
				$from=$2;
				$to=$3;
				print "$from > $to, $sz b.\n";
				$trig=1;
			} elsif(/DEBUG:\s(\d+)\sbytes\smessage\sreceived\s
			    from\s([0-9.\[\]]+)\sto\s([0-9.\[\]]+)/x) {
				$sz=$1;
				$from=$2;
				$to=$3;
				print "$from > $to, $sz b.\n";
				$trig=1;
			} elsif(/decrypted\./) {
				print "$from > $to, $sz b.\n";
				$d=1;
				$trig=1;
			}
			if($mode eq 's') {
				if(s/.*DEBUG:  ([0-9a-fA-F ]+)$/$1/) {
					if($f || $trig) {
						$sl=1;
					}
				}
			} else {
				if(/^[0-9a-fA-F ]+$/) {
					if($trig) {
						$sl=1;
					}
				}
			}
		}
		if($sl) {
			tr/0-9A-Fa-f//cd;
			s/(..)/$1,/g;
			s/,$//;
			push(@ab,map(hex,split(/,/)));
			$f=0;
		}
	}
}
if($html) {
	print "</table>\n";
	print "<p class='bp'><a href='http://www.lacave.net/~fred/racoon/analyzer.html'>Back</a></p>\n";
	print "</body>\n";
	print "</html>\n";
}

sub hex_fmt {
	my $h=shift;
	my $m=shift;
	my $c=shift || 4;
	$m=15+scalar(@onp)*4 unless(defined $m);
	my $spc=($html?'':(' ' x $m));
	$h=~s/(.{8})/$1 /g;
	$h=~s/ $//;
	$h=~s/((?:.{8} ){$c})/$1\n$spc/g;
	return $h;
}

sub asc_fmt {
	my $h=shift;
	my $m=shift;
	my $c=shift || 4;
	$m=15+scalar(@onp)*4 unless(defined $m);
	my $spc=($html?'':(' ' x $m));
	$h=~s/((?:.{8}){$c})/$1\n$spc/g;
	return $h;
}

sub htmlize {
	$_=shift;
	s/&/&amp;/g;
	s/</&lt;/g;
	s/>/&gt;/g;
	s/  / &nbsp;/g;
	s/\n/<br \/>/g;
	$_;
}

sub plog {
	my $t=shift;
	my $v=shift;
	my $raw=shift;
	if(!$html) {
		printf("\%".(12+scalar(@onp)*4)."s ".($t?':':'')." \%s\n",$t,$v);
	} else {
		print "<tr>\n";
		for((1..scalar(@onp))) {
			print "<td>&nbsp;</td>\n";
		}
		$t=htmlize($t);
		$v=htmlize($v);
		print "<td colspan='".($ncols-1-scalar(@onp))."'";
		print " class='typ_".(scalar(@onp)+1)."'>$t</td>\n";
		print "<td class='dat'>".($raw?'<tt>':'').$v.($raw?'</tt>':'')."</td>\n";
		print "</tr>\n";
	}
		
}

sub plogx {
	plog(shift,hex_fmt(shift),1);
}

sub plogc {
	plog("",shift);
}

sub plogcr {
	plog("",shift,1);
}

sub slurp {
	my $c=shift || 1;
	$c=($c>scalar(@ab)?scalar(@ab):$c);
	return (splice(@ab,0,$c));
}

sub peek {
	my $c=shift || 1;
	$c=($c>scalar(@ab)?scalar(@ab):$c);
	return @ab[0..$c-1];
}

sub asc_slurp {
	my $c=shift || 1;
	return join('',map({ chr((($_<32 || $_>127)?46:$_)) } slurp($c)));
}

sub hex_slurp {
	my $c=shift || 1;
	my $p=shift;
	return join('',map({ sprintf('%02x',$_) } slurp($c)));
}

sub hex_peek {
	my $c=shift || 1;
	my $p=shift;
	return join('',map({ sprintf('%02x',$_) } peek($c)));
}

sub dec_slurp {
	my $c=shift || 1;
	return hex(hex_slurp($c));
}

sub name {
	my $d=shift;
	my $n=shift;
	my $f=shift;
	$f=1 if(!defined $f);
	my $r=$NAMES{"$d.$n"};
	if($r) {
		return "$r".($f?" ($n)":'');
	} else {
		return "$d".($f?" ($n)":'');
	}
}
#/* 3.1 ISAKMP Header Format
#	 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!                          Initiator                            !
#	!                            Cookie                             !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!                          Responder                            !
#	!                            Cookie                             !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!  Next Payload ! MjVer ! MnVer ! Exchange Type !     Flags     !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!                          Message ID                           !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!                            Length                             !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#*/

sub dump_packet {
	my $num=shift;
	my $from=shift;
	my $to=shift;
	print "".('-' x 72)."\n";
	if($from ne 'unk') {
		print "Packet #$num, from $from, to $to\n";
	} else {
		print "Packet #$num\n";
	}
	print "".('-' x 72)."\n";
	print asc_fmt(asc_slurp(scalar(@ab)),0,8)."\n\n";
}

sub parse_packet {
	my $num=shift;
	my $from=shift;
	my $to=shift;
	my $dec=shift;
	my $np;
	{
		my $ic=hex_slurp(8);
		my $rc=hex_slurp(8);
		   $np=dec_slurp(1);
		my $ve=hex_slurp(1);
		my $et=dec_slurp(1);
		my $fl=dec_slurp(1);
		my $mi=hex_slurp(4);
		my $le=dec_slurp(4);
		my @f;
		return -1 if(scalar(@ab)==0);
		return -1 if($ve ne '10');
		return -1 if(!$dec && $fl & $CONST{'ISAKMP_FLAG_E'});
		return -1 if($le > 10000 || $le == 0);
		if(!$html) {
			print "".('-' x 72)."\n";
		} else {
			print "<tr><td colspan='$ncols' class='mt'>";
		}
		if($from ne 'unk') {
			print "Packet #$num, from $from, to $to";
		} else {
			print "Packet #$num";
		}
		if(!$html) {
			print "\n";
			print "".('-' x 72)."\n";
		} else {
			print "</td></tr>\n";
			print "<tr><td colspan='6' class='t'>";
		}
		print "Header\n";
		if(!$html) {
			print "======\n";
			print "\n";
		} else {
			print "</td></tr>\n";
			print "<tr class='sep'><td colspan='$ncols'>&nbsp;</td></tr>\n";
		}
		plogx('I. Cookie',$ic);
		plogx('R. Cookie',$rc);
		plog('Version',join('/',split(//,$ve)));
		plog('Exc. Type',name('isakmp_etype',$et));
		foreach my $v (('ISAKMP_FLAG_E','ISAKMP_FLAG_C','ISAKMP_FLAG_A')) {
			my $b=$CONST{$v};
			if($fl & $b) {
				push(@f,$NAMES{"flag.$b"});
			}
		}
		plog('Flags',"$fl".(@f?" = ".join('+',@f):''));
		plogx('MessageID',$mi);
		plog('Length',$le);
		if(!$html) {
			print "\n";
		} else {
			print "<tr class='sep'><td colspan='$ncols'>&nbsp;</td></tr>\n";
			print "<tr><td colspan='$ncols' class='t'>";
		}
		print "Payloads\n";
		if(!$html) {
			print "========\n";
			print "\n";
		} else {
			print "</td></tr>\n";
		}
	}
	#/* 3.2 Payload Generic Header
	#	 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
	#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
	#	! Next Payload  !   RESERVED    !         Payload Length        !
	#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
	#*/

	#	 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
	#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
	#	!A!       Attribute Type        !    AF=0  Attribute Length     !
	#	!F!                             !    AF=1  Attribute Value      !
	#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
	#	.                   AF=0  Attribute Value                       .
	#	.                   AF=1  Not Transmitted                       .
	#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
	my $first=1;
	while(1) {
		my $cp=$np;
		my $spi=0;
		my $spin=1;
		my $sa=0;
		my $pd=0;
		my $dom='';
		print "<tr class='sep'><td colspan='$ncols'>&nbsp;</td></tr>\n" if($html);
		plog('Type',name('isakmp_nptype',$np));
		$np=dec_slurp(1);
		dec_slurp(1); # RESERVED
		my $l=dec_slurp(2);
		plog('Length',$l);
		my $r='';	
		$l-=4;
		if($l>10000 || $l==0) {
			return -1;
		}
		if($cp==$CONST{'ISAKMP_NPTYPE_SA'}) {
			$r='SA';
			$sa=1;
			# ?
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_P'}) {
			plog('Number',dec_slurp(1));
			plog('Protocol',name('ipsecdoi_proto',dec_slurp(1)));
			$spi=dec_slurp(1);
			plog('SPI size',$spi);
			plog('Transforms',dec_slurp(1));
			$r='Proposals';
			$l-=4;
			$sa=2;
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_T'}) {
			plog('T. number',dec_slurp(1));
			plog('T. ID',dec_slurp(1));
			dec_slurp(2); # RESERVED
			$pd=1;
			$dom='tr';
			$r='T.';
			$l-=4;
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_KE'}) {
			$r='Key';
			# .
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_ID'}) {
			plog('Type',name('ipsecdoi_ident',dec_slurp(1)));
			plog('Spec. data',hex_slurp(3));
			$r='ID';
			$l-=4;
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_CERT'}) {
			$r='Cert';
			# .
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_CR'}) {
			plog('CR type',name('isakmp_certtype',dec_slurp(1)));
			$l-=1;
			$r='CR';
			# .
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_HASH'}) {
			$r='Hash';
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_SIG'}) {
			$r='Sig';
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_NONCE'}) {
			$r='Nonce';
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_N'}) {
			plog('DOI',name('doi',dec_slurp(4)));
			plog('Protocol',name('ipsecdoi_proto',dec_slurp(1)));
			$spi=dec_slurp(1);
			plog('SPI size',$spi);
			plog('Notify',name('isakmp_notify_msg',dec_slurp(2)));
			$r='Notify data';
			$l-=8;
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_D'}) {
			plog('DOI',name('doi',dec_slurp(4)));
			plog('Protocol',name('ipsecdoi_proto',dec_slurp(1)));
			$spi=dec_slurp(1);
			plog('SPI size',$spi);
			$spin=dec_slurp(2);
			plog('# of SPI',$spin);
			$r='Delete';
			$l-=8;
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_VID'}) {
			my $vid=lc(hex_slurp($l));
			my $vi2=hex_fmt($vid,0);
			if($VNDID{$vid}) {
				plog('Vendor ID',"$VNDID{$vid} ($vi2)");
			} else {
				plog('Vendor ID',"$vi2");
			}
			$l=0;
			#$r='Vendor ID';
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_ATTR'}) {
			$r='Attributes';
			plog('Type',dec_slurp(1));
			dec_slurp(1); # RESERVED 2
			plogx('ID',hex_slurp(2));
			$pd=2;
			$dom='isakmp_cfg_type';
			$r='Attribute';
			$l-=4;
			# ?
		} elsif($cp==$CONST{'ISAKMP_NPTYPE_FRAG'}) {
			$r='IKE Frag';
		} else {
			$r=name('isakmp_nptype',$cp);
			$r=~s/(ISAKMP_)?(NPTYPE_)?//g;
		}
		if($sa==1) {
			plog('SA DOI',name('doi',dec_slurp(4)));
			plog('SA Situ.',name('situ',dec_slurp(4)));
			$l=0;
			push(@onp,$np);
			$np=$CONST{'ISAKMP_NPTYPE_P'};
		} elsif($sa==2) {
			$l=0;
			push(@onp,$np);
			$np=$CONST{'ISAKMP_NPTYPE_T'};
		} elsif($sa==3) {
			$l=0;
		}
		if($pd) {
			my($v,$t,$nl,$s);
			$nl=-1;
			$v=0;
			push(@onp,$np);
			while($l>0) {
				my $ll=0;
				if($nl==-1) {
					$t=dec_slurp(2);
					if($t & 0x8000) {
						$t^=0x8000;
						$v=dec_slurp(2);
						$s=1;
						$nl=-1;
					} else {
						$nl=dec_slurp(2);
						if($nl==0) {
							$nl=-1;
							$v='';
							$s=1;
						} else {
							$v=-1;
							$s=0;
						}
					}
					$l-=4;
				} else {
					$v=hex_peek($nl);
					$ll=$nl;
					$l-=$nl;
					$nl=-1;
					$s=0;
				}
				if($v!=-1) {
					my $lnk=$LINKS{$dom.'.'.$t};
					if($lnk && $pd==1) {
						plog(name($dom,$t,1),name($lnk,$v));
					} elsif(!$lnk && $pd==1) {
						if($s) {
							plog(name($dom,$t,1),$v);
						} else {
							plogx(name($dom,$t,1),$v);
						}
					} elsif($lnk && $pd==2) {
						plog($r,name($dom,$t,1).' = '.name($lnk,$v));
					} else {
						if($s) {
							plog($r,name($dom,$t,1).' = '.$v);
						} else {
							plog($r,name($dom,$t,1).' = ');
							plogcr(hex_fmt($v));
							$v=asc_slurp($ll);
							if($v=~/[A-Za-z]{6,}/) {
								plogcr(asc_fmt($v));
							}
							$ll=0;
						}
					}
					$v=-1;
				}
				if($ll) {
					dec_slurp($ll);
				}
					
			}
			pop(@onp);
		}		
			
		if($spi) {
			foreach(($spin)) {
				if($l>=$spi) {
					plogx("SPI $_",hex_slurp($spi));
					$l-=$spi;
				} else {
					plogx("WARNING !",hex_slurp($l));
					$l=0;
					last;
				}
			}
		}
		if($r && $l>0) {
			my $v=hex_peek($l);
			plogx($r,$v);
			$v=asc_slurp($l);
			if($v=~/[A-Za-z0-9]{6}/) {
				plogcr(asc_fmt($v));
			}
		}
		while(@onp && !$np) {
			$np=pop(@onp);
		}
		last unless($np);
		print "\n";
	}
	#print "Leftover : ".scalar(@ab)."\n" if(@ab);
	print "\n";
}

#	 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	~             ISAKMP Header with XCHG of Main Mode,             ~
#	~                  and Next Payload of ISA_SA                   ~
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!       0       !    RESERVED   !        Payload Length         !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!                  Domain of Interpretation                     !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!                          Situation                            !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!       0       !    RESERVED   !        Payload Length         !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!  Proposal #1  ! PROTO_ISAKMP  ! SPI size = 0  | # Transforms  !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!    ISA_TRANS  !    RESERVED   !        Payload Length         !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!  Transform #1 !  KEY_OAKLEY   |          RESERVED2            !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	~                   prefered SA attributes                      ~
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!       0       !    RESERVED   !        Payload Length         !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	!  Transform #2 !  KEY_OAKLEY   |          RESERVED2            !
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#	~                   alternate SA attributes                     ~
#	+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+