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

package Mojo::WebSocketProxy::Parser;

use strict;
use warnings;

our $VERSION = '0.13';    ## VERSION

sub parse_req {
    my ($c, $req_storage) = @_;

    my $result;
    my $args = $req_storage->{args};
    if (ref $args ne 'HASH') {
        # for invalid call, eg: not json
        $req_storage->{args} = {};
        $result = $c->wsp_error('error', 'BadRequest', 'The application sent an invalid request.');
    }

    $result = _check_sanity($c, $req_storage) unless $result;

    return $result;
}

sub _check_sanity {
    my ($c, $req_storage) = @_;

    my @failed;
    my $args   = $req_storage->{args};
    my $config = $c->wsp_config->{config};

    OUTER:
    foreach my $k (keys %$args) {
        if (not ref $args->{$k}) {
            last OUTER if (@failed = _failed_key_value($k, $args->{$k}, $config->{skip_check_sanity}));
        } else {
            if (ref $args->{$k} eq 'HASH') {
                foreach my $l (keys %{$args->{$k}}) {
                    last OUTER
                        if (@failed = _failed_key_value($l, $args->{$k}->{$l}, $config->{skip_check_sanity}));
                }
            } elsif (ref $args->{$k} eq 'ARRAY') {
                foreach my $l (@{$args->{$k}}) {
                    last OUTER if (@failed = _failed_key_value($k, $l, $config->{skip_check_sanity}));
                }
            }
        }
    }

    if (@failed) {
        my $result = $c->wsp_error('error', 'SanityCheckFailed', 'Parameters sanity check failed.');
        # emit notification
        $c->tx->emit(sanity_failed => \@failed);
        return $result;
    }
    return;
}

sub _failed_key_value {
    my ($key, $value, $skip_check_sanity) = @_;

    my $key_regex = qr/^[A-Za-z0-9_-]{1,50}$/;
    if ($key !~ /$key_regex/) {
        return ($key, $value);
    }

    if ($skip_check_sanity && $key =~ /$skip_check_sanity/) {
        return;
    }

    if (
        $key !~ /$key_regex/
        # !-~ to allow a range of acceptable characters. To find what is the range, look at ascii table

        # \p{L} is to ensure we include other Unicode letters outside the ASCII range
        # \p{Script=Common} is to match double byte characters in Japanese keyboards, eg: '１−１−１'
        # refer: http://perldoc.perl.org/perlunicode.html and http://perldoc.perl.org/perluniprops.html
        # null-values are allowed
        or ($value and $value !~ /^[\p{Script=Common}\p{Letter}\s\w\@_:!-~]{0,300}$/))
    {
        return ($key, $value);
    }
    return;
}

1;

__END__