-
-
Notifications
You must be signed in to change notification settings - Fork 86
/
Copy patho-saft.pl
executable file
·9927 lines (8867 loc) · 463 KB
/
o-saft.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 -CADSio
#!#############################################################################
#!# Copyright (c) 2025, Achim Hoffmann
#!#----------------------------------------------------------------------------
#!# If this tool is valuable for you and we meet some day, you can spend me an
#!# O-Saft. I'll accept good wine or beer too :-). Meanwhile -- 'til we meet --
#!# your're encouraged to make a donation to any needy child you see. Thanks!
#!#----------------------------------------------------------------------------
#!# This software is provided "as is", without warranty of any kind, express or
#!# implied, including but not limited to the warranties of merchantability,
#!# fitness for a particular purpose. In no event shall the copyright holders
#!# or authors be liable for any claim, damages or other liability.
#!# This software is distributed in the hope that it will be useful.
#!#
#!# This software is licensed under GPLv2.
#!#
#!# GPL - The GNU General Public License, version 2
#!# as specified in: http://www.gnu.org/licenses/gpl-2.0
#!# or a copy of it https://github.com/OWASP/O-Saft/blob/master/LICENSE.md
#!# Permits anyone the right to use and modify the software without limitations
#!# as long as proper credits are given and the original and modified source
#!# code are included. Requires that the final product, software derivate from
#!# the original source or any software utilizing a GPL component, such as
#!# this, is also licensed under the same GPL license.
#!#############################################################################
#!# WARNING:
#!# This is no "academically" certified code, but written to be understood and
#!# modified by humans (you:) easily. Please see the documentation in section
#!# "Program Code" (file coding.txt) if you want to improve the program.
## {
# NOTE: when started using "perl o-saft.pl ...", Perl may complain with:
# Too late for "-CA" option at ...
# Workaround: remove -CADSio in shebang line and use it on command line.
# NOTE: when started standalone, following Modules must be available in ./lib :
# OCfg.pm OData.pm Ciphers.pm OText.pm OMan.pm ODoc.pm doc/help.txt
# NOTE: Perl's `use' and `require' will be used for common and well known Perl
# modules only. All other modules, in particular our own ones, are loaded
# using an internal function, see _load_file(). All required modules are
# included as needed. This keeps away noisy messages and allows to be run
# and print some information even if installed incompletely.
## no critic qw(Variables::RequireLocalizedPunctuationVars)
# NOTE: Perl::Critic seems to be buggy as it does not honor the allow option
# for this policy (see t/.perlcriticrc also). It even doesn't honor the
# setting here, hence it's disabled at each line using $ENV{} = ...
## no critic qw(Variables::ProhibitPackageVars)
# NOTE: we have a couple of global variables, but do not want to write them in
# all CAPS (as it would be required by Perl::Critic)
## no critic qw(ErrorHandling::RequireCarping)
# NOTE: Using carp() is nice in modules, as it also prints the calling stack.
# But here it is sufficient to see the line number, hence we use warn().
## no critic qw(Subroutines::ProhibitExcessComplexity)
# NOTE: It's the nature of checks to be complex, hence don't complain.
## no critic qw(Modules::ProhibitExcessMainComplexity)
# NOTE: Yes, it's a high, very high complexity here.
# BUG: this pragma does not work here, needs mccabe value ...
## no critic qw(RegularExpressions::RequireExtendedFormatting)
# most RegEx are human readable.
## }
use strict;
use warnings;
use utf8;
our $SID_main = "@(#) o-saft.pl 3.199 25/03/12 19:06:59"; # version of this file
my $VERSION = _VERSION(); ## no critic qw(ValuesAndExpressions::RequireConstantVersion)
# SEE Perl:constant
# see _VERSION() below for our official version number
use autouse 'Data::Dumper' => qw(Dumper);
#use Encode; # see _load_modules()
#$DB::single=1; # for debugging; start with: PERL5OPT='-dt' $0
#| definitions: configuration need early
#| -------------------------------------
# SEE Make:OSAFT_MAKE (in Makefile.pod)
our $time0 = time(); # must be set very early, cannot be done in OCfg.pm
$time0 = 0 if (defined $ENV{'OSAFT_MAKE'});
our @perl_inc ; # add to @INC
our @perl_noinc ; # remove from @INC
my @perl_incorig; # save orginial @INC
# all these variables are not available in BEGIN{}, but can be set there
#_____________________________________________________________________________
#______________________________________________ functions needed in BEGIN{} __|
sub _VERSION { return "24.09.24"; } # <== our official version number
# get official version (used for --help=* and in private modules)
sub _set_binmode {
# set discipline for I/O operations (STDOUT, STDERR)
# SEE Perl:binmode()
## no critic qw(InputOutput::RequireEncodingWithUTF8Layer)
my $layer = shift;
binmode(STDOUT, $layer);
binmode(STDERR, $layer);
return;
} # _set_binmode
_set_binmode(":unix:utf8"); # set I/O layers very early
# SEE Note:ARGV
sub _is_ARGV { my $rex = shift; return (grep{/$rex/} @ARGV); } # case-sensitive!
sub _is_argv { my $rex = shift; return (grep{/$rex/i} @ARGV); } # case-insensitive!
sub _is_trace { my $rex = shift; return (grep{/--(?:trace(?:=\d*)?$)/} @ARGV); }
sub _is_v_trace { my $rex = shift; return (grep{/--(?:v|trace(?:=\d*)?$)/} @ARGV); } # case-sensitive! because of --v
our $make_text = "(OSAFT_MAKE exists)";
our $time_text = $make_text;
sub _vprint {
#? print information when --v is given
my @txt = @_;
return if not _is_ARGV('(?:--v$)');
my %STR; # dummy declaration to keep Perl's compile phase quiet
printf("%s%s\n", $STR{'INFO'}||'**INFO: ', join(" ", @txt));
# hardcoded '**INFO: ' is necessary in standalone mode only
return;
} # _vprint
sub _trace_time {
# print timestamp if --trace-time was given; similar to trace_time
# time0 does not exist in early calls in BEGIN{} and until arguments are
# read, %cfg is also not set, hence OTrace::trace_time not possible
my @txt = @_;
my $me = $0; $me =~ s{.*?([^/\\]+)$}{$1};
return if not _is_argv('(?:--trace.?(?:time|cmd))');
my $now = 0;
if (defined $time0) {
$now = time(); # only set if called after $time0 is set
$now -= $time0 if not _is_argv('(?:--time.*absolut)');
$now = 0 if (0 > $now);# fix runtime error: $now == -1
}
$now -= 3600; # remove 1 hour, otherwise we get 01:00:00
$now = sprintf("%02s:%02s:%02s", (localtime($now))[2,1,0]);
if (defined $ENV{'OSAFT_MAKE'}) { # SEE Make:OSAFT_MAKE (in Makefile.pod)
# SEE Make:OSAFT_MAKE (in Makefile.pod)
$now = "HH:MM:SS";
printf("#$me timstamp printed as $now $time_text\n") if $time_text;
$time_text = ""; # no more messages
}
printf("#$me $now @txt\n");
return;
} # _trace_time
sub _trace_exit {
# exit if parameter matches given argument in @ARGV
my $txt = shift; # example: INIT{ - initialisation start
$txt =~ s#^\s*##;# strip off leading left spaces
my $arg = $txt; # matches: --exit=INIT{
$arg =~ s#^\s*##;# strip off leading left spaces
$arg =~ s# .*##; # strip off anything right of a space
if (_is_ARGV(qr/(([+,]|--)exit=\Q$arg\E).*/)) { # \Q because of meta chars in $arg
my $me = $0; $me =~ s{.*?([^/\\]+)$}{$1};
printf STDERR ("#${me}::_trace_exit --exit=$txt\n");
# assumes that first word of $txt is argument of --exit
exit 0;
}
return;
} # _trace_exit
sub _trace_next {
# return 1 if parameter matches given argument in @ARGV; 0 otherwise
my $txt = shift;
if (exists &_vprint) { _vprint($txt); }
$txt =~ s#^\s*##;
_trace_time("$txt"); # alias
my $arg = $txt;
$arg =~ s#^\s*##;
$arg =~ s# .*##;
if (_is_ARGV(qr/(([+,]|--)exit=\Q$arg\E).*/)) {
my $me = $0; $me =~ s{.*?([^/\\]+)$}{$1};
printf STDERR ("#${me}::_trace_next --exit=$txt\n");
return 1;
}
return 0;
} # _trace_next
sub _trace_info {
# call _vprint() and _trace_time() and _trace_exit()
my $txt = shift; # example: INIT0 - initialisation start
$txt =~ s#^\s*##;
if (exists &_vprint) { _vprint($txt); }
_trace_time("$txt"); # alias
_trace_exit("$txt"); # alias
return;
} # _trace_info
sub _version_exit { print _VERSION() . "\n"; exit 0; }
# print VERSION and exit
BEGIN {
# SEE Perl:BEGIN
# SEE Perl:BEGIN perlcritic
my $rex = qr/(?:^--trace)/i;
if (_is_argv($rex) or (defined $ENV{'OSAFT_OPTIONS'} and grep{/$rex/} $ENV{'OSAFT_OPTIONS'}) ) {
# print complete command-line if any --trace-* was given, it's intended
# that it works if unknown --trace-* was given, for example --trace-CLI
# use $0 instead of $cfg{'me'}, shows PATH which is nice for debugging
printf("#$0 %s\n", join(" ", @ARGV)) if not _is_argv('--help=');
# do not print command-line in files generated with option --help=*
# as they may contain special syntax where the #* line is wrong
}
_trace_info("BEGIN0 - start");
my $_path = $0; $_path =~ s#[/\\][^/\\]*$##;
my $_pwd = $ENV{PWD} || "."; # . as fallback if $ENV{PWD} not defined
# SEE Perl:@INC
@perl_incorig = @INC;
if ("." ne $_path and not (grep{/^$_path$/} @INC)) {
# add location of executable if not "."
unshift(@INC, "$_path/lib");# lazy, no check if already there
unshift(@INC, $_path);
}
unshift(@INC, $_pwd) if (1 > (grep{/^$_pwd$/} @INC));
unshift(@INC, "lib") if (1 > (grep{/^lib$/} @INC));
unshift(@INC, "."); # dirty hack for own make
_version_exit() if _is_ARGV('(?:([+,]|--)VERSION)');
# be smart to users if systems behave strange :-/
print STDERR "**WARNING: 019: on $^O additional option --v required, sometimes ...\n" if ($^O =~ m/MSWin32/);
# setting @INC according options --inc= and --no-inc=
foreach my $arg (@ARGV) {
push(@perl_inc, $1) if ($arg =~ m/^--inc=(.*)/); # get all --inc=*
push(@perl_noinc, $1) if ($arg =~ m/^--no[,._-]?inc=(.*)/);
if ($arg =~ m/^--inc=(.*)/) {
unshift(@INC, $1) if (1 > (grep{/^$1$/} @INC));
}
}
foreach my $arg (@perl_noinc) {
@INC = grep{$_ !~ m#$arg#} @INC;
}
_trace_info("BEGIN9 - end");
} # BEGIN
_trace_info("INIT0 - initialisation start");
$::osaft_standalone = 0; # SEE Note:Stand-alone
## PACKAGES # dummy comment used by some generators, do not remove
#| README if any
#| -------------------------------------
#if (open(my $rc, '<', "o-saft-README")) { print <$rc>; close($rc); exit 0; };
# SEE Since VERSION 16.06.16
#| definitions: include configuration
#| -------------------------------------
# modules always needed, it's ok to die if missing, hence not loaded with _load_modules()
use IO::Socket; # avoid: Bareword "AF_INET" not allowed while "strict subs" in use ...
use OText qw(%STR);
use OCfg qw(%cfg %dbx %data_oid %prot _dbx);
use OData qw(%checks %data %check_cert %check_conn %check_dest %check_http %check_size);
# (%check_cert %check_conn %check_dest %check_http %check_size );
use Ciphers qw(%ciphers %ciphers_desc %ciphers_notes $cipher_results);
# for definition of above internal variables SEE Note:Data Structures
# $0 +test-vars # will show a quick overview
# Note that %checks is constructed at runtime from %check_*, see OData::_init
#_____________________________________________________________________________
#______________________________________ functions for trace, initialisation __|
#| definitions: debug and tracing functions
#| -------------------------------------
# functions used very early in main
sub _tprint { my @txt = @_; printf("#%s: %s\n", $cfg{'me'}, join(" ", @txt)); return; }
#? same as OTrace::trace; needed before loading module
sub _warn_nosni {
#? print warning and hint message if SNI is not supported by SSL
my $err = shift;
my $ssl = shift;
my $sni = shift;
return if ($sni < 1);
return if ($ssl !~ m/^SSLv[23]/);
# SSLv2 has no SNI; SSLv3 has originally no SNI
OCfg::warn("$err $ssl does not support SNI; cipher checks are done without SNI");
return;
} # _warn_nosni
sub _vprint2 {
#? print information when --v --v is given
my @txt = @_;
return if (1 >= _is_cfg_verbose());
_vprint(@txt);
return;
} # _vprint2
sub _vprint_read {
#? print information which file will be read
#? will only be written if --v or --warn or --trace is given and --cgi-exec
#? or --no-header are not given
# $cgi is not (yet) available, hence we use @ARGV to check for options
# $cfg{'out'}->{'header'} is also not yet properly set, see LIMITATIONS also
my ($fil, @txt) = @_;
return if _is_argv('(?:--no.?header|--cgi)'); # --cgi-exec or --cgi-trace
return if not _is_argv('(?:--v$|--trace|--warn)');
if (not _is_argv('(?:--trace[_.-]?(?:arg|cmd|time|me)$)')) {
return if _is_argv('(?:--trace[_.-]?cli|key$)');# --trace-CLI or --trace-KEY
}
# print "read ..." also if only any --trace* given
_tprint("read", $fil, "(@txt)") if _is_argv('(?:--trace)');
_vprint("read", $fil, "(@txt)");
return;
} # _vprint_read
sub _vprint_me {
#? print own version, command-line arguments and date and time
my ($s,$m,$h,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
_vprint($cfg{'me'}, _VERSION());
_vprint($cfg{'me'}, @{$cfg{'ARGV'}});
if (defined $ENV{'OSAFT_MAKE'}) { # SEE Make:OSAFT_MAKE (in Makefile.pod)
_vprint("$cfg{'me'}: dd.mm.yyyy HH:MM:SS $make_text");
} else {
_vprint(sprintf("%s: %02s.%02s.%s %02s:%02s:%02s", $cfg{'me'}, $mday, ($mon +1), ($year +1900), $h, $m, $s));
}
return;
} # _vprint_me
sub _load_file {
#? load file with Perl's require using the paths in @INC
# use `$0 +version --v' to see which files are loaded
my $fil = shift;
my $txt = shift;
my $err = "";
return $err if (grep{/$fil/} @{$dbx{'files'}}); # avoid multiple loads
# need eval to catch "Can't locate ... in @INC ..."
eval {require $fil;} or OCfg::warn("101: 'require $fil' failed");
$err = $@;
chomp $err;
if ("" eq $err) {
$fil = $INC{$fil};
$txt = "$txt done";
} else {
$txt = "$txt failed";
}
push(@{$dbx{'files'}}, $fil);
_vprint_read($fil, $txt);
return $err;
} # _load_file
#_____________________________________________________________________________
#________________________________________________________________ variables __|
my $arg = ""; # no special purpose, used in various loops
my @argv = (); # all options, including those from RC-FILE
# will be used when ever possible instead of @ARGV
my @rc_argv = ""; # all options read from RC-FILE
my @dbx = (); # contains all debug options, like --trace* and --v
# must be set from @argv not @ARGV to get values from
# RC-FILE also, see below
# some temporary variables used in main, they are mainly just shortcuts for
# corresponding values in $cfg{}, used for better human readability
my $host = ""; # the host currently processed in main
my $port = ""; # the port currently used in main
my $legacy = ""; # the legacy mode used in main
my $help = ""; # set to argument if it begins with --help* or --h
my $test = ""; # set to argument if it begins with --test* or +test*
my $info = 0; # set to 1 if +info
my $check = 0; # set to 1 if +check was used
my $quick = 0; # set to 1 if +quick was used
my $cmdsni = 0; # set to 1 if +sni or +sni_check was used
my $sniname = undef; # will be set to $cfg{'sni_name'} as this changes for each host
my $cgi = _is_argv('(?:--cgi-?(?:exec|trace$))'); # 1: for --cgi-exec, --cgi-trace
our %openssl = (
# contains all OpenSSL related informations and settings
'timeout' => "timeout", # to terminate shell processes (timeout 1)
'exe' => "openssl", # OpenSSL
'exe3' => "openssl", # OpenSSL which supports TLSv1.3
'external' => 1, # 1: use external openssl; default yes, except on Win32
'sclient' => 1, # 1: use openssl s_client; default yes, except on Win32
'libs' => [], # where to find libssl.so and libcrypto.so
'path' => [], # where to find openssl executable
'envlibvar' => "LD_LIBRARY_PATH", # name of environment variable
'envlibvar3' => "LD_LIBRARY_PATH", # for OpenSSL which supports TLSv1.3
'call' => [], # list of special (internal) function calls
# see --call=METHOD option in description below
'version' => "", # OpenSSL's version number, see OCfg::get_openssl_version
); # %openssl
$cfg{'time0'} = $time0;
OCfg::set_user_agent("$cfg{'me'}/3.199"); # use version of this file not $VERSION
OCfg::set_user_agent("$cfg{'me'}/$STR{'MAKEVAL'}") if (defined $ENV{'OSAFT_MAKE'});
# TODO: $STR{'MAKEVAL'} is wrong if not called by internal make targets
%{$cfg{'done'}} = ( # internal administration
'targets' => 0,
'dbxfile' => 0,
'rc_file' => 0,
'init_all' => 0,
'ssl_failed' => 0, # local counter for SSL connection errors
'ssl_errors' => 0, # total counter for SSL connection errors
'arg_cmds' => [], # contains all commands given as argument
# all following need to be reset for each host, which is done in
# _resetchecks() by matching the key against ^check or ^cipher
'default_get' => 0,
'ciphers_all' => 0,
'ciphers_get' => 0,
'checkciphers' => 0, # not used, as it's called multiple times
'checkpreferred' => 0,
'check02102' => 0,
'check03116' => 0,
'check2818' => 0,
'check6125' => 0,
'check7525' => 0,
'checkdates' => 0,
'checksizes' => 0,
'checkbleed' => 0,
'checkcert' => 0,
'checkprot' => 0,
'checkdest' => 0,
'checkhttp' => 0,
'checksstp' => 0,
'checksni' => 0,
'checkssl' => 0,
'checkalpn' => 0,
'checkdv' => 0,
'checkev' => 0,
'check_dh' => 0,
'check_url' => 0, # not used, as it's called multiple times
'check_certchars' => 0,
);
# TODO: move %text to OCfg or OText
our %text = ( # our instead of my required for --help=cfg-text --help=text
'separator' => ":",# separator character between label and value
# texts may be redefined
'undef' => "<<undefined>>",
'response' => "<<response>>",
'protocol' => "<<protocol probably supported, but no ciphers accepted>>",
'need_cipher' => "<<check possible in conjunction with +cipher only>>",
'na' => "<<N/A>>",
'na_SSLv2' => "<<N/A as SSLv2 has no server selected cipher>>",
'na_STS' => "<<N/A as STS not set>>",
'na_sni' => "<<N/A as --no-sni in use>>",
'na_dns' => "<<N/A as --no-dns in use>>",
'na_cert' => "<<N/A as --no-cert in use>>",
'na_http' => "<<N/A as --no-http in use>>",
'na_tlsextdebug'=> "<<N/A as --no-tlsextdebug in use>>",
'na_nextprotoneg'=>"<<N/A as --no-nextprotoneg in use>>",
'na_reconnect' => "<<N/A as --no_reconnect in use>>",
'na_openssl' => "<<N/A as --no-openssl in use>>",
'disabled' => "<<N/A as @@ in use>>", # @@ is --no-SSLv2 or --no-SSLv3
'disabled_protocol' => "<<N/A as protocol disabled or NOT YET implemented>>", # @@ is --no-SSLv2 or --no-SSLv3
'disabled_test' => "tests with/for @@ disabled", # not yet used
'miss_cipher' => "<<N/A as no ciphers found>>",
'miss_protocol' => "<<N/A as no protocol found>>",
'miss_RSA' => " <<missing ECDHE-RSA-* cipher>>",
'miss_ECDSA' => " <<missing ECDHE-ECDSA-* cipher>>",
'missing' => " <<missing @@>>",
'enabled_extension' => " <<@@ extension enabled>>",
'unexpected' => " <<unexpected @@>>",
'insecure' => " <<insecure @@>>",
'invalid' => " <<invalid @@>>",
'bit256' => " <<keysize @@ < 256>>",
'bit512' => " <<keysize @@ < 512>>",
'bit2048' => " <<keysize @@ < 2048>>",
'bit4096' => " <<keysize @@ < 4096>>",
'EV_large' => " <<too large @@>>",
'EV_subject_CN' => " <<missmatch: subject CN= and commonName>>",
'EV_subject_host'=>" <<missmatch: subject CN= and given hostname>>",
'no_reneg' => " <<secure renegotiation not supported>>",
'cert_dates' => " <<invalid certificate date>>",
'cert_valid' => " <<certificate validity to large @@>>",
'cert_chars' => " <<invalid charcters in @@>>",
'wildcards' => " <<uses wildcards:@@>>",
'gethost' => " <<gethostbyaddr() failed>>",
'out_target' => "\n==== Target: @@ ====\n",
'out_ciphers' => "\n=== Ciphers: Checking @@ ===",
'out_infos' => "\n=== Information ===",
'out_scoring' => "\n=== Scoring Results EXPERIMENTAL ===",
'out_checks' => "\n=== Performed Checks ===",
'out_list' => "=== List @@ Ciphers ===",
'out_summary' => "=== Ciphers: Summary @@ ===",
# hostname texts
'host_name' => "Given hostname",
'host_IP' => "IP for given hostname",
'host_rhost' => "Reverse resolved hostname",
'host_DNS' => "DNS entries for given hostname",
# misc texts
'cipher' => "Cipher",
'support' => "supported",
'security' => "Security",
'dh_param' => "DH Parameters",
'desc' => "Description",
'desc_check' => "Check Result (yes is considered good)",
'desc_info' => "Value",
'desc_score' => "Score (max value 100)",
'anon_text' => "<<anonymised>>", # SEE Note:anon-out
# texts used for legacy mode; DO NOT CHANGE!
'legacy' => { #----------------+------------------------+---------------------
#header => # not implemented supported unsupported
# #----------------+------------------------+---------------------
'compact' => { 'not' => '-', 'yes' => "yes", 'no' => "no" },
'simple' => { 'not' => '-?-', 'yes' => "yes", 'no' => "no" },
'full' => { 'not' => '-?-', 'yes' => "Yes", 'no' => "No" },
'key' => { 'not' => '-?-', 'yes' => "yes", 'no' => "no" },
'owasp' => { 'not' => '-?-', 'yes' => "", 'no' => "" },
# #----------------+------------------------+---------------------
# following keys are roughly the names of the tool they are used
# #----------------+------------------------+---------------------
'sslaudit' => { 'not' => '-?-', 'yes' => "successfull", 'no' => "unsuccessfull" },
'sslcipher' => { 'not' => '-?-', 'yes' => "ENABLED", 'no' => "DISABLED" },
'ssldiagnos'=> { 'not' => '-?-', 'yes' => "CONNECT_OK CERT_OK", 'no' => "FAILED" },
'sslscan' => { 'not' => '-?-', 'yes' => "Accepted", 'no' => "Rejected" },
'ssltest' => { 'not' => '-?-', 'yes' => "Enabled", 'no' => "Disabled" },
'ssltest-g' => { 'not' => '-?-', 'yes' => "Enabled", 'no' => "Disabled" },
'sslyze' => { 'not' => '-?-', 'yes' => "%s", 'no' => "SSL Alert" },
'testsslserver'=>{'not'=> '-?-', 'yes' => "", 'no' => "" },
'thcsslcheck'=>{ 'not' => '-?-', 'yes' => "supported", 'no' => "unsupported" },
# #----------------+------------------------+---------------------
# -?- means "not implemented"
# all other text used in headers titles, etc. are defined in the
# corresponding print functions:
# print_title, print_cipherhead, print_footer, print_cipherpreferred
# NOTE: all other legacy texts are hardcoded, as there is no need to change them!
},
# SEE Note:hints
'hints' => { # define hints here only if not feasable in OCfg.pm
# will be added to $cfg{hints} in _init_all()
},
'mnemonic' => { # NOT YET USED
'example' => "TLS_DHE_DSS_WITH_3DES-EDE-CBC_SHA",
'description'=> "TLS Version _ key establishment algorithm _ digital signature algorithm _ WITH _ confidentility algorithm _ hash function",
'explain' => "TLS Version1 _ Ephemeral DH key agreement _ DSS which implies DSA _ WITH _ 3DES encryption in CBC mode _ SHA for HMAC"
},
# just for information, some configuration options in Firefox
'firefox' => { # NOT YET USED
'browser.cache.disk_cache_ssl' => "En-/Disable caching of SSL pages", # false
'security.enable_tls_session_tickets' => "En-/Disable Session Ticket extension", # false
'security.ssl.allow_unrestricted_renego_everywhere__temporarily_available_pref' =>"",# false
'security.ssl.renego_unrestricted_hosts' => '??', # list of hosts
'security.ssl.require_safe_negotiation' => "", # true
'security.ssl.treat_unsafe_negotiation_as_broken' => "", # true
'security.ssl.warn_missing_rfc5746' => "", # true
'pfs.datasource.url' => '??', #
'browser.identity.ssl_domain_display' => "coloured non EV-SSL Certificates", # true
},
'IE' => { # NOT YET USED
'HKLM\\...' => "sequence of ciphers", #
},
# for more information about definitions and RFC, see lib/OMan.pm
); # %text
#| read RC-FILE if any
#| -------------------------------------
_trace_info("RCFILE0 - RC-FILE start");
if (_is_ARGV('(?:--rc)')) { # (re-)compute default RC-File with full path
$cfg{'RC-FILE'} = $0; # from directory where $0 found
$cfg{'RC-FILE'} =~ s#($cfg{'me'})$#.$1#;
}
if (defined $ENV{'OSAFT_CONFIG'}) {
_trace_info("CONFIG - OSAFT_CONFIG $ENV{'OSAFT_CONFIG'}");
# INFO printed only if --v given as command line option
if (-e $ENV{'OSAFT_CONFIG'}) {
$cfg{'RC-FILE'} = $ENV{'OSAFT_CONFIG'};
} else {
$cfg{'RC-FILE'} = ""; # don't read default file
OCfg::warn("038: OSAFT_CONFIG '$ENV{'OSAFT_CONFIG'}' does not exist; no RC-FILE read");
}
}
if (_is_ARGV('(?:--rc=)')) { # other RC-FILE given
$cfg{'RC-FILE'} = (grep{/--rc=.*/} @ARGV)[0]; # get value --rc=*
$cfg{'RC-FILE'} =~ s#--rc=##; # strip off --rc=
# no check if file exists, will be done below
}
_tprint("RC-FILE: $cfg{'RC-FILE'}") if _is_trace();
if (not _is_ARGV('(?:--no.?rc)')) { # only if not inhibited
# we do not use a function for following to avoid passing @argv, @rc_argv
OCfg::hint("use --trace to see complete settings") if _is_ARGV('(?:--v(?:=[0-9]+)?)');
if (open(my $rc, '<:encoding(UTF-8)', "$cfg{'RC-FILE'}")) {
push(@{$dbx{'files'}}, $cfg{'RC-FILE'});
_vprint_read("$cfg{'RC-FILE'}", "RC-FILE done");
## no critic qw(ControlStructures::ProhibitMutatingListFunctions)
# NOTE: the purpose here is to *change the source array"
@rc_argv = grep{!/^\s*[#=][^\r\n]*/} <$rc>; # get all but comment lines
@rc_argv = grep{s/[\r\n]//} @rc_argv; # remove newlines
@rc_argv = grep{s/\s*([+,-]-?)/$1/} @rc_argv;# get options and commands, remove leading spaces
## use critic
close($rc);
OCfg::warn("052: option with trailing spaces '$_'") foreach (grep{m/\s+$/} @rc_argv);
push(@argv, @rc_argv); # store arguments
# all commands, options and arguments are process later, nothing is
# interpreted here; see below at #| scan options
# this also means that --rc= cannot be used inside an RC-FILE where
# it needs to be ignored (for example recursive call), no injection
# checks necessary, it's all fine
# OTrace::trace_rcfile(); # function cannot be used here
my @cfgs;
if (_is_trace()) {
_tprint("$cfg{'RC-FILE'}");
_tprint("#------------------------------------------------- RC-FILE {");
}
my @tmp_argv = @rc_argv;
# following foreach seems to modify @rc_argv, reason unknown ...
# hence we use a temporary variable
foreach my $val (@tmp_argv) {
if ($val !~ m/^\s*([+,-]-?)/) {
OCfg::warn("040: invalid argument in RC-FILE '$val'; setting ignored");
@argv = (grep{!/$val/} @argv); # remove from stored arguments
# should be fixed: $val still in @rc_argv, which is stored
# in $cfg{'RC-ARGV'} later
next;
}
$val =~ s/(--cfg[^=]*=[^=]*).*/$1/ if not _is_argv('(?:--trace)');
_tprint(" $val") if _is_trace();
if ($val =~ m/--cfg[^=]*=[^=]*/) {
$val =~ s/--cfg[^=]*=([^=]*).*/+$1/;
push(@cfgs, $val);
}
}
if (_is_trace()) {
_tprint("added/modified= @cfgs");
_tprint("#------------------------------------------------- RC-FILE }");
}
} else {
_vprint_read("$cfg{'RC-FILE'}", "RC-FILE: $!") if _is_trace();
}
}
@{$cfg{'RC-ARGV'}} = @rc_argv;
$cfg{'done'}->{'rc_file'}++ if (0 < $#rc_argv);
_trace_info("RCFILE9 - RC-FILE end");
#| add arguments from environment, then from command-line
#| -------------------------------------
if (defined $ENV{'OSAFT_OPTIONS'}) {
_trace_info("OPTIONS - OSAFT_OPTIONS $ENV{'OSAFT_OPTIONS'}");
# INFO printed only if --v given as command line option
push(@argv, split(" ", $ENV{'OSAFT_OPTIONS'}));
# simply add to @argv, no checks
# because of simple split(), only single words are possible as options
}
push(@argv, @ARGV); # from hereon "grep{/.../} @argv" is used instead of _is_argv()
push(@ARGV, "--no-header") if (grep{/--no-?header/} @argv); # if defined in RC-FILE, needed in OCfg::warn()
@dbx = (grep{/--(?:trace|v$|exitcode.?v$|tests?)/} @argv); # may have --trace=./file
push(@dbx, (grep{/^[+,](?:tests?)/} @argv)); # may have +test*
#| read DEBUG-FILE, if any (source for trace and verbose)
#| -------------------------------------
my $err = "";
if (scalar(@dbx) and not (grep{/--cgi=?/} @argv)) { # SEE Note:CGI mode
$arg = "lib/OTrace.pm";
$arg = $dbx[0] if ($dbx[0] =~ m#/#);
$arg =~ s#[^=]+=##; # --trace=./myfile.pl
$err = _load_file($arg, "trace module");
if ($err ne "") {
die $STR{ERROR}, "012: $err\n" unless (-e $arg);
# no need to continue if file with debug functions does not exist
# NOTE: if $mepath or $0 is a symbolic link, above checks fail
# we don't fix that! Workaround: install file in ./
}
} else {
sub trace {}
sub trace_ {}
sub trace1 {}
sub trace2 {}
sub trace_arg {}
sub trace_args {}
sub trace_init {}
sub trace_exit {}
# debug functions are defined in OTrace.pm and loaded on demand
# they must be defined always as they are used whether requested or not
# NOTE: these comment lines at end of else scope so that some make targets
# can produce better human readable results
}
if (exists $INC{'lib/OTrace.pm'}) {
# module was loaded; it does not auto-export its methods
## no critic qw(TestingAndDebugging::ProhibitNoWarnings)
no warnings 'redefine';
no warnings 'once';
# "... used only once: possible typo ..." appears when OTrace.pm not included
*trace = \&OTrace::trace;
*trace_ = \&OTrace::trace_;
*trace1 = \&OTrace::trace1;
*trace2 = \&OTrace::trace2;
*trace_arg = \&OTrace::arg_show;
*trace_args = \&OTrace::args_show;
*trace_init = \&OTrace::init_show;
*trace_exit = \&OTrace::exit_show;
# $OTrace:: variables; Perl is clever enough to set them here
$OTrace::trace = $cfg{'trace'};
$OTrace::prefix_trace = $cfg{'prefix_trace'};
$OTrace::prefix_verbose = $cfg{'prefix_verbose'};
}
#| read USER-FILE, if any (source with user-specified code)
#| -------------------------------------
if ((grep{/--(?:use?r)/} @argv)) { # must have any --usr option
$err = _load_file("lib/OUsr.pm", "user module");
if ($err ne "") {
# continue without warning, it's already printed in "read ... " line
# OSAFT_STANDALONE no warnings 'redefine'; # avoid: "Subroutine ... redefined"
sub OUsr::version { return ""; };
sub OUsr::pre_init {}; # "
sub OUsr::pre_file {}; # "
sub OUsr::pre_args {}; # "
sub OUsr::pre_exec {}; # "
sub OUsr::pre_cipher {}; # "
sub OUsr::pre_main {}; # "
sub OUsr::pre_host {}; # "
sub OUsr::pre_info {}; # "
sub OUsr::pre_open {}; # "
sub OUsr::pre_cmds {}; # "
sub OUsr::pre_data {}; # "
sub OUsr::pre_print {}; # "
sub OUsr::pre_next {}; # "
sub OUsr::pre_exit {}; # "
# user functions are defined in OUsr.pm and loaded on demand
}
}
OUsr::pre_init();
#| initialise defaults
#| -------------------------------------
my %scores = ( # will be removed in future ...
# keys starting with 'check_' are for total values
# all other keys are for individual score values
#------------------+-------------+----------------------------------------
'check_conn' => {'val' => 100, 'txt' => "SSL connection checks"},
'check_ciph' => {'val' => 100, 'txt' => "Ciphers checks"},
'check_cert' => {'val' => 100, 'txt' => "Certificate checks"},
'check_dest' => {'val' => 100, 'txt' => "Target checks"},
'check_http' => {'val' => 100, 'txt' => "HTTP(S) checks"},
'check_size' => {'val' => 100, 'txt' => "Certificate sizes checks"},
'checks' => {'val' => 100, 'txt' => "Total scoring"},
#------------------+-------------+----------------------------------------
# sorting according key name
); # %scores
my %score_ssllabs = (
# SSL Server Rating Guide:
#------------------+------------+---------------+-------------------------
'check_prot' => {'val' => 0, 'score' => 0.3, 'txt' => "Protocol support"}, # 30%
'check_keyx' => {'val' => 0, 'score' => 0.3, 'txt' => "Key exchange support"}, # 30%
'check_ciph' => {'val' => 0, 'score' => 0.4, 'txt' => "Cipher strength support"}, # 40%
# 'score' is a factor here; 'val' will be the score 0..100
# Letter grade translation
# Grade Numerical Score
#------------------------------------------+------+---------------
'A' => {'val' => 0, 'score' => 80, 'txt' => "A"}, # score >= 80
'B' => {'val' => 0, 'score' => 65, 'txt' => "B"}, # score >= 65
'C' => {'val' => 0, 'score' => 50, 'txt' => "C"}, # score >= 50
'D' => {'val' => 0, 'score' => 35, 'txt' => "D"}, # score >= 35
'E' => {'val' => 0, 'score' => 20, 'txt' => "E"}, # score >= 20
'F' => {'val' => 0, 'score' => 20, 'txt' => "F"}, # score >= 20
# 'val' is not used above!
# Protocol support rating guide
# Protocol Score Protocol
#------------------------------------------+-----+------------------
'SSLv2' => {'val' => 0, 'score' => 20, 'txt' => "SSL 2.0"}, # 20%
'SSLv3' => {'val' => 0, 'score' => 80, 'txt' => "SSL 3.0"}, # 80%
'TLSv1' => {'val' => 0, 'score' => 90, 'txt' => "TLS 1.0"}, # 90%
'TLSv11' => {'val' => 0, 'score' => 95, 'txt' => "TLS 1.1"}, # 95%
'TLSv12' => {'val' => 0, 'score' => 100, 'txt' => "TLS 1.2"}, # 100%
'TLSv13' => {'val' => 0, 'score' => 100, 'txt' => "TLS 1.3"}, # 100%
'DTLSv09' => {'val' => 0, 'score' => 80, 'txt' => "DTLS 0.9"},# 80%
'DTLSv1' => {'val' => 0, 'score' => 100, 'txt' => "DTLS 1.0"},# 100%
'DTLSv11' => {'val' => 0, 'score' => 100, 'txt' => "DTLS 1.1"},# 100%
'DTLSv12' => {'val' => 0, 'score' => 100, 'txt' => "DTLS 1.2"},# 100%
'DTLSv13' => {'val' => 0, 'score' => 100, 'txt' => "DTLS 1.3"},# 100%
# 'txt' is not used here!
#
# ( best protocol + worst protocol ) / 2
# Key exchange rating guide
# Score Key exchange aspect # Score
#------------------------------------------+-----+----------------------------------------------------------+------
'key_debian' => {'val' => 0, 'score' => 0, 'txt' => "Weak key (Debian OpenSSL flaw)"}, # 0%
'key_anonx' => {'val' => 0, 'score' => 0, 'txt' => "Anonymous key exchange (no authentication)"}, # 0%
'key_512' => {'val' => 0, 'score' => 20, 'txt' => "Key length < 512 bits"}, # 20%
'key_export' => {'val' => 0, 'score' => 40, 'txt' => "Exportable key exchange (limited to 512 bits)"}, # 40%
'key_1024' => {'val' => 0, 'score' => 40, 'txt' => "Key length < 1024 bits (e.g., 512)"}, # 40%
'key_2048' => {'val' => 0, 'score' => 80, 'txt' => "Key length < 2048 bits (e.g., 1024)"}, # 80%
'key_4096' => {'val' => 0, 'score' => 90, 'txt' => "Key length < 4096 bits (e.g., 2048)"}, # 90%
'key_good' => {'val' => 0, 'score' => 100, 'txt' => "Key length >= 4096 bits (e.g., 4096)"}, # 100%
#
#
# Cipher strength rating guide
# Score Cipher strength # Score
#------------------------------------------+-----+----------------------------------------+------
'ciph_0' => {'val' => 0, 'score' => 0, 'txt' => "0 bits (no encryption)"}, # 0%
'ciph_128' => {'val' => 0, 'score' => 0, 'txt' => "< 128 bits (e.g., 40, 56)"}, # 20%
'ciph_256' => {'val' => 0, 'score' => 0, 'txt' => "< 256 bits (e.g., 128, 168)"}, # 80%
'ciph_512' => {'val' => 0, 'score' => 0, 'txt' => ">= 256 bits (e.g., 256)"}, # 100%
#
# ( strongest cipher + weakest cipher ) / 2
#
); # %score_ssllabs
my %score_howsmyssl = (
# https://www.howsmyssl.com/
# https://www.howsmyssl.com/s/about.html
'good' => {'txt' => "Good"},
'probably' => {'txt' => "Probably Okay"},
'improvable' => {'txt' => "Improvable"},
# if they do not support ephemeral key cipher suites,
# do not support session tickets, or are using TLS 1.1.
'bad' => {'txt' => "Bad"},
# uses TLS 1.0 (instead of 1.1 or 1.2), or worse: SSLv3 or earlier.
# supports known insecure cipher suites
# supports TLS compression (that is compression of the encryption
# information used to secure your connection) which exposes it
# to the CRIME attack.
# is susceptible to the BEAST attack
); # %score_howsmyssl
my %info_gnutls = ( # NOT YET USED
# extracted from http://www.gnutls.org/manual/gnutls.html
# security parameter ECC key
# bits size size security description
# ----------+-----------+--------+-----------+------------------
'I' => "<72 <1008 <160 INSECURE Considered to be insecure",
'W' => "72 1008 160 WEAK Short term protection against small organizations",
'L' => "80 1248 160 LOW Very short term protection against agencies",
'l' => "96 1776 192 LEGACY Legacy standard level",
'M' => "112 2432 224 NORMAL Medium-term protection",
'H' => "128 3248 256 HIGH Long term protection",
'S' => "256 15424 512 ULTRA Foreseeable future",
); # %info_gnutls
#| construct list for special commands: 'cmd-*'
#| -------------------------------------
# SEE Note:Testing, sort
my $old = "";
my $regex = join("|", @{$cfg{'versions'}}); # these are data only, not commands
foreach my $key (sort {uc($a) cmp uc($b)} keys %data, keys %checks, @{$cfg{'commands_int'}}) {
next if ($key eq $old); # unique
$old = $key;
push(@{$cfg{'commands'}}, $key) if ($key !~ m/^(?:$regex)/);
push(@{$cfg{'cmd-hsts'}}, $key) if ($key =~ m/$cfg{'regex'}->{'cmd-hsts'}/i);
push(@{$cfg{'cmd-http'}}, $key) if ($key =~ m/$cfg{'regex'}->{'cmd-http'}/i);
push(@{$cfg{'cmd-sizes'}}, $key) if ($key =~ m/$cfg{'regex'}->{'cmd-sizes'}/);
push(@{$cfg{'need-checkhttp'}}, $key) if ($key =~ m/$cfg{'regex'}->{'cmd-hsts'}/);
push(@{$cfg{'need-checkhttp'}}, $key) if ($key =~ m/$cfg{'regex'}->{'cmd-http'}/);
}
push(@{$cfg{'cmd-check'}}, $_) foreach (keys %checks);
push(@{$cfg{'cmd-info--v'}}, 'dump'); # more information
foreach my $key (keys %data) {
push(@{$cfg{'cmd-info--v'}}, $key);
next if (_is_cfg_intern($key)); # ignore aliases
next if ($key =~ m/^(ciphers)/); # Client ciphers are less important
next if ($key =~ m/^modulus$/ ); # same values as 'pubkey_value'
push(@{$cfg{'cmd-info'}}, $key);
}
push(@{$cfg{'cmd-info--v'}}, 'info--v');
# SEE Note:Testing, sort
foreach my $key (qw(commands commands_cmd commands_usr commands_int cmd-info--v)) {
# commands_usr need to be handled aftere reading arguments
@{$cfg{$key}} = sort(@{$cfg{$key}}); # only internal use
}
if (_is_ARGV('(?:--no.?rc)')) {
foreach my $key (qw(do cmd-check cmd-info cmd-quick cmd-vulns)) {
@{$cfg{$key}} = sort(@{$cfg{$key}});# may be redefined
}
}
_trace_info("INIT - RC-FILE merged");
$openssl{'external'}= 0 if ($^O =~ m/MSWin32/); # tooooo slow on Windows
#| incorporate some environment variables
#| -------------------------------------
# all OPENSSL* environment variables are checked and assigned in OCfg::_cfg_init
$openssl{'exe'} = $cfg{'openssl_env'} if (defined $cfg{'openssl_env'});
if (defined $ENV{'LIBPATH'}) {
# some systems use LIBPATH instead of or beside LD_LIBRARY_PATH
# print hint if found but not requested by --envlibvar=LIBPATH
OCfg::hint("LIBPATH environment variable found and used, avoid hint by using '--envlibvar=LIBPATH'") if not _is_argv('^--envlibvar');
$openssl{'envlibvar'} = 'LIBPATH';
}
#_init_all(); # call delayed to prevent warning of prototype check with -w
_trace_info("INIT9 - initialisation end");
OUsr::pre_file();
#_____________________________________________________________________________
#_______________________________________________________ internal functions __|
#| definitions: functions to "convert" values
#| -------------------------------------
sub __subst { my ($is,$txt)=@_; $is=~s/@@/$txt/; return $is; }
# return given text with '@@' replaced by given value
sub _get_text { my ($is,$txt)=@_; return __subst($text{$is}, $txt); }
# for given index of %text return text with '@@' replaced by given value
sub _get_yes_no { my $val=shift || ""; return ($val eq "") ? 'yes' : 'no (' . $val . ')'; }
# return 'yes' if given value is empty or undefined, return 'no' otherwise
sub _get_base2 {
# return base-2 of given number
my $value = shift;
$value = 1 if ($value !~ /^[0-9]+$/);# SEE Note:Defensive Programming
return 0 if ($value == 0); # -''-
$value = log($value);
# base-2 = log($value) / log(2)
# unfortunately this calculation results in "inf" for big values
# to avoid using Math::BigInt for big values, the calculation is done as
# follows (approximately):
# log(2) = 0.693147180559945;
# 1/log(2) = 1.44269504088896;
# v * 1.44 = v + (v / 100 * 44);
return ($value + ($value/100*44));
} # _get_base2
sub _hex_like_openssl {
# return full hex constant formatted as used by openssl's output
my $c = shift;
$c =~ s/0x(..)(..)(..)(..)/0x$2,0x$3,0x$4 - /; # 0x0300C029 ==> 0x00,0xC0,0x29
$c =~ s/^0x00,// if ($c ne "0x00,0x00,0x00"); # first byte omitted if 0x00
return sprintf("%22s", $c);
} # _hex_like_openssl
#| definitions: %cfg functions
#| -------------------------------------
sub __need_this {
# returns >0 if any of the given commands is listed in $cfg{'do'}
my $key = shift;
my $is = join("|", @{$cfg{'do'}});
$is =~ s/\+/\\+/g; # we have commands with +, needs to be escaped
return grep{/^($is)$/} @{$cfg{$key}};
} # __need_this
sub _need_netinfo {
# returns >0 if $cfg{'do'} contains commands other than cipher*
# compares with $cfg{'need-cipher'}
my $need_cipher = join("|", @{$cfg{'need-cipher'}});
return grep{not /^(?:$need_cipher)$/} @{$cfg{'do'}};
} # _need_netinfo
sub _need_openssl { return _need_netinfo() + _is_cfg_ciphermode('openssl'); }
# returns >0 if $cfg{'do'} contains commands other than cipher* or --ciphermode=openssl
sub _need_cipher { return __need_this('need-cipher'); }
sub _need_default { return __need_this('need-default'); }
sub _need_checkssl { return __need_this('need-checkssl'); }
sub _need_checkalpn { return __need_this('need-checkalpn'); }
sub _need_checkbleed {return __need_this('need-checkbleed');}
sub _need_checkchr { return __need_this('need-checkchr'); }
sub _need_checkdest { return __need_this('need-checkdest'); }
sub _need_check_dh { return __need_this('need-check_dh'); }
sub _need_checkhttp { return __need_this('need-checkhttp'); }
sub _need_checkprot { return __need_this('need-checkprot'); }
# returns >0 if any of the given commands is listed in $cfg{need-*}
sub _is_do_cmdvulns { return __need_this('cmd-vulns'); }
# returns >0 if any of the given commands is listed in $cfg{cmd-vulns}
sub _is_hashkey { my ($is,$ref)=@_; return grep({lc($is) eq lc($_)} keys %{$ref}); }
sub _is_member { my ($is,$ref)=@_; return grep({lc($is) eq lc($_)} @{$ref}); }
# returns list of entries matching $is in specified array @cfg{*}
sub _is_cfg_do { my $is=shift; return _is_member($is, \@{$cfg{'do'}}); }
sub _is_cfg_intern { my $is=shift; return _is_member($is, \@{$cfg{'commands_int'}}); }
sub _is_cfg_hexdata { my $is=shift; return _is_member($is, \@{$cfg{'data_hex'}}); }
sub _is_cfg_call { my $is=shift; return _is_member($is, \@{$openssl{'call'}}); }
# returns >0 if the given string $is is listed in $cfg{*}
sub _is_cfg { my $is=shift; return $cfg{$is}; }
sub _is_cfg_ssl { my $is=shift; return $cfg{$is}; }
# returns >0 if specified key $is (protocol like SSLv3) is set $cfg{*}
sub _is_cfg_out { my $is=shift; return $cfg{'out'}->{$is}; }
sub _is_cfg_tty { my $is=shift; return $cfg{'tty'}->{$is}; }
sub _is_cfg_use { my $is=shift; return $cfg{'use'}->{$is}; }
# returns value for given key $is in $cfg{*}->{key}; which is 0 or 1 (usually)
sub _is_cfg_trace { return $cfg{'trace'}; }
sub _is_cfg_verbose { return $cfg{'verbose'}; }
sub _is_cfg_ciphermode { my $is=shift; return ($cfg{'ciphermode'} =~ $is); }
# returns >0 if the given string $is matches $cfg{ciphermode}; string can be RegEx
sub _is_cfg_legacy { my $is=shift; return ($cfg{'legacy'} =~ $is); }
# returns >0 if the given string $is matches $cfg{legacy}; string can be RegEx
sub _set_cfg_out { my ($is,$val)=@_; $cfg{'out'}->{$is} = $val; return; }
sub _set_cfg_tty { my ($is,$val)=@_; $cfg{'tty'}->{$is} = $val; return; }
sub _set_cfg_use { my ($is,$val)=@_; $cfg{'use'}->{$is} = $val; return; }
# set value for given key in $cfg{*}->{key}
sub _set_cfg_list { my ($is,$val)=@_;
# SEE Note:ALPN, NPN
# --protos* is special to simulate empty and undefined arrays
# --protosnpn=value - add value to array
# --protosnpn=, - set empty array
# --protosnpn=,, - set array element to ""
# applies also to --ciphercurves= --cipheralpns= --ciphernpns= --protosalpn=
# NOTE: distinguish: [], [""], [" "]
$cfg{$is} = [""] if ($val =~ /^[,:][,:]$/);# special to set empty string
if ($val =~ /^[,:]$/) {