From 9c9e81bbde5461ee964c5a129a4ef241463624f3 Mon Sep 17 00:00:00 2001 From: Aaron Trevena Date: Wed, 11 Jan 2006 18:39:59 +0000 Subject: [PATCH] added new Untaint subclass for maypole2 git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@450 48953598-375a-da11-a14b-00016c27c3ee --- lib/CGI/Untaint/Maypole.pm | 111 +++++++++++++++++++++++++++++++++++++ 1 file changed, 111 insertions(+) create mode 100644 lib/CGI/Untaint/Maypole.pm diff --git a/lib/CGI/Untaint/Maypole.pm b/lib/CGI/Untaint/Maypole.pm new file mode 100644 index 0000000..2320a99 --- /dev/null +++ b/lib/CGI/Untaint/Maypole.pm @@ -0,0 +1,111 @@ +package CGI::Untaint::Maypole; + +use strict; +use warnings; +our $VERSION = '0.01'; +use base 'CGI::Untaint'; +use Carp; + +=head1 NAME + +CGI::Untaint::Maypole - CGI::Untaint but it returns a "No input for '$field'\n" error for fields left blank on a web form. + +=head1 SYNOPSIS + + if ($h->error =~ /No input for/) { + # caught empty input now handle it + } + + See CGI::Untaint. + +=head1 DESCRIPTION + +Instead of passing the empty string to the untaint handlers, which +do not like it or updating them all, it seemed better +to have CGI::Untaint catch the field left blank exception. So it does. +This should be ok I see no point untainting an empty string. But i am open to suggestions and other patches. + +=cut + + +# offending method ripped from base and patched +sub _do_extract { + my $self = shift; + + my %param = @_; + + #---------------------------------------------------------------------- + # Make sure we have a valid data handler + #---------------------------------------------------------------------- + my @as = grep /^-as_/, keys %param; + croak "No data handler type specified" unless @as; + croak "Multiple data handler types specified" unless @as == 1; + + my $field = delete $param{ $as[0] }; + my $skip_valid = $as[0] =~ s/^(-as_)like_/$1/; + my $module = $self->_load_module($as[0]); + + #---------------------------------------------------------------------- + # Do we have a sensible value? Check the default untaint for this + # type of variable, unless one is passed. + #---------------------------------------------------------------------- + + ################# PETER'S PATCH ##################### + my $raw = $self->{__data}->{$field} ; + die "No parameter for '$field'\n" if !defined($raw); + die "No input for '$field'\n" if $raw eq ''; + ##################################################### + + + # 'False' values get returned as themselves with no warnings. + # return $self->{__lastval} unless $self->{__lastval}; + + my $handler = $module->_new($self, $raw); + + my $clean = eval { $handler->_untaint }; + if ($@) { # Give sensible death message + die "$field ($raw) does not untaint with default pattern\n" + if $@ =~ /^Died at/; + die $@; + } + + #---------------------------------------------------------------------- + # Are we doing a validation check? + #---------------------------------------------------------------------- + unless ($skip_valid) { + if (my $ref = $handler->can('is_valid')) { + die "$field ($raw) does not pass the is_valid() check\n" + unless $handler->$ref(); + } + } + + return $handler->untainted; +} + +=head1 BUGS + +None known yet. + +=head1 SEE ALSO + +L. L. L. + +=head1 AUTHOR + +Peter Speltz but most code was ripped from CGI::Untaint. + +=head1 BUGS and QUERIES + +Please direct all correspondence regarding this module to: + peterspeltz@cafes.net or bug-CGI-UntaintPatched@rt.cpan.org + +=head1 COPYRIGHT and LICENSE + +Copyright (C) 2005 Peter Speltz. All rights reserved. + +This module is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; -- 2.39.5