File::Basename taint fix (revised)

p4raw-id: //depot/perl@777

1 files changed, 8 insertions, 3 deletions

diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index 5c6299e596..8828a52bfc 100644
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -127,8 +127,8 @@ require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
 #use strict;
-#use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase);
-$VERSION = "2.5";
+use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase);
+$VERSION = "2.6";
 
 
 #   fileparse_set_fstype() - specify OS-based rules used in future
@@ -155,11 +155,13 @@ sub fileparse {
   my($fullname,@suffices) = @_;
   my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
   my($dirpath,$tail,$suffix,$basename);
+  my($taint) = substr($fullname,0,0);  # Is $fullname tainted?
 
   if ($fstype =~ /^VMS/i) {
     if ($fullname =~ m#/#) { $fstype = '' }  # We're doing Unix emulation
     else {
       ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/);
+      $dirpath ||= '';  # should always be defined
     }
   }
   if ($fstype =~ /^MS(DOS|Win32)/i) {
@@ -183,12 +185,15 @@ sub fileparse {
     foreach $suffix (@suffices) {
       my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
       if ($basename =~ s/$pat//) {
+        $taint .= substr($suffix,0,0);
         $tail = $1 . $tail;
       }
     }
   }
 
-  wantarray ? ($basename,$dirpath,$tail) : $basename;
+  $tail .= $taint if defined $tail; # avoid warning if $tail == undef
+  wantarray ? ($basename . $taint, $dirpath . $taint, $tail)
+            : $basename . $taint;
 }