#! /usr/bin/perl -w

# Please excuse the convoluted nature of this script.
# It is based on code from an unreleased project, which
# supports adding more "packet decoders" and handles
# the encapsulation calculations.

use strict;


use Net::Pcap;

$| = 1;


my $filter = 'ip proto 11';
while (my $filename = shift(@ARGV)) {
    print "Analyzing $filename.\n";
    my ($err, $filter_t, $data, %hdr);
    my $pcap_t = Net::Pcap::open_offline($filename, \$err);
    die "Error analyzing $filename: $err" if !defined $pcap_t;

    # Make sure to only grab the IP packets from the dump, and not
    # anything else, like IPX or anything
    die "Unable to compile filter: ". Net::Pcap::geterr($pcap_t)
	unless Net::Pcap::compile($pcap_t, \$filter_t, $filter, 1, 0) == 0;
    die "Unable to compile filter: ". Net::Pcap::geterr($pcap_t)
	unless Net::Pcap::setfilter($pcap_t, $filter_t) == 0;

    my $datalink = Net::Pcap::datalink($pcap_t);
    my $packetReader = \&Datalinks::Ethernet::ethernetReader;
    my $rv = Net::Pcap::loop($pcap_t, -1, $packetReader, undef);
    if ($rv) {
	warn "Error analyzing $filename: ". Net::Pcap::geterr($pcap_t);
    }

    Net::Pcap::close($pcap_t);
}

exit(0);

package Protocols::Mystery;
use Socket qw(inet_ntoa);

sub print {
    # parameters = $pkt, $offset
    my @chars = unpack('C*', substr($_[0], $_[1]));
    for (my $i = 0; $i < int(scalar(@chars)/16) + 1; $i++) {
	next if $i * 16 >= @chars;		# skip if we're at end
	print "\t";
	for (my $j = 0; $j < 16; $j++) {
	    if ($i * 16 + $j  >= @chars) {
		print "  ";
	    } else {
		printf "%02x", $chars[$i * 16 + $j];
	    }
	}
	print "\t";
	for (my $j = 0; $j < 16; $j++) {
	    next if $i * 16 + $j  >= @chars;	# skip if we're at end
	    my $ascii = chr($chars[$i*16+$j]);
	    # check for unprintable characters
	    $ascii = '.' if $ascii !~ m/[\040-\176]/;
	    print $ascii;
	}
	print "\n";
    }
}

sub decode {
    # parameters = $pkt, $offset

    # turn packet data into an array of ASCII values
    my @encoded = unpack('C*', substr($_[0], $_[1]));
    my (@decoded);

    $decoded[0] = $encoded[0] - 23;
    for (my $i = 1; $i < @encoded; $i++) {
	$decoded[$i] = $encoded[$i] - $encoded[$i-1] - 23;
    }
    foreach (@decoded) {
	# bring anything that went negative back into positive territory
	$_ = ($_ + 256 ) % 256;
    }

    my $decoded = $_[0];
    substr($decoded, $_[1]) = pack('C*', @decoded);
    return $decoded;
}

sub packetReader {
    my ($offset, $hdr, $pkt) = @_;

    # The first two bytes represent the source of the packet
    my $source = unpack('S', substr($pkt, $offset, 2));
    if ($source == 3) {
	$source = 'server/the-binary';
    } elsif ($source == 2) {
	$source = 'client/attacker';
    }
    print "\tsource = $source\n";

    # The rest of the packet is encoded, so let's decode it.
    my $decoded = &decode($pkt, $offset+2);
    my $decoded_start = $offset+2;

    # Keep track of what's left to print out
    my $print_at = $decoded_start;

    if ($source eq 'client/attacker') {
	# position 0 is unused

	# The command that the attacker wants to run is at
	# position 1 in the data
	my $cmd = unpack('C', substr($decoded, $print_at+1));
	# but it's got an extra encoding.
	$cmd = ($cmd - 1 + 256) % 256;
	# and as a last trick, the programmer was counting from one-based.
	$cmd++;
	print "\tcommand = $cmd : ";
	$print_at++;		# inc position of what's left to print


	if ($cmd == 1) {
	    print "status request\n";
	} elsif ($cmd == 2) {
	    print "set Reply IP\n";

	    # @ position 2 in the decoded data
	    my $dest_mode = unpack('C', substr($decoded, $decoded_start+2));
	    print "\tdest IP reply mode: $dest_mode :";
	    if ($dest_mode == 0) {
		print "table randomized...\n";
		my $addr = inet_ntoa(
			substr($decoded, $decoded_start+3, 4)
		    );
		print "\t\ttable[0] set to $addr\n";
	    } elsif ($dest_mode == 1) {
		print "table randomized...\n";
		my $addr = inet_ntoa(
			substr($decoded, $decoded_start+3, 4)
		    );
		print "\t\trandom position set to $addr\n";
	    } elsif ($dest_mode == 2) {
		print "table set as follows:\n";

		# table starts at position 3 in the decoded data
		for (my $i = 0; $i < 10; $i++) {
		    my $addr = inet_ntoa(
			    substr($decoded, $decoded_start+3+4*$i, 4)
			);
		    print "\t\t$addr\n";
		}
	    }
	    # There's no other valid data, so skip the rest
	    $print_at = length($decoded);
	} elsif ($cmd == 3) {
	    print "run shell commands, return output\n";
	    my $shell = unpack('Z*',
				substr($decoded, $decoded_start + 2)
			);
	    print "\t\tshell command = $shell ", length($shell), "\n";

	    # There's no other valid data, so skip the rest
	    $print_at = length($decoded);
	} else {
	    print "???\n";
	}
    } else {
	my $type = unpack('C', substr($decoded, $decoded_start+1));
	if ($type == 1) {
	    print "\ttype = 1 : response to command 1\n";

	    # grab whether an attack is running
	    my $running = unpack('C', substr($decoded, $decoded_start+3) );
	    if (!$running) {
		print "\tserver not currently running attack.\n";
	    } else {
		# and grab what the command number is, if it is running.
		my $cur_cmd = unpack('C', substr($decoded, $decoded_start+4) );
		print "\tserver currently running attack/command $cur_cmd.\n";
	    }
	    # There's no other valid data, so skip the rest
	    $print_at = length($decoded);
	} elsif ($type == 3) {
	    print "\ttype = 3 : response to command 3, initial packet\n";
	    my $output = unpack('Z*',
				substr($decoded, $decoded_start + 2)
			);
	    $output = '<**EOF**>' if length($output) == 0;
	    print "\tresponse:\n";
	    print $output, "\n";
	    # There's no other valid data, so skip the rest
	    $print_at = length($decoded);
	} elsif ($type == 4) {
	    print "\ttype = 4 : response to command 3, continuation packet\n";
	    my $output = unpack('Z*',
				substr($decoded, $decoded_start + 2)
			);
	    print "\tresponse:\n";
	    $output = '<**EOF**>' if length($output) == 0;
	    print $output, "\n";
	    # There's no other valid data, so skip the rest
	    $print_at = length($decoded);
	}
    }
    # print the rest of the packet
    &print($decoded, $print_at);
}

package Protocols::IPv4;
use vars qw(%protocols);
use Socket qw(inet_ntoa);

BEGIN {
    $protocols{11} = \&Protocols::Mystery::packetReader;
}

sub packetReader {
    # use the alias form of the arguments, which is faster than
    # naming the parameters:        my ($offset, $hdr, $pkt) = @_;

    print "IP packet: ";

    $_[1]->{'srcip'} = inet_ntoa(substr($_[2], $_[0]+12, 4));
    $_[1]->{'dstip'} = inet_ntoa(substr($_[2], $_[0]+16, 4));

    print $_[1]->{srcip}, " > ", $_[1]->{dstip}, "\n";

    my $version = (ord(substr($_[2], $_[0], 1)) >> 4) & 0xf;
    if ($version != 4) {
        warn "IPv4: Unknown IP version: #".$version;
        return;
    }

    # The sub-protocols are calculated from byte 9, as
    my $type = ord(substr($_[2], $_[0]+9, 1));
    $_[1]->{'type'} = $type;
    my $handler = $protocols{$type};
    if (!$handler) {
        warn "IPv4: Unknown protocol: type = $type";
        # Record to the database anyway, but mark ports as zeros.
        return;
    }

    $_[1]->{'total_length'} = unpack('n', substr($_[2], $_[0]+2, 2));
    $_[1]->{'iphdr_length'} = (ord(substr($_[2], $_[0], 1)) & 0xf)  * 4;
    $_[1]->{'data_length'} = $_[1]->{'total_length'} - $_[1]->{'iphdr_length'};

    # The offset is calculated from the first byte of the IP header...
    #       my $offset = (ord(substr($_[2], $_[0], 1)) & 0xf)  * 4;
    &$handler($_[0] + (ord(substr($_[2], $_[0], 1)) & 0xf)  * 4,
                $_[1],
                $_[2]);
}


package Datalinks::Ethernet;
use vars qw(%protocols);

BEGIN {
    # First, setup protocols we know about
    $protocols{0x800} = \&Protocols::IPv4::packetReader;
}

sub ethernetReader {
    # Use the alias form of the arguments, which is much faster
    # than assigning to named parameters.
    #my ($user, $hdr, $pkt) = @_;

    # The protocol type is stored in bytes 12 and 13, so select
    # the appropriate handle based on that.
    my $protocol = unpack('n', substr($_[2], 12, 2));
    my $handler = $protocols{ $protocol };
    if (!$handler) {
        warn "Unknown ethernet protocol: ".sprintf("%04x", $protocol);
        return;
    }
    # Call the protocol, and give them an offset of 14, so that
    # they can skip over the ethernet header.  Benchmarking of
    # various techniques to pass the packet (such as doing a substr())
    # show that just using offsets is the fastest method.
    &$handler( 14, $_[1], $_[2] );
}