Merge pull request #3131 from testssl/perl_quality

Add Perl static analysis
This commit is contained in:
Dirk Wetter
2026-09-01 20:02:32 +02:00
committed by GitHub
17 changed files with 76 additions and 13 deletions
+3 -2
View File
@@ -3,6 +3,7 @@
# Basics: is there a syntax error where already bash hiccups on?
use strict;
use warnings;
use Test::More;
use File::stat;
@@ -25,11 +26,11 @@ my $info = stat($prg);
my $retMode = $info->mode;
#1
is($retMode & 0400, 0400, "Checking \"./testssl.sh\" for read permission");
is($retMode & oct("400"), oct("0400"), "Checking \"./testssl.sh\" for read permission");
$tests++;
#2
is($retMode & 0100, 0100, "Checking \"./testssl.sh\" for execute permission");
is($retMode & oct("0100"), oct("0100"), "Checking \"./testssl.sh\" for execute permission");
$tests++;
$fileout = `bash $prg 2>&1`;
+1
View File
@@ -4,6 +4,7 @@
# --banner is equal to --version
use strict;
use warnings;
use Test::More;
my $tests = 0;
+1
View File
@@ -4,6 +4,7 @@
# doesn't have any syntax errors
use strict;
use warnings;
use Test::More;
my $tests = 0;
+6 -5
View File
@@ -3,11 +3,12 @@
# Basics: are there semantic errors which are easy to spot?
use strict;
use warnings;
use Test::More;
my $tests = 0;
my $prg="testssl.sh";
my $os="$^O";
my $prg = "testssl.sh";
my $os = "$^O";
if ( $os eq "darwin" ){
plan skip_all => 'No checks on MacOS';
@@ -27,7 +28,7 @@ $tests++;
#2
printf "\n%s\n", "Testing for backticks ...";
my @matches = qx(grep -nP '`[^`]*`' $prg);
@matches = qx(grep -nP '`[^`]*`' $prg);
is(scalar(@matches), 0, "Checking bad backtick patterns")
or diag(@matches);
$tests++;
@@ -35,7 +36,7 @@ $tests++;
#3
printf "\n%s\n", "Sourcing without checking the file exists #1 ...";
my @matches = qx(grep -nP '^\s*\.\s+\$' $prg);
@matches = qx(grep -nP '^\\s*\\.\\s+\$' $prg);
is(scalar(@matches), 0, "Checking bad sourcing pattern #1")
or diag(@matches);
$tests++;
@@ -43,7 +44,7 @@ $tests++;
#4
printf "\n%s\n", "Sourcing without checking the file exists #2 ...";
my @matches = qx(grep -nP '^\s*source\s+\$' $prg);
@matches = qx(grep -nP '^\\s*source\\s+\$' $prg);
is(scalar(@matches), 0, "Checking bad sourcing pattern #2")
or diag(@matches);
$tests++;
+1
View File
@@ -1,6 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
printf "\n%s\n", "Make sure CA certificate stores are older than their SPKI hashes \"~/etc/ca_hashes.txt\" ...";
+2 -1
View File
@@ -7,6 +7,7 @@
# "finding" : "Scan interrupted"
use strict;
use warnings;
use Test::More;
use Data::Dumper;
use JSON;
@@ -98,7 +99,7 @@ done_testing($tests);
printf "\n\n";
sub json($) {
sub json {
my $file = shift;
$file = `cat $file`;
unlink $file;
+1
View File
@@ -5,6 +5,7 @@
# This runs a basic test with the supplied openssl vs /usr/bin/openssl
use strict;
use warnings;
use Test::More;
use Data::Dumper;
use Text::Diff;
+2 -1
View File
@@ -10,6 +10,7 @@
# - Hosts which match the regex patterns should be avoided
use strict;
use warnings;
use Test::More;
use Data::Dumper;
# use JSON;
@@ -150,7 +151,7 @@ if ( $os ne "darwin" ){
done_testing($tests);
# unlink "tmp.json";
sub json($) {
sub json {
my $file = shift;
$file = `cat $file`;
unlink $file;
+2 -1
View File
@@ -7,6 +7,7 @@
# "finding" : "Scan interrupted"
use strict;
use warnings;
use Test::More;
use Data::Dumper;
# if needed: comment this and the lines below in:
@@ -64,7 +65,7 @@ done_testing($tests);
printf "\n";
sub json($) {
sub json {
my $file = shift;
$file = `cat $file`;
unlink $file;
+2 -1
View File
@@ -4,6 +4,7 @@
#
use strict;
use warnings;
use Test::More;
use JSON;
@@ -94,7 +95,7 @@ if ( $os eq "linux" ){
done_testing($tests);
printf "\n\n";
sub json($) {
sub json {
my $file = shift;
$file = `cat $file`;
unlink $file;
+1
View File
@@ -4,6 +4,7 @@
# This could be amended by using HTML::Tidy or HTML::Valid
use strict;
use warnings;
use Test::More;
use Data::Dumper;
use Text::Diff;
+2 -1
View File
@@ -1,6 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Data::Dumper;
use JSON;
@@ -66,7 +67,7 @@ is($found,0,"We should not have any finding with INFO level"); $tests++;
done_testing($tests);
printf "\n\n";
sub json($) {
sub json {
my $file = shift;
$file = `cat $file`;
unlink $file;
+2 -1
View File
@@ -1,6 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Data::Dumper;
use JSON;
@@ -154,7 +155,7 @@ is($found,1,"We should have a finding for this in the JSON output"); $tests++;
done_testing($tests);
sub json($) {
sub json {
my $file = shift;
$file = `cat $file`;
unlink $file;
+1
View File
@@ -7,6 +7,7 @@
# We don't use a full run, only the certificate section.
use strict;
use warnings;
use Test::More;
use Data::Dumper;
use Text::Diff;
+1
View File
@@ -6,6 +6,7 @@
# We don't use a full run, only the HTTP header section.
use strict;
use warnings;
use Test::More;
my $tests = 0;
+1
View File
@@ -9,6 +9,7 @@
#
use strict;
use warnings;
use Test::More;
use Data::Dumper;
use Text::Diff;