Checking if file name exists (#53)

* return feature to remove blank lines and comments * add samples to perform tests * pushing some tools to help during debug tasks * skip false positives - draft function * improve taint analysis function * drafting new rules * update sarif output with new variables * apply design pattern practices to a better code compreension * remove Data::Dumper * fixed sarif * remove unecessary variables * remove old file * remove samples * create some unit tests * update rules on linter * resolv linter warnings * resolv linter warnings * new module * remove tools/ * tdy * update perltidyrc * new line * deleted tests/Sarif.t * remove blank lines * checking if the name of file that does exists --------- Co-authored-by: Heitor <htrgouvea@Heitors-iMac.local>
htrgouvea · Oct 10, 2024 · 5ec7323 · 5ec7323
1 parent 753d2ae
commit 5ec7323
Show file tree

Hide file tree

Showing 15 changed files with 181 additions and 146 deletions.
diff --git a/.perlcriticrc b/.perlcriticrc
@@ -1,4 +1,5 @@
-severity = 3
+severity = 1
 
 [-TestingAndDebugging::RequireUseStrict]
-[-TestingAndDebugging::RequireUseWarnings]
+[-TestingAndDebugging::RequireUseWarnings]
+[-CodeLayout::RequireTidyCode]
diff --git a/.perltidyrc b/.perltidyrc
@@ -3,4 +3,8 @@
 --continuation-indentation=4
 --square-bracket-tightness=2
 --tight-secret-operators
---maximum-consecutive-blank-lines=1
+--maximum-consecutive-blank-lines=1
+--nocuddled-else
+--nooutdent-long-quotes
+
+# perltidy -nst -b filename.pl
diff --git a/cpanfile b/cpanfile
@@ -2,4 +2,5 @@ requires "JSON";
 requires "File::Find::Rule", "0.34";
 requires "Getopt::Long", "2.54";
 requires "YAML::Tiny", "1.73";
-requires "PPI::Document";
+requires "PPI::Document";
+requires "List::Util";
diff --git a/lib/Zarn/Engine/AST.pm b/lib/Zarn/Engine/AST.pm
@@ -4,7 +4,7 @@ package Zarn::Engine::AST {
     use PPI::Find;
     use Getopt::Long;
     use PPI::Document;
-    
+
     our $VERSION = '0.0.6';
 
     sub new {
@@ -13,14 +13,14 @@ package Zarn::Engine::AST {
 
         Getopt::Long::GetOptionsFromArray (
             $parameters,
-            "file=s"  => \$file
+            'file=s'  => \$file
         );
 
         if ($file) {
             my $document = PPI::Document -> new($file);
 
-            $document -> prune("PPI::Token::Pod");
-            $document -> prune("PPI::Token::Comment");
+            $document -> prune('PPI::Token::Pod');
+            $document -> prune('PPI::Token::Comment');
 
             return $document;
         }

diff --git a/lib/Zarn/Engine/Source_to_Sink.pm b/lib/Zarn/Engine/Source_to_Sink.pm
@@ -3,6 +3,7 @@ package Zarn::Engine::Source_to_Sink {
     use warnings;
     use PPI::Find;
     use Getopt::Long;
+    use List::Util 'any';
     use PPI::Document;
     use Zarn::Engine::Taint_Analysis;
 
@@ -14,26 +15,26 @@ package Zarn::Engine::Source_to_Sink {
 
         Getopt::Long::GetOptionsFromArray (
             $parameters,
-            "ast=s"   => \$ast,
-            "rules=s" => \$rules
+            'ast=s'   => \$ast,
+            'rules=s' => \$rules
         );
 
         if ($ast && $rules) {
-            foreach my $token (@{$ast -> find("PPI::Token")}) {
+            foreach my $token (@{$ast -> find('PPI::Token')}) {
                 foreach my $rule (@{$rules}) {
                     my @sample   = $rule -> {sample} -> @*;
                     my $category = $rule -> {category};
                     my $title    = $rule -> {name};
                     my $message  = $rule -> {message};
 
-                    if (grep {my $content = $_; scalar(grep {$content =~ m/$_/xms} @sample)} $token -> content()) {
+                    if (any { my $content = $_; scalar(any { $content =~ m/$_/xms } @sample) } $token -> content()) {
                         my $next_element = $token -> snext_sibling;
 
                         # this is a draft source-to-sink function
                         if (defined $next_element && ref $next_element && $next_element -> content() =~ /[\$\@\%](\w+)/xms) {
                             my $taint_analysis = Zarn::Engine::Taint_Analysis -> new ([
-                                "--ast" => $ast,
-                                "--token" => $1,
+                                '--ast' => $ast,
+                                '--token' => $1,
                             ]);
 
                             if ($taint_analysis) {
@@ -57,7 +58,7 @@ package Zarn::Engine::Source_to_Sink {
 
             return @results;
         }
-        
+
         return 0;
     }
 }

diff --git a/lib/Zarn/Engine/Taint_Analysis.pm b/lib/Zarn/Engine/Taint_Analysis.pm
@@ -4,7 +4,9 @@ package Zarn::Engine::Taint_Analysis {
     use PPI::Find;
     use Getopt::Long;
     use PPI::Document;
-
+    use List::Util 'any';
+
+
     our $VERSION = '0.0.1';
 
     sub new {
@@ -13,31 +15,31 @@ package Zarn::Engine::Taint_Analysis {
 
         Getopt::Long::GetOptionsFromArray (
             $parameters,
-            "ast=s"   => \$ast,
-            "token=s" => \$token
+            'ast=s'   => \$ast,
+            'token=s' => \$token
         );
 
         if ($ast && $token) {
-            my $var_token = $ast -> find_first (                                
-                sub { 
-                    $_[1] -> isa("PPI::Token::Symbol") and 
+            my $var_token = $ast -> find_first (
+                sub {
+                    $_[1] -> isa('PPI::Token::Symbol') and
                     ($_[1] -> content eq "\$$token") # or $_[1] -> content eq "\@$1" or $_[1] -> content eq "\%$1"
                 }
             );
 
-            if ($var_token && $var_token -> can("parent")) {
+            if ($var_token && $var_token -> can('parent')) {
                 my @childrens = $var_token -> parent -> children;
-                
+
                 # verifyng if the variable is a fixed string or a number
-                if (grep { 
-                    $_ -> isa("PPI::Token::Quote::Double") || 
-                    $_ -> isa("PPI::Token::Quote::Single") || 
-                    $_ -> isa("PPI::Token::Number")
+                if (any {
+                    $_ -> isa('PPI::Token::Quote::Double') ||
+                    $_ -> isa('PPI::Token::Quote::Single') ||
+                    $_ -> isa('PPI::Token::Number')
                 } @childrens) {
                     return 0;
                 }
 
-                if (($var_token -> parent -> isa("PPI::Token::Operator") || $var_token -> parent -> isa("PPI::Statement::Expression"))) {
+                if (($var_token -> parent -> isa('PPI::Token::Operator') || $var_token -> parent -> isa('PPI::Statement::Expression'))) {
                     return $var_token -> location;
                 }
             }

diff --git a/lib/Zarn/Helper/Files.pm b/lib/Zarn/Helper/Files.pm
@@ -3,24 +3,33 @@ package Zarn::Helper::Files {
     use warnings;
     use File::Find::Rule;
 
-    our $VERSION = '0.0.2';
+    our $VERSION = '0.0.3';
 
     sub new {
         my ($self, $source, $ignore) = @_;
 
         if ($source) {
             my $rule = File::Find::Rule -> new();
+            my $exclude_rule = $rule -> new();
 
-            $rule -> or (
-                $rule -> new -> directory -> name(".git", $ignore) -> prune -> discard,
-                $rule -> new
-            );
+            $exclude_rule = $exclude_rule -> directory();
+            $exclude_rule = $exclude_rule -> name('.git', $ignore);
+            $exclude_rule = $exclude_rule -> prune();
+            $exclude_rule = $exclude_rule -> discard();
+
+            my $file_rule = $rule -> new();
+            $rule -> or ($exclude_rule, $file_rule);
 
             $rule -> file -> nonempty;
-            $rule -> name("*.pm", "*.t", "*.pl");
+            $rule -> name('*.pm', '*.t', '*.pl');
 
             my @files = $rule -> in($source);
 
+            if (!@files) {
+                print "[!] Could not identify any files in: $source.\n";
+                return 1;
+            }
+
             return @files;
         }
 

diff --git a/lib/Zarn/Helper/Sarif.pm b/lib/Zarn/Helper/Sarif.pm
@@ -8,14 +8,14 @@ package Zarn::Helper::Sarif {
         my ($self, @vulnerabilities) = @_;
 
         my $sarif_data = {
-            "\$schema" => "https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json",
-            version   => "2.1.0",
+            "\$schema" => 'https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json',
+            version   => '2.1.0',
             runs      => [{
                 tool    => {
                     driver => {
-                        name    => "ZARN",
-                        informationUri => "https://github.com/htrgouvea/zarn",
-                        version => "0.1.0"
+                        name    => 'ZARN',
+                        informationUri =>'"https://github.com/htrgouvea/zarn',
+                        version => '0.1.0'
                     }
                 },
                 results => []

diff --git a/samples/code-injection.pl b/samples/code-injection.pl
diff --git a/samples/false-positive.pl b/samples/false-positive.pl
diff --git a/tests/Files.t b/tests/Files.t
@@ -0,0 +1,52 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Temp qw(tempdir);
+use File::Path qw(make_path);
+use File::Spec;
+use File::Basename;
+use File::Find;
+use File::Slurp;
+use Zarn::Helper::Files;
+
+my $temp_dir = tempdir(CLEANUP => 1);
+
+my @dirs = (
+    File::Spec->catdir($temp_dir, 'dir1'),
+    File::Spec->catdir($temp_dir, 'dir2', '.git'),
+);
+
+my @files = (
+    File::Spec->catfile($temp_dir, 'dir1', 'file1.pm'),
+    File::Spec->catfile($temp_dir, 'dir1', 'file2.t'),
+    File::Spec->catfile($temp_dir, 'dir1', 'file3.pl'),
+    File::Spec->catfile($temp_dir, 'dir2', 'file4.pm'),
+    File::Spec->catfile($temp_dir, 'dir2', 'file5.txt'),
+    File::Spec->catfile($temp_dir, 'dir2', '.git', 'file6.pm'),
+);
+
+foreach my $dir (@dirs) {
+    make_path($dir);
+}
+
+foreach my $file (@files) {
+    write_file($file, "use strict;\n");
+}
+
+my @expected_files = (
+    File::Spec->catfile($temp_dir, 'dir1', 'file1.pm'),
+    File::Spec->catfile($temp_dir, 'dir1', 'file2.t'),
+    File::Spec->catfile($temp_dir, 'dir1', 'file3.pl'),
+    File::Spec->catfile($temp_dir, 'dir2', 'file4.pm'),
+);
+
+my @found_files = Zarn::Helper::Files->new($temp_dir, '.git');
+@found_files = sort @found_files;
+@expected_files = sort @expected_files;
+
+is_deeply(\@found_files, \@expected_files, 'Perl files correctly found in the source directory');
+
+my $no_source = Zarn::Helper::Files->new();
+is($no_source, 0, 'Returns 0 when no source directory is provided');
+
+done_testing();
diff --git a/tests/Rules.t b/tests/Rules.t
@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+use Test::More;
+use Zarn::Helper::Rules;
+use File::Temp qw(tempfile);
+
+my $yaml_content = <<'END_YAML';
+---
+rules:
+  - rule1
+  - rule2
+  - rule3
+END_YAML
+
+
+my ($fh, $filename) = tempfile();
+print $fh $yaml_content;
+close $fh;
+
+my @expected_rules = ('rule1', 'rule2', 'rule3');
+my @rules = Zarn::Helper::Rules->new($filename);
+
+my @flattened_rules = map { @$_ } @rules;
+is_deeply(\@flattened_rules, \@expected_rules, 'Rules correctly loaded from YAML file');
+
+my $no_rules = Zarn::Helper::Rules->new();
+is($no_rules, 0, 'Returns 0 when no rules file is provided');
+
+done_testing();
diff --git a/tools/graph.pl b/tools/graph.pl
diff --git a/tools/view-ast.pl b/tools/view-ast.pl