1#!/usr/local/bin/perl 2 3use warnings; 4use strict; 5 6############################################################################# 7# For the version information list and copyright statement, 8# see ../doc/pass_gen.Manifest 9# Version v1.22. Update this version signature here, AND the document file. 10############################################################################# 11 12# Most "use xxx" now moved to "require xxx" *locally* in respective subs in 13# order to only require them when actually used. 14# 15# use Digest::SHA qw(sha1); 16# -> 17# require Digest::SHA; 18# import Digest::SHA qw(sha1); 19 20use Digest::MD4 qw(md4 md4_hex md4_base64); 21use Digest::MD5 qw(md5 md5_hex md5_base64); 22use Digest::SHA qw(sha1 sha1_hex sha1_base64 23 sha224 sha224_hex sha224_base64 24 sha256 sha256_hex sha256_base64 25 sha384 sha384_hex sha384_base64 26 sha512 sha512_hex sha512_base64 ); 27use Encode; 28use POSIX; 29use Getopt::Long; 30use MIME::Base64; 31 32############################################################################# 33# 34# Here is how to add a new hash subroutine to this script file: 35# 36# 1. add a new element to the @funcs array. The case of this string does 37# not matter. The only time it is shown is on the usage screen, so make 38# it something recognizable to the user wanting to know what this script 39# can do. 40# 2. add a new sub to the bottom of this program. The sub MUST be same 41# spelling as what is added here, but MUST be lower case. Thus, we see 42# DES here in funcs array, but the sub is: sub des($pass) This 43# subroutine will be passed a candidate password, and should should output 44# the proper hash. All salts are randomly selected, either from the perl 45# function doing the script, or by using the randstr() subroutine. 46# 3. Test to make sure it works properly. Make sure john can find ALL values 47# your subroutine returns. 48# 4. Update the version of this file (at the top of it) 49# 5. Publish it to the john wiki for others to also use. 50# 51# these are decrypt images, which we may not be able to do in perl. We will 52# take these case by case. 53# pdf pkzip rar5, ssh 54# 55# lotus5 is done in some custom C code. If someone wants to take a crack at 56# it here, be my guest :) 57############################################################################# 58my @funcs = (qw(DESCrypt BigCrypt BSDIcrypt md5crypt md5crypt_a BCRYPT BCRYPTx 59 BFegg Raw-MD5 Raw-MD5u Raw-SHA1 Raw-SHA1u msCash LM NT pwdump 60 Raw-MD4 PHPass PO hmac-MD5 IPB2 PHPS MD4p MD4s SHA1p SHA1s 61 mysql-sha1 pixMD5 MSSql05 MSSql12 netntlm cisco4 cisco8 cisco9 62 nsldap nsldaps ns XSHA krb5pa-md5 krb5-18 mysql mssql_no_upcase_change 63 mssql oracle oracle_no_upcase_change oracle11 hdaa netntlm_ess 64 openssha l0phtcrack netlmv2 netntlmv2 mschapv2 mscash2 mediawiki 65 crc_32 Dynamic dummy raw-sha224 raw-sha256 raw-sha384 raw-sha512 66 dragonfly3-32 dragonfly4-32 dragonfly3-64 dragonfly4-64 67 salted-sha1 raw_gost raw_gost_cp hmac-sha1 hmac-sha224 mozilla 68 hmac-sha256 hmac-sha384 hmac-sha512 sha1crypt sha256crypt sha512crypt 69 XSHA512 dynamic_27 dynamic_28 pwsafe django drupal7 epi zip 70 episerver_sha1 episerver_sha256 hmailserver ike keepass 71 keychain nukedclan radmin raw-SHA sip sip_qop SybaseASE 72 wbb3 wpapsk sunmd5 wowsrp django-scrypt aix-ssha1 aix-ssha256 73 aix-ssha512 pbkdf2-hmac-sha512 pbkdf2-hmac-sha256 scrypt 74 rakp osc formspring skey-md5 pbkdf2-hmac-sha1 odf odf-1 office_2007 75 skey-md4 skey-sha1 skey-rmd160 cloudkeychain agilekeychain 76 rar ecryptfs office_2010 office_2013 tc_ripemd160 tc_sha512 77 tc_whirlpool SAP-H rsvp pbkdf2-hmac-sha1-p5k2 78 pbkdf2-hmac-sha1-pkcs5s2 md5crypt-smd5 ripemd-128 ripemd-160 79 raw-tiger raw-whirlpool hsrp known-hosts chap bb-es10 citrix-ns10 80 clipperz-srp dahua fortigate lp lastpass rawmd2 mongodb mysqlna 81 o5logon postgres pst raw-blake2 raw-keccak raw-keccak256 siemens-s7 82 ssha512 tcp-md5 strip bitcoin blockchain 83 rawsha3-512 rawsha3-224 rawsha3-256 rawsha3-384 AzureAD vdi_256 vdi_128 84 qnx_md5 qnx_sha512 qnx_sha256 sxc vnc vtp keystore pbkdf2-hmac-md4 85 pbkdf2-hmac-md5 racf zipmonster asamd5 mongodb_scram has160 fgt iwork 86 palshop snefru_128 snefru_256 keyring efs mdc2 eigrp as400ssha1 leet 87 sapg sapb bitlocker money_md5 money_sha1 88 )); 89 90# todo: sapfg ike keepass cloudkeychain pfx pdf pkzip rar5 ssh raw_gost_cp cq dmg dominosec encfs fde gpg haval-128 Haval-256 krb4 krb5 krb5pa-sha1 kwallet luks pfx afs ssh oldoffice openbsd-softraid openssl-enc openvms panama putty ssh-ng sybase-prop tripcode whirlpool0 whirlpool1 91# raw-skein-256 raw-skein-512 _7z axcrypt bks dmd5 dominosec8 krb5_tgs lotus5 lotus85 net_md5 net_sha1 netlmv2 netsplitlm openssl_enc oracle12c pem po pomelo stribog 92 93my $i; my $h; my $u; my $salt; my $out_username; my $out_extras; my $out_uc_pass; my $l0pht_fmt; 94my $qnx_sha512_warning=0; my $is_mdc2_valid = -1; 95my @chrAsciiText=('a'..'z','A'..'Z'); 96my @chrAsciiTextLo=('a'..'z'); 97my @chrAsciiTextHi=('A'..'Z'); 98my @chrAsciiTextNum=('a'..'z','A'..'Z','0'..'9'); 99my @chrAsciiTextNumLo=('a'..'z','0'..'9'); 100my @chrAsciiNum=('0'..'9'); 101my @chrAsciiTextNumUnder=('a'..'z','A'..'Z','0'..'9','_'); 102my @chrHexHiLo=('0'..'9','a'..'f','A'..'F'); 103my @chrHexLo=('0'..'9','a'..'f'); 104my @chrHexHi=('0'..'9','A'..'F'); 105my @chrRawData=(0..255); foreach(@chrRawData) {$chrRawData[$_] = chr($chrRawData[$_]);} 106my @i64 = ('.','/','0'..'9','A'..'Z','a'..'z'); 107my @ns_i64 = ('A'..'Z', 'a'..'z','0'..'9','+','/',); 108my @userNames = ( 109 "admin", "root", "bin", "Joe", "fi15_characters", "Babeface", "Herman", "lexi Conrad", "jack", "John", "sz110", 110 "fR14characters", "Thirteenchars", "Twelve_chars", "elev__chars", "teN__chars", "six16_characters", 111# "B\xE3rtin", 112 "ninechars", "eightchr", "sevench", "barney", "C0ffee", "deadcafe", "user", "01234", "nineteen_characters", 113 "eight18_characters", "seven17characters", "u1", "harvey", "john", "ripper", "a", "Hank", "1", "u2", "u3", 114 "2", "3", "usr", "usrx", "usry", "skippy", "Bing", "Johnson", "addams", "anicocls", "twentyXXX_characters", 115 "twentyoneX_characters", "twentytwoXX_characters"); 116 117######################################################### 118# These global vars are used by the Dynamic parsing engine 119# to deal with unknown formats. 120######################################################### 121my $gen_u; my $gen_s; my $gen_soutput, my $gen_stype; my $gen_s2; my $gen_pw; my @gen_c; my @gen_toks; my $gen_num; 122my $gen_lastTokIsFunc; my $gen_u_do; my $dynamic_usernameType; my $dynamic_passType; my $salt2len; my $saltlen; my $gen_PWCase=""; 123# pcode, and stack needed for pcode. 124my @gen_pCode; my @gen_Stack; my @gen_Flags; 125my $debug_pcode=0; my $gen_needs; my $gen_needs2; my $gen_needu; my $gen_singlesalt; my $hash_format; my $net_ssl_init_called = 0; 126######################################################### 127# These global vars settable by command line args. 128######################################################### 129my $arg_utf8 = 0; my $arg_codepage = ""; my $arg_minlen = 0; my $arg_maxlen = 128; my $arg_dictfile = "stdin"; 130my $arg_count = 1500, my $argsalt, my $argiv, my $argcontent; my $arg_nocomment = 0; my $arg_hidden_cp; my $arg_loops=-1; 131my $arg_tstall = 0; my $arg_genall = 0; my $arg_nrgenall = 0; my $argmode; my $arguser; my $arg_outformat="normal"; 132my $arg_help = 0; 133# these are 'converted' from whatever the user typed in for $arg_outformat 134my $bVectors = 0; my $bUserIDs=1; my $bFullNormal=1; 135 136GetOptions( 137 'codepage=s' => \$arg_codepage, 138 'hiddencp=s' => \$arg_hidden_cp, 139 'utf8!' => \$arg_utf8, 140 'nocomment!' => \$arg_nocomment, 141 'minlength=n' => \$arg_minlen, 142 'maxlength=n' => \$arg_maxlen, 143 'salt=s' => \$argsalt, 144 'iv=s' => \$argiv, 145 'content=s' => \$argcontent, 146 'mode=s' => \$argmode, 147 'count=n' => \$arg_count, 148 'loops=n' => \$arg_loops, 149 'dictfile=s' => \$arg_dictfile, 150 'tstall!' => \$arg_tstall, 151 'genall!' => \$arg_genall, 152 'nrgenall!' => \$arg_nrgenall, 153 'outformat=s' => \$arg_outformat, 154 'user=s' => \$arguser, 155 'help+' => \$arg_help 156 ) || usage(); 157 158if ($arg_help != 0) {die usage();} 159 160if ($arg_outformat eq substr("vectors", 0, length($arg_outformat))) { 161 $bVectors = 1; 162 $bUserIDs=0; 163 $bFullNormal=0; 164 $arg_nocomment = 1; 165} elsif ($arg_outformat eq substr("raw", 0, length($arg_outformat))) { 166 $bUserIDs=0; 167 $bFullNormal=0; 168 $arg_nocomment = 1; 169} elsif ($arg_outformat eq substr("user", 0, length($arg_outformat))) { 170 $bFullNormal=0; 171 $arg_nocomment = 1; 172} 173 174sub pretty_print_hash_names { 175 my ($wchar, $hchar, $wpixels, $hpixels); 176 $wchar = 80; # default IF Term::ReadKey lib not found. 177 if (eval "require Term::ReadKey") { 178 # note, if Term::ReadKey is not installed, the script 179 # does not abort, but uses 80 columns for width of terminal. 180 import Term::ReadKey qw(GetTerminalSize); 181 ($wchar, $hchar, $wpixels, $hpixels) = GetTerminalSize(); 182 } 183 #if ($wchar > 120) {$wchar = 121;} 184 --$wchar; 185 my $s; my $s2; my $i; 186 my @sorted_funcs = sort {lc($a) cmp lc($b)} @funcs; 187 $s2 = " "; 188 for ($i = 0; $i < scalar @sorted_funcs; ++$i) { 189 if (length($s2)+length($sorted_funcs[$i]) > $wchar) { 190 $s .= $s2."\n"; 191 $s2 = " "; 192 } 193 $s2 .= $sorted_funcs[$i]." "; 194 } 195 return $s.$s2."\n"; 196} 197 198sub usage { 199 my $hash_str = pretty_print_hash_names(); 200 my $hidden_opts = " -help shows this screen (-help -help shows hidden options)"; 201 my $name = $0; 202 my $pos = rindex($name, "/"); 203 if ($pos != -1) { 204 $name = substr($name, $pos+1); 205 } elsif (($pos = rindex($name, "\\")) != -1) { 206 $name = substr($name, $pos+1); 207 } 208 if ($arg_help > 1) { $hidden_opts = 209" -dictfile <s> Put name of dict file into the first line comment 210 -nocomment eliminate the first line comment 211 -tstall runs a 'simple' test for all known types. 212 -genall generates all hashes with random salts. 213 -nrgenall generates all hashes (non-random, repeatable)"; 214 } 215 die <<"UsageHelp"; 216usage: $name [-codepage=CP] [-option[s]] HashType [...] [<wordfile] 217 Options can be abbreviated! 218 219 Default is to read and write files as binary, no conversions 220 -utf8 shortcut to -codepage=UTF-8. 221 -codepage=CP Read and write files in CP encoding. 222 223 Options are: 224 -minlen <n> Discard lines shorter than <n> characters [0] 225 -maxlen <n> Discard lines longer than <n> characters [125] 226 -count <n> Stop when we have produced <n> hashes [1500] 227 -loops <n> Some formats have a loop count. This allows overriding. 228 -salt <s> Force a single salt 229 -iv <s> Force a single iv 230 -content <s> Force a single content 231 -mode <s> Force mode (zip, mode 1..3, rar4 modes 1..10, etc) 232 -user <s> Provide a fixed user name, vs random user name. 233 -outformat<s> output format. 'normal' 'vectors' 'raw' 'user' [normal] 234$hidden_opts 235 236HashType is one or more (space separated) from the following list: 237$hash_str 238UsageHelp 239} 240 241if ($arg_tstall != 0) { 242 tst_all(); 243 exit(0); 244} 245 246if ($arg_nrgenall != 0) { $arg_genall = 1; } 247 248if (@ARGV == 0 && $arg_genall == 0) { 249 die usage(); 250} 251 252if ($arg_utf8) { 253 #@ARGV = map { decode_utf8($_, 1) } @ARGV; 254 $argsalt = decode_utf8($argsalt, 1); 255 $arg_codepage="UTF-8"; 256} 257 258############################################################################################### 259# modifications to character set used. This is to get pass_gen.pl working correctly 260# with john's -utf8 switch. Also added is code to do max length of passwords. 261############################################################################################### 262if (defined $arg_codepage and length($arg_codepage)) { 263 binmode(STDIN,"encoding(:$arg_codepage)"); 264 binmode(STDOUT,"encoding(:$arg_codepage)"); 265 if (!$arg_nocomment) { printf("#!comment: Built with pass_gen.pl using -codepage-$arg_codepage mode, $arg_minlen to $arg_maxlen characters. dict file=$arg_dictfile\n"); } 266} else { 267 binmode(STDIN,":raw"); 268 binmode(STDOUT,":raw"); 269 if (!$arg_nocomment) { printf("#!comment: Built with pass_gen.pl using RAW mode, $arg_minlen to $arg_maxlen characters dict file=$arg_dictfile\n"); } 270} 271 272if ($bVectors == 1 && (@ARGV != 1 || $arg_genall != 0)) { 273 print STDERR "\n\nNOTE, if using --outformat=vector you must ONLY be processing for a single format\n\n"; 274 die usage(); 275} 276 277#if not a redirected file, prompt the user 278if (-t STDIN) { 279 print STDERR "\nEnter words to hash, one per line.\n"; 280 if (@ARGV != 1) { print STDERR "When all entered ^D starts the processing.\n\n"; } 281 $arg_nocomment = 1; # we do not output 'comment' line if writing to stdout. 282} 283 284if ($arg_genall != 0) { 285 while (<STDIN>) { 286 next if (/^#!comment/); 287 chomp; 288 s/\r$//; # strip CR for non-Windows 289 #my $line_len = length($_); 290 my $line_len = utf16_len($_); 291 next if $line_len > $arg_maxlen || $line_len < $arg_minlen; 292 gen_all($_); 293 } 294 exit(0); 295} 296############################################################################################### 297############################################################################################### 298#### Data Processing Loop. We read all candidates here, and send them to the proper hashing 299#### function(s) to build into john valid input lines. 300############################################################################################### 301############################################################################################### 302 303if (@ARGV == 1) { 304 # if only one format (how this script SHOULD be used), then we do not slurp the file, but we 305 # read STDIN line by line. Cuts down on memory usage GREATLY within the running of the script. 306 $u = 0; 307 my $orig_arg = $ARGV[0]; 308 my $arg = lc $ARGV[0]; 309 if (substr($arg,0,8) eq "dynamic_") { substr($arg,0,8)="dynamic="; } 310 if ($arg eq "dynamic") { dynamic_compile("") } 311 if (substr($arg,0,8) eq "dynamic=") { 312 @funcs = (); 313 my $dyn=""; 314 if (length($orig_arg)>8) { $dyn=substr($orig_arg,8); } 315 push(@funcs, $arg = dynamic_compile($dyn)); 316 } 317 318 my $have_something = 0; 319 foreach (@funcs) { 320 if ($arg eq lc $_) { 321 $have_something = 1; 322 if (!$arg_nocomment) { 323 print "\n ** Here are the "; 324 print $bVectors ? "test vectors" : "hashes"; 325 print " for format $orig_arg **\n"; 326 } 327 $arg =~ s/-/_/g; 328 while (<STDIN>) { 329 next if (/^#!comment/); 330 chomp; 331 s/\r$//; # strip CR for non-Windows 332 #my $line_len = length($_); 333 my $line_len = utf16_len($_); 334 next if $line_len > $arg_maxlen || $line_len < $arg_minlen; 335 reset_out_vars(); 336 no strict 'refs'; 337 my $hash = &$arg($_, word_encode($_)); 338 use strict; 339 if (defined($hash) && length($hash) > 4) { 340 output_hash($hash, $_, word_encode($_)); 341 } 342 ++$u; 343 if ($u >= $arg_count) { 344 print STDERR "Got $arg_count, not processing more. Use -count to bump limit.\n"; 345 last; 346 } 347 } 348 last; 349 } 350 } 351 if (!$have_something) { 352 print STDERR "hash type [$orig_arg] is not supported\n"; 353 exit(1); 354 } 355} else { 356 #slurp the wordlist words from stdin. We have to, to be able to run the same words multiple 357 # times, and not interleave the format 'types' in the file. Doing this allows us to group them. 358 my @lines = <STDIN>; 359 360 foreach (@ARGV) { 361 $u = 0; 362 my $orig_arg = $_; 363 my $arg = lc $_; 364 if ($arg eq "dynamic") { dynamic_compile(""); } 365 if (substr($arg,0,8) eq "dynamic_") { substr($arg,0,8)="dynamic="; } 366 if (substr($arg,0,8) eq "dynamic=") { 367 my $dyn=""; 368 if (length($orig_arg)>8) { $dyn=substr($orig_arg,8); } 369 push(@funcs, $arg = dynamic_compile($dyn)); 370 } 371 my $have_something = 0; 372 foreach (@funcs) { 373 if ($arg eq lc $_) { 374 $have_something = 1; 375 if (!$arg_nocomment) { print "\n ** Here are the hashes for format $orig_arg **\n"; } 376 $arg =~ s/-/_/g; 377 foreach (@lines) { 378 next if (/^#!comment/); 379 chomp; 380 s/\r$//; # strip CR for non-Windows 381 #my $line_len = length($_); 382 my $line_len = utf16_len($_); 383 next if $line_len > $arg_maxlen || $line_len < $arg_minlen; 384 reset_out_vars(); 385 no strict 'refs'; 386 my $hash = &$arg($_, word_encode($_)); 387 use strict; 388 if (defined($hash) && length($hash) > 4) { 389 output_hash($hash, $_, word_encode($_)); 390 } 391 ++$u; 392 last if $u >= $arg_count; 393 } 394 last; 395 } 396 } 397 if (!$have_something) { 398 print STDERR "hash type [$orig_arg] is not supported\n"; 399 exit(1); 400 } 401 } 402} 403 404############################################################################# 405# these variables modify outout in output_hash, for 'some' formats. We might 406# upcase the password. The hash may return multple fields in its 'hash' that 407# is returned, so that means we add fewer 'extra' fields prior to the password. 408# also, we may have to insert the user name as field 1. This function sets 409# 'proper' defaults, so if a hash function does not set anything, it will 410# output in proper format. 411############################################################################# 412sub reset_out_vars { 413 $out_username = ""; 414 $out_extras = 2; 415 $out_uc_pass = 0; 416 $l0pht_fmt = 0; 417} 418############################################################################# 419# sub output_hash($hash, $pass, $encoded_pass) 420# a 'common' output function. This right now is just a stub, but laster we 421# can have some command line option(s) that allows control over this function 422# to give us ability to change the output format. 423############################################################################# 424sub output_hash { 425 if ($l0pht_fmt == 1) { 426 print "$_[0]:$_[1]:\n"; 427 return; 428 } 429 elsif ($bVectors) { 430 printf("\t{\"%s\", \"%s\"},\n", $_[0], $_[1]); 431 return; 432 } 433 my $p = $_[1]; 434 if ($out_uc_pass) {$p = uc $p; } 435 if ($out_extras == 2) { $p = "$u:0:".$p;} 436 elsif ($out_extras == 1) { $p = "$u:".$p;} 437 if (length($out_username)) { print "$out_username:"; } elsif ($bUserIDs == 1) { print "u$u:"; } 438 print "$_[0]"; 439 if ($bFullNormal == 1) {print ":$p:";} 440 print "\n"; 441} 442############################################################################# 443# these 3 functions (the pp_pbkdf2/pp_pbkdf2_hex are the 'exported' functions, 444# the other is just a hmac 'helper') replace all requirements on the 445# Crypt::PBKDF2 module. this code is VERY simple, and at least as fast as the 446# Crypt::PBKDF2, and is MUCH more simple to use (IMHO). The entire interface 447# is in the single function call pp_pbkdf2($pass,$salt,$itr,$algo,$bytes_out) 448# pp_pbkdf2_hex() is a simple hex function wrapper function. 449############################################################################# 450sub hmac_pad { 451 my ($pass, $ch, $algo, $pad_len) = @_; 452 my $pad; # ipad or opad, depending upon ch passed in. 453 no strict 'refs'; 454 $pad = &$algo("a"); 455 $pad = $ch x $pad_len; 456 if (length($pass) > $pad_len) { $pass = &$algo($pass); } 457 use strict; 458 $pad ^= $pass; 459 return $pad; 460} 461sub pp_pbkdf2 { 462 my ($pass, $orig_salt, $iter, $algo, $bytes, $pad_len, $pbkdf1, $efscrap) = @_; 463 my $ipad = hmac_pad($pass, '6', $algo, $pad_len); # 6 is \x36 for an ipad 464 my $opad = hmac_pad($pass, '\\', $algo, $pad_len); # \ is \x5c for an opad 465 my $final_out=""; my $i=1; 466 my $slt; 467 while (length($final_out) < $bytes) { 468 $slt = $orig_salt; 469 if (!defined($pbkdf1) || !$pbkdf1) { $slt .= Uint32BERaw($i); $i += 1; } 470 no strict 'refs'; 471 $slt = &$algo($opad.&$algo($ipad.$slt)); 472 my $out; 473 if (!defined($pbkdf1) || !$pbkdf1) { $out = $slt; } 474 for (my $x = 1; $x < $iter; $x += 1) { 475 $slt = &$algo($opad.&$algo($ipad.$slt)); 476 if (!defined($pbkdf1) || !$pbkdf1) { 477 $out ^= $slt; 478 if (defined($efscrap) && $efscrap) { 479 $slt = $out; 480 } 481 } 482 } 483 use strict; 484 if (defined($pbkdf1) && $pbkdf1) { $out = $slt; } 485 if (length($final_out)+length($out) > $bytes) { 486 $out = substr($out, 0, $bytes-length($final_out)); 487 } 488 $final_out .= $out; 489 } 490 return $final_out; 491} 492sub pp_pbkdf2_hex { 493 my ($pass, $slt, $iter, $algo, $bytes, $pad_len, $pbkdf1) = @_; 494 return unpack("H*",pp_pbkdf2($pass,$slt,$iter,$algo,$bytes,$pad_len,$pbkdf1)); 495} 496 497############################################################################# 498# pure perl crc32 using table lookup, and 'restart' values. 499# crc32("test this") == crc32(" this", crc32("test")); 500############################################################################# 501my @crc32_tab = (); 502my $crc32_tab_init = 0; 503 504sub init_crc32_tab { 505 if (defined($crc32_tab_init) && $crc32_tab_init == 1) { return; } 506 $crc32_tab_init = 1; 507 my $i; my $j; my $byte; my $crc; my $mask; 508 509 for ($byte = 0; $byte <= 255; $byte++) { 510 $crc = $byte; 511 for ($j = 7; $j >= 0; $j--) { 512 $mask = -($crc & 1); 513 $crc = ($crc >> 1) ^ (0xEDB88320 & $mask); 514 } 515 $crc32_tab[$byte] = $crc & 0xffffffff; 516 } 517} 518 519sub crc32 { 520 my $msg = $_[0]; 521 my $i; my $j; my $byte; my $crc; my $mask; 522 523 init_crc32_tab(); # note, only init's 1 time. 524 if (defined($_[1])) { 525 $crc = $_[1]^0xFFFFFFFF; 526 } else { 527 $crc = 0xFFFFFFFF; 528 } 529 $i = 0; 530 while ($i < length($msg)) { 531 $byte = ord(substr($msg, $i, 1)); 532 $crc = ($crc >> 8) ^ $crc32_tab[($crc ^ $byte) & 0xFF]; 533 ++$i; 534 } 535 return ~ $crc; 536} 537############################################################################# 538# the Crypt::ECB padding interface changed at v2.00 and is not compatible. 539# we have to handle this correctly by detecting version, and returning 540# proper data for the version being used 541############################################################################# 542sub ecb_padding_none { 543 require Crypt::ECB; 544 if (Crypt::ECB->VERSION*1.0 >= 2.00) { return 'none'; } 545 import Crypt::ECB qw(PADDING_NONE); 546 return PADDING_NONE(); 547} 548############################################################################# 549# these functions will encode words 'properly', or at least try to, based upon 550# things like -utf8 mode, and possible MS code pages understood by JtR. 551############################################################################# 552sub ms_word_encode_uc { 553 my $s = uc($_[0]); 554 if ($arg_codepage eq "UTF-8") { 555 eval { $s = encode("CP850", uc($_[0]), Encode::FB_CROAK); }; 556 if (!$@) { goto MS_enc_Found; } 557 eval { $s = encode("CP437", uc($_[0]), Encode::FB_CROAK); }; 558 if (!$@) { goto MS_enc_Found; } 559 eval { $s = encode("CP852", uc($_[0]), Encode::FB_CROAK); }; 560 if (!$@) { goto MS_enc_Found; } 561 eval { $s = encode("CP858", uc($_[0]), Encode::FB_CROAK); }; 562 if (!$@) { goto MS_enc_Found; } 563 eval { $s = encode("CP866", uc($_[0]), Encode::FB_CROAK); }; 564 if (!$@) { goto MS_enc_Found; } 565 eval { $s = encode("CP737", uc($_[0]), Encode::FB_CROAK); }; 566 if ($@) { 567 print STDERR "UTF-8 input for LM must be encodable in CP850/CP437/CP852/CP858/CP866/CP737. Use non-UTF8 input with --codepage=xx instead Word was: $_[0]\n"; 568 $s = uc($_[0]); 569 } 570 MS_enc_Found:; 571 } elsif ($arg_codepage) { 572 $s = encode($arg_codepage, uc($_[0])); 573 } 574 return $s; 575} 576sub word_encode { 577 my $s = $_[0]; 578 if ($arg_codepage && $arg_codepage ne "UTF-8") { 579 $s = encode($arg_codepage, $_[0]); 580 } 581 return $s; 582} 583# sets parity bit to odd. 'truncates' chars to 7 bit before computing odd parity. 584sub str_odd_parity { 585 my $i; 586 my $s = $_[0]; 587 for ($i = 0; $i < length($s); $i++) { 588 my $b = ord(substr($s, $i, 1))&0x7F; #strip off high bit. 589 my $b_7bit = $b; 590 my $c = 0; 591 while ($b) { 592 if ($b & 1) { $c++; } 593 $b >>= 1; 594 } 595 if ($c & 1) { 596 substr($s, $i, 1) = chr($b_7bit); # already odd 597 } else { 598 substr($s, $i, 1) = chr($b_7bit+0x80); 599 } 600 } 601 return $s; 602} 603# sets parity bit to even. 'truncates' chars to 7 bit before computing even parity. 604sub str_even_parity { 605 my $i; 606 my $s = $_[0]; 607 for ($i = 0; $i < length($s); $i++) { 608 my $b = ord(substr($s, $i, 1))&0x7F; #strip off high bit. 609 my $b_7bit = $b; 610 my $c = 0; 611 while ($b) { 612 if ($b & 1) { $c++; } 613 $b >>= 1; 614 } 615 if ( ($c & 1) == 0) { 616 substr($s, $i, 1) = chr($b_7bit); # already even 617 } else { 618 substr($s, $i, 1) = chr($b_7bit+0x80); 619 } 620 } 621 return $s; 622} 623# str_force_length(str, len, padd); does padding to proper len (or truncation). 624sub str_force_length_pad { 625 my $str = $_[0]; 626 while (length($str) < $_[1]) { $str .= $_[2]; } 627 $str = substr($str, 0, $_[1]); 628 return $str; 629} 630# every byte of the string has its bits put into reverse order. 631# vnc does this for some reason. But I put into a function so if 632# needed again, we can do this. 633sub str_reverse_bits_in_bytes { 634 my $i; 635 my $s = $_[0]; 636 for ($i = 0; $i < length($s); $i++) { 637 my $b = ord(substr($s, $i, 1)); 638 $b = ($b & 0xF0) >> 4 | ($b & 0x0F) << 4; 639 $b = ($b & 0xCC) >> 2 | ($b & 0x33) << 2; 640 $b = ($b & 0xAA) >> 1 | ($b & 0x55) << 1; 641 substr($s, $i, 1) = chr($b); 642 } 643 return $s; 644} 645############################################################################# 646# this function does the LM hash in pure perl. It uses an existing 647# setup_des_key we were using for the net_ntlm stuff. 648############################################################################# 649sub LANMan { 650 require Crypt::DES; 651 my $LMConst = 'KGS!@#$%'; 652 my $s = ms_word_encode_uc($_[0]); 653 if (length($s)>14) { $s = substr($s,0,14); } 654 while (length ($s) < 14) { $s .= "\0"; } 655 my $des0 = new Crypt::DES setup_des_key(substr($s,0,7)); 656 my $des1 = new Crypt::DES setup_des_key(substr($s,7,7)); 657 return $des0->encrypt($LMConst).$des1->encrypt($LMConst); 658} 659 660############################################################################# 661# This function does PHPass/Wordpress algorithm. 662############################################################################# 663sub PHPass_hash { 664 my ($pw, $cost, $salt) = @_; 665 $cost = 1<<$cost; 666 my $h = md5($salt.$pw); 667 while ($cost-- > 0) { 668 $h = md5($h.$pw); 669 } 670 return $h; 671} 672# this helper converts 11 into 9, 12 into A, 13 into B, etc. This is the byte 673# signature for PHPass, which ends up being 1<<num (num being 7 to 31) 674sub to_phpbyte { 675 if ($_[0] <= 11) { 676 return 0+($_[0]-2); 677 } 678 return "A"+($_[0]-12); 679} 680 681 682############################################################################# 683# this function is 'like' the length($s) function, BUT it has special 684# processing needed for UTF-16 formats. The problem is that 4-byte UTF-8 685# end up requiring 4 bytes of UTF-16 (using a surrogate), while up to 3-byte 686# UTF-8 only require 2 bytes. We have assumption that 1 UTF-8 char is 2 bytes 687# long. So if we find 4-byte characters used for a single UTF-8 char, then we 688# have to say it is 2 characters long. 689############################################################################# 690sub utf16_len { 691 my $base_len = length($_[0]); 692 if ($arg_codepage ne "UTF-8") { return $base_len; } 693 my $final_len = $base_len; 694 for (my $i = 0; $i < $base_len; $i += 1) { 695 my $s = substr($_[0], $i, 1); 696 my $ch_bytes = Encode::encode_utf8($s); 697 if (length($ch_bytes) > 3) { $final_len += 1; } 698 } 699 return $final_len; 700} 701 702############################################################################# 703# if the 'magic' option -tstall is used, we simply call a function that calls 704# ALL of the functions which is used to test if all CPAN modules are installed. 705############################################################################# 706sub tst_all { 707 $u = 1; 708 my $cnt = 0; 709 $arg_hidden_cp = "iso-8859-1"; 710 foreach my $f (@funcs) { 711 $f = lc $f; 712 $f =~ s/-/_/g; 713 if ($f ne "dynamic") { 714 reset_out_vars(); 715 no strict 'refs'; 716 my $hash = &$f("password", word_encode("password")); 717 use strict; 718 $cnt += 1; 719 if (defined($hash) && length($hash) > 4) { 720 output_hash($hash, "password", word_encode("password")); 721 } 722 } 723 } 724 # now test all 'simple' dyna which we have defined (number only) 725 for (my $i = 0; $i < 10000; $i += 1) { 726 my $f = dynamic_compile($i); 727 $f = lc $f; 728 if (defined(&{$f})) { 729 reset_out_vars(); 730 no strict 'refs'; 731 my $hash = &$f("password", word_encode("password")); 732 use strict; 733 $cnt += 1; 734 if (defined($hash) && length($hash) > 4) { 735 output_hash($hash, "password", word_encode("password")); 736 } 737 } 738 } 739 print STDERR "\nAll formats were able to be run ($cnt total formats). All CPAN modules installed\n"; 740} 741 742sub gen_all { 743 $u = 1; 744 $arg_hidden_cp = "iso-8859-1"; 745 srand(666); 746 foreach my $f (@funcs) { 747 $f = lc $f; 748 $f =~ s/-/_/g; 749 if ($f ne "dynamic") { 750 reset_out_vars(); 751 no strict 'refs'; 752 my $hash = &$f($_[0], word_encode($_[0])); 753 use strict; 754 if (defined($hash) && length($hash) > 4) { 755 output_hash($hash, $_[0], word_encode($_[0])); 756 } 757 } 758 } 759 # now test all 'simple' dyna which we have defined (number only) 760 for (my $i = 0; $i < 10000; $i += 1) { 761 my $f = dynamic_compile($i); 762 $f = lc $f; 763 if (defined(&{$f})) { 764 reset_out_vars(); 765 no strict 'refs'; 766 my $hash = &$f($_[0], word_encode($_[0])); 767 use strict; 768 if (defined($hash) && length($hash) > 4) { 769 output_hash($hash, $_[0], word_encode($_[0])); 770 } 771 } 772 } 773} 774 775############################################################################# 776# used to get salts. Call with randstr(count[,array of valid chars] ); array is 'optional' Default is AsciiText (UPloCase, nums, _ ) 777############################################################################# 778sub randstr { 779 my @chr = defined($_[1]) ? @{$_[1]} : @chrAsciiTextNum; 780 my $s=""; 781 if ($arg_nrgenall != 0) { srand(666); } 782 foreach (1..$_[0]) { 783 $s.=$chr[rand @chr]; 784 } 785 return $s; 786} 787sub randusername { 788 my $num = shift; 789 if ($arg_nrgenall != 0) { srand(666); } 790 my $user = $userNames[rand @userNames]; 791 if (defined($num) && $num > 0) { 792 while (length($user) > $num) { 793 $user = $userNames[rand @userNames]; 794 } 795 } 796 return $user; 797} 798# this will return the same LE formated buffer as 'uint32_t i' would on Intel 799sub Uint32LERaw { 800 my $i = $_[0]; 801 return chr($i&0xFF).chr(($i>>8)&0xFF).chr(($i>>16)&0xFF).chr(($i>>24)&0xFF); 802} 803# this will return the same BE formated buffer as 'uint32_t i' would on Motorola 804sub Uint32BERaw { 805 my $i = $_[0]; 806 return chr(($i>>24)&0xFF).chr(($i>>16)&0xFF).chr(($i>>8)&0xFF).chr($i&0xFF); 807} 808# this will return the same LE formated buffer as 'uint64_t i' would on Intel 809sub Uint64LERaw { 810 my $i = $_[0]; 811 return chr($i&0xFF).chr(($i>>8)&0xFF).chr(($i>>16)&0xFF).chr(($i>>24)&0xFF).chr(($i>>32)&0xFF).chr(($i>>40)&0xFF).chr(($i>>48)&0xFF).chr(($i>>56)&0xFF); 812} 813 814sub net_ssl_init { 815 if ($net_ssl_init_called == 1) { return; } 816 $net_ssl_init_called = 1; 817 require Net::SSLeay; 818 import Net::SSLeay qw(die_now die_if_ssl_error); 819 Net::SSLeay::load_error_strings(); 820 Net::SSLeay::SSLeay_add_ssl_algorithms(); # Important! 821 Net::SSLeay::ENGINE_load_builtin_engines(); # If you want built-in engines 822 Net::SSLeay::ENGINE_register_all_complete(); # If you want built-in engines 823 Net::SSLeay::OpenSSL_add_all_digests(); 824} 825############################################################################################ 826# returns salt. Usage: get_salt(len [,argsalt_len [,@character_set]] ) 827# if len is negative, then we want a random salt len that is int(rand(-len))+1 bytes long 828# if argsalt_len is missing, then argsalt_len is set to len (after it is set positive) 829# if argsalt_len is there, it is used. If it is -1, then any length argsalt is ok, if it is 830# negative (not -1), then only argsalts <= -argsalt_len are used. 831# if the length of the salt is 2*aslen, and the argsalt is hex, then it is first converted 832# into raw before it is later used. If using a var length salt, we still can provide abs 833# hex salt string, we just have to append HEX= to the salt. So HEX=303132333434 would 834# give us a salt of 012344 835# the 3rd param (optional), is the character set. @chrAsciiTextNum is default. 836############################################################################################ 837sub get_salt { 838 my $len = $_[0]; 839 my $randlen = 0; 840 if ($len < 0) { $randlen = 1; $len *= -1; } 841 my $aslen = $len; 842 my @chr = (); 843 my $chrset_arg = 1; 844 if (defined $_[1] && $_[1]+0 eq $_[1]) { 845 $aslen = $_[1]; 846 $chrset_arg = 2; 847 } 848 @chr = defined($_[$chrset_arg]) ? @{$_[$chrset_arg]} : @chrAsciiTextNum; 849 if (defined $argsalt && length ($argsalt)==$aslen*2 && length(pack("H*",$argsalt))==$aslen) { 850 $argsalt = pack("H*",$argsalt); 851 } elsif (defined $argsalt && substr($argsalt, 0, 4) eq "HEX=") { 852 $argsalt = pack("H*",substr($argsalt,4)); 853 } 854 if (defined $argsalt && ($aslen == -1 || ($aslen < -1 && length($argsalt) <= -1*$aslen) || length ($argsalt)==$aslen || ($randlen == 1 && length($argsalt) <= $len)) ) { 855 return ($argsalt); 856 } 857 if (@chr == @userNames) { return randusername($len); } 858 elsif ($randlen == 0) { return randstr($len, \@chr); } 859 if ($len > 8) { 860 my $l = int(rand(8))+int(rand($len-8))+1; 861 if ($l > $len) { $l = $len; } 862 return randstr($l, \@chr); 863 } 864 return randstr(int(rand($len))+1, \@chr); 865} 866sub get_iv { 867 my $len = $_[0]; 868 my @chr = defined($_[1]) ? @{$_[1]} : @chrAsciiTextNum; 869 if (defined $argiv && length ($argiv)==$len*2 && length(pack("H*",$argiv))==$len) { 870 $argiv = pack("H*",$argiv); 871 } 872 if (defined $argiv && length ($argiv)==$len) { 873 return ($argiv); 874 } 875 return randstr($len, \@chr); 876} 877sub get_content { 878 my $len = $_[0]; 879 my $randlen = 0; 880 if ($len < 0) { $randlen = 1; $len *= -1; } 881 my $aslen = $len; 882 if (defined $_[1] && $_[1]+0 eq $_[1]) { $aslen = $_[1]; } 883 my @chr = defined($_[2]) ? @{$_[2]} : @chrAsciiTextNum; 884 if (defined $argcontent && length ($argcontent)==$len*2 && length(pack("H*",$argcontent))==$len) { 885 return pack("H*",$argcontent); 886 } elsif (defined $argcontent && substr($argcontent, 0, 4) eq "HEX=") { 887 return pack("H*",substr($argcontent, 4)); 888 } 889 if (defined $argcontent && ($aslen == -1 || ($aslen < -1 && length($argcontent) <= -1*$aslen) || length ($argcontent)==$aslen || ($randlen == 1 && length($argcontent) <= $len)) ) { 890 return ($argcontent); 891 } 892 if ($randlen == 0) { return randstr($len, \@chr); } 893 if ($len > 32) { 894 my $l = int(rand(32))+int(rand($len-32))+1; 895 if ($l > $len) { $l = $len; } 896 return randstr($l, \@chr); 897 } 898 return randstr(int(rand($len))+1, \@chr); 899} 900sub get_username { 901 my $len = $_[0]; 902 if (defined ($arguser) && length($arguser) <= abs($len)) { 903 return ($arguser); 904 } 905 return randusername($len); 906} 907sub get_loops { 908 if ($arg_loops != -1) { return $arg_loops; } 909 return $_[0]; 910} 911############################################################################################ 912# we need a getter function for $iv also (and content??, and possibly others) that are 913# modeled after get_salt() 914############################################################################################ 915 916# helper function needed by md5crypt_a (or md5crypt if we were doing that one) 917sub to64 #unsigned long v, int n) 918{ 919 my $str, my $n = $_[1], my $v = $_[0]; 920 while (--$n >= 0) { 921 $str .= $i64[$v & 0x3F]; 922 $v >>= 6; 923 } 924 return $str; 925} 926# uses encode_64, but replaces all + with . NOT sure why, but that is what it does. 927# used in at least pbkdf2-hmac-sha256. Probably others. 928sub base64pl { 929 my $ret = encode_base64($_[0], ""); 930 $ret =~ s/\+/./g; 931 chomp $ret; 932 return $ret; 933} 934# helper function for nsldap and nsldaps 935sub base64 { 936 my $ret = encode_base64($_[0], ""); 937 chomp $ret; 938 return $ret; 939} 940sub _crypt_to64 { 941 my $itoa64 = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; 942 my ($v, $n) = ($_[1], $_[2]); 943 while (--$n >= 0) { 944 $_[0] .= substr($itoa64, $v & 0x3f, 1); 945 $v >>= 6; 946 } 947} 948# used by drupal. Would also probably be used for phpass. dragonfly also uses something similar, but 'mixes' 949sub base64i { 950 my $final = $_[0]; 951 #print "\n".unpack("H*",$final)."\n"; 952 my $len = length $final; 953 my $mod = $len%3; 954 my $cnt = ($len-$mod)/3; 955 my $out = ""; 956 my $l; 957 for ($i = 0; $i < $cnt; $i++) { 958 $l = (ord(substr($final, $i*3, 1))) | (ord(substr($final, $i*3+1, 1)) << 8) | (ord(substr($final, $i*3+2, 1))<<16); 959 _crypt_to64($out, $l, 4); 960 } 961 if ($mod == 2) { $l = ord(substr($final, $i*3, 1)) | (ord(substr($final, $i*3+1, 1)) << 8); _crypt_to64($out, $l, 4); } 962 if ($mod == 1) { $l = ord(substr($final, $i*3, 1)); _crypt_to64($out, $l, 4); } 963 return $out; 964} 965 966# the encoding used for JtR wpapsk is strange enough, I had to make my own version. 967# base64i 'worked' but the data output was out of order (I think it was LE vs BE building). 968sub _crypt_to64_wpa { 969 my $itoa64 = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; 970 my ($v, $n) = ($_[1], $_[2]); 971 while (--$n >= 0) { 972 $_[0] .= substr($itoa64, ($v & 0xFC0000)>>18, 1); 973 $v <<= 6; 974 } 975} 976sub base64_wpa { 977 my $final = $_[0]; 978 my $len = length $final; 979 my $mod = $len%3; 980 my $cnt = ($len-$mod)/3; 981 my $out = ""; 982 my $l; 983 for ($i = 0; $i < $cnt; $i++) { 984 $l = (ord(substr($final, $i*3, 1))<<16) | (ord(substr($final, $i*3+1, 1)) << 8) | (ord(substr($final, $i*3+2, 1))); 985 _crypt_to64_wpa($out, $l, 4); 986 } 987 if ($mod == 2) { $l = (ord(substr($final, $i*3, 1))<<16) | (ord(substr($final, $i*3+1, 1))<<8); _crypt_to64_wpa($out, $l, 3); } 988 if ($mod == 1) { $l = (ord(substr($final, $i*3, 1))<<16); _crypt_to64_wpa($out, $l, 2); } 989 return $out; 990} 991# aix was like wpa, byte swapped, but it also swaps the end result chars (4 byte swap), and odd last limb gets all 4, swaps and then trims. 992sub base64_aix { 993 my $final = $_[0]; 994 my $len = length $final; 995 my $mod = $len%3; 996 my $cnt = ($len-$mod)/3; 997 my $out = ""; 998 my $l; 999 for ($i = 0; $i < $cnt; $i++) { 1000 $l = (ord(substr($final, $i*3, 1))<<16) | (ord(substr($final, $i*3+1, 1)) << 8) | (ord(substr($final, $i*3+2, 1))); 1001 my $x=""; 1002 _crypt_to64_wpa($x, $l, 4); 1003 $out .= substr($x,3,1); 1004 $out .= substr($x,2,1); 1005 $out .= substr($x,1,1); 1006 $out .= substr($x,0,1); 1007 } 1008 if ($mod == 2) { 1009 $l = (ord(substr($final, $i*3, 1))<<16) | (ord(substr($final, $i*3+1, 1))<<8); 1010 my $x=""; 1011 _crypt_to64_wpa($x, $l, 4); 1012 $out .= substr($x,3,1); 1013 $out .= substr($x,2,1); 1014 $out .= substr($x,1,1); 1015 } 1016 if ($mod == 1) { 1017 $l = (ord(substr($final, $i*3, 1))<<16); 1018 my $x=""; 1019 _crypt_to64_wpa($x, $l, 4); 1020 $out .= substr($x,3,1); 1021 $out .= substr($x,2,1); 1022 } 1023 return $out; 1024} 1025# required by the ns hash. base64 did not work. 1026sub ns_base64_2 { 1027 my $ret = ""; 1028 my $n; my @ha = split(//,$h); 1029 for ($i = 0; $i < $_[0]; ++$i) { 1030 # the first one gets some unitialized at times.. Same as the fix in ns_base64 1031 #$n = ord($ha[$i*2+1]) | (ord($ha[$i*2])<<8); 1032 $n = ord($ha[$i*2])<<8; 1033 if (@ha > $i*2+1) { $n |= ord($ha[$i*2+1]); } 1034 $ret .= "$ns_i64[($n>>12)&0xF]"; 1035 $ret .= "$ns_i64[($n>>6)&0x3F]"; 1036 $ret .= "$ns_i64[$n&0x3F]"; 1037 } 1038 return $ret; 1039} 1040 1041sub whirlpool_hex { 1042 require Digest; 1043 my $whirlpool = Digest->new('Whirlpool'); 1044 $whirlpool->add( $_[0] ); 1045 return $whirlpool->hexdigest; 1046} 1047sub whirlpool_base64 { 1048 require Digest; 1049 my $whirlpool = Digest->new('Whirlpool'); 1050 $whirlpool->add( $_[0] ); 1051 return $whirlpool->b64digest; 1052} 1053sub whirlpool { 1054 require Digest; 1055 my $whirlpool = Digest->new('Whirlpool'); 1056 $whirlpool->add( $_[0] ); 1057 return $whirlpool->digest; 1058} 1059 1060sub haval256 { 1061 require Digest::Haval256; 1062 my $hash = new Digest::Haval256; 1063 $hash->add( $_[0] ); 1064 my $h = $hash->digest; 1065 return $h; 1066} 1067sub haval256_hex { 1068 require Digest::Haval256; 1069 my $hash = new Digest::Haval256; 1070 $hash->add( $_[0] ); 1071 return $hash->hexdigest; 1072} 1073sub haval256_base64 { 1074 require Digest::Haval256; 1075 my $hash = new Digest::Haval256; 1076 $hash->add( $_[0] ); 1077 return $hash->base64digest; 1078} 1079sub tiger_hex { 1080 require Digest::Tiger; 1081 return lc Digest::Tiger::hexhash($_[0]); 1082} 1083sub tiger { 1084 my $h = tiger_hex($_[0]); 1085 my $ret = pack "H*", $h; 1086 return $ret; 1087} 1088sub tiger_base64 { 1089 require Digest::Tiger; 1090 my $bin = pack "H*", lc Digest::Tiger::hexhash($_[0]); 1091 return base64($bin); 1092} 1093# these all come from CryptX usage. 1094sub ripemd128_hex { 1095 # these come from CryptX which is very hard to get working under Cygwin, but the only place 1096 # to find RIPEMD128, RIPEMD266, RIPEMD320. We use the Crypt::Digest usage, instead of 1097 # loading each Digest type (4 of them, at least) 1098 require Crypt::Digest::RIPEMD128; 1099 Crypt::Digest::RIPEMD128::ripemd128_hex($_[0]); 1100} 1101sub ripemd128 { 1102 require Crypt::Digest::RIPEMD128; 1103 Crypt::Digest::RIPEMD128::ripemd128($_[0]); 1104} 1105sub ripemd128_base64 { 1106 require Crypt::Digest::RIPEMD128; 1107 Crypt::Digest::RIPEMD128::ripemd128_base64($_[0]); 1108} 1109sub ripemd160_hex { 1110 require Crypt::Digest::RIPEMD160; 1111 Crypt::Digest::RIPEMD160::ripemd160_hex($_[0]); 1112} 1113sub ripemd160 { 1114 require Crypt::Digest::RIPEMD160; 1115 Crypt::Digest::RIPEMD160::ripemd160($_[0]); 1116} 1117sub ripemd160_base64 { 1118 require Crypt::Digest::RIPEMD160; 1119 Crypt::Digest::RIPEMD160::ripemd160_base64($_[0]); 1120} 1121sub ripemd256_hex { 1122 require Crypt::Digest::RIPEMD256; 1123 Crypt::Digest::RIPEMD256::ripemd256_hex($_[0]); 1124} 1125sub ripemd256 { 1126 require Crypt::Digest::RIPEMD256; 1127 Crypt::Digest::RIPEMD256::ripemd256($_[0]); 1128} 1129sub ripemd256_base64 { 1130 require Crypt::Digest::RIPEMD256; 1131 Crypt::Digest::RIPEMD256::ripemd256_base64($_[0]); 1132} 1133sub ripemd320_hex { 1134 require Crypt::Digest::RIPEMD320; 1135 Crypt::Digest::RIPEMD320::ripemd320_hex($_[0]); 1136} 1137sub ripemd320 { 1138 require Crypt::Digest::RIPEMD320; 1139 Crypt::Digest::RIPEMD320::ripemd320($_[0]); 1140} 1141sub ripemd320_base64 { 1142 require Crypt::Digest::RIPEMD320; 1143 Crypt::Digest::RIPEMD320::ripemd320_base64($_[0]); 1144} 1145 1146############################################################################ 1147# Here are the encryption subroutines. 1148# the format of ALL of these is: function(password) 1149# all salted formats choose 'random' salts, in one way or another. 1150############################################################################# 1151sub descrypt { 1152 require Crypt::UnixCrypt_XS; 1153 $salt = get_salt(2,2,\@i64); 1154 return Crypt::UnixCrypt_XS::crypt($_[1], $salt); 1155} 1156sub bigcrypt { 1157 require Crypt::UnixCrypt_XS; 1158 if (length($_[0]) > 8) { 1159 my $ret = ""; 1160 $salt = get_salt(2,2,\@i64); 1161 my $pw = $_[0]; 1162 while (length($pw)%8!= 0) { $pw .= "\0"; } 1163 my $lastlimb = Crypt::UnixCrypt_XS::crypt(substr($pw,0,8), $salt); 1164 $ret = $lastlimb; 1165 $pw = substr($pw,8); 1166 while (length($pw)) { 1167 $lastlimb = Crypt::UnixCrypt_XS::crypt(substr($pw,0,8), substr($lastlimb,2,2)); 1168 $ret .= substr($lastlimb, 2); 1169 $pw = substr($pw,8); 1170 } 1171 return $ret; 1172 } 1173 return descrypt(@_); 1174} 1175sub bsdicrypt { 1176 require Crypt::UnixCrypt_XS; 1177 my $block = "\0\0\0\0\0\0\0\0"; 1178 my $rounds = 725; 1179 $salt = get_salt(4,4,\@i64); 1180 my $h = Crypt::UnixCrypt_XS::crypt_rounds(Crypt::UnixCrypt_XS::fold_password($_[1]),$rounds,Crypt::UnixCrypt_XS::base64_to_int24($salt),$block); 1181 return "_".Crypt::UnixCrypt_XS::int24_to_base64($rounds).$salt.Crypt::UnixCrypt_XS::block_to_base64($h); 1182} 1183sub md5crypt { 1184 $salt = get_salt(-8); 1185 return md5crypt_hash($_[1], $salt, "\$1\$"); 1186} 1187sub bfx_fix_pass { 1188 my $pass = $_[0]; 1189 my $i; 1190 for ($i = 0; $i < length($pass); $i++) { 1191 my $s = substr($pass, $i, 1); 1192 last if (ord($s) >= 0x80); 1193 } 1194 if ($i == length($pass)) { return $pass; } # if no high bits set, then the error would NOT show up. 1195 my $pass_ret = ""; 1196 # Ok, now do the logic from 'broken' BF_std_set_key(). 1197 # When we get to a 4 byte limb, that has (limb&0xFF) == 0, we return the accumlated string, minus that last null. 1198 my $BF_word; my $ptr=0; 1199 for ($i = 0; $i < 18; $i++) { # BF_Rounds is 16, so 16+2 is 18 1200 $BF_word = 0; 1201 for (my $j = 0; $j < 4; $j++) { 1202 $BF_word <<= 8; 1203 my $c; 1204 if ($ptr < length($pass)) { 1205 $c = substr($pass, $ptr, 1); 1206 if (ord($c) > 0x80) { 1207 $BF_word = 0xFFFFFF00; 1208 } 1209 $BF_word |= ord($c); 1210 } 1211 if ($ptr < length($pass)) { $ptr++; } 1212 else { $ptr = 0; } 1213 } 1214 $pass_ret .= chr(($BF_word&0xFF000000)>>24); 1215 $pass_ret .= chr(($BF_word&0x00FF0000)>>16); 1216 $pass_ret .= chr(($BF_word&0x0000FF00)>>8); 1217 if ( ($BF_word & 0xFF) == 0) { 1218 # done (uncomment to see just 'what' the password is. i.e. the hex string of the password) 1219 #print unpack("H*", $pass_ret) . "\n"; 1220 return $pass_ret; 1221 } 1222 $pass_ret .= chr($BF_word&0xFF); 1223 } 1224} 1225sub bcryptx { 1226 my $fixed_pass = bfx_fix_pass($_[1]); 1227 require Crypt::Eksblowfish::Bcrypt; 1228 $salt = get_salt(16,16,\@i64); 1229 my $hash = Crypt::Eksblowfish::Bcrypt::bcrypt_hash({key_nul => 1, cost => 5, salt => $salt, }, $fixed_pass); 1230 return "\$2x\$05\$".Crypt::Eksblowfish::Bcrypt::en_base64($salt).Crypt::Eksblowfish::Bcrypt::en_base64($hash); 1231} 1232sub bcrypt { 1233 require Crypt::Eksblowfish::Bcrypt; 1234 $salt = get_salt(16,16,\@i64); 1235 my $hash = Crypt::Eksblowfish::Bcrypt::bcrypt_hash({key_nul => 1, cost => 5, salt => $salt, }, $_[1]); 1236 return "\$2a\$05\$".Crypt::Eksblowfish::Bcrypt::en_base64($salt).Crypt::Eksblowfish::Bcrypt::en_base64($hash); 1237} 1238sub _bfegg_en_base64($) { 1239 my($bytes) = @_; 1240 my $digits = ""; 1241 my $b64_digits = "./0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; 1242 foreach my $word (reverse unpack("N*", $bytes)) { 1243 for(my $i = 6; $i--; $word >>= 6) { 1244 $digits .= substr($b64_digits, $word & 0x3f, 1); 1245 } 1246 } 1247 return $digits; 1248} 1249sub bfegg { 1250 require Crypt::Eksblowfish::Uklblowfish; 1251 if (length($_[1]) > 0) { 1252 my $cipher = Crypt::Eksblowfish::Uklblowfish->new($_[1]); 1253 my $h = $cipher->encrypt("\xde\xad\xd0\x61\x23\xf6\xb0\x95"); 1254 return "+"._bfegg_en_base64($h); 1255 } 1256 return undef; 1257} 1258sub raw_md5 { 1259 return md5_hex($_[1]); 1260} 1261sub raw_md5u { 1262 return md5_hex(encode("UTF-16LE",$_[0])); 1263} 1264sub raw_sha1 { 1265 return sha1_hex($_[1]); 1266} 1267sub raw_sha1u { 1268 return sha1_hex(encode("UTF-16LE",$_[0])); 1269} 1270sub raw_sha256 { 1271 return sha256_hex($_[1]); 1272} 1273sub cisco4 { 1274 return "\$cisco4\$".base64_wpa(sha256($_[1])); 1275} 1276sub raw_sha224 { 1277 return sha224_hex($_[1]); 1278} 1279sub raw_sha384 { 1280 return sha384_hex($_[1]); 1281} 1282sub raw_sha512 { 1283 return sha512_hex($_[1]); 1284} 1285sub cisco8 { 1286 $salt = get_salt(14,14,\@i64); 1287 my $h = pp_pbkdf2($_[1],$salt,20000,"sha256",32,64); 1288 my $s = base64_wpa($h); 1289 return "\$8\$$salt\$$s"; 1290} 1291sub cisco9 { 1292 require Crypt::ScryptKDF; 1293 import Crypt::ScryptKDF qw(scrypt_raw); 1294 $salt = get_salt(14,14,\@i64); 1295 my $h = scrypt_raw($_[1],$salt,16384,1,1,32); 1296 my $s = base64_wpa($h); 1297 return "\$9\$$salt\$$s"; 1298} 1299sub raw_tiger { 1300 return "\$tiger\$".tiger_hex($_[1]); 1301} 1302sub raw_whirlpool { 1303 # note we only handle whirlpool, not whirlpool0 or whirlpool1 1304 return "\$whirlpool\$".whirlpool_hex($_[1]); 1305} 1306sub dragonfly3_32 { 1307 $salt = get_salt(-8, -8); 1308 my $final = sha256($_[1]."\$3\$\0".$salt); 1309 my $out = ""; 1310 my ($l, $p); 1311 for ($i = 0; $i < 10; $i++) { 1312 $l = ord(substr($final, $i, 1)) << 16 | ord(substr($final, $i + 11, 1)) << 8 | ord(substr($final, $i + 21, 1)); 1313 _crypt_to64($out, $l, 4); $p += 4; 1314 } 1315 $l = ord(substr($final, 10, 1)) << 16 | ord(substr($final, 31, 1)) << 8; 1316 _crypt_to64($out, $l, 4); 1317 return "\$3\$$salt\$$out"; 1318} 1319sub dragonfly4_32 { 1320 $salt = get_salt(-8, -8); 1321 my $final = sha512($_[1]."\$4\$\0".$salt); 1322 my $out = ""; 1323 my ($l, $p); 1324 for ($i = 0; $i < 20; $i++) { 1325 $l = ord(substr($final, $i, 1)) << 16 | ord(substr($final, $i + 21, 1)) << 8 | ord(substr($final, $i + 42, 1)); 1326 _crypt_to64($out, $l, 4); $p += 4; 1327 } 1328 $l = ord(substr($final, 20, 1)) << 16 | ord(substr($final, 41, 1)) << 8; 1329 _crypt_to64($out, $l, 4); 1330 return "\$4\$$salt\$$out"; 1331} 1332sub dragonfly3_64 { 1333 $salt = get_salt(-8, -8); 1334 my $final = sha256($_[1]."\$3\$\0sha5".$salt); 1335 my $out = ""; 1336 my ($l, $p); 1337 for ($i = 0; $i < 10; $i++) { 1338 $l = ord(substr($final, $i, 1)) << 16 | ord(substr($final, $i + 11, 1)) << 8 | ord(substr($final, $i + 21, 1)); 1339 _crypt_to64($out, $l, 4); $p += 4; 1340 } 1341 $l = ord(substr($final, 10, 1)) << 16 | ord(substr($final, 31, 1)) << 8; 1342 _crypt_to64($out, $l, 4); 1343 return "\$3\$$salt\$$out"; 1344} 1345 1346sub dragonfly4_64 { 1347 $salt = get_salt(-8, -8); 1348 my $final = sha512($_[1]."\$4\$\0/etc".$salt); 1349 my $out = ""; 1350 my ($l, $p); 1351 for ($i = 0; $i < 20; $i++) { 1352 $l = ord(substr($final, $i, 1)) << 16 | ord(substr($final, $i + 21, 1)) << 8 | ord(substr($final, $i + 42, 1)); 1353 _crypt_to64($out, $l, 4); $p += 4; 1354 } 1355 $l = ord(substr($final, 20, 1)) << 16 | ord(substr($final, 41, 1)) << 8; 1356 _crypt_to64($out, $l, 4); 1357 return "\$4\$$salt\$$out"; 1358} 1359 1360sub mscash { 1361 $out_username = get_salt(19,-19,\@userNames); 1362 return md4_hex(md4(encode("UTF-16LE",$_[0])).encode("UTF-16LE", lc($out_username))); 1363} 1364 1365sub krb5_18 { 1366 # algorith gotten by working with kbr5-1.13 sources, and using lots of dump_stuff_msg() 1367 # calls to figure out what was happening. The constant being used here was found by 1368 # dump_stuff_msg() calls, and appears to be the end result that is used. 1369 $salt = get_salt(12,-64); 1370 my $pbk = pp_pbkdf2($_[0], $salt, 4096, "sha1",32,64); 1371 require Crypt::Cipher::AES; 1372 my $crypt = Crypt::Cipher::AES->new($pbk); 1373 # 6b65726265726f737b9b5b2b93132b93 == 'kerberos' and 8 other bytes 1374 my $output1 = $crypt->encrypt(pack("H*","6b65726265726f737b9b5b2b93132b93")); 1375 my $output2 = $crypt->encrypt($output1); 1376 return "\$krb18\$$salt\$".unpack("H*",$output1).unpack("H*",$output2); 1377} 1378sub lp { 1379 $salt = get_salt(32, -32, \@userNames); 1380 my $pbk = pp_pbkdf2($_[0], $salt, 500, "sha256", 32, 64); 1381 require Crypt::Cipher::AES; 1382 my $crypt = Crypt::Cipher::AES->new($pbk); 1383 $h = unpack("H*", $crypt->encrypt("lastpass rocks\x02\x02")); 1384 return "\$lp\$$salt\$$h"; 1385} 1386sub lastpass { 1387 my $iter = get_loops(500); 1388 $salt = get_salt(32, -32, \@userNames); 1389 my $pbk = pp_pbkdf2($_[0], $salt, $iter, "sha256", 32, 64); 1390 require Crypt::Cipher::AES; 1391 require Crypt::CBC; 1392 my $dat = $salt; 1393 my $iv = "\0"x16; 1394 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => $pbk, -iv => $iv, -cipher => "Crypt::Cipher::AES", -header => 'none', -padding => 'null'); 1395 $h = base64($crypt->encrypt($dat)); 1396 return "\$lastpass\$$salt\$$iter\$$h"; 1397} 1398 1399sub odf { 1400 my $iv; my $content; 1401 $salt = get_salt(16); 1402 $iv = get_iv(8); 1403 my $itr = get_loops(1024); 1404 $content = get_content(-1024, -4095); 1405 my $s = sha1($_[0]); 1406 my $key = pp_pbkdf2($s, $salt, $itr, "sha1", 16,64); 1407 require Crypt::Cipher::Blowfish; 1408 require Crypt::Mode::CFB; 1409 my $crypt = Crypt::Mode::CFB->new('Blowfish'); 1410 my $output = $crypt->decrypt($content, $key, $iv); 1411 $s = sha1($output); 1412 return "\$odf\$*0*0*$itr*16*".unpack("H*",$s)."*8*".unpack("H*",$iv)."*16*".unpack("H*",$salt)."*0*".unpack("H*",$content); 1413} 1414sub odf_1 { 1415 # odf cipher type 1 (AES instead of blowfish, and some sha256, pbkdf2 is still sha1, but 32 byte of output) 1416 my $iv; my $content; 1417 $salt = get_salt(16); 1418 $iv = get_iv(16); 1419 my $itr = get_loops(1024); 1420 $content = get_content(-1024, -4095); 1421 while (length($content)%16 != 0) { $content .= "\x0" } # must be even 16 byte padded. 1422 my $s = sha256($_[0]); 1423 my $key = pp_pbkdf2($s, $salt, $itr, "sha1", 32,64); 1424 require Crypt::Cipher::AES; 1425 require Crypt::CBC; 1426 # set -padding to 'none'. Otherwise a Crypt::CBC->decrypt() padding removal will bite us, and possibly strip off bytes. 1427 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => $key, -iv => $iv, -cipher => "Crypt::Cipher::AES", -header => 'none', -padding => 'none'); 1428 my $output = $crypt->decrypt($content); 1429 $s = sha256($output); 1430 return "\$odf\$*1*1*$itr*32*".unpack("H*",$s)."*16*".unpack("H*",$iv)."*16*".unpack("H*",$salt)."*0*".unpack("H*",$content); 1431} 1432# the inverse of the DecryptUsingSymmetricKeyAlgorithm() in the JtR office format 1433sub _office_2k10_EncryptUsingSymmetricKeyAlgorithm { 1434 my ($key, $data, $len, $keysz) = @_; 1435 # we handle ALL padding. 1436 while (length($data)<$len) {$data.="\0";} $data = substr($data,0,$len); 1437 while (length($key)<$keysz) {$key.="\0";} $key = substr($key,0,$keysz); 1438 require Crypt::Cipher::AES; 1439 require Crypt::CBC; 1440 my $crypt = Crypt::CBC->new(-literal_key => 1, -keysize => $keysz, -key => $key, -iv => $salt, -cipher => "Crypt::Cipher::AES", -header => 'none', -padding => 'none'); 1441 return $crypt->encrypt($data); 1442} 1443# same function as the GenerateAgileEncryptionKey[512]() in the JtR office format 1444sub _office_2k10_GenerateAgileEncryptionKey { 1445 # 2 const values for office 2010/2013 1446 my $encryptedVerifierHashInputBlockKey = pack("H*", "fea7d2763b4b9e79"); 1447 my $encryptedVerifierHashValueBlockKey = pack("H*", "d7aa0f6d3061344e"); 1448 my $p = encode("UTF-16LE", $_[0]); 1449 my $spincount = $_[1]; 1450 my $hash_func = $_[2]; # should be sha1 or sha512 1451 no strict 'refs'; 1452 my $h = &$hash_func($salt.$p); 1453 for (my $i = 0; $i < $spincount; $i += 1) { $h = &$hash_func(Uint32LERaw($i).$h); } 1454 $_[3] = &$hash_func($h.$encryptedVerifierHashInputBlockKey); 1455 $_[4] = &$hash_func($h.$encryptedVerifierHashValueBlockKey); 1456 use strict; 1457} 1458sub office_2010 { 1459 $salt = get_salt(16); 1460 my $randdata = get_iv(16); 1461 my $spincount = get_loops(100000); 1462 my $hash1; my $hash2; 1463 _office_2k10_GenerateAgileEncryptionKey($_[1], $spincount, \&sha1, $hash1, $hash2); 1464 my $encryptedVerifier = _office_2k10_EncryptUsingSymmetricKeyAlgorithm($hash1, $randdata, 16, 128/8); 1465 my $encryptedVerifierHash = _office_2k10_EncryptUsingSymmetricKeyAlgorithm($hash2, sha1($randdata), 32, 128/8); 1466 return "\$office\$*2010*$spincount*128*16*".unpack("H*",$salt)."*".unpack("H*",$encryptedVerifier)."*".unpack("H*",$encryptedVerifierHash); 1467} 1468sub office_2013 { 1469 $salt = get_salt(16); 1470 my $randdata = get_iv(16); 1471 my $spincount = get_loops(100000); 1472 my $hash1; my $hash2; 1473 _office_2k10_GenerateAgileEncryptionKey($_[1], $spincount, \&sha512, $hash1, $hash2); 1474 my $encryptedVerifier = _office_2k10_EncryptUsingSymmetricKeyAlgorithm($hash1, $randdata, 16, 256/8); 1475 my $encryptedVerifierHash = _office_2k10_EncryptUsingSymmetricKeyAlgorithm($hash2, sha512($randdata), 32, 256/8); 1476 return "\$office\$*2013*$spincount*256*16*".unpack("H*",$salt)."*".unpack("H*",$encryptedVerifier)."*".unpack("H*",$encryptedVerifierHash); 1477} 1478sub office_2007 { 1479 $salt = get_salt(16); 1480 my $randdata = get_iv(16); 1481 my $p = encode("UTF-16LE", $_[1]); 1482 my $h = sha1($salt.$p); 1483 for (my $i = 0; $i < 50000; $i += 1) { 1484 $h = sha1(Uint32LERaw($i).$h); 1485 } 1486 $h = sha1($h."\0\0\0\0"); 1487 $h = substr(sha1($h^"6666666666666666666666666666666666666666666666666666666666666666"),0,16); 1488 require Crypt::Cipher::AES; 1489 my $crypt = Crypt::Cipher::AES->new($h); 1490 my $hash = $crypt->encrypt(substr(sha1(substr($crypt->decrypt($randdata),0,16)),0,16)); 1491 return "\$office\$*2007*20*128*16*".unpack("H*",$salt)."*".unpack("H*",$randdata)."*".unpack("H*",$hash)."00000000"; 1492} 1493sub rawmd2 { 1494 require Digest::MD2; 1495 import Digest::MD2 qw(md2); 1496 return "\$md2\$".unpack("H*",md2($_[1])); 1497} 1498sub mongodb { 1499 $salt = get_salt(16,16,\@chrHexLo); 1500 my $user = get_username(128); 1501 my $type=1; 1502 if (substr($salt, 2, 1) eq '2') {$type=0;} 1503 if(defined($argmode)) {$type=$argmode;} 1504 if ($type==0) { 1505 $h = md5_hex($user . ":mongo:" . $_[1]); 1506 return "\$mongodb\$0\$$user\$$h"; 1507 } 1508 $h = md5_hex($salt.$user.md5_hex($user . ":mongo:" . $_[1])); 1509 return "\$mongodb\$1\$$user\$$salt\$$h"; 1510} 1511sub mysqlna { 1512 $salt = get_salt(20); 1513 $h = sha1($salt.sha1(sha1($_[1]))) ^ sha1($_[1]); 1514 return "\$mysqlna\$".unpack("H*",$salt)."*".unpack("H*",$h); 1515} 1516sub o5logon { 1517 $salt = get_salt(10); 1518 my $crpt = get_content(32); 1519 my $plain = get_iv(8) . "\x08\x08\x08\x08\x08\x08\x08\x08"; 1520 my $key = sha1($_[1].$salt) . "\0\0\0\0"; 1521 require Crypt::Cipher::AES; 1522 require Crypt::CBC; 1523 my $iv = substr($crpt, 16, 16); 1524 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => $key, -keysize => 24, -iv => $iv, -cipher => 'Crypt::Cipher::AES', -header => 'none'); 1525 $crpt .= $crypt->encrypt($plain); 1526 $crpt = substr($crpt, 0, 48); 1527 $crpt = uc unpack("H*",$crpt); 1528 $salt = uc unpack("H*",$salt); 1529 return "\$o5logon\$$crpt*$salt"; 1530} 1531sub postgres { 1532 my $user = 'postgres'; 1533 $salt = get_salt(4); 1534 if (substr($salt,2,1) eq "1") {$user = get_username(64); } 1535 $h = md5_hex(md5_hex($_[1], $user).$salt); 1536 $salt = unpack("H*", $salt); 1537 return "\$postgres\$$user*$salt*$h"; 1538} 1539sub pst { 1540 my $pw = $_[0]; 1541 if (length($pw)>8) {$pw = substr($pw, 0, 8); } 1542 return "\$pst\$".unpack("H*", Uint32BERaw(crc32($pw, 0xffffffff)^0xffffffff)); 1543} 1544sub raw_blake2 { 1545 require Digest::BLAKE2; 1546 import Digest::BLAKE2 qw(blake2b); 1547 return "\$BLAKE2\$".unpack("H*",blake2b($_[1])); 1548} 1549sub rawsha3_224 { 1550 require Digest::SHA3; 1551 import Digest::SHA3 qw(sha3_224); 1552 return unpack("H*",sha3_224($_[1])); 1553} 1554sub rawsha3_256 { 1555 require Digest::SHA3; 1556 import Digest::SHA3 qw(sha3_256); 1557 return unpack("H*",sha3_256($_[1])); 1558} 1559sub rawsha3_384 { 1560 require Digest::SHA3; 1561 import Digest::SHA3 qw(sha3_384); 1562 return unpack("H*",sha3_384($_[1])); 1563} 1564sub rawsha3_512 { 1565 require Digest::SHA3; 1566 import Digest::SHA3 qw(sha3_512); 1567 return unpack("H*",sha3_512($_[1])); 1568} 1569sub raw_keccak { 1570 require Digest::Keccak; 1571 import Digest::Keccak qw(keccak_512); 1572 return "\$keccak\$".unpack("H*",keccak_512($_[1])); 1573} 1574sub raw_keccak256 { 1575 require Digest::Keccak; 1576 import Digest::Keccak qw(keccak_256); 1577 return "\$keccak256\$".unpack("H*",keccak_256($_[1])); 1578} 1579sub leet { 1580 my $u = get_username(20); 1581 my $h = unpack("H*", sha512($_[0].$u) ^ whirlpool($u.$_[0])); 1582 $out_username = $u; 1583 return "$u\$$h"; 1584} 1585sub siemens_s7 { 1586 $salt = get_salt(20); 1587 $h = Digest::SHA::hmac_sha1($salt, sha1($_[1])); 1588 $salt = unpack("H*",$salt); 1589 $h = unpack("H*",$h); 1590 return "\$siemens-s7\$1\$$salt\$$h"; 1591} 1592sub ssha512 { 1593 $salt = get_salt(8, -16); 1594 $h = sha512($_[1].$salt); 1595 return "{ssha512}".base64($h.$salt); 1596} 1597sub tcp_md5 { 1598 $salt = get_salt(32); 1599 $h = md5($salt.$_[1]); 1600 $h = unpack("H*",$h); 1601 $salt = unpack("H*",$salt); 1602 return "\$tcpmd5\$$salt\$$h"; 1603} 1604sub known_hosts { 1605 # simple hmac-sha1, BUT salt and pw are used in wrong order, and password is usually some host or IP, BUT 1606 # it does not matter if it is an IP or not. Still works fine regardless. 1607 $salt = get_salt(20); 1608 $h = Digest::SHA::hmac_sha1($_[1], $salt); 1609 $salt = base64($salt); 1610 $h = base64($h); 1611 return "\$known_hosts\$|1|$salt|$h"; 1612} 1613sub strip { 1614 $salt = get_salt(16); 1615 my $iv = get_iv(16); 1616 my $key = pp_pbkdf2($_[0], $salt, 4000, \&sha1, 32, 64); 1617 # this is the decrypted data from JtR's openwall password test string. 1618 my $dat = "\x04\0\x01\x01\x10\x40\x20\x20\x1a\x4f\xed\x2b\0\0\0\x2d\0\0\0\0\0\0\0\0\0\0\0\x25\0\0\0\x04\0\0\0\0\0\0\0\0\0\0\0\x01\0\0\0\x07\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\x1a\x4f\xed\x2b\x00\x2d\xe2\x24\x05\x00\x00\x00\x0a\x03\xbe\x00\x00\x00\x00\x2c\x03\xeb\x03\xe6\x03\xe1\x03\xdc\x03\xd7\x03\xd2\x03\xcd\x03\xc8\x03\xc3\x03\xbe"; 1619 $dat .= "\0"x828; 1620 $dat .= "\x00\x2b\x29\x00\x00\x00\x29\x27\x00\x00\x00\x27\x25\x00\x00\x00\x26\x23\x00\x00\x00\x24\x21\x00\x00\x00\x22\x1f\x00\x00\x00\x21\x1d\x00\x00\x00\x18\x1a\x00\x00\x00\x0d\x12\x00\x00\x00\x0a\x08"; 1621 require Crypt::Cipher::AES; 1622 require Crypt::CBC; 1623 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => $key, -keysize => 32, -iv => $iv, -cipher => 'Crypt::Cipher::AES', -header => 'none'); 1624 $h = substr($crypt->encrypt($dat), 0, 32+960); 1625 $salt = unpack("H*",$salt); 1626 $h = unpack("H*",$h); 1627 $iv = unpack("H*", $iv); 1628 return "\$strip\$*$salt$h$iv"; 1629} 1630sub _tc_build_buffer { 1631 # build a special TC buffer. 448 bytes, 2 spots have CRC32. Lots of null, etc. 1632 my $buf = 'TRUE'."\x00\x05\x07\x00". "\x00"x184 . randstr(64) . "\x00"x192; 1633 my $crc1 = crc32(substr($buf, 192, 256)); 1634 substr($buf, 8, 4) = Uint32BERaw($crc1); 1635 my $crc2 = crc32(substr($buf, 0, 188)); 1636 substr($buf, 188, 4) = Uint32BERaw($crc2); 1637 return $buf; 1638} 1639# I looked high and low for a Perl implementation of AES-256-XTS and 1640# could not find one. This may be the first implementation in Perl, ever. 1641sub _aes_xts { 1642 # a dodgy, but working XTS implementation. (encryption). To do decryption 1643 # simply do $cipher1->decrypt($tmp) instead of encrypt. That is the only diff. 1644 # switched to do both 256 and 128 bit AES ($_[3]) and can also handle decryption 1645 # and not just encryption ($_[4] set to 1 will decrypt) 1646 my $bytes = 32; # AES 256 1647 if ($_[3] == 128) { $bytes = 16; } 1648 my $key1 = substr($_[0],0,$bytes); my $key2 = substr($_[0],$bytes,$bytes); 1649 my $d; my $c = $_[1]; # $c=cleartext MUST be a multiple of 16. 1650 my $num = length($c) / 16; 1651 my $t = $_[2]; # tweak (must be provided) 1652 my $decr = $_[4]; 1653 if (!defined($decr)) { $decr = 0; } 1654 require Crypt::Cipher::AES; 1655 my $cipher1 = new Crypt::Cipher::AES($key1); 1656 my $cipher2 = new Crypt::Cipher::AES($key2); 1657 $t = $cipher2->encrypt($t); 1658 for (my $cnt = 0; ; ) { 1659 my $tmp = substr($c, 16*$cnt, 16); 1660 $tmp ^= $t; 1661 if ($decr != 0) { 1662 $tmp = $cipher1->decrypt($tmp); 1663 } else { 1664 $tmp = $cipher1->encrypt($tmp); 1665 } 1666 $tmp ^= $t; 1667 $d .= $tmp; 1668 $cnt += 1; 1669 if ($cnt == $num) { return ($d); } 1670 # do the mulmod in GF(2) 1671 my $Cin=0; my $Cout; my $x; 1672 for ($x = 0; $x < 16; $x += 1) { 1673 $Cout = ((ord(substr($t,$x,1)) >> 7) & 1); 1674 substr($t,$x,1) = chr(((ord(substr($t,$x,1)) << 1) + $Cin) & 0xFF); 1675 $Cin = $Cout; 1676 } 1677 if ($Cout != 0) { 1678 substr($t,0,1) = chr(ord(substr($t,0,1))^135); 1679 } 1680 } 1681} 1682sub _tc_aes_128_xts { 1683 # a dodgy, but working XTS implementation. (encryption). To do decryption 1684 # simply do $cipher1->decrypt($tmp) instead of encrypt. That is the only diff. 1685 my $key1 = substr($_[0],0,16); my $key2 = substr($_[0],16,16); 1686 my $d; my $c = $_[1]; # $c=cleartext MUST be a multiple of 16. 1687 my $num = length($c) / 16; 1688 my $t = $_[2]; # tweak (must be provided) 1689 my $decr = $_[3]; 1690 if (!defined($decr)) { $decr = 0; } 1691 require Crypt::Cipher::AES; 1692 my $cipher1 = new Crypt::Cipher::AES($key1); 1693 my $cipher2 = new Crypt::Cipher::AES($key2); 1694 $t = $cipher2->encrypt($t); 1695 for (my $cnt = 0; ; ) { 1696 my $tmp = substr($c, 16*$cnt, 16); 1697 $tmp ^= $t; 1698 if ($decr != 0) { 1699 $tmp = $cipher1->decrypt($tmp); 1700 } else { 1701 $tmp = $cipher1->encrypt($tmp); 1702 } 1703 $tmp ^= $t; 1704 $d .= $tmp; 1705 $cnt += 1; 1706 if ($cnt == $num) { return ($d); } 1707 # do the mulmod in GF(2) 1708 my $Cin=0; my $Cout; my $x; 1709 for ($x = 0; $x < 16; $x += 1) { 1710 $Cout = ((ord(substr($t,$x,1)) >> 7) & 1); 1711 substr($t,$x,1) = chr(((ord(substr($t,$x,1)) << 1) + $Cin) & 0xFF); 1712 $Cin = $Cout; 1713 } 1714 if ($Cout != 0) { 1715 substr($t,0,1) = chr(ord(substr($t,0,1))^135); 1716 } 1717 } 1718} 1719sub tc_ripemd160 { 1720 $salt = get_salt(64); 1721 my $h = pp_pbkdf2($_[0], $salt, 2000, \&ripemd160, 64, 64); 1722 my $d = _tc_build_buffer(); 1723 my $tweak = "\x00"x16; #first block of file 1724 $h = _aes_xts($h,$d,$tweak,256); 1725 return "truecrypt_RIPEMD_160\$".unpack("H*",$salt).unpack("H*",$h); 1726} 1727sub tc_sha512 { 1728 $salt = get_salt(64); 1729 my $h = pp_pbkdf2($_[0], $salt, 1000, \&sha512, 64, 128); 1730 my $d = _tc_build_buffer(); 1731 my $tweak = "\x00"x16; #first block of file 1732 $h = _aes_xts($h,$d,$tweak,256); 1733 return "truecrypt_SHA_512\$".unpack("H*",$salt).unpack("H*",$h); 1734} 1735sub tc_whirlpool { 1736 $salt = get_salt(64); 1737 my $h = pp_pbkdf2($_[0], $salt, 1000, \&whirlpool, 64, 64); # note, 64 byte ipad/opad (oSSL is buggy?!?!) 1738 my $d = _tc_build_buffer(); 1739 my $tweak = "\x00"x16; #first block of file 1740 $h = _aes_xts($h,$d,$tweak,256); 1741 return "truecrypt_WHIRLPOOL\$".unpack("H*",$salt).unpack("H*",$h); 1742} 1743sub dahua { 1744 my $h = md5($_[1]); 1745 # compressor 1746 my @a = split(//, $h); 1747 $h = ""; 1748 for (my $i = 0; $i < 16; $i += 2) { 1749 my $x = (ord($a[$i])+ord($a[$i+1])) % 62; 1750 if ($x < 10) { $x += 48; } 1751 elsif ($x < 36) { $x += 55; } 1752 else { $x += 61; } 1753 $h .= chr($x); 1754 } 1755 return "\$dahua\$$h"; 1756} 1757sub ripemd_128 { 1758 return "\$ripemd\$".ripemd128_hex($_[0]); 1759} 1760sub ripemd_160 { 1761 return "\$ripemd\$".ripemd160_hex($_[0]); 1762} 1763sub rsvp { 1764 $salt = get_salt(16, -8192); 1765 my $mode = 1; 1766 my $h; 1767 if (defined $argmode) {$mode=$argmode;} # 1 or 2 1768 # note, password and salt are 'reversed' in the hmac. 1769 if ($mode == 1) { 1770 $h = _hmacmd5($_[0], $salt); 1771 } else { 1772 $h = _hmacsha1($_[0], $salt); 1773 } 1774 return "\$rsvp\$$mode\$".unpack("H*",$salt).'$'.unpack("H*",$h); 1775} 1776sub sap_h { 1777 $salt = get_salt(12, -16); 1778 my $mode = "sha1"; 1779 my $iter = get_loops(1024); 1780 if (defined $argmode) {$mode=$argmode;} # must be sha1 sha256 sha384 or sha512 1781 my $modestr; 1782 if ($mode eq "sha1") { $modestr = "sha"; } 1783 elsif ($mode eq "sha256") { $modestr = "SHA256"; } 1784 elsif ($mode eq "sha384") { $modestr = "SHA384"; } 1785 elsif ($mode eq "sha512") { $modestr = "SHA512"; } 1786 else { print STDERR "invalid mode used for SAP-H [$mode] is not valid\n"; exit 0; } 1787 no strict 'refs'; 1788 my $h = &$mode($_[0].$salt); 1789 for (my $i = 1; $i < $iter; $i++) { 1790 $h = &$mode($_[0].$h); 1791 } 1792 use strict; 1793 return "{x-is$modestr, $iter}".base64($h.$salt); 1794} 1795sub bb_es10 { 1796 # 101x sha512, Blackberry, es10 server. 1797 $salt = get_salt(8); 1798 $h = sha512($_[1].$salt); 1799 for (my $i = 0; $i < 99; $i++) { 1800 $h = sha512($h); 1801 } 1802 $h = uc unpack("H*",$h); 1803 return "\$bbes10\$$h\$$salt"; 1804} 1805sub citrix_ns10 { 1806 $salt = get_salt(8, 8, \@chrHexLo); 1807 $h = sha1($salt.$_[0]."\0"); 1808 return "1$salt".unpack("H*",$h); 1809} 1810sub chap { 1811 $salt = get_salt(16); 1812 my $h = md5("\0" . $_[1] . $salt); 1813 $salt = unpack("H*",$salt); 1814 $h = unpack("H*",$h); 1815 return "\$chap\$0*$salt*$h"; 1816} 1817sub fortigate { 1818 $salt = get_salt(12); 1819 $h = sha1($salt.$_[1]."\xa3\x88\xba\x2e\x42\x4c\xb0\x4a\x53\x79\x30\xc1\x31\x07\xcc\x3f\xa1\x32\x90\x29\xa9\x81\x5b\x70"); 1820 return "AK1".base64($salt.$h); 1821} 1822sub zip { 1823 # NOTE ,the zip contents are garbage, but we do not care. We simply 1824 # run the hmac-sha1 over it and compare to the validator (in JtR), so 1825 # we simply have designed this to build hashes that are 'jtr' valid. 1826 my $mode; my $sl; my $kl; my $chksum; my $content; my $hexlen; 1827 if (defined $argmode) {$mode=$argmode;} else { $mode=int(rand(3))+1; } 1828 if ($mode==1) { $sl = 8; } 1829 elsif ($mode==2) { $sl = 12; } 1830 else { $mode = 3; $sl = 16; } 1831 $kl = $sl*2; 1832 $salt = get_salt($sl); 1833 $content = get_content(96,-4096); 1834 $h = pp_pbkdf2($_[0], $salt, 1000, "sha1", 2*$kl+2, 64); 1835 $chksum = substr($h,2*$kl,2); 1836 my $bin = _hmac_shas(\&sha1, 64, substr($h,$kl,$kl), $content); 1837 $hexlen = sprintf("%x", length($content)); 1838 return "\$zip2\$*0*$mode*0*".unpack("H*",$salt)."*".unpack("H*",$chksum)."*$hexlen*".unpack("H*",$content)."*".substr(unpack("H*",$bin),0,20)."*\$/zip2\$"; 1839} 1840sub _gen_key_rar4 { 1841 # return final output generated by rar4. 1842 my ($pw, $salt, $raw_input, $iv, $raw, $i) = ($_[0], $_[1], $_[2], "", "", 0); 1843 for (my $k = 0; $k < length($_[0]); $k += 1) { $raw .= substr($_[0], $k, 1); $raw .= "\0"; } 1844 $raw .= $salt; 1845 my $ctx = Digest::SHA->new('SHA1'); 1846 while ($i < 0x40000) { 1847 # this could probably be done faster by simply modifying bytes, 1848 # of the $i in BE format, but it is not too bad, and this 'works' 1849 my $work = $raw; 1850 $work .= chr($i & 0xFF); 1851 $work .= chr( ($i>>8) & 0xFF); 1852 $work .= chr( ($i>>16) & 0xFF); 1853 $ctx->add($work); 1854 if ( ($i&0x3fff) == 0) { # first and every 16384 loops, grab 1 byte of IV from that digest 1855 $h = $ctx->clone->digest; # we MUST use clone() to not modify the ctx 1856 $iv .= substr($h, 19,1); 1857 } 1858 $i += 1; 1859 } 1860 my $key = substr($ctx->digest, 0, 16); # key is first 16 bytes (swapped) 1861 $key = pack("V*", unpack("N*",$key)); # swap the 4 uint32_t values. 1862 1863 require Crypt::Cipher::AES; 1864 require Crypt::CBC; 1865 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => $key, -keysize => 16, -iv => $iv, -cipher => 'Crypt::Cipher::AES', -header => 'none'); 1866 while (length($raw_input) % 16 != 0) { $raw_input .= "\x00"; } 1867 return $crypt->encrypt($raw_input); 1868} 1869sub rar { 1870 # for rar version 4 archives (both -p (compressed or stored) and -hp) 1871 my $content; my $contentlen; my $contentpacklen; my $crc; my $type = "33"; 1872 $salt = get_salt(8); 1873 my $rnd = int(rand(10)); 1874 my @ar; 1875 if (defined $argmode) { $rnd = $argmode; } 1876 # first 7 are compressed files. 8th is stored file. 9-10 are type -hp 1877 # using command line arg: '-content=7' would force only doing stored file -content=2 would force file 2, 1878 # and -content=xxx or anything other than 0 to 7 would force -hp mode. 1879 if ($rnd == 0) { 1880 # the format of the string is crc~len~rarpackbuffer the rarpackbuffer is NOT encrypted. We put that into an array, and later pull it out. 1881 @ar = split("~", "b54415c5~46~0bc548bdd40d37b8578f5b39a3c022c11115d2ce1fb3d8f9c548bbddb5dfb7a56c475063d6eef86f2033f6fe7e20a4a24590e9f044759c4f0761dbe4"); 1882 } elsif ($rnd == 1) { 1883 @ar = split("~", "e90c7d49~28~0c0108be90bfb0a204c9dce07778e0700dfdbffeb056af47a8d305370ec39e95c87c7d"); 1884 } elsif ($rnd == 2) { 1885 @ar = split("~", "d3ec3a5e~54~09414c8fe50fbb85423de8e4694b222827da16cdfef463c52e29ef6ad1608b42e72884766c17f8527cefabb68c8f1daed4c6079ea715387c80"); 1886 } elsif ($rnd == 3) { 1887 @ar = split("~", "d85f3c19~142~0951148d3e11372f0a41e03270586689a203a24de9307ec104508af7f842668c4905491270ebabbbae53775456cf7b8795496201243e397cb8c6c0f78cb235303dd513853ffad6afc9bf5806e9cd6e0e3db4f82fc72b4ff10488beb8cdc2b6a545159260e47e891ec8"); 1888 } elsif ($rnd == 4) { 1889 @ar = split("~", "b1e45656~82~090010cbe4cee6615e497b83a208d0a308ca5abc48fc2404fa204dfdbbd80e00e09d6f6a8c9c4fa2880ef8bb86bc5ba60fcb676a398a99f44ccaefdb4c498775f420be69095f25a09589b1aaf1"); 1890 } elsif ($rnd == 5) { 1891 @ar = split("~", "965f1453~47~09414c93e4cef985416f472549220827da3ba6fed8ad28e29ef6ad170ad53a69051e9b06f439ef6da5df8670181f7eb2481650"); 1892 } elsif ($rnd == 6) { 1893 @ar = split("~", "51699729~27~100108be8cb7614409939cf2298079cbedfdbfec5e33d2b148c388be230259f57ddbe8"); 1894 } elsif ($rnd == 7) { 1895 $type = "30"; 1896 $content = randstr(int(rand(32))+int(rand(32))+16); 1897 $contentlen=length($content); 1898 my $crcs = sprintf("%08x", crc32($content)); # note, rar_fmt/rar2john F's up the byte order!! so we have to match what it expects. 1899 $crc = substr($crcs,6).substr($crcs,4,2).substr($crcs,2,2).substr($crcs,0,2); 1900 @ar = ($crc, $contentlen, unpack("H*", $content)); 1901 } else { 1902 # do -hp type here. 1903 my $output = _gen_key_rar4($_[0], $salt, "\xc4\x3d\x7b\x00\x40\x07\x00"); 1904 return "\$RAR3\$*0*".unpack("H*",$salt)."*".unpack("H*",substr($output,0,16)); 1905 } 1906 # common final processing for -p rar (-hp returns before getting here). 1907 $crc = $ar[0]; 1908 $contentlen = $ar[1]; 1909 $content = pack("H*", $ar[2]); 1910 $contentpacklen = length($content) + 16-length($content)%16; 1911 my $output = _gen_key_rar4($_[0], $salt, $content); 1912 return "\$RAR3\$*1*".unpack("H*",$salt)."*$crc*$contentpacklen*$contentlen*1*".unpack("H*",substr($output,0,$contentpacklen))."*$type"; 1913} 1914sub ecryptfs { 1915 my $rndsalt=0; 1916 if ($u % 5 == 0) { # every 5th hash gets a random salt. 1917 $rndsalt = 1; 1918 $salt = get_salt(8); 1919 } else { $salt = pack("H*", "0011223344556677"); } 1920 $h = sha512($salt.$_[0]); 1921 for (my $i = 0; $i < 65536; $i += 1) { 1922 $h = sha512($h); 1923 } 1924 if ($rndsalt == 0) { 1925 return '$ecryptfs$0$'.substr(unpack("H*",$h),0,16); 1926 } 1927 return '$ecryptfs$0$1$'.unpack("H*",$salt).'$'.substr(unpack("H*",$h),0,16); 1928} 1929sub sip { 1930 my $IPHead = "192.168." . (int(rand(253))+1) . "."; 1931 my $serverIP = $IPHead . (int(rand(253))+1); 1932 my $clientIP = $IPHead . (int(rand(253))+1); 1933 my $user = randstr(5, \@chrAsciiNum); 1934 my $realm = "asterisk"; 1935 my $method = "REGISTER"; 1936 my $URIpart1 = "sip"; 1937 my $nonce = randstr(8, \@chrHexLo); 1938 my $uri = "$URIpart1:$clientIP"; 1939 1940 my $static_hash = md5_hex($method.":".$uri); 1941 my $dynamic_hash_data = "$user:$realm:"; 1942 my $static_hash_data = ":$nonce:$static_hash"; 1943 my $dyna_hash = md5_hex($dynamic_hash_data.$_[0]); 1944 my $h = md5_hex($dyna_hash.$static_hash_data); 1945 return "\$sip\$*$serverIP*$clientIP*$user*$realm*$method*$URIpart1*$clientIP**$nonce****MD5*$h"; 1946} 1947 1948sub sip_qop { 1949 my $IPHead = "192.168." . (int(rand(253))+1) . "."; 1950 my $serverIP = $IPHead . (int(rand(253))+1); 1951 my $clientIP = $IPHead . (int(rand(253))+1); 1952 my $user = randstr(5, \@chrAsciiNum); 1953 my $realm = "asterisk"; 1954 my $method = "REGISTER"; 1955 my $URIpart1 = "sip"; 1956 my $nonce = randstr(32, \@chrHexLo); 1957 my $uri = "$URIpart1:$clientIP"; 1958 my $qop = "auth"; 1959 my $nonce_count = "00000001"; 1960 my $cnonce = randstr(8, \@chrHexLo); 1961 1962 my $static_hash = md5_hex($method.":".$uri); 1963 my $dynamic_hash_data = "$user:$realm:"; 1964 my $static_hash_data = ":$nonce:$nonce_count:$cnonce:$qop:$static_hash"; 1965 my $dyna_hash = md5_hex($dynamic_hash_data.$_[0]); 1966 my $h = md5_hex($dyna_hash.$static_hash_data); 1967 return "\$sip\$*$serverIP*$clientIP*$user*$realm*$method*$URIpart1*$clientIP**$nonce*$cnonce*$nonce_count*$qop*MD5*$h"; 1968} 1969 1970sub bitlocker { 1971 require Crypt::AuthEnc::CCM; 1972 my $itr = get_loops(1048576); 1973 my $salt = get_salt(16,16,\@chrHexLo); 1974 my $iv = get_iv(12); 1975 # data taken from sample test hash in JtR bitlocker format, after decrypt. 1976 my $data = pack("H*","9a0bd9fbcb83988509088b435f1058fd2c000000010000000320000029a9df35315149afb5613e97f48ba8efbc9f2a1fd041dd019df1db87a1a29e1f"); 1977 my $pwd = encode("UTF-16LE", $_[1]); 1978 my $h = sha256($pwd); $h = sha256($h); 1979 # do kdf code 1980 my $i; 1981 my $last = "\0" x 32; 1982 for ($i = 0; $i < $itr; ++$i) { 1983 $last = sha256($last, $h, $salt, Uint64LERaw($i)); 1984 } 1985 $h = $last; 1986 # end of kdf code 1987 print unpack("H*", $h)."\n"; 1988 # we have the key. we have the IV, we have the unenc data. Now we just have 1989 # to properly encrypt it, then return the proper hash string. 1990 1991# my $ae = Crypt::AuthEnc::CCM->new("AES", $h, $iv, $data, $tag_len, $pt_len); 1992# my $ct = $ae->encrypt_add('data1'); 1993# $ct .= $ae->encrypt_add('data2'); 1994# $ct .= $ae->encrypt_add('data3'); 1995# my $tag = $ae->encrypt_done(); 1996 1997# exit(0); 1998} 1999 2000sub money_md5 { 2001 require Crypt::RC4; 2002 import Crypt::RC4 qw(RC4); 2003 my $pw = $_[0]; 2004 my $i; 2005 my $salt = get_salt(8); 2006 for ($i = 0; $i < length $pw; ++$i) { 2007 my $c = substr($pw, $i, 1); 2008 if ( ord($c) >= ord('a') && ord($c) <= ord('z')) { 2009 $c = chr(ord($c)-0x20); 2010 } 2011 $c = chr(ord($c) % 0x80); 2012 substr($pw, $i, 1) = $c; 2013 } 2014 while (length($pw) < 20) { $pw .= "\0"; } 2015 $pw = encode("UTF-16LE", $pw); 2016 my $h = md5($pw); 2017 my $enc = RC4($h.$salt, substr($salt, 0, 4)); 2018 return "\$money\$0*".unpack("H*", $salt)."*".unpack("H*", $enc); 2019} 2020sub money_sha1 { 2021 require Crypt::RC4; 2022 import Crypt::RC4 qw(RC4); 2023 my $pw = $_[0]; 2024 my $i; 2025 my $salt = get_salt(8); 2026 for ($i = 0; $i < length $pw; ++$i) { 2027 my $c = substr($pw, $i, 1); 2028 if ( ord($c) >= ord('a') && ord($c) <= ord('z')) { 2029 $c = chr(ord($c)-0x20); 2030 } 2031 $c = chr(ord($c) % 0x80); 2032 substr($pw, $i, 1) = $c; 2033 } 2034 while (length($pw) < 20) { $pw .= "\0"; } 2035 $pw = encode("UTF-16LE", $pw); 2036 my $h = sha1($pw); 2037 my $enc = RC4(substr($h,0,16).$salt, substr($salt, 0, 4)); 2038 return "\$money\$1*".unpack("H*", $salt)."*".unpack("H*", $enc); 2039} 2040 2041############################################################################## 2042# stub functions. When completed, move the function out of this section 2043############################################################################## 2044sub pfx { 2045} 2046sub keepass { 2047} 2048sub ike { 2049} 2050sub afs { 2051} 2052sub cq { 2053} 2054sub dmg { 2055} 2056sub dominosec { 2057} 2058#{"$encfs$192*181474*0*20*f1c413d9a20f7fdbc068c5a41524137a6e3fb231*44*9c0d4e2b990fac0fd78d62c3d2661272efa7d6c1744ee836a702a11525958f5f557b7a973aaad2fd14387b4f", "openwall"}, 2059#{"$encfs$128*181317*0*20*e9a6d328b4c75293d07b093e8ec9846d04e22798*36*b9e83adb462ac8904695a60de2f3e6d57018ccac2227251d3f8fc6a8dd0cd7178ce7dc3f", "Jupiter"}, 2060#{"$encfs$256*714949*0*20*472a967d35760775baca6aefd1278f026c0e520b*52*ac3b7ee4f774b4db17336058186ab78d209504f8a58a4272b5ebb25e868a50eaf73bcbc5e3ffd50846071c882feebf87b5a231b6", "Valient Gough"}, 2061#{"$encfs$256*120918*0*20*e6eb9a85ee1c348bc2b507b07680f4f220caa763*52*9f75473ade3887bca7a7bb113fbc518ffffba631326a19c1e7823b4564ae5c0d1e4c7e4aec66d16924fa4c341cd52903cc75eec4", "Alo3San1t@nats"}, 2062#unsigned int keySize; 2063#unsigned int iterations; 2064#unsigned int cipher; 2065#unsigned int saltLen; 2066#unsigned char salt[40]; 2067#unsigned int dataLen; 2068#unsigned char data[128]; 2069#unsigned int ivLength; 2070sub encfs { 2071 # this format sux. Skipping it :( 2072 my $salt = get_salt(20); 2073 $salt = pack("H*","f1c413d9a20f7fdbc068c5a41524137a6e3fb231"); 2074 my $iter = 180000 + int(rand(50000)); 2075 $iter = 181474; 2076 my $key_sz = 128 + 64*int(rand(3)); # 128, 192, 256 2077 my $data = pack("H*", "9c0d4e2b990fac0fd78d62c3d2661272efa7d6c1744ee836a702a11525958f5f557b7a973aaad2fd14387b4f"); 2078 my $iv_len = 16; 2079 my $datlen = length($data); 2080 $key_sz = 192; 2081 my $chksum1 = 0; 2082 for (my $i = 0; $i < 4; ++$i) { 2083 $chksum1 = ($chksum1<<8) + ord(substr($data, $i, 1)); 2084 } 2085 my $h = pp_pbkdf2($_[0], $salt,$iter,"sha1",$key_sz/8+$iv_len, 64); 2086 2087 # setup iv and seed 2088 my $seed = $chksum1 + 1; 2089 my $iv = substr($h, $key_sz/8); 2090 for (my $i = 0; $i < 8; ++$i) { 2091 $iv .= chr($seed & 0xFF); 2092 $seed >>= 8; 2093 } 2094 $iv = substr(Digest::SHA::hmac_sha1(substr($iv,0,24), substr($h,0,$key_sz/8)), 0, 16); 2095 2096 require Crypt::Cipher::AES; 2097 require Crypt::Mode::CFB; # Should be CFB64, not sure how to set? 2098 $h = substr($h, 0, 24); 2099 print "key=".unpack("H*",$h)."\n"; 2100 print "iv=".unpack("H*",$iv)."\n"; 2101 my $crypt = Crypt::Mode::CFB->new('AES'); 2102 my $h2 = $crypt->decrypt(substr($data,4), $h, $iv); 2103 print unpack("H*", substr($data,4))." ".unpack("H*", $h2)."\n"; 2104 2105 2106 $salt = unpack("H*",$salt); $data = unpack("H*",$data); 2107 return "\$encfs\$$key_sz*$iter*0*20*$salt*$datlen*$data"; 2108} 2109sub fde { 2110} 2111sub gpg { 2112} 2113sub haval_128 { 2114} 2115sub haval_256 { 2116 # NOTE, haval is busted in perl at this time. 2117 #print "u$u-haval256_3:".haval256_hex($_[0]).":$u:0:$_[0]::\n"; 2118} 2119sub krb4 { 2120} 2121sub krb5 { 2122} 2123sub kwallet { 2124} 2125sub luks { 2126} 2127sub raw_skein_256 { 2128 # NOTE, uses v1.2 of this hash, while JtR uses v 1.3. They are NOT compatible! 2129# require Digest::Skein; 2130# import Digest::Skein qw(skein_256); 2131# print "u$u:\$skein\$".unpack("H*",skein_256($_[1])).":$u:0:$_[0]::\n"; 2132} 2133sub raw_skein_512 { 2134 # NOTE, uses v1.2 of this hash, while JtR uses v 1.3. They are NOT compatible! 2135# require Digest::Skein; 2136# import Digest::Skein qw(skein_512); 2137# print "u$u:\$skein\$".unpack("H*",skein_512($_[1])).":$u:0:$_[0]::\n"; 2138} 2139sub ssh { 2140} 2141sub rar5 { 2142} 2143sub pdf { 2144} 2145sub pkzip { 2146} 2147sub oldoffice { 2148} 2149sub openbsd_softraid { 2150} 2151sub openssl_enc { 2152} 2153sub openvms { 2154} 2155sub panama { 2156} 2157sub putty { 2158} 2159sub ssh_ng { 2160} 2161sub sybase_prop { 2162} 2163sub tripcode { 2164} 2165sub whirlpool0 { 2166} 2167sub whirlpool1 { 2168} 2169# New ones. 2170sub _7z { 2171} 2172sub axcrypt { 2173#formats can be: 2174#$axcrypt$*version*iterations*salt*wrappedkey 2175#$axcrypt$*version*iterations*salt*wrappedkey*key-file 2176#$axcrypt$*1*1337*0fd9e7e2f907f480f8af162564f8f94b*af10c88878ba4e2c89b12586f93b7802453121ee702bc362 : Bab00nmoNCo|\|2$inge 2177#$axcrypt$*1*38574*ce4f58c1e85df1ea921df6d6c05439b4*3278c3c730f7887b1008e852e59997e2196710a5c6bc1813*66664a6b2074434a4520374d73592055626979204a6b755520736d6b4b20394e694a205548444320524578562065674b33202f42593d : 0v3rgo2|<fc! 2178#return "\$axcrypt\$*1*$iter*$salt*$h"; 2179} 2180sub bks { 2181} 2182sub dmd5 { 2183} 2184sub dominosec8 { 2185} 2186sub krb5_tgs { 2187} 2188sub lotus5 { 2189} 2190sub lotus85 { 2191} 2192sub net_md5 { 2193} 2194sub net_sha1 { 2195} 2196sub netsplitlm { 2197} 2198sub oracle12c { 2199} 2200sub pem { 2201} 2202sub pomelo { 2203} 2204sub sapb { 2205 my $BCODE = "\x14\x77\xf3\xd4\xbb\x71\x23\xd0\x03\xff\x47\x93\x55\xaa\x66\x91". 2206 "\xf2\x88\x6b\x99\xbf\xcb\x32\x1a\x19\xd9\xa7\x82\x22\x49\xa2\x51". 2207 "\xe2\xb7\x33\x71\x8b\x9f\x5d\x01\x44\x70\xae\x11\xef\x28\xf0\x0d"; 2208 my $TRANS = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". 2209 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". 2210 "\x3f\x40\x41\x50\x43\x44\x45\x4b\x47\x48\x4d\x4e\x54\x51\x53\x46". 2211 "\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x56\x55\x5c\x49\x5d\x4a". 2212 "\x42\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f". 2213 "\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x58\x5b\x59\xff\x52". 2214 "\x4c\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f". 2215 "\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x57\x5e\x5a\x4f\xff". 2216 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". 2217 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". 2218 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". 2219 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". 2220 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". 2221 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". 2222 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff". 2223 "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"; 2224 $out_username = uc get_username(12); 2225 my $pw = $_[1]; 2226 # note length=0 password fails, who cares! 2227 if (length $pw > 8) { $pw = substr($pw, 0, 8); } 2228 # convert password into 'translated' password 2229 my @arp = unpack("C*", $pw); 2230 my $pass_tr = ""; for ($h = 0; $h < length $pw; ++$h) { $pass_tr .= substr($TRANS, $arp[$h]%256, 1); } 2231 # convert username (salt) into 'translated' username 2232 my @ars = unpack("C*", $out_username); 2233 my $user_tr = ""; for ($h = 0; $h < length $out_username; ++$h) { $user_tr .= substr($TRANS, $ars[$h]%256, 1); } 2234 2235 $h = md5($pass_tr.$user_tr); 2236 2237 # wald0rf_magic crap (from sapB_fmt_plug.c) 2238 my @arh = unpack("C*", $h); 2239 my $sum20 = $arh[0]%4+$arh[1]%4+$arh[2]%4+$arh[3]%4+$arh[5]%4+0x20; 2240 my $destArray = ""; # we build $sum20 byts of destArray, using tralated password, username and the BCODE array 2241 my $I1=0; my $I3=0; # the I2 variable is simply current length of destArray 2242 while (length $destArray < $sum20) { 2243 if ($I1 < length($pw)) { 2244 if ($arh[15-$I1] % 2) { 2245 $destArray .= substr($BCODE, 0x30-$I1-1, 1); 2246 } 2247 $destArray .= substr($pass_tr, $I1++, 1); 2248 } 2249 if ($I3 < length $out_username) { 2250 $destArray .= substr($user_tr, $I3++, 1); 2251 } 2252 $destArray .= substr($BCODE, length($destArray) - $I1 - $I3, 1); 2253 $destArray .= "\0"; 2254 } 2255 # note, the wald0r_magic can give us 1 byte too much, for some $sum20 values. Fix if needed. 2256 if (length $destArray > $sum20) { $destArray = substr($destArray, 0, $sum20); } 2257 # end of wald0rf_magic crap 2258 2259 $h = md5($destArray); 2260 my @ar = unpack("C*", $h); 2261 $h = ""; 2262 for ($I1 = 0; $I1 < 8; ++$I1) { 2263 $h .= chr($ar[$I1] ^ $ar[$I1+8]); 2264 } 2265 return "$out_username\$". uc unpack("H*",$h); 2266} 2267sub sapg { 2268 my $CODVNG = "\x91\xAC\x51\x14\x9F\x67\x54\x43\x24\xE7\x3B\xE0\x28\x74\x7B\xC2". 2269 "\x86\x33\x13\xEB\x5A\x4F\xCB\x5C\x08\x0A\x73\x37\x0E\x5D\x1C\x2F". 2270 "\x33\x8F\xE6\xE5\xF8\x9B\xAE\xDD\x16\xF2\x4B\x8D\x2C\xE1\xD4\xDC". 2271 "\xB0\xCB\xDF\x9D\xD4\x70\x6D\x17\xF9\x4D\x42\x3F\x9B\x1B\x11\x94". 2272 "\x9F\x5B\xC1\x9B\x06\x05\x9D\x03\x9D\x5E\x13\x8A\x1E\x9A\x6A\xE8". 2273 "\xD9\x7C\x14\x17\x58\xC7\x2A\xF6\xA1\x99\x63\x0A\xD7\xFD\x70\xC3". 2274 "\xF6\x5E\x74\x13\x03\xC9\x0B\x04\x26\x98\xF7\x26\x8A\x92\x93\x25". 2275 "\xB0\xA2\x0D\x23\xED\x63\x79\x6D\x13\x32\xFA\x3C\x35\x02\x9A\xA3". 2276 "\xB3\xDD\x8E\x0A\x24\xBF\x51\xC3\x7C\xCD\x55\x9F\x37\xAF\x94\x4C". 2277 "\x29\x08\x52\x82\xB2\x3B\x4E\x37\x9F\x17\x07\x91\x11\x3B\xFD\xCD"; 2278 $out_username = uc get_username(12); 2279 my @ar = unpack("C*", sha1($_[1].$out_username)); 2280 my $len = 0; for ($h = 0; $h < 10; ++$h) { $len += $ar[$h] % 6; } $len += 0x20; 2281 my $off = 0; for ($h = 19; $h > 9; --$h) { $off += $ar[$h] % 8; } 2282 $h = uc unpack("H*", sha1($_[1].substr($CODVNG, $off, $len).$out_username)); 2283 return "$out_username\$$h"; 2284} 2285sub stribog { 2286} 2287 2288############################################################################## 2289# stub functions. When completed, move the function out of this section 2290############################################################################## 2291sub as400ssha1 { 2292 # note, dynamic_1590 is used. this is a 'thin' format. 2293 $out_username = get_username(10); 2294 my $uname = uc $out_username; 2295 while (length($uname) < 10) { $uname .= ' '; } 2296 return '$as400ssha1$'.uc unpack("H*",sha1(encode("UTF-16BE", $uname.$_[1]))) . '$' . uc $out_username; 2297} 2298sub eigrp { 2299 my $algo = int(rand(120) > 100) + 2; 2300 #$algo = 2; 2301 if ($algo == 2) { 2302 # md5 version 2303 my $salt = pack("H*","020500000000000000000000000000000000002a000200280002001000000001000000000000000000000000"); 2304 substr($salt, 12,3) = randstr(3); 2305 my $pw = $_[0]; 2306 while (length($pw) < 16) { $pw .= "\0"; } 2307 my $salt2 = int(rand(120) > 110) ? randstr(30) : ""; 2308 my $h = md5($salt . $pw . $salt2); 2309 if ($salt2 ne "") { $salt2 = "\$1\$".unpack("H*",$salt2)."\$"; } else { $salt2 = '$0$x$'; } 2310 return "\$eigrp\$2\$" . unpack("H*",$salt) . $salt2 . unpack("H*",$h); 2311 } 2312 #hmac-256 version. 2313 my $ip = int(rand(240)+10).".".int(rand(256)).".".int(rand(256)).".".int(rand(256)); 2314 my $pw = "\n$_[0]$ip"; 2315 my $salt = pack("H*","020500000000000000000000000000000000000a00020038000300200000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000c010001000000000f000400080f00020000f5000a000000020000"); 2316 substr($salt, 12,3) = randstr(3); 2317 my $h = Digest::SHA::hmac_sha256($salt, $pw); 2318 return "\$eigrp\$3\$" . unpack("H*",$salt) . "\$0\$x\$1\$$ip\$" . unpack("H*",$h); 2319} 2320sub mdc2 { 2321 # we should be able to optimize this, but for now this 'works'. 2322 # note, mdc2 is not in v1.01 but was introduced somewhere in v1.02 2323 # so a 1 time check has been added. 2324 if ($is_mdc2_valid == 0) { return undef; } 2325 if ($is_mdc2_valid == -1) { 2326 my $s = `echo -n '' | openssl dgst -mdc2 2> /dev/null`; 2327 chomp $s; 2328 if (length($s) > 10) { $s = substr($s, 9); } 2329 if ($s eq "52525252525252522525252525252525") { 2330 $is_mdc2_valid = 1; 2331 } else { 2332 print STDERR "\nmdc2 requires an updated openssl for pass_gen.pl to produce hashes\n\n"; 2333 $is_mdc2_valid = 0; 2334 return undef; 2335 } 2336 } 2337 if (index($_[0], "'") != -1) { return undef; } 2338 my $s = `echo -n '$_[0]' | openssl dgst -mdc2`; 2339 chomp $s; 2340 $s = substr($s, 9); 2341 if ($s eq "") { print "_[0] = $_[0]\n"; } 2342 return "\$mdc2\$$s"; 2343} 2344sub efs { 2345 my $sid = sprintf("S-1-5-21-1482476501-1659004503-725345%03d-%04d", int(rand(999)), int(rand(9999))); 2346 my $sid_u = encode("UTF-16LE", $sid."\0"); 2347 my $iter = 4000; 2348 my $iv = get_iv(16); 2349 my $pw_u = encode("UTF-16LE", $_[0]); 2350 my $out = sha1($pw_u); 2351 my $out2 = Digest::SHA::hmac_sha1($sid_u, $out); 2352 # NOTE, efs has a busted pbkdf2 function. The last param (1) tells pbkdf2 to use the busted extra step. 2353 my $p = pp_pbkdf2($out2,$iv,$iter,"sha1",32, 64, 0, 1); 2354 #create the ct here. We just build a 104 byte random string, then perform the computations that 2355 #sets bytes [16..36] to the proper computed hmac value of the password hash and the other parts of ct. 2356 $out2 .= "\0\0\0\0\0\0\0\0\0\0\0\0"; 2357 my $ct = randstr(104); 2358 my $ourKey = substr($ct, length($ct)-64); 2359 my $hmacSalt = substr($ct, 0, 16); 2360 my $encKey = Digest::SHA::hmac_sha1($hmacSalt, $out2); 2361 my $hmacComputed = Digest::SHA::hmac_sha1($ourKey, $encKey); 2362 substr($ct, 16, 20) = $hmacComputed; 2363 # now crypt the ct. This crypted value is stored in the hash line. 2364 require Crypt::DES_EDE3; require Crypt::CBC; 2365 my $cbc = Crypt::CBC->new(-key => substr($p,0,24), -cipher => "DES_EDE3", -iv => substr($p,24,8), -literal_key => 1, -header => "none"); 2366 my $enc = $cbc->encrypt($ct); 2367 $enc = substr($enc, 0, length($enc)-8); 2368 return "\$efs\$0\$$sid\$".unpack("H*",$iv)."\$$iter\$".unpack("H*",$enc); 2369} 2370sub keyring { 2371 my $s = get_salt(8); 2372 my $iter = int(2000 + rand(2000)); 2373 my $data = randstr(16); 2374 $data = md5($data) . $data; 2375 my $h = sha256($_[0].$s); 2376 for (my $i = 1; $i < $iter; ++$i) { 2377 $h = sha256($h); 2378 } 2379 my $key = substr($h, 0, 16); 2380 my $iv = substr($h, 16, 16); 2381 require Crypt::Cipher::AES; 2382 require Crypt::CBC; 2383 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => $key, -keysize => 16, -iv => $iv, -cipher => "Crypt::Cipher::AES", -header => 'none', -padding => 'none'); 2384 $h = $crypt->encrypt($data); 2385 $h = unpack("H*", $h); 2386 $s = unpack("H*", $s); 2387 my $l = length($data); 2388 return "\$keyring\$$s*$iter*$l*0*$h"; 2389} 2390sub snefru_128 { 2391 require Crypt::Rhash; 2392 my $r = Crypt::Rhash->new(Crypt::Rhash::RHASH_SNEFRU128()); 2393 return "\$snefru\$" . $r->update($_[0])->hash(); 2394} 2395sub snefru_256 { 2396 require Crypt::Rhash; 2397 my $r = Crypt::Rhash->new(Crypt::Rhash::RHASH_SNEFRU256()); 2398 return "\$snefru\$" . $r->update($_[0])->hash(); 2399} 2400sub palshop { 2401 my $m1 = md5($_[0]); 2402 my $s1 = sha1($_[0]); 2403 my $s = unpack("H*", $m1.$s1); 2404 $s = substr($s, 11, 50) . substr($s, 0, 1); 2405 #print ("$s\n"); 2406 my $m2 = md5($s); 2407 my $s2 = sha1($s); 2408 return "\$palshop\$". substr(unpack("H*",$m2),11) . substr(unpack("H*",$s2), 0, 29) . substr(unpack("H*",$m2),0,1); 2409} 2410sub iwork { 2411 my $s = get_salt(16); 2412 my $iv = get_iv(16); 2413 my $iter = 100000; 2414 my $blob_dat = randstr(32); 2415 #$blob_dat = pack("H*", "c6ef9b77af9e4d356e3dc977910b8cb3c3c1f2db89430ec36232078c2cefdec7"); 2416 $blob_dat .= sha256($blob_dat); 2417 $h = pp_pbkdf2($_[0], $s, $iter, "sha1", 16, 64); 2418 require Crypt::Cipher::AES; 2419 require Crypt::CBC; 2420 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => $h, -keysize => 16, -iv => $iv, -cipher => "Crypt::Cipher::AES", -header => 'none', -padding => 'none'); 2421 my $output = $crypt->encrypt($blob_dat); 2422 return "\$iwork\$1\$2\$1\$$iter\$".unpack("H*",$s)."\$".unpack("H*",$iv)."\$".unpack("H*",$output); 2423} 2424sub fgt { 2425 my $s = get_salt(12); 2426 my $magic = "\xa3\x88\xba\x2e\x42\x4c\xb0\x4a\x53\x79\x30\xc1\x31\x07\xcc\x3f\xa1\x32\x90\x29\xa9\x81\x5b\x70"; 2427 $h = sha1($s.$_[0].$magic); 2428 return "AK1".base64($s.$h); 2429} 2430sub has160 { 2431 require Crypt::Rhash; 2432 my $r = Crypt::Rhash->new(Crypt::Rhash::RHASH_HAS160()); 2433 return $r->update($_[0])->hash(); 2434} 2435sub mongodb_scram { 2436 my $u = get_username(-16); 2437 my $s = get_salt(16); 2438 my $iter = 10000; 2439 my $h = md5_hex($u . ':mongo:' . $_[0]); 2440 $h = pp_pbkdf2($h, $s, $iter, "sha1", 20, 64); 2441 $h = Digest::SHA::hmac_sha1("Client Key", $h); 2442 $h = sha1($h); 2443 return "\$scram\$$u\$$iter\$" . base64($s) . '$' . base64($h); 2444} 2445sub zipmonster { 2446 my $s = uc md5_hex($_[0]); 2447 for (my $i = 0; $i < 49999; ++$i) { 2448 $s = uc md5_hex($s); 2449 } 2450 return "\$zipmonster\$".lc $s; 2451} 2452sub cloudkeychain { 2453 $salt = get_salt(16); 2454 my $iv = get_iv(16); 2455 my $iter = get_loops(227272); 2456 my $master_key = " "; 2457 my $hmacdata = get_content(96, -1024); 2458 my $p = pp_pbkdf2($_[1],$salt,$iter,"sha512",64, 128); 2459 my $expectedhmac = _hmac_shas(\&sha256, 64, substr($p,32), $hmacdata); 2460 my $mklen = length($master_key); 2461 my $hmdl = length($hmacdata); 2462 my $ct = pack("H*", "000"); 2463 my $ctlen = length($ct); 2464 $salt = unpack("H*",$salt); $iv = unpack("H*",$iv); $ct = unpack("H*",$ct); $master_key = unpack("H*",$master_key); 2465 $expectedhmac = unpack("H*",$expectedhmac); $hmacdata = unpack("H*",$hmacdata); 2466 return "\$cloudkeychain\$16\$$salt\$$iter\$$mklen\$$master_key\$256\$16\$$iv\$$ctlen\$$ct\$32\$$expectedhmac\$$hmdl\$$hmacdata"; 2467} 2468sub agilekeychain { 2469 my $nkeys=1; 2470 my $iterations=get_loops(1000); 2471 my $salt=get_salt(8); 2472 my $iv=get_iv(16); 2473 my $dat=randstr(1040-32); # not sure what would be here, but JtR does not do anything with it. 2474 $dat .= $iv; 2475 my $key = pp_pbkdf2($_[1], $salt, $iterations,"sha1",16, 64); 2476 require Crypt::Cipher::AES; 2477 require Crypt::CBC; 2478 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => $key, -keysize => 16, -iv => $iv, -cipher => 'Crypt::Cipher::AES', -header => 'none'); 2479 my $h = $crypt->encrypt("\x10\x10\x10\x10\x10\x10\x10\x10\x10\x10\x10\x10\x10\x10\x10\x10"); 2480 $dat .= substr($h,0,16); 2481 2482 return "\$agilekeychain\$$nkeys*$iterations*8*".unpack("H*", $salt)."*1040*".unpack("H*", $dat)."*".unpack("H*", $key); 2483} 2484sub bitcoin { 2485 my $master; my $rounds; # my $ckey; my $public_key; 2486 $master = pack("H*", "0e34a996b1ce8a1735bba1acf6d696a43bc6730b5c41224206c93006f14f951410101010101010101010101010101010"); 2487 $salt = get_salt(8); 2488 $rounds = get_loops(20000); # 20k is a 'small' default number, but runs pretty fast. 2489 $h = sha512($_[1] . $salt); 2490 for (my $i = 1; $i < $rounds; $i++) { 2491 $h = sha512($h); 2492 } 2493 require Crypt::Cipher::AES; 2494 require Crypt::CBC; 2495 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => substr($h,0,32), -keysize => 32, -iv => substr($h,32,16), -cipher => 'Crypt::Cipher::AES', -header => 'none'); 2496 return '$bitcoin$96$'.substr(unpack("H*", $crypt->encrypt($master)),0,96).'$16$'.unpack("H*", $salt).'$'.$rounds.'$2$00$2$00'; 2497} 2498sub azuread { 2499 $salt = get_salt(10); 2500 #$salt = pack("H*", "317ee9d1dec6508fa510"); 2501 my $rounds = get_loops(100); # NOTE, right now, Azure-AD 'is' hard coded at 100, ITRW 2502 $h = encode("UTF-16LE", uc unpack("H*",md4(encode("UTF-16LE", $_[0])))); 2503 my $key = unpack("H*",pp_pbkdf2($h, $salt, $rounds, "sha256", 32, 64)); 2504 return "v1;PPH1_MD4,".unpack("H*",$salt).",$rounds,$key;"; 2505} 2506sub vdi_256 { 2507 my $salt1 = randstr(32, \@chrRawData); 2508 my $salt2 = randstr(32, \@chrRawData); 2509 my $dec_dat = randstr(64, , \@chrRawData); 2510 my $evp_pass = pp_pbkdf2($_[0], $salt1, 2000, \&sha256, 64, 64); 2511 my $tweak = "\x00"x16; 2512 my $enc_pass = _aes_xts($evp_pass,$dec_dat,$tweak, 256); 2513 my $final = unpack("H*",pp_pbkdf2($dec_dat, $salt2, 2000, \&sha256, 32, 64)); 2514 $salt1 = unpack("H*",$salt1); $salt2 = unpack("H*",$salt2); $enc_pass = unpack("H*",$enc_pass); 2515 return "\$vdi\$aes-xts256\$sha256\$2000\$2000\$64\$32\$$salt1\$$salt2\$$enc_pass\$$final"; 2516} 2517sub vdi_128 { 2518 my $salt1 = randstr(32, \@chrRawData); 2519 my $salt2 = randstr(32, \@chrRawData); 2520 my $dec_dat = randstr(32, , \@chrRawData); 2521 my $evp_pass = pp_pbkdf2($_[0], $salt1, 2000, \&sha256, 32, 64); 2522 my $tweak = "\x00"x16; 2523 my $enc_pass = _aes_xts($evp_pass,$dec_dat,$tweak, 128); 2524 my $final = unpack("H*",pp_pbkdf2($dec_dat, $salt2, 2000, \&sha256, 32, 64)); 2525 $salt1 = unpack("H*",$salt1); $salt2 = unpack("H*",$salt2); $enc_pass = unpack("H*",$enc_pass); 2526 return "\$vdi\$aes-xts128\$sha256\$2000\$2000\$32\$32\$$salt1\$$salt2\$$enc_pass\$$final"; 2527} 2528sub qnx_md5 { 2529 $salt = get_salt(16, \@chrHexLo); 2530 my $rounds = get_loops(1000); 2531 my $h = md5($salt . $_[0]x($rounds+1)); 2532 my $ret = "\@m"; 2533 if ($rounds != 1000) { $ret .= ",$rounds"; } 2534 $ret .= "\@".unpack("H*",$h)."\@$salt"; 2535 return $ret; 2536} 2537sub qnx_sha512 { 2538# use SHA512_qnx; 2539# $salt = get_salt(16, \@chrHexLo); 2540# my $rounds = get_loops(1000); 2541# my $h = SHA512_qnx::sha512($salt . $_[0]x($rounds+1)); 2542# my $ret = "\@S"; 2543# if ($rounds != 1000) { $ret .= ",$rounds"; } 2544# $ret .= "\@".unpack("H*",$h)."\@$salt"; 2545# return $ret; 2546 if ($qnx_sha512_warning == 0) { 2547 print STDERR "\nqnx_sha512 requires SHA512_qnx.pm to be in current directory, and the qnx_sha512 function edited.\n\n";} 2548 $qnx_sha512_warning += 1; 2549 return qnx_sha256(@_); 2550} 2551sub qnx_sha256 { 2552 $salt = get_salt(16, \@chrHexLo); 2553 my $rounds = get_loops(1000); 2554 my $h = sha256($salt . $_[0]x($rounds+1)); 2555 my $ret = "\@s"; 2556 if ($rounds != 1000) { $ret .= ",$rounds"; } 2557 $ret .= "\@".unpack("H*",$h)."\@$salt"; 2558 return $ret; 2559} 2560sub blockchain { 2561 my $unenc = "{\n{\t\"guid\" : \"246093c1-de47-4227-89be-".randstr(12,\@chrHexLo)."\",\n\t\"sharedKey\" : \"fccdf579-707c-46bc-9ed1-".randstr(12,\@chrHexLo)."\",\n\t"; 2562 $unenc .= "\"options\" : {\"pbkdf2_iterations\":10,\"fee_policy\":0,\"html5_notifications\":false,\"logout_time\":600000,\"tx_display\":0,\"always_keep_local_backup\":false},\n\t"; 2563 $unenc .= "\"keys\" : [\n\t{\"addr\" : \"156yFScjeoMCvPnNji2UiztuVuYL2MY16Z\",\n\t \"priv\" : \"DNDjMS2CsrKE8kXhwkZawbou56fJECiGCqNEzZbwgxSJ\"}\n\t]\n}"; 2564 my $len = length($unenc); 2565 $len = floor(($len+15)/16); 2566 $len *= 16; 2567 my $data; 2568 my $iv = get_salt(16); 2569 my $key = pp_pbkdf2($_[1], $iv, 10,"sha1",32, 64); 2570 require Crypt::Cipher::AES; 2571 require Crypt::CBC; 2572 my $crypt = Crypt::CBC->new(-literal_key => 1, -key => $key, -keysize => 32, -iv => $iv, -cipher => 'Crypt::Cipher::AES', -header => 'none'); 2573 my $h = $crypt->encrypt($unenc); 2574 $data = $iv.substr($h,0,$len); 2575 return '$blockchain$'.length($data).'$'.unpack("H*", $data); 2576} 2577sub keystore { 2578 # we want to assure that we will NEVER set the 0x80 bit in the first block. 2579 # so, salt and contant have to be > 64 bytes (at min). 2580 $salt = pack("H*", "feedfeed0000000200000001000000010000") . get_salt(36) . get_salt(-128); 2581 my $p = unpack("H*", $_[0]); 2582 my $p2 = ""; 2583 for (my $i = 0; $i < length($p); $i += 2) { 2584 $p2 .= "00" . substr($p, $i, 2); 2585 } 2586 $p = pack("H*", $p2); 2587 my $hash = sha1_hex($p . "Mighty Aphrodite" . $salt); 2588 return "\$keystore\$0\$".length($salt).'$'.unpack("H*",$salt)."\$$hash\$1\$1\$00"; 2589} 2590sub vnc { 2591 require Crypt::ECB; 2592 Crypt::ECB->import(); 2593 my $chal = get_salt(16); 2594 my $key = str_force_length_pad($_[0], 8, "\0"); 2595 $key = str_odd_parity($key); 2596 $key = str_reverse_bits_in_bytes($key); 2597 my $cr = Crypt::ECB->new; 2598 $cr->padding(ecb_padding_none); 2599 $cr->cipher("DES"); 2600 $cr->key($key); 2601 my $hash = $cr->encrypt($chal); 2602 return "\$vnc\$*".uc(unpack("H*",$chal))."*".uc(unpack('H*', $hash)); 2603} 2604sub sxc { 2605 $salt = get_salt(16); 2606 my$iv = get_iv(8); 2607 my $r = get_loops(1024); 2608 my $content = get_content(-1024, -4095); 2609 my $len = length($content); 2610 my $len2 = floor(length($content)/20) * 20; 2611 $h = sha1($_[0]); 2612 my $key = pp_pbkdf2($h, $salt, $r, "sha1", 16 , 64); 2613 require Crypt::Cipher::Blowfish; 2614 require Crypt::Mode::CFB; 2615 my $crypt = Crypt::Mode::CFB->new('Blowfish'); 2616 my $output = $crypt->decrypt($content, $key, $iv); 2617 my $res = sha1_hex(substr($output, 0, $len2)); 2618 return "\$sxc\$*0*0*$r*16*$res*8*".unpack("H*",$iv)."*16*".unpack("H*",$salt)."*$len2*$len*".unpack("H*",$content); 2619} 2620sub vtp { 2621 my $secret = $_[0]; 2622 if (length($secret)) { 2623 while (length($secret) < 1563*64) { $secret .= $_[0]; } 2624 if (length($secret) > 1563*64) { $secret = substr($secret, 0, 1563*64); } 2625 $secret = md5($secret); 2626 } else { 2627 $secret = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; 2628 } 2629 my $c = randstr(1,\@chrRawData); 2630 my $vtp; 2631 my $trailer_data; 2632 my $vlans_data; 2633 my $v = 2; 2634 my $salt = get_salt(10); 2635 if (ord($c) < 20) { 2636 # create v1 record. 2637 $v = 1; 2638 $vtp = pack("H*","0101000c646f6d61696e31323334353600000000000000000000000000000000000000000000001". 2639 "00000000000000000000000000000000000000000000000000000000000000000"); 2640 $trailer_data = pack("H*","0101000200"); 2641 $vlans_data = pack("H*","14000107000105dc000186a164656661756c740014000105000505dc000186a568656c6c6". 2642 "f0000002000020c03ea05dc00018a8a666464692d64656661756c74010100000401000028". 2643 "00031203eb05dc00018a8b746f6b656e2d72696e672d64656661756c74000001010000040". 2644 "100002400040f03ec05dc00018a8c666464696e65742d64656661756c7400020100000301". 2645 "00012400050d03ed05dc00018a8d74726e65742d64656661756c740000000201000003010002"); 2646 } else { 2647 # create v2 record. 2648 $vtp = pack("H*","0201000c646f6d61696e313233343536000000000000000000000000000000000000000000000015". 2649 "0000000000000000000000000000000000000000000000000000000000000000"); 2650 $trailer_data = pack("H*","0000000106010002"); 2651 $vlans_data = pack("H*","14000107000105dc000186a164656661756c740014000105000505dc000186a56368656e61". 2652 "00000010000103000605dc000186a6666666001800020c03ea05dc00018a8a666464692d64". 2653 "656661756c743000030d03eb117800018a8b74726372662d64656661756c7400000001010c". 2654 "cc040103ed0701000208010007090100072000040f03ec05dc00018a8c666464696e65742d". 2655 "64656661756c7400030100012400050d03ed117800018a8d74726272662d64656661756c740000000201000f03010002"); 2656 } 2657 substr($vtp, 4, 10) = "\0\0\0\0\0\0\0\0\0\0"; 2658 substr($vtp, 4, length($salt)) = $salt; 2659 my $h = $secret.$vtp; 2660 if ($v != 1) { $h .= $trailer_data; } 2661 my $vdl = length($vlans_data); 2662 my $sl = length($vtp)+length($trailer_data); 2663 $h = unpack("H*",md5($h.$vlans_data.$secret)); 2664 $vtp = unpack("H*",$vtp); 2665 $vlans_data = unpack("H*",$vlans_data); 2666 $trailer_data = unpack("H*",$trailer_data); 2667 return "\$vtp\$$v\$$vdl\$$vlans_data\$$sl\$$vtp$trailer_data\$$h"; 2668} 2669sub racf { 2670 require Convert::EBCDIC; 2671 import Convert::EBCDIC qw (ascii2ebcdic); 2672 require Crypt::DES; 2673 my $user = uc get_username(12); 2674 my $pw = uc $_[0]; 2675 my $pad_user = substr ($user . " " x 8, 0, 8); 2676 my $pad_pass = substr ($pw . " " x 8, 0, 8); 2677 my $usr_ebc = ascii2ebcdic ($pad_user); 2678 my $pass_ebc = ascii2ebcdic ($pad_pass); 2679 my @pw = split ("", $pass_ebc); 2680 for (my $i = 0; $i < 8; $i++) { 2681 $pw[$i] = unpack ("C", $pw[$i]); 2682 $pw[$i] ^= 0x55; 2683 $pw[$i] <<= 1; 2684 $pw[$i] = pack ("C", $pw[$i] & 0xff); 2685 } 2686 my $key = join ("", @pw); 2687 my $des = new Crypt::DES $key; 2688 my $h = $des->encrypt ($usr_ebc); 2689 $h = uc unpack ("H16", $h); 2690 return "\$racf\$*$user*$h"; 2691} 2692 2693sub mozilla { 2694 $salt = get_salt(20); 2695 # use -iv=xxx to pass in global_salt by user. 2696 my $gsalt = get_iv(20); 2697 2698 my $h2 = sha1(sha1($gsalt.$_[0]).$salt); 2699 my $h4 = Digest::SHA::hmac_sha1($salt, $h2); 2700 my $h3 = Digest::SHA::hmac_sha1($salt.$salt, $h2) . Digest::SHA::hmac_sha1($h4.$salt, $h2); 2701 2702 require Crypt::DES_EDE3; 2703 require Crypt::CBC; 2704 my $chk_key = "password-check"; 2705 my $cbc = Crypt::CBC->new( -key => substr($h3,0,24), 2706 -cipher => "DES_EDE3", 2707 -iv => substr($h3,32,8), 2708 -literal_key => 1, 2709 -header => "none"); 2710 my $enc = $cbc->encrypt($chk_key); 2711 return "\$mozilla\$*3*20*1*".unpack("H*",$salt)."*11*2a864886f70d010c050103*16*".unpack("H*",$enc)."*20*".unpack("H*",$gsalt); 2712} 2713sub keychain { 2714 require Crypt::DES_EDE3; 2715 require Crypt::CBC; 2716 my $iv; my $data; my $key; my $h; 2717 $salt = get_salt(20); 2718 $iv = get_iv(8); 2719 2720 # NOTE, this data came from decryption of the sample hash in jtr's keychain_fmt_plug.c. 2721 # So we will just keep using it. We know (think) it is valid. 2722 $data = "\x85\x6e\xef\x45\x56\xb5\x85\x8c\x15\x47\x7d\xb1\x7b\x95\xc5\xcb\x01\x5d" . 2723 "\x51\x0b\x9f\x37\x10\xce\x9d\x44\xf6\x5d\x8b\x6c\xbd\x5d\xa0\x66\xee\x9d" . 2724 "\xd0\x85\xc2\x0d\xfa\x53\x78\x25\x04\x04\x04\x04"; 2725 $key = pp_pbkdf2($_[1], $salt, 1000,"sha1",24, 64); 2726 my $cbc = Crypt::CBC->new( -key => $key, 2727 -cipher => "DES_EDE3", 2728 -iv => $iv, 2729 -literal_key => 1, 2730 -header => "none"); 2731 $h = $cbc->encrypt($data); 2732 # $h is 8 bytes longer than in the JtR sample hash. BUT the first 48 bytes ARE the same. We just trim them. 2733 return "\$keychain\$*".unpack("H*",$salt)."*".unpack("H*",$iv)."*".substr(unpack("H*",$h),0,48*2); 2734} 2735sub wpapsk { 2736 # max ssid is 32 bytes 2737 # min password is 8 bytes. Max is 63 bytes 2738 if (length($_[1]) < 8 || length($_[1]) > 63) { return; } 2739 2740 my $ssid; my $nonce1; my $nonce2; my $mac1; my $mac2; my $eapol; my $eapolsz; 2741 my $keyver; my $keymic; my $data; my $prf; my $inpdat; my $i; 2742 # load ssid 2743 $ssid = get_salt(32,-32,\@userNames); 2744 2745 # Compute the pbkdf2-sha1(4096) for 32 bytes 2746 my $wpaH = pp_pbkdf2($_[1],$ssid,4096,"sha1",32, 64); 2747 2748 # load some other 'random' values, for the other data. 2749 $nonce1 = randstr(32,\@chrRawData); 2750 $nonce2 = randstr(32,\@chrRawData); 2751 $mac1 = randstr(6,\@chrRawData); 2752 $mac2 = randstr(6,\@chrRawData); 2753 $eapolsz = 92 + rand (32); 2754 $eapol = randstr($eapolsz,\@chrRawData); 2755 $keyver = (rand(32) / 6) + 1; # more chance of a keyver1 2756 if ($keyver > 2) { $keyver = 2; } 2757 if ($keyver < 2) { $keyver = 1; } 2758 2759 # ok, keymic now needs to be computed. 2760 # for keyver=1 we use md5, for keyver=2 we use sha1 2761 # (see wpapsk.h wpapsk_postprocess() for information) 2762 Load_MinMax($data, $mac1, $mac2); 2763 Load_MinMax($data, $nonce1, $nonce2); 2764 2765 # in JtR prf_512($wpaH, $data, $prf), but we simply do it inline. 2766 $data = "Pairwise key expansion" . chr(0) . $data . chr(0); 2767 $prf = _hmacsha1($wpaH, $data); 2768 2769 if ($keyver == 1) { 2770 $prf = substr($prf, 0, 16); 2771 $keymic = _hmacmd5($prf, $eapol); 2772 } else { 2773 $prf = substr($prf, 0, 16); 2774 $keymic = _hmacsha1($prf, $eapol); 2775 $keymic = substr($keymic, 0, 16); 2776 } 2777 # ok, now we have the keymic. 2778 2779 ############################################################ 2780 # Now build the data for JtR's hccap_t structure. 2781 ############################################################ 2782 $inpdat = $mac1 . $mac2 . $nonce1 . $nonce2 . $eapol; # first 4 parts easy. Simply append them AND data we have for eapol 2783 for ($i = $eapolsz; $i < 256; ++$i) { $inpdat .= chr(0); } # pad eapol data to 256 bytes. 2784 $inpdat .= chr($eapolsz).chr(0).chr(0).chr(0); # put eapolsz, and keyver into a LE 4 byte integers 2785 $inpdat .= chr($keyver).chr(0).chr(0).chr(0); 2786 $inpdat .= $keymic; # now append the keymic 2787 2788 # drop out the JtR hash. NOTE, base64_wpa() is specialzed for this hash. 2789 return "\$WPAPSK\$$ssid#".base64_wpa($inpdat); 2790} 2791 2792# used by wpapsk, to load the MAC1/MAC2 and NONCE1/NONCE2. It loads the smallest of 2793# the two, first, then loads the larger one. All data is appended to the first param 2794sub Load_MinMax { 2795 my ($v1, $v2) = ($_[1], $_[2]); 2796 my $c1; my $c2; my $off; 2797 for ($off = 0; $off < length($v1); ++$off) { 2798 $c1 = substr($v1, $off, 1); 2799 $c2 = substr($v2, $off, 1); 2800 if (ord($c1) > ord($c2)) { 2801 $_[0] .= $v2.$v1; 2802 return; 2803 } 2804 if (ord($c2) > ord($c1)) { 2805 $_[0] .= $v1.$v2; 2806 return; 2807 } 2808 } 2809 # same?? 2810 $_[0] .= $v1.$v2; 2811} 2812sub mscash2 { 2813 # max username (salt) length is supposed to be 19 characters (in John) 2814 # max password length is 27 characters (in John) 2815 # the algorithm lowercases the salt 2816 my $iter = 10240; 2817 $out_username = get_salt(22,-27,\@userNames); 2818 $salt = encode("UTF-16LE", lc($out_username)); 2819 my $key = md4(md4(encode("UTF-16LE",$_[0])).$salt); 2820 return '$DCC2$'."$iter#$out_username#".pp_pbkdf2_hex($key,$salt,$iter,"sha1",16,64); 2821} 2822sub lm { 2823 my $p = $_[0]; 2824 if (length($p)>14) { $p = substr($p,0,14);} 2825 $out_uc_pass = 1; $out_extras = 1; 2826 return "0:".unpack("H*",LANMan($p)); 2827} 2828sub nt { 2829 return "\$NT\$".unpack("H*",md4(encode("UTF-16LE", $_[0]))); 2830} 2831sub pwdump { 2832 my $lm = unpack("H*",LANMan(length($_[0]) <= 14 ? $_[0] : "")); 2833 my $nt = unpack("H*",md4(encode("UTF-16LE", $_[0]))); 2834 $out_extras = 0; 2835 return "0:$lm:$nt"; 2836} 2837sub raw_md4 { 2838 return md4_hex($_[1]); 2839} 2840sub mediawiki { 2841 $salt = get_salt(8); 2842 return "\$B\$$salt\$".md5_hex($salt . "-" . md5_hex($_[1])); 2843} 2844sub osc { 2845 $salt = get_salt(2); 2846 return "\$OSC\$".unpack("H*",$salt)."\$".md5_hex($salt. $_[1]); 2847} 2848sub formspring { 2849 $salt = get_salt(2,2,\@chrAsciiNum); 2850 return sha256_hex($salt. $_[1])."\$$salt"; 2851} 2852sub phpass { 2853 $salt = get_salt(8); 2854 my $h = PHPass_hash($_[1], 11, $salt); 2855 return "\$P\$".to_phpbyte(11).$salt.substr(base64i($h),0,22); 2856} 2857sub po { 2858 if (defined $argsalt) { 2859 $salt = md5_hex($argsalt); 2860 } else { 2861 $salt=randstr(32, \@chrHexLo); 2862 } 2863 return md5_hex($salt."Y".$_[1]."\xF7".$salt)."$salt"; 2864} 2865sub _md5_crypt_to_64 { 2866 my $c = $_[0]; 2867 my $i; 2868 # MD5-a (or MD5-BSD and sunmd5), do a strange 2869 # transposition and base-64 conversion. We do the same here, to get the same hash 2870 $i = (ord(substr($c,0,1))<<16) | (ord(substr($c,6,1))<<8) | ord(substr($c,12,1)); 2871 my $tmp = to64($i,4); 2872 $i = (ord(substr($c,1,1))<<16) | (ord(substr($c,7,1))<<8) | ord(substr($c,13,1)); 2873 $tmp .= to64($i,4); 2874 $i = (ord(substr($c,2,1))<<16) | (ord(substr($c,8,1))<<8) | ord(substr($c,14,1)); 2875 $tmp .= to64($i,4); 2876 $i = (ord(substr($c,3,1))<<16) | (ord(substr($c,9,1))<<8) | ord(substr($c,15,1)); 2877 $tmp .= to64($i,4); 2878 $i = (ord(substr($c,4,1))<<16) | (ord(substr($c,10,1))<<8) | ord(substr($c,5,1)); 2879 $tmp .= to64($i,4); 2880 $i = ord(substr($c,11,1)); 2881 $tmp .= to64($i,2); 2882 return $tmp; 2883} 2884sub md5crypt_hash { 2885 my $b, my $c, my $tmp; 2886 my $type = $_[2]; 2887 $salt = $_[1]; 2888 #create $b 2889 $b = md5($_[0],$salt,$_[0]); 2890 #create $a 2891 $tmp = $_[0] . $type . $salt; # if this is $1$ then we have 'normal' BSD MD5 2892 for ($i = length($_[0]); $i > 0; $i -= 16) { 2893 if ($i > 16) { $tmp .= $b; } 2894 else { $tmp .= substr($b,0,$i); } 2895 } 2896 for ($i = length($_[0]); $i > 0; $i >>= 1) { 2897 if ($i & 1) { $tmp .= "\x0"; } 2898 else { $tmp .= substr($_[0],0,1); } 2899 } 2900 $c = md5($tmp); 2901 2902 # now we do 1000 iterations of md5. 2903 for ($i = 0; $i < 1000; ++$i) { 2904 if ($i&1) { $tmp = $_[0]; } 2905 else { $tmp = $c; } 2906 if ($i%3) { $tmp .= $salt; } 2907 if ($i%7) { $tmp .= $_[0]; } 2908 if ($i&1) { $tmp .= $c; } 2909 else { $tmp .= $_[0]; } 2910 $c = md5($tmp); 2911 } 2912 $tmp = _md5_crypt_to_64($c); 2913 my $ret = "$type$salt\$$tmp"; 2914 return $ret; 2915} 2916sub md5crypt_a { 2917 $salt = get_salt(8); 2918 $h = md5crypt_hash($_[1], $salt, "\$apr1\$"); 2919 return $h; 2920} 2921sub md5crypt_smd5 { 2922 $salt = get_salt(8); 2923 $h = md5crypt_hash($_[1], $salt, ""); 2924 return "{smd5}$h"; 2925} 2926sub md5bit { 2927 my $digest = $_[0]; my $bit_num=$_[1]; 2928 my $byte_off; 2929 my $bit_off; 2930 2931 $bit_num %= 128; 2932 $byte_off = $bit_num / 8; 2933 $bit_off = $bit_num % 8; 2934 2935 my $b = ord(substr($digest, $byte_off, 1)); 2936 if ($b&(1<<$bit_off)) { return 1; } 2937 return 0; 2938} 2939# F'n ugly function, but pretty much straight port from sunmd5 C code. 2940sub moffet_coinflip { 2941 my $c = $_[0]; 2942 my $round = $_[1]; 2943 my $i; 2944 my @shift_4; my @shift_7; my @indirect_4; my @indirect_7; 2945 my $shift_a; my $shift_b; 2946 my $indirect_a; my $indirect_b; 2947 my $bit_a; my $bit_b; 2948 2949 for ($i = 0; $i < 16; $i++) { 2950 my $j; 2951 $j = ($i + 3) & 0xF; 2952 $shift_4[$i] = ord(substr($c,$j,1)) % 5; 2953 $shift_7[$i] = (ord(substr($c,$j,1)) >> (ord(substr($c,$i,1)) & 7)) & 0x01; 2954 } 2955 2956 $shift_a = md5bit($c, $round); 2957 $shift_b = md5bit($c, $round + 64); 2958 2959 for ($i = 0; $i < 16; $i++) { 2960 $indirect_4[$i] = (ord(substr($c,$i,1)) >> $shift_4[$i]) & 0x0f; 2961 } 2962 for ($i = 0; $i < 16; $i++) { 2963 $indirect_7[$i] = (ord(substr($c,$indirect_4[$i],1)) >> $shift_7[$i]) & 0x7f; 2964 } 2965 $indirect_a = $indirect_b = 0; 2966 2967 for ($i = 0; $i < 8; $i++) { 2968 $indirect_a |= (md5bit($c, $indirect_7[$i]) << $i); 2969 $indirect_b |= (md5bit($c, $indirect_7[$i + 8]) << $i); 2970 } 2971 2972 $indirect_a = ($indirect_a >> $shift_a) & 0x7f; 2973 $indirect_b = ($indirect_b >> $shift_b) & 0x7f; 2974 2975 $bit_a = md5bit($c, $indirect_a); 2976 $bit_b = md5bit($c, $indirect_b); 2977 2978 return $bit_a ^ $bit_b; 2979} 2980sub _sunmd5_hash { 2981 my $pw=$_[0]; 2982 $salt = $_[1]; 2983 my $c = md5($pw,$salt); 2984 my $i = 0; 2985 while ($i < 5000) { 2986 # compute coin flip 2987 my $round = sprintf("%d", $i); 2988 # now do md5 on this round 2989 if (moffet_coinflip($c, $i)) { 2990 $c = md5( 2991 $c, 2992 # this long constant string (AND the null trailing), 2993 # need to be added, then the round's text number 2994 "To be, or not to be,--that is the question:--\n", 2995 "Whether 'tis nobler in the mind to suffer\n", 2996 "The slings and arrows of outrageous fortune\n", 2997 "Or to take arms against a sea of troubles,\n", 2998 "And by opposing end them?--To die,--to sleep,--\n", 2999 "No more; and by a sleep to say we end\n", 3000 "The heartache, and the thousand natural shocks\n", 3001 "That flesh is heir to,--'tis a consummation\n", 3002 "Devoutly to be wish'd. To die,--to sleep;--\n", 3003 "To sleep! perchance to dream:--ay, there's the rub;\n", 3004 "For in that sleep of death what dreams may come,\n", 3005 "When we have shuffled off this mortal coil,\n", 3006 "Must give us pause: there's the respect\n", 3007 "That makes calamity of so long life;\n", 3008 "For who would bear the whips and scorns of time,\n", 3009 "The oppressor's wrong, the proud man's contumely,\n", 3010 "The pangs of despis'd love, the law's delay,\n", 3011 "The insolence of office, and the spurns\n", 3012 "That patient merit of the unworthy takes,\n", 3013 "When he himself might his quietus make\n", 3014 "With a bare bodkin? who would these fardels bear,\n", 3015 "To grunt and sweat under a weary life,\n", 3016 "But that the dread of something after death,--\n", 3017 "The undiscover'd country, from whose bourn\n", 3018 "No traveller returns,--puzzles the will,\n", 3019 "And makes us rather bear those ills we have\n", 3020 "Than fly to others that we know not of?\n", 3021 "Thus conscience does make cowards of us all;\n", 3022 "And thus the native hue of resolution\n", 3023 "Is sicklied o'er with the pale cast of thought;\n", 3024 "And enterprises of great pith and moment,\n", 3025 "With this regard, their currents turn awry,\n", 3026 "And lose the name of action.--Soft you now!\n", 3027 "The fair Ophelia!--Nymph, in thy orisons\n", 3028 "Be all my sins remember'd.\n\x0", # the NULL must be included. 3029 $round); 3030 } else { 3031 $c = md5($c,$round); 3032 } 3033 $i++; 3034 } 3035 return $c; 3036} 3037sub sunmd5 { 3038 $salt = get_salt(16); 3039 $salt = "\$md5\$rounds=904\$".$salt; 3040 my $c = _sunmd5_hash($_[1], $salt); 3041 my $h = _md5_crypt_to_64($c); 3042 return "$salt\$$h"; 3043} 3044sub wowsrp { 3045 require Math::BigInt; 3046 $salt = get_salt(16); 3047 my $usr = uc get_username(24); 3048 my $h = sha1($salt, sha1($usr,":",uc $_[1])); 3049 # turn $h into a hex, so we can load it into a BigInt 3050 $h = "0x" . unpack("H*", $h); 3051 3052 # perform exponentation. 3053 my $base = Math::BigInt->new(47); 3054 my $exp = Math::BigInt->new($h); 3055 my $mod = Math::BigInt->new("112624315653284427036559548610503669920632123929604336254260115573677366691719"); 3056 $h = $base->bmodpow($exp, $mod); 3057 3058 # convert h into upper cased hex (also salt gets converted into upcased hex) 3059 $h = uc substr($h->as_hex(), 2); 3060 $out_uc_pass = 1; 3061 3062# this next line left pads 0's to the hash. Optional. We handle both instances. 3063# while (length($h) < 64) { $h = "0".$h; } 3064 3065 return "\$WoWSRP\$$h\$".uc unpack("H*", $salt)."*$usr"; 3066} 3067sub clipperz_srp { 3068 require Math::BigInt; 3069 $salt = get_salt(64); 3070 my $usr = get_username(24); 3071 my $h = "0x" . unpack("H*", sha256(sha256($salt.unpack("H*",sha256(sha256($_[1].$usr)))))); 3072 3073 # perform exponentation. 3074 my $base = Math::BigInt->new(2); 3075 my $exp = Math::BigInt->new($h); 3076 my $mod = Math::BigInt->new("125617018995153554710546479714086468244499594888726646874671447258204721048803"); 3077 $h = $base->bmodpow($exp, $mod); 3078 3079 # convert h into hex 3080 $h = substr($h->as_hex(), 2); 3081 3082# this next line left pads 0's to the hash. Optional. We handle both instances. 3083# while (length($h) < 65) { $h = "0".$h; } 3084 3085 return "\$clipperz\$$h\$$salt*$usr"; 3086} 3087sub _hmacmd5 { 3088 my ($key, $data) = @_; 3089 my $ipad; my $opad; 3090 if (length($key) > 64) { 3091 $key = md5($key); 3092 } 3093 for ($i = 0; $i < length($key); ++$i) { 3094 $ipad .= chr(ord(substr($key, $i, 1)) ^ 0x36); 3095 $opad .= chr(ord(substr($key, $i, 1)) ^ 0x5C); 3096 } 3097 while ($i++ < 64) { 3098 $ipad .= chr(0x36); 3099 $opad .= chr(0x5C); 3100 } 3101 return md5($opad,md5($ipad,$data)); 3102} 3103sub _hmacsha1 { 3104 my ($key, $data) = @_; 3105 my $ipad; my $opad; 3106 if (length($key) > 64) { 3107 $key = sha1($key); 3108 } 3109 for ($i = 0; $i < length($key); ++$i) { 3110 $ipad .= chr(ord(substr($key, $i, 1)) ^ 0x36); 3111 $opad .= chr(ord(substr($key, $i, 1)) ^ 0x5C); 3112 } 3113 while ($i++ < 64) { 3114 $ipad .= chr(0x36); 3115 $opad .= chr(0x5C); 3116 } 3117 return sha1($opad,sha1($ipad,$data)); 3118} 3119sub hmac_md5 { 3120 $salt = get_salt(-183); 3121 my $bin = _hmacmd5($_[1], $salt); 3122 return "$salt#".unpack("H*",$bin); 3123} 3124sub _hmac_shas { 3125 my ($func, $pad_sz, $key, $data) = @_; 3126 my $ipad; my $opad; 3127 if (length($key) > $pad_sz) { 3128 $key = $func->($key); 3129 } 3130 for ($i = 0; $i < length($key); ++$i) { 3131 $ipad .= chr(ord(substr($key, $i, 1)) ^ 0x36); 3132 $opad .= chr(ord(substr($key, $i, 1)) ^ 0x5C); 3133 } 3134 while ($i++ < $pad_sz) { 3135 $ipad .= chr(0x36); 3136 $opad .= chr(0x5C); 3137 } 3138 return $func->($opad,$func->($ipad,$data)); 3139} 3140sub hmac_sha1 { 3141 $salt = get_salt(24); 3142 my $bin = _hmac_shas(\&sha1, 64, $_[1], $salt); 3143 return "$salt#".unpack("H*",$bin); 3144} 3145sub hmac_sha224 { 3146 $salt = get_salt(-183); 3147 my $bin = _hmac_shas(\&sha224, 64, $_[1], $salt); 3148 return "$salt#".unpack("H*",$bin); 3149} 3150sub hmac_sha256 { 3151 $salt = get_salt(-183); 3152 my $bin = _hmac_shas(\&sha256, 64, $_[1], $salt); 3153 return "$salt#".unpack("H*",$bin); 3154} 3155sub hmac_sha384 { 3156 $salt = get_salt(-239); 3157 my $bin = _hmac_shas(\&sha384, 128, $_[1], $salt); 3158 return "$salt#".unpack("H*",$bin); 3159} 3160sub hmac_sha512 { 3161 $salt = get_salt(-239); 3162 my $bin = _hmac_shas(\&sha512, 128, $_[1], $salt); 3163 return "$salt#".unpack("H*",$bin); 3164} 3165sub rakp { 3166 $out_username = get_username(64); 3167 $salt = get_salt(56) . $out_username; 3168 my $bin = _hmac_shas(\&sha1, 64, $_[1], $salt); 3169 return unpack("H*",$salt)."\$".unpack("H*",$bin); 3170} 3171sub _sha_crypts { 3172 my $a; my $b, my $c, my $tmp; my $i; my $ds; my $dp; my $p; my $s; 3173 my ($func, $bits, $key, $salt) = @_; 3174 my $bytes = $bits/8; 3175 my $loops = get_loops(5000); 3176 3177 $b = $func->($key.$salt.$key); 3178 3179 # Add for any character in the key one byte of the alternate sum. 3180 $tmp = $key . $salt; 3181 for ($i = length($key); $i > 0; $i -= $bytes) { 3182 if ($i > $bytes) { $tmp .= $b; } 3183 else { $tmp .= substr($b,0,$i); } 3184 } 3185 3186 # Take the binary representation of the length of the key and for every 1 add the alternate sum, for every 0 the key. 3187 for ($i = length($key); $i > 0; $i >>= 1) { 3188 if (($i & 1) != 0) { $tmp .= $b; } 3189 else { $tmp .= $key; } 3190 } 3191 $a = $func->($tmp); 3192 # NOTE, this will be the 'initial' $c value in the inner loop. 3193 3194 # For every character in the password add the entire password. produces DP 3195 $tmp = ""; 3196 for ($i = 0; $i < length($key); ++$i) { 3197 $tmp .= $key; 3198 } 3199 $dp = $func->($tmp); 3200 # Create byte sequence P. 3201 $p = ""; 3202 for ($i = length($key); $i > 0; $i -= $bytes) { 3203 if ($i > $bytes) { $p .= $dp; } 3204 else { $p .= substr($dp,0,$i); } 3205 } 3206 # produce ds 3207 $tmp = ""; 3208 my $til = 16 + ord(substr($a,0,1)); 3209 for ($i = 0; $i < $til; ++$i) { 3210 $tmp .= $salt; 3211 } 3212 $ds = $func->($tmp); 3213 3214 # Create byte sequence S. 3215 for ($i = length($salt); $i > 0; $i -= $bytes) { 3216 if ($i > $bytes) { $s .= $ds; } 3217 else { $s .= substr($ds,0,$i); } 3218 } 3219 3220 $c = $a; # Ok, we saved this, which will 'seed' our crypt value here in the loop. 3221 # now we do 5000 iterations of SHA2 (256 or 512) 3222 for ($i = 0; $i < $loops; ++$i) { 3223 if ($i&1) { $tmp = $p; } 3224 else { $tmp = $c; } 3225 if ($i%3) { $tmp .= $s; } 3226 if ($i%7) { $tmp .= $p; } 3227 if ($i&1) { $tmp .= $c; } 3228 else { $tmp .= $p; } 3229# printf ("%02d=" . unpack("H*", $tmp) . "\n", $i); # for debugging. 3230 $c = $func->($tmp); 3231 } 3232# printf ("F =" . unpack("H*", $c) . "\n"); # final value. 3233 3234 # $c now contains the 'proper' sha_X_crypt hash. However, a strange transposition and 3235 # base-64 conversion. We do the same here, to get the same hash. sha256 and sha512 use 3236 # a different key schedule. I have come up with a way to do this, that is not using a 3237 # table, but using modular walking of the data, 3 values at a time. 3238 # seel http://www.akkadia.org/drepper/SHA-crypt.txt for information 3239 3240 my $inc1; my $inc2; my $mod; my $end; 3241 if ($bits==256) { $inc1=10;$inc2=21;$mod=30;$end=0; } 3242 else { $inc1=21;$inc2=22;$mod=63;$end=21; } 3243 $i = 0; 3244 $tmp = ""; 3245 do { 3246 $tmp .= to64((ord(substr($c,$i,1))<<16) | (ord(substr($c,($i+$inc1)%$mod,1))<<8) | ord(substr($c,($i+$inc1*2)%$mod,1)),4); 3247 $i = ($i + $inc2) % $mod; 3248 } while ($i != $end); 3249 if ($bits==256) { $tmp .= to64((ord(substr($c,31,1))<<8) | ord(substr($c,30,1)),3); } 3250 else { $tmp .= to64(ord(substr($c,63,1)),2); } 3251 3252 return $tmp; 3253} 3254sub sha256crypt { 3255 $salt = get_salt(-16); 3256 my $bin = _sha_crypts(\&sha256, 256, $_[1], $salt); 3257 if ($arg_loops != -1) { return "\$5\$rounds=${arg_loops}\$$salt\$$bin"; } 3258 return "\$5\$$salt\$$bin"; 3259} 3260sub sha512crypt { 3261 $salt = get_salt(-16); 3262 my $bin = _sha_crypts(\&sha512, 512, $_[1], $salt); 3263 if ($arg_loops != -1) { return "\$6\$rounds=${arg_loops}\$$salt\$$bin" } 3264 return "\$6\$$salt\$$bin"; 3265} 3266sub sha1crypt { 3267 $salt = get_salt(8); 3268 my $loops = get_loops(5000); 3269 # actual call to pbkdf1 (that is the last 1 param, it says to use pbkdf1 logic) 3270 $h = pp_pbkdf2($_[1], $salt.'$sha1$'.$loops, $loops, "sha1", 20, 64, 1); 3271 $h = base64_aix($h.substr($h,0,1)); # the hash is padded to 21 bytes, by appending first byte. That is how it is done, dont ask why. 3272 return "\$sha1\$$loops\$$salt\$$h"; 3273} 3274sub xsha512 { 3275 # simple 4 byte salted crypt. No separator char, just raw hash and 'may' have $LION$ 3276 my $ret = ""; 3277 $salt = get_salt(4); 3278 if ($u&1) { $ret = "\$LION\$"; } 3279 $ret .= unpack("H*", $salt).sha512_hex($salt . $_[1]); 3280} 3281sub krb5pa_sha1 { 3282} 3283sub krb5pa_md5 { 3284 require Crypt::RC4; 3285 import Crypt::RC4 qw(RC4); 3286 my $password = $_[1]; 3287 my $datestring = sprintf('20%02u%02u%02u%02u%02u%02uZ', rand(100), rand(12)+1, rand(31)+1, rand(24), rand(60), rand(60)); 3288 my $timestamp = randstr(14,\@chrRawData) . $datestring . randstr(7,\@chrRawData); 3289 my $K = md4(encode("UTF-16LE", $password)); 3290 my $K1 = _hmacmd5($K, pack('N', 0x01000000)); 3291 my $K2 = _hmacmd5($K1, $timestamp); 3292 my $K3 = _hmacmd5($K1, $K2); 3293 my $encrypted = RC4($K3, $timestamp); 3294 return "\$mskrb5\$\$\$".unpack("H*",$K2)."\$".unpack("H*",$encrypted); 3295} 3296sub ipb2 { 3297 $salt = get_salt(5); 3298 return "\$IPB2\$".unpack("H*",$salt)."\$".md5_hex(md5_hex($salt).md5_hex($_[1])); 3299} 3300sub phps { 3301 $salt = get_salt(3); 3302 return "\$PHPS\$".unpack("H*",$salt)."\$".md5_hex(md5_hex($_[1]),$salt); 3303} 3304sub md4p { 3305 $salt = get_salt(8); 3306 return "\$MD4p\$$salt\$".md4_hex($salt, $_[1]); 3307} 3308sub md4s { 3309 $salt = get_salt(8); 3310 return "\$MD4s\$$salt\$".md4_hex($_[1], $salt); 3311} 3312sub sha1p { 3313 $salt = get_salt(8); 3314 return "\$SHA1p\$$salt\$".sha1_hex($salt, $_[1]); 3315} 3316sub sha1s { 3317 $salt = get_salt(8); 3318 return "\$SHA1s\$$salt\$".sha1_hex($_[1], $salt); 3319} 3320sub mysql_sha1 { 3321 return "*".sha1_hex(sha1($_[1])); 3322} 3323sub mysql { 3324 my $nr=0x50305735; 3325 my $nr2=0x12345671; 3326 my $add=7; 3327 for (my $i = 0; $i < length($_[1]); ++$i) { 3328 my $ch = substr($_[1], $i, 1); 3329 if ( !($ch eq ' ' || $ch eq '\t') ) { 3330 my $charNum = ord($ch); 3331 # since perl is big num, we need to force some 32 bit truncation 3332 # at certain 'points' in the algorithm, by doing &= 0xffffffff 3333 $nr ^= ((($nr & 63)+$add)*$charNum) + (($nr << 8)&0xffffffff); 3334 $nr2 += ( (($nr2 << 8)&0xffffffff) ^ $nr); 3335 $add += $charNum; 3336 } 3337 } 3338 return unpack("H*",Uint32BERaw($nr&0x7fffffff)).unpack("H*",Uint32BERaw($nr2&0x7fffffff)); 3339} 3340sub pixmd5 { 3341 my $pass = $_[1]; 3342 if (length($pass)>16) { $pass = substr($pass,0,16); } 3343 my $pass_padd = $pass; 3344 while (length($pass_padd) < 16) { $pass_padd .= "\x0"; } 3345 my $c = md5($pass_padd); 3346 $h = ""; 3347 for ($i = 0; $i < 16; $i+=4) { 3348 my $n = ord(substr($c,$i,1))|(ord(substr($c,$i+1,1))<<8)|(ord(substr($c,$i+2,1))<<16); 3349 $h .= $i64[$n & 0x3f]; 3350 $h .= $i64[($n>>6) & 0x3f]; 3351 $h .= $i64[($n>>12) & 0x3f]; 3352 $h .= $i64[($n>>18) & 0x3f]; 3353 } 3354 return $h; 3355} 3356# salted pix 3357sub asamd5 { 3358 my $pass = $_[1]; 3359 $salt = get_salt(-4); 3360 if (length($pass)>12) { $pass = substr($pass,0,12); } 3361 my $pass_padd = $pass.$salt; 3362 while (length($pass_padd) < 16) { $pass_padd .= "\x0"; } 3363 my $c = md5($pass_padd); 3364 $h = ""; 3365 for ($i = 0; $i < 16; $i+=4) { 3366 my $n = ord(substr($c,$i,1))|(ord(substr($c,$i+1,1))<<8)|(ord(substr($c,$i+2,1))<<16); 3367 $h .= $i64[$n & 0x3f]; 3368 $h .= $i64[($n>>6) & 0x3f]; 3369 $h .= $i64[($n>>12) & 0x3f]; 3370 $h .= $i64[($n>>18) & 0x3f]; 3371 } 3372 return "\$dynamic_20\$$h\$$salt"; 3373} 3374sub mssql12 { 3375 $salt = get_salt(4); 3376 return "0x0200".uc unpack("H*",$salt).uc sha512_hex(encode("UTF-16LE", $_[0]).$salt); 3377} 3378sub mssql05 { 3379 $salt = get_salt(4); 3380 return "0x0100".uc unpack("H*",$salt).uc sha1_hex(encode("UTF-16LE", $_[0]).$salt); 3381} 3382sub mssql { 3383 $salt = get_salt(4); 3384 my $t = uc $_[1]; 3385 if (length($_[1]) == length($t)) { 3386 $out_uc_pass = 1; 3387 return "0x0100".uc unpack("H*",$salt).uc sha1_hex(encode("UTF-16LE", $_[0]).$salt).uc sha1_hex(encode("UTF-16LE", $t).$salt); 3388 } 3389} 3390sub mssql_no_upcase_change { 3391 $salt = get_salt(4); 3392 # converts $c into utf8, from $enc code page, and 'sets' the 'flag' in perl that $c IS a utf8 char. 3393 # since we are NOT doing case changes in this function, it is ASSSUMED that we have been given a properly upcased dictionary 3394 if (!defined $arg_hidden_cp) { print STDERR "ERROR, for this format, you MUST use -hiddencp=CP to set the proper code page conversion\n"; exit(1); } 3395 my $PASS = Encode::decode($arg_hidden_cp, $_[0]); 3396 return "0x0100".uc unpack("H*",$salt).uc sha1_hex(encode("UTF-16LE", $PASS).$salt).uc sha1_hex(encode("UTF-16LE", $PASS).$salt); 3397} 3398 3399sub nsldap { 3400 $h = sha1($_[0]); 3401 return "{SHA}".base64($h); 3402} 3403sub nsldaps { 3404 $salt = get_salt(8); 3405 $h = sha1($_[1],$salt); 3406 $h .= $salt; 3407 return "{SSHA}".base64($h); 3408} 3409sub openssha { 3410 $salt = get_salt(4); 3411 $h = sha1($_[1],$salt); 3412 $h .= $salt; 3413 return "{SSHA}".base64($h); 3414} 3415sub salted_sha1 { 3416 $salt = get_salt(-16, -128); 3417 $h = sha1($_[1],$salt); 3418 $h .= $salt; 3419 return "{SSHA}".base64($h); 3420} 3421sub ns { 3422 $salt = get_salt(7, -7, \@chrHexLo); 3423 $h = md5($salt, ":Administration Tools:", $_[1]); 3424 my $hh = ns_base64_2(8); 3425 substr($hh, 0, 0) = 'n'; 3426 substr($hh, 6, 0) = 'r'; 3427 substr($hh, 12, 0) = 'c'; 3428 substr($hh, 17, 0) = 's'; 3429 substr($hh, 23, 0) = 't'; 3430 substr($hh, 29, 0) = 'n'; 3431 return "$salt\$".$hh; 3432} 3433sub xsha { 3434 $salt = get_salt(4); 3435 return uc unpack("H*",$salt).uc sha1_hex($salt, $_[1]); 3436} 3437sub oracle { 3438 require Crypt::CBC; 3439 # snagged perl source from http://users.aber.ac.uk/auj/freestuff/orapass.pl.txt 3440 $out_username = get_salt(30, -30, \@userNames); 3441 my $pass = $_[1]; 3442 my $userpass = pack('n*', unpack('C*', uc($out_username.$pass))); 3443 $userpass .= pack('C', 0) while (length($userpass) % 8); 3444 my $key = pack('H*', "0123456789ABCDEF"); 3445 my $iv = pack('H*', "0000000000000000"); 3446 my $cr1 = new Crypt::CBC(-literal_key => 1, -cipher => "DES", -key => $key, -iv => $iv, -header => "none" ); 3447 my $key2 = substr($cr1->encrypt($userpass), length($userpass)-8, 8); 3448 my $cr2 = new Crypt::CBC( -literal_key => 1, -cipher => "DES", -key => $key2, -iv => $iv, -header => "none" ); 3449 my $hash = substr($cr2->encrypt($userpass), length($userpass)-8, 8); 3450 return uc(unpack('H*', $hash)); 3451} 3452sub oracle_no_upcase_change { 3453 require Crypt::CBC; 3454 # snagged perl source from http://users.aber.ac.uk/auj/freestuff/orapass.pl.txt 3455 my $out_username = get_salt(30, -30, \@userNames); 3456 # converts $c into utf8, from $enc code page, and 'sets' the 'flag' in perl that $c IS a utf8 char. 3457 # since we are NOT doing case changes in this function, it is ASSSUMED that we have been given a properly upcased dictionary 3458 if (!defined $arg_hidden_cp) { print STDERR "ERROR, for this format, you MUST use -hiddencp=CP to set the proper code page conversion\n"; exit(1); } 3459 3460 my $pass = $out_username . Encode::decode($arg_hidden_cp, $_[0]); 3461 3462 my $userpass = encode("UTF-16BE", $pass); 3463 $userpass .= pack('C', 0) while (length($userpass) % 8); 3464 my $key = pack('H*', "0123456789ABCDEF"); 3465 my $iv = pack('H*', "0000000000000000"); 3466 my $cr1 = new Crypt::CBC(-literal_key => 1, -cipher => "DES", -key => $key, -iv => $iv, -header => "none" ); 3467 my $key2 = substr($cr1->encrypt($userpass), length($userpass)-8, 8); 3468 my $cr2 = new Crypt::CBC( -literal_key => 1, -cipher => "DES", -key => $key2, -iv => $iv, -header => "none" ); 3469 my $hash = substr($cr2->encrypt($userpass), length($userpass)-8, 8); 3470 return uc(unpack('H*', $hash)); 3471} 3472sub oracle11 { 3473 $salt=get_salt(10); 3474 return uc sha1_hex($_[1], $salt).uc unpack("H*",$salt); 3475} 3476sub hdaa { 3477 # {"$response$679066476e67b5c7c4e88f04be567f8b$user$myrealm$GET$/$8c12bd8f728afe56d45a0ce846b70e5a$00000001$4b61913cec32e2c9$auth", "nocode"}, 3478 my $user = randusername(20); 3479 my $realm = randusername(10); 3480 my $url = randstr(rand(64)+1); 3481 my $nonce = randstr(rand(32)+1, \@chrHexLo); 3482 my $clientNonce = randstr(rand(32)+1, \@chrHexLo); 3483 my $h1 = md5_hex($user, ":".$realm.":", $_[1]); 3484 my $h2 = md5_hex("GET:/$url"); 3485 my $resp = md5_hex($h1, ":", $nonce, ":00000001:", $clientNonce, ":auth:", $h2); 3486 return "\$response\$$resp\$$user\$$realm\$GET\$/$url\$$nonce\$00000001\$$clientNonce\$auth"; 3487} 3488sub setup_des_key { 3489 # ported from the ntlmv1_mschap2_fmt_plug.c by magnum. Changed to 3490 # use (& 254) by JimF so that all parity bits are 0. It did work 3491 # with parity bits being mixed 0 and 1, but when all bits are set 3492 # to 0, we can see that the function is correct. 3493 my @key_56 = split(//, shift); 3494 my $key = ""; 3495 $key = chr( ord($key_56[0]) & 254); 3496 $key .= chr(((ord($key_56[0]) << 7) | (ord($key_56[1]) >> 1)) & 254); 3497 $key .= chr(((ord($key_56[1]) << 6) | (ord($key_56[2]) >> 2)) & 254); 3498 $key .= chr(((ord($key_56[2]) << 5) | (ord($key_56[3]) >> 3)) & 254); 3499 $key .= chr(((ord($key_56[3]) << 4) | (ord($key_56[4]) >> 4)) & 254); 3500 $key .= chr(((ord($key_56[4]) << 3) | (ord($key_56[5]) >> 5)) & 254); 3501 $key .= chr(((ord($key_56[5]) << 2) | (ord($key_56[6]) >> 6)) & 254); 3502 $key .= chr( (ord($key_56[6]) << 1) & 254); 3503 return $key; 3504} 3505# This produces only NETNTLM ESS hashes, in L0phtcrack format 3506sub netntlm_ess { 3507 require Crypt::ECB; 3508 import Crypt::ECB qw(encrypt); 3509 my $password = $_[1]; 3510 my $domain = get_salt(15, -15); 3511 my $nthash = md4(encode("UTF-16LE", $password)); 3512 $nthash .= "\x00"x5; 3513 my $s_challenge = get_iv(8); 3514 my $c_challenge = get_content(8); 3515 my $challenge = substr(md5($s_challenge.$c_challenge), 0, 8); 3516 my $ntresp = Crypt::ECB::encrypt(setup_des_key(substr($nthash, 0, 7)), 'DES', $challenge, ecb_padding_none); 3517 $ntresp .= Crypt::ECB::encrypt(setup_des_key(substr($nthash, 7, 7)), 'DES', $challenge, ecb_padding_none); 3518 $ntresp .= Crypt::ECB::encrypt(setup_des_key(substr($nthash, 14, 7)), 'DES', $challenge, ecb_padding_none); 3519 my $type = "ntlm ESS"; 3520 my $lmresp = $c_challenge . "\0"x16; 3521 #printf("%s\\%s:::%s:%s:%s::%s:%s\n", $domain, "u$u-netntlm", unpack("H*",$lmresp), unpack("H*",$ntresp), unpack("H*",$s_challenge), $_[0], $type); 3522 $l0pht_fmt = 1; 3523 return "u$u".":::".unpack("H*",$lmresp).":".unpack("H*",$ntresp).":".unpack("H*",$s_challenge); 3524} 3525# Alias for l0phtcrack 3526sub netntlm { 3527 return l0phtcrack(@_); 3528} 3529# This produces NETHALFLM, NETLM and non-ESS NETNTLM hashes in L0pthcrack format 3530sub l0phtcrack { 3531 require Crypt::ECB; 3532 import Crypt::ECB qw(encrypt); 3533 my $password = $_[1]; 3534 my $domain = get_salt(15); 3535 my $nthash = md4(encode("UTF-16LE", $password)); 3536 $nthash .= "\x00"x5; 3537 my $lmhash; my $lmresp; 3538 my $challenge = get_iv(8); 3539 my $ntresp = Crypt::ECB::encrypt(setup_des_key(substr($nthash, 0, 7)), 'DES', $challenge, ecb_padding_none); 3540 $ntresp .= Crypt::ECB::encrypt(setup_des_key(substr($nthash, 7, 7)), 'DES', $challenge, ecb_padding_none); 3541 $ntresp .= Crypt::ECB::encrypt(setup_des_key(substr($nthash, 14, 7)), 'DES', $challenge, ecb_padding_none); 3542 my $type; 3543 if (length($password) > 14) { 3544 $type = "ntlm only"; 3545 $lmresp = $ntresp; 3546 } else { 3547 $type = "lm and ntlm"; 3548 $lmhash = LANMan($password); 3549 $lmhash .= "\x00"x5; 3550 $lmresp = Crypt::ECB::encrypt(setup_des_key(substr($lmhash, 0, 7)), 'DES', $challenge, ecb_padding_none); 3551 $lmresp .= Crypt::ECB::encrypt(setup_des_key(substr($lmhash, 7, 7)), 'DES', $challenge, ecb_padding_none); 3552 $lmresp .= Crypt::ECB::encrypt(setup_des_key(substr($lmhash, 14, 7)), 'DES', $challenge, ecb_padding_none); 3553 } 3554 #printf("%s\\%s:::%s:%s:%s::%s:%s\n", $domain, "u$u-netntlm", unpack("H*",$lmresp), unpack("H*",$ntresp), unpack("H*",$challenge), $_[0], $type); 3555 $l0pht_fmt = 1; 3556 return "u$u".":::".unpack("H*",$lmresp).":".unpack("H*",$ntresp).":".unpack("H*",$challenge); 3557} 3558sub hsrp { 3559 if (length($_[1]) > 55) { return; } 3560 $h = pad_md64($_[1]); 3561 $salt = get_salt(16,-64); 3562 $h = md5($h.$salt.$_[1]); 3563 return '$hsrp$'.unpack("H*",$salt).'$'.unpack('H*', $h); 3564} 3565sub netlmv2 { 3566 my $pwd = $_[1]; 3567 my $nthash = md4(encode("UTF-16LE", $pwd)); 3568 my $domain = get_salt(15); 3569 my $user = get_username(20); 3570 my $identity = Encode::encode("UTF-16LE", uc($user).$domain); 3571 my $s_challenge = get_iv(8); 3572 my $c_challenge = get_content(8); 3573 my $lmresponse = _hmacmd5(_hmacmd5($nthash, $identity), $s_challenge.$c_challenge); 3574 #printf("%s\\%s:::%s:%s:%s::%s:netlmv2\n", $domain, $user, unpack("H*",$s_challenge), unpack("H*",$lmresponse), unpack("H*",$c_challenge), $_[0]); 3575 $l0pht_fmt = 1; 3576 return "$domain\\$user".":::".unpack("H*",$s_challenge).":".unpack("H*",$lmresponse).":".unpack("H*",$c_challenge); 3577} 3578sub netntlmv2 { 3579 my $pwd = $_[1]; 3580 my $nthash = md4(encode("UTF-16LE", $pwd)); 3581 my $user = get_username(20); 3582 my $domain = get_salt(15); 3583 my $identity = Encode::encode("UTF-16LE", uc($user).$domain); 3584 my $s_challenge = get_iv(8); 3585 my $c_challenge = get_content(8); 3586 my $temp = '\x01\x01' . "\x00"x6 . "abdegagt" . $c_challenge . "\x00"x4 . "flasjhstgluahr" . '\x00'; 3587 my $ntproofstr = _hmacmd5(_hmacmd5($nthash, $identity), $s_challenge.$temp); 3588 # $ntresponse = $ntproofstr.$temp but we separate them with a : 3589 #printf("%s\\%s:::%s:%s:%s::%s:netntlmv2\n", $domain, $user, unpack("H*",$s_challenge), unpack("H*",$ntproofstr), unpack("H*",$temp), $_[0]); 3590 $l0pht_fmt = 1; 3591 return "$domain\\$user".":::".unpack("H*",$s_challenge).":".unpack("H*",$ntproofstr).":".unpack("H*",$temp); 3592} 3593sub mschapv2 { 3594 require Crypt::ECB; 3595 import Crypt::ECB qw(encrypt); 3596 my $pwd = $_[1]; 3597 my $nthash = md4(encode("UTF-16LE", $pwd)); 3598 my $user = get_username(20); 3599 my $p_challenge = get_iv(16); 3600 my $a_challenge = get_content(16); 3601 my $ctx = Digest::SHA->new('sha1'); 3602 $ctx->add($p_challenge); 3603 $ctx->add($a_challenge); 3604 $ctx->add($user); 3605 my $challenge = substr($ctx->digest, 0, 8); 3606 my $response = Crypt::ECB::encrypt(setup_des_key(substr($nthash, 0, 7)), 'DES', $challenge, ecb_padding_none); 3607 $response .= Crypt::ECB::encrypt(setup_des_key(substr($nthash, 7, 7)), 'DES', $challenge, ecb_padding_none); 3608 $response .= Crypt::ECB::encrypt(setup_des_key(substr($nthash . "\x00" x 5, 14, 7)), 'DES', $challenge, ecb_padding_none); 3609 #printf("%s:::%s:%s:%s::%s:mschapv2\n", $user, unpack("H*",$a_challenge), unpack("H*",$response), unpack("H*",$p_challenge), $_[0]); 3610 $l0pht_fmt = 1; 3611 return "$user".":::".unpack("H*",$a_challenge).":".unpack("H*",$response).":".unpack("H*",$p_challenge); 3612} 3613sub crc_32 { 3614 my $pwd = $_[1]; 3615 if (rand(256) > 245) { 3616 my $init = rand(2000000000); 3617 return "\$crc32\$".unpack("H*",Uint32BERaw($init)).".".unpack("H*",Uint32BERaw(crc32($pwd,$init))); 3618 } else { 3619 return "\$crc32\$00000000.".unpack("H*",Uint32BERaw(crc32($pwd))); 3620 } 3621} 3622sub dummy { 3623 return '$dummy$'.unpack('H*', $_[1]); 3624} 3625sub raw_gost { 3626 require Digest::GOST; 3627 import Digest::GOST qw(gost gost_hex gost_base64); 3628 return "\$gost\$".gost_hex($_[1]); 3629} 3630sub raw_gost_cp { 3631 # HMMM. Not sure how to do this at this time in perl. 3632 #print STDERR "raw_gost_cp : THIS ONE STILL LEFT TO DO\n"; 3633} 3634sub pwsafe { 3635 $salt=get_salt(32); 3636 my $digest = sha256($_[1],$salt); 3637 my $loops = get_loops(2048); 3638 my $i; 3639 for ($i = 0; $i <= $loops; ++$i) { 3640 $digest = sha256($digest); 3641 } 3642 return "\$pwsafe\$\*3\*".unpack('H*', $salt)."\*$loops\*".unpack('H*', $digest); 3643} 3644sub django { 3645 $salt=get_salt(12,-32); 3646 my $loops = get_loops(10000); 3647 return "\$django\$\*1\*pbkdf2_sha256\$$loops\$$salt\$".base64(pp_pbkdf2($_[1], $salt, $loops, "sha256", 32, 64)); 3648} 3649sub django_scrypt { 3650 require Crypt::ScryptKDF; 3651 import Crypt::ScryptKDF qw(scrypt_b64); 3652 $salt=get_salt(12,12,\@i64); 3653 my $N=14; my $r=8; my $p=1; my $bytes=64; 3654 my $h = scrypt_b64($_[1],$salt,1<<$N,$r,$p,$bytes); 3655 return "scrypt\$$salt\$$N\$$r\$$p\$$bytes\$$h"; 3656} 3657sub scrypt { 3658 require Crypt::ScryptKDF; 3659 import Crypt::ScryptKDF qw(scrypt_raw); 3660 $salt=get_salt(12,-64,\@i64); 3661 my $N=14; my $r=8; my $p=1; my $bytes=32; 3662 my $h = base64i(scrypt_raw($_[1],$salt,1<<$N,$r,$p,$bytes)); 3663 # C is 14, 6.... is 8 and /.... is 1 ($N, $r, $p) 3664 if (length($h) > 43) { $h = substr($h,0,43); } 3665 return "\$7\$C6..../....$salt\$".$h; 3666} 3667sub aix_ssha1 { 3668 $salt=get_salt(16); 3669 return "{ssha1}06\$$salt\$".base64_aix(pp_pbkdf2($_[1],$salt,(1<<6),"sha1",20, 64)); 3670} 3671sub aix_ssha256 { 3672 $salt=get_salt(16); 3673 return "{ssha256}06\$$salt\$".base64_aix(pp_pbkdf2($_[1],$salt,(1<<6),"sha256",32, 64)); 3674} 3675sub aix_ssha512 { 3676 $salt=get_salt(16); 3677 return "{ssha512}06\$$salt\$".base64_aix(pp_pbkdf2($_[1],$salt,(1<<6),"sha512",64, 128)); 3678} 3679# there are many 'formats' handled, but we just do the cannonical $pbkdf2-hmac-sha512$ one. 3680# there could also be $ml$ and grub.pbkdf2.sha512. as the signatures. but within prepare() of pbkdf2-hmac-sha512_fmt, 3681# they all get converted to this one, so that is all I plan on using. 3682sub pbkdf2_hmac_sha512 { 3683 $salt=get_salt(16,-107); 3684 my $itr = get_loops(10000); 3685 return "\$pbkdf2-hmac-sha512\$${itr}.".unpack("H*", $salt).".".pp_pbkdf2_hex($_[1],$salt,$itr,"sha512",64, 128); 3686} 3687sub pbkdf2_hmac_sha256 { 3688 $salt=get_salt(16, -179); 3689 my $itr = get_loops(12000); 3690 my $s64 = base64pl($salt); 3691 my $h64 = substr(base64pl(pack("H*",pp_pbkdf2_hex($_[1],$salt,$itr,"sha256",32, 64))),0,43); 3692 while (substr($s64, length($s64)-1) eq "=") { $s64 = substr($s64, 0, length($s64)-1); } 3693 return "\$pbkdf2-sha256\$${itr}\$${s64}\$${h64}"; 3694} 3695sub pbkdf2_hmac_sha1 { 3696 $salt=get_salt(16, -179); 3697 my $itr = get_loops(1000); 3698 return "\$pbkdf2-hmac-sha1\$${itr}.".unpack("H*", $salt).".".pp_pbkdf2_hex($_[1],$salt,$itr,"sha1",20, 64); 3699} 3700sub pbkdf2_hmac_md4 { 3701 $salt=get_salt(16, -179); 3702 my $itr = get_loops(1000); 3703 return "\$pbkdf2-hmac-md4\$${itr}\$".unpack("H*", $salt).'$'.pp_pbkdf2_hex($_[1],$salt,$itr,"md4",16, 64); 3704} 3705sub pbkdf2_hmac_md5 { 3706 $salt=get_salt(16, -179); 3707 my $itr = get_loops(1000); 3708 return "\$pbkdf2-hmac-md5\$${itr}\$".unpack("H*", $salt).'$'.pp_pbkdf2_hex($_[1],$salt,$itr,"md5",16, 64); 3709} 3710sub pbkdf2_hmac_sha1_pkcs5s2 { 3711 $salt=get_salt(16); 3712 my $itr = get_loops(10000); 3713 my $h = base64pl($salt.pp_pbkdf2($_[1],$salt,$itr,"sha1",20, 64)); 3714 return "{PKCS5S2}$h"; 3715} 3716sub pbkdf2_hmac_sha1_p5k2 { 3717 $salt=get_salt(16); 3718 my $itr = get_loops(1000); 3719 my $itrs = sprintf("%x", $itr); 3720 return "\$p5k2\$$itrs\$".base64($salt).'$'.base64(pack("H*",pp_pbkdf2_hex($_[1],$salt,$itr,"sha1",20, 64))); 3721} 3722sub drupal7 { 3723 $salt=get_salt(8,-8); 3724 # We only handle the 'C' count (16384) 3725 my $h = sha512($salt.$_[1]); 3726 my $i = 16384; 3727 do { $h = sha512($h.$_[1]); } while (--$i > 0); 3728 return "\$S\$C".$salt.substr(base64i($h),0,43); 3729} 3730sub epi { 3731 $salt=get_salt(30); 3732 return "0x".uc(unpack("H*", $salt))." 0x".uc(sha1_hex(substr($salt,0,29),$_[1], "\0")); 3733} 3734sub episerver_sha1 { 3735 $salt=get_salt(16); 3736 return "\$episerver\$\*0\*".base64($salt)."\*".sha1_base64($salt, Encode::encode("UTF-16LE", $_[1])); 3737} 3738sub episerver_sha256 { 3739 $salt=get_salt(16); 3740 return "\$episerver\$\*1\*".base64($salt)."\*".sha256_base64($salt, Encode::encode("UTF-16LE", $_[1])); 3741} 3742sub hmailserver { 3743 $salt=get_salt(6,6,\@chrHexLo); 3744 return "$salt".sha256_hex($salt,$_[1]); 3745} 3746sub nukedclan { 3747 $salt=get_salt(20, 20, \@chrAsciiTextNum); 3748 my $decal=get_iv(1, \@chrHexLo); 3749 my $pass_hash = sha1_hex($_[1]); 3750 my $i = 0; my $k; 3751 $k = hex($decal); 3752 3753 my $out = ""; 3754 for (; $i < 40; $i += 1, $k += 1) { 3755 $out .= substr($pass_hash, $i, 1); 3756 if ($k > 19) { $k = 0; } 3757 $out .= substr($salt, $k, 1); 3758 } 3759 return "\$nk\$\*".unpack("H*", $salt)."\*#$decal".md5_hex($out); 3760} 3761sub skey_fold { 3762 my $a; my $b; 3763 if ($_[1] == 4) { 3764 my( $f0, $f1, $f2, $f3) = unpack('I4', $_[0]); 3765 $a = pack('I', $f0) ^ pack('I', $f2); 3766 $b = pack('I', $f1) ^ pack('I', $f3); 3767 } else { 3768 my( $f0, $f1, $f2, $f3, $f4) = unpack('I5', $_[0]); 3769 $a = pack('I', $f0) ^ pack('I', $f2) ^ pack('I', $f4); 3770 $b = pack('I', $f1) ^ pack('I', $f3); 3771 } 3772 return $a.$b; 3773} 3774sub skey_md5 { 3775 $salt=get_salt(8, 8, \@chrAsciiTextNumLo); 3776 $salt = lc $salt; 3777 my $cnt=get_iv(3, \@chrAsciiNum); 3778 if (defined $argmode) {$cnt=$argmode;} 3779 my $h = md5($salt.$_[1]); 3780 $h = skey_fold($h, 4); 3781 my $i = $cnt; 3782 while ($i-- > 0) { 3783 $h = md5($h); 3784 $h = skey_fold($h, 4) 3785 } 3786 return "md5 $cnt $salt ".unpack("H*", $h); 3787} 3788sub skey_md4 { 3789 $salt=get_salt(8, 8, \@chrAsciiTextNumLo); 3790 $salt = lc $salt; 3791 my $cnt=get_iv(3, \@chrAsciiNum); 3792 if (defined $argmode) {$cnt=$argmode;} 3793 my $h = md4($salt.$_[1]); 3794 $h = skey_fold($h, 4); 3795 my $i = $cnt; 3796 while ($i-- > 0) { 3797 $h = md4($h); 3798 $h = skey_fold($h, 4) 3799 } 3800 return "md4 $cnt $salt ".unpack("H*", $h); 3801} 3802sub skey_sha1 { 3803 $salt=get_salt(8, 8, \@chrAsciiTextNumLo); 3804 $salt = lc $salt; 3805 my $cnt=get_iv(3, \@chrAsciiNum); 3806 if (defined $argmode) {$cnt=$argmode;} 3807 my $h = sha1($salt.$_[1]); 3808 $h = skey_fold($h, 5); 3809 my $i = $cnt; 3810 while ($i-- > 0) { 3811 $h = sha1($h); 3812 $h = skey_fold($h, 5) 3813 } 3814 return "sha1 $cnt $salt ".unpack("H*", $h); 3815} 3816sub skey_rmd160 { 3817 $salt=get_salt(8, 8, \@chrAsciiTextNumLo); 3818 $salt = lc $salt; 3819 my $cnt=get_iv(3, \@chrAsciiNum); 3820 if (defined $argmode) {$cnt=$argmode;} 3821 my $h = ripemd160($salt.$_[1]); 3822 $h = skey_fold($h, 5); 3823 my $i = $cnt; 3824 while ($i-- > 0) { 3825 $h = ripemd160($h); 3826 $h = skey_fold($h, 5) 3827 } 3828 return "rmd160 $cnt $salt ".unpack("H*", $h); 3829} 3830sub radmin { 3831 my $pass = $_[1]; 3832 while (length($pass) < 100) { $pass .= "\0"; } 3833 return "\$radmin2\$".md5_hex($pass); 3834} 3835sub raw_sha { 3836# this method sux, but I can find NO sha0 anywhere else in perl. 3837# It does exist in "openssl dgst -sha" however. Slow, but works. 3838 #$h = `echo -n '$_[1]' | openssl dgst -sha`; 3839 #chomp($h); 3840 #if (substr($h,0,9) eq "(stdin)= ") { $h = substr($h,9); } 3841 #if (substr($h,0,8) eq "(stdin)=") { $h = substr($h,8); } 3842 #print "u$u-raw_sha:$h:$u:0:$_[0]::\n"; 3843 3844 # found a way :) 3845 net_ssl_init; 3846 my $md = Net::SSLeay::EVP_get_digestbyname("sha"); 3847 $h = Net::SSLeay::EVP_Digest($_[1], $md); 3848 return unpack("H*",$h); 3849} 3850sub sybasease { 3851 $salt=get_salt(8, 8, \@chrAsciiTextNum); 3852 my $h = Encode::encode("UTF-16BE", $_[0]); 3853 while (length($h) < 510) { $h .= "\0\0"; } 3854 return "0xc007".unpack("H*",$salt).sha256_hex($h.$salt); 3855} 3856sub wbb3 { 3857 # Simply 'dynamic' format: sha1($s.sha1($s.sha1($p))) 3858 $salt=get_salt(40, 40, \@chrHexLo); 3859 return "\$wbb3\$\*1\*$salt\*".sha1_hex($salt,sha1_hex($salt,sha1_hex($_[1]))); 3860} 3861############################################################ 3862# DYNAMIC code. Quite a large block. Many 'fixed' formats, and then a parser 3863############################################################ 3864sub pad16 { # used by pad16($p) This will null pad a string to 16 bytes long 3865 my $p = $_[0]; 3866 while (length($p) < 16) { 3867 $p .= "\0"; 3868 } 3869 return $p; 3870} 3871sub pad20 { # used by pad20($p) This will null pad a string to 20 bytes long 3872 my $p = $_[0]; 3873 while (length($p) < 20) { 3874 $p .= "\0"; 3875 } 3876 return $p; 3877} 3878sub pad100 { # used by pad100($p) This will null pad a string to 100 bytes long for dyna1010 3879 my $p = $_[0]; 3880 while (length($p) < 100) { 3881 $p .= "\0"; 3882 } 3883 return $p; 3884} 3885# used by pad_md64($p) This will null pad a string to 64 bytes long, appends the 0x80 after current length, and puts length 3886# 'bits' (i.e. length << 3) in proper place for md5 processing. HSRP format uses this. 3887sub pad_md64 { 3888 my $p = $_[0]; 3889 my $len = length($p); 3890 $p .= "\x80"; 3891 while (length($p) < 56) { 3892 $p .= "\0"; 3893 } 3894 $p .= chr(($len*8)&0xFF); 3895 $p .= chr(($len*8)/256); 3896 while (length($p) < 64) { 3897 $p .= "\0"; 3898 } 3899 return $p; 3900} 3901 3902sub dynamic_17 { #dynamic_17 --> phpass ($P$ or $H$) phpass 3903 $salt=get_salt(8); 3904 my $h = PHPass_hash($_[1], 11, $salt); 3905 return "\$dynamic_17\$".substr(base64i($h),0,22)."\$".to_phpbyte(11).$salt; 3906} 3907sub dynamic_19 { #dynamic_19 --> Cisco PIX (MD5) 3908 my $pass; 3909 if (length($_[1])>16) { $pass = substr($_[1],0,16); } else { $pass = $_[1]; } 3910 my $pass_padd = $pass; 3911 while (length($pass_padd) < 16) { $pass_padd .= "\x0"; } 3912 my $c = md5($pass_padd); 3913 $h = ""; 3914 for ($i = 0; $i < 16; $i+=4) { 3915 my $n = ord(substr($c,$i,1))|(ord(substr($c,$i+1,1))<<8)|(ord(substr($c,$i+2,1))<<16); 3916 $h .= $i64[$n & 0x3f]; 3917 $h .= $i64[($n>>6) & 0x3f]; 3918 $h .= $i64[($n>>12) & 0x3f]; 3919 $h .= $i64[($n>>18) & 0x3f]; 3920 } 3921 return "\$dynamic_19\$$h"; 3922} 3923sub dynamic_20 { #dynamic_20 --> Cisco PIX (MD5 salted) 3924 if (defined $argsalt) { $salt = $argsalt; if (length($salt) > 4) { $salt = substr($salt,0,4); } } else { $salt = randstr(4); } 3925 my $pass; 3926 if (length($_[1])>12) { $pass = substr($_[1],0,12); } else { $pass = $_[1]; } 3927 my $pass_padd = $pass . $salt; 3928 while (length($pass_padd) < 16) { $pass_padd .= "\x0"; } 3929 my $c = md5($pass_padd); 3930 $h = ""; 3931 for ($i = 0; $i < 16; $i+=4) { 3932 my $n = ord(substr($c,$i,1))|(ord(substr($c,$i+1,1))<<8)|(ord(substr($c,$i+2,1))<<16); 3933 $h .= $i64[$n & 0x3f]; 3934 $h .= $i64[($n>>6) & 0x3f]; 3935 $h .= $i64[($n>>12) & 0x3f]; 3936 $h .= $i64[($n>>18) & 0x3f]; 3937 } 3938 return "\$dynamic_20\$$h\$$salt"; 3939} 3940sub dynamic_27 { #dynamic_27 --> OpenBSD MD5 3941 if (defined $argsalt) { $salt = $argsalt; } else { $salt=randstr(8); } 3942 $h = md5crypt_hash($_[1], $salt, "\$1\$"); 3943 return "\$dynamic_27\$".substr($h,15)."\$$salt"; 3944} 3945sub dynamic_28 { # Apache MD5 3946 if (defined $argsalt) { $salt = $argsalt; } else { $salt=randstr(8); } 3947 $h = md5crypt_hash($_[1], $salt, "\$apr1\$"); 3948 return "\$dynamic_28\$".substr($h,15)."\$$salt"; 3949} 3950sub dynamic_1590 { 3951 # as400-ssha1 3952 $out_username = get_username(10); 3953 my $uname = uc $out_username; 3954 while (length($uname) < 10) { $uname .= ' '; } 3955 return '$dynamic_1590$'.uc unpack("H*",sha1(encode("UTF-16BE", $uname.$_[1]))) . '$HEX$' . uc unpack("H*",encode("UTF-16BE", $uname)); 3956} 3957sub dynamic_compile { 3958 my $dynamic_args = $_[0]; 3959 if (length($dynamic_args) == 0) { 3960 print STDERR "usage: $0 [-h|-?] HashType ... [ < wordfile ]\n"; 3961 print STDERR "\n"; 3962 print STDERR "NOTE, for DYNAMIC usage: here are the possible formats:\n"; 3963 print STDERR " dynamic_# # can be any of the built in dynamic values. So,\n"; 3964 print STDERR " dynamic_0 will output for md5(\$p) format\n"; 3965 print STDERR "\n"; 3966 print STDERR " dynamic=num=#,format=FMT_EXPR[,saltlen=#][,salt=true|ashex|tohex]\n"; 3967 print STDERR " [,pass=uni][,salt2len=#][,const#=value][,usrname=true|lc|uc|uni]\n"; 3968 print STDERR " [,single_salt=1][passcase=uc|lc]]\n"; 3969 # NOTE, there is also debug=1 will dump the symtab, and optimize=1 optimizes the parse. 3970 print STDERR "\n"; 3971 print STDERR "The FMT_EXPR is somewhat 'normal' php type format, with some extensions.\n"; 3972 print STDERR " A format such as md5(\$p.\$s.md5(\$p)) is 'normal'. Dots must be used\n"; 3973 print STDERR " where needed. Also, only a SINGLE expression is valid. Using an\n"; 3974 print STDERR " expression such as md5(\$p).md5(\$s) is not valid.\n"; 3975 print STDERR " The extensions are:\n"; 3976 print STDERR " Added \$s2 (if 2nd salt is defined),\n"; 3977 print STDERR " Added \$c1 to \$c9 for constants (must be defined in const#= values)\n"; 3978 print STDERR " Added \$u if user name (normal, upper/lower case or unicode convert)\n"; 3979 print STDERR " Handle utf16() and utf16be() for items. So md5(utf16(\$p)) gives md5 of unicode password\n"; 3980 print STDERR " Handle md5, sha1, md4 sha2 (sha224,sha256,sha384,sha512) gost whirlpool tiger and haval crypts.\n"; 3981 print STDERR " Handle MD5, SHA1, MD4 SHA2 (all uc(sha2) types) GOST WHILRPOOL TIGER HAVAL which output hex in uppercase.\n"; 3982 print STDERR " Handle md5_64, sha1_64, md4_64, sha2*_64 gost_64 whirlpool_64 tiger_64 haval_64 which output in\n"; 3983 print STDERR " 'mime-standard' base-64 which is \"A-Za-z0-9+/\"\n"; 3984 print STDERR " Handle md5_64c, sha1_64c, md4_64c, sha2*_64c gost_64c, whirlpool_64c which output in\n"; 3985 print STDERR " 'crypt character set' base-64 which is \"./0-9A-Za-z\" \n"; 3986 print STDERR " Handle md5_raw, sha1_raw, md4_raw, sha2*_raw gost_raw whirlpool_raw which output\n"; 3987 print STDERR " is the 'binary' 16 or 20 bytes of data. CAN not be used as 'outside'\n"; 3988 print STDERR " function\n"; 3989 print STDERR " User names are handled by usrname= if true, then \'normal\' user names\n"; 3990 print STDERR " used, if lc, then user names are converted to lowercase, if uc then\n"; 3991 print STDERR " they are converted to UPPER case. if uni they are converted into unicode\n"; 3992 print STDERR " If constants are used, then they have to start from const1= and can \n"; 3993 print STDERR " go up to const9= , but they need to be in order, and start from one (1).\n"; 3994 print STDERR " So if there are 3 constants in the expression, then the line needs to\n"; 3995 print STDERR " contain const1=v1,const2=v2,const3=v3 (v's replaced by proper constants)\n"; 3996 print STDERR " if pw=uni is used, the passwords are converted into unicode before usage\n"; 3997 die; 3998 } 3999 if ($dynamic_args =~ /^[+\-]?\d*.?\d+$/) { # is $dynamic_args a 'simple' number? 4000 #my $func = "dynamic_" . $dynamic_args; 4001 #return $func; 4002 4003 # before we had custom functions for 'all' of the builtin's. Now we use the compiler 4004 # for most of them (in the below switch statement) There are only a handful where 4005 # we keep the 'original' hard coded function (7,17,19,20,21,27,28) 4006 4007 my $func = "dynamic_" . $dynamic_args; 4008 my $prefmt = "num=$dynamic_args,optimize=1,format="; 4009 my $fmt; 4010 4011 if ($dynamic_args >= 50 && $dynamic_args <= 1000) { 4012 my $dyna_func_which = $dynamic_args%10; 4013 my $dyna_func_range = $dynamic_args-$dyna_func_which; 4014 my %dyna_hashes = ( 4015 50=>'sha224', 60=>'sha256', 70=>'sha384', 80=>'sha512', 90=>'gost', 4016 100=>'whirlpool', 110=>'tiger', 120=>'ripemd128', 130=>'ripemd160', 140=>'ripemd256', 4017 150=>'ripemd320', 370=>'sha3_224', 380=>'sha3_256', 390=>'sha3_384', 400=>'sha3_512', 4018 410=>'keccak_256', 420=>'keccak_512', 310=>'md2' ); 4019 4020# NOTE, these are still part of dynamic in JtR, but may not be handled here. 4021# Some may NOT be able to be done within perl. Haval does have some Perl 4022# support, but not nearly as much as john has. Skein is the wrong version 4023# perl is v1.2 and john is v1.3. John implements skein-512-224 skein-512-256 4024# skein-512-384 and skein-512-512 4025#dynamic_160 -->haval128_3($p) 4026#dynamic_170 -->haval128_4($p) 4027#dynamic_180 -->haval128_5($p) 4028#dynamic_190 -->haval160_3($p) 4029#dynamic_200 -->haval160_4($p) 4030#dynamic_210 -->haval160_5($p) 4031#dynamic_220 -->haval192_3($p) 4032#dynamic_230 -->haval192_4($p) 4033#dynamic_240 -->haval192_5($p) 4034#dynamic_250 -->haval224_3($p) 4035#dynamic_260 -->haval224_4($p) 4036#dynamic_270 -->haval224_5($p) 4037#dynamic_280 -->haval256_3($p) 4038#dynamic_290 -->haval256_4($p) 4039#dynamic_300 -->haval256_5($p) 4040#dynamic_320 -->panama($p) 4041#dynamic_330 -->skein224($p) 4042#dynamic_340 -->skein256($p) 4043#dynamic_350 -->skein384($p) 4044#dynamic_360 -->skein512($p) 4045 my $ht = $dyna_hashes{$dynamic_args-$dyna_func_which}; 4046 if (!defined($ht)) { return $func; } 4047 SWITCH: { 4048 $dyna_func_which==0 && do {$fmt="$ht(\$p)"; last SWITCH; }; 4049 $dyna_func_which==1 && do {$fmt="$ht(\$s.\$p),saltlen=6"; last SWITCH; }; 4050 $dyna_func_which==2 && do {$fmt="$ht(\$p.\$s)"; last SWITCH; }; 4051 $dyna_func_which==3 && do {$fmt="$ht($ht(\$p))"; last SWITCH; }; 4052 $dyna_func_which==4 && do {$fmt="$ht($ht"."_raw(\$p))"; last SWITCH; }; 4053 $dyna_func_which==5 && do {$fmt="$ht($ht(\$p).\$s),saltlen=6"; last SWITCH; }; 4054 $dyna_func_which==6 && do {$fmt="$ht(\$s.$ht(\$p)),saltlen=6"; last SWITCH; }; 4055 $dyna_func_which==7 && do {$fmt="$ht($ht(\$s).$ht(\$p)),saltlen=6"; last SWITCH; }; 4056 $dyna_func_which==8 && do {$fmt="$ht($ht(\$p).$ht(\$p))"; last SWITCH; }; 4057 return $func; 4058 } 4059 } else { 4060 SWITCH: { 4061 $dynamic_args==0 && do {$fmt='md5($p)'; last SWITCH; }; 4062 $dynamic_args==1 && do {$fmt='md5($p.$s),saltlen=32'; last SWITCH; }; 4063 $dynamic_args==2 && do {$fmt='md5(md5($p))'; last SWITCH; }; 4064 $dynamic_args==3 && do {$fmt='md5(md5(md5($p)))'; last SWITCH; }; 4065 $dynamic_args==4 && do {$fmt='md5($s.$p),saltlen=2'; last SWITCH; }; 4066 $dynamic_args==5 && do {$fmt='md5($s.$p.$s)'; last SWITCH; }; 4067 $dynamic_args==6 && do {$fmt='md5(md5($p).$s)'; last SWITCH; }; 4068 $dynamic_args==8 && do {$fmt='md5(md5($s).$p)'; last SWITCH; }; 4069 $dynamic_args==9 && do {$fmt='md5($s.md5($p))'; last SWITCH; }; 4070 $dynamic_args==10 && do {$fmt='md5($s.md5($s.$p))'; last SWITCH; }; 4071 $dynamic_args==11 && do {$fmt='md5($s.md5($p.$s))'; last SWITCH; }; 4072 $dynamic_args==12 && do {$fmt='md5(md5($s).md5($p))'; last SWITCH; }; 4073 $dynamic_args==13 && do {$fmt='md5(md5($p).md5($s))'; last SWITCH; }; 4074 $dynamic_args==14 && do {$fmt='md5($s.md5($p).$s)'; last SWITCH; }; 4075 $dynamic_args==15 && do {$fmt='md5($u.md5($p).$s)'; last SWITCH; }; 4076 $dynamic_args==16 && do {$fmt='md5(md5(md5($p).$s).$s2)'; last SWITCH; }; 4077 $dynamic_args==18 && do {$fmt='md5($s.$c1.$p.$c2.$s),const1=Y,const2='."\xf7".',salt=ashex'; last SWITCH; }; 4078 $dynamic_args==22 && do {$fmt='md5(sha1($p))'; last SWITCH; }; 4079 $dynamic_args==23 && do {$fmt='sha1(md5($p))'; last SWITCH; }; 4080 $dynamic_args==24 && do {$fmt='sha1($p.$s)'; last SWITCH; }; 4081 $dynamic_args==25 && do {$fmt='sha1($s.$p)'; last SWITCH; }; 4082 $dynamic_args==26 && do {$fmt='sha1($p)'; last SWITCH; }; 4083 $dynamic_args==29 && do {$fmt='md5(utf16($p))'; last SWITCH; }; 4084 $dynamic_args==30 && do {$fmt='md4($p)'; last SWITCH; }; 4085 $dynamic_args==31 && do {$fmt='md4($s.$p)'; last SWITCH; }; 4086 $dynamic_args==32 && do {$fmt='md4($p.$s)'; last SWITCH; }; 4087 $dynamic_args==33 && do {$fmt='md4(utf16($p))'; last SWITCH; }; 4088 $dynamic_args==34 && do {$fmt='md5(md4($p))'; last SWITCH; }; 4089 $dynamic_args==35 && do {$fmt='sha1($u.$c1.$p),usrname=uc,const1=:'; last SWITCH; }; 4090 $dynamic_args==36 && do {$fmt='sha1($u.$c1.$p),usrname=true,const1=:'; last SWITCH; }; 4091 $dynamic_args==37 && do {$fmt='sha1($u.$p),usrname=lc'; last SWITCH; }; 4092 $dynamic_args==38 && do {$fmt='sha1($s.sha1($s.sha1($p))),saltlen=20'; last SWITCH; }; 4093 $dynamic_args==39 && do {$fmt='md5($s.pad16($p)),saltlen=60'; last SWITCH; }; 4094 $dynamic_args==40 && do {$fmt='sha1($s.pad20($p)),saltlen=60'; last SWITCH; }; 4095 4096 # 7, 17, 19, 20, 21, 27, 28 are still handled by 'special' functions. 4097 4098 # since these are in dynamic.conf, and treatly 'like' builtins, we might as well put them here. 4099 $dynamic_args==1001 && do {$fmt='md5(md5(md5(md5($p))))'; last SWITCH; }; 4100 $dynamic_args==1002 && do {$fmt='md5(md5(md5(md5(md5($p)))))'; last SWITCH; }; 4101 $dynamic_args==1003 && do {$fmt='md5(md5($p).md5($p))'; last SWITCH; }; 4102 $dynamic_args==1004 && do {$fmt='md5(md5(md5(md5(md5(md5($p))))))'; last SWITCH; }; 4103 $dynamic_args==1005 && do {$fmt='md5(md5(md5(md5(md5(md5(md5($p)))))))'; last SWITCH; }; 4104 $dynamic_args==1006 && do {$fmt='md5(md5(md5(md5(md5(md5(md5(md5($p))))))))'; last SWITCH; }; 4105 $dynamic_args==1007 && do {$fmt='md5(md5($p).$s),saltlen=3'; last SWITCH; }; 4106 $dynamic_args==1008 && do {$fmt='md5($p.$s),saltlen=16'; last SWITCH; }; 4107 $dynamic_args==1009 && do {$fmt='md5($s.$p),saltlen=16'; last SWITCH; }; 4108 $dynamic_args==1010 && do {$fmt='md5(pad100($p))'; last SWITCH; }; 4109 $dynamic_args==1011 && do {$fmt='md5($p.md5($s)),saltlen=6'; last SWITCH; }; 4110 $dynamic_args==1012 && do {$fmt='md5($p.md5($s)),saltlen=6'; last SWITCH; }; 4111 $dynamic_args==1013 && do {$fmt='md5($p.$s),usrname=md5_hex_salt'; last SWITCH; }; 4112 $dynamic_args==1014 && do {$fmt='md5($p.$s),saltlen=56'; last SWITCH; }; 4113 $dynamic_args==1015 && do {$fmt='md5(md5($p.$u).$s),saltlen=6,username'; last SWITCH; }; 4114 $dynamic_args==1016 && do {$fmt='md5($p.$s),saltlen=-64'; last SWITCH; }; 4115 $dynamic_args==1017 && do {$fmt='md5($s.$p),saltlen=-64'; last SWITCH; }; 4116 $dynamic_args==1018 && do {$fmt='md5(sha1(sha1($p)))'; last SWITCH; }; 4117 $dynamic_args==1019 && do {$fmt='md5(sha1(sha1(md5($p))))'; last SWITCH; }; 4118 $dynamic_args==1020 && do {$fmt='md5(sha1(md5($p)))'; last SWITCH; }; 4119 $dynamic_args==1021 && do {$fmt='md5(sha1(md5(sha1($p))))'; last SWITCH; }; 4120 $dynamic_args==1022 && do {$fmt='md5(sha1(md5(sha1(md5($p)))))'; last SWITCH; }; 4121 $dynamic_args==1023 && do {$fmt='trunc32(sha1($p))'; last SWITCH; }; 4122 $dynamic_args==1024 && do {$fmt='trunc32(sha1(md5($p)))'; last SWITCH; }; 4123 $dynamic_args==1025 && do {$fmt='trunc32(sha1(md5(md5($p))))'; last SWITCH; }; 4124 $dynamic_args==1026 && do {$fmt='trunc32(sha1(sha1($p)))'; last SWITCH; }; 4125 $dynamic_args==1027 && do {$fmt='trunc32(sha1(sha1(sha1($p))))'; last SWITCH; }; 4126 $dynamic_args==1028 && do {$fmt='trunc32(sha1(sha1_raw($p)))'; last SWITCH; }; 4127 $dynamic_args==1029 && do {$fmt='trunc32(sha256($p))'; last SWITCH; }; 4128 $dynamic_args==1030 && do {$fmt='trunc32(whirlpool($p))'; last SWITCH; }; 4129 $dynamic_args==1031 && do {$fmt='trunc32(gost($p))'; last SWITCH; }; 4130 $dynamic_args==1032 && do {$fmt='sha1_64(utf16($p))'; last SWITCH; }; 4131 $dynamic_args==1033 && do {$fmt='sha1_64(utf16($p).$s)'; last SWITCH; }; 4132 $dynamic_args==1300 && do {$fmt='md5(md5_raw($p))'; last SWITCH; }; 4133 $dynamic_args==1350 && do {$fmt='md5(md5($s.$p).$c1.$s),saltlen=2,const1=:'; last SWITCH; }; 4134 $dynamic_args==1400 && do {$fmt='sha1(utf16($p))'; last SWITCH; }; 4135 $dynamic_args==1401 && do {$fmt='md5_40($u.$c1.$p),const1='."\n".'skyper'."\n,usrname=true"; last SWITCH; }; 4136 $dynamic_args==1501 && do {$fmt='sha1($s.sha1($p)),saltlen=32'; last SWITCH; }; 4137 $dynamic_args==1502 && do {$fmt='sha1(sha1($p).$s),saltlen=-32'; last SWITCH; }; 4138 $dynamic_args==1503 && do {$fmt='sha256(sha256($p).$s),saltlen=64'; last SWITCH; }; 4139 $dynamic_args==1504 && do {$fmt='sha1($s.$p.$s)'; last SWITCH; }; 4140 $dynamic_args==1505 && do {$fmt='md5($p.$s.md5($p.$s)),saltlen=-64'; last SWITCH; }; 4141 $dynamic_args==1506 && do {$fmt='md5($u.$c1.$p),const1=:XDB:,usrname=true'; last SWITCH; }; 4142 $dynamic_args==1507 && do {$fmt='sha1($c1.utf16($p)),const1='."\x01\x00\x0f\x00\x0d\x00\x33\x00"; last SWITCH; }; 4143 $dynamic_args==1588 && do {$fmt='SHA256($s.SHA1($p)),saltlen=64,salt=asHEX64'; last SWITCH; }; 4144 $dynamic_args==2000 && do {$fmt='md5($p)'; last SWITCH; }; 4145 $dynamic_args==2001 && do {$fmt='md5($p.$s),saltlen=32'; last SWITCH; }; 4146 $dynamic_args==2002 && do {$fmt='md5(md5($p))'; last SWITCH; }; 4147 $dynamic_args==2003 && do {$fmt='md5(md5(md5($p)))'; last SWITCH; }; 4148 $dynamic_args==2004 && do {$fmt='md5($s.$p),saltlen=2'; last SWITCH; }; 4149 $dynamic_args==2005 && do {$fmt='md5($s.$p.$s)'; last SWITCH; }; 4150 $dynamic_args==2006 && do {$fmt='md5(md5($p).$s)'; last SWITCH; }; 4151 $dynamic_args==2008 && do {$fmt='md5(md5($s).$p)'; last SWITCH; }; 4152 $dynamic_args==2009 && do {$fmt='md5($s.md5($p))'; last SWITCH; }; 4153 $dynamic_args==2010 && do {$fmt='md5($s.md5($s.$p))'; last SWITCH; }; 4154 $dynamic_args==2011 && do {$fmt='md5($s.md5($p.$s))'; last SWITCH; }; 4155 $dynamic_args==2014 && do {$fmt='md5($s.md5($p).$s)'; last SWITCH; }; 4156 4157 return $func; 4158 } 4159 } 4160 # allow the generic compiler to handle these types. 4161 $dynamic_args = $prefmt.$fmt; 4162 } 4163 4164 # now compile. 4165 dynamic_compile_to_pcode($dynamic_args); 4166 4167 #return the name of the function to run the compiled pcode. 4168 return "dynamic_run_compiled_pcode"; 4169} 4170sub dyna_addtok { 4171 push(@gen_toks, $_[0]); 4172 return $_[1]; 4173} 4174sub do_dynamic_GetToken { 4175 # parses next token. 4176 # the token is placed on the gen_toks array as the 'new' token. 4177 # the return is the rest of the string (not tokenized yet) 4178 # if there is an error, then "tok_bad" (X) is pushed on to the top of the gen_toks array. 4179 $gen_lastTokIsFunc = 0; 4180 my $exprStr = $_[0]; 4181 if (!defined($exprStr) || length($exprStr) == 0) { return dyna_addtok("X", $exprStr); } 4182 my $stmp = substr($exprStr, 0, 1); 4183 if ($stmp eq "." || $stmp eq "(" || $stmp eq ")") { 4184 return dyna_addtok(substr($exprStr, 0, 1), substr($exprStr, 1)); 4185 } 4186 if ($stmp eq '$') { 4187 $stmp = substr($exprStr, 0, 2); 4188 if ($stmp eq '$p' || $stmp eq '$u') { return dyna_addtok(substr($exprStr,1,1), substr($exprStr, 2)); } 4189 if ($stmp eq '$s') { 4190 if (substr($exprStr, 0, 3) eq '$s2') { return dyna_addtok("S", substr($exprStr, 3)); } 4191 return dyna_addtok("s", substr($exprStr, 2)); 4192 } 4193 if ($stmp ne '$c') { return dyna_addtok("X", $exprStr); } 4194 $stmp = substr($exprStr, 2, 1); 4195 if ($stmp < 1 || $stmp > 9) { return dyna_addtok("X", $exprStr); } 4196 my $sRet = dyna_addtok($stmp, substr($exprStr, 3)); 4197 if (!defined($gen_c[$stmp-1])) {print STDERR "\$c$stmp found, but no const$stmp loaded\n"; die; } 4198 return $sRet; 4199 } 4200 4201 $gen_lastTokIsFunc=2; # a func, but can NOT be the 'outside' function. 4202 if (substr($exprStr, 0, 7) eq "md5_raw") { return dyna_addtok("f5r", substr($exprStr, 7)); } 4203 if (substr($exprStr, 0, 8) eq "sha1_raw") { return dyna_addtok("f1r", substr($exprStr, 8)); } 4204 if (substr($exprStr, 0, 7) eq "md4_raw") { return dyna_addtok("f4r", substr($exprStr, 7)); } 4205 if (substr($exprStr, 0,10) eq "sha224_raw") { return dyna_addtok("f224r", substr($exprStr,10)); } 4206 if (substr($exprStr, 0,10) eq "sha256_raw") { return dyna_addtok("f256r", substr($exprStr,10)); } 4207 if (substr($exprStr, 0,10) eq "sha384_raw") { return dyna_addtok("f384r", substr($exprStr,10)); } 4208 if (substr($exprStr, 0,10) eq "sha512_raw") { return dyna_addtok("f512r", substr($exprStr,10)); } 4209 if (substr($exprStr, 0,12) eq "sha3_224_raw") { return dyna_addtok("fsha3_224r", substr($exprStr,12)); } 4210 if (substr($exprStr, 0,12) eq "sha3_256_raw") { return dyna_addtok("fsha3_256r", substr($exprStr,12)); } 4211 if (substr($exprStr, 0,12) eq "sha3_384_raw") { return dyna_addtok("fsha3_384r", substr($exprStr,12)); } 4212 if (substr($exprStr, 0,12) eq "sha3_512_raw") { return dyna_addtok("fsha3_512r", substr($exprStr,12)); } 4213 if (substr($exprStr, 0,14) eq "keccak_256_raw") { return dyna_addtok("fkeccak_256r", substr($exprStr,14)); } 4214 if (substr($exprStr, 0,14) eq "keccak_512_raw") { return dyna_addtok("fkeccak_512r", substr($exprStr,14)); } 4215 if (substr($exprStr, 0, 7) eq "md2_raw") { return dyna_addtok("fmd2r", substr($exprStr, 7)); } 4216 if (substr($exprStr, 0, 8) eq "gost_raw") { return dyna_addtok("fgostr",substr($exprStr, 8)); } 4217 if (substr($exprStr, 0,13) eq "whirlpool_raw") { return dyna_addtok("fwrlpr", substr($exprStr, 13)); } 4218 if (substr($exprStr, 0, 9) eq "tiger_raw") { return dyna_addtok("ftigr", substr($exprStr, 9)); } 4219 if (substr($exprStr, 0,13) eq "ripemd128_raw") { return dyna_addtok("frip128r", substr($exprStr,13)); } 4220 if (substr($exprStr, 0,13) eq "ripemd160_raw") { return dyna_addtok("frip160r", substr($exprStr,13)); } 4221 if (substr($exprStr, 0,13) eq "ripemd256_raw") { return dyna_addtok("frip256r", substr($exprStr,13)); } 4222 if (substr($exprStr, 0,13) eq "ripemd320_raw") { return dyna_addtok("frip320r", substr($exprStr,13)); } 4223 if (substr($exprStr, 0,12) eq "haval256_raw") { return dyna_addtok("fhavr", substr($exprStr,12)); } 4224 if (substr($exprStr, 0,5) eq "pad16") { return dyna_addtok("fpad16", substr($exprStr,5)); } 4225 if (substr($exprStr, 0,5) eq "pad20") { return dyna_addtok("fpad20", substr($exprStr,5)); } 4226 if (substr($exprStr, 0,6) eq "pad100") { return dyna_addtok("fpad100", substr($exprStr,6)); } 4227 if (substr($exprStr, 0,7) eq "padmd64") { return dyna_addtok("fpadmd64", substr($exprStr,7)); } 4228 if (substr($exprStr, 0,7) eq "utf16be") { return dyna_addtok("futf16be", substr($exprStr,7)); } 4229 if (substr($exprStr, 0,5) eq "utf16") { return dyna_addtok("futf16", substr($exprStr,5)); } 4230 4231 $gen_lastTokIsFunc=1; 4232 $stmp = uc substr($exprStr, 0, 3); 4233 if ($stmp eq "MD5") { 4234 if (substr($exprStr, 0, 7) eq "md5_64c") { return dyna_addtok("f5c", substr($exprStr, 7)); } 4235 if (substr($exprStr, 0, 6) eq "md5_64") { return dyna_addtok("f56", substr($exprStr, 6)); } 4236 #md5_40 is used by dyna_1401, which is md5, but pads (with 0's) to 20 bytes, not 16 4237 if (substr($exprStr, 0, 6) eq "md5_40") { return dyna_addtok("f54", substr($exprStr, 6)); } 4238 if (substr($exprStr, 0, 3) eq "md5") { return dyna_addtok("f5h", substr($exprStr, 3)); } 4239 if (substr($exprStr, 0, 3) eq "MD5") { return dyna_addtok("f5H", substr($exprStr, 3)); } 4240 } elsif ($stmp eq "SHA") { 4241 if (substr($exprStr, 0, 8) eq "sha1_64c") { return dyna_addtok("f1c", substr($exprStr, 8)); } 4242 if (substr($exprStr, 0, 7) eq "sha1_64") { return dyna_addtok("f16", substr($exprStr, 7)); } 4243 if (substr($exprStr, 0, 4) eq "SHA1") { return dyna_addtok("f1H", substr($exprStr, 4)); } 4244 if (substr($exprStr, 0, 4) eq "sha1") { return dyna_addtok("f1h", substr($exprStr, 4)); } 4245 if (substr($exprStr, 0,10) eq "sha224_64c"){ return dyna_addtok("f224c", substr($exprStr, 10)); } 4246 if (substr($exprStr, 0, 9) eq "sha224_64") { return dyna_addtok("f2246", substr($exprStr, 9)); } 4247 if (substr($exprStr, 0, 6) eq "SHA224") { return dyna_addtok("f224H", substr($exprStr, 6)); } 4248 if (substr($exprStr, 0, 6) eq "sha224") { return dyna_addtok("f224h", substr($exprStr, 6)); } 4249 if (substr($exprStr, 0,10) eq "sha256_64c"){ return dyna_addtok("f256c", substr($exprStr, 10)); } 4250 if (substr($exprStr, 0, 9) eq "sha256_64") { return dyna_addtok("f2566", substr($exprStr, 9)); } 4251 if (substr($exprStr, 0, 6) eq "SHA256") { return dyna_addtok("f256H", substr($exprStr, 6)); } 4252 if (substr($exprStr, 0, 6) eq "sha256") { return dyna_addtok("f256h", substr($exprStr, 6)); } 4253 if (substr($exprStr, 0,10) eq "sha384_64c"){ return dyna_addtok("f384c", substr($exprStr, 10)); } 4254 if (substr($exprStr, 0, 9) eq "sha384_64") { return dyna_addtok("f3846", substr($exprStr, 9)); } 4255 if (substr($exprStr, 0, 6) eq "SHA384") { return dyna_addtok("f384H", substr($exprStr, 6)); } 4256 if (substr($exprStr, 0, 6) eq "sha384") { return dyna_addtok("f384h", substr($exprStr, 6)); } 4257 if (substr($exprStr, 0,10) eq "sha512_64c"){ return dyna_addtok("f512c", substr($exprStr, 10)); } 4258 if (substr($exprStr, 0, 9) eq "sha512_64") { return dyna_addtok("f5126", substr($exprStr, 9)); } 4259 if (substr($exprStr, 0, 6) eq "SHA512") { return dyna_addtok("f512H", substr($exprStr, 6)); } 4260 if (substr($exprStr, 0, 6) eq "sha512") { return dyna_addtok("f512h", substr($exprStr, 6)); } 4261 if (substr($exprStr, 0,12) eq "sha3_224_64c"){ return dyna_addtok("fsha3_224c", substr($exprStr, 12)); } 4262 if (substr($exprStr, 0,11) eq "sha3_224_64") { return dyna_addtok("fsha3_2246", substr($exprStr, 11)); } 4263 if (substr($exprStr, 0, 8) eq "SHA3_224") { return dyna_addtok("fsha3_224H", substr($exprStr, 8)); } 4264 if (substr($exprStr, 0, 8) eq "sha3_224") { return dyna_addtok("fsha3_224h", substr($exprStr, 8)); } 4265 if (substr($exprStr, 0,12) eq "sha3_256_64c"){ return dyna_addtok("fsha3_256c", substr($exprStr, 12)); } 4266 if (substr($exprStr, 0,11) eq "sha3_256_64") { return dyna_addtok("fsha3_2566", substr($exprStr, 11)); } 4267 if (substr($exprStr, 0, 8) eq "SHA3_256") { return dyna_addtok("fsha3_256H", substr($exprStr, 8)); } 4268 if (substr($exprStr, 0, 8) eq "sha3_256") { return dyna_addtok("fsha3_256h", substr($exprStr, 8)); } 4269 if (substr($exprStr, 0,12) eq "sha3_384_64c"){ return dyna_addtok("fsha3_384c", substr($exprStr, 12)); } 4270 if (substr($exprStr, 0,11) eq "sha3_384_64") { return dyna_addtok("fsha3_3846", substr($exprStr, 11)); } 4271 if (substr($exprStr, 0, 8) eq "SHA3_384") { return dyna_addtok("fsha3_384H", substr($exprStr, 8)); } 4272 if (substr($exprStr, 0, 8) eq "sha3_384") { return dyna_addtok("fsha3_384h", substr($exprStr, 8)); } 4273 if (substr($exprStr, 0,12) eq "sha3_512_64c"){ return dyna_addtok("fsha3_512c", substr($exprStr, 12)); } 4274 if (substr($exprStr, 0,11) eq "sha3_512_64") { return dyna_addtok("fsha3_5126", substr($exprStr, 11)); } 4275 if (substr($exprStr, 0, 8) eq "SHA3_512") { return dyna_addtok("fsha3_512H", substr($exprStr, 8)); } 4276 if (substr($exprStr, 0, 8) eq "sha3_512") { return dyna_addtok("fsha3_512h", substr($exprStr, 8)); } 4277 4278 } elsif ($stmp eq "MD4") { 4279 if (substr($exprStr, 0, 7) eq "md4_64c") { return dyna_addtok("f4c", substr($exprStr, 7)); } 4280 if (substr($exprStr, 0, 6) eq "md4_64") { return dyna_addtok("f46", substr($exprStr, 6)); } 4281 if (substr($exprStr, 0, 3) eq "md4") { return dyna_addtok("f4h", substr($exprStr, 3)); } 4282 if (substr($exprStr, 0, 3) eq "MD4") { return dyna_addtok("f4H", substr($exprStr, 3)); } 4283 } elsif ($stmp eq "GOS") { 4284 if (substr($exprStr, 0, 8) eq "gost_64c") { return dyna_addtok("fgostc", substr($exprStr, 8)); } 4285 if (substr($exprStr, 0, 7) eq "gost_64") { return dyna_addtok("fgost6", substr($exprStr, 7)); } 4286 if (substr($exprStr, 0, 4) eq "GOST") { return dyna_addtok("fgostH", substr($exprStr, 4)); } 4287 if (substr($exprStr, 0, 4) eq "gost") { return dyna_addtok("fgosth", substr($exprStr, 4)); } 4288 } elsif ($stmp eq "WHI") { 4289 if (substr($exprStr, 0,13) eq "whirlpool_64c") { return dyna_addtok("fwrlpc", substr($exprStr, 13)); } 4290 if (substr($exprStr, 0,12) eq "whirlpool_64") { return dyna_addtok("fwrlp6", substr($exprStr, 12)); } 4291 if (substr($exprStr, 0, 9) eq "WHIRLPOOL") { return dyna_addtok("fwrlpH", substr($exprStr, 9)); } 4292 if (substr($exprStr, 0, 9) eq "whirlpool") { return dyna_addtok("fwrlph", substr($exprStr, 9)); } 4293 } elsif ($stmp eq "TIG") { 4294 if (substr($exprStr, 0, 9) eq "tiger_64c") { return dyna_addtok("ftigc", substr($exprStr, 9)); } 4295 if (substr($exprStr, 0, 8) eq "tiger_64") { return dyna_addtok("ftig6", substr($exprStr, 8)); } 4296 if (substr($exprStr, 0, 5) eq "TIGER") { return dyna_addtok("ftigH", substr($exprStr, 5)); } 4297 if (substr($exprStr, 0, 5) eq "tiger") { return dyna_addtok("ftigh", substr($exprStr, 5)); } 4298 } elsif ($stmp eq "RIP") { 4299 if (substr($exprStr, 0,13) eq "ripemd128_64c") { return dyna_addtok("frip128c", substr($exprStr,13)); } 4300 if (substr($exprStr, 0,12) eq "ripemd128_64") { return dyna_addtok("frip1286", substr($exprStr,12)); } 4301 if (substr($exprStr, 0, 9) eq "RIPEMD129") { return dyna_addtok("frip128H", substr($exprStr, 9)); } 4302 if (substr($exprStr, 0, 9) eq "ripemd128") { return dyna_addtok("frip128h", substr($exprStr, 9)); } 4303 if (substr($exprStr, 0,13) eq "ripemd160_64c") { return dyna_addtok("frip160c", substr($exprStr,13)); } 4304 if (substr($exprStr, 0,12) eq "ripemd160_64") { return dyna_addtok("frip1606", substr($exprStr,12)); } 4305 if (substr($exprStr, 0, 9) eq "RIPEMD160") { return dyna_addtok("frip160H", substr($exprStr, 9)); } 4306 if (substr($exprStr, 0, 9) eq "ripemd160") { return dyna_addtok("frip160h", substr($exprStr, 9)); } 4307 if (substr($exprStr, 0,13) eq "ripemd256_64c") { return dyna_addtok("frip256c", substr($exprStr,13)); } 4308 if (substr($exprStr, 0,12) eq "ripemd256_64") { return dyna_addtok("frip2566", substr($exprStr,12)); } 4309 if (substr($exprStr, 0, 9) eq "RIPEMD129") { return dyna_addtok("frip256H", substr($exprStr, 9)); } 4310 if (substr($exprStr, 0, 9) eq "ripemd256") { return dyna_addtok("frip256h", substr($exprStr, 9)); } 4311 if (substr($exprStr, 0,13) eq "ripemd320_64c") { return dyna_addtok("frip320c", substr($exprStr,13)); } 4312 if (substr($exprStr, 0,12) eq "ripemd320_64") { return dyna_addtok("frip3206", substr($exprStr,12)); } 4313 if (substr($exprStr, 0, 9) eq "RIPEMD129") { return dyna_addtok("frip320H", substr($exprStr, 9)); } 4314 if (substr($exprStr, 0, 9) eq "ripemd320") { return dyna_addtok("frip320h", substr($exprStr, 9)); } 4315 } elsif ($stmp eq "HAV") { 4316 if (substr($exprStr, 0,12) eq "haval256_64c") { return dyna_addtok("fhavc", substr($exprStr,12)); } 4317 if (substr($exprStr, 0,11) eq "haval256_64") { return dyna_addtok("fhav6", substr($exprStr,11)); } 4318 if (substr($exprStr, 0, 8) eq "HAVEL256") { return dyna_addtok("fhavH", substr($exprStr, 8)); } 4319 if (substr($exprStr, 0, 8) eq "haval256") { return dyna_addtok("fhavh", substr($exprStr, 8)); } 4320 } elsif ($stmp eq "TRU") { 4321 if (substr($exprStr, 0,7) eq "trunc32") { return dyna_addtok("ftr32", substr($exprStr, 7)); } 4322 } elsif ($stmp eq "KEC") { 4323 if (substr($exprStr, 0,14) eq "keccak_256_64c"){ return dyna_addtok("fkeccak_256c", substr($exprStr, 14)); } 4324 if (substr($exprStr, 0,13) eq "keccak_256_64") { return dyna_addtok("fkeccak_2566", substr($exprStr, 13)); } 4325 if (substr($exprStr, 0,10) eq "KECCAK_256") { return dyna_addtok("fkeccak_256H", substr($exprStr, 10)); } 4326 if (substr($exprStr, 0,10) eq "keccak_256") { return dyna_addtok("fkeccak_256h", substr($exprStr, 10)); } 4327 if (substr($exprStr, 0,14) eq "keccak_512_64c"){ return dyna_addtok("fkeccak_512c", substr($exprStr, 14)); } 4328 if (substr($exprStr, 0,13) eq "keccak_512_64") { return dyna_addtok("fkeccak_5126", substr($exprStr, 13)); } 4329 if (substr($exprStr, 0,10) eq "KECCAK_512") { return dyna_addtok("fkeccak_512H", substr($exprStr, 10)); } 4330 if (substr($exprStr, 0,10) eq "keccak_512") { return dyna_addtok("fkeccak_512h", substr($exprStr, 10)); } 4331 } elsif ($stmp eq "MD2") { 4332 if (substr($exprStr, 0, 7) eq "md2_64c") { return dyna_addtok("fmd2c", substr($exprStr, 7)); } 4333 if (substr($exprStr, 0, 6) eq "md2_64") { return dyna_addtok("fmd26", substr($exprStr, 6)); } 4334 if (substr($exprStr, 0, 3) eq "md2") { return dyna_addtok("fmd2h", substr($exprStr, 3)); } 4335 if (substr($exprStr, 0, 3) eq "MD2") { return dyna_addtok("fmd2H", substr($exprStr, 3)); } 4336 } 4337 4338 $gen_lastTokIsFunc=0; 4339 push(@gen_toks, "X"); 4340 return $exprStr; 4341} 4342sub do_dynamic_LexiError { 4343 print STDERR "Syntax Error around this part of expression:\n"; 4344 print STDERR "$hash_format\n"; 4345 my $v = (length($hash_format) - length($_[0])); 4346 if ($gen_toks[@gen_toks - 1] ne "X") { --$v; } 4347 print STDERR " " x $v; 4348 print STDERR "^\n"; 4349 if ($gen_toks[@gen_toks - 1] eq "X") { print STDERR "Invalid token found\n"; } 4350 elsif (defined $_[1]) { print STDERR "$_[1]\n"; } 4351} 4352sub do_dynamic_Lexi { 4353 # tokenizes the string, and syntax validates that it IS valid. 4354 @gen_toks=(); 4355 4356 my $fmt = do_dynamic_GetToken($hash_format); 4357 if ($gen_lastTokIsFunc!=1) { 4358 print STDERR "The expression MUST start with a 'known' md5/md4/sha1 type function.\n"; die; 4359 } 4360 my $paren = 0; 4361 while ($gen_toks[@gen_toks - 1] ne "X") { 4362 if ($gen_lastTokIsFunc) { 4363 $fmt = do_dynamic_GetToken($fmt); 4364 if ($gen_toks[@gen_toks - 1] ne "(") { 4365 do_dynamic_LexiError($fmt, "A ( MUST follow one of the hash function names"); die; 4366 } 4367 next; 4368 } 4369 if ($gen_toks[@gen_toks - 1] eq "(") { 4370 $fmt = do_dynamic_GetToken($fmt); 4371 if ($gen_toks[@gen_toks - 1] eq "X" || $gen_toks[@gen_toks - 1] eq "." || $gen_toks[@gen_toks - 1] eq "(" || $gen_toks[@gen_toks - 1] eq ")") { 4372 do_dynamic_LexiError($fmt, "Invalid character following the ( char"); die; 4373 } 4374 ++$paren; 4375 next; 4376 } 4377 if ($gen_toks[@gen_toks - 1] eq ")") { 4378 --$paren; 4379 if ( length($fmt) == 0) { 4380 if ($paren == 0) { 4381 # The format is VALID, and proper syntax checking fully done. 4382 4383 # if we want to dump the token table: 4384 #for (my $i = 0; $i < @gen_toks; ++$i) { 4385 # print "$gen_toks[$i]\n"; 4386 #} 4387 return @gen_toks; # return the count 4388 } 4389 do_dynamic_LexiError($fmt, "Error, not enough ) characters at end of expression"); die; 4390 } 4391 if ($paren == 0) { 4392 do_dynamic_LexiError($fmt, "Error, reached the matching ) to the initial (, but there is still more expression left."); die; 4393 } 4394 $fmt = do_dynamic_GetToken($fmt); 4395 unless ($gen_toks[@gen_toks - 1] eq "." || $gen_toks[@gen_toks - 1] eq ")") { 4396 do_dynamic_LexiError($fmt, "The only things valid to follow a ) char, are a . or another )"); die; 4397 } 4398 next; 4399 } 4400 if ($gen_toks[@gen_toks - 1] eq ".") { 4401 $fmt = do_dynamic_GetToken($fmt); 4402 if ($gen_toks[@gen_toks - 1] eq "X" || $gen_toks[@gen_toks - 1] eq "." || $gen_toks[@gen_toks - 1] eq "(" || $gen_toks[@gen_toks - 1] eq ")") { 4403 do_dynamic_LexiError($fmt, "invalid character following the . character"); die; 4404 } 4405 next; 4406 } 4407 # some 'string op 4408 $fmt = do_dynamic_GetToken($fmt); 4409 unless ($gen_toks[@gen_toks - 1] eq ")" || $gen_toks[@gen_toks - 1] eq ".") { 4410 do_dynamic_LexiError($fmt, "Only a dot '.' or a ) can follow a string type token"); die; 4411 } 4412 } 4413} 4414sub dynamic_compile_to_pcode { 4415 $gen_s = ""; $gen_u = ""; $gen_s2 = ""; 4416 $gen_needs = 0; $gen_needs2 = 0; $gen_needu = 0; 4417 4418 my $dynamic_args = $_[0]; 4419 # ok, not a specific version, so we use 'this' format: 4420 # dynamic=num=1,salt=true,saltlen=8,format=md5(md5(md5($p.$s).$p).$s) 4421 # which at this point, we would 'see' in dynamic_args: 4422 # num=1,salt=true,saltlen=8,format=md5(md5(md5($p.$s).$p).$s) 4423 4424 # get all of the params into a hash table. 4425 my %hash; 4426 my @opts = split(/,/,$dynamic_args); 4427 foreach my $x (@opts) { 4428 my @opt = split(/=/,$x); 4429 $hash {$opt[0]} = $opt[1]; 4430 } 4431 4432 @gen_pCode = (); 4433 @gen_Flags = (); 4434 4435 ######################## 4436 # load the values 4437 ######################## 4438 4439 # Validate that the 'required' params are at least here. 4440 $gen_num = $hash{"num"}; 4441 if (!defined ($gen_num )) { print STDERR "Error, num=# is REQUIRED for dynamic\n"; die; } 4442 my $v = $hash{"format"}; 4443 if (!defined ($v)) { print STDERR "Error, format=EXPR is REQUIRED for dynamic\n"; die; } 4444 4445 $gen_singlesalt = $hash{"single_salt"}; 4446 if (!defined($gen_singlesalt)) {$gen_singlesalt=0;} 4447 4448 # load PW 4449 $gen_pw = $_[0]; 4450 4451 # load a salt. If this is unused, then we will clear it out after parsing Lexicon 4452 $saltlen = $hash{"saltlen"}; 4453 unless (defined($saltlen) && $saltlen =~ /^[+\-]?\d*.?\d+$/) { $saltlen = 8; } 4454 $gen_stype = $hash{"salt"}; 4455 unless (defined($gen_stype)) { $gen_stype = "true"; } 4456 #print "$gen_stype\n"; 4457 4458 # load salt #2 4459 $salt2len = $hash{"salt2len"}; 4460 unless (defined($salt2len) && $salt2len =~ /^[+\-]?\d*.?\d+$/) { $salt2len = 6; } 4461 4462 # load user name 4463 $dynamic_usernameType = $hash{"usrname"}; 4464 if (!$dynamic_usernameType) { $dynamic_usernameType=0; } else {$gen_needu=1; } 4465 $dynamic_passType = $hash{"pass"}; 4466 if (!defined ($dynamic_passType) || $dynamic_passType ne "uni") {$dynamic_passType="";} 4467 my $pass_case = $hash{"passcase"}; 4468 if (defined($pass_case)) { 4469 if ( (lc $pass_case) eq "lc") { $gen_PWCase = "L"; } 4470 if ( (lc $pass_case) eq "uc") { $gen_PWCase = "U"; } 4471 } 4472 4473 # load constants 4474 @gen_c=(); 4475 for (my $n = 1; $n <= 9; ++$n) { 4476 my $c = "const" . $n; 4477 $v = $hash{$c}; 4478 if (defined($v)) { push(@gen_c, $v); } 4479 else {last;} 4480 } 4481 4482 $debug_pcode = $hash{"debug"}; 4483 if (!$debug_pcode) { $debug_pcode=0; } 4484 4485 $hash_format = $hash{"format"}; 4486 my $optimize = $hash{"optimize"}; 4487 if (defined($optimize) && $optimize > 0) {dynamic_compile_Optimize1();} 4488 4489 ###################################### 4490 # syntax check, and load the expression into our token table. 4491 ###################################### 4492 do_dynamic_Lexi(); 4493 unless (@gen_toks > 3) { print STDERR "Error, the format= of the expression was missing, or NOT valid\n"; die; } 4494 4495 # now clean up salt, salt2, user, etc if they were NOT part of the expression: 4496 $v = $saltlen; $saltlen=0; 4497 foreach(@gen_toks) { if ($_ eq "s") {$saltlen=$v;last;} } 4498 $gen_u_do=0; 4499 foreach(@gen_toks) { if ($_ eq "u") {$gen_u_do=1;last;} } 4500 $v = $salt2len; $salt2len=0; 4501 foreach(@gen_toks) { if ($_ eq "S") {$salt2len=$v;last;} } 4502 4503 # this function actually BUILDS the pcode. 4504 dynamic_compile_expression_to_pcode(0, @gen_toks-1); 4505 4506 if (defined($optimize) && $optimize > 1) {dynamic_compile_Optimize2();} 4507 4508 # dump pcode 4509 if ($debug_pcode) { foreach (@gen_Flags) { print STDERR "Flag=$_\n"; } } 4510 if ($debug_pcode) { foreach (@gen_pCode) { print STDERR "$_\n"; } } 4511} 4512sub dynamic_compile_Optimize2() { 4513} 4514sub dynamic_compile_Optimize1() { 4515 # Look for 'salt as hash' or 'salt as hash in salt2' 4516 # If ALL instances of $s are md5($s), then then we can use 4517 # 'salt as hash'. If there are some md5($s), but some 4518 # extra $s's scattered in, and we do NOT have any $s2 then 4519 # we can use the 'salt as hash in salt2' optimization. 4520 my @positions; my $pos=0; 4521 while (1) { 4522 $pos = index($hash_format, 'md5($s)', $pos); 4523 last if($pos < 0); 4524 push(@positions, $pos++); 4525 } 4526 if (@positions) { 4527 # found at least 1 md5($s) 4528 # now, count number of $s's, and if same, then ALL $s's are in md5($s) 4529 my $count = 0; 4530 $pos = 0; 4531 while (1) { 4532 $pos = index($hash_format, '$s', $pos) + 1; 4533 last if($pos < 1); 4534 ++$count; 4535 } 4536 if ($count == @positions) { 4537 my $from = quotemeta 'md5($s)'; my $to = '$s'; 4538 $gen_stype = "tohex"; 4539 push (@gen_Flags, "MGF_SALT_AS_HEX"); 4540 if ($debug_pcode == 1) { 4541 print STDERR "Performing Optimization(Salt_as_hex). Changing format from\n"; 4542 print STDERR "$hash_format\n"; 4543 } 4544 $hash_format =~ s/$from/$to/g; 4545 if ($debug_pcode == 1) { print STDERR "to\n$hash_format\n"; } 4546 } 4547 else { 4548 # we still 'might' be able to optimize. if there is no $s2, then 4549 # we can still have a salt, and use salt2 as our md5($s) preload. 4550 if (index($hash_format, '$s2') < 0) { 4551 $gen_stype = "toS2hex"; 4552 $gen_needs2 = 1; 4553 my $from = quotemeta 'md5($s)'; my $to = '$s2'; 4554 push (@gen_Flags, "MGF_SALT_AS_HEX_TO_SALT2"); 4555 if ($debug_pcode == 1) { 4556 print STDERR "Performing Optimization(Salt_as_hex_to_salt2). Changing format from\n"; 4557 print STDERR "$hash_format\n"; 4558 } 4559 $hash_format =~ s/$from/$to/g; 4560 if ($debug_pcode == 1) { print STDERR "to\n$hash_format\n"; } 4561 } 4562 } 4563 } 4564} 4565sub dynamic_compile_expression_to_pcode { 4566 # 4567 # very crappy, recursive decent parser, but 'it works', lol. 4568 # 4569 # Now, same parser, but converted into a pcode generator 4570 # which were very simple changes, using a stack. 4571 # 4572 my $cur = $_[0]; 4573 my $curend = $_[1]; 4574 my $curTok; 4575 4576 # we 'assume' it is likely that we have ( and ) wrapping the expr. We trim them off, and ignore them. 4577 if ($gen_toks[$cur] eq "(" && $gen_toks[$curend] eq ")") { ++$cur; --$curend; } 4578 4579 while ($cur <= $curend) { 4580 $curTok = $gen_toks[$cur]; 4581 if ($curTok eq ".") { 4582 # in this expression builder, we totally ignore these. 4583 ++$cur; 4584 next; 4585 } 4586 if (length($curTok) > 1 && substr($curTok,0,1) eq "f") 4587 { 4588 # find the closing ')' for this md5. 4589 my $tail; my $count=1; 4590 ++$cur; 4591 $tail = $cur; 4592 while ($count) { 4593 ++$tail; 4594 if ($gen_toks[$tail] eq "(") {++$count;} 4595 elsif ($gen_toks[$tail] eq ")") {--$count;} 4596 } 4597 4598 # OUTPUT CODE Doing 'some' md5($value) call First, push a 'new' var'. Build it, then perform the crypt 4599 push(@gen_pCode, "dynamic_push"); 4600 4601 # recursion. 4602 my $cp = dynamic_compile_expression_to_pcode($cur,$tail); 4603 $cur = $tail+1; 4604 4605 # OUTPUT CODE Now perform the 'correct' crypt. This will do: 4606 # 1. Pop the stack 4607 # 2. Perform crypt, 4608 # 3. Perform optional work (like up case, appending '=' chars, etc) 4609 # 4. Append the computed (and possibly tweaked) hash string to the last string in the stack. 4610 # 5. return the string. 4611 push(@gen_pCode, "dynamic_".$curTok); 4612 next; 4613 } 4614 if ($curTok eq "s") { 4615 # salt could be 'normal' or might be the md5 hex of the salt 4616 # OUTPUT CODE 4617 if ($gen_stype eq "tohex") { push(@gen_pCode, "dynamic_app_sh"); } 4618 else { push(@gen_pCode, "dynamic_app_s"); } 4619 ++$cur; 4620 $gen_needs = 1; 4621 next; 4622 } 4623 if ($curTok eq "p") { push(@gen_pCode, "dynamic_app_p" . $gen_PWCase); ++$cur; next; } 4624 if ($curTok eq "S") { push(@gen_pCode, "dynamic_app_S"); ++$cur; $gen_needs2 = 1; next; } 4625 if ($curTok eq "u") { push(@gen_pCode, "dynamic_app_u"); ++$cur; $gen_needu = 1; next; } 4626 if ($curTok eq "1") { push(@gen_pCode, "dynamic_app_1"); ++$cur; next; } 4627 if ($curTok eq "2") { push(@gen_pCode, "dynamic_app_2"); ++$cur; next; } 4628 if ($curTok eq "3") { push(@gen_pCode, "dynamic_app_3"); ++$cur; next; } 4629 if ($curTok eq "4") { push(@gen_pCode, "dynamic_app_4"); ++$cur; next; } 4630 if ($curTok eq "5") { push(@gen_pCode, "dynamic_app_5"); ++$cur; next; } 4631 if ($curTok eq "6") { push(@gen_pCode, "dynamic_app_6"); ++$cur; next; } 4632 if ($curTok eq "7") { push(@gen_pCode, "dynamic_app_7"); ++$cur; next; } 4633 if ($curTok eq "8") { push(@gen_pCode, "dynamic_app_8"); ++$cur; next; } 4634 if ($curTok eq "9") { push(@gen_pCode, "dynamic_app_9"); ++$cur; next; } 4635 4636 print STDERR "Error, invalid, can NOT create this expression (trying to build sample test buffer\n"; 4637 die; 4638 } 4639} 4640sub dynamic_run_compiled_pcode { 4641 ###################################### 4642 # now, RUN the expression, to generate our final hash. 4643 ###################################### 4644 4645 if ($gen_needu == 1) { dynamic_load_username(); $out_username=$gen_u;} 4646 if ($gen_needs == 1) { dynamic_load_salt(); if ($gen_singlesalt==1) {$gen_needs=2;} } 4647 if ($gen_needs2 == 1) { dynamic_load_salt2(); if ($gen_singlesalt==1) {$gen_needs=2;} } 4648 4649 if ($dynamic_passType eq "uni") { $gen_pw = encode("UTF-16LE",$_[0]); } 4650 else { $gen_pw = $_[0]; } 4651 @gen_Stack = (); 4652 # we have to 'preload' this, since the md5() pops, then modifies top element, then returns string. 4653 # Thus, for the 'last' modification, we need a dummy var there. 4654 push(@gen_Stack,""); 4655 foreach my $fn (@gen_pCode) { 4656 no strict 'refs'; 4657 $h = &$fn(); 4658 use strict; 4659 } 4660 4661 # older (pre-unified hash output function) code was kept, just in case. 4662# if ($gen_needu == 1) { print "$gen_u:\$dynamic_$gen_num\$$h"; } 4663# else { print "u$u-dynamic_$gen_num:\$dynamic_$gen_num\$$h"; } 4664# if ($gen_needs > 0) { print "\$$gen_soutput"; } 4665# if ($gen_needs2 > 0) { if (!defined($gen_stype) || $gen_stype ne "toS2hex") {print "\$\$2$gen_s2";} } 4666# print ":$u:0:$_[0]::\n"; 4667# return $h; # might as well return the value. 4668 4669 my $ret = ""; 4670 if ($gen_needu == 1) { $ret .= "\$dynamic_$gen_num\$$h"; } 4671 else { $ret .= "\$dynamic_$gen_num\$$h"; } 4672 if ($gen_needs > 0) { $ret .= "\$$gen_soutput"; } 4673 if ($gen_needs2 > 0) { if (!defined($gen_stype) || $gen_stype ne "toS2hex") {$ret .= "\$\$2$gen_s2";} } 4674 return $ret; 4675} 4676sub dynamic_load_username { 4677 # load user name 4678 $gen_u = randusername(12); 4679 if (defined($dynamic_usernameType)) { 4680 if ($dynamic_usernameType eq "lc") { $gen_u = lc $gen_u; } 4681 elsif ($dynamic_usernameType eq "uc") { $gen_u = uc $gen_u; } 4682 elsif ($dynamic_usernameType eq "uni") { $gen_u = encode("UTF-16LE",$gen_u); } 4683 elsif ($dynamic_usernameType eq "md5_hex_salt") { $argsalt = md5_hex($gen_u); } 4684 } 4685} 4686sub dynamic_load_salt { 4687 if (defined $argsalt) { 4688 if ($gen_stype eq "ashex") { $gen_s=md5_hex($argsalt); } 4689 else { $gen_s=$argsalt; } 4690 if (!defined $gen_s) {$gen_s = get_salt(4);} 4691 $gen_soutput = $gen_s; 4692 $saltlen = length($gen_s); 4693 if ($gen_stype eq "tohex") { $gen_s=md5_hex($gen_s); } 4694 } else { 4695 if ($gen_stype eq "ashex") { $gen_s=randstr(32, \@chrHexLo); } 4696 elsif ($gen_stype eq "asHEX") { $gen_s=uc randstr(32, \@chrHexLo); } 4697 elsif ($gen_stype eq "asHEX64") { $gen_s=uc randstr(64, \@chrHexLo); } 4698 else { 4699 my $slen = $saltlen; 4700 if ($slen < 0) { 4701 $slen = int(rand($slen*-1)); 4702 } 4703 #print "$gen_stype\n"; 4704 if ($gen_stype eq "onlyhex") { 4705 $gen_s=randstr($slen, \@chrHexLo); 4706 } else { 4707 $gen_s=randstr($slen); 4708 } 4709 } 4710 $gen_soutput = $gen_s; 4711 if ($gen_stype eq "tohex") { $gen_s=md5_hex($gen_s); } 4712 } 4713} 4714sub dynamic_load_salt2() { 4715 if (defined($gen_stype) && $gen_stype eq "toS2hex") { $gen_s2 = md5_hex($gen_s); } 4716 else { $gen_s2 = randstr($salt2len); } 4717} 4718########################################################################## 4719# Here are the ACTUAL pCode primitive functions. These handle pretty 4720# much everything dealing with hashing expressions for md5/md4/sha1/sha224 4721# /sha256/sha384/sha512/gost/whirlpool. 4722# There are some variables which will be properly prepared prior to any of these 4723# pCode functions. These are $gen_pw (the password, possibly in unicode 4724# format). $gen_s (the salt), $gen_s2 (the 2nd salt), $gen_u the username 4725# (possibly in unicode), and @gen_c (array of constants). Also, prior to 4726# running against a number, the @gen_Stack is cleaned (but a blank variable 4727# is pushed to preload it). To perform this function md5(md5($p.$s).$p) 4728# here is the code that WILL be run: 4729# dynamic_push 4730# dynamic_push 4731# dynamic_app_p 4732# dynamic_app_s 4733# dynamic_f5h 4734# dynamic_app_p 4735# dynamic_f5h 4736########################################################################## 4737sub dynamic_push { push @gen_Stack,""; } 4738sub dynamic_pop { return pop @gen_Stack; } # not really needed. 4739sub dynamic_app_s { $gen_Stack[@gen_Stack-1] .= $gen_s; } 4740sub dynamic_app_sh { $gen_Stack[@gen_Stack-1] .= $gen_s; } #md5_hex($gen_s); } 4741sub dynamic_app_S { $gen_Stack[@gen_Stack-1] .= $gen_s2; } 4742sub dynamic_app_u { $gen_Stack[@gen_Stack-1] .= $gen_u; } 4743sub dynamic_app_p { $gen_Stack[@gen_Stack-1] .= $gen_pw; } 4744sub dynamic_app_pU { $gen_Stack[@gen_Stack-1] .= uc $gen_pw; } 4745sub dynamic_app_pL { $gen_Stack[@gen_Stack-1] .= lc $gen_pw; } 4746sub dynamic_app_1 { $gen_Stack[@gen_Stack-1] .= $gen_c[0]; } 4747sub dynamic_app_2 { $gen_Stack[@gen_Stack-1] .= $gen_c[1]; } 4748sub dynamic_app_3 { $gen_Stack[@gen_Stack-1] .= $gen_c[2]; } 4749sub dynamic_app_4 { $gen_Stack[@gen_Stack-1] .= $gen_c[3]; } 4750sub dynamic_app_5 { $gen_Stack[@gen_Stack-1] .= $gen_c[4]; } 4751sub dynamic_app_6 { $gen_Stack[@gen_Stack-1] .= $gen_c[5]; } 4752sub dynamic_app_7 { $gen_Stack[@gen_Stack-1] .= $gen_c[6]; } 4753sub dynamic_app_8 { $gen_Stack[@gen_Stack-1] .= $gen_c[7]; } 4754sub dynamic_app_9 { $gen_Stack[@gen_Stack-1] .= $gen_c[8]; } 4755sub dynamic_ftr32 { $h = pop @gen_Stack; $h = substr($h,0,32); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4756sub dynamic_f5h { $h = pop @gen_Stack; $h = md5_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4757sub dynamic_f1h { $h = pop @gen_Stack; $h = sha1_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4758sub dynamic_f4h { $h = pop @gen_Stack; $h = md4_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4759sub dynamic_f5H { $h = pop @gen_Stack; $h = uc md5_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4760sub dynamic_f1H { $h = pop @gen_Stack; $h = uc sha1_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4761sub dynamic_f4H { $h = pop @gen_Stack; $h = uc md4_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4762sub dynamic_f56 { $h = pop @gen_Stack; $h = md5_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4763sub dynamic_f54 { $h = pop @gen_Stack; $h = md5_hex($h)."00000000"; $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4764sub dynamic_f16 { $h = pop @gen_Stack; $h = sha1_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4765sub dynamic_f46 { $h = pop @gen_Stack; $h = md4_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4766sub dynamic_f5c { $h = pop @gen_Stack; $h = base64_wpa(md5($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4767# we can use base64i to get cryptBS layout 4768sub dynamic_f1c { $h = pop @gen_Stack; $h = base64_wpa(sha1($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4769sub dynamic_f4c { $h = pop @gen_Stack; $h = base64_wpa(md4($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4770sub dynamic_f5r { $h = pop @gen_Stack; $h = md5($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4771sub dynamic_f1r { $h = pop @gen_Stack; $h = sha1($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4772sub dynamic_f4r { $h = pop @gen_Stack; $h = md4($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4773sub dynamic_f224h { $h = pop @gen_Stack; $h = sha224_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4774sub dynamic_f224H { $h = pop @gen_Stack; $h = uc sha224_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4775sub dynamic_f2246 { $h = pop @gen_Stack; $h = sha224_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4776sub dynamic_f224c { $h = pop @gen_Stack; $h = base64_wpa(sha224($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4777sub dynamic_f224r { $h = pop @gen_Stack; $h = sha224($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4778sub dynamic_f256h { $h = pop @gen_Stack; $h = sha256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4779sub dynamic_f256H { $h = pop @gen_Stack; $h = uc sha256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4780sub dynamic_f2566 { $h = pop @gen_Stack; $h = sha256_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4781sub dynamic_f256c { $h = pop @gen_Stack; $h = base64_wpa(sha256($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4782sub dynamic_f256r { $h = pop @gen_Stack; $h = sha256($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4783sub dynamic_f384h { $h = pop @gen_Stack; $h = sha384_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4784sub dynamic_f384H { $h = pop @gen_Stack; $h = uc sha384_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4785sub dynamic_f3846 { $h = pop @gen_Stack; $h = sha384_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4786sub dynamic_f384c { $h = pop @gen_Stack; $h = base64_wpa(sha384($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4787sub dynamic_f384r { $h = pop @gen_Stack; $h = sha384($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4788sub dynamic_f512h { $h = pop @gen_Stack; $h = sha512_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4789sub dynamic_f512H { $h = pop @gen_Stack; $h = uc sha512_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4790sub dynamic_f5126 { $h = pop @gen_Stack; $h = sha512_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4791sub dynamic_f512c { $h = pop @gen_Stack; $h = base64_wpa(sha512($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4792sub dynamic_f512r { $h = pop @gen_Stack; $h = sha512($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4793sub dynamic_fgosth { require Digest::GOST; import Digest::GOST qw(gost gost_hex gost_base64); $h = pop @gen_Stack; $h = gost_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4794sub dynamic_fgostH { require Digest::GOST; import Digest::GOST qw(gost gost_hex gost_base64); $h = pop @gen_Stack; $h = uc gost_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4795sub dynamic_fgost6 { require Digest::GOST; import Digest::GOST qw(gost gost_hex gost_base64); $h = pop @gen_Stack; $h = gost_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4796sub dynamic_fgostc { require Digest::GOST; import Digest::GOST qw(gost gost_hex gost_base64); $h = pop @gen_Stack; $h = base64_wpa(gost($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4797sub dynamic_fgostr { require Digest::GOST; import Digest::GOST qw(gost gost_hex gost_base64); $h = pop @gen_Stack; $h = gost($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4798sub dynamic_fwrlph { $h = pop @gen_Stack; $h = whirlpool_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4799sub dynamic_fwrlpH { $h = pop @gen_Stack; $h = uc whirlpool_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4800sub dynamic_fwrlp6 { $h = pop @gen_Stack; $h = whirlpool_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4801sub dynamic_fwrlpc { $h = pop @gen_Stack; $h = base64_wpa(whirlpool($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4802sub dynamic_fwrlpr { $h = pop @gen_Stack; $h = whirlpool($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4803sub dynamic_ftigh { $h = pop @gen_Stack; $h = tiger_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4804sub dynamic_ftigH { $h = pop @gen_Stack; $h = uc tiger_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4805sub dynamic_ftig6 { $h = pop @gen_Stack; $h = tiger_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4806sub dynamic_ftigc { $h = pop @gen_Stack; $h = base64_wpa(tiger($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4807sub dynamic_ftigr { $h = pop @gen_Stack; $h = tiger($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4808sub dynamic_frip128h { $h = pop @gen_Stack; $h = ripemd128_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4809sub dynamic_frip128H { $h = pop @gen_Stack; $h = uc ripemd128_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4810sub dynamic_frip1286 { $h = pop @gen_Stack; $h = ripemd128_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4811sub dynamic_frip128c { $h = pop @gen_Stack; $h = base64_wpa(ripemd128($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4812sub dynamic_frip128r { $h = pop @gen_Stack; $h = ripemd128($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4813sub dynamic_frip160h { $h = pop @gen_Stack; $h = ripemd160_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4814sub dynamic_frip160H { $h = pop @gen_Stack; $h = uc ripemd160_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4815sub dynamic_frip1606 { $h = pop @gen_Stack; $h = ripemd160_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4816sub dynamic_frip160c { $h = pop @gen_Stack; $h = base64_wpa(ripemd160($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4817sub dynamic_frip160r { $h = pop @gen_Stack; $h = ripemd160($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4818sub dynamic_frip256h { $h = pop @gen_Stack; $h = ripemd256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4819sub dynamic_frip256H { $h = pop @gen_Stack; $h = uc ripemd256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4820sub dynamic_frip2566 { $h = pop @gen_Stack; $h = ripemd256_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4821sub dynamic_frip256c { $h = pop @gen_Stack; $h = base64_wpa(ripemd256($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4822sub dynamic_frip256r { $h = pop @gen_Stack; $h = ripemd256($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4823sub dynamic_frip320h { $h = pop @gen_Stack; $h = ripemd320_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4824sub dynamic_frip320H { $h = pop @gen_Stack; $h = uc ripemd320_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4825sub dynamic_frip3206 { $h = pop @gen_Stack; $h = ripemd320_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4826sub dynamic_frip320c { $h = pop @gen_Stack; $h = base64_wpa(ripemd320($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4827sub dynamic_frip320r { $h = pop @gen_Stack; $h = ripemd320($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4828sub dynamic_fhavh { require Digest::Haval256; $h = pop @gen_Stack; $h = haval256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4829sub dynamic_fhavH { require Digest::Haval256; $h = pop @gen_Stack; $h = uc haval256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4830sub dynamic_fhav6 { require Digest::Haval256; $h = pop @gen_Stack; $h = haval256_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4831sub dynamic_fhavc { require Digest::Haval256; $h = pop @gen_Stack; $h = base64_wpa(haval256($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4832sub dynamic_fhavr { require Digest::Haval256; $h = pop @gen_Stack; $h = haval256($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4833sub dynamic_fpad16 { $h = pop @gen_Stack; $h = pad16($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4834sub dynamic_fpad20 { $h = pop @gen_Stack; $h = pad20($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4835sub dynamic_fpad100{ $h = pop @gen_Stack; $h = pad100($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4836sub dynamic_fpadmd64 { $h = pop @gen_Stack; $h = pad_md64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4837sub dynamic_futf16 { $h = pop @gen_Stack; $h = encode("UTF-16LE",$h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4838sub dynamic_futf16be{ $h = pop @gen_Stack; $h = encode("UTF-16BE",$h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4839 4840sub dynamic_fsha3_224h { require Digest::SHA3; import Digest::SHA3 qw(sha3_224_hex); $h = pop @gen_Stack; $h = sha3_224_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4841sub dynamic_fsha3_224H { require Digest::SHA3; import Digest::SHA3 qw(sha3_224_hex); $h = pop @gen_Stack; $h = uc sha3_224_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4842sub dynamic_fsha3_2246 { require Digest::SHA3; import Digest::SHA3 qw(sha3_224_base64); $h = pop @gen_Stack; $h = sha3_224_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4843sub dynamic_fsha3_224c { require Digest::SHA3; import Digest::SHA3 qw(sha3_224); $h = pop @gen_Stack; $h = base64_wpa(sha3_224($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4844sub dynamic_fsha3_224r { require Digest::SHA3; import Digest::SHA3 qw(sha3_224); $h = pop @gen_Stack; $h = sha3_224($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4845sub dynamic_fsha3_256h { require Digest::SHA3; import Digest::SHA3 qw(sha3_256_hex); $h = pop @gen_Stack; $h = sha3_256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4846sub dynamic_fsha3_256H { require Digest::SHA3; import Digest::SHA3 qw(sha3_256_hex); $h = pop @gen_Stack; $h = uc sha3_256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4847sub dynamic_fsha3_2566 { require Digest::SHA3; import Digest::SHA3 qw(sha3_256_base64); $h = pop @gen_Stack; $h = sha3_256_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4848sub dynamic_fsha3_256c { require Digest::SHA3; import Digest::SHA3 qw(sha3_256); $h = pop @gen_Stack; $h = base64_wpa(sha3_256($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4849sub dynamic_fsha3_256r { require Digest::SHA3; import Digest::SHA3 qw(sha3_256); $h = pop @gen_Stack; $h = sha3_256($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4850sub dynamic_fsha3_384h { require Digest::SHA3; import Digest::SHA3 qw(sha3_384_hex); $h = pop @gen_Stack; $h = sha3_384_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4851sub dynamic_fsha3_384H { require Digest::SHA3; import Digest::SHA3 qw(sha3_384_hex); $h = pop @gen_Stack; $h = uc sha3_384_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4852sub dynamic_fsha3_3846 { require Digest::SHA3; import Digest::SHA3 qw(sha3_384_base64); $h = pop @gen_Stack; $h = sha3_384_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4853sub dynamic_fsha3_384c { require Digest::SHA3; import Digest::SHA3 qw(sha3_384); $h = pop @gen_Stack; $h = base64_wpa(sha3_384($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4854sub dynamic_fsha3_384r { require Digest::SHA3; import Digest::SHA3 qw(sha3_384); $h = pop @gen_Stack; $h = sha3_384($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4855sub dynamic_fsha3_512h { require Digest::SHA3; import Digest::SHA3 qw(sha3_512_hex); $h = pop @gen_Stack; $h = sha3_512_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4856sub dynamic_fsha3_512H { require Digest::SHA3; import Digest::SHA3 qw(sha3_512_hex); $h = pop @gen_Stack; $h = uc sha3_512_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4857sub dynamic_fsha3_5126 { require Digest::SHA3; import Digest::SHA3 qw(sha3_512_base64); $h = pop @gen_Stack; $h = sha3_512_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4858sub dynamic_fsha3_512c { require Digest::SHA3; import Digest::SHA3 qw(sha3_512); $h = pop @gen_Stack; $h = base64_wpa(sha3_512($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4859sub dynamic_fsha3_512r { require Digest::SHA3; import Digest::SHA3 qw(sha3_512); $h = pop @gen_Stack; $h = sha3_512($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4860sub dynamic_fkeccak_256h { require Digest::Keccak; import Digest::Keccak qw(keccak_256_hex); $h = pop @gen_Stack; $h = keccak_256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4861sub dynamic_fkeccak_256H { require Digest::Keccak; import Digest::Keccak qw(keccak_256_hex); $h = pop @gen_Stack; $h = uc keccak_256_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4862sub dynamic_fkeccak_2566 { require Digest::Keccak; import Digest::Keccak qw(keccak_256_base64); $h = pop @gen_Stack; $h = keccak_256_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4863sub dynamic_fkeccak_256c { require Digest::Keccak; import Digest::Keccak qw(keccak_256); $h = pop @gen_Stack; $h = base64_wpa(keccak_256($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4864sub dynamic_fkeccak_256r { require Digest::Keccak; import Digest::Keccak qw(keccak_256); $h = pop @gen_Stack; $h = keccak_256($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4865sub dynamic_fkeccak_512h { require Digest::Keccak; import Digest::Keccak qw(keccak_512_hex); $h = pop @gen_Stack; $h = keccak_512_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4866sub dynamic_fkeccak_512H { require Digest::Keccak; import Digest::Keccak qw(keccak_512_hex); $h = pop @gen_Stack; $h = uc keccak_512_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4867sub dynamic_fkeccak_5126 { require Digest::Keccak; import Digest::Keccak qw(keccak_512_base64); $h = pop @gen_Stack; $h = keccak_512_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4868sub dynamic_fkeccak_512c { require Digest::Keccak; import Digest::Keccak qw(keccak_512); $h = pop @gen_Stack; $h = base64_wpa(keccak_512($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4869sub dynamic_fkeccak_512r { require Digest::Keccak; import Digest::Keccak qw(keccak_512); $h = pop @gen_Stack; $h = keccak_512($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4870sub dynamic_fmd2h { require Digest::MD2; import Digest::MD2 qw(md2_hex); $h = pop @gen_Stack; $h = md2_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4871sub dynamic_fmd2H { require Digest::MD2; import Digest::MD2 qw(md2_hex); $h = pop @gen_Stack; $h = uc md2_hex($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4872sub dynamic_fmd26 { require Digest::MD2; import Digest::MD2 qw(md2_base64); $h = pop @gen_Stack; $h = md2_base64($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4873sub dynamic_fmd2c { require Digest::MD2; import Digest::MD2 qw(md2); $h = pop @gen_Stack; $h = base64_wpa(md2($h)); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4874sub dynamic_fmd2r { require Digest::MD2; import Digest::MD2 qw(md2); $h = pop @gen_Stack; $h = md2($h); $gen_Stack[@gen_Stack-1] .= $h; return $h; } 4875