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.

5 files changed, 110 insertions, 89 deletions

diff --git a/lib/TUWF.pm b/lib/TUWF.pm
index 1954ceb..c6a042e 100644
--- a/lib/TUWF.pm
+++ b/lib/TUWF.pm
@@ -281,7 +281,7 @@ sub _handle_request {
       "HTTP Request Headers:\n".
       join('', map sprintf("  %s: %s\n", $_, $self->reqHeader($_)), $self->reqHeader).
       "POST dump:\n".
-      join('', map sprintf("  %s: %s\n", $_, $self->reqPost($_)), $self->reqPost).
+      join('', map sprintf("  %s: %s\n", $_, join "\n    ", $self->reqPosts($_)), $self->reqPosts).
       "Error:\n  $err\n"
     );
   }
diff --git a/lib/TUWF/Misc.pm b/lib/TUWF/Misc.pm
index 5ab0352..1ca1ebf 100644
--- a/lib/TUWF/Misc.pm
+++ b/lib/TUWF/Misc.pm
@@ -157,9 +157,9 @@ sub _validate { # value, \%templates, \%rules
 sub formValidate {
   my($self, @fields) = @_;
   return kv_validate(
-    { post   => sub { $self->reqPost(shift)   },
-      get    => sub { $self->reqGet(shift)    },
-      param  => sub { $self->reqParam(shift)  },
+    { post   => sub { $self->reqPosts(shift)  },
+      get    => sub { $self->reqGets(shift)   },
+      param  => sub { $self->reqParams(shift) },
       cookie => sub { $self->reqCookie(shift) },
     }, $self->{_TUWF}{validate_templates} || {},
     \@fields
diff --git a/lib/TUWF/Misc.pod b/lib/TUWF/Misc.pod
index 0348778..fb864c5 100644
--- a/lib/TUWF/Misc.pod
+++ b/lib/TUWF/Misc.pod
@@ -20,9 +20,9 @@ form is useful if you wish to use a function outside of the TUWF framework.
 Shorthand for calling C<kv_validate()> with the following sources:
 
   Name    TUWF Method
-   post    reqPost()
-   get     reqGet()
-   param   reqParam()
+   post    reqPosts()
+   get     reqGets()
+   param   reqParams()
    cookie  reqCookie()
 
 The L<validate_templates|TUWF/validate_templates> configuration setting is
@@ -65,10 +65,10 @@ subroutine reference. This subroutine should accept one argument: the name of
 the field, and is expected return a list of values, or an empty list if there
 are no values with that key. The following example defines a source by the name
 "param", and tells C<kv_validate()> to fetch the values using
-L<reqParam()|TUWF::Request>.
+L<reqParams()|TUWF::Request>.
 
   kv_validate(
-    { param => sub { $TUWF::OBJ->reqParam(shift) } },
+    { param => sub { $TUWF::OBJ->reqParams(shift) } },
     ..
   );
 
@@ -90,7 +90,7 @@ should not be a field from a different source with the same name.
 
 Using the I<sources> example above, specifying C<param =E<gt> 'foo'> as field
 option tells C<kv_validate()> to fetch the value(s) for this field from
-C<reqParam('foo')>.
+C<reqParams('foo')>.
 
 =item required
 
@@ -249,7 +249,7 @@ Usage example:
 
   my $r = kv_validate(
     # sources
-    { param => sub { $TUWF::OBJ->reqParam(shift) } },
+    { param => sub { $TUWF::OBJ->reqParams(shift) } },
     # templates
     { crc32_hex => {
       regex => qr/^[0-9a-f]+$/i,
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;
-
diff --git a/lib/TUWF/Request.pod b/lib/TUWF/Request.pod
index a2b283e..6996a70 100644
--- a/lib/TUWF/Request.pod
+++ b/lib/TUWF/Request.pod
@@ -14,70 +14,91 @@ This module can not be used outside of the TUWF framework.
 
 The following methods are added to the main TUWF object:
 
-=head2 reqGet(name)
+=head2 reqGets(name)
 
 Get parameters from the query string. When I<name> is not given or undef,
-returns a list of all parameter names (in no defined order). When used in array
-context and with I<name> given, will return all values of the parameter in the
-order that they appear in the query string. When used in scalar context and
-with I<name> given, will return the value of the first occurence of the
-parameter. When I<name> is given, but there exists no parameter with that name,
-C<reqGet> will return an empty list in array context or C<undef> otherwise.
+returns a list of all parameter names (in no defined order). Otherwise it will
+return all values of the parameter in the order that they appear in the query
+string. In both cases an empty list may be returned if there are no parameters
+or if the named parameter does not exist. This method should not be used in
+scalar context.
+
 Examples:
 
   # Let the query string be the following:
   #  "key=value&foo=bar1&foo=bar2"
   # Then:
-  my @list = $self->reqGet();     # @list = ('key', 'foo')
-  my $key = $self->reqGet('key'); # $key = 'value'
-  my $foo = $self->reqGet('foo'); # $foo = 'bar1'
-  my @foo = $self->reqGet('foo'); # @foo = ('bar1', 'bar2')
-  my $no  = $self->reqGet('no');  # $no = undef
-  my @no  = $self->reqGet('no');  # @no = ()
+  my @list = $self->reqGets();      # @list = ('key', 'foo')
+  my @foo  = $self->reqGets('foo'); # @foo = ('bar1', 'bar2')
+  my @no   = $self->reqGets('no');  # @no = ()
+
+=head2 reqGet(name)
+
+Get the first value of the named query string parameter. Roughly equivalent to
+C<(reqGets($name))[0]>. The name argument is required. Since this method only
+ever returns a scalar value, it is safe to use when constructing lists:
+
+  my %stuff = (
+    name => $self->reqGet('name'),
+  );
+
+Don't do that with C<reqGets()>, as it may leave you vulnerable to parameter
+injection!
+
+=head2 reqPosts(name)
+
+Behaves the same as C<reqGets()>, but fetches the information from the POST
+data of the request instead. Unlike many CGI libraries, C<reqPost()> will
+B<not> return the file contents when the parameter comes from a file upload
+input element, instead, it will return the file name.
 
 =head2 reqPost(name)
 
-Behaves the same as C<reqGet()>, but fetches the information from the POST data
-of the request instead. Unlike many CGI libraries, C<reqPost()> will B<not>
-return the file contents when the parameter comes from a file upload input
-element, instead, it will return the file name.
+Behaves the same as C<reqGet()>, but for POST data.
 
-=head2 reqParam(name)
+=head2 reqParams(name)
 
-Combines C<reqGet()> and C<reqPost()>. The behaviour is the same as both
-functions, but C<reqParam()> returns data from both the query string and POST
-data. In listings, POST parameters and values are always listed before the GET
-parameters and values, and in scalar context the value of the POST parameter
-has priotity over the GET value.
+Combines C<reqGets()> and C<reqPosts()>. The behaviour is the same as both
+functions, but C<reqParams()> returns data from both the query string and POST
+data. POST parameters and values are always listed before the GET parameters
+and values.
 
 This function behaves similar to the C<param()> function of many CGI libraries,
-with the exception that (like all other TUWF methods) C<reqParam()> returns all
+with the exception that (like all other TUWF methods) C<reqParams()> returns all
 data in Perls native unicode format and that for file uploads, the file name is
 returned instead of its contents.
 
-=head2 reqUploadMIME(name)
+=head2 reqParam(name)
+
+Behaves the same as C<reqGet()>, but works on both POST and GET data. If a
+parameter is set in both the POST and GET data, only the value in the POST data
+is returned.
+
+=head2 reqUploadMIMEs(name)
 
 When I<name> is not given, returns a list of all parameter names that represent
-an uploaded file (in no particular order). In array context and when I<name> is
-given, returns the MIME type of all uploaded files corresponding to the named
-parameter, in the order that they appear in the POST data. In scalar context
-and when I<name> is given, will return the MIME type of the first uploaded file
-corresponding to the named parameter. When the named parameter does not exist
-or does not represent an uploaded file, C<reqUploadMIME()> will return an empty
-list in array context or C<undef> otherwise.
+an uploaded file (in no particular order). When I<name> is given, returns the
+MIME type of all uploaded files corresponding to the named parameter, in the
+order that they appear in the POST data. When the named parameter does not
+exist or does not represent an uploaded file, C<reqUploadMIMEs()> will return
+an empty list.
 
 It is important to note that this function B<only> works with parameters that
 actually represent an uploaded file. If a parameter comes from a file upload
 input element, but the user did not use it to actually upload a file (i.e. left
-it empty), then C<reqUploadMIME()> will treat it as if the parameter did not
-exist at all. The parameter will then still show up in C<reqPost()>, but with
+it empty), then C<reqUploadMIMEs()> will treat it as if the parameter did not
+exist at all. The parameter will then still show up in C<reqPosts()>, but with
 an empty string as "file name".
 
-=head2 reqUploadRaw(name)
+=head2 reqUploadMIME(name)
 
-In list context, returns the contents of all uploaded files corresponding to
-the named parameter, in the order that they appear in the POST data. In scalar
-context, returns the contents of the first uploaded file.
+Behaves similarly to C<reqGet()>, but works with the fields from
+C<reqUploadMIMEs()>.
+
+=head2 reqUploadRaws(name)
+
+Behaves similarly to C<reqUploadMIMEs()>, but returns the file data instead of
+the MIME types.
 
 Unlike all other methods, this method does B<NOT> return the data in Perls
 native unicode format, but will return the data as a binary string. The reason
@@ -85,6 +106,11 @@ for this is that TUWF has no way of knowing in which encoding the uploaded file
 is, and the file may not even represent text at all, but could be any binary
 file (e.g. a JPEG image).
 
+=head2 reqUploadRaw(name)
+
+Behaves similarly to C<reqGet()>, but works with the fields from
+C<reqUploadRaws()>.
+
 =head2 reqSaveUpload(name, file)
 
 Saves the contents of the first file uploaded with parameter I<name> to