lib/CGI/Untaint/Maypole.pm

   1 package CGI::Untaint::Maypole;
   2
   3 use strict;
   4 use warnings;
   5 our $VERSION = '0.01';
   6 use base 'CGI::Untaint';
   7 use Carp;
   8
   9 =head1 NAME
  10
  11 CGI::Untaint::Maypole - CGI::Untaint but it returns a "No input for '$field'\n" error for fields left blank on a  web form.
  12
  13 =head1 SYNOPSIS
  14
  15   if ($h->error =~ /No input for/) {
  16     # caught empty input now handle it
  17   }
  18
  19   See  CGI::Untaint.
  20
  21 =head1 DESCRIPTION
  22
  23 Instead of passing the empty string to the untaint handlers, which
  24 do not like it or updating them all, it seemed better
  25 to have CGI::Untaint catch the field left blank exception. So it does.
  26 This should be ok I see no point untainting an empty string. But i am open to suggestions and other patches.
  27
  28 =cut
  29
  30
  31 # offending method ripped from base and patched
  32 sub _do_extract {
  33         my $self = shift;
  34
  35         my %param = @_;
  36
  37         #----------------------------------------------------------------------
  38         # Make sure we have a valid data handler
  39         #----------------------------------------------------------------------
  40         my @as = grep /^-as_/, keys %param;
  41         croak "No data handler type specified"        unless @as;
  42         croak "Multiple data handler types specified" unless @as == 1;
  43
  44         my $field      = delete $param{ $as[0] };
  45         my $skip_valid = $as[0] =~ s/^(-as_)like_/$1/;
  46         my $module     = $self->_load_module($as[0]);
  47
  48         #----------------------------------------------------------------------
  49         # Do we have a sensible value? Check the default untaint for this
  50         # type of variable, unless one is passed.
  51         #----------------------------------------------------------------------
  52
  53         ################# PETER'S PATCH #####################
  54         my $raw = $self->{__data}->{$field} ;
  55         die "No parameter for '$field'\n" if !defined($raw);
  56         die "No input for '$field'\n" if $raw eq '';
  57     #####################################################
  58
  59
  60         # 'False' values get returned as themselves with no warnings.
  61         # return $self->{__lastval} unless $self->{__lastval};
  62
  63         my $handler = $module->_new($self, $raw);
  64
  65         my $clean = eval { $handler->_untaint };
  66         if ($@) {    # Give sensible death message
  67                 die "$field ($raw) does not untaint with default pattern\n"
  68                         if $@ =~ /^Died at/;
  69                 die $@;
  70         }
  71
  72         #----------------------------------------------------------------------
  73         # Are we doing a validation check?
  74         #----------------------------------------------------------------------
  75         unless ($skip_valid) {
  76                 if (my $ref = $handler->can('is_valid')) {
  77                         die "$field ($raw) does not pass the is_valid() check\n"
  78                                 unless $handler->$ref();
  79                 }
  80         }
  81
  82         return $handler->untainted;
  83 }
  84
  85 =head1 BUGS
  86
  87 None known yet.
  88
  89 =head1 SEE ALSO
  90
  91 L<CGI>. L<perlsec>. L<CGI::Untaint>.
  92
  93 =head1 AUTHOR
  94
  95 Peter Speltz but most code was ripped from CGI::Untaint.
  96
  97 =head1 BUGS and QUERIES
  98
  99 Please direct all correspondence regarding this module to:
 100   peterspeltz@cafes.net or bug-CGI-UntaintPatched@rt.cpan.org
 101
 102 =head1 COPYRIGHT and LICENSE
 103
 104 Copyright (C) 2005 Peter Speltz.  All rights reserved.
 105
 106 This module is free software; you can redistribute it and/or modify
 107 it under the same terms as Perl itself.
 108
 109 =cut
 110
 111 1;