diff --git a/.perlcriticrc b/.perlcriticrc index feaae88..930198b 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -1,2 +1,2 @@ only = 1 -include = ProhibitUnusedVariables ProhibitUnusedConstant ProhibitUnusedInclude ProhibitUnusedImport \ No newline at end of file +include = ProhibitUnusedVariables ProhibitUnusedConstant ProhibitUnusedInclude ProhibitUnusedImport ProhibitUnreachableCode ProhibitComplexRegexes ProhibitDuplicatedSub ProhibitDuplicateHashKeys ProhibitUnusedPrivateSubroutines ProhibitUnlessBlocks ProhibitExcessiveColons ProhibitExplicitReturnUndef RequireCamelCase ProhibitMagicNumbers ProhibitTrailingWhitespace ProhibitHardTabs \ No newline at end of file diff --git a/examples/CodeGraph.pm b/examples/CodeGraph.pm deleted file mode 100644 index 90507e9..0000000 --- a/examples/CodeGraph.pm +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/env perl - -use 5.018; -use strict; -use warnings; -use Devel::Graph; - -sub main { - my $file = $ARGV[0]; - my $grapher = Devel::Graph -> new(); - my $graph = $grapher -> decompose ($file); - - print $graph -> as_ascii(); -} - -main(); \ No newline at end of file diff --git a/examples/chat.pl b/examples/chat.pl deleted file mode 100644 index c7f43b2..0000000 --- a/examples/chat.pl +++ /dev/null @@ -1,177 +0,0 @@ -#!/usr/bin/env perl - -use DateTime; -use Mojolicious::Lite; -use Data::Dumper qw(Dumper); - -my %clients; - -get '*' => sub { - my $content = shift; - - $content->res->headers->header('Access-Control-Allow-Origin' => 'heitorgouvea.me'); - $content->res->headers->header('Access-Control-Allow-Methods' => 'GET, OPTIONS, POST, DELETE, PUT'); - - $content -> render(text => 'Hello World!'); -}; - -websocket '/chat' => sub { - my $content = shift; - - $content->res->headers->header('Access-Control-Allow-Origin' => 'heitorgouvea.me'); - $content->res->headers->header('Access-Control-Allow-Credentials' => 'true'); - $content->res->headers->header('Access-Control-Allow-Methods' => 'GET, OPTIONS, POST, DELETE, PUT'); - $content->res->headers->header('Access-Control-Allow-Headers' => 'Content-Type'); - $content->res->headers->header('Access-Control-Max-Age' => '1728000'); - - my $tx_id = sprintf "%s", $content->tx; - $clients{$tx_id} = { ws => $content->tx }; - - $content->on(json => sub { - my ($ws, $hash) = @_; - $content->app->log->debug("From $ws received " . Dumper $hash); - - if ($hash->{heartbeat}) { - $ws->send({json => {heartbeat => $hash->{heartbeat}}}); - return; - } - - my $dt = DateTime -> now (time_zone => 'Asia/Tokyo'); - - if ($hash -> {login}) { - $clients{$tx_id}{user_name} = $hash->{login}; - $ws->send({json => {login => 'ok'}}); - - foreach my $ws (keys %clients) { - next if $ws eq $tx_id; - $clients{$ws}{ws}->send({json => { - msg => $dt->hms . " $clients{$tx_id}{user_name} has joined the conversation" - }}); - } - - return; - } - - foreach my $ws (keys %clients) { - my $msg = $dt->hms . ($ws eq $tx_id ? " $hash->{msg}" : " $clients{$tx_id}{user_name}: $hash->{msg}"); - - $clients{$ws}{ws}->send({json => { - msg => $msg, - }}); - } - - return; - }); - - $content -> on(finish => sub { - my ($ws, $code, $reason) = @_; - $content->app->log->debug( "Finished $ws Code $code reason: '" . ( $reason // '' ) . "'"); - - my $dt = DateTime->now( time_zone => 'Asia/Tokyo'); - - foreach my $ws (keys %clients) { - next if $ws eq $tx_id; - - $clients{$ws}{ws}->send({json => { - msg => $dt->hms . " $clients{$tx_id}{user_name} has left the conversation" - }}); - } - - delete $clients{$ws}; - - return; - }); -}; - -get '/' => 'index'; -app -> start(); - -__DATA__ - -@@ index.html.ep - - - - - Chat - - - - - -
Your name:
-
- Logged in as
- -
-
- - \ No newline at end of file diff --git a/examples/gateway.pl b/examples/gateway.pl deleted file mode 100644 index b0783fb..0000000 --- a/examples/gateway.pl +++ /dev/null @@ -1,44 +0,0 @@ -#!/usr/bin/env perl - -use 5.018; -use strict; -use warnings; -use Mojo::URL; -use Mojolicious::Lite -signatures; -use Mojo::File; -use Mojo::JSON qw(decode_json); -use Mojo::UserAgent; - -get "*" => sub ($request) { - my $confs = Mojo::File -> new("config.json"); - - if ($confs) { - my $json_list = $confs -> slurp(); - my $full_list = decode_json($json_list); - - foreach my $value ($full_list) { - my $full_request = $request -> req(); - my $url_values = $full_request -> url; - my $url_parsing = Mojo::URL -> new($url_values); - - if ($url_parsing =~ $value -> {base_path} . $value -> {route}) { - my $userAgent = Mojo::UserAgent -> new(); - - my $endpoint = $value -> {scheme} . $value -> {host} . ":" . $value -> {port} . $value -> {endpoint}; - - my $gateway = $userAgent -> get($endpoint) -> result(); - - return ($request -> render ( - text => $gateway -> body(), - status => $gateway -> code() - )); - } - } - } - - return ($request -> render ( - text => "Some thing as wrong... =/" - )); -}; - -app -> start(); \ No newline at end of file diff --git a/examples/hello-world.pl b/examples/hello-world.pl deleted file mode 100644 index 43fca51..0000000 --- a/examples/hello-world.pl +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/perl - -use 5.018; -use strict; -use warnings; - -sub main { - my $name = $ARGV; - - system ("echo Hello World! $name"); -} - -exit main(); \ No newline at end of file diff --git a/examples/waf.pl b/examples/waf.pl deleted file mode 100644 index 7af1984..0000000 --- a/examples/waf.pl +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/env perl -# Use: perl application.pl daemon -m production -l http://*:8001 - -use 5.018; -use strict; -use warnings; -use re::engine::TRE; -use Mojolicious::Lite -signatures; - -get "/" => sub ($request) { - my $xss = $request -> param("TryHarder"); - $xss = lc $xss; - - if (($xss) && (length($xss) <= 32)) { - my @blocklist = ( - "script", ";", "img", "link", "onload", "onfocus", "onblur", "onclick", - "(", ")", "/", "onerror", "onplay", "onend", "svg", "", "", "", "", "%", - "onmouseup", "onwheel", "xss" - ); - - for (my $i = 0; $i <= 5; $i++) { - foreach my $filter (@blocklist) { - $xss =~ s/$filter//; - } - } - - return ($request -> render ( - text => " - - - Awesome WAF - Try Harder! - - -

Hello $xss!!

- - - " - )); - } - - return ($request -> render ( - text => "" - )); -}; - -app -> start(); \ No newline at end of file diff --git a/lib/Zarn/AST.pm b/lib/Zarn/AST.pm index 69f67da..ef2214a 100644 --- a/lib/Zarn/AST.pm +++ b/lib/Zarn/AST.pm @@ -21,7 +21,7 @@ package Zarn::AST { $document -> prune("PPI::Token::Pod"); $document -> prune("PPI::Token::Comment"); - foreach my $token (@{$document -> find("PPI::Token")}) { + foreach my $token (@{$document -> find("PPI::Token")}) { foreach my $rule (@{$rules}) { my @sample = $rule -> {sample} -> @*; my $category = $rule -> {category}; @@ -30,10 +30,10 @@ package Zarn::AST { if ($self -> matches_sample($token -> content(), \@sample)) { $self -> process_sample_match($document, $category, $file, $title, $token); } - } + } } } - + return 1; } @@ -52,7 +52,7 @@ package Zarn::AST { 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+)/) { + if (defined $next_element && ref $next_element && $next_element -> content() =~ /[\$\@\%](\w+)/) { # perform taint analysis $self -> perform_taint_analysis($document, $category, $file, $title, $next_element); } @@ -74,4 +74,4 @@ package Zarn::AST { } } -1; +1; \ No newline at end of file diff --git a/lib/Zarn/Rules.pm b/lib/Zarn/Rules.pm index 9fee1d9..fcd4007 100644 --- a/lib/Zarn/Rules.pm +++ b/lib/Zarn/Rules.pm @@ -8,7 +8,7 @@ package Zarn::Rules { if ($rules) { my $yamlfile = YAML::Tiny -> read($rules); - my @rules = $yamlfile -> [0] -> {rules}; + my @rules = $yamlfile -> [0] -> {rules}; return @rules; } diff --git a/zarn.pl b/zarn.pl index ff24a12..77b5b71 100755 --- a/zarn.pl +++ b/zarn.pl @@ -22,16 +22,16 @@ sub main { if (!$source) { print " - \rZarn v0.0.5 - \rCore Commands - \r============== - \r\tCommand Description - \r\t------- ----------- - \r\t-s, --source Configure a source directory to do static analysis - \r\t-r, --rules Define YAML file with rules - \r\t-i, --ignore Define a file or directory to ignore - \r\t-h, --help To see help menu of a module - \n"; + \rZarn v0.0.5 + \rCore Commands + \r============== + \r\tCommand Description + \r\t------- ----------- + \r\t-s, --source Configure a source directory to do static analysis + \r\t-r, --rules Define YAML file with rules + \r\t-i, --ignore Define a file or directory to ignore + \r\t-h, --help To see help menu of a module\n + "; exit 1; }