-------- Original Message --------
Subject: [rt.cpan.org #18584] Apache::DProf not taint safe
Date: Fri, 7 Apr 2006 06:14:01 -0400 (EDT)
From: via RT <[EMAIL PROTECTED]>
Reply-To: [EMAIL PROTECTED]
To: undisclosed-recipients:;
References: <[EMAIL PROTECTED]>
Fri Apr 07 06:14:00 2006: Request 18584 was acted upon.
Transaction: Ticket created by DOMQ
Queue: Apache-DB
Subject: Apache::DProf not taint safe
Owner: Nobody
Requestors: [EMAIL PROTECTED]
Status: new
Ticket <URL: http://rt.cpan.org/Ticket/Display.html?id=18584 >
Apache::DProf::handler() calls File::Path::mkpath() on a tainted
parameter, which throws an exception when PerlTaintCheck is On.
The problem is due to Apache->server_root_relative() returning tainted
results under MP1, and although I didn't test that, I highly suspect all
other methods of computing $prof pick up some taint too (from the
environment I'm pretty sure, and from the MP2 API probably too).
Attached patch fixes that by applying an adequate regex operation on
$dir within handler(), and adds a regression test.
diff -Naur Apache-DB-0.12.ORIG/lib/Apache/DProf.pm Apache-DB-0.12/lib/Apache/DProf.pm
--- Apache-DB-0.12.ORIG/lib/Apache/DProf.pm 2006-04-03 20:51:11.000000000 +0200
+++ Apache-DB-0.12/lib/Apache/DProf.pm 2006-04-07 11:48:03.000000000 +0200
@@ -65,6 +65,7 @@
my $r = shift;
my $dir = "$prof_path/$$";
+ $dir =~ m/^(.*)$/; $dir = $1; # Untainted
File::Path::mkpath($dir);
chdir $dir or die "Cannot move into '$dir': $!";
diff -Naur Apache-DB-0.12.ORIG/t/taintsafe.t Apache-DB-0.12/t/taintsafe.t
--- Apache-DB-0.12.ORIG/t/taintsafe.t 1970-01-01 01:00:00.000000000 +0100
+++ Apache-DB-0.12/t/taintsafe.t 2006-04-07 11:44:41.000000000 +0200
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -T
+
+# This tests ensures that Apache::DProf can work with taint mode enabled.
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Scalar::Util qw(tainted);
+use File::Temp qw(tempdir);
+
+my $tainted_null = substr($0, 0, 0);
+tainted($tainted_null) or die <<"FATAL";
+This test must be run with taint mode enabled (perl -T)
+FATAL
+
+#####################################################################
+
+my $tempdir = tempdir(CLEANUP => 1);
+sub Apache::server_root_relative { $tempdir . $tainted_null . shift }
+
+use_ok('Apache::DProf');
+
+eval {
+ no warnings "redefine";
+ local *File::Path::mkpath = sub {
+ my $path = shift;
+ like($path, qr/^$tempdir/);
+ ok(! tainted($path));
+ die "SNAFU"; # Don't want to actually run the rest of handler()
+ };
+ Apache::DProf::handler();
+};
+like($@, qr/^SNAFU/);
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
