#!/usr/bin/perl -w
######################################################################
# Artemis DEADBEEF to hex tool, (C) 2015-2019 Nosey Nick Waterman,
#   <perl@noseynick.org>   https://noseynick.org/artemis/
# All wrong righted, all rights reserved. Licensed under thev GNU
# Affero General Public License v3.0 https://www.gnu.org/licenses/agpl.txt
# with Commons Clause https://commonsclause.com/ v1.0
######################################################################
# Convert Artemis raw DEADBEEF data streams from binary (or pcap!)
# to hex dumps
######################################################################
# +++++ TODO: Add Getopt::Long arg support, and POD
use strict;
use POSIX  qw(strftime);
my %bufs;

$| = 1; # output autoflush

unless (@ARGV) {
    die "USAGE: $0 [files]\n"
      . "  Will accept [gzipped] files in PCap format or raw DEADBEEF binary\n"
      if -t STDIN;
    @ARGV = '-';
}
my $tsdiv = 1000; # timestamp divisor (default: timestamps are in ms)
my $protover;

for my $fi (@ARGV) { ReadFile($fi); }

sub ReadFile {
    my $fi = shift;
    my $buf;
    $protover = 0; # unknown so far
    
    open(IN, $fi) or die "Can't read $fi: $!\n";
    print "!file=$fi\n";
    binmode(IN);
    
    read (IN, $buf, 4) == 4  or die "Can't read 4 bytes: $!\n";
    my $magic = unpack('V', $buf); # note LITTLE-ENDIAN
    
    if (($magic & 0xffff) == 0x8b1f) {
	# GZIP 0x1f 0x8b magic number ...
	close IN;
	die "Unable to gunzip stdin - please DIY\n" if $fi eq '-';
	
	open(IN, "zcat $fi |")  or die "Can't zcat $fi: $!\n";
	print "# ... is being gunzipped\n";
	binmode(IN);
	
	read (IN, $buf, 4) == 4  or die "Can't read 4 bytes: $!\n";
	$magic = unpack('V', $buf);
    } elsif ($magic == 0x587a37fd) {
	# first 4 bytes of XZ header 0xFD, '7zXZ', 0x00
	# see https://tukaani.org/xz/xz-file-format.txt
	close IN;
	die "Unable to xzcat stdin - please DIY\n" if $fi eq '-';
	
	open(IN, "xzcat $fi |")  or die "Can't xzcat $fi: $!\n";
	print "# ... is being xzcat()ted\n";
	binmode(IN);
	
	read (IN, $buf, 4) == 4  or die "Can't read 4 bytes: $!\n";
	$magic = unpack('V', $buf);
    }
    # ... and in either case, continue where we left off...
    
    if ($magic == 0xDEADBEEF) { # Probably raw artemis TCP stream contents
	ReadDEADBEEF($fi, *IN, $buf);
    } elsif ($magic == 0xa1b2c3d4) { # LITTLE-endian PCap 0xa1b2c3d4
	$tsdiv=1000000; # microsecond
	ReadPCap(*IN, $buf);
    } elsif ($magic == 0xd4c3b2a1) { # BIG-endian PCap 0xa1b2c3d4, 
	$tsdiv=1000000; # microsecond
	die "Sorry, BIG-ENDIAN PCap not supported yet\n"; # ++++
    } elsif ($magic == 0xa1b23c4d) {
	$tsdiv=100000000; # nanosecond +++ untested!
	ReadPCap(*IN, $buf);
    } elsif ($magic == 0x4d3cb2a1) {
	$tsdiv=100000000; # nanosecond +++ untested!
	die "Sorry, BIG-ENDIAN PCap not supported yet\n"; # ++++
    } elsif ($magic == 0x0a0d0d0a) { # PCap-NG
	$tsdiv=1000000; # microsecond, unless/until overridden in PCapNG_IDB
	my $start; # start time will be populated later
	while ($magic) {
	    ReadPCapNG(*IN, $magic, \$start);
	    read (IN, $buf, 4) or last;
	    $magic = unpack('V', $buf);
	}
    } else {
	# +++++ Add support for HEX INPUT!
	die "Sorry, file wasn't in a recognized format\n"
	  . sprintf('  magic=0x%08x', $magic) . "\n";
    }
    close IN;
}

sub ReadDEADBEEF {
    my ($fi, $IN, $buf) = @_;
    # GotBytes() CAN handle 1 byte at a time but that would be horribly slow.
    # CAN handle 8k chunks but this stalls if run in a pipe like:
    #   nc 127.1 2010 | ./deadbeef2hex.pl
    read(IN, $buf, 4, 4); # Hopefully LENGTH
    while (1) {
	my ($deadbeef, $totlen) = unpack('VV', $buf);
	while ( $deadbeef != 0xDEADBEEF ) {
	    # DO NOT have DEADBEEF - keep reading SLOOOOOOWLY 1 byte at a time:
	    GotBytes(substr($buf, 0, 1, ''), $fi); # remove 1st byte
	    read (IN, $buf, 1, 7) or last;         # append 1 more byte
	    ($deadbeef, $totlen) = unpack('VV', $buf);
	}
	$totlen = 20    if ($totlen//0) < 20;
	$totlen = 5000  if $totlen > 5000;
	read(IN, $buf, $totlen-8, 8); # hopefully one complete packet
	GotBytes($buf, $fi);
	
	read(IN, $buf, 8) == 8 or last;
    }
}

sub ReadPCap {
    my ($IN, $buf) = @_;
    # https://wiki.wireshark.org/Development/LibpcapFileFormat

    
    # Read + check rest of PCap file "global" header (already did magic number):
    die "Unable to read 24-byte PCap header: $!\n"
      unless read(IN, $buf, 20) == 20; # Rest of PCap header?
    my ($vmaj, $vmin, $tz, $sigfigs, $snaplen, $network)
      = unpack('vvVVVV', $buf);
    print "# tcpdump capture file (little-endian) - version $vmaj.$vmin\n";
    print "# UNSUPPORTED VERSION !!!\n"
      unless $vmaj == 2 && $vmin == 4;
    print "# WARNING! tz=$tz, expected 0, timestamps may be broken!\n"
      unless $tz == 0;
    # ignore $sigfigs, "all tools set it to 0"
    print "# WARNING! --snapshot-length=$snaplen! reccommend >=2k!\n"
      unless $snaplen >= 2000; # TBH 1k MIGHT be enough?
    die "# network=$network unsupported, need network=1 (ethernet)\n"
      unless $network == 1;
    
    my ($start_sec, $start_usec);
    while (read(IN, $buf, 16) == 16) {
	# Read PCap packet header:
	my ($sec, $usec, $len, $origlen) = unpack('VVVV', $buf);
	unless ($start_sec) {
	    $start_sec  = $sec;
	    $start_usec = $usec;
	    print strftime "!start=%Y-%m-%dT%H:%M:%SZ\n", gmtime($start_sec);
	}
	$sec  = $sec  - $start_sec;
	$usec = $usec - $start_usec;
	if ($usec < 0) { $usec += $tsdiv; $sec--; }
	die "# PCap packet of len $len seems unlikely  :-(\n"
	  if $len > 9000;
	# +++ Way too big for DEADBEEF packets...
	# but CAN happen if TCP stream has got behind and is catching up?
	print "# WARNING: PCap had truncated packet: $len / $origlen:\n"
	  unless $len == $origlen;
	# Read PCap packet data:
	my $read = read(IN, $buf, $len);
	die "Read $read / $len byte PCap packet: $!"
	  unless $read == $len;
	ParseEthernet($buf, ($sec*1000) + (1000*$usec/$tsdiv));
    }
}

sub ReadPCapNG {
    my ($IN, $blocktype, $start) = @_;
    # https://www.winpcap.org/ntar/draft/PCAP-DumpFileFormat.html
    # https://github.com/pcapng/pcapng
    my $buf;
    read (IN, $buf, 4) == 4
      or die "# Unable to read 4-byte PCapNG block len: $!\n";
    my ($len) = unpack('V', $buf);
    # blocks are 32-bit aligned, BUT we already read block type, len:
    my $padded = ($len + 3 - 8) & 0xFFFFFFFC;
    my $block;
    read (IN, $block, $padded) == $padded
      or die "# Unable to read $padded bytes of PCapNG block type $blocktype: $!\n";
    my ($lenrev) = unpack('V', substr($buf, -4));
    print "# WARNING! HEADER LEN was $len and $lenrev ?!?\n"
      unless $len == $lenrev;
    $block = substr($block, 0, $len - 12); # strip padding

    if      ($blocktype == 0x0A0D0D0A) {
	PCapNG_SHB($block);
    } elsif ($blocktype == 1) {
	PCapNG_IDB($block);
    } elsif ($blocktype == 3) { # "Simple Packet Block" is simple:
	my $packlen = unpack('V', $block);
	ParseEthernet(substr($block, 4, $packlen)); # no timestamp!
    } elsif ($blocktype == 6) {
	PCapNG_EPB($block, $start);
    } else {
	printf "# SKIPPING unknown PCapNG Block Type = 0x%08x\n", $blocktype;
    }
}

sub PCapNG_SHB {
    # Read + check (rest of) PCapNG file "section header":
    my ($magic, $maj, $min, undef, undef, $opts) = unpack('VvvVVa*', shift);
    if      ($magic == 0x1A2B3C4D) { # LITTLE-endian PCapNG 0xa1b2c3d4
	printf "# PCapNG file v%d.%d\n", $maj, $min,
    } elsif ($magic == 0x4D3C2B1A) { #    BIG-endian PCapNG 0xa1b2c3d4
	die "Sorry, BIG-ENDIAN PCapNG not supported yet\n"; # ++++
    } else {
	die sprintf("PCapNG has strange magic 0x%x!\n", $magic);
    }
    PCapNG_opts($opts,
	2 => sub { printf "#   H/W: %s\n", shift },
	3 => sub { printf "#   OS:  %s\n", shift },
	4 => sub { printf "#   App: %s\n", shift },
    );
}

sub PCapNG_IDB {
    my ($linktype, undef, $snaplen, $opts) = unpack('vvVa*', shift);
    print "# PCapNG Interface Description: linktype=$linktype snaplen=$snaplen\n";
    die "# linktype=$linktype unsupported, need linktype=1 (ethernet)\n"
      unless $linktype == 1;
    print "# WARNING! --snapshot-length=$snaplen! reccommend >=2k!\n"
      unless $snaplen >= 2000; # TBH 1k MIGHT be enough?
    
    PCapNG_opts($opts,
	2  => sub { printf "#   name : %s\n", shift },
	3  => sub { printf "#   desc : %s\n", shift },
	4  => sub { printf "#   IPv4 : %d.%d.%d.%d/%d.%d.%d.%d\n",    unpack('C8',  shift) },
	5  => sub { printf "#   IPv6 : %x:%x:%x:%x:%x:%x:%x:%x/%d\n", unpack('n8C', shift) },
	6  => sub { printf "#   MAC  : %x:%x:%x:%x:%x:%x\n",          unpack('C6',  shift) },
	7  => sub { printf "#   EUI  : %x:%x:%x:%x:%x:%x:%x%x\n",     unpack('C8',  shift) },
	8  => sub { printf "#   speed: %dbps\n",                      unpack('VV',  shift) }, # +++ handle 64-bit int better?
	9  => sub { $tsdiv = unpack('C',   shift);
	    if      ($tsdiv == 3) { # +++ untested, may not even exist IRL
		print "#   ts res: 3 (milliseconds)\n"; $tsdiv = 1000;
	    } elsif ($tsdiv == 6) {
		print "#   ts res: 6 (microseconds)\n"; $tsdiv = 1000000;
	    } elsif ($tsdiv == 9) { # +++ untested
		print "#   ts res: 9 (nanoseconds)\n";  $tsdiv = 1000000000;
	    } elsif ($tsdiv <128) { # +++ other powers of 10 untested
		print "#   ts res: $tsdiv (UNSUPPORTED!)\n"; $tsdiv = 10 ** $tsdiv;
	    } else { # powers of 2 timestamp divisor +++ untested!
		print "#   ts res: $tsdiv (UNSUPPORTED!)\n"; $tsdiv = 1 << ($tsdiv & 0x7f);
	    }
	},
	10 => sub { printf "#   timezone : %d\n",                     unpack('V',   shift) },
	11 => sub { printf "#   filter (type %d) : %s\n",             unpack('Ca*', shift) },
	12 => sub { printf "#   OS:  %s\n", shift },
	13 => sub {}, # fcslen - ignore
	14 => sub {
	    my ($offa, $offb) = unpack('VV', shift); # +++ handle 64-bit int better?
	    return unless $offa || $offb;
	    die sprintf("Unhandled PCapNG tsoffset %d %d\n", $offa, $offb);
	},
    );
}

sub PCapNG_EPB {
    my ($epb, $start) = @_;
    my ($ifid, $tshi, $tslo, $caplen, $paclen, $dat) = unpack('VVVVVa*', $epb);
    # print "# PCapNG Enhanced Packet Block if=$ifid, ts=$tshi,$tslo len=$caplen/$paclen\n";
    my $packet = substr($dat, 0, ($caplen+3) & 0xFFFFFFFC, ''); # strip data INCL PADDING
    $packet = substr($packet, 0, $caplen);
    PCapNG_opts($dat,
	2 => sub { printf "#   flags : 0x%x\n", unpack('V', shift) },
	3 => sub {}, # hash - ignore
	4 => sub {
	    my ($dropa, $dropb) = unpack('VV', shift); # +++ handle 64-bit int better?
	    return unless $dropa || $dropb;
	    printf "#   WARNING! Dropped %d %d packets!\n", $dropa, $dropb;
	},
    );
    # +++ Hope your Perl is 64-bit capable - Works For Me (TM):
    my $sec = (($tshi<<32) + $tslo)/$tsdiv;
    # print "##### \@ $tshi $tslo ($sec?) ", time(), "\n"; # +++
    unless ($$start) {
	$$start  = $sec;
	print strftime "!start=%Y-%m-%dT%H:%M:%SZ\n", gmtime($$start);
    }
    $sec  = $sec  - $$start;

    ParseEthernet($packet, $sec*1000); # ms
}

sub PCapNG_opts {
    my ($opt, $optlen, $buf) = unpack('vva*', shift);
    my $dumpers = {
	0   => sub {}, # opt_endofopt
	1   => sub { printf "#   %s\n", shift }, # comment
	'*' => sub { print "#   unknown opt $opt = "; hexdump(shift) },
	@_ # others provided in args
    };
    while ($opt) {
        my $dumper = $dumpers->{$opt} || $dumpers->{'*'};
	$dumper->(substr($buf, 0, $optlen));
	$buf = substr($buf, ($optlen+3) & 0xFFFC); # Was padded to 32-bit boundary
	($opt, $optlen, $buf) = unpack('vva*', $buf);
    }
}
    
my (%flows, %cs);
sub ParseEthernet {
    # Parse Ethernet header:
    my ($buf, $ti) = @_;
    my ($eth_dst, $eth_src, $eth_type, $ipv4) = unpack('a6 a6 n a*', $buf);
    return BAD($buf, 'raw PCap', 'Ethernet header too short')
      unless $ipv4;
    return BAD($buf, 'raw PCap', sprintf 'non-IPv4 packet type=0x%04x', $eth_type)
      unless ($eth_type == 0x0800);
    
    # Parse IP header:
    my ($ver,undef,$ip_len,  undef,$frag,  undef,$proto,undef,  $src,$dst,$tcp)
      = unpack('CCn nn CCn NNa*', $ipv4);
    return BAD($ipv4, 'raw IPv4', 'IP header too short')
      unless $ipv4;
    return BAD($ipv4, 'raw IPv4', sprintf 'IPv4 not v4? %d', $ver/16)
      unless ($ver & 0xf0) == 0x40;
    return BAD($ipv4, 'raw IPv4', sprintf 'IPv4 with extra headers %d != 5', $ver & 0x0f)
      unless ($ver & 0x0f) == 5;
    return BAD($ipv4, 'raw IPv4', sprintf 'IPv4 fragment offset=%d', $frag & 0x1fff)
      unless ($frag & 0x1fff) == 0;
    return BAD($ipv4, 'raw IPv4', "IPv4 non-TCP packet proto=$proto")
      unless ($proto == 6); # 6=TCP
    
    # Parse TCP header:
    my ($sport,$dport, $seq,$ack, $flags) = unpack('nn NN n', $tcp);
    return BAD($tcp, 'raw TCP', 'TCP header too short')
      unless $flags && $flags >= 0x5000;
    my $hlen = ($flags & 0xf000) >> 10;
    $tcp = substr($tcp, $hlen);
    $src = sprintf '%d.%d.%d.%d:%d', unpack('C4', pack('N', $src)), $sport;
    $dst = sprintf '%d.%d.%d.%d:%d', unpack('C4', pack('N', $dst)), $dport;
    my ($flow, $rev) = ("$src > $dst", "$dst > $src");
    print "# TCP $flow seq=$seq hlen=$hlen ",
      ($flags & 0x0001 ? 'Fin' : '').
      ($flags & 0x0002 ? 'Syn' : ''),
      ($flags & 0x0004 ? 'Rst' : ''),
      ($flags & 0x0010 ? 'Ack' : ''), "\n";
    
    my $atti = $ti ? " \@$ti" : '';
    # Make up a C/S number in case this is a new connection
    my $cs = 1 + keys %cs;     # number of C/S we already know, +1
    $cs = "0$cs" if $cs < 10;  # make >= 2 digits
    if ($cs{$flow}) {
	$cs = "C$cs{$flow}";
    } elsif ($cs{$rev}) {
	$cs = "S$cs{$rev}";    # Else decide which is most likely to be C / S:
    } elsif (($flags&0x0012) == 0x0002) { # client SYN
	print "!C${cs}_connect=$src$atti\n!S${cs}_connect=$dst$atti\n";
	$cs{$flow} = $cs;  $cs = "C$cs";
    } elsif (($flags&0x0012) == 0x0012) { # server SYNACK (missed client SYN?)
	print "!C${cs}_connect=$dst$atti\n!S${cs}_connect=$src$atti\n";
	$cs{$rev}  = $cs;  $cs = "S$cs";
    } elsif ($dport == 2010) { # client -> 2010 but missed SYN/SYNACK - no timestamp
	print "!C${cs}_connect=$src\n!S${cs}_connect=$dst\n";
	$cs{$flow} = $cs;  $cs = "C$cs";
    } elsif ($sport == 2010) { # server == 2010 but missed SYN / SYNACK - no timestamp
	print "!C${cs}_connect=$dst\n!S${cs}_connect=$src\n";
	$cs{$rev}  = $cs;  $cs = "S$cs";
    } elsif ($sport > $dport) { # client? perhaps? Missed SYN / SYNACK - no timestamp
	print "!C${cs}_connect=$src\n!S${cs}_connect=$dst\n";
	$cs{$flow} = $cs;  $cs = "C$cs";
    } else { # server? FFS give up! Missed SYN / SYNACK - no timestamp
	print "!C${cs}_connect=$dst\n!S${cs}_connect=$src\n";
	$cs{$rev}  = $cs;  $cs = "S$cs";
    }
    print "!${cs}_disconnect$atti\n"  if $flags & 0x0001;
    
    # Check expected vs actual sequence number in case of retries etc
    $flows{$flow} ||= $seq;
    my $diff   = $seq - $flows{$flow};
    my $tcplen = length($tcp);
    # Calculate next expected sequence number - seq + ip_len - headers,
    # Also add 1 for SYN (incl SYNACK) packets
    if      ($diff < 0) {
	if  ($diff < -$tcplen) {
	    print "### SKIP $diff for $tcplen packet: complete dupe - ignore\n";
	    return;
	}
	print "### SKIP $diff for $tcplen packet: keep ", $tcplen+$diff, "?\n";
	substr($tcp, 0, -$diff, ''); # remove bytes we have already seen
    } elsif ($diff > 0) {
	print "### SKIP $diff for $tcplen packet: padding with 00 :-(\n";
	$tcp = ("\0" x $diff) . $tcp;
	print "### NOW ", length($tcp), "\n";
    }
    $flows{$flow} += length($tcp)
      + ($flags & 0x0003 ? 1 : 0); # SYNs and FINs add 1 to seq too
    
    GotBytes($tcp, $cs, $ti) unless $tcp eq '';
    # ++++ Clean up flow cache on RST / FIN?
}

# ++++ debuggery!
# for (sort keys %flows) { 
#     print "# FLOWS: $_ = $flows{$_}\n";
# }
# for (sort keys %cs) {
#     print "# CS: $_ = $cs{$_}\n";
# }


sub BAD {
    my ($dat, $what, $why) = @_;
    print "# IGNORING $why:\n# ";
    hexdump($dat, $what);
    # ++++ cmdline option to NOT dump raw hex, but still complain, for privacy reasons?
}

sub GotBytes {
    my ($dat, $chan, $ti) = @_;
    my $buf = $bufs{$chan} .= $dat; # append to THIS CHAN'S buffer
    
    # +++++ some sort of "abandon hope" logic for "too much" non-DEADBEEF?
    my $skip = index($buf, "\xEF\xBE\xAD\xDE");
    while ($skip >= 0) { # found DEADBEEF
	my ($deadbeef, $totlen, $from, $zero, $len, $payload);
	hexdump( substr($buf,0,$skip,''), 'SKIPPED OOB!', $chan, $ti) if $skip;
	
	last unless length($buf) >= 8;
	# found DEADBEEF + totlen
	($deadbeef, $totlen) = unpack('V V', $buf);
	if    ( ($totlen//0) < 20)    { $totlen = 20; }
	elsif (  $totlen     > 5000 ) { $totlen = 5000; }
	last unless length($buf) >= $totlen;
	
	# SHOULD have a complete packet here?
	($deadbeef, $totlen, $from, $zero, $len, $payload)
	  = unpack('VVVVVa*', $buf);
	my $dir = ({ 1 => 's2c', 2 => 'c2s' }->{$from}) // " from $from ?!?";
	$dir .= " zero=$zero ?!?" if $zero != 0;
	
	if (length($buf) < $totlen) {
	    hexdump($buf, 'PARTIAL!', $chan, $ti);  $buf=''; last;
	} elsif ($deadbeef != 0xDEADBEEF) {
	    # Already tested - should never happen
	    hexdump($buf, 'NOT DEADBEEF? WTF!', $chan, $ti); $buf='';
	} elsif (($totlen//0) < 20) {
	    hexdump($buf, 'TOO SHORT!', $chan, $ti); $buf='';
	} elsif ($totlen > 2000) {
	    hexdump($buf, 'TOO LONG?!?', $chan, $ti); $buf='';
	} elsif ($totlen != $len + 20) {
	    hexdump($buf, "LEN $len+20 != $totlen !", $chan, $ti); $buf='';
	}  else { # GOOD packet?
	    hexdump(substr($buf, 0, 20,   ''), "HEADER $dir len=$totlen", $chan, $ti);
	    if (unpack('V', $buf) == 0xe548e74a) { # Packet type for version packet
		my ($pkttype, $unk, $ver, $major, $minor, $patch)
		  = unpack('V V f< VVV', $buf);
		$protover = 0;
		$protover = $ver if $ver;
		$protover = "$major.$minor.$patch" if defined $patch;
	    }
	    hexdump(substr($buf, 0, $len, ''),
		($protover ? "$protover payload" : 'payload'), $chan, $ti);
	    # ++++ special code to parse 0xe548e74a version packets into metadata?
	    # ++++ other packets too?
	}
	
	# There may be MORE THAN ONE deadbeef packet in $buf?
	$skip = index($buf, "\xEF\xBE\xAD\xDE");
    }
    $bufs{$chan} = $buf; # we may have removed some bytes
}

# +++++ debuggery!
# for (sort keys %bufs) {
#     next if $bufs{$_} eq '';
#     print "# BUFS: ";
#     hexdump($bufs{$_}, 'LEFT OVER!', $_);
# }

sub hexdump {
    my ($dat, $comment, $chan, $ti) = @_;
    print "$chan " if $chan && $chan =~ /^[CS]\d*$/;
    print map { sprintf '%02x', $_ } unpack('C*', $dat);
    print " \@$ti" if defined $ti;
    print $comment ? " # $comment\n" : "\n";
}