-
Notifications
You must be signed in to change notification settings - Fork 15
/
Copy pathjtrts.pl
executable file
·1553 lines (1468 loc) · 57.1 KB
/
jtrts.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#!/usr/bin/perl -w
use strict;
use lib ".";
use Getopt::Long;
use jtrts_inc;
use Digest::MD5;
use MIME::Base64;
use List::Util qw/shuffle/;
use Storable;
my $VERSION = "1.13";
my $RELEASE_DATE = "Dec 21, 2014";
# how to do alpha character left, so next 'alpha', or beta release will be easy.
#use utf8;
#my $VERSION = "1.10-\x{3B1}2"; # alpha-2
#binmode(STDOUT, ":utf8"); # to print the alpha char. once we get rid of the alpha char, this line should be commented out.
#############################################################################
# For the version information list, see the file JtrTestSuite.Manifest
# also see the github commit record at:
# https://github.com/magnumripper/jtrTestSuite/commits/master
#############################################################################
# EDIT this variable to properly setup the john-test-suite script
my $JOHN_PATH = "../run";
# NOTE, john built on Windows 'may' need this lines changed to "$JOHN_PATH/john.exe" IF the script will not run properly.
my $JOHN_EXE = "$JOHN_PATH/john";
my $UNIQUE = "$JOHN_PATH/unique 2>/dev/null";
my $verbosity = 2;
my @types=();
my @nontypes=();
my @caps=();
my @encs=();
my @johnUsageScreen=();
my @validFormats=();
my %formatDetails=();
my %opts=(line_num => 0);
my @tstdata;
my $show_stderr=0;
my $only_1_type=0;
my $last_line_len=0;
my $error_cnt = 0; my $error_cnt_pot = 0; my $done_cnt = 0; my $ret_val_non_zero_cnt = 0;
my $dyanmic_wanted="normal";
my @startingTime;
my $pass_thru = "";
my $show_pass_thru;
my $rand_seed = 31337;
my $core_only = 0;
# Set this once and we don't have to care about it anymore
$ENV{"LC_ALL"} = "C";
# Speed up OpenCL for short runs/many salts. Do not touch if already set.
if (!defined($ENV{"LWS"})) { $ENV{"LWS"} = "8"; }
if (!defined($ENV{"GWS"})) { $ENV{"GWS"} = "64"; }
###############################################################################
# MAIN
###############################################################################
local $| = 1; # force non buffered line io for stdout.
startTime();
parseArgs();
setup(); # this function takes a while!!
readData();
if (defined $opts{showtypes} && $opts{showtypes} > 0) { showTypeData(); unlink_restore(); exit 0; }
johnPrelims();
if (defined $opts{internal} && $opts{internal} > 0) { doInternalMode(); unlink_restore(); }
if (defined $opts{restore} && $opts{restore} > 0) { doRestoreMode(); unlink_restore(); }
filterPatterns();
process(0, 0);
cleanup();
unlink_restore();
displaySummary();
exit $error_cnt+$error_cnt_pot+$ret_val_non_zero_cnt;
###############################################################################
# End of MAIN. Everything from this point on is subroutines.
###############################################################################
###############################################################################
# Here are all of the subroutines that get the job done
###############################################################################
sub randstr {
my @chr = ('.','/','0'..'9','A'..'Z','a'..'z');
my $s="";
foreach (1..$_[0]) { $s.=$chr[rand @chr]; }
return $s;
}
sub startTime {
@startingTime = gmtime(time);
}
sub displaySummary {
my @timeEnd = gmtime(time);
my $secs = timeToSecs(@timeEnd)-timeToSecs(@startingTime);
if ($error_cnt == 0 && $error_cnt_pot == 0 && $ret_val_non_zero_cnt == 0) {
if ($done_cnt == 0) { ScreenOutAlways ("NO tests were performed. Time used was $secs seconds\n"); }
else { ScreenOutAlways ("All tests passed without error. Performed $done_cnt tests. Time used was $secs seconds\n"); }
} else {
my $s = "Some tests had Errors. Performed $done_cnt tests.";
unless ($error_cnt == 0) { $s = $s . " $error_cnt errors"; }
unless ($error_cnt_pot == 0) { $s = $s . " $error_cnt_pot errors reprocessing the .POT files"; }
unless ($ret_val_non_zero_cnt == 0) { $s = $s . " $ret_val_non_zero_cnt runs had non-clean exit"; }
ScreenOutAlways ("$s\nTime used was $secs seconds\n");
}
}
###############################################################################
# parse our command line options.
###############################################################################
sub parseArgs {
my @passthru=();
my $help = 0;
my $resume = 0;
my $err = GetOptions(\%opts,
'help|?' => \$help,
'quiet+' ,# => \$quiet,
'verbose+' ,# => \$verbose,
'type=s' ,# => \@types,
'nontype=s' ,# => \@nontypes,
'showtypes' ,# => \$showtypes,
'basepath=s' ,# => \$basepath,
'dynamic=s' ,# => \$dyanmic_wanted,
'prelims!' ,# => \$prelims,
'passthru=s' ,# => \@passthru,
'stoponerror!' ,# => \$stop_on_error,
'showstderr!' ,# => \$show_stderr,
'internal!' ,# => \$internal_testing,
'restore!' ,# => \$restore_testing,
'resume!' => \$resume,
'case_mangle!' ,# => \$hash_case_mangle,
'random!' ,# => \$randomize,
'ignore_full!' ,# => \$ignore_full,
'seed=n' ,# => \$rand_seed
);
if ($err == 0) {
print "exiting, due to invalid option\n";
exit 1;
}
if ($help) { usage($JOHN_PATH); }
if (@ARGV) {$opts{argv} = \@ARGV; }
if ($resume != 0) { ResumeState(); $opts{resume}=1; }
else { SaveState(); }
if (defined $opts{argv}) {@ARGV = @{$opts{argv}}; }
if (defined $opts{type}) {@types = split /\s+/, $opts{type}; }
if (defined $opts{nontype}) {@nontypes = split /\s+/, $opts{nontype}; }
if (defined $opts{dynamic}) {$dyanmic_wanted = $opts{dynamic}; }
# not sure why needed, but it is. The only think I can see is that the passthru
# object starts with a '-' character. But if we leave it in strict mode perl
# exits out trying to handle the next expression.
if (defined $opts{passthru}) {@passthru = split /\s+/, $opts{passthru}; }
if (defined $opts{showstderr}) {$show_stderr = $opts{showstderr}; }
if (defined $opts{seed}) {$rand_seed = $opts{seed}; }
if (defined $opts{basepath}) {
$JOHN_PATH = $opts{basepath};
$JOHN_EXE = "$JOHN_PATH/john";
$UNIQUE = "$JOHN_PATH/unique 2>/dev/null";
}
$verbosity = 2;
if (defined $opts{verbose}) { $verbosity += $opts{verbose} }
if (defined $opts{quiet}) { $verbosity -= $opts{quiet} }
setVerbosity($verbosity);
if (@ARGV) { push @types, @ARGV; }
my $cnt=0;
foreach my $i (0..$#types) { ++$cnt; $types[$i] = lc($types[$i]); }
if ($cnt == 1) { $only_1_type = 1; }
foreach my $s (@passthru) { $pass_thru .= " " . $s; }
$pass_thru =~ s/--?sa[ve\-mory]*[=:]\d+ ?//; # save memory is simply not allowed in the TS.
$show_pass_thru = strip_pass_thru_to_show($pass_thru);
}
sub strip_pass_thru_to_show {
my $show_pass_thru = $_[0];
$show_pass_thru =~ s/--?nol[og]* ?//;
$show_pass_thru =~ s/--?fork[=:]\d+ ?//;
$show_pass_thru =~ s/--?mkpc?[=:]\d+ ?//;
$show_pass_thru =~ s/--?sk[ip\-selft]* ?//;
$show_pass_thru =~ s/--?max-r[un\-time]*[=:]\d+ ?//;
# --dupe-suppression on GPU builds or on CPU builds:
$show_pass_thru =~ s/--?du[pe\-surion]* ?//;
# a possible --dupe-suppression abbreviation on noAn-GPU builds,
# this will drop the abbreviated option if followed by other options:
$show_pass_thru =~ s/--?d //;
# this will drop --d at the end of -passthru="...":
$show_pass_thru =~ s/--?d$//;
$show_pass_thru =~ s/--?me[mfile\-sz]*[=:]\d+ ?//;
$show_pass_thru =~ s/--?fix[\-staedly]*[=:]\d+ ?//;
$show_pass_thru =~ s/--?pro[gres\-vry]*[=:]\d+ ?//;
$show_pass_thru =~ s/--?cr[ack\-stu]* ?//;
$show_pass_thru =~ s/--?fie[ld\-separtoch]*[^\s]+ ?//;
$show_pass_thru =~ s/--?sal[ts]*[=:]\d+ ?//;
# --rules=none might help to find UbSan or ASan bugs in rpp.c,
# that's why drop that for --show as well, just in case
$show_pass_thru =~ s/--?ru[les]*[:=]?[^\s]* ?//;
# Allow -passthru="--mask='?w'" and drop --mask from --show options
$show_pass_thru =~ s/--?mask?[:=]?[^\s]* ?//;
# --regex needs to be dropped as well
$show_pass_thru =~ s/--?regex[:=][^\s]* ?//;
# And finally, --external needs to be dropped
# (in jumbo, the shortest abbreviation is -ex, in core it is -e)
$show_pass_thru =~ s/--?e[xternal]*[:=][^\s]* ?//;
return $show_pass_thru;
}
sub ResumeState {
%opts = %{retrieve('jtrts.resume')};
}
sub SaveState {
store \%opts, 'jtrts.resume';
}
sub unlink_restore {
unlink ('jtrts.resume');
}
###############################################################################
# see if we can find a string (i.e. grep) from the usage data
###############################################################################
sub grepUsage {
foreach my $line(@johnUsageScreen) {
if (index($line,$_[0]) ge 0) {
return 1;
}
}
return 0;
}
sub LoadFormatDetails {
# build the formatDetails hash (1 time)
my $res = `$JOHN_EXE $show_pass_thru -list=format-details 2>/dev/null`;
$res .= `$JOHN_EXE $show_pass_thru -list=format-details -format=dynamic 2>/dev/null`;
my @details = split ("\n", $res);
foreach my $detail (@details) {
my @indiv = split("\t", $detail);
if (scalar @indiv > 12) {
$formatDetails {lc $indiv[0]} = $detail;
}
}
}
sub StopOnError {
my $cmd=$_[0]; my $pot=$_[1]; my $show=$_[2];
if (defined $opts{stoponerror} && $opts{stoponerror} > 0) {
ScreenOut("Exiting on error. The .pot file $pot contains the found data\n");
$cmd =~ s# 2>&1##;
$cmd =~ s# 2?>/dev/null##g;
$cmd =~ s# 2>_stderr##g;
$show =~ s# 2>&1##;
$show =~ s# 2?>/dev/null##g;
$show =~ s# 2>_stderr##g;
ScreenOut("The command used to run this test was:\n\n$cmd\n");
if (length($show) > 0) {ScreenOut("and\n$show\n");}
my $str = `grep Terminating tst-.log`;
if (length($str)>0) { print "\nFrom tst-.log file:\n$str\n"; }
exit(1);
}
}
###############################################################################
# here we do prelim work. This is the multiple calls to -test=0 (-test-full=0
# for jumbo) which should not output ANY error conditions.
###############################################################################
sub johnPrelims {
return unless ( defined $opts{prelims} && $opts{prelims}>0 );
johnTest0_one(" ");
foreach my $item (@encs) {johnTest0_one($item);}
if ($verbosity < 2) {ScreenOutSemi(" \n");}
}
sub johnTest0_one {
if (length($_[0]) < 2 || stringInArray($_[0], @types) || stringInArray("enc", @types) || stringInArray("full", @types)) {
if (length($_[0]) >= 2) { $_[0] = "--encoding=$_[0]"; }
my $sCmd;
if ($core_only == 1) {
$sCmd = "$JOHN_EXE -test=0 $_[0] $pass_thru";
} else {
$sCmd = "$JOHN_EXE -test-full=0 $_[0] $pass_thru";
}
ScreenOutSemi("testing: $sCmd\n");
$sCmd .= " 2>/dev/null";
my $sCmdOut = `$sCmd`;
my @CmdLines = split (/\n/, $sCmdOut);
foreach my $line(split (/\n/, $sCmdOut)) {
if (index($line, "FAILED") ge 0) {
ScreenOutAlways($line,"\n");
}
}
}
}
###############################################################################
# We parse through the data file, and list the 'types' that can be used,
# removing duplicates, etc.
###############################################################################
sub showTypeData {
# Get all the 'types'. NOTE, full/full_only were removed from element 0
# so we 'add' it to 'seed' the list, and also add base.
my @typeddata = ("base", "full", "full_only");
my @formatswedo = ();
{
LINE: foreach my $line(@tstdata) {
my @ar = split(',', $line);
my $cnt = @ar;
if ($cnt == 12) {
if (stringInArray($ar[7], @validFormats) && !stringInArray($ar[7], @formatswedo)) {
push(@formatswedo, $ar[7]);
}
my @types = split('\)', $ar[0]);
my @types_fixed = ();
TYPE: foreach my $type (@types) {
$type = substr($type, 1, length($type)-1);
if ($type eq "full") {ScreenOutVV("(full) found in field0 for $line\n");}
if (!stringInArray($type, @validFormats)) {
push(@types_fixed, $type);
} else {
ScreenOutVV("Exact format found in field 1 $type\n");
}
}
my %k;
map { $k{$_} = 1 } @typeddata;
push(@typeddata, grep { !exists $k{$_} } @types_fixed);
}
}
}
ScreenOutAlways_ar("\nHere are all of the type values in this test suite:\n", @typeddata);
ScreenOutAlways_ar("\nThese are the valid formats in this john (also valid as types):\n", @validFormats);
ScreenOutAlways_ar("\nThese are the formats jtrts processes (also valid as types):\n", sort @formatswedo);
ScreenOutAlways("\nIf there is no types given, then '-type base -type utf8 -type koi8r'\n");
ScreenOutAlways("will be the type used if this is a john-jumbo build, and -type full\n");
ScreenOutAlways("will be used for non-jumbo john (i.e. 'core' john)\n\n");
ScreenOutAlways("-type full does a test of ALL formats, and all encodings, including the\n");
ScreenOutAlways(" slower types.\n");
ScreenOutAlways("-type base tests the formats where tests do not take 'too' much time.\n");
ScreenOutAlways(" NOTE, base covers most of the formats.\n");
ScreenOutAlways(" NOTE, full_only will test ONLY the (full) formats.\n");
}
###############################################################################
# Setup the program to run. Parses through params, strtok's the john screen
# output, and also possilby john --subformat=LIST (deprecated) or
# john --list=subformats and john --encoding=LIST to find
# internal 'variable' data built into jumbo, which can be added to, or removed
# over time, and between builds.
###############################################################################
sub setup {
if ( ! -d $JOHN_PATH ) {
ScreenOutAlways("ERROR, the JOHN_PATH variable has to be setup properly for this script file to run.\n");
exit;
}
if ( ! -f $JOHN_EXE ) {
ScreenOutAlways("Error, the JOHN_EXE variable is not setup properly, or john was not built yet\n");
exit;
}
# we store a john usage string. We will use this data in several ways, later.
@johnUsageScreen = `$JOHN_EXE 2>&1`;
if (grepUsage("Use --help")) {
@johnUsageScreen = `$JOHN_EXE --help 2>&1`;
}
if (grepUsage("--list=hidden-options")) {
push(@johnUsageScreen, `$JOHN_EXE --list=hidden-options 2>&1`);
}
ScreenOutAlways("-------------------------------------------------------------------------------\n");
ScreenOutAlways("- JtR-TestSuite (jtrts). Version $VERSION, $RELEASE_DATE. By, JimF & others\n");
ScreenOutAlways("- Testing: $johnUsageScreen[0]"); # note the line ends in a \n, so do not add one.
ScreenOutAlways("--------------------------------------------------------------------------------\n");
ScreenOut("\n");
# now use the john error screen to determine if this is a jumbo john, or
# a core john. Then use this data to figure out what formats ARE and are NOT
# able to be run by this build (so we can later skip formats NOT built in
# this build. Also check for how to do -utf8 or --encoding=utf8 (different syntax
# in different builds of john. Also certain extra options may
# be 'possible'. We simply parse that screen (and also a john --subformat=LIST to
# get a list of dynamics, if we are in a jumbo), so we know HOW to proceed.
ScreenOutVV("John 'usage' data is:\n");
ScreenOutVV(@johnUsageScreen);
# can we use -pot=tst-.pot ?
if (grepUsage("--pot=NAME")) {
push(@caps, "jumbo");
push(@caps, "core"); # note, jumbo can do both CORE and JUMBO formats
ScreenOut("John Jumbo build detected.\n");
LoadFormatDetails();
} else {
push(@caps, "core"); # core john can ONLY do core formats.
ScreenOut("John CORE build detected. Only core formats can be tested.\n");
$core_only = 1;
}
# load all the format strings we 'can' use.
loadAllValidFormatTypeStrings();
# does this version handle --dupe-supression ?
if (grepUsage("--dupe-supression")) {
push(@caps, "dupe_suppression");
ScreenOutV("--dupe-suppression option is valid\n");
}
# can we use --config=jtrts.conf ?
if (grepUsage("--config=FILE")) { push(@caps, "config_valid");
ScreenOutV("--config=FILE option is valid\n");
}
# if the --field-sep=value valid?
if (grepUsage("--field-separator-char=")) {
push(@caps, "field_sep_valid");
ScreenOutV("--field-separator-char=C option is valid\n");
}
if (grepUsage("--pot=NAME")) {
push(@caps, "local_pot_valid");
ScreenOutV("--pot=NAME option is valid\n");
}
if (grepUsage("--regex=")) {
push(@caps, "regex");
ScreenOutV("--regex mode exists\n");
}
# can we use --encoding=utf8, --encoding=koi8r, etc.
if (grepUsage("--encoding=NAME")) {
push(@caps, "encode_valid");
ScreenOutV("--encoding=NAME option is valid\n");
loadAllValidEncodings();
}
# ok, now load the md5's of the ascii.chr and alnum.chr files. These end up being 'required' types for the inc to run.
my $file = $JOHN_PATH . "/ascii.chr";
if (open(FILE, $file)) {
binmode(FILE);
my $sHash = "inc_ascii_" . Digest::MD5->new->addfile(*FILE)->hexdigest;
close(FILE);
push(@caps, $sHash);
ScreenOutV("ascii.chr found, $sHash added as a capability\n");
} else {
ScreenOutV("ascii.chr ($file) not found\n");
}
$file = $JOHN_PATH . "/alnum.chr";
if (open(FILE, $file)) {
binmode(FILE);
my $sHash = "inc_alnum_" . Digest::MD5->new->addfile(*FILE)->hexdigest;
close(FILE);
push(@caps, $sHash);
ScreenOutV("alnum.chr found, $sHash added as a capability\n");
} else {
ScreenOutV("alnum.chr ($file) not found\n");
}
if (@types) {
ScreenOutV("Types to filter on:\n");
ScreenOutV(@types);
ScreenOutV("\n");
} else {
# we setup the 'defaults'. If there are NO types at all, then we do this:
# -type full (core builds)
# -t base -t koi8r -t utf8 on john jumbo builds.
if (stringInArray("jumbo", @caps)) {
ScreenOutV("Setting default for john-jumbo to be: base+koi8r+utf8\n");
push (@types, "base", "koi8r", "utf8");
} else {
ScreenOutV("Setting default for john-core to be: full+core\n");
push (@types, "core", "full");
}
}
if (@nontypes) {
ScreenOutV("Types to filter off (non-types):\n");
ScreenOutV(@nontypes);
ScreenOutV("\n");
}
ScreenOutV("Capabilities in this build of john:\n");
ScreenOutV(@caps);
ScreenOutV("\n");
if (stringInArray("config_valid", @caps)) { $JOHN_EXE .= " -config=jtrts.conf"; }
}
###############################################################################
# we parse the tst-JohnUsage.Scr file, for the --format=NAME line, and ALL lines
# up to the next param. We then chop out all of the 'valid' formats which this
# build of john claims to be able to handle. Then we can later compare when
# running, and simply about a run, if this build does not support it.
# The format of this data is:
# --format=NAME force hash type NAME: des/bsdi/md5/bf/afs/lm/trip/
# dummy
# NOTE, there may be MANY more. the format names have varied in case, from
# version to version. We lowercase them here (and also in the input data file).
###############################################################################
sub loadAllValidFormatTypeStrings {
my $in_fmt=0;
my $fmt_str="";
foreach my $line(@johnUsageScreen) {
if ($in_fmt == 0) {
if (index($line, "--format=[NAME") == 0 || index($line, "--format=NAME") == 0) {
if (index($line, ":") < 0) {
# new format layout does not use format names on usage
# screen. The new method forces us to use --list=formats
my @ar = `$JOHN_EXE --list=formats 2>/dev/null`;
foreach $line (@ar) {
chomp $line; $line =~ s/\r$//;
$line =~ s/, /\//g;
$fmt_str = $fmt_str . $line;
}
} else {
$in_fmt = 1;
while (substr($line, 0, 1) ne ":") {
$line = substr($line, 1, length($line)-1);
}
$line = substr($line, 2, length($line)-2);
chomp($line);
$line =~ s/\r$//; # strip CR for non-Windows
$line = $line . '/';
$line =~ s/ /\//g;
$fmt_str = $fmt_str . $line;
}
}
} else {
if (index($line, '-') == 0) { last; }
while (substr($line, 0, 1) eq " " || substr($line, 0, 1) eq "\t") {
$line = substr($line, 1, length($line)-1);
}
chomp($line);
$line =~ s/\r$//; # strip CR for non-Windows
$line = $line . '/';
$line =~ s/ /\//g;
$fmt_str = $fmt_str . $line;
}
}
# strip off the 'final' / char
if ($in_fmt) { $fmt_str = substr($fmt_str, 0, -1); }
# Make all format labels listed from JtR lower case.
$fmt_str = lc($fmt_str);
# removed dynamic_n IF it exists
$fmt_str =~ s/\/dynamic_n//g;
# Ok, now if we have 'dynamic's, LOAD them
if ($dyanmic_wanted ne "none") {
if (grepUsage("--list=WHAT") || grepUsage("--subformat=LIST")) {
my $more = 1;
if ($dyanmic_wanted eq "all") {
system ("$JOHN_EXE $show_pass_thru --list=formats --format=dynamic >JohnDynaUsage.Scr 2>/dev/null");
open(FILE, "<JohnDynaUsage.Scr") or die $!;
my @dyna = <FILE>;
close(FILE);
unlink("JohnDynaUsage.Scr");
if (defined($dyna[0]) && substr($dyna[0], 0, 10) eq "dynamic_0,") {
$more = 0;
foreach my $line (@dyna) {
chomp $line;
$line =~ s/\r$//;
$line =~ s/,//g;
my @ar = split(/ /, $line);
foreach my $item (@ar) {
$fmt_str = $fmt_str . "/" . $item;
}
}
}
}
if ($more > 0) {
if (grepUsage("--list=WHAT")) {
system ("$JOHN_EXE $show_pass_thru --list=subformats >JohnDynaUsage.Scr 2>/dev/null");
}
else {
system ("$JOHN_EXE $show_pass_thru --subformat=LIST >JohnDynaUsage.Scr 2>/dev/null");
}
system ("$JOHN_EXE $show_pass_thru --subformat=LIST >JohnDynaUsage.Scr 2>/dev/null");
open(FILE, "<JohnDynaUsage.Scr") or die $!;
my @dyna = <FILE>;
close(FILE);
unlink("JohnDynaUsage.Scr");
foreach my $line (@dyna) {
my @ar = split(/ /, $line);
if (defined $ar[2] && index($ar[2], "dynamic_") == 0) {
$fmt_str = $fmt_str . "/" . $ar[2];
}
}
}
}
}
#$fmt_str = $fmt_str . "/inc";
@validFormats = split(/\//, $fmt_str);
if (index($fmt_str, "-cuda") != -1) {
push(@caps, "cuda");
}
if (index($fmt_str, "-opencl") != -1) {
push(@caps, "opencl");
}
# push (inc), since ALL john versions allow the inc.
push(@caps, "inc");
if ($verbosity > 3) {
my $cnt = @validFormats;
ScreenOutVVV("There are $cnt formats this john build can handle. These are:\n");
foreach my $line(@validFormats) { ScreenOutVVV($line . ","); }
ScreenOutVVV("\n");
}
}
sub loadAllValidEncodings {
ScreenOutV("Get valid encodings from --encoding=LIST\n");
system ("$JOHN_EXE --encoding=LIST >JohnEncUsage.Scr 2>&1");
open(FILE, "<JohnEncUsage.Scr") or die $!;
my @encodings = <FILE>;
close(FILE);
unlink("JohnEncUsage.Scr");
my $str;
foreach my $sline (@encodings) {
if (index($sline, "Supported ") lt 0) {
my @encline = split(/, /,$sline);
foreach my $item (@encline) {
if (index($item, " ") gt 0) {
$item = substr($item, 0, index($item, " "));
}
if (index($item, ",") gt 0) {
$item = substr($item, 0, index($item, ","));
}
push(@caps, $item);
push(@encs, $item);
}
}
}
}
###############################################################################
# we read the data file 'jtrts.dat'. This is a CSV file. It contains lines
# of data, which provide the data, used along with john's capabilities, along
# with the way the user wants to run (the -type and -nontype values).
###############################################################################
sub readData {
open(FILE, "<jtrts.dat") or die $!;
my @lines = <FILE>;
close(FILE);
foreach my $line(@lines) {
chomp($line);
$line =~ s/\r$//; # strip CR for non-Windows
if (length($line) > 0 && substr($line, 0, 1) ne "#") {
#$line = "(*)" . $line; # we have now added the "base", so there is no reason for this one.
my @ar = split(',', $line);
my $cnt = @ar;
if ($cnt == 12) {
if (!defined $opts{showtypes} || $opts{showtypes}==0) {
if (index($ar[0], "($ar[7])") lt 0) {
$line = "($ar[7])$line";
}
$line = "(full)$line";
if (index($ar[1], "(full)") >= 0) {
$line = "(full_only)$line";
}
}
push(@tstdata, $line);
}
}
}
if ($verbosity > 3) {
my $cnt = @tstdata;
ScreenOutVVV("Running data-dictionary. $cnt items (jtrts.dat):\n");
foreach my $line(@tstdata) { ScreenOutVVV($line . "\n"); }
ScreenOutVVV("\n");
}
}
###############################################################################
###############################################################################
sub filterPatterns {
my @filtereddata;
{
LINE: foreach my $line(@tstdata) {
my @ar = split(',', $line);
my $cnt = @ar;
my $valid = 'f';
if ($cnt == 12) {
# determine if our build of john 'can' do this format:
if (!stringInArray($ar[7], @validFormats)) {
ScreenOutVVV("Line [$line] filtered out, because format ${ar[7]} can not be processed by this build of john\n");
next LINE;
}
# Now, make sure that this is something 'requested'
if (!arrayPartInString($ar[0], @types)) {
ScreenOutVVV("Line [$line] filtered out, no requests [$ar[0]] in [@types] were satisfied\n");
next LINE;
}
# Now, make sure that nothing from the is something 'non-requested' is set
if (arrayPartInString($ar[0], @nontypes)) {
ScreenOutVVV("Line [$line] filtered out. A non request [@types] was found\n");
next LINE;
}
# Now, make sure that ALL of the required types are satisfied.
# NOTE, if user specified a format, then assume all requirements have also been specified.
if (!stringInArray($ar[7], @types)) {
if ($ar[1] ne "(X)") {
my @reqs = split(/&/,$ar[1]);
if ((stringInArray("full_only", @types)||(defined $opts{ignore_full} && $opts{ignore_full} > 0)) && index($ar[1], "(full)") >= 0) {
# we want this one!!
} else {
$valid = 'f';
foreach my $req(@reqs) { # note, these are already wrapped in ()
if (!stringInArray(substr($req, 1, length($req)-2), @types)) {
# if only 1 type was given, then we IGNORE 'full' requirements.
if ($only_1_type == 0) {
ScreenOutVVV("Line [$line] filtered out, required option [@reqs] not satisfied in [@types]\n");
next LINE;
}
}
}
}
}
}
# Now, make sure that ALL of the required build capacities are satisfied.
my @reqs = split(/&/,$ar[2]);
foreach my $req(@reqs) {
if (!stringInArray(substr($req, 1, length($req)-2), @caps)) {
ScreenOutVVV("Line [$line] filtered out, required build option option [@reqs] not satisfied in [@caps]\n");
next LINE;
}
}
# OK, make sure the dictionary file 'exists'
unless (-e "${ar[5]}.dic") {
if (substr($ar[5],0,10) ne "INCREMENT_") {
ScreenOutVVV("Line [$line] filtered out, because dictionary ${ar[5]}.dic not found\n");
next LINE;
}
}
# we are going to process this item. Add it to our filtered array.
push (@filtereddata, $line);
}
}
# now that we have filtered our data, put it on the 'real' list.
@tstdata = ();
for my $line(@filtereddata) { push(@tstdata, $line); }
}
if ($verbosity > 3) {
my $cnt = @tstdata;
ScreenOutVVV("Filtered items from the data-dictionary. $cnt items (jtrts.dat):\n");
foreach my $line(@tstdata) { ScreenOutVVV($line . "\n"); }
ScreenOutVVV("\n");
}
}
sub ExtraArgs_Run { #($ar[8], $ar[7], $ar[9]);
#if ($ar[8] eq 'Y') { $cmd = "$cmd -form=$ar[7]"; }
#if ($ar[9] ne 'X') { $cmd .= "$cmd $ar[9]"; }
my $ret = "";
if ($_[0] eq 'Y' || substr($_[1],0,8) eq "dynamic_") { $ret .= " -form=$_[1]"; }
if ($core_only) { return $ret; }
if ($_[2] ne 'X') {
my $x = "";
if (substr($_[2], 0, 1) eq 'X') {
$x = substr($_[2], 1);
} else {
$x = $_[2];
}
my @a = split('\|', $x);
# adusting -enc=xxx into '-encoding=x -internal-codepage=xxx' only
# needed on the 'Run' It does not appear to be needed in RunPot or Show
$a[0] =~ s/-enc=([a-zA-Z0-9\-_]+)/-encoding=$1 -internal-codepage=$1 /;
$ret .= " " . $a[0];
}
return $ret;
}
sub ExtraArgs_RunPot { #($ar[8], $ar[7], $ar[9]);
#if ($ar[8] eq 'Y') { $cmd = "$cmd -form=$ar[7]"; }
#if ($ar[9] ne 'X') { $cmd .= "$cmd $ar[9]"; }
my $ret = "";
if ($_[0] eq 'Y' || substr($_[1],0,8) eq "dynamic_") { $ret .= " -form=$_[1]"; }
if ($core_only) { return $ret; }
if ($_[2] ne 'X') {
my $x = "";
if (substr($_[2], 0, 1) eq 'X') {
$x = substr($_[2], 1);
} else {
$x = $_[2];
}
my @a = split('\|', $x);
if (scalar(@a) > 1) {
$ret .= " " . $a[1];
}
#if (index($ret, "-enc") < 0) {
# $ret .= " -enc=utf8";
#}
}
return $ret;
}
sub ExtraArgs_Show { #($ar[9]);
#if ($ar[9] ne 'X') { $cmd .= "$cmd $ar[9]"; }
my $ret = "";
if ($core_only) { return $ret; }
if (substr($_[0], 0, 1) ne 'X') {
my @a = split('\|', $_[0]);
$ret .= " " . $a[0];
}
$ret = strip_pass_thru_to_show($ret);
return $ret;
}
sub is_format_8bit {
my $type = $_[0];
my $details = $formatDetails{$type};
if (!defined($details)) { return 0; }
my @details = split("\t", $details);
if (scalar @details < 5) { return 0; }
my $_8bit = hex($details[4]) & 0x00000002; # check for FMT_8_BIT
return $_8bit;
}
sub stripHi {
my $is_8bit = $_[1];
return if ($core_only || $is_8bit);
my @chars = split(//, $_[0]);
for (my $i = 0; $i < length($_[0]); ++$i) {
#if (ord($chars[$i]) > ord('~')) { $chars[$i] = chr(ord($chars[$i])-0x80); }
$chars[$i] = chr(ord($chars[$i])&0x7f);
}
$_[0] = join('', @chars);
}
my $sub_cnt=0;
sub pot_match_pass {
# line will be "password (password)" or something else.
my $line = $_[0];
my $is_8bit = $_[1];
chomp $line;
#print "$line\n";
stripHi($line, $is_8bit);
if (substr($line, length($line)-1, 1) ne ")" || index($line, " (") < 0) { return 1; }
if (index($line, "Loaded ") == 0) { return 1; }
if (index($line, "Will run ") == 0 && index($line, "OpenMP") > 0) { return 1; }
if (index($line, "Node numbers ") == 0) { return 1; }
if (index($line, "Local worksize") == 0) { return 1; }
if (index($line, "LWS") == 0) { return 1; }
if (index($line, "guesses: ") == 0) { return 1; }
if (index($line, "../run/john") == 0) { return 1; }
my $idx = index($line, " (");
my $s = substr($line, $idx+2);
$s = substr($s, 0, length($s)-1);
#return substr($line, 0, length($s)) eq $s;
#if (index($line, $s) == 0) { $sub_cnt+=1; print "*** good $sub_cnt\n"; return 2;}
if (index($line, $s) == 0) { return 2;}
ScreenOutV("FAILED line = $_[0]\n");
return 0;
}
sub create_file_if_not_exist {
my $filename = $_[0];
if (-e $filename) { return; }
open(FILE, ">".$filename);
#print FILE "\n";
close(FILE);
}
###############################################################################
###############################################################################
sub exit_cause {
my ($ret_val) = @_;
my $exit_cause = "";
if (!$ret_val) { return $exit_cause; }
if ($ret_val & 128) {
$exit_cause = sprintf("segfault, signal %d%s", $ret_val & 127,
$ret_val & 128 ? " (core dumped)" : "");
} else {
$exit_cause = sprintf("exited, return code %d", $ret_val >> 8);
}
return $exit_cause;
}
sub process {
my ($skip, $int_mask) = @_;
my $pot = "tst-.pot";
my $pot_opt = "";
my $line_num = 0;
my $cmd_head = "$JOHN_EXE -ses=tst- $pass_thru";
if ($skip) { $cmd_head .= " -skip" }
if (stringInArray("local_pot_valid", @caps)) { $cmd_head .= $pot_opt = " -pot=tst-.pot"; }
else {
# handle john 'core' behavior. We save off existing john.pot, then it is overwritten
unlink $JOHN_PATH."/john.ptt";
rename $JOHN_PATH."/john.pot",$JOHN_PATH."/john.ptt";
$pot = $JOHN_PATH."/john.pot";
}
my $dict_name_ex = "";
my $dict_name = "";
my $line = "";
LINE: foreach my $line(@tstdata) {
# start of -resume code (pretty trivial, I just count line#'s)
++$line_num;
if (defined $opts{resume} && $opts{resume} > 0 && defined $opts{line_num}) {
if ($line_num < $opts{line_num}) {
ScreenOutV("resuming. Skipping line $line_num = $line\n");
next LINE;
}
}
# end of -resume code.
unlink $pot;
unlink "tst-.log";
unlink "tst-.rec";
# mark that we are starting a new line. If we crash here,
# a -resume picks up where we left off, i.e. on this test.
$opts{line_num} = $line_num;
SaveState();
my @ar = split(',', $line);
if (substr($ar[5],0,10) eq "INCREMENT_") {
$dict_name = "--incremental=" . substr($ar[5],10);
} else {
$dict_name = "--wordlist=$ar[5].dic";
if ($int_mask) {
$dict_name .= " --mask=?w?b";
}
}
my $cmd = "$cmd_head $ar[6]";
unless (-e $ar[6]) { next LINE; }
$done_cnt = $done_cnt + 1;
if ((defined $opts{random} && $opts{random} > 0) || $ar[3] != 10000) {
open (FILE, "<".substr($dict_name,11));
my @lines = <FILE>;
close(FILE);
$dict_name = "--wordlist=tst-$ar[5]-$ar[3].dic";
$dict_name_ex = substr($dict_name,11);
if ($ar[3] != 10000) {
@lines = @lines[0 .. ($ar[3] - 1)];
}
if (defined $opts{random} && $opts{random} > 0) {
# Add some extra lines before we shuffle. This makes sure that
# we have lines of each length (the file has all up to 18 already)
srand($rand_seed);
my $L1 = randstr(136);
my $i;
if ($ar[3] != 10000) {
for ($i = 18; $i < 134; $i += 3) {
push @lines, substr($L1, 0, $i)."\n";
}
} else {
my $L2 = randstr(136); my $L3 = randstr(136);
my $L4 = randstr(136); my $L5 = randstr(136); my $L6 = randstr(136);
for ($i = 18; $i < 136; ++$i) {
push @lines, substr($L1, 0, $i)."\n"; push @lines, substr($L2, 0, $i)."\n";
push @lines, substr($L3, 0, $i)."\n"; push @lines, substr($L4, 0, $i)."\n";
push @lines, substr($L5, 0, $i)."\n"; push @lines, substr($L6, 0, $i)."\n";
}
}
@lines = shuffle @lines;
}
open (FILE, ">".substr($dict_name,11));
while ($#lines >= 0) {
my $line = shift(@lines);
if (defined $line) { print FILE $line; }
}
close(FILE);
}
$cmd = "$cmd $dict_name" . ExtraArgs_Run($ar[8], $ar[7], $ar[9]);
if ($show_stderr != 1) { $cmd .= " 2>&1 >/dev/null"; }
# this will switch stderr and stdout (vs joining them), so we can grab stderr BY ITSELF.
else { $cmd .= " 3>&1 1>&2 2>&3 >/dev/null"; }
ScreenOutVV("Execute john: $cmd\n");
unlink($pot);
# we create the .pot file. This is a work around for a known issue in vboxfs fs
# under virtualbox using -fork=n mode. If the file is there (even empty), then
# forking locking works. If the file is not there, locking will 'see' multiple
# files many times (depending upon race conditions). This is a bug in virtualbox
# vm's, but this works around it, and cause no other side effects for other OS's.
create_file_if_not_exist($pot);
my $cmd_data = `$cmd`;
my $ret_val = $?;
# ok, now show stderr, if asked to.
if ($show_stderr == 1) { print $cmd_data; }
ScreenOutVV("\n\nCmd_data = \n$cmd_data\n\n");
my @crack_cnt = split (/\n/, $cmd_data);
my $runtime_err = index($cmd_data, "runtime error") != -1;
my @crack_xx = ();
foreach $line (@crack_cnt) {
# cut away progress indicator
$line =~ s/.*\x08//;
# convert to legacy format, take care of --fork=
$line =~ s/^(\d+ )?(\d+)g /guesses: $2 /;
if (index($line, "guesses:") == 0) {
# fork will have multiple guess lines.
if (defined $crack_xx[1] > 0) {
my @crxx = split (/ /, $line);
$crack_xx[1] += $crxx[1];
} else {
@crack_xx = split (/ /, $line);
}
}
}
# convert to legacy format
if (defined $crack_xx[4]) {
$crack_xx[4] =~ s/100%/DONE/;
$crack_xx[4] =~ s/%/%%/;
}
while (not defined $crack_xx[1]) { push (@crack_xx, "0"); }
my $orig_crack_cnt = $crack_xx[1];
ScreenOutSemi("\n");
# Ok, get crack count using --show
my $cmdshow = "$JOHN_EXE -show $show_pass_thru $pot_opt $ar[6] -form=$ar[7]" . ExtraArgs_Show($ar[9]) . " 2>/dev/null";
ScreenOutVV("Execute john: $cmdshow\n");
my $cmd_show_data = `$cmdshow`;
if (!$runtime_err) { $runtime_err = index($cmd_show_data, "runtime error") != -1; }
ScreenOutVVV("\n\nCmd_show_data = \n$cmd_show_data\n\n");
my @cmd_show_lines = split(/\n/, $cmd_show_data);
my $cmd_show_line = $cmd_show_lines[scalar (@cmd_show_lines) - 1];