test.tmpl

##

#!/usr/bin/perl -wT
# test3a.pl
use CGI;
use strict;
use Test::Simple tests => 11;
use Scalar::Util qw(tainted);
my $c = CGI->new();

pr($c->header());
pr($c->start_html());
pr("print world");
pr($c->param());
pr($c->param("blah"));
pr($c->hidden(-name=>"blah"));
pr($c->start_form());
pr($c->self_url());
pr($c->submit());
pr($c->end_form());
pr($c->end_html());

sub pr {
    my @thingy = shift;
    foreach my $t (@thingy) {
        ok(!tainted($t), $t);
    }
}

##

##

C:\Users\SilasTheMonk\Downloads\Documents\paranoia>perl -T test3a.pl blah=hello
1..11
ok 1 - Content-Type: text/html; charset=ISO-8859-1
#
#
ok 2 - 
# 
# 
# Untitled Document
# 
# 
# 
#
ok 3 - print world
not ok 4 - blah
#   Failed test 'blah'
#   at test3a.pl line 23.
not ok 5 - hello
#   Failed test 'hello'
#   at test3a.pl line 23.
not ok 6 - 
#   Failed test ''
#   at test3a.pl line 23.
not ok 7 - 
#
#   Failed test '
# '
#   at test3a.pl line 23.
not ok 8 - http://localhost?blah=hello
#   Failed test 'http://localhost?blah=hello'
#   at test3a.pl line 23.
ok 9 - 
ok 10 - 
ok 11 -
# 
# 
# Looks like you failed 5 tests of 11.

##

##

package CGI::Taintless;

use vars qw(@ISA);

sub new {
    my $class = shift;

    # inherit from a CGI hash-based object, to which we default many CGI operations
    my $self = shift; # must be something conforming to CGI interface
    my $uclass = ref($self);
    @ISA = ($uclass);

    die "I am going in circles" if $uclass eq $class;

    $self->{__Taintless_taint_handlers} = shift || {}; # must be a param => taint handler mapping
    my $max_param_len = shift || 10;
    $self->{__Taintless_param_check} = "^\(\[\\w\\\_\]\{1\,$max_param_len\}\)\$";

    bless $self, $class;
    return $self;
}

sub param {
    my $self = shift;
    if (scalar(@_) == 0) {
        # must only allow alphanumeric parameters for which we have taint handlers
        my @params = $self->SUPER::param();
        my @filtered = ();
        foreach my $p (@params) {
            if ($self->get_re($p)) {
                push @filtered, $1 if $p =~ /$self->{__Taintless_param_check}/;
            }
        }
        return @filtered;
    }
    elsif (scalar(@_) == 1) { # will be tainted
        my $p = shift;
        my $v = $self->SUPER::param($p);
        return undef unless defined($v); # need this line to deal with the .cgifields parameter
        my $re = $self->get_re($p) || die "Cannot find taint handler for $p";
        return $1 if $v =~ /$re/;
        die "$p does not pass taint check"
    }
    else {
        $self->SUPER::param(@_);
    }

}

sub get_re {
    my $self = shift;
    my $p = shift;
    if (exists $self->{__Taintless_taint_handlers}->{$p}) {
        return $self->{__Taintless_taint_handlers}->{$p};
    }
    elsif (exists $self->{__Taintless_taint_handlers}->{-DEFAULT_HANDLER}) {
        return $self->{__Taintless_taint_handlers}->{-DEFAULT_HANDLER};
    }
    return undef;
}

1

##

##

#!/usr/bin/perl -wT
# test3.pl
use CGI;
use Test::Simple tests => 11;
use Scalar::Util qw(tainted);
use lib qw(...........); # set this as appropriate.
use CGI::Taintless;
my $q = CGI->new();
my $c = CGI::Taintless->new($q, {blah=>'^([helo]+)$'});

pr($c->header());
pr($c->start_html());
pr("print world");
pr($c->param());
pr($c->param("blah"));
pr($c->hidden(-name=>"blah"));
pr($c->start_form());
pr($c->self_url());
pr($c->submit());
pr($c->end_form());
pr($c->end_html());

sub pr {
    my @thingy = shift;
    foreach my $t (@thingy) {
        ok(!tainted($t), $t);
    }
}