mirror of
https://github.com/drwetter/testssl.sh.git
synced 2026-09-14 05:38:16 +02:00
Merge pull request #3131 from testssl/perl_quality
Add Perl static analysis
This commit is contained in:
@@ -0,0 +1,47 @@
|
||||
name: Perl quality
|
||||
|
||||
on:
|
||||
pull_request:
|
||||
paths:
|
||||
- 't/**'
|
||||
- 'cpanfile'
|
||||
- '.perlcritic'
|
||||
- '.github/workflows/perl-quality.yml'
|
||||
|
||||
permissions:
|
||||
contents: read
|
||||
|
||||
jobs:
|
||||
perl:
|
||||
runs-on: ubuntu-24.04
|
||||
timeout-minutes: 10
|
||||
steps:
|
||||
- uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1
|
||||
- uses: shogo82148/actions-setup-perl@v1.43.1
|
||||
with:
|
||||
perl-version: '5.38'
|
||||
|
||||
- name: Install dev modules
|
||||
run: cpanm --notest Perl::Critic Perl::Tidy CPAN::Audit
|
||||
- name: Install dev modules
|
||||
# add all perl modules from other modules tool, otherwise the next run fails
|
||||
run: cpanm --notest Data::Dumper IPC::Run3 JSON Test::More Text::Diff
|
||||
|
||||
- name: 'Syntax check #1 w Perl::Tidy'
|
||||
run: |
|
||||
perltidy -se t/*.t
|
||||
#TODO: we should as well reformat with the t(i)dy files generated
|
||||
|
||||
- name: Syntax check all test files with perl itself
|
||||
run: |
|
||||
find t -name '*.t' -o -name '*.pm' | while read -r f; do
|
||||
perl -I t/lib -c "$f"
|
||||
done
|
||||
|
||||
- name: Use Perl::Critic for best practises
|
||||
run: perlcritic -4 t/*.t
|
||||
|
||||
- name: Audit CPAN modules for known CVEs
|
||||
run: cpan-audit installed --exit-zero
|
||||
# logic is: in the container all should be fine. There are doubts though about deliberately unfixed ones
|
||||
|
||||
+3
-2
@@ -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`;
|
||||
|
||||
@@ -4,6 +4,7 @@
|
||||
# --banner is equal to --version
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More;
|
||||
|
||||
my $tests = 0;
|
||||
|
||||
@@ -4,6 +4,7 @@
|
||||
# doesn't have any syntax errors
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More;
|
||||
|
||||
my $tests = 0;
|
||||
|
||||
+6
-5
@@ -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,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\" ...";
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -9,6 +9,7 @@
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More;
|
||||
use Data::Dumper;
|
||||
use Text::Diff;
|
||||
|
||||
Reference in New Issue
Block a user