develooper Front page | perl.perl5.porters | Postings from October 2001

[PATCH] Re: [ID 20011030.064] File::Temp tempdir (CLEANUP => 1) and -T on OpenBSD 2.9

From:
Rafael Garcia-Suarez
Date:
October 30, 2001 13:24
Subject:
[PATCH] Re: [ID 20011030.064] File::Temp tempdir (CLEANUP => 1) and -T on OpenBSD 2.9
Message ID:
20011030222224.C28503@rafael
On 2001.10.30 13:52 Alex Farber wrote:
> This is a bug report for perl from eedalf@eed.ericsson.se,
> generated with the help of perlbug 1.28 running under perl v5.6.0.
> 
> 
> -----------------------------------------------------------------
> [Please enter your report here]
> 
> Hi,
> 
> the same problem as in ID 20011030.063:
> 
> 
>     #!/usr/bin/perl -wT
> 
>     BEGIN { %ENV = () }
> 
>     use File::Temp qw (tempdir);
> 
>     $tempdir = tempdir (CLEANUP => 1);
> 
>     $tempdir = $1 if $tempdir =~ /(\S*)/;
>     print "$tempdir\n";
>     system ("/usr/bin/touch $tempdir/xxx") and die $!;
> 
> produces:
> 
> pref:alex {140} ./temp.pl
> /tmp/oQp5wJKtTU
> Insecure dependency in unlink while running with -T switch at /usr/libdata/perl5/File/Path.pm
> line 220.
> END failed--call queue aborted.

Patch below. Also tests that would not run with -T now do.
Basically this tells File::Path::rmtree() to untaint the contents of the subdirectories
of the tree to be removed. Objections?

(Note. As this patch uses ${^TAINT}, it will not work with earlier perls)

--- lib/File/Path.pm.orig	Fri Sep 21 20:11:58 2001
+++ lib/File/Path.pm	Tue Oct 30 22:11:43 2001
@@ -98,7 +98,7 @@
 use strict;
 use warnings;
 
-our $VERSION = "1.0405";
+our $VERSION = "1.05";
 our @ISA = qw( Exporter );
 our @EXPORT = qw( mkpath rmtree );
 
@@ -180,7 +180,12 @@
 		unless $safe;
 
 	    if (opendir my $d, $root) {
-		@files = readdir $d;
+		if (${^TAINT}) {
+		    # Blindly untaint dir names
+		    @files = map { /^(.*)\z/ ; $1 } readdir $d;
+		} else {
+		    @files = readdir $d;
+		}
 		closedir $d;
 	    }
 	    else {
--- lib/File/Path.t.orig	Mon Jun 18 07:21:16 2001
+++ lib/File/Path.t	Tue Oct 30 22:10:08 2001
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -wT
 
 BEGIN {
     chdir 't' if -d 't';
--- lib/File/Temp/t/mktemp.t.orig	Thu Jun 21 16:46:53 2001
+++ lib/File/Temp/t/mktemp.t	Tue Oct 30 22:13:43 2001
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl -wT
 
 # Test for mktemp family of commands in File::Temp
 # Use STANDARD safe level for these tests



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About