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 - Use instead of CGI::Untaint. Based on CGI::Untaint
  12
  13 =head1 SYNOPSIS
  14
  15   use CGI::Untaint::Maypole;
  16   my $h = CGI::Untaint::Maypole->new($params);
  17   $value = $h->extract(-as_printable => 'name);
  18
  19   if ($h->error =~ /No input for/) {
  20         # caught empty input now handle it
  21                 ....
  22   }
  23   if ($h->raw_data->{$field} eq $object->$field) {
  24     # Raw data same as database data. Perhaps we should not update field
  25         ...
  26   }
  27
  28 =head1 DESCRIPTION
  29
  30 This patches some issues I have with CGI::Untaint. You still need it installed
  31 and you install handlers the same.
  32
  33 1) Instead of passing the empty string to the untaint handlers and relying on
  34 them to handle it to everyone's liking, it seems better
  35 to have CGI::Untaint just say "No input for field" if the field is blank.
  36
  37 2) It  adds the method C<raw_data> to the get back the parameters the handler
  38 was created with.
  39
  40 =cut
  41
  42 =head2 raw_data
  43
  44 Returns the parameters the handler was created with as a hashref
  45
  46 =cut
  47
  48 sub raw_data {
  49         return shift->{__data};
  50 }
  51
  52 # offending method ripped from base and patched
  53 sub _do_extract {
  54         my $self = shift;
  55
  56         my %param = @_;
  57
  58         #----------------------------------------------------------------------
  59         # Make sure we have a valid data handler
  60         #----------------------------------------------------------------------
  61         my @as = grep /^-as_/, keys %param;
  62         croak "No data handler type specified"        unless @as;
  63         croak "Multiple data handler types specified" unless @as == 1;
  64
  65         my $field      = delete $param{ $as[0] };
  66         my $skip_valid = $as[0] =~ s/^(-as_)like_/$1/;
  67         my $module     = $self->_load_module($as[0]);
  68
  69         #----------------------------------------------------------------------
  70         # Do we have a sensible value? Check the default untaint for this
  71         # type of variable, unless one is passed.
  72         #----------------------------------------------------------------------
  73
  74         ################# PETER'S PATCH #####################
  75         my $raw = $self->{__data}->{$field} ;
  76         die "No parameter for '$field'\n" if !defined($raw);
  77         die "No input for '$field'\n" if $raw eq '';
  78     #####################################################
  79
  80
  81         my $handler = $module->_new($self, $raw);
  82
  83         my $clean = eval { $handler->_untaint };
  84         if ($@) {    # Give sensible death message
  85                 die "$field ($raw) is in invalid format.\n"
  86                         if $@ =~ /^Died at/;
  87                 die $@;
  88         }
  89
  90         #----------------------------------------------------------------------
  91         # Are we doing a validation check?
  92         #----------------------------------------------------------------------
  93         unless ($skip_valid) {
  94                 if (my $ref = $handler->can('is_valid')) {
  95                         die "$field ($raw) is in invalid format.\n"
  96                                 unless $handler->is_valid;
  97                 }
  98         }
  99
 100         return $handler->untainted;
 101 }
 102
 103 =head1 BUGS
 104
 105 None known yet.
 106
 107 =head1 SEE ALSO
 108
 109 L<perlsec>. L<CGI::Untaint>.
 110
 111 =head1 AUTHOR
 112
 113 Peter Speltz.
 114
 115 =head1 BUGS and QUERIES
 116
 117 Please direct all correspondence regarding this module to:
 118    bug-Maypole@rt.cpan.org
 119
 120 =head1 COPYRIGHT and LICENSE
 121
 122 Copyright (C) 2006 Peter Speltz.  All rights reserved.
 123
 124 This module is free software; you can redistribute it and/or modify
 125 it under the same terms as Perl itself.
 126
 127 =cut
 128
 129 1;