1#!/usr/local/bin/perl 2# 3##################################################################### 4# 5# Written by JoMo-Kun <jmk at foofus.net> in 2007 6# and placed in the public domain. 7# 8# The purpose of this script is to aid with cracking a LM/NTLM 9# challenge/response set, when part of the password is known. It 10# was written with John's NetLM/NetNTLM formats and "halflmchall" 11# Rainbow Tables in mind. 12# 13# Example Scenario: 14# Let's assume you've captured LM/NTLM challenge/response set for 15# the password Cricket88!. You may be able to crack the first part 16# (i.e. CRICKET) using "Half LM" Rainbow Tables. This script will 17# use that value as a seed and attempt to crack the second part 18# (i.e. "88!") via an incremental brute. It'll then use the NetNTLM 19# response hash to crack the case-sensitive version of the entire 20# password. 21# 22##################################################################### 23 24use warnings; 25use Getopt::Long; 26 27my $VERSION = "0.2"; 28my %opt; 29my %data; 30 31my $JOHN = "john"; 32 33GetOptions ( 34 'seed=s' => \$opt{'seed'}, 35 'file=s' => \$opt{'file'}, 36 'help|h' => sub { ShowUsage(); }, 37); 38 39sub showUsage { 40 print "john-netntlm.pl v$VERSION\n\n"; 41 print "JoMo-Kun <jmk\@foofus.net>\n\n"; 42 print "Usage: $0 [OPTIONS]\n"; 43 print " $0\n"; 44 print " --seed [RainbowCrack/HalfLM Response Password]\n"; 45 print " --file [File Containing LM/NTLM challenge/responses (.lc format)]\n"; 46 print " Ex: Domain\\User:::LM response:NTLM response:challenge"; 47 print "\n"; 48 print " Ex:\n"; 49 print " $0 --file capture.lc\n"; 50 print " $0 --seed \"GERGE!!\"--file capture.lc\n"; 51 print "\n"; 52 exit(1); 53} 54 55# Main 56{ 57 if ( !defined($opt{'file'}) ) { &showUsage; } 58 59 # Parse accounts to audit 60 open(HAND, $opt{'file'}) || die("Failed to open response file: $opt{'file'} -- $!"); 61 @{ $data{'pairs'} } = <HAND>; 62 close(HAND); 63 64 # Load information for any accounts previous cracked 65 print STDERR "\n\n"; 66 print STDERR "###########################################################################################\n"; 67 68 open (HAND, "$JOHN -format:netlm -show $opt{'file'} |") || die("Failed to execute john: $!"); 69 print STDERR "The following LM responses have been previously cracked:\n"; 70 while(<HAND>) { 71 next if ( /\d+ password hashes cracked, \d+ left/ ); 72 last if /^$/; 73 print "\t$_"; 74 push @{ $data{'cracked-lm'} }, $_; 75 } 76 close(HAND); 77 78 print STDERR "\nThe following NTLM responses have been previously cracked:\n"; 79 open (HAND, "$JOHN -format:netntlm -show $opt{'file'} |") || die("Failed to execute john: $!"); 80 while(<HAND>) { 81 next if ( /\d+ password hashes cracked, \d+ left/ ); 82 last if /^$/; 83 print "\t$_"; 84 push @{ $data{'cracked-ntlm'} }, $_; 85 } 86 close(HAND); 87 88 mkdir("/tmp/john.$$") || die; 89 my $tmpconf = &createConf(); 90 my $tmpsession = "/tmp/john.$$/john.session"; 91 my $tmpsessionlog = "/tmp/john.$$/john.session.log"; 92 my $tmplog = "/tmp/john.$$/john.log"; 93 #print STDERR "Created temporary configuration file: $tmpconf\n"; 94 95 # Crack case-sensitive version of password 96 my $tmpdict = "/tmp/john.$$/john.dict"; 97 #print STDERR "Created temporary dictionary file: $tmpdict\n"; 98 99 foreach $credential_set ( @{ $data{'cracked-lm'} } ) { 100 my ($account,$lmpass,$bar,$netlm,$netntlm,$chall) = split(/:/, $credential_set); 101 next if ( grep(/^$account:/i, @{ $data{'cracked-ntlm'} }) ); 102 103 print STDERR "\n\n"; 104 print STDERR "###########################################################################################\n"; 105 print STDERR "Performing NTLM case-sensitive crack for account: $account.\n"; 106 107 open(HAND, ">$tmpdict") || die("Failed to option file: $tmpdict -- $!"); 108 print HAND "$lmpass"; 109 close(HAND); 110 111 open (HAND, "$JOHN -format:netntlm -config:$tmpconf -wordlist:$tmpdict -rules -user:\"$account\" -session:$tmpsession $opt{'file'} |") || die("Failed to execute john: $!"); 112 while(<HAND>) { print; } 113 close(HAND); 114 115 unlink $tmpdict || warn("Failed to unlink $tmpdict -- $!"); 116 } 117 118 print STDERR "\n\n"; 119 print STDERR "###########################################################################################\n"; 120 print STDERR "Isolating accounts which have only had their LM response cracked.\n"; 121 122 foreach $credential_set ( @{ $data{'pairs'} } ) { 123 $credential_set =~ s/\\/\\\\/g; 124 my ($account,$foo,$bar,$netlm,$netntlm,$chall) = split(/:/, $credential_set); 125 if (lc($netlm) eq lc($netntlm)) { 126 print STDERR "LM response is not unique from NTLM response (skipping):\n\t$credential_set\n"; 127 push @{ $data{'pairs-ntlm'} }, $credential_set; 128 } 129 elsif ( @cracked = grep(/^$account:/i, @{ $data{'cracked-ntlm'} }) ) { 130 print STDERR "Account $account NTLM response previously cracked.\n"; 131 #print "@cracked"; 132 } 133 else { 134 print STDERR "Account $account LM response added to cracking list.\n"; 135 push @{ $data{'pairs-lm'} }, $credential_set; 136 } 137 } 138 139 if ( defined($opt{'seed'}) ) { 140 print STDERR "\n\n"; 141 print STDERR "###########################################################################################\n"; 142 print STDERR "Testing seed password to determine whether it is the actual password.\n"; 143 open(HAND, ">$tmpdict") || die("Failed to option file: $tmpdict -- $!"); 144 print HAND $opt{'seed'}; 145 close(HAND); 146 147 open (HAND, "$JOHN -format:netntlm -config:$tmpconf -wordlist:$tmpdict -rules -session:$tmpsession $opt{'file'} |") || die("Failed to execute john: $!"); 148 while(<HAND>) { 149 print; 150 next if (/^guesses: .*time: / || (/^Loaded .* password hash /) || (/^No password hashes loaded/)); 151 my ($account) = $_ =~ / \((.*)\)$/; 152 153 # Remove accounts which just cracked from list 154 my $i = 0; 155 foreach $credential_set ( @{ $data{'pairs-lm'} } ) { 156 $account =~ s/\\/_/g; 157 $credential_set =~ s/\\\\/_/g; 158 if ( $credential_set =~ /^$account:/ ) { 159 splice(@{ $data{'pairs-lm'} }, $i, 1); 160 } 161 $i++; 162 } 163 } 164 close(HAND); 165 unlink $tmpdict || warn("Failed to unlink $tmpdict -- $!"); 166 167 my $tmppasswd = "/tmp/john.$$/john.passwd"; 168 open(HAND, ">$tmppasswd") || die("Failed to open $tmppasswd: $!"); 169 print HAND @{ $data{'pairs-lm'} }; 170 close(HAND); 171 172 print STDERR "\n\n"; 173 print STDERR "###########################################################################################\n"; 174 print STDERR "The hashes contained within $tmppasswd have not been cracked.\n"; 175 print STDERR "Executing the following (this could take a while...):\n\n"; 176 print STDERR "john -format:netlm -config:$tmpconf -external:HalfLM -incremental:LM -session:$tmpsession $tmppasswd\n"; 177 print STDERR "\n"; 178 print STDERR " *If the passwords successfully crack, use this script again to crack the case-sensitive password\n"; 179 print STDERR " without feeding a seed password\n"; 180 print STDERR"\n\n"; 181 182 system("$JOHN -format:netlm -config:$tmpconf -external:HalfLM -incremental:LM -session:$tmpsession $tmppasswd"); 183 #exec("$JOHN -format:netlm -config:$tmpconf -external:HalfLM -incremental:LM -session:$tmpsession $tmppasswd"); 184 185 unlink $tmppasswd || warn("Failed to unlink $tmppasswd -- $!"); 186 } 187 else { 188 print STDERR "\nNo seed supplied for testing.\n"; 189 } 190 191 #print STDERR "Removing temporary files and directory\n"; 192 unlink $tmpconf, $tmplog, $tmpsession, $tmpsessionlog || warn("Failed to unlink temporary config files -- $!"); 193 rmdir("/tmp/john.$$") || warn("Failed to delete temporary john directory -- $!"); 194} 195 196exit(0); 197 198sub createConf { 199 my $tmpconf = "/tmp/john.$$/john.conf"; 200 open(CONF, ">$tmpconf") || die("Failed to open $tmpconf: $!"); 201 202 # Define character keyspace 203 print CONF "[Incremental:LM]\n"; 204 print CONF "File = \$JOHN/lanman.chr\n"; 205 print CONF "MinLen = 1\n"; 206 207 # John compiled for MaxLen <= 8 208 if (14 - length($opt{'seed'}) > 8) { 209 print CONF "MaxLen = 8\n"; 210 } else { 211 print CONF "MaxLen = ", 14 - length($opt{'seed'}), "\n"; 212 } 213 print CONF "CharCount = 69\n\n"; 214 215 # Add external filter to handle uncracked characters 216 if ($opt{'seed'} ne "") { 217 my $i; $j; 218 my @seed = split(//, $opt{'seed'}); 219 220 print CONF "[List.External:HalfLM]\n"; 221 print CONF "void init()\n"; 222 print CONF "{\n"; 223 print CONF " word[14] = 0;\n"; 224 print CONF "}\n\n"; 225 226 print CONF "void filter()\n"; 227 print CONF "{\n"; 228 229 my $len = length($opt{'seed'}); 230 for ($i = 13, $j = 13 - $len; $i>=0; $i--) { 231 if ($i >= $len) { 232 print CONF " word[$i] = word[$j];\n"; 233 $j--; 234 } else { 235 print CONF " word[$i] = \'$seed[$i]\';\n"; 236 } 237 } 238 239 print CONF "}\n\n"; 240 } 241 242 # Add custom wordlist to utilize NTLM hash for character case cracking 243 print CONF "[List.Rules:Wordlist]\n"; 244 print CONF ":\n"; 245 print CONF "-c T0Q\n"; 246 print CONF "-c T1QT[z0]\n"; 247 print CONF "-c T2QT[z0]T[z1]\n"; 248 print CONF "-c T3QT[z0]T[z1]T[z2]\n"; 249 print CONF "-c T4QT[z0]T[z1]T[z2]T[z3]\n"; 250 print CONF "-c T5QT[z0]T[z1]T[z2]T[z3]T[z4]\n"; 251 print CONF "-c T6QT[z0]T[z1]T[z2]T[z3]T[z4]T[z5]\n"; 252 print CONF "-c T7QT[z0]T[z1]T[z2]T[z3]T[z4]T[z5]T[z6]\n"; 253 print CONF "-c T8QT[z0]T[z1]T[z2]T[z3]T[z4]T[z5]T[z6]T[z7]\n"; 254 print CONF "-c T9QT[z0]T[z1]T[z2]T[z3]T[z4]T[z5]T[z6]T[z7]T[z8]\n"; 255 print CONF "-c TAQT[z0]T[z1]T[z2]T[z3]T[z4]T[z5]T[z6]T[z7]T[z8]T[z9]\n"; 256 print CONF "-c TBQT[z0]T[z1]T[z2]T[z3]T[z4]T[z5]T[z6]T[z7]T[z8]T[z9]T[zA]\n"; 257 print CONF "-c TCQT[z0]T[z1]T[z2]T[z3]T[z4]T[z5]T[z6]T[z7]T[z8]T[z9]T[zA]T[zB]\n"; 258 print CONF "-c TDQT[z0]T[z1]T[z2]T[z3]T[z4]T[z5]T[z6]T[z7]T[z8]T[z9]T[zA]T[zB]T[zC]\n"; 259 260 close(CONF); 261 262 return $tmpconf; 263} 264