Skip to content

Commit b2f2397

Browse files
EnDeEnDe
committed
ED: formal changes
1 parent 5ec2e50 commit b2f2397

File tree

1 file changed

+146
-115
lines changed

1 file changed

+146
-115
lines changed

‎o-saft.pl

+146-115
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,7 @@
7171
use warnings;
7272
use utf8;
7373

74-
our $SID_main = "@(#) o-saft.pl 3.201 25/03/14 15:52:07"; # version of this file
74+
our $SID_main = "@(#) o-saft.pl 3.203 25/03/19 00:01:38"; # version of this file
7575
my $VERSION = _VERSION(); ## no critic qw(ValuesAndExpressions::RequireConstantVersion)
7676
# SEE Perl:constant
7777
# see _VERSION() below for our official version number
@@ -389,7 +389,7 @@ sub _load_file {
389389
); # %openssl
390390

391391
$cfg{'time0'} = $time0;
392-
OCfg::set_user_agent("$cfg{'me'}/3.201"); # use version of this file not $VERSION
392+
OCfg::set_user_agent("$cfg{'me'}/3.203"); # use version of this file not $VERSION
393393
OCfg::set_user_agent("$cfg{'me'}/$STR{'MAKEVAL'}") if (defined $ENV{'OSAFT_MAKE'});
394394
# TODO: $STR{'MAKEVAL'} is wrong if not called by internal make targets
395395

@@ -2816,6 +2816,72 @@ sub _get_target {
28162816
return ($prot, $host, $port, $auth, $path);
28172817
} # _get_target
28182818

2819+
sub _get_dns {
2820+
#? return IP and DNS related data; empty list if target is invalid
2821+
# gethostbyname() and gethostbyaddr() set $? on error, needs to be reset!
2822+
my $host = shift;
2823+
my $fail = "";
2824+
my $rhost = "";
2825+
my $dns = "";
2826+
my $myIP = "";
2827+
my $myip = "";
2828+
trace("_get_dns($host){");
2829+
if ("" ne $cfg{'proxyhost'}) {
2830+
# if a proxy is used, DNS might not work at all, or be done by the
2831+
# proxy (which even may return other results than the local client)
2832+
# so we set corresponding values to a warning
2833+
$fail = _get_text('disabled', "--proxyhost=$cfg{'proxyhost'}");
2834+
$rhost = $fail;
2835+
$dns = $fail;
2836+
$myIP = $fail;
2837+
$myip = $fail;
2838+
} else {
2839+
$fail = '<<gethostbyaddr() failed>>';
2840+
$myip = gethostbyname($host); # primary IP as identified by given hostname
2841+
if (not defined $myip) {
2842+
OCfg::warn("201: Can't get IP for host '$host'; host ignored");
2843+
trace(" host}");
2844+
return undef; # failed, must be handled by caller
2845+
}
2846+
# gethostbyaddr() is strange: returns $?==0 but an error message in $!
2847+
# hence just checking $? is not reliable, we do it additionally.
2848+
# If gethostbyaddr() fails we use Perl's `or' to assign our default
2849+
# text. This may happen when there are problems with the local name
2850+
# resolution.
2851+
# When gethostbyaddr() fails, the connection to the target most likely
2852+
# fails also, which produces more Perl warnings later.
2853+
# Using "C4" (8-bit unsigned char) which should be ok for IPs an works
2854+
# in ancient Perl too, which does not support "W4".
2855+
_vprint(" test IP");
2856+
$myIP = join(".", unpack("C4", $myip));
2857+
if (_is_cfg_use('dns')) { # following settings only with --dns
2858+
trace(" test DNS (disable with --no-dns)");
2859+
_trace_time("test DNS{");
2860+
local $? = 0; local $! = undef;
2861+
($rhost = gethostbyaddr($myip, AF_INET)) or $rhost = $fail;
2862+
$rhost = $fail if ($? != 0);
2863+
my ($fqdn, $aliases, $addrtype, $length, @ips) = gethostbyname($host);
2864+
my $i = 0;
2865+
#dbx printf "@ips = %s\n", join(" - ", @ips);
2866+
foreach my $ip (@ips) {
2867+
local $? = 0; local $! = undef;
2868+
# TODO: $rhost = gethostbyaddr($ipv6, AF_INET6));
2869+
($rhost = gethostbyaddr($ip, AF_INET)) or $rhost = $fail;
2870+
$rhost = $fail if ($? != 0);
2871+
$dns .= join(".", unpack("C4", $myip)) . " " . $rhost . "; ";
2872+
#dbx printf "[%s] = %s\t%s\n", $i, join(".",unpack("C4",$ip)), $rhost;
2873+
}
2874+
if ($rhost =~ m/gethostbyaddr/) {
2875+
OCfg::warn("202: Can't do DNS reverse lookup: for '$host': $fail; ignored");
2876+
OCfg::hint("202: use '--no-dns' to disable this check");
2877+
}
2878+
_trace_time("test DNS}");
2879+
}
2880+
}
2881+
trace("_get_dns()\t= [rhost=$rhost, dns=$dns, IP=$myIP, ..] }");
2882+
return ($rhost, $dns, $myIP, $myip);
2883+
} # _get_dns
2884+
28192885
sub _get_data0 {
28202886
#? get %data for connection without SNI
28212887
# this function currently only returns data for: cn_nosni, session_ticket
@@ -3127,7 +3193,7 @@ sub ciphers_scan_openssl {
31273193
my $results = {}; # hash of cipher list to be returned
31283194
foreach my $ssl (@{$cfg{'version'}}) {
31293195
my $usesni = $cfg{'use'}->{'sni'};
3130-
_vprint(" test $cnt ciphers for $ssl ... ($cfg{'ciphermode'}) ");
3196+
_vprint(" test $cnt ciphers for $ssl ... ($cfg{'ciphermode'}) ");
31313197
trace( " test $cnt ciphers for $ssl ... ($cfg{'ciphermode'}) ");
31323198
trace( " using cipherpattern=[ @{$cfg{'cipher'}} ], cipherrange=$cfg{'cipherrange'}");
31333199
if ($ssl =~ m/^SSLv[23]/) {
@@ -3210,7 +3276,7 @@ sub ciphers_scan_intern {
32103276
my $accepted_cnt = 0;
32113277
my @all = _get_cipherslist('keys', $ssl);
32123278
$total += scalar(@all);
3213-
_vprint(" test " . scalar(@all) . " ciphers for $ssl ... (SSLhello)");
3279+
_vprint(" test " . scalar(@all) . " ciphers for $ssl ... (SSLhello)");
32143280
trace( " test " . scalar(@all) . " ciphers for $ssl ... (SSLhello)");
32153281
trace( " using cipherpattern=[ @{$cfg{'cipher'}} ], cipherrange=$cfg{'cipherrange'}");
32163282
if ("@all" =~ /^\s*$/) {
@@ -3268,6 +3334,50 @@ sub ciphers_scan_intern {
32683334
return $results;
32693335
} # ciphers_scan_intern
32703336

3337+
sub ciphers_scan {
3338+
#? scan target for ciphers for all protocols; modifies %checks, %prot
3339+
# wrapper for ciphers_scan_intern() and ciphers_scan_openssl()
3340+
# returns array with accepted ciphers
3341+
my ($host, $port) = @_;
3342+
trace("ciphers_scan($host, $port) {");
3343+
my $results = {}; # array of arrays
3344+
OCfg::warn("209: No SSL versions for '+cipher' available") if ($#{$cfg{'version'}} < 0);
3345+
# above warning is most likely a programming error herein
3346+
if ('openssl' eq $cfg{'cipherrange'}) {
3347+
# get ciphers from openssl for any --ciphermode=
3348+
# TODO: see CIPHER_RANGE also
3349+
require SSLinfo; # FIXME: dirty hack until we have lib/SSLtool.pm
3350+
$SSLinfo::openssl = $openssl{'exe'};
3351+
@{$cfg{'cipher'}} = map({Ciphers::get_key($_)||"";} SSLinfo::cipher_openssl("@{$cfg{'cipher'}}"));
3352+
trace(" openssl ciphers: " . scalar @{$cfg{'cipher'}});
3353+
}
3354+
_vprint(" test protocols @{$cfg{'version'}} ...");
3355+
if (_is_cfg_ciphermode('intern|dump')) {
3356+
trace(" use SSLhello ...");
3357+
SSLhello::printParameters() if ($cfg{'trace'} > 1);
3358+
$results = ciphers_scan_intern($host, $port);
3359+
}
3360+
if (_is_cfg_ciphermode('openssl|socket')) {
3361+
trace(" use $cfg{'ciphermode'} ...");
3362+
# FIXME: on tiny systems following may cause "Out of memory!"
3363+
$results = ciphers_scan_openssl($host, $port); # uses @{$cfg{'ciphers'}}
3364+
# TODO: $prot{$ssl}->{'default'} = $cipher;
3365+
# SEE Note:+cipher-selected
3366+
trace(" get default ...");
3367+
_trace_time("need_default{");
3368+
ciphers_default_openssl($host, $port);
3369+
_trace_time("need_default}");
3370+
}
3371+
foreach my $ssl (@{$cfg{'version'}}) { # all requested protocol versions
3372+
$checks{'cnt_ciphers'}->{val} += $results->{'_admin'}{$ssl}{'cnt_offered'};
3373+
$checks{'cnt_totals'} ->{val} += $results->{'_admin'}{$ssl}{'cnt_accepted'};
3374+
}
3375+
#dbx# print Dumper(\$results);
3376+
checkciphers($host, $port, $results);
3377+
trace("ciphers_scan() }"); # no trace($results) as already done by ciphers_scan_*()
3378+
return $results;
3379+
} # ciphers_scan
3380+
32713381
#_____________________________________________________________________________
32723382
#__________________________________________________________ check functions __|
32733383

@@ -5410,7 +5520,7 @@ sub print_footer {
54105520
} # print_footer
54115521

54125522
sub print_title {
5413-
#? print title according given legacy format
5523+
#? print title according given legacy format; uses $cfg{'IP'}
54145524
my ($legacy, $ssl, $host, $port, $header) = @_;
54155525
if ($legacy eq 'sslyze') {
54165526
my $txt = " SCAN RESULTS FOR " . $host . " - " . $cfg{'IP'};
@@ -6129,6 +6239,24 @@ sub printchecks {
61296239
return;
61306240
} # printchecks
61316241

6242+
sub printdns {
6243+
#? print DNS-related information for target
6244+
my ($legacy, $host, $port) = @_;
6245+
_vprint(" print DNS stuff");
6246+
trace(" +info || +check || +sni*");
6247+
if ($legacy =~ /(compact|full|owasp|simple)/) {
6248+
print_ruler();
6249+
print_line($legacy, $host, $port, 'host_name', $text{'host_name'}, $host);
6250+
print_line($legacy, $host, $port, 'host_IP', $text{'host_IP'}, $cfg{'IP'});
6251+
if (_is_cfg_use('dns')) {
6252+
print_line($legacy, $host, $port, 'host_rhost', $text{'host_rhost'}, $cfg{'rhost'});
6253+
print_line($legacy, $host, $port, 'host_DNS', $text{'host_DNS'}, $cfg{'DNS'});
6254+
}
6255+
print_ruler();
6256+
}
6257+
return;
6258+
} # printdns
6259+
61326260
#| definitions: print functions for help and information
61336261
#| -------------------------------------
61346262

@@ -6205,7 +6333,7 @@ sub printversion {
62056333
my $me = $cfg{'me'};
62066334
print( "= $0 " . _VERSION() . " =");
62076335
if (not _is_cfg_verbose()) {
6208-
printf(" %-21s%s\n", $me, "3.201");# just version to keep make targets happy
6336+
printf(" %-21s%s\n", $me, "3.203");# just version to keep make targets happy
62096337
} else {
62106338
printf(" %-21s%s\n", $me, $SID_main); # own unique SID
62116339
# print internal SID of our own modules
@@ -7519,7 +7647,7 @@ sub printusage_exit {
75197647
OMan::man_printhelp($help);
75207648
exit 0;
75217649
}
7522-
if (0 == scalar(@{$cfg{'do'}}) and $cfg{'opt-V'}) { print "3.201"; exit 0; }
7650+
if (0 == scalar(@{$cfg{'do'}}) and $cfg{'opt-V'}) { print "3.203"; exit 0; }
75237651
# NOTE: printciphers_list() is a wrapper for Ciphers::show() regarding more options
75247652
if (_is_cfg_do('list')) { _vprint(" list "); printciphers_list('list'); exit 0; }
75257653
if (_is_cfg_do('ciphers')) { _vprint(" ciphers "); printciphers_list('ciphers'); exit 0; }
@@ -7992,82 +8120,16 @@ sub printusage_exit {
79928120
$SSLinfo::target_url =~ s:^\s*$:/:; # set to / if empty
79938121
_resetchecks();
79948122
print_header(_get_text('out_target', "$host:$port"), "", "", $cfg{'out'}->{'header'});
7995-
next if _trace_next(" DNS0 - start");
79968123

7997-
# gethostbyname() and gethostbyaddr() set $? on error, needs to be reset!
7998-
my $rhost = "";
7999-
$fail = ""; # reusing variable
8000-
if ("" ne $cfg{'proxyhost'}) {
8001-
# if a proxy is used, DNS might not work at all, or be done by the
8002-
# proxy (which even may return other results than the local client)
8003-
# so we set corresponding values to a warning
8004-
$fail = _get_text('disabled', "--proxyhost=$cfg{'proxyhost'}");
8005-
$cfg{'rhost'} = $fail;
8006-
$cfg{'DNS'} = $fail;
8007-
$cfg{'IP'} = $fail;
8008-
$cfg{'ip'} = $fail;
8009-
} else {
8010-
$fail = '<<gethostbyaddr() failed>>';
8011-
$cfg{'ip'} = gethostbyname($host); # primary IP as identified by given hostname
8012-
if (not defined $cfg{'ip'}) {
8013-
OCfg::warn("201: Can't get IP for host '$host'; host ignored");
8014-
trace(" host}");
8015-
next; # otherwise all following fails
8016-
}
8017-
# gethostbyaddr() is strange: returns $?==0 but an error message in $!
8018-
# hence just checking $? is not reliable, we do it additionally.
8019-
# If gethostbyaddr() fails we use Perl's `or' to assign our default
8020-
# text. This may happen when there are problems with the local name
8021-
# resolution.
8022-
# When gethostbyaddr() fails, the connection to the target most likely
8023-
# fails also, which produces more Perl warnings later.
8024-
# Using "C4" (8-bit unsigned char) which should be ok for IPs an works
8025-
# in ancient Perl too, which does not support "W4".
8026-
_vprint(" test IP");
8027-
$cfg{'IP'} = join(".", unpack("C4", $cfg{'ip'}));
8028-
if (_is_cfg_use('dns')) { # following settings only with --dns
8029-
trace(" test DNS (disable with --no-dns)");
8030-
_trace_time("test DNS{");
8031-
local $? = 0; local $! = undef;
8032-
($cfg{'rhost'} = gethostbyaddr($cfg{'ip'}, AF_INET)) or $cfg{'rhost'} = $fail;
8033-
$cfg{'rhost'} = $fail if ($? != 0);
8034-
my ($fqdn, $aliases, $addrtype, $length, @ips) = gethostbyname($host);
8035-
my $i = 0;
8036-
#dbx printf "@ips = %s\n", join(" - ", @ips);
8037-
foreach my $ip (@ips) {
8038-
local $? = 0; local $! = undef;
8039-
# TODO: $rhost = gethostbyaddr($ipv6, AF_INET6));
8040-
($rhost = gethostbyaddr($ip, AF_INET)) or $rhost = $fail;
8041-
$rhost = $fail if ($? != 0);
8042-
$cfg{'DNS'} .= join(".", unpack("C4", $cfg{'ip'})) . " " . $rhost . "; ";
8043-
#dbx printf "[%s] = %s\t%s\n", $i, join(".",unpack("C4",$ip)), $rhost;
8044-
}
8045-
if ($cfg{'rhost'} =~ m/gethostbyaddr/) {
8046-
OCfg::warn("202: Can't do DNS reverse lookup: for '$host': $fail; ignored");
8047-
OCfg::hint("202: use '--no-dns' to disable this check");
8048-
}
8049-
_trace_time("test DNS}");
8050-
}
8051-
}
8124+
next if _trace_next(" DNS0 - start");
8125+
($cfg{'rhost'}, $cfg{'DNS'}, $cfg{'IP'}, $cfg{'ip'}) = _get_dns($host);
8126+
next if not defined $cfg{'rhost'}; # otherwise all following fails
80528127
if (_is_cfg_do('host') or (($info + $check + $cmdsni) > 0)) {
8053-
_vprint(" print DNS stuff");
8054-
trace(" +info || +check || +sni*");
8055-
if ($legacy =~ /(compact|full|owasp|simple)/) {
8056-
print_ruler();
8057-
print_line($legacy, $host, $port, 'host_name', $text{'host_name'}, $host);
8058-
print_line($legacy, $host, $port, 'host_IP', $text{'host_IP'}, $cfg{'IP'});
8059-
if (_is_cfg_use('dns')) {
8060-
print_line($legacy, $host, $port, 'host_rhost', $text{'host_rhost'}, $cfg{'rhost'});
8061-
print_line($legacy, $host, $port, 'host_DNS', $text{'host_DNS'}, $cfg{'DNS'});
8062-
}
8063-
print_ruler();
8064-
}
8128+
printdns($legacy, $host, $port);
80658129
}
8066-
80678130
next if _trace_next(" DNS9 - end");
80688131

80698132
if (_is_cfg_do('cipher_dh')) {
8070-
# abort here is ok because +cipher-dh cannot be combined with other commands
80718133
if (not _is_cfg_ciphermode('intern')) {
80728134
OCfg::warn("405: option '--ciphermode=', not supported for '+cipher-dh'; reset to --ciphermode=intern");
80738135
$cfg{'ciphermode'} = "intern";
@@ -8080,42 +8142,9 @@ sub printusage_exit {
80808142

80818143
next if _trace_next(" CIPHER0 - start (ciphermode=$cfg{'ciphermode'})");
80828144
if (_need_cipher()) {
8083-
OCfg::warn("209: No SSL versions for '+cipher' available") if ($#{$cfg{'version'}} < 0);
8084-
# above warning is most likely a programming error herein
8085-
if ('openssl' eq $cfg{'cipherrange'}) {
8086-
# get ciphers from openssl for any --ciphermode=
8087-
# TODO: see CIPHER_RANGE also
8088-
require SSLinfo; # FIXME: dirty hack until we have lib/SSLtool.pm
8089-
$SSLinfo::openssl = $openssl{'exe'};
8090-
@{$cfg{'cipher'}} = map({Ciphers::get_key($_)||"";} SSLinfo::cipher_openssl("@{$cfg{'cipher'}}"));
8091-
trace(" openssl ciphers: " . scalar @{$cfg{'cipher'}});
8092-
}
8093-
$cipher_results = {}; # new list for every host (array of arrays)
8094-
_vprint(" test protocols @{$cfg{'version'}} ...");
8095-
if (_is_cfg_ciphermode('intern|dump')) {
8096-
trace(" use SSLhello ...");
8097-
SSLhello::printParameters() if ($cfg{'trace'} > 1);
8098-
$cipher_results = ciphers_scan_intern($host, $port);
8099-
}
8100-
if (_is_cfg_ciphermode('openssl|socket')) {
8101-
trace(" use $cfg{'ciphermode'} ...");
8102-
# FIXME: on tiny systems following may cause "Out of memory!"
8103-
$cipher_results = ciphers_scan_openssl($host, $port); # uses @{$cfg{'ciphers'}}
8104-
# TODO: $prot{$ssl}->{'default'} = $cipher;
8105-
# SEE Note:+cipher-selected
8106-
trace(" get default ...");
8107-
_trace_time("need_default{");
8108-
ciphers_default_openssl($host, $port);
8109-
_trace_time("need_default}");
8110-
}
8111-
foreach my $ssl (@{$cfg{'version'}}) { # all requested protocol versions
8112-
$checks{'cnt_ciphers'}->{val} += $cipher_results->{'_admin'}{$ssl}{'cnt_offered'};
8113-
$checks{'cnt_totals'} ->{val} += $cipher_results->{'_admin'}{$ssl}{'cnt_accepted'};
8114-
}
8115-
#dbx# print Dumper(\$cipher_results);
8116-
checkciphers($host, $port, $cipher_results);
8117-
} # need_cipher
8118-
next if _trace_next(" SCAN - done");
8145+
$cipher_results = ciphers_scan($host, $port);
8146+
}
8147+
next if _trace_next(" SCAN - done"); # dirty logic outside if-condition to ensure it's always checked
81198148

81208149
if (_is_cfg_do('cipher_dh')) {
81218150
_vprint(" +cipher-dh");
@@ -8140,11 +8169,13 @@ sub printusage_exit {
81408169
# in printprotocols() anyway
81418170
printcipherpreferred($legacy, $host, $port);
81428171
}
8172+
next if _trace_next(" CIPHER9 - end");
81438173
goto CLOSE_SSL if (_is_cfg_do('cipher') and (0 == $quick)); # next HOSTS
81448174
} # need_cipher
8145-
next if _trace_next(" CIPHER9 - end");
8175+
next if _trace_next(" CIPHER9 - end"); # dirty logic outside if-condition to ensure it's always checked
81468176

8147-
# Quick check if the target is available; any command except +cipher*
8177+
# from here on all other commands than +cipher*
8178+
# Quick check if the target is available
81488179
next if _trace_next(" CONN0 - start"); # SEE Note:Connection Test
81498180
my $connect_ssl = 1;
81508181
trace(" sni_name= " . ($cfg{'sni_name'} || $STR{UNDEF}));

0 commit comments

Comments
 (0)