Fall back to CSIDL_LOCAL_APPDATA under taint on Windows

When File::Spec->tmpdir gives an unwritable directory on Windows when
in taint mode, this attempts to use a directory in the local appdata
folder instead.

See https://rt.cpan.org/Ticket/Display.html?id=60340

Author: xdg

lib/File/Temp.pm

@@ -1431,7 +1431,7 @@ sub tempfile {
 
     } elsif ($options{TMPDIR}) {
 
-      $template = File::Spec->catfile(File::Spec->tmpdir, $template );
+      $template = File::Spec->catfile(_wrap_file_spec_tmpdir(), $template );
 
     }
 
@@ -1443,7 +1443,7 @@ sub tempfile {
 
     } else {
 
-      $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
+      $template = File::Spec->catfile(_wrap_file_spec_tmpdir(), TEMPXXX);
 
     }
 
@@ -1506,6 +1506,58 @@ sub tempfile {
 
 }
 
+# On Windows under taint mode, File::Spec could suggest "C:\" as a tempdir
+# which might not be writable.  If that is the case, we fallback to a
+# user directory.  See https://rt.cpan.org/Ticket/Display.html?id=60340
+
+{
+  my ($alt_tmpdir, $checked);
+
+  sub _wrap_file_spec_tmpdir {
+    return File::Spec->tmpdir unless $^O eq "MSWin32" && ${^TAINT};
+
+    if ( $checked ) {
+      return $alt_tmpdir ? $alt_tmpdir : File::Spec->tmpdir;
+    }
+
+    # probe what File::Spec gives and find a fallback
+    my $xxpath = _replace_XX( "X" x 10, 0 );
+
+    # First, see if File::Spec->tmpdir is writable
+    my $tmpdir = File::Spec->tmpdir;
+    my $testpath = File::Spec->catdir( $tmpdir, $xxpath );
+    if (mkdir( $testpath, 0700) ) {
+      $checked = 1;
+      rmdir $testpath;
+      return $tmpdir;
+    }
+
+    # Next, see if CSIDL_LOCAL_APPDATA is writable
+    require Win32;
+    my $local_app = File::Spec->catdir(
+      Win32::GetFolderPath( Win32::CSIDL_LOCAL_APPDATA() ), 'Temp'
+    );
+    $testpath = File::Spec->catdir( $local_app, $xxpath );
+    if ( -e $local_app or mkdir( $local_app, 0700 ) ) {
+      if (mkdir( $testpath, 0700) ) {
+        $checked = 1;
+        rmdir $testpath;
+        return $alt_tmpdir = $local_app;
+      }
+    }
+
+    # Can't find something writable
+    croak << "HERE";
+Couldn't find a writable temp directory in taint mode. Tried:
+  $tmpdir
+  $local_app
+
+Try setting and untainting the TMPDIR environment variable.
+HERE
+
+  }
+}
+
 =item B<tempdir>
 
 This is the recommended interface for creation of temporary
@@ -1620,7 +1672,7 @@ sub tempdir  {
       } elsif ($options{TMPDIR}) {
 
         # Prepend tmpdir
-        $template = File::Spec->catdir(File::Spec->tmpdir, $template);
+        $template = File::Spec->catdir(_wrap_file_spec_tmpdir(), $template);
 
       }
 
@@ -1634,7 +1686,7 @@ sub tempdir  {
 
     } else {
 
-      $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
+      $template = File::Spec->catdir(_wrap_file_spec_tmpdir(), TEMPXXX);
 
     }
 
@@ -1901,8 +1953,9 @@ Current API available since 0.05.
 sub tmpnam {
 
   # Retrieve the temporary directory name
-  my $tmpdir = File::Spec->tmpdir;
+  my $tmpdir = _wrap_file_spec_tmpdir();
 
+  # XXX I don't know under what circumstances this occurs, -- xdg 2016-04-02
   croak "Error temporary directory is not writable"
     if $tmpdir eq '';
 
@@ -2490,7 +2543,10 @@ destruction), then you will get a warning from File::Path::rmtree().
 =head2 Taint mode
 
 If you need to run code under taint mode, updating to the latest
-L<File::Spec> is highly recommended.
+L<File::Spec> is highly recommended.  On Windows, if the directory
+given by L<File::Spec::tmpdir> isn't writable, File::Temp will attempt
+to fallback to the user's local application data directory or croak
+with an error.
 
 =head2 BINMODE
 

t/mktemp.t

@@ -16,7 +16,7 @@ ok(1);
 # MKSTEMP - test
 
 # Create file in temp directory
-my $template = File::Spec->catfile(File::Spec->tmpdir, 'wowserXXXX');
+my $template = File::Spec->catfile(File::Temp::_wrap_file_spec_tmpdir(), 'wowserXXXX');
 
 (my $fh, $template) = mkstemp($template);
 
@@ -87,7 +87,7 @@ if ($status) {
 # MKDTEMP
 # Temp directory
 
-$template = File::Spec->catdir(File::Spec->tmpdir, 'tmpdirXXXXXX');
+$template = File::Spec->catdir(File::Temp::_wrap_file_spec_tmpdir(), 'tmpdirXXXXXX');
 
 my $tmpdir = mkdtemp($template);
 
@@ -101,7 +101,7 @@ rmtree($tmpdir);
 # MKTEMP
 # Just a filename, not opened
 
-$template = File::Spec->catfile(File::Spec->tmpdir, 'mytestXXXXXX');
+$template = File::Spec->catfile(File::Temp::_wrap_file_spec_tmpdir(), 'mytestXXXXXX');
 
 my $tmpfile = mktemp($template);
 

t/security.t

@@ -77,7 +77,7 @@ sub test_security {
   # Create the tempfile
   my $template = "tmpXXXXX";
   my ($fh1, $fname1) = eval { tempfile ( $template, 
-				  DIR => File::Spec->tmpdir,
+				  DIR => File::Temp::_wrap_file_spec_tmpdir(),
 				  UNLINK => 1,
 				);
 			    };
@@ -89,7 +89,7 @@ sub test_security {
         push(@files, $fname1); # store for end block
     } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
         chomp($@);
-        my $msg = File::Spec->tmpdir() . " possibly insecure: $@";
+        my $msg = File::Temp::_wrap_file_spec_tmpdir() . " possibly insecure: $@";
         skip $msg, 2; # one here and one in END
     } else {
         ok(0);

t/tempfile.t

@@ -154,7 +154,7 @@ push( @still_there, File::Spec->rel2abs($tempfile) ); # check at END
 #    on NFS
 # Try to do what we can.
 # Tempfile croaks on error so we need an eval
-$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) };
+$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Temp::_wrap_file_spec_tmpdir() ) };
 
 if ($fh) {