File Coverage

blib/lib/Mojo/WebSocketProxy/Parser.pm
Criterion Covered Total %
statement 27 42 64.2
branch 8 24 33.3
condition 3 9 33.3
subroutine 5 5 100.0
pod 1 1 100.0
total 44 81 54.3


line stmt bran cond sub pod time code
1             package Mojo::WebSocketProxy::Parser;
2              
3 17     17   94 use strict;
  17         29  
  17         438  
4 17     17   76 use warnings;
  17         24  
  17         7774  
5              
6             our $VERSION = '0.13'; ## VERSION
7              
8             sub parse_req {
9 33     33 1 97 my ($c, $req_storage) = @_;
10              
11 33         73 my $result;
12 33         73 my $args = $req_storage->{args};
13 33 50       218 if (ref $args ne 'HASH') {
14             # for invalid call, eg: not json
15 0         0 $req_storage->{args} = {};
16 0         0 $result = $c->wsp_error('error', 'BadRequest', 'The application sent an invalid request.');
17             }
18              
19 33 50       167 $result = _check_sanity($c, $req_storage) unless $result;
20              
21 33         140 return $result;
22             }
23              
24             sub _check_sanity {
25 33     33   74 my ($c, $req_storage) = @_;
26              
27 33         65 my @failed;
28 33         60 my $args = $req_storage->{args};
29 33         103 my $config = $c->wsp_config->{config};
30              
31             OUTER:
32 33         123 foreach my $k (keys %$args) {
33 33 50       112 if (not ref $args->{$k}) {
34 33 50       152 last OUTER if (@failed = _failed_key_value($k, $args->{$k}, $config->{skip_check_sanity}));
35             } else {
36 0 0       0 if (ref $args->{$k} eq 'HASH') {
    0          
37 0         0 foreach my $l (keys %{$args->{$k}}) {
  0         0  
38             last OUTER
39 0 0       0 if (@failed = _failed_key_value($l, $args->{$k}->{$l}, $config->{skip_check_sanity}));
40             }
41             } elsif (ref $args->{$k} eq 'ARRAY') {
42 0         0 foreach my $l (@{$args->{$k}}) {
  0         0  
43 0 0       0 last OUTER if (@failed = _failed_key_value($k, $l, $config->{skip_check_sanity}));
44             }
45             }
46             }
47             }
48              
49 33 50       105 if (@failed) {
50 0         0 my $result = $c->wsp_error('error', 'SanityCheckFailed', 'Parameters sanity check failed.');
51             # emit notification
52 0         0 $c->tx->emit(sanity_failed => \@failed);
53 0         0 return $result;
54             }
55 33         129 return;
56             }
57              
58             sub _failed_key_value {
59 33     33   132 my ($key, $value, $skip_check_sanity) = @_;
60              
61 33         140 my $key_regex = qr/^[A-Za-z0-9_-]{1,50}$/;
62 33 50       288 if ($key !~ /$key_regex/) {
63 0         0 return ($key, $value);
64             }
65              
66 33 50 33     145 if ($skip_check_sanity && $key =~ /$skip_check_sanity/) {
67 0         0 return;
68             }
69              
70 33 50 33     382 if (
      33        
71             $key !~ /$key_regex/
72             # !-~ to allow a range of acceptable characters. To find what is the range, look at ascii table
73              
74             # \p{L} is to ensure we include other Unicode letters outside the ASCII range
75             # \p{Script=Common} is to match double byte characters in Japanese keyboards, eg: '1−1−1'
76             # refer: http://perldoc.perl.org/perlunicode.html and http://perldoc.perl.org/perluniprops.html
77             # null-values are allowed
78             or ($value and $value !~ /^[\p{Script=Common}\p{Letter}\s\w\@_:!-~]{0,300}$/))
79             {
80 0         0 return ($key, $value);
81             }
82 33         195 return;
83             }
84              
85             1;
86              
87             __END__