/usr/share/perl5/CGI/Untaint/object.pm is in libcgi-untaint-perl 1.26-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 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;
|