Weird un-tainting problem.

ChakaMonk has asked for the wisdom of the Perl Monks concerning the following question:

Using a variable in the regular expression below, $realm does not get untained. If I use the commented out reular expression instead, $realm is untainted. In both cases there is a successful match. Any ideas?

#!/usr/bin/perl -T

$|++;
use strict;

use lib qw( /home/httpd/sec-cgi );
use RealmFile_DB;

use CGI qw(:standard *table );
use CGI::Carp qw(fatalsToBrowser);
use HTTPD::RealmManager;

my $template_dir = '/home/httpd/template/';
my $docroot = "/home/httpd/sec-html/";
my $user = remote_user();

print header();
#$ENV{SCRIPT_FILENAME} =~ /\/home\/httpd\/sec\-html\/(.*?)\//;
$ENV{SCRIPT_FILENAME} =~ /${docroot}(.*?)\//;
my $realm = $1;
if (is_tainted($realm)) { print "realm: $realm is tainted in main0!<P>
+"; }
[download]

Comment on Weird un-tainting problem. Download Code

Replies are listed 'Best First'.
Re: Weird un-tainting problem. by kal (Hermit) on Jan 22, 2002 at 00:46 UTC
Firstly, always reduce your code to the 'minimal' case - that means, get rid of anything else that isn't needed to demonstrate the problem. I reduced your code to: `#!/usr/bin/perl -Tw use strict; use CGI qw(:standard table ); use CGI::Carp qw(fatalsToBrowser); my $docroot = "/home/httpd/sec-html/"; sub is_tainted { return ! eval { join('',@_), kill 0; 1; }; } print header(); $ENV{SCRIPT_FILENAME} =~ /\/home\/httpd\/sec\-html\/(.?)\//; #$ENV{SCRIPT_FILENAME} =~ /${docroot}(.*?)\//; my $realm = $1; if (is_tainted($realm)) { print "realm: $realm is tainted in main0!<P>"; } else { print "realm: $realm is not tainted in main0<P>"; }` [download] ... which is a lot simpler. Also, `$realm` is untainted (according to this code) in either case, so I'm not sure why it doesn't work for you. Check the things you include - perhaps they have a faulty version of `is_tainted ()` (I took this implementation from the perlsec man page :), which is giving you false values?	[reply] [d/l] [select]
Re: Weird un-tainting problem. by chromatic (Archbishop) on Jan 22, 2002 at 00:51 UTC
It works for me. Are you positive the match succeeds? I'm not. Throw an if clause in there: `my $realm; if ($ENV{SCRIPT_FILENAME} =~ m!${docroot}(.*?)/!) { $realm = $1; } else { print "Realm ($realm) is really wrong.\n"; }` [download]	[reply] [d/l]
Re: Weird un-tainting problem. by ChakaMonk (Novice) on Jan 22, 2002 at 01:12 UTC
Here is much simpler code that demonstrates the same problem: `#!/usr/bin/perl -T use strict; my $docroot = "/home/httpd/sec-html/"; if ($ENV{SCRIPT_FILENAME} =~ /${docroot}(.*?)\//) { print "RE MATCH!\n +"; } my $realm = $1; if (is_tainted($realm)) { print "Realm: $realm is tainted!\n"; } sub is_tainted { return ! eval { join('',@_), kill 0; 1; }; }` [download] Here is what I get when I run it: `[chaka@pengy sec-cgi]# export SCRIPT_FILENAME=/home/httpd/sec-html/sur +flo/ [chaka@pengy sec-cgi]# ./index.cgi RE MATCH! Realm: surflo is tainted!` [download] My perl version is 5.005_03	[reply] [d/l] [select]
Re: Weird un-tainting problem. by ChakaMonk (Novice) on Jan 22, 2002 at 01:18 UTC
I just tried it on a machine with perl 5.6 and it works fine. Must be an old bug. Upgrading isn't an option at this time so I'll have to untaint it with /(.*)/ after the first regexp. Thanks.	[reply]