Taint-Runtime-0.03/0000755000175000017500000000000010634300723012616 5ustar paulpaulTaint-Runtime-0.03/t/0000755000175000017500000000000010634300723013061 5ustar paulpaulTaint-Runtime-0.03/t/01_non_xs.t0000644000175000017500000000134510634300122015046 0ustar paulpaul#!perl -T use Test::More tests => 9; BEGIN { use_ok('Taint::Runtime') }; Taint::Runtime->import(qw(taint_enabled taint untaint is_tainted )); ok(taint_enabled(), "Taint is On"); my $data = "foo\nbar"; ok(! is_tainted($data), "No false positive on is_tainted"); my $copy = taint($data); ok(is_tainted($copy), "Made a tainted copy"); taint(\$data); ok(is_tainted($data), "Tainted it directly"); $copy = untaint($data); ok(! is_tainted($copy), "Made a clean copy"); ok($copy eq $data, "And i got all of the data back"); ok(is_tainted($data), "Data is still tainted"); untaint(\$data); ok(! is_tainted($data), "Clean it directly"); Taint-Runtime-0.03/t/Taint-Runtime.t0000644000175000017500000000073510207652206015755 0ustar paulpaul# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Taint-Runtime.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 1; BEGIN { use_ok('Taint::Runtime') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. Taint-Runtime-0.03/t/03_var.t0000644000175000017500000000105310207775022014343 0ustar paulpaul use Test::More tests => 7; BEGIN { use_ok('Taint::Runtime') }; Taint::Runtime->import(qw($TAINT taint_enabled taint untaint is_tainted )); ok(! $TAINT, "Not on"); ok(! taint_enabled(), "Taint is Not on yet"); $TAINT = 1; ok(taint_enabled(), "Taint is On"); $TAINT = 0; ok(! taint_enabled(), "Taint disabled"); { local $TAINT = 1; ok(taint_enabled(), "Taint is On"); } ok(! taint_enabled(), "Taint disabled"); Taint-Runtime-0.03/t/02_xs.t0000644000175000017500000000132410207660640014204 0ustar paulpaul use Test::More tests => 8; BEGIN { use_ok('Taint::Runtime') }; Taint::Runtime->import(qw(taint_start taint_enabled taint untaint is_tainted )); ok(! taint_enabled(), "Taint is Not on yet"); taint_start(); ok(taint_enabled(), "Taint is On"); my $data = "foo"; ok(! is_tainted($data), "No false positive on is_tainted"); my $copy = taint($data); ok(is_tainted($copy), "Made a tainted copy"); taint(\$data); ok(is_tainted($data), "Tainted it directly"); $copy = untaint($data); ok(! is_tainted($copy), "Made a clean copy"); untaint(\$data); ok(! is_tainted($data), "Clean it directly"); Taint-Runtime-0.03/t/04_enable.t0000644000175000017500000000037210210152051014766 0ustar paulpaul use Test::More tests => 4; BEGIN { use_ok('Taint::Runtime') }; Taint::Runtime->import(qw($TAINT)); ok(! $TAINT, "Not on"); Taint::Runtime->import('enable'); ok($TAINT, "Taint is On"); Taint::Runtime->import('disable'); ok(! $TAINT, "Not on"); Taint-Runtime-0.03/t/00_Base.t0000644000175000017500000000073510207656021014425 0ustar paulpaul# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Taint-Runtime.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 1; BEGIN { use_ok('Taint::Runtime') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. Taint-Runtime-0.03/lib/0000755000175000017500000000000010634300723013364 5ustar paulpaulTaint-Runtime-0.03/lib/Taint/0000755000175000017500000000000010634300723014443 5ustar paulpaulTaint-Runtime-0.03/lib/Taint/Runtime.pm0000644000175000017500000002731310634300230016423 0ustar paulpaulpackage Taint::Runtime; =head1 NAME Taint::Runtime - Runtime enable taint checking =cut use strict; use Exporter; use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION $TAINT); use XSLoader; @ISA = qw(Exporter); %EXPORT_TAGS = ( 'all' => [qw( taint_start taint_stop taint_enabled tainted is_tainted taint untaint taint_env taint_deeply $TAINT ) ], ); @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); @EXPORT = qw(taint_start taint_stop); $VERSION = '0.03'; XSLoader::load('Taint::Runtime', $VERSION); ###----------------------------------------------------------------### tie $TAINT, __PACKAGE__; sub TIESCALAR { return bless [], __PACKAGE__; } sub FETCH { _taint_enabled() ? 1 : 0; } sub STORE { my ($self, $val) = @_; $val = 0 if ! $val || $val eq 'disable'; $val ? _taint_start() : _taint_stop(); } ###----------------------------------------------------------------### ### allow for special enable/disable keywords sub import { my $change; for my $i (reverse 1 .. $#_) { next if $_[$i] !~ /^(dis|en)able$/; my $val = $1 eq 'dis' ? 0 : 1; splice @_, $i, 1, (); die 'Cannot both enable and disable $TAINT during import' if defined $change && $change != $val; $TAINT = $val; } __PACKAGE__->export_to_level(1, @_); } ###----------------------------------------------------------------### sub taint_start { _taint_start(); } sub taint_stop { _taint_stop() } sub taint_enabled { _taint_enabled() } sub tainted { _tainted() } sub is_tainted { return if ! defined $_[0]; ! eval { eval '#'.substr($_[0], 0, 0); 1 } } # slower on tainted and undef # modified version from standard lib/perl/5.8.5/tainted.pl sub is_tainted2 { local $^W = 0; local $@; eval { kill 0 * $_[0] }; $@ =~ /^Insecure/ } sub taint { my $str = shift; my $ref = ref($str) ? $str : \$str; $$ref = '' if ! defined $$ref; $$ref .= tainted(); return ref($str) ? 1 : $str; } sub untaint { my $str = shift; my $ref = ref($str) ? $str : \$str; if (! defined $$ref) { $$ref = undef; } else { $$ref = ($$ref =~ /(.*)/s) ? $1 : do { require Carp; Carp::confess("Couldn't find data to untaint") }; } return ref($str) ? 1 : $str; } ###----------------------------------------------------------------### sub taint_env { taint_deeply(\%ENV); } sub taint_deeply { my ($ref, $seen) = @_; return if ! defined $ref; # can undefined be tainted ? if (! ref $ref) { taint \$_[0]; # better be modifyable return; } elsif (UNIVERSAL::isa($ref, 'SCALAR')) { taint $ref; return; } ### avoid circular descent $seen ||= {}; return if $seen->{$ref}; $seen->{$ref} = 1; if (UNIVERSAL::isa($ref, 'ARRAY')) { taint_deeply($_, $seen) foreach @$ref; } elsif (UNIVERSAL::isa($ref, 'HASH')) { while (my ($key, $val) = each %$ref) { taint_deeply($key); taint_deeply($val, $seen); $ref->{$key} = $val; } } else { # not really sure if or what to do for GLOBS or CODE refs } } ###----------------------------------------------------------------### 1; __END__ =head1 SYNOPSIS ### sample "enable" usage #!/usr/bin/perl -w use Taint::Runtime qw(enable taint_env); taint_env(); # having the keyword enable in the import list starts taint ### sample $TAINT usage #!/usr/bin/perl -w use Taint::Runtime qw($TAINT taint_env); $TAINT = 1; taint_env(); # taint is now enabled if (1) { local $TAINT = 0; # do something we trust } # back to an untrustwory area ### sample functional usage #!/usr/bin/perl -w use strict; use Taint::Runtime qw(taint_start is_tainted taint_env taint untaint taint_enabled); ### other operations here taint_start(); # taint should become active taint_env(); # %ENV was previously untainted print taint_enabled() ? "enabled\n" : "not enabled\n"; my $var = taint("some string"); print is_tainted($var) ? "tainted\n" : "not tainted\n"; $var = untaint($var); # OR untaint \$var; print is_tainted($var) ? "tainted\n" : "not tainted\n"; =head1 DESCRIPTION First - you probably shouldn't use this module to control taint. You should probably use the -T switch on the commandline instead. There are a somewhat limited number of legitimate use cases where you should use this module instead of the -T switch. Unless you have a specific and good reason for not using the -T option, you should use the -T option. Taint is a good thing. However, few people (that I work with or talk to or discuss items with) use taint even though they should. The goal of this module isn't to use taint less, but to actually encourage its use more. This module aims to make using taint as painless as possible (This can be an argument against it - often implementation of security implies pain - so taking away pain might lessen security - sort of). In general - the more secure your script needs to be - the earlier on in your program that tainting should be enabled. For most setuid scripts, you should enable taint by using the -T switch. Without doing so you allow for a non-root user to override @INC which allows for them to put their own module in the place of trusted modules. This is bad. This is very bad. Use the -T switch. There are some common places where this module may be useful, and where most people don't use it. One such place is in a web server. The -T switch removes PERL5LIB and PERLLIB and '.' from @INC (or remove them before they can be added). This makes sense under setuid. The use of the -T switch in a CGI environment may cause a bit of a headache. For new development, CGI scripts it may be possible to use the -T switch and for mod_perl environments there is the PerlTaint variable. Both of these methods will enable taint and from that point on development should be done with taint. However, many (possibly most) perl web server implentations add their own paths to the PERL5LIB. All CGI's and mod_perl scripts can then have access. Using the -T switch throws a wrench into the works as suddenly PERL5LIB disappears (mod_perl can easily have the extra directories added again using push @INC, '/our/lib/dir';). The company I work for has 200 plus user visible scripts mixed with some mod_perl. Currently none of the scripts use taint. We would like for them all to, but it is not feasible to make the change all at once. Taint::Runtime allows for moving legacy scripts over one at a time. Again, if you are using setuid - don't use this script. If you are not using setuid and have reasons not to use the -T and are using this module, make sure that taint is enabled before processing any user data. Also remember that BECAUSE THE -T SWITCH WAS NOT USED %ENV IS INITIALLY NOT MARKED AS TAINTED. Call taint_env() to mark it as tainted (especially important in CGI scripts which all read from $ENV{'QUERY_STRING'}). If you are not using the -T switch, you most likely should use the following at the very top of your script: #!/usr/bin/perl -w use strict; use Taint::Runtime qw(enable taint_env); taint_env(); Though this module allows for you to turn taint off - you probably shouldn't. This module is more for you to turn taint on - and once it is on it probably ought to stay on. =head1 NON-EXPORTABLE XS FUNCTIONS The following very basic functions provide the base functionality. =over 4 =item _taint_start() Sets PL_tainting =item _taint_stop() Sets PL_tainting =item _taint_enabled() View of PL_tainting =item _tainted() Returns a zero length tainted string. =back =head1 $TAINT VARIABLE The variable $TAINT is tied to the current state of taint. If $TAINT is set to 0 taint mode is off. When it is set to 1 taint mode is enabled. if (1) { local $TAINT = 1; # taint is enabled } =head1 EXPORT FUNCTIONS =over 4 =item enable/disable Not really functions. If these keywords are in the import list, taint will be either enabled or disabled. =item taint_start Start taint mode. $TAINT will equal 1. =item taint_stop Stop taint mode. $TAINT will equal 0. =item taint_env Convenience function that taints the keys and values of %ENV. If the -T switch was not used - you most likely should call this as soon as taint mode is enabled. =item taint Taints the passed in variable. Only works on writeable scalar values. If a scalar ref is passed in - it is modified. If a scalar is passed in (non ref) it is copied, modified and returned. If a value was undefined, it becomes a zero length defined and tainted string. taint(\$var_to_be_tainted); my $tainted_copy = taint($some_var); For a stronger taint, see the Taint module by Dan Sulgalski which is capable of tainting most types of data. =item untaint Untaints the passed in variable. Only works on writeable scalar values. If a scalar ref is passed in - it is modified. If a scalar is passed in (non ref) it is copied, modified and returned. If a value was undefined it becomes an untainted undefined value. Note: Just because the variable is untainted, doesn't mean that it is safe. You really should use CGI::Ex::Validate, or Data::FormValidator or any of the Untaint:: modules. If you are doing your own validation, and once you have put the user data through very strict checks, then you can use untaint. if ($var_to_be_untainted =~ /^[\w\.\-]{0,100}$/) { untaint(\$var_to_be_untainted); } my $untainted_copy = untaint($some_var); =item taint_enabled Boolean - Is taint on. =item tainted Returns a zero length tainted string. =item is_tainted Boolean - True if the passed value is tainted. =item taint_deeply Convenience function that attempts to deply recurse a structure and mark it as tainted. Takes a hashref, arrayref, scalar ref, or scalar and recursively untaints the structure. For a stronger taint, see the Taint module by Dan Sulgalski which is capable of tainting most types of data. =back =head1 TURNING TAINT ON (Be sure to call taint_env() after turning taint on the first time) #!/usr/bin/perl -T use Taint::Runtime qw(enable); # this does not create a function called enable - just starts taint use Taint::Runtime qw($TAINT); $TAINT = 1; use Taint::Runtime qw(taint_start); taint_start; =head1 TURNING TAINT OFF use Taint::Runtime qw(disable); # this does not create a function called disable - just stops taint use Taint::Runtime qw($TAINT); $TAINT = 0; use Taint::Runtime qw(taint_stop); taint_stop; =head1 CREDITS C code was provided by "hv" on perlmonks. This module wouldn't really be possible without insight into the internals that "hv" provided. His post with the code was shown in this node on perlmonks: http://perlmonks.org/?node_id=434086 The basic premise in that node was the following code: use Inline C => 'void _start_taint() { PL_tainting = 1; }'; use Inline C => 'SV* _tainted() { PL_tainted = 1; return newSVpvn("", 0); }'; In this module, these two lines have instead been turned into XS for runtime speed (and so you won't need Inline and Parse::RecDescent). Note: even though "hv" provided the base code example, that doesn't mean that he necessarily endorses the idea. If there are disagreements, quirks, annoyances or any other negative side effects with this module - blame me - not "hv." =head1 THANKS Thanks to Alexey A. Kiritchun for pointing out untaint failure on multiline strings. =head1 AUTHOR Paul Seamons (2005) C stub functions by "hv" on perlmonks.org =head1 LICENSE This module may be used and distributed under the same terms as Perl itself. =cut Taint-Runtime-0.03/Changes0000644000175000017500000000042410634300343014107 0ustar paulpaulRevision history for Perl extension Taint::Runtime. 0.03 Thu Jun 14 11:54:00 2007 - Fix untaint failure on multiline strings found by Alexey A. Kiritchun. 0.01 Fri Feb 25 09:38:30 2005 - original version; created by h2xs 1.23 with options -A -n Taint::Runtime Taint-Runtime-0.03/MANIFEST0000644000175000017500000000035510634300672013755 0ustar paulpaulChanges is_taint_bench.pl lib/Taint/Runtime.pm Makefile.PL MANIFEST MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) ppport.h README Runtime.xs t/00_Base.t t/01_non_xs.t t/02_xs.t t/03_var.t t/04_enable.t t/Taint-Runtime.t Taint-Runtime-0.03/MANIFEST.SKIP0000644000175000017500000000020510634300667014520 0ustar paulpaulCVS/ blib pm_to_blib .cvsignore Runtime.bs Runtime.c Runtime.o ^tgz/ \.~$ \.# \w#$ \.bak$ Makefile$ Makefile\.old$ \.gz$ tmon\.out Taint-Runtime-0.03/ppport.h0000644000175000017500000007214110207652206014322 0ustar paulpaul /* ppport.h -- Perl/Pollution/Portability Version 2.011 * * Automatically Created by Devel::PPPort on Fri Feb 25 09:38:30 2005 * * Do NOT edit this file directly! -- Edit PPPort.pm instead. * * Version 2.x, Copyright (C) 2001, Paul Marquess. * Version 1.x, Copyright (C) 1999, Kenneth Albanowski. * This code may be used and distributed under the same license as any * version of Perl. * * This version of ppport.h is designed to support operation with Perl * installations back to 5.004, and has been tested up to 5.8.1. * * If this version of ppport.h is failing during the compilation of this * module, please check if a newer version of Devel::PPPort is available * on CPAN before sending a bug report. * * If you are using the latest version of Devel::PPPort and it is failing * during compilation of this module, please send a report to perlbug@perl.com * * Include all following information: * * 1. The complete output from running "perl -V" * * 2. This file. * * 3. The name & version of the module you were trying to build. * * 4. A full log of the build that failed. * * 5. Any other information that you think could be relevant. * * * For the latest version of this code, please retreive the Devel::PPPort * module from CPAN. * */ /* * In order for a Perl extension module to be as portable as possible * across differing versions of Perl itself, certain steps need to be taken. * Including this header is the first major one, then using dTHR is all the * appropriate places and using a PL_ prefix to refer to global Perl * variables is the second. * */ /* If you use one of a few functions that were not present in earlier * versions of Perl, please add a define before the inclusion of ppport.h * for a static include, or use the GLOBAL request in a single module to * produce a global definition that can be referenced from the other * modules. * * Function: Static define: Extern define: * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL * */ /* To verify whether ppport.h is needed for your module, and whether any * special defines should be used, ppport.h can be run through Perl to check * your source code. Simply say: * * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc] * * The result will be a list of patches suggesting changes that should at * least be acceptable, if not necessarily the most efficient solution, or a * fix for all possible problems. It won't catch where dTHR is needed, and * doesn't attempt to account for global macro or function definitions, * nested includes, typemaps, etc. * * In order to test for the need of dTHR, please try your module under a * recent version of Perl that has threading compiled-in. * */ /* #!/usr/bin/perl @ARGV = ("*.xs") if !@ARGV; %badmacros = %funcs = %macros = (); $replace = 0; foreach () { $funcs{$1} = 1 if /Provide:\s+(\S+)/; $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; $replace = $1 if /Replace:\s+(\d+)/; $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; } foreach $filename (map(glob($_),@ARGV)) { unless (open(IN, "<$filename")) { warn "Unable to read from $file: $!\n"; next; } print "Scanning $filename...\n"; $c = ""; while () { $c .= $_; } close(IN); $need_include = 0; %add_func = (); $changes = 0; $has_include = ($c =~ /#.*include.*ppport/m); foreach $func (keys %funcs) { if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { if ($c !~ /\b$func\b/m) { print "If $func isn't needed, you don't need to request it.\n" if $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); } else { print "Uses $func\n"; $need_include = 1; } } else { if ($c =~ /\b$func\b/m) { $add_func{$func} =1 ; print "Uses $func\n"; $need_include = 1; } } } if (not $need_include) { foreach $macro (keys %macros) { if ($c =~ /\b$macro\b/m) { print "Uses $macro\n"; $need_include = 1; } } } foreach $badmacro (keys %badmacros) { if ($c =~ /\b$badmacro\b/m) { $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; $need_include = 1; } } if (scalar(keys %add_func) or $need_include != $has_include) { if (!$has_include) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). "#include \"ppport.h\"\n"; $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; } elsif (keys %add_func) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; } if (!$need_include) { print "Doesn't seem to need ppport.h.\n"; $c =~ s/^.*#.*include.*ppport.*\n//m; } $changes++; } if ($changes) { open(OUT,">/tmp/ppport.h.$$"); print OUT $c; close(OUT); open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); while () { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } close(DIFF); unlink("/tmp/ppport.h.$$"); } else { print "Looks OK\n"; } } __DATA__ */ #ifndef _P_P_PORTABILITY_H_ #define _P_P_PORTABILITY_H_ #ifndef PERL_REVISION # ifndef __PATCHLEVEL_H_INCLUDED__ # define PERL_PATCHLEVEL_H_IMPLICIT # include # endif # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) # include # endif # ifndef PERL_REVISION # define PERL_REVISION (5) /* Replace: 1 */ # define PERL_VERSION PATCHLEVEL # define PERL_SUBVERSION SUBVERSION /* Replace PERL_PATCHLEVEL with PERL_VERSION */ /* Replace: 0 */ # endif #endif #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) /* It is very unlikely that anyone will try to use this with Perl 6 (or greater), but who knows. */ #if PERL_REVISION != 5 # error ppport.h only works with Perl version 5 #endif /* PERL_REVISION != 5 */ #ifndef ERRSV # define ERRSV perl_get_sv("@",FALSE) #endif #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) /* Replace: 1 */ # define PL_Sv Sv # define PL_compiling compiling # define PL_copline copline # define PL_curcop curcop # define PL_curstash curstash # define PL_defgv defgv # define PL_dirty dirty # define PL_dowarn dowarn # define PL_hints hints # define PL_na na # define PL_perldb perldb # define PL_rsfp_filters rsfp_filters # define PL_rsfpv rsfp # define PL_stdingv stdingv # define PL_sv_no sv_no # define PL_sv_undef sv_undef # define PL_sv_yes sv_yes /* Replace: 0 */ #endif #ifdef HASATTRIBUTE # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) # define PERL_UNUSED_DECL # else # define PERL_UNUSED_DECL __attribute__((unused)) # endif #else # define PERL_UNUSED_DECL #endif #ifndef dNOOP # define NOOP (void)0 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL #endif #ifndef dTHR # define dTHR dNOOP #endif #ifndef dTHX # define dTHX dNOOP # define dTHXa(x) dNOOP # define dTHXoa(x) dNOOP #endif #ifndef pTHX # define pTHX void # define pTHX_ # define aTHX # define aTHX_ #endif #ifndef dAX # define dAX I32 ax = MARK - PL_stack_base + 1 #endif #ifndef dITEMS # define dITEMS I32 items = SP - MARK #endif /* IV could also be a quad (say, a long long), but Perls * capable of those should have IVSIZE already. */ #if !defined(IVSIZE) && defined(LONGSIZE) # define IVSIZE LONGSIZE #endif #ifndef IVSIZE # define IVSIZE 4 /* A bold guess, but the best we can make. */ #endif #ifndef UVSIZE # define UVSIZE IVSIZE #endif #ifndef NVTYPE # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) # define NVTYPE long double # else # define NVTYPE double # endif typedef NVTYPE NV; #endif #ifndef INT2PTR #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) # define PTRV UV # define INT2PTR(any,d) (any)(d) #else # if PTRSIZE == LONGSIZE # define PTRV unsigned long # else # define PTRV unsigned # endif # define INT2PTR(any,d) (any)(PTRV)(d) #endif #define NUM2PTR(any,d) (any)(PTRV)(d) #define PTR2IV(p) INT2PTR(IV,p) #define PTR2UV(p) INT2PTR(UV,p) #define PTR2NV(p) NUM2PTR(NV,p) #if PTRSIZE == LONGSIZE # define PTR2ul(p) (unsigned long)(p) #else # define PTR2ul(p) INT2PTR(unsigned long,p) #endif #endif /* !INT2PTR */ #ifndef boolSV # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) #endif #ifndef gv_stashpvn # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) #endif #ifndef newSVpvn # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) #endif #ifndef newRV_inc /* Replace: 1 */ # define newRV_inc(sv) newRV(sv) /* Replace: 0 */ #endif /* DEFSV appears first in 5.004_56 */ #ifndef DEFSV # define DEFSV GvSV(PL_defgv) #endif #ifndef SAVE_DEFSV # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif #ifndef newRV_noinc # ifdef __GNUC__ # define newRV_noinc(sv) \ ({ \ SV *nsv = (SV*)newRV(sv); \ SvREFCNT_dec(sv); \ nsv; \ }) # else # if defined(USE_THREADS) static SV * newRV_noinc (SV * sv) { SV *nsv = (SV*)newRV(sv); SvREFCNT_dec(sv); return nsv; } # else # define newRV_noinc(sv) \ (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) # endif # endif #endif /* Provide: newCONSTSUB */ /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) #if defined(NEED_newCONSTSUB) static #else extern void newCONSTSUB(HV * stash, char * name, SV *sv); #endif #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) void newCONSTSUB(stash,name,sv) HV *stash; char *name; SV *sv; { U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; HV *old_curstash = PL_curstash; line_t oldline = PL_curcop->cop_line; PL_curcop->cop_line = PL_copline; PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) PL_curstash = PL_curcop->cop_stash = stash; newSUB( #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) /* before 5.003_22 */ start_subparse(), #else # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) /* 5.003_22 */ start_subparse(0), # else /* 5.003_23 onwards */ start_subparse(FALSE, 0), # endif #endif newSVOP(OP_CONST, 0, newSVpv(name,0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) ); PL_hints = oldhints; PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; PL_curcop->cop_line = oldline; } #endif #endif /* newCONSTSUB */ #ifndef START_MY_CXT /* * Boilerplate macros for initializing and accessing interpreter-local * data from C. All statics in extensions should be reworked to use * this, if you want to make the extension thread-safe. See ext/re/re.xs * for an example of the use of these macros. * * Code that uses these macros is responsible for the following: * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" * 2. Declare a typedef named my_cxt_t that is a structure that contains * all the data that needs to be interpreter-local. * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. * 4. Use the MY_CXT_INIT macro such that it is called exactly once * (typically put in the BOOT: section). * 5. Use the members of the my_cxt_t structure everywhere as * MY_CXT.member. * 6. Use the dMY_CXT macro (a declaration) in all the functions that * access MY_CXT. */ #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) /* This must appear in all extensions that define a my_cxt_t structure, * right after the definition (i.e. at file scope). The non-threads * case below uses it to declare the data as static. */ #define START_MY_CXT #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) /* Fetches the SV that keeps the per-interpreter data. */ #define dMY_CXT_SV \ SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) #else /* >= perl5.004_68 */ #define dMY_CXT_SV \ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ sizeof(MY_CXT_KEY)-1, TRUE) #endif /* < perl5.004_68 */ /* This declaration should be used within all functions that use the * interpreter-local data. */ #define dMY_CXT \ dMY_CXT_SV; \ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when * the interpreter goes away.) */ #define MY_CXT_INIT \ dMY_CXT_SV; \ /* newSV() allocates one more than needed */ \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ Zero(my_cxtp, 1, my_cxt_t); \ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ #define MY_CXT (*my_cxtp) /* Judicious use of these macros can reduce the number of times dMY_CXT * is used. Use is similar to pTHX, aTHX etc. */ #define pMY_CXT my_cxt_t *my_cxtp #define pMY_CXT_ pMY_CXT, #define _pMY_CXT ,pMY_CXT #define aMY_CXT my_cxtp #define aMY_CXT_ aMY_CXT, #define _aMY_CXT ,aMY_CXT #else /* single interpreter */ #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP #define MY_CXT_INIT NOOP #define MY_CXT my_cxt #define pMY_CXT void #define pMY_CXT_ #define _pMY_CXT #define aMY_CXT #define aMY_CXT_ #define _aMY_CXT #endif #endif /* START_MY_CXT */ #ifndef IVdf # if IVSIZE == LONGSIZE # define IVdf "ld" # define UVuf "lu" # define UVof "lo" # define UVxf "lx" # define UVXf "lX" # else # if IVSIZE == INTSIZE # define IVdf "d" # define UVuf "u" # define UVof "o" # define UVxf "x" # define UVXf "X" # endif # endif #endif #ifndef NVef # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ # define NVef PERL_PRIeldbl # define NVff PERL_PRIfldbl # define NVgf PERL_PRIgldbl # else # define NVef "e" # define NVff "f" # define NVgf "g" # endif #endif #ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */ # define AvFILLp AvFILL #endif #ifdef SvPVbyte # if PERL_REVISION == 5 && PERL_VERSION < 7 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ # undef SvPVbyte # define SvPVbyte(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) static char * my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) { sv_utf8_downgrade(sv,0); return SvPV(sv,*lp); } # endif #else # define SvPVbyte SvPV #endif #ifndef SvPV_nolen # define SvPV_nolen(sv) \ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ ? SvPVX(sv) : sv_2pv_nolen(sv)) static char * sv_2pv_nolen(pTHX_ register SV *sv) { STRLEN n_a; return sv_2pv(sv, &n_a); } #endif #ifndef get_cv # define get_cv(name,create) perl_get_cv(name,create) #endif #ifndef get_sv # define get_sv(name,create) perl_get_sv(name,create) #endif #ifndef get_av # define get_av(name,create) perl_get_av(name,create) #endif #ifndef get_hv # define get_hv(name,create) perl_get_hv(name,create) #endif #ifndef call_argv # define call_argv perl_call_argv #endif #ifndef call_method # define call_method perl_call_method #endif #ifndef call_pv # define call_pv perl_call_pv #endif #ifndef call_sv # define call_sv perl_call_sv #endif #ifndef eval_pv # define eval_pv perl_eval_pv #endif #ifndef eval_sv # define eval_sv perl_eval_sv #endif #ifndef PERL_SCAN_GREATER_THAN_UV_MAX # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 #endif #ifndef PERL_SCAN_SILENT_ILLDIGIT # define PERL_SCAN_SILENT_ILLDIGIT 0x04 #endif #ifndef PERL_SCAN_ALLOW_UNDERSCORES # define PERL_SCAN_ALLOW_UNDERSCORES 0x01 #endif #ifndef PERL_SCAN_DISALLOW_PREFIX # define PERL_SCAN_DISALLOW_PREFIX 0x02 #endif #if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1)) #define I32_CAST #else #define I32_CAST (I32*) #endif #ifndef grok_hex static UV _grok_hex (char *string, STRLEN *len, I32 *flags, NV *result) { NV r = scan_hex(string, *len, I32_CAST len); if (r > UV_MAX) { *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = r; return UV_MAX; } return (UV)r; } # define grok_hex(string, len, flags, result) \ _grok_hex((string), (len), (flags), (result)) #endif #ifndef grok_oct static UV _grok_oct (char *string, STRLEN *len, I32 *flags, NV *result) { NV r = scan_oct(string, *len, I32_CAST len); if (r > UV_MAX) { *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = r; return UV_MAX; } return (UV)r; } # define grok_oct(string, len, flags, result) \ _grok_oct((string), (len), (flags), (result)) #endif #if !defined(grok_bin) && defined(scan_bin) static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) { NV r = scan_bin(string, *len, I32_CAST len); if (r > UV_MAX) { *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; if (result) *result = r; return UV_MAX; } return (UV)r; } # define grok_bin(string, len, flags, result) \ _grok_bin((string), (len), (flags), (result)) #endif #ifndef IN_LOCALE # define IN_LOCALE \ (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) #endif #ifndef IN_LOCALE_RUNTIME # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) #endif #ifndef IN_LOCALE_COMPILETIME # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) #endif #ifndef IS_NUMBER_IN_UV # define IS_NUMBER_IN_UV 0x01 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 # define IS_NUMBER_NOT_INT 0x04 # define IS_NUMBER_NEG 0x08 # define IS_NUMBER_INFINITY 0x10 # define IS_NUMBER_NAN 0x20 #endif #ifndef grok_numeric_radix # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send) #define grok_numeric_radix Perl_grok_numeric_radix bool Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) { #ifdef USE_LOCALE_NUMERIC #if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1)) if (PL_numeric_radix_sv && IN_LOCALE) { STRLEN len; char* radix = SvPV(PL_numeric_radix_sv, len); if (*sp + len <= send && memEQ(*sp, radix, len)) { *sp += len; return TRUE; } } #else /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix * must manually be requested from locale.h */ #include struct lconv *lc = localeconv(); char *radix = lc->decimal_point; if (radix && IN_LOCALE) { STRLEN len = strlen(radix); if (*sp + len <= send && memEQ(*sp, radix, len)) { *sp += len; return TRUE; } } #endif /* PERL_VERSION */ #endif /* USE_LOCALE_NUMERIC */ /* always try "." if numeric radix didn't match because * we may have data from different locales mixed */ if (*sp < send && **sp == '.') { ++*sp; return TRUE; } return FALSE; } #endif /* grok_numeric_radix */ #ifndef grok_number #define grok_number Perl_grok_number int Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) { const char *s = pv; const char *send = pv + len; const UV max_div_10 = UV_MAX / 10; const char max_mod_10 = UV_MAX % 10; int numtype = 0; int sawinf = 0; int sawnan = 0; while (s < send && isSPACE(*s)) s++; if (s == send) { return 0; } else if (*s == '-') { s++; numtype = IS_NUMBER_NEG; } else if (*s == '+') s++; if (s == send) return 0; /* next must be digit or the radix separator or beginning of infinity */ if (isDIGIT(*s)) { /* UVs are at least 32 bits, so the first 9 decimal digits cannot overflow. */ UV value = *s - '0'; /* This construction seems to be more optimiser friendly. (without it gcc does the isDIGIT test and the *s - '0' separately) With it gcc on arm is managing 6 instructions (6 cycles) per digit. In theory the optimiser could deduce how far to unroll the loop before checking for overflow. */ if (++s < send) { int digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; if (++s < send) { /* Now got 9 digits, so need to check each time for overflow. */ digit = *s - '0'; while (digit >= 0 && digit <= 9 && (value < max_div_10 || (value == max_div_10 && digit <= max_mod_10))) { value = value * 10 + digit; if (++s < send) digit = *s - '0'; else break; } if (digit >= 0 && digit <= 9 && (s < send)) { /* value overflowed. skip the remaining digits, don't worry about setting *valuep. */ do { s++; } while (s < send && isDIGIT(*s)); numtype |= IS_NUMBER_GREATER_THAN_UV_MAX; goto skip_value; } } } } } } } } } } } } } } } } } } numtype |= IS_NUMBER_IN_UV; if (valuep) *valuep = value; skip_value: if (GROK_NUMERIC_RADIX(&s, send)) { numtype |= IS_NUMBER_NOT_INT; while (s < send && isDIGIT(*s)) /* optional digits after the radix */ s++; } } else if (GROK_NUMERIC_RADIX(&s, send)) { numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ /* no digits before the radix means we need digits after it */ if (s < send && isDIGIT(*s)) { do { s++; } while (s < send && isDIGIT(*s)); if (valuep) { /* integer approximation is valid - it's 0. */ *valuep = 0; } } else return 0; } else if (*s == 'I' || *s == 'i') { s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; s++; if (s < send && (*s == 'I' || *s == 'i')) { s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; s++; if (s == send || (*s != 'T' && *s != 't')) return 0; s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; s++; } sawinf = 1; } else if (*s == 'N' || *s == 'n') { /* XXX TODO: There are signaling NaNs and quiet NaNs. */ s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; s++; sawnan = 1; } else return 0; if (sawinf) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; } else if (sawnan) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; } else if (s < send) { /* we can have an optional exponent part */ if (*s == 'e' || *s == 'E') { /* The only flag we keep is sign. Blow away any "it's UV" */ numtype &= IS_NUMBER_NEG; numtype |= IS_NUMBER_NOT_INT; s++; if (s < send && (*s == '-' || *s == '+')) s++; if (s < send && isDIGIT(*s)) { do { s++; } while (s < send && isDIGIT(*s)); } else return 0; } } while (s < send && isSPACE(*s)) s++; if (s >= send) return numtype; if (len == 10 && memEQ(pv, "0 but true", 10)) { if (valuep) *valuep = 0; return IS_NUMBER_IN_UV; } return 0; } #endif /* grok_number */ #ifndef PERL_MAGIC_sv # define PERL_MAGIC_sv '\0' #endif #ifndef PERL_MAGIC_overload # define PERL_MAGIC_overload 'A' #endif #ifndef PERL_MAGIC_overload_elem # define PERL_MAGIC_overload_elem 'a' #endif #ifndef PERL_MAGIC_overload_table # define PERL_MAGIC_overload_table 'c' #endif #ifndef PERL_MAGIC_bm # define PERL_MAGIC_bm 'B' #endif #ifndef PERL_MAGIC_regdata # define PERL_MAGIC_regdata 'D' #endif #ifndef PERL_MAGIC_regdatum # define PERL_MAGIC_regdatum 'd' #endif #ifndef PERL_MAGIC_env # define PERL_MAGIC_env 'E' #endif #ifndef PERL_MAGIC_envelem # define PERL_MAGIC_envelem 'e' #endif #ifndef PERL_MAGIC_fm # define PERL_MAGIC_fm 'f' #endif #ifndef PERL_MAGIC_regex_global # define PERL_MAGIC_regex_global 'g' #endif #ifndef PERL_MAGIC_isa # define PERL_MAGIC_isa 'I' #endif #ifndef PERL_MAGIC_isaelem # define PERL_MAGIC_isaelem 'i' #endif #ifndef PERL_MAGIC_nkeys # define PERL_MAGIC_nkeys 'k' #endif #ifndef PERL_MAGIC_dbfile # define PERL_MAGIC_dbfile 'L' #endif #ifndef PERL_MAGIC_dbline # define PERL_MAGIC_dbline 'l' #endif #ifndef PERL_MAGIC_mutex # define PERL_MAGIC_mutex 'm' #endif #ifndef PERL_MAGIC_shared # define PERL_MAGIC_shared 'N' #endif #ifndef PERL_MAGIC_shared_scalar # define PERL_MAGIC_shared_scalar 'n' #endif #ifndef PERL_MAGIC_collxfrm # define PERL_MAGIC_collxfrm 'o' #endif #ifndef PERL_MAGIC_tied # define PERL_MAGIC_tied 'P' #endif #ifndef PERL_MAGIC_tiedelem # define PERL_MAGIC_tiedelem 'p' #endif #ifndef PERL_MAGIC_tiedscalar # define PERL_MAGIC_tiedscalar 'q' #endif #ifndef PERL_MAGIC_qr # define PERL_MAGIC_qr 'r' #endif #ifndef PERL_MAGIC_sig # define PERL_MAGIC_sig 'S' #endif #ifndef PERL_MAGIC_sigelem # define PERL_MAGIC_sigelem 's' #endif #ifndef PERL_MAGIC_taint # define PERL_MAGIC_taint 't' #endif #ifndef PERL_MAGIC_uvar # define PERL_MAGIC_uvar 'U' #endif #ifndef PERL_MAGIC_uvar_elem # define PERL_MAGIC_uvar_elem 'u' #endif #ifndef PERL_MAGIC_vstring # define PERL_MAGIC_vstring 'V' #endif #ifndef PERL_MAGIC_vec # define PERL_MAGIC_vec 'v' #endif #ifndef PERL_MAGIC_utf8 # define PERL_MAGIC_utf8 'w' #endif #ifndef PERL_MAGIC_substr # define PERL_MAGIC_substr 'x' #endif #ifndef PERL_MAGIC_defelem # define PERL_MAGIC_defelem 'y' #endif #ifndef PERL_MAGIC_glob # define PERL_MAGIC_glob '*' #endif #ifndef PERL_MAGIC_arylen # define PERL_MAGIC_arylen '#' #endif #ifndef PERL_MAGIC_pos # define PERL_MAGIC_pos '.' #endif #ifndef PERL_MAGIC_backref # define PERL_MAGIC_backref '<' #endif #ifndef PERL_MAGIC_ext # define PERL_MAGIC_ext '~' #endif #endif /* _P_P_PORTABILITY_H_ */ /* End of File ppport.h */ Taint-Runtime-0.03/META.yml0000644000175000017500000000047110634300723014071 0ustar paulpaul# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Taint-Runtime version: 0.03 version_from: lib/Taint/Runtime.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30_01 Taint-Runtime-0.03/Runtime.xs0000644000175000017500000000072610207772755014640 0ustar paulpaul#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" MODULE = Taint::Runtime PACKAGE = Taint::Runtime int _taint_start() CODE: PL_tainting = 1; RETVAL = 1; OUTPUT: RETVAL int _taint_stop() CODE: PL_tainting = 0; RETVAL = 1; OUTPUT: RETVAL int _taint_enabled() CODE: RETVAL = PL_tainting; OUTPUT: RETVAL SV* _tainted() CODE: PL_tainted = 1; RETVAL = newSVpvn("", 0); OUTPUT: RETVAL Taint-Runtime-0.03/is_taint_bench.pl0000644000175000017500000000477410210711121016124 0ustar paulpaul#!/usr/bin/perl -w use strict; use Benchmark qw(timethese cmpthese countit timestr); use Taint::Runtime qw($TAINT taint); $TAINT = 1; sub is1 { return if ! defined $_[0]; ! eval { eval '#'.substr($_[0], 0, 0); 1 } } sub is2 { local $^W = 0; local $@; eval { kill 0 * $_[0] }; $@ =~ /^Insecure/ } sub is3 { local $^W = 0; ! eval { my $t = 0 * $_[0]; eval("1 + $t") } } my $var_bad = taint("foo"); my $var_ok = "bar"; my $var_und = undef; print is1($var_bad) ? "Correct\n" : "Wrong\n"; print is2($var_bad) ? "Correct\n" : "Wrong\n"; print is3($var_bad) ? "Correct\n" : "Wrong\n"; print is1($var_ok) ? "Wrong\n" : "Correct\n"; print is2($var_ok) ? "Wrong\n" : "Correct\n"; print is3($var_ok) ? "Wrong\n" : "Correct\n"; print is1($var_und) ? "Wrong\n" : "Correct\n"; print is2($var_und) ? "Wrong\n" : "Correct\n"; print is3($var_und) ? "Wrong\n" : "Correct\n"; foreach my $var ($var_ok, $var_bad, $var_und) { print "Run: ".(! $var ? "Undefined" : $var eq 'foo' ? 'Tainted' : 'Untainted')."\n"; cmpthese (-2,{ is1 => sub { is1($var) }, is2 => sub { is2($var) }, is3 => sub { is3($var) }, },'auto'); } __END__ ### Perl 5.8.5 Mandrake 10.1 1.4 Mobile # Run: Untainted # Benchmark: running is1, is2, is3 for at least 2 CPU seconds... # is1: 3 wallclock secs ( 2.04 usr + 0.00 sys = 2.04 CPU) @ 40906.86/s (n=83450) # is2: 1 wallclock secs ( 2.12 usr + 0.00 sys = 2.12 CPU) @ 147537.74/s (n=312780) # is3: 2 wallclock secs ( 2.10 usr + 0.00 sys = 2.10 CPU) @ 29252.38/s (n=61430) # Rate is3 is1 is2 # is3 29252/s -- -28% -80% # is1 40907/s 40% -- -72% # is2 147538/s 404% 261% -- # Run: Tainted # Benchmark: running is1, is2, is3 for at least 2 CPU seconds... # is1: 2 wallclock secs ( 2.13 usr + 0.00 sys = 2.13 CPU) @ 67086.85/s (n=142895) # is2: 2 wallclock secs ( 2.02 usr + 0.00 sys = 2.02 CPU) @ 52951.49/s (n=106962) # is3: 3 wallclock secs ( 2.07 usr + 0.00 sys = 2.07 CPU) @ 48884.06/s (n=101190) # Rate is3 is2 is1 # is3 48884/s -- -8% -27% # is2 52951/s 8% -- -21% # is1 67087/s 37% 27% -- # Run: Undefined # Benchmark: running is1, is2, is3 for at least 2 CPU seconds... # is1: 1 wallclock secs ( 2.02 usr + 0.00 sys = 2.02 CPU) @ 40643.56/s (n=82100) # is2: 2 wallclock secs ( 2.16 usr + 0.00 sys = 2.16 CPU) @ 111499.07/s (n=240838) # is3: 2 wallclock secs ( 2.04 usr + 0.00 sys = 2.04 CPU) @ 26348.04/s (n=53750) # Rate is3 is1 is2 # is3 26348/s -- -35% -76% # is1 40644/s 54% -- -64% # is2 111499/s 323% 174% - Taint-Runtime-0.03/README0000644000175000017500000002200710634300403013472 0ustar paulpaulNAME Taint::Runtime - Runtime enable taint checking SYNOPSIS ### sample "enable" usage #!/usr/bin/perl -w use Taint::Runtime qw(enable taint_env); taint_env(); # having the keyword enable in the import list starts taint ### sample $TAINT usage #!/usr/bin/perl -w use Taint::Runtime qw($TAINT taint_env); $TAINT = 1; taint_env(); # taint is now enabled if (1) { local $TAINT = 0; # do something we trust } # back to an untrustwory area ### sample functional usage #!/usr/bin/perl -w use strict; use Taint::Runtime qw(taint_start is_tainted taint_env taint untaint taint_enabled); ### other operations here taint_start(); # taint should become active taint_env(); # %ENV was previously untainted print taint_enabled() ? "enabled\n" : "not enabled\n"; my $var = taint("some string"); print is_tainted($var) ? "tainted\n" : "not tainted\n"; $var = untaint($var); # OR untaint \$var; print is_tainted($var) ? "tainted\n" : "not tainted\n"; DESCRIPTION First - you probably shouldn't use this module to control taint. You should probably use the -T switch on the commandline instead. There are a somewhat limited number of legitimate use cases where you should use this module instead of the -T switch. Unless you have a specific and good reason for not using the -T option, you should use the -T option. Taint is a good thing. However, few people (that I work with or talk to or discuss items with) use taint even though they should. The goal of this module isn't to use taint less, but to actually encourage its use more. This module aims to make using taint as painless as possible (This can be an argument against it - often implementation of security implies pain - so taking away pain might lessen security - sort of). In general - the more secure your script needs to be - the earlier on in your program that tainting should be enabled. For most setuid scripts, you should enable taint by using the -T switch. Without doing so you allow for a non-root user to override @INC which allows for them to put their own module in the place of trusted modules. This is bad. This is very bad. Use the -T switch. There are some common places where this module may be useful, and where most people don't use it. One such place is in a web server. The -T switch removes PERL5LIB and PERLLIB and '.' from @INC (or remove them before they can be added). This makes sense under setuid. The use of the -T switch in a CGI environment may cause a bit of a headache. For new development, CGI scripts it may be possible to use the -T switch and for mod_perl environments there is the PerlTaint variable. Both of these methods will enable taint and from that point on development should be done with taint. However, many (possibly most) perl web server implentations add their own paths to the PERL5LIB. All CGI's and mod_perl scripts can then have access. Using the -T switch throws a wrench into the works as suddenly PERL5LIB disappears (mod_perl can easily have the extra directories added again using push @INC, '/our/lib/dir';). The company I work for has 200 plus user visible scripts mixed with some mod_perl. Currently none of the scripts use taint. We would like for them all to, but it is not feasible to make the change all at once. Taint::Runtime allows for moving legacy scripts over one at a time. Again, if you are using setuid - don't use this script. If you are not using setuid and have reasons not to use the -T and are using this module, make sure that taint is enabled before processing any user data. Also remember that BECAUSE THE -T SWITCH WAS NOT USED %ENV IS INITIALLY NOT MARKED AS TAINTED. Call taint_env() to mark it as tainted (especially important in CGI scripts which all read from $ENV{'QUERY_STRING'}). If you are not using the -T switch, you most likely should use the following at the very top of your script: #!/usr/bin/perl -w use strict; use Taint::Runtime qw(enable taint_env); taint_env(); Though this module allows for you to turn taint off - you probably shouldn't. This module is more for you to turn taint on - and once it is on it probably ought to stay on. NON-EXPORTABLE XS FUNCTIONS The following very basic functions provide the base functionality. _taint_start() Sets PL_tainting _taint_stop() Sets PL_tainting _taint_enabled() View of PL_tainting _tainted() Returns a zero length tainted string. $TAINT VARIABLE The variable $TAINT is tied to the current state of taint. If $TAINT is set to 0 taint mode is off. When it is set to 1 taint mode is enabled. if (1) { local $TAINT = 1; # taint is enabled } EXPORT FUNCTIONS enable/disable Not really functions. If these keywords are in the import list, taint will be either enabled or disabled. taint_start Start taint mode. $TAINT will equal 1. taint_stop Stop taint mode. $TAINT will equal 0. taint_env Convenience function that taints the keys and values of %ENV. If the -T switch was not used - you most likely should call this as soon as taint mode is enabled. taint Taints the passed in variable. Only works on writeable scalar values. If a scalar ref is passed in - it is modified. If a scalar is passed in (non ref) it is copied, modified and returned. If a value was undefined, it becomes a zero length defined and tainted string. taint(\$var_to_be_tainted); my $tainted_copy = taint($some_var); For a stronger taint, see the Taint module by Dan Sulgalski which is capable of tainting most types of data. untaint Untaints the passed in variable. Only works on writeable scalar values. If a scalar ref is passed in - it is modified. If a scalar is passed in (non ref) it is copied, modified and returned. If a value was undefined it becomes an untainted undefined value. Note: Just because the variable is untainted, doesn't mean that it is safe. You really should use CGI::Ex::Validate, or Data::FormValidator or any of the Untaint:: modules. If you are doing your own validation, and once you have put the user data through very strict checks, then you can use untaint. if ($var_to_be_untainted =~ /^[\w\.\-]{0,100}$/) { untaint(\$var_to_be_untainted); } my $untainted_copy = untaint($some_var); taint_enabled Boolean - Is taint on. tainted Returns a zero length tainted string. is_tainted Boolean - True if the passed value is tainted. taint_deeply Convenience function that attempts to deply recurse a structure and mark it as tainted. Takes a hashref, arrayref, scalar ref, or scalar and recursively untaints the structure. For a stronger taint, see the Taint module by Dan Sulgalski which is capable of tainting most types of data. TURNING TAINT ON (Be sure to call taint_env() after turning taint on the first time) #!/usr/bin/perl -T use Taint::Runtime qw(enable); # this does not create a function called enable - just starts taint use Taint::Runtime qw($TAINT); $TAINT = 1; use Taint::Runtime qw(taint_start); taint_start; TURNING TAINT OFF use Taint::Runtime qw(disable); # this does not create a function called disable - just stops taint use Taint::Runtime qw($TAINT); $TAINT = 0; use Taint::Runtime qw(taint_stop); taint_stop; CREDITS C code was provided by "hv" on perlmonks. This module wouldn't really be possible without insight into the internals that "hv" provided. His post with the code was shown in this node on perlmonks: http://perlmonks.org/?node_id=434086 The basic premise in that node was the following code: use Inline C => 'void _start_taint() { PL_tainting = 1; }'; use Inline C => 'SV* _tainted() { PL_tainted = 1; return newSVpvn("", 0); }'; In this module, these two lines have instead been turned into XS for runtime speed (and so you won't need Inline and Parse::RecDescent). Note: even though "hv" provided the base code example, that doesn't mean that he necessarily endorses the idea. If there are disagreements, quirks, annoyances or any other negative side effects with this module - blame me - not "hv." THANKS Thanks to Alexey A. Kiritchun for pointing out untaint failure on multiline strings. AUTHOR Paul Seamons (2005) C stub functions by "hv" on perlmonks.org LICENSE This module may be used and distributed under the same terms as Perl itself. Taint-Runtime-0.03/Makefile.PL0000644000175000017500000000051410207657127014601 0ustar paulpauluse ExtUtils::MakeMaker; WriteMakefile( NAME => 'Taint::Runtime', VERSION_FROM => 'lib/Taint/Runtime.pm', ABSTRACT_FROM => 'lib/Taint/Runtime.pm', AUTHOR => 'Paul Seamons', ); package MY; sub postamble { return qq^ pm_to_blib: README README: \$(VERSION_FROM) pod2text \$(VERSION_FROM) > README ^; }