r37696 - in /branches/upstream/libcgi-untaint-perl: ./ current/ current/lib/ current/lib/CGI/ current/lib/CGI/Untaint/ current/t/
bartm at users.alioth.debian.org
bartm at users.alioth.debian.org
Sat Jun 6 17:28:45 UTC 2009
Author: bartm
Date: Sat Jun 6 17:28:40 2009
New Revision: 37696
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=37696
Log:
[svn-inject] Installing original source of libcgi-untaint-perl
Added:
branches/upstream/libcgi-untaint-perl/
branches/upstream/libcgi-untaint-perl/current/
branches/upstream/libcgi-untaint-perl/current/Changes
branches/upstream/libcgi-untaint-perl/current/MANIFEST
branches/upstream/libcgi-untaint-perl/current/META.yml
branches/upstream/libcgi-untaint-perl/current/Makefile.PL
branches/upstream/libcgi-untaint-perl/current/README
branches/upstream/libcgi-untaint-perl/current/lib/
branches/upstream/libcgi-untaint-perl/current/lib/CGI/
branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/
branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint.pm
branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/hex.pm
branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/integer.pm
branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/object.pm
branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/printable.pm
branches/upstream/libcgi-untaint-perl/current/t/
branches/upstream/libcgi-untaint-perl/current/t/01.t
branches/upstream/libcgi-untaint-perl/current/t/apache.t
branches/upstream/libcgi-untaint-perl/current/t/empty.t
branches/upstream/libcgi-untaint-perl/current/t/mypath.t
branches/upstream/libcgi-untaint-perl/current/t/pod-coverage.t
branches/upstream/libcgi-untaint-perl/current/t/pod.t
branches/upstream/libcgi-untaint-perl/current/t/printable.t
branches/upstream/libcgi-untaint-perl/current/t/setval.t
branches/upstream/libcgi-untaint-perl/current/t/twodigit.t
Added: branches/upstream/libcgi-untaint-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/Changes?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/Changes (added)
+++ branches/upstream/libcgi-untaint-perl/current/Changes Sat Jun 6 17:28:40 2009
@@ -1,0 +1,74 @@
+Revision history for Perl extension CGI::Untaint.
+
+1.26 Tue Sep 20 22:13:21 UTC 2005
+ - allow 'printable' strings to be empty [Michael Reece]
+
+1.25 December 27 2004
+ - add test to make sure that false values which don't pass the
+ regex test are handled correctly [Mark Fowler]
+
+1.24 December 27 2004
+ - Correctly handle false values [reported by Mark Fowler]
+
+1.23 December 27 2004
+ - fix INCLUDE_PATH bugs: it's a prefix, not a physical path on
+ disk
+
+1.22 December 27 2004
+ - store raw data in sub-hash, rather than direct in object
+ - clean out lots of obsolete code
+
+1.21 December 27 2004
+ - document the error() method [Mark Fowler]
+ - allow 'printable' to include tabs [Dana Hudes]
+
+1.20 December 27 2004
+ - remove an 'our' for 5.005 compatability [Drew Taylor]
+
+1.1 August 26 2003
+ - don't clobber people's 'value' key
+
+1.0 August 6 2003
+ - handle case where $q->Vars is empty
+
+0.9 February 5, 2003
+ - handle Apache::Table better when we have no config hash
+ (thanks to domm)
+ - better portability
+ - reference Test::CGI::Untaint
+
+0.83 January 27, 2002
+ - cope with UNIVERSAL::require API change
+
+0.82 December 16, 2001
+ - add reference to CGI::Untaint::isbn
+
+0.81 December 8, 2001
+ - add 'hex' pattern
+ - fix spelling of parameter in error message
+
+0.8 November 28, 2001
+ - make tests work with latest Test::More
+
+0.09 November 10, 2001
+ - list available handlers from CPAN
+
+0.08 November 9, 2001
+ - empty values always extract OK
+
+0.07 October 5, 2001
+ - value is now settable in the validation routine
+ - untainting now works properly
+
+0.05 August 23, 2001
+ - added the ability to specify an INCLUDE_PATH
+ - fixed bug in (undocumented) credit_card handler
+ - added 'printable'
+
+0.02 August 22, 2001
+ - added 'postcode'
+
+0.01 June 2001
+ - original version
+
+
Added: branches/upstream/libcgi-untaint-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/MANIFEST?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/MANIFEST (added)
+++ branches/upstream/libcgi-untaint-perl/current/MANIFEST Sat Jun 6 17:28:40 2009
@@ -1,0 +1,19 @@
+Changes
+lib/CGI/Untaint.pm
+lib/CGI/Untaint/hex.pm
+lib/CGI/Untaint/integer.pm
+lib/CGI/Untaint/object.pm
+lib/CGI/Untaint/printable.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml Module meta-data (added by MakeMaker)
+README
+t/01.t
+t/apache.t
+t/empty.t
+t/mypath.t
+t/pod-coverage.t
+t/pod.t
+t/printable.t
+t/setval.t
+t/twodigit.t
Added: branches/upstream/libcgi-untaint-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/META.yml?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/META.yml (added)
+++ branches/upstream/libcgi-untaint-perl/current/META.yml Sat Jun 6 17:28:40 2009
@@ -1,0 +1,12 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: CGI-Untaint
+version: 1.26
+version_from: lib/CGI/Untaint.pm
+installdirs: site
+requires:
+ Test::More: 0.11
+ UNIVERSAL::require: 0.01
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: branches/upstream/libcgi-untaint-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/Makefile.PL?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/Makefile.PL (added)
+++ branches/upstream/libcgi-untaint-perl/current/Makefile.PL Sat Jun 6 17:28:40 2009
@@ -1,0 +1,12 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'CGI::Untaint',
+ 'AUTHOR' => 'Tony Bowden <tmtm at cpan.org>',
+ 'ABSTRACT_FROM' => 'lib/CGI/Untaint.pm',
+ 'VERSION_FROM' => 'lib/CGI/Untaint.pm',
+ 'PREREQ_PM' => {
+ 'Test::More' => 0.11,
+ 'UNIVERSAL::require' => 0.01,
+ },
+);
Added: branches/upstream/libcgi-untaint-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/README?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/README (added)
+++ branches/upstream/libcgi-untaint-perl/current/README Sat Jun 6 17:28:40 2009
@@ -1,0 +1,180 @@
+NAME
+ CGI::Untaint - process CGI input parameters
+
+SYNOPSIS
+ use CGI::Untaint;
+
+ my $q = new CGI;
+ my $handler = CGI::Untaint->new( $q->Vars );
+ my $handler2 = CGI::Untaint->new({
+ INCLUDE_PATH => 'My::Untaint',
+ }, $apr->parms);
+
+ my $name = $handler->extract(-as_printable => 'name');
+ my $homepage = $handler->extract(-as_url => 'homepage');
+
+ my $postcode = $handler->extract(-as_postcode => 'address6');
+
+ # Create your own handler...
+
+ package MyRecipes::CGI::Untaint::legal_age;
+ use base 'CGI::Untaint::integer';
+ sub is_valid {
+ shift->value > 21;
+ }
+
+ package main;
+ my $age = $handler->extract(-as_legal_age => 'age');
+
+DESCRIPTION
+ Dealing with large web based applications with multiple forms is a
+ minefield. It's often hard enough to ensure you validate all your input
+ at all, without having to worry about doing it in a consistent manner.
+ If any of the validation rules change, you often have to alter them in
+ many different places. And, if you want to operate taint-safe, then
+ you're just adding even more headaches.
+
+ This module provides a simple, convenient, abstracted and extensible
+ manner for validating and untainting the input from web forms.
+
+ You simply create a handler with a hash of your parameters (usually
+ $q->Vars), and then iterate over the fields you wish to extract,
+ performing whatever validations you choose. The resulting variable is
+ guaranteed not only to be valid, but also untainted.
+
+CONSTRUCTOR
+ new
+ my $handler = CGI::Untaint->new( $q->Vars );
+ my $handler2 = CGI::Untaint->new({
+ INCLUDE_PATH => 'My::Untaint',
+ }, $apr->parms);
+
+ The simplest way to contruct an input handler is to pass a hash of
+ parameters (usually $q->Vars) to new(). Each parameter will then be able
+ to be extracted later by calling an extract() method on it.
+
+ However, you may also pass a leading reference to a hash of
+ configuration variables.
+
+ Currently the only such variable supported is 'INCLUDE_PATH', which
+ allows you to specify a local path in which to find extraction handlers.
+ See "LOCAL EXTRACTION HANDLERS".
+
+METHODS
+ extract
+ my $homepage = $handler->extract(-as_url => 'homepage');
+ my $state = $handler->extract(-as_us_state => 'address4');
+ my $state = $handler->extract(-as_like_us_state => 'address4');
+
+ Once you have constructed your Input Handler, you call the 'extract'
+ method on each piece of data with which you are concerned.
+
+ The takes an -as_whatever flag to state what type of data you require.
+ This will check that the input value correctly matches the required
+ specification, and return an untainted value. It will then call the
+ is_valid() method, where applicable, to ensure that this doesn't just
+ _look_ like a valid value, but actually is one.
+
+ If you want to skip this stage, then you can call -as_like_whatever
+ which will perform the untainting but not the validation.
+
+ error
+ my $error = $handler->error;
+
+ If the validation failed, this will return the reason why.
+
+LOCAL EXTRACTION HANDLERS
+ As well as as the handlers supplied with this module for extracting
+ data, you may also create your own. In general these should inherit from
+ 'CGI::Untaint::object', and must provide an '_untaint_re' method which
+ returns a compiled regular expression, suitably bracketed such that $1
+ will return the untainted value required.
+
+ e.g. if you often extract single digit variables, you could create
+
+ package My::Untaint::digit;
+
+ use base 'CGI::Untaint::object';
+
+ sub _untaint_re { qr/^(\d)$/ }
+
+ 1;
+
+ You should specify the path 'My::Untaint' in the INCLUDE_PATH
+ configuration option. (See new() above.)
+
+ When extract() is called CGI::Untaint will also check to see if you have
+ an is_valid() method also, and if so will run this against the value
+ extracted from the regular expression (available as $self->value).
+
+ If this returns a true value, then the extracted value will be returned,
+ otherwise we return undef.
+
+ is_valid() can also modify the value being returned, by assigning
+ $self->value($new_value)
+
+ e.g. in the above example, if you sometimes need to ensure that the
+ digit extracted is prime, you would supply:
+
+ sub is_valid { (1 x shift->value) !~ /^1?$|^(11+?)\1+$/ };
+
+ Now, when users call extract(), it will also check that the value is
+ valid(), i.e. prime:
+
+ my $number = $handler->extract(-as_digit => 'value');
+
+ A user wishing to skip the validation, but still ensure untainting can
+ call
+
+ my $number = $handler->extract(-as_like_digit => 'value');
+
+ Test::CGI::Untaint
+ If you create your own local handlers, then you may wish to explore
+ Test::CGI::Untaint, available from the CPAN. This makes it very easy to
+ write tests for your handler. (Thanks to Profero Ltd.)
+
+AVAILABLE HANDLERS
+ This package comes with the following simplistic handlers:
+
+ printable - a printable string
+ integer - an integer
+ hex - a hexadecimal number (as a string)
+
+ To really make this work for you you either need to write, or download
+ from CPAN, other handlers. Some of the handlers available on CPAN
+ include:
+
+ asin - an Amazon ID
+ boolean - boolean value
+ country - a country code or name
+ creditcard - a credit card number
+ date - a date (into a Date::Simple)
+ datetime - a date (into a DateTime)
+ email - an email address
+ hostname - a DNS host name
+ html - sanitized HTML
+ ipaddress - an IP address
+ isbn - an ISBN
+ uk_postcode - a UK Postcode
+ url - a URL
+ zipcode - a US zipcode
+
+BUGS
+ None known yet.
+
+SEE ALSO
+ CGI. perlsec. Test::CGI::Untaint.
+
+AUTHOR
+ Tony Bowden
+
+BUGS and QUERIES
+ Please direct all correspondence regarding this module to:
+ bug-CGI-Untaint at rt.cpan.org
+
+COPYRIGHT and LICENSE
+ Copyright (C) 2001-2005 Tony Bowden. All rights reserved.
+
+ This module is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
Added: branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint.pm?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint.pm (added)
+++ branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint.pm Sat Jun 6 17:28:40 2009
@@ -1,0 +1,332 @@
+package CGI::Untaint;
+
+$VERSION = '1.26';
+
+=head1 NAME
+
+CGI::Untaint - process CGI input parameters
+
+=head1 SYNOPSIS
+
+ use CGI::Untaint;
+
+ my $q = new CGI;
+ my $handler = CGI::Untaint->new( $q->Vars );
+ my $handler2 = CGI::Untaint->new({
+ INCLUDE_PATH => 'My::Untaint',
+ }, $apr->parms);
+
+ my $name = $handler->extract(-as_printable => 'name');
+ my $homepage = $handler->extract(-as_url => 'homepage');
+
+ my $postcode = $handler->extract(-as_postcode => 'address6');
+
+ # Create your own handler...
+
+ package MyRecipes::CGI::Untaint::legal_age;
+ use base 'CGI::Untaint::integer';
+ sub is_valid {
+ shift->value > 21;
+ }
+
+ package main;
+ my $age = $handler->extract(-as_legal_age => 'age');
+
+=head1 DESCRIPTION
+
+Dealing with large web based applications with multiple forms is a
+minefield. It's often hard enough to ensure you validate all your
+input at all, without having to worry about doing it in a consistent
+manner. If any of the validation rules change, you often have to alter
+them in many different places. And, if you want to operate taint-safe,
+then you're just adding even more headaches.
+
+This module provides a simple, convenient, abstracted and extensible
+manner for validating and untainting the input from web forms.
+
+You simply create a handler with a hash of your parameters (usually
+$q->Vars), and then iterate over the fields you wish to extract,
+performing whatever validations you choose. The resulting variable is
+guaranteed not only to be valid, but also untainted.
+
+=cut
+
+use strict;
+use Carp;
+use UNIVERSAL::require;
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+ my $handler = CGI::Untaint->new( $q->Vars );
+ my $handler2 = CGI::Untaint->new({
+ INCLUDE_PATH => 'My::Untaint',
+ }, $apr->parms);
+
+The simplest way to contruct an input handler is to pass a hash of
+parameters (usually $q->Vars) to new(). Each parameter will then be able
+to be extracted later by calling an extract() method on it.
+
+However, you may also pass a leading reference to a hash of configuration
+variables.
+
+Currently the only such variable supported is 'INCLUDE_PATH', which
+allows you to specify a local path in which to find extraction handlers.
+See L<LOCAL EXTRACTION HANDLERS>.
+
+=cut
+
+sub new {
+ my $class = shift;
+
+ # want to cope with any of:
+ # (%vals), (\%vals), (\%config, %vals) or (\%config, \%vals)
+ # but %vals could also be an object ...
+ my ($vals, $config);
+
+ if (@_ == 1) {
+
+ # only one argument - must be either hashref or obj.
+ $vals = ref $_[0] eq "HASH" ? shift: { %{ +shift } }
+
+ } elsif (@_ > 2) {
+
+ # Conf + Hash or Hash
+ $config = shift if ref $_[0] eq "HASH";
+ $vals = {@_}
+
+ } else {
+
+ # Conf + Hashref or 1 key hash
+ ref $_[0] eq "HASH" ? ($config, $vals) = @_ : $vals = {@_};
+ }
+
+ bless {
+ __config => $config,
+ __data => $vals,
+ } => $class;
+
+}
+
+=head1 METHODS
+
+=head2 extract
+
+ my $homepage = $handler->extract(-as_url => 'homepage');
+ my $state = $handler->extract(-as_us_state => 'address4');
+ my $state = $handler->extract(-as_like_us_state => 'address4');
+
+Once you have constructed your Input Handler, you call the 'extract'
+method on each piece of data with which you are concerned.
+
+The takes an -as_whatever flag to state what type of data you
+require. This will check that the input value correctly matches the
+required specification, and return an untainted value. It will then call
+the is_valid() method, where applicable, to ensure that this doesn't
+just _look_ like a valid value, but actually is one.
+
+If you want to skip this stage, then you can call -as_like_whatever
+which will perform the untainting but not the validation.
+
+=cut
+
+sub extract {
+ my $self = shift;
+ $self->{_ERR} = "";
+ my $val = eval { $self->_do_extract(@_) };
+ if ($@) {
+ chomp($self->{_ERR} = $@);
+ return;
+ }
+ return $val;
+}
+
+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.
+ #----------------------------------------------------------------------
+ defined(my $raw = $self->{__data}->{$field})
+ or die "No parameter for '$field'\n";
+
+ # '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;
+}
+
+=head2 error
+
+ my $error = $handler->error;
+
+If the validation failed, this will return the reason why.
+
+=cut
+
+sub error { $_[0]->{_ERR} }
+
+sub _load_module {
+ my $self = shift;
+ my $name = $self->_get_module_name(shift());
+
+ foreach
+ my $prefix (grep defined, "CGI::Untaint", $self->{__config}{INCLUDE_PATH})
+ {
+ my $mod = "$prefix\::$name";
+ return $self->{__loaded}{$mod} if defined $self->{__loaded}{$mod};
+ eval {
+ $mod->require;
+ $mod->can('_untaint') or die;
+ };
+ return $self->{__loaded}{$mod} = $mod unless $@;
+ }
+ die "Can't find extraction handler for $name\n";
+}
+
+# Convert the -as_whatever to a FQ module name
+sub _get_module_name {
+ my $self = shift;
+ (my $handler = shift) =~ s/^-as_//;
+ return $handler;
+}
+
+=head1 LOCAL EXTRACTION HANDLERS
+
+As well as as the handlers supplied with this module for extracting
+data, you may also create your own. In general these should inherit from
+'CGI::Untaint::object', and must provide an '_untaint_re' method which
+returns a compiled regular expression, suitably bracketed such that $1
+will return the untainted value required.
+
+e.g. if you often extract single digit variables, you could create
+
+ package My::Untaint::digit;
+
+ use base 'CGI::Untaint::object';
+
+ sub _untaint_re { qr/^(\d)$/ }
+
+ 1;
+
+You should specify the path 'My::Untaint' in the INCLUDE_PATH
+configuration option. (See new() above.)
+
+When extract() is called CGI::Untaint will also check to see if you have
+an is_valid() method also, and if so will run this against the value
+extracted from the regular expression (available as $self->value).
+
+If this returns a true value, then the extracted value will be returned,
+otherwise we return undef.
+
+is_valid() can also modify the value being returned, by assigning
+ $self->value($new_value)
+
+e.g. in the above example, if you sometimes need to ensure that the
+digit extracted is prime, you would supply:
+
+ sub is_valid { (1 x shift->value) !~ /^1?$|^(11+?)\1+$/ };
+
+Now, when users call extract(), it will also check that the value
+is valid(), i.e. prime:
+
+ my $number = $handler->extract(-as_digit => 'value');
+
+A user wishing to skip the validation, but still ensure untainting can
+call
+
+ my $number = $handler->extract(-as_like_digit => 'value');
+
+=head2 Test::CGI::Untaint
+
+If you create your own local handlers, then you may wish to explore
+L<Test::CGI::Untaint>, available from the CPAN. This makes it very easy
+to write tests for your handler. (Thanks to Profero Ltd.)
+
+=head1 AVAILABLE HANDLERS
+
+This package comes with the following simplistic handlers:
+
+ printable - a printable string
+ integer - an integer
+ hex - a hexadecimal number (as a string)
+
+To really make this work for you you either need to write, or download
+from CPAN, other handlers. Some of the handlers available on CPAN include:
+
+ asin - an Amazon ID
+ boolean - boolean value
+ country - a country code or name
+ creditcard - a credit card number
+ date - a date (into a Date::Simple)
+ datetime - a date (into a DateTime)
+ email - an email address
+ hostname - a DNS host name
+ html - sanitized HTML
+ ipaddress - an IP address
+ isbn - an ISBN
+ uk_postcode - a UK Postcode
+ url - a URL
+ zipcode - a US zipcode
+
+=head1 BUGS
+
+None known yet.
+
+=head1 SEE ALSO
+
+L<CGI>. L<perlsec>. L<Test::CGI::Untaint>.
+
+=head1 AUTHOR
+
+Tony Bowden
+
+=head1 BUGS and QUERIES
+
+Please direct all correspondence regarding this module to:
+ bug-CGI-Untaint at rt.cpan.org
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2001-2005 Tony Bowden. 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;
Added: branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/hex.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/hex.pm?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/hex.pm (added)
+++ branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/hex.pm Sat Jun 6 17:28:40 2009
@@ -1,0 +1,36 @@
+package CGI::Untaint::hex;
+
+use strict;
+use base 'CGI::Untaint::object';
+
+sub _untaint_re {
+ qr/^\s*([abcdef1234567890]+)\s*$/i
+}
+
+=head1 NAME
+
+CGI::Untaint::hex - validate as a hexadecimal value
+
+=head1 SYNOPSIS
+
+ my $id = $handler->extract(-as_hex => 'hexvalue');
+
+=head1 DESCRIPTION
+
+This Input Handler verifies that it is dealing with a hexadecimal
+value.
+
+=head1 AUTHOR
+
+Tony Bowden, E<lt>kasei at tmtm.comE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Tony Bowden. 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;
Added: branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/integer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/integer.pm?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/integer.pm (added)
+++ branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/integer.pm Sat Jun 6 17:28:40 2009
@@ -1,0 +1,34 @@
+package CGI::Untaint::integer;
+
+use strict;
+use base 'CGI::Untaint::object';
+sub _untaint_re { qr/^([+-]?\d+)$/ }
+
+=head1 NAME
+
+CGI::Untaint::integer - validate an integer
+
+=head1 SYNOPSIS
+
+ my $age = $handler->extract(-as_integer => 'age');
+
+=head1 DESCRIPTION
+
+This Input Handler verifies that it is dealing with an integer.
+The integer can be positive or negative, but only in a basic format
+(i.e. a string of digits). It will not accept exponentials.
+
+=head1 AUTHOR
+
+Tony Bowden, E<lt>kasei at tmtm.comE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Tony Bowden. 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;
Added: branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/object.pm?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/object.pm (added)
+++ branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/object.pm Sat Jun 6 17:28:40 2009
@@ -1,0 +1,96 @@
+package CGI::Untaint::object;
+
+=head1 NAME
+
+CGI::Untaint::object - base class for Input Handlers
+
+=head1 SYNOPSIS
+
+ package MyUntaint::foo;
+
+ use base 'CGI::Untaint::object';
+
+ sub _untaint_re {
+ return qr/$your_regex/;
+ }
+
+ sub is_valid {
+ my $self = shift;
+ return is_ok($self->value);
+ }
+
+ 1;
+
+=head1 DESCRIPTION
+
+This is the base class that all Untaint objects should inherit
+from.
+
+=cut
+
+use strict;
+
+sub _new {
+ my ($class, $h, $raw) = @_;
+ bless {
+ _obj => $h,
+ _raw => $raw,
+ _clean => undef,
+ } => $class;
+}
+
+=head1 METHODS TO SUBCLASS
+
+=head2 is_valid / _untaint_re
+
+Your subclass should either provide a regular expression in _untaint_re
+(and yes, I should really make this public), or an entire is_valid method.
+
+=cut
+
+sub is_valid { 1 }
+
+=head1 METHODS TO CALL
+
+=head2 value
+
+This should really have been two methods, but too many other modules
+now rely on the fact that this does double duty. As an accessor, this
+is the 'raw' value. As a mutator it's the extracted one.
+
+=cut
+
+sub value {
+ my $self = shift;
+ $self->{_clean} = shift if defined $_[0];
+ $self->{_raw};
+}
+
+sub _untaint {
+ my $self = shift;
+ my $re = $self->_untaint_re;
+ die unless $self->value =~ $self->_untaint_re;
+ $self->value($1);
+ return 1;
+}
+
+=head2 re_all / re_none
+
+Regular expressions to match anything, or nothing, untained. These should
+only be used if you have already validated your entry in some way that
+means you completely trust the data.
+
+=cut
+
+sub re_all { qr/(.*)/ }
+sub re_none { qr/(?!)/ }
+
+=head2 untainted
+
+Are we clean yet?
+
+=cut
+
+sub untainted { shift->{_clean} }
+
+1;
Added: branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/printable.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/printable.pm?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/printable.pm (added)
+++ branches/upstream/libcgi-untaint-perl/current/lib/CGI/Untaint/printable.pm Sat Jun 6 17:28:40 2009
@@ -1,0 +1,30 @@
+package CGI::Untaint::printable;
+
+use strict;
+use base 'CGI::Untaint::object';
+
+sub _untaint_re {
+ qr/^([\040-\377\r\n\t]*)$/;
+}
+
+=head1 NAME
+
+CGI::Untaint::printable - validate as a printable value
+
+=head1 SYNOPSIS
+
+ my $name = $handler->extract(-as_printable => 'name');
+
+=head1 DESCRIPTION
+
+This Input Handler verifies that it is dealing with an 'printable'
+string i.e. characters in the range \040-\377 (plus \r and \n).
+
+The empty string is taken to be printable.
+
+This is occasionally a useful 'fallback' pattern, but in general you
+will want to write your own patterns to be stricter.
+
+=cut
+
+1;
Added: branches/upstream/libcgi-untaint-perl/current/t/01.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/t/01.t?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/t/01.t (added)
+++ branches/upstream/libcgi-untaint-perl/current/t/01.t Sat Jun 6 17:28:40 2009
@@ -1,0 +1,55 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 24;
+
+use strict;
+use CGI;
+use CGI::Untaint;
+
+my $data = {
+ name => "Tony Bowden",
+ age => 110,
+ value => -10,
+ count => "0",
+ hex => "a15b",
+};
+
+my %type = (
+ name => 'printable',
+ age => 'integer',
+ value => 'integer',
+ hex => 'hex',
+ count => 'printable',
+);
+
+{
+ my $q = CGI->new($data);
+ ok my $h = CGI::Untaint->new($q->Vars), "Create the handler";
+ isa_ok $h, "CGI::Untaint";
+ foreach (sort keys %type) {
+ ok defined(my $res = $h->extract("-as_$type{$_}" => $_)), "Extract $_";
+ is $res, $data->{$_}, " - Correct value ($_ = $data->{$_})";
+ is $h->error, '', "No error";
+ }
+ my $foo = $h->extract(-as_printable => 'foo');
+ ok !$foo, "No Foo";
+ is $h->error, "No parameter for 'foo'", "No error";
+}
+
+{
+ local $data->{hex} = "a15g";
+ my $q = CGI->new($data);
+ ok my $h = CGI::Untaint->new($q->Vars), "Create the handler";
+ my $hex = $h->extract(-as_hex => 'hex');
+ ok !$hex, "Invalid hex";
+ like $h->error, qr/does not untaint with default pattern/, $h->error;
+}
+
+{
+ my $data = {};
+ my $q = CGI->new($data);
+ ok my $h = CGI::Untaint->new($q->Vars), "Create an empty handler";
+ my $hex = $h->extract(-as_hex => 'hex');
+ ok !$hex, "No hex in it";
+}
+
Added: branches/upstream/libcgi-untaint-perl/current/t/apache.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/t/apache.t?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/t/apache.t (added)
+++ branches/upstream/libcgi-untaint-perl/current/t/apache.t Sat Jun 6 17:28:40 2009
@@ -1,0 +1,45 @@
+#!/usr/bin/perl -w
+
+use strict;
+use CGI;
+use CGI::Untaint;
+
+use Test::More tests => 20;
+
+my $data = {
+ name => "Tony Bowden",
+ age => 110,
+};
+
+package My::Apache::Table;
+sub new { bless $data, shift }
+sub name { shift->{name} }
+sub age { shift->{name} }
+sub parms { shift; }
+
+package main;
+
+my %type = (
+ name => 'printable',
+ age => 'integer',
+);
+
+{
+ my $apr = My::Apache::Table->new();
+ my %h = (
+ args => CGI::Untaint->new( {}, $apr ),
+ noargs => CGI::Untaint->new( $apr ),
+ );
+ for my $type (sort keys %h) {
+ ok my $h = $h{$type}, "*** handler for $type ***";
+ isa_ok $h, "CGI::Untaint";
+ foreach (keys %type) {
+ ok my $res = $h->extract("-as_$type{$_}" => $_), "$type: Extract $_";
+ is $res, $data->{$_}, "$type: - Correct value";
+ is $h->error, '', "$type: No error";
+ }
+ my $foo = $h->extract(-as_printable => 'foo');
+ ok !$foo, "$type: No Foo";
+ is $h->error, "No parameter for 'foo'", "$type: No error";
+ }
+}
Added: branches/upstream/libcgi-untaint-perl/current/t/empty.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/t/empty.t?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/t/empty.t (added)
+++ branches/upstream/libcgi-untaint-perl/current/t/empty.t Sat Jun 6 17:28:40 2009
@@ -1,0 +1,19 @@
+#!/usr/bin/perl
+
+use CGI::Untaint;
+use Test::More tests => 4;
+
+my %params = ( foo => '', bar => undef);
+my $h = CGI::Untaint->new({ %params });
+
+{
+ my $foo = $h->extract(-as_printable => 'foo');
+ is $foo, '', "Extract empty text";
+ ok !$h->error, "No error";
+}
+
+{
+ my $bar = $h->extract(-as_printable => 'bar');
+ is $bar, undef, "Extract undef";
+ like $h->error, qr/No param/, "No parameter with undef";
+}
Added: branches/upstream/libcgi-untaint-perl/current/t/mypath.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/t/mypath.t?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/t/mypath.t (added)
+++ branches/upstream/libcgi-untaint-perl/current/t/mypath.t Sat Jun 6 17:28:40 2009
@@ -1,0 +1,42 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+use CGI;
+use CGI::Untaint;
+
+plan tests => 9;
+
+package My::Untaint::prime;
+
+use base 'CGI::Untaint::object';
+
+sub _untaint_re { qr/^(\d)$/ }
+sub is_valid { (1 x shift->value) !~ /^1?$|^(11+?)\1+$/ }
+
+package main;
+
+my $q = CGI->new(
+ {
+ ok => 6,
+ not => 10,
+ prime => 7,
+ notprime => 8,
+ }
+);
+
+ok(my $data = CGI::Untaint->new({ INCLUDE_PATH => "My::Untaint" }, $q->Vars),
+ "Can create the handler, with INCLUDE_PATH");
+
+is($data->extract("-as_like_prime" => 'ok'), 6, '6 passes "like" test');
+is $data->error, '', "With no errors";
+
+ok(!$data->extract("-as_like_prime" => 'not'), '10 fails (not single digit)');
+is($data->error, "not (10) does not untaint with default pattern", " - with suitable error");
+
+is($data->extract("-as_prime" => 'prime'), 7, '7 passes prime test');
+is $data->error, '', "And we have no errors";
+
+ok(!$data->extract("-as_prime" => 'notprime'), '8 fails prime test');
+is($data->error, 'notprime (8) does not pass the is_valid() check', " - with suitable error");
+
Added: branches/upstream/libcgi-untaint-perl/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/t/pod-coverage.t?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/t/pod-coverage.t (added)
+++ branches/upstream/libcgi-untaint-perl/current/t/pod-coverage.t Sat Jun 6 17:28:40 2009
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: branches/upstream/libcgi-untaint-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/t/pod.t?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/t/pod.t (added)
+++ branches/upstream/libcgi-untaint-perl/current/t/pod.t Sat Jun 6 17:28:40 2009
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
Added: branches/upstream/libcgi-untaint-perl/current/t/printable.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/t/printable.t?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/t/printable.t (added)
+++ branches/upstream/libcgi-untaint-perl/current/t/printable.t Sat Jun 6 17:28:40 2009
@@ -1,0 +1,23 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 6;
+
+use strict;
+use CGI;
+use CGI::Untaint;
+
+my $q = CGI->new({
+ ok => (join '', map chr($_), (32..255)),
+ not => (join '', map chr($_), (0 .. 31)),
+ mix => ("Hello ".chr(17).chr(0)."World"),
+ win => "Hello World\r\nPart 2",
+ tab => "We have\ttabs\tin this one",
+});
+
+ok(my $data = CGI::Untaint->new( $q->Vars ), "Can create the handler");
+
+is($data->extract(-as_printable => 'ok'), $q->param('ok'), 'Printable');
+is($data->extract(-as_printable => 'win'), $q->param('win'), 'Printable');
+ok(!$data->extract(-as_printable => 'not'), 'Not printable');
+ok(!$data->extract(-as_printable => 'mix'), 'Mixed');
+ok($data->extract(-as_printable => 'tab'), 'Tabs');
Added: branches/upstream/libcgi-untaint-perl/current/t/setval.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/t/setval.t?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/t/setval.t (added)
+++ branches/upstream/libcgi-untaint-perl/current/t/setval.t Sat Jun 6 17:28:40 2009
@@ -1,0 +1,30 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+use CGI;
+use CGI::Untaint;
+
+plan tests => 2;
+
+package CGI::Untaint::bigint;
+
+use base 'CGI::Untaint::integer';
+use Math::BigInt;
+
+sub is_valid {
+ my $self = shift;
+ $self->value(Math::BigInt->new($self->value));
+}
+
+package main;
+
+my $q = CGI->new( { num => 6091 });
+
+my $h = CGI::Untaint->new($q->Vars);
+
+my $val = $h->extract(-as_bigint => "num");
+
+ok $val == 6091, "Extract a big int";
+isa_ok $val, "Math::BigInt", "as an object";
+
Added: branches/upstream/libcgi-untaint-perl/current/t/twodigit.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-untaint-perl/current/t/twodigit.t?rev=37696&op=file
==============================================================================
--- branches/upstream/libcgi-untaint-perl/current/t/twodigit.t (added)
+++ branches/upstream/libcgi-untaint-perl/current/t/twodigit.t Sat Jun 6 17:28:40 2009
@@ -1,0 +1,28 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+use CGI;
+use CGI::Untaint;
+
+plan tests => 5;
+
+package CGI::Untaint::twodigit;
+
+use base 'CGI::Untaint::integer';
+
+sub _untaint_re { return qr/^\s*([0-9]{2})\s*$/ }
+
+package main;
+
+my $q = CGI->new( { foo => 12, bar => 0, baz => "" } );
+my $h = CGI::Untaint->new($q->Vars);
+
+is $h->extract(-as_twodigit => "foo"), 12, "12 extracts";
+
+is $h->extract(-as_twodigit => "bar"), undef, "0 doesn't";
+like $h->error, qr/does not untaint/, "With error";
+
+is $h->extract(-as_twodigit => "baz"), undef, "empty string doesn't";
+like $h->error, qr/does not untaint/, "With error";
+
More information about the Pkg-perl-cvs-commits
mailing list