summaryrefslogtreecommitdiff
path: root/lib/TUWF/Request.pm
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2015-09-20 11:46:30 +0200
committerYorhel <git@yorhel.nl>2015-09-20 11:58:58 +0200
commit6a694f158d833c58125d383577fce48c9f55b3cf (patch)
treecd4b2da38d936f29c1da7566d61679a168cd11dd /lib/TUWF/Request.pm
parent55cbbb319a135dbddfbfdd989bc0cb364edef81d (diff)
TUWF::Request: Split reqGet family of methods into scalar and list versions
!!!BACKWARDS INCOMPATIBLE CHANGE!!! This is to avoid parameter injection vulnerabilities as described in http://blog.gerv.net/2014/10/new-class-of-vulnerability-in-perl-web-applications/ Handy way to see if you have any code to fix: grep -E 'req(Get|Post|Param|UploadMIME|UploadRaw)' -R src/ Additionally, all methods that would return the list of available keys when no key name was given now check that the name argument was not present at all (as opposed to present but undef). This avoids a potential parameter injection if an attacker can manage to set the argument to undef.
Diffstat (limited to 'lib/TUWF/Request.pm')
-rw-r--r--lib/TUWF/Request.pm75
1 files changed, 35 insertions, 40 deletions
diff --git a/lib/TUWF/Request.pm b/lib/TUWF/Request.pm
index 2ba8f7a..8806451 100644
--- a/lib/TUWF/Request.pm
+++ b/lib/TUWF/Request.pm
@@ -9,7 +9,8 @@ use Carp 'croak';
our $VERSION = '0.2';
our @EXPORT = qw|
- reqInit reqGet reqPost reqParam reqUploadMIME reqUploadRaw reqSaveUpload
+ reqInit reqGets reqGet reqPosts reqPost reqParams reqParam
+ reqUploadMIMEs reqUploadMIME reqUploadRaws reqUploadRaw reqSaveUpload
reqCookie reqMethod reqHeader reqPath reqQuery reqBaseURI reqURI reqHost reqIP
|;
@@ -153,60 +154,55 @@ sub _parse_cookies {
}
-# get parameters from the query string
-sub reqGet {
- my($s, $n) = @_;
- my $lst = $s->{_TUWF}{Req}{GET};
- return keys %$lst if !$n;
- return wantarray ? () : undef if !$lst->{$n};
- return wantarray ? @{$lst->{$n}} : $lst->{$n}[0];
+sub _tablegets {
+ my($k, $s, $n) = @_;
+ my $lst = $s->{_TUWF}{Req}{$k};
+ return keys %$lst if @_ == 2;
+ return $lst->{$n} ? @{$lst->{$n}} : ();
}
-# get parameters from the POST body
-sub reqPost {
- my($s, $n) = @_;
- my $lst = $s->{_TUWF}{Req}{POST};
- return keys %$lst if !$n;
- return wantarray ? () : undef if !$lst->{$n};
- return wantarray ? @{$lst->{$n}} : $lst->{$n}[0];
+sub _tableget {
+ my($k, $s, $n) = @_;
+ my $v = $s->{_TUWF}{Req}{$k}{$n};
+ return $v ? $v->[0] : undef;
}
+sub reqGets { _tablegets(GET => @_) }
+sub reqGet { _tableget (GET => @_) }
+sub reqPosts { _tablegets(POST => @_) }
+sub reqPost { _tableget (POST => @_) }
+sub reqUploadMIMEs { _tablegets(MIMES => @_) }
+sub reqUploadMIME { _tableget (MIMES => @_) }
+sub reqUploadRaws { _tablegets(FILES => @_) }
+sub reqUploadRaw { _tableget (FILES => @_) }
+
+
# get parameters from either or both POST and GET
# (POST has priority over GET in scalar context)
-sub reqParam {
+sub reqParams {
my($s, $n) = @_;
my $nfo = $s->{_TUWF}{Req};
if(!$n) {
my %keys = map +($_,1), keys(%{$nfo->{GET}}), keys(%{$nfo->{POST}});
return keys %keys;
}
- my $val = [
+ return (
$nfo->{POST}{$n} ? @{$nfo->{POST}{$n}} : (),
$nfo->{GET}{$n} ? @{$nfo->{GET}{$n}} : (),
- ];
- return wantarray ? () : undef if !@$val;
- return wantarray ? @$val : $val->[0];
-}
-
-
-# returns the MIME Type of an uploaded file.
-sub reqUploadMIME {
- my($self, $n) = @_;
- my $nfo = $self->{_TUWF}{Req}{MIMES};
- return keys %$nfo if !defined $n;
- return wantarray ? () : undef if !$nfo->{$n};
- return wantarray ? @{$nfo->{$n}} : $nfo->{$n}[0];
+ );
}
-# returns the raw (encoded) contents of an uploaded file
-sub reqUploadRaw {
- my($self, $n) = @_;
- my $nfo = $self->{_TUWF}{Req}{FILES}{$n};
- return wantarray ? () : undef if !$nfo;
- return wantarray ? @$nfo : $nfo->[0];
+# (POST has priority over GET in scalar context)
+sub reqParam {
+ my($s, $n) = @_;
+ my $nfo = $s->{_TUWF}{Req};
+ return [
+ $nfo->{POST}{$n} ? @{$nfo->{POST}{$n}} : (),
+ $nfo->{GET}{$n} ? @{$nfo->{GET}{$n}} : (),
+ ]->[0];
}
@@ -215,7 +211,7 @@ sub reqUploadRaw {
sub reqSaveUpload {
my($s, $n, $f) = @_;
open my $F, '>', $f or croak "Unable to write to $f: $!";
- print $F scalar $s->reqUploadRaw($n);
+ print $F $s->reqUploadRaw($n);
close $F;
}
@@ -223,7 +219,7 @@ sub reqSaveUpload {
sub reqCookie {
my($self, $n) = @_;
my $nfo = $self->{_TUWF}{Req}{Cookies};
- return keys %$nfo if !defined $n;
+ return keys %$nfo if @_ == 1;
return $nfo->{$n};
}
@@ -240,7 +236,7 @@ sub reqMethod {
# case-insensitive
sub reqHeader {
my($self, $name) = @_;
- if($name) {
+ if(@_ == 1) {
(my $v = uc $_[1]) =~ tr/-/_/;
return $ENV{"HTTP_$v"}||'';
} else {
@@ -291,4 +287,3 @@ sub reqIP {
1;
-