Applying design pattern practices to a better code comprehension

lib/Zarn/Engine/AST.pm

@@ -0,0 +1,32 @@
+package Zarn::Engine::AST {
+    use strict;
+    use warnings;
+    use PPI::Find;
+    use Getopt::Long;
+    use PPI::Document;
+
+    our $VERSION = '0.0.6';
+
+    sub new {
+        my ($self, $parameters) = @_;
+        my ($file, $rules, @results);
+
+        Getopt::Long::GetOptionsFromArray (
+            $parameters,
+            "file=s"  => \$file
+        );
+
+        if ($file) {
+            my $document = PPI::Document -> new($file);
+
+            $document -> prune("PPI::Token::Pod");
+            $document -> prune("PPI::Token::Comment");
+
+            return $document;
+        }
+
+        return 0;
+    }
+}
+
+1;

lib/Zarn/Engine/Source_to_Sink.pm

@@ -0,0 +1,65 @@
+package Zarn::Engine::Source_to_Sink {
+    use strict;
+    use warnings;
+    use PPI::Find;
+    use Getopt::Long;
+    use PPI::Document;
+    use Zarn::Engine::Taint_Analysis;
+
+    our $VERSION = '0.0.2';
+
+    sub new {
+        my ($self, $parameters) = @_;
+        my ($ast, $rules, @results);
+
+        Getopt::Long::GetOptionsFromArray (
+            $parameters,
+            "ast=s"   => \$ast,
+            "rules=s" => \$rules
+        );
+
+        if ($ast && $rules) {
+            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()) {
+                        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,
+                            ]);
+
+                            if ($taint_analysis) {
+                                my ($line_sink, $rowchar_sink) = @{$token -> location};
+                                my ($line_source, $rowchar_source) = @{$taint_analysis};
+
+                                push @results, {
+                                    category       => $category,
+                                    title          => $title,
+                                    message        => $message,
+                                    line_sink      => $line_sink,
+                                    rowchar_sink   => $rowchar_sink,
+                                    line_source    => $line_source,
+                                    rowchar_source => $rowchar_source
+                                };
+                            }
+                        }
+                    }
+                }
+            }
+
+            return @results;
+        }
+
+        return 0;
+    }
+}
+
+1;

lib/Zarn/Engine/Taint_Analysis.pm

@@ -0,0 +1,50 @@
+package Zarn::Engine::Taint_Analysis {
+    use strict;
+    use warnings;
+    use PPI::Find;
+    use Getopt::Long;
+    use PPI::Document;
+
+    our $VERSION = '0.0.1';
+
+    sub new {
+        my ($self, $parameters) = @_;
+        my ($ast, $token);
+
+        Getopt::Long::GetOptionsFromArray (
+            $parameters,
+            "ast=s"   => \$ast,
+            "token=s" => \$token
+        );
+
+        if ($ast && $token) {
+            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")) {
+                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")
+                } @childrens) {
+                    return 0;
+                }
+
+                if (($var_token -> parent -> isa("PPI::Token::Operator") || $var_token -> parent -> isa("PPI::Statement::Expression"))) {
+                    return $var_token -> location;
+                }
+            }
+        }
+
+        return 0;
+    }
+}
+
+1;

lib/Zarn/Files.pm → lib/Zarn/Helper/Files.pm

@@ -1,9 +1,9 @@
-package Zarn::Files {
+package Zarn::Helper::Files {
     use strict;
     use warnings;
     use File::Find::Rule;
 
-    our $VERSION = '0.0.1';
+    our $VERSION = '0.0.2';
 
     sub new {
         my ($self, $source, $ignore) = @_;

lib/Zarn/Rules.pm → lib/Zarn/Helper/Rules.pm

@@ -1,9 +1,9 @@
-package Zarn::Rules {
+package Zarn::Helper::Rules {
     use strict;
     use warnings;
     use YAML::Tiny;
 
-    our $VERSION = '0.0.1';
+    our $VERSION = '0.0.2';
 
     sub new {
         my ($self, $rules) = @_;

lib/Zarn/Sarif.pm → lib/Zarn/Helper/Sarif.pm

@@ -1,8 +1,8 @@
-package Zarn::Sarif {
+package Zarn::Helper::Sarif {
     use strict;
     use warnings;
 
-    our $VERSION = '0.0.1';
+    our $VERSION = '0.0.2';
 
      sub new {
         my ($self, @vulnerabilities) = @_;
@@ -15,7 +15,7 @@ package Zarn::Sarif {
                     driver => {
                         name    => "ZARN",
                         informationUri => "https://github.com/htrgouvea/zarn",
-                        version => "0.0.9"
+                        version => "0.1.0"
                     }
                 },
                 results => []

zarn.pl

@@ -4,15 +4,16 @@
 use strict;
 use warnings;
 use Carp;
+use JSON;
 use lib "./lib/";
 use Getopt::Long;
-use Zarn::AST;
-use Zarn::Files;
-use Zarn::Rules;
-use Zarn::Sarif;
-use JSON;
+use Zarn::Engine::AST;
+use Zarn::Helper::Files;
+use Zarn::Helper::Rules;
+use Zarn::Helper::Sarif;
+use Zarn::Engine::Source_to_Sink;
 
-our $VERSION = '0.0.9';
+our $VERSION = '0.1.0';
 
 sub main {
     my $rules = "rules/default.yml";
@@ -26,7 +27,7 @@ sub main {
     );
 
     if (!$source) {
-        print "\nZarn v0.0.9"
+        print "\nZarn v0.1.0"
         . "\nCore Commands"
         . "\n==============\n"
         . "\tCommand          Description\n"
@@ -40,16 +41,22 @@ sub main {
         exit 1;
     }
 
-    my @rules = Zarn::Rules -> new($rules);
-    my @files = Zarn::Files -> new($source, $ignore);
+    my @rules = Zarn::Helper::Rules -> new($rules);
+    my @files = Zarn::Helper::Files -> new($source, $ignore);
 
     foreach my $file (@files) {
         if (@rules) {
-            my @analysis = Zarn::AST -> new ([
-                "--file" => $file,
+            my $ast = Zarn::Engine::AST -> new (["--file" => $file]);
+
+            my @analysis = Zarn::Engine::Source_to_Sink -> new ([
+                "--ast" => $ast,
                 "--rules" => @rules
             ]);
 
+            if (@analysis) {
+                $analysis[0] -> {'file'} = $file;
+            }
+
             push @results, @analysis;
         }
     }
@@ -67,7 +74,7 @@ sub main {
     }
 
     if ($sarif) {
-        my $sarif_data = Zarn::Sarif -> new (@results);
+        my $sarif_data = Zarn::Helper::Sarif -> new (@results);
 
         open(my $output, '>', $sarif) or croak "Cannot open file '$sarif': $!";