new safer-update patch, should work on win32 now, too

git-svn-id: svn://tug.org/texlive/trunk@10655 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 77 insertions, 14 deletions

diff --git a/Master/tlpkg/etc/safer-update.diff b/Master/tlpkg/etc/safer-update.diff
index eff61010331..9e7318d27fb 100644
--- a/Master/tlpkg/etc/safer-update.diff
+++ b/Master/tlpkg/etc/safer-update.diff
@@ -151,7 +151,7 @@ Index: tlpkg/TeXLive/TLMedia.pm
    }
  
    if (ref $what) {
-@@ -271,48 +278,84 @@
+@@ -271,48 +278,82 @@
        mkdirhier("$target/$dn");
        copy "$location/$file", "$target/$dn";
      }
@@ -186,6 +186,7 @@ Index: tlpkg/TeXLive/TLMedia.pm
 -      if (!download_file($what, $lzmafile) || (! -r $lzmafile)) {
 -        die "Downloading $what did not succeed, please retry!";
 +    my $tarfile;
++    my $remove_tarfile = 1;
 +    if ($type eq "lzma") {
 +      my $lzmafile = "$target/temp/$fn";
 +      $tarfile  = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//;
@@ -237,11 +238,8 @@ Index: tlpkg/TeXLive/TLMedia.pm
 +          return(0);
 +        }
 +      } else {
-+        # we are installing from CD
-+        my $aa = abs_path(dirname($what));
-+        my $bb = abs_path("$target/temp");
-+        # copy if the file is not already there
-+        copy($what, "$target/temp") unless ($aa eq $bb);
++        $tarfile = $what;
++        $remove_tarfile = 0;
 +      }
      }
 -    debug("Un-lzmaing $lzmafile to $tarfile\n");
@@ -251,14 +249,14 @@ Index: tlpkg/TeXLive/TLMedia.pm
 +    debug("Unpacking $tarfile\n");
 +    if (system($tar,"-x","-C",$target,"-f",$tarfile) != 0) {
 +      tlwarn("Untarring $tarfile did not succeed, please retry!\n");
-+      unlink($tarfile);
++      unlink($tarfile) if $remove_tarfile;
 +      return(0);
      }
 -    debug("Unpacking $tarfile\n");
 -    system($tar,"-x","-C",$target,"-f",$tarfile);
 -    unlink($tarfile, $lzmafile);
 +    # we are still here, so success!
-+    unlink($tarfile);
++    unlink($tarfile) if $remove_tarfile;
 +    return(1);
    } else {
 -    die "Don't know how to install $what!\n";
@@ -267,6 +265,57 @@ Index: tlpkg/TeXLive/TLMedia.pm
    }
  }
  
+Index: tlpkg/TeXLive/TLUtils.pm
+===================================================================
+--- tlpkg/TeXLive/TLUtils.pm	(revision 10633)
++++ tlpkg/TeXLive/TLUtils.pm	(working copy)
+@@ -683,8 +683,10 @@
+ =pod
+ 
+ =item C<copy($file, $target_dir)>
++=item C<copy("-f", $file, $destfile)>
+ 
+-Copy file C<$file> to directory C<$target_dir>.  No external programs
++Copy file C<$file> to directory C<$target_dir>, or to the C<$destfile> in
++the second case.  No external programs
+ are involved.  Since we need C<sysopen()>, the Perl module C<Fcntl.pm>
+ is required.  The time stamps are preserved and symlinks are created
+ on UNIX systems.  On Windows, C<(-l $file)> will certainly never
+@@ -700,6 +702,12 @@
+ 
+ sub copy {
+   my $infile=shift;
++  my $filemode = 0;
++  if ($infile eq "-f") {
++    # second argument is a file!!!
++    $filemode = 1;
++    $infile = shift;
++  }
+   my $destdir=shift;
+   my $outfile;
+   my @stat;
+@@ -710,12 +718,19 @@
+   my $dirmode=0755;
+   my $blocksize=2048;
+ 
+-  mkdirhier ("$destdir") unless -d "$destdir";
+ 
+   $infile =~ s!^file://*!/!i;
+   $filename=basename "$infile";
+-  $outfile="$destdir/$filename";
++  if ($filemode) {
++    # we actually got a destination file
++    $outfile = $destdir;
++    $destdir = dirname($outfile);
++  } else {
++    $outfile="$destdir/$filename";
++  }
+ 
++  mkdirhier ("$destdir") unless -d "$destdir";
++
+   if (-l "$infile") {
+     symlink readlink "$infile", "$destdir/$filename";
+   } else {
 Index: texmf/scripts/texlive/tlmgr.pl
 ===================================================================
 --- texmf/scripts/texlive/tlmgr.pl	(revision 10633)
@@ -345,7 +394,7 @@ Index: texmf/scripts/texlive/tlmgr.pl
            }
          }
          if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) {
-@@ -757,10 +763,51 @@
+@@ -757,10 +763,65 @@
              }
            }
          } else {
@@ -384,7 +433,20 @@ Index: texmf/scripts/texlive/tlmgr.pl
 +            # dirs from the new package before re-installing the old one!!!
 +            # TODO
 +            tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind!\n");
-+            if (TeXLive::TLMedia->_install_package("$unwind_package" , [] ,$localtlpdb)) {
++            if (win32()) {
++              # win32 is notorious for not releasing a file immediately
++              # we experienced permission denied errors 
++              my $newname = $unwind_package;
++              $newname =~ s/__BACKUP/___BACKUP/;
++              copy ("-f", $unwind_package, $newname);
++              # try to remove the file if has been created by us
++              unlink($unwind_package) if $remove_unwind_container;
++              # and make sure that the temporary file is removed in any case
++              $remove_unwind_container = 1;
++              $unwind_package = $newname;
++            }
++            my $instret = TeXLive::TLMedia->_install_package("$unwind_package" , [] ,$localtlpdb);
++            if ($instret) {
 +              # now we have to include the tlpobj
 +              my $tlpobj = TeXLive::TLPOBJ->new;
 +              $tlpobj->from_file($localtlpdb->root . "/tlpkg/tlpobj/$pkg.tlpobj");
@@ -395,12 +457,13 @@ Index: texmf/scripts/texlive/tlmgr.pl
 +              tlwarn("Restoring of old package did NOT succeed!\n");
 +              tlwarn("Best is to call tlmgr install $pkg and hope to get it right!\n");
 +            }
++            unlink($unwind_package) if $remove_unwind_container;
 +          }
 +          info("done\n");
          }
        }
      } elsif ($rev > $mediarev) {
-@@ -813,6 +860,7 @@
+@@ -813,6 +874,7 @@
        print "install: $pkg\n";
      } else {
        # install the packages and run postinstall actions (that is the 0)
@@ -408,7 +471,7 @@ Index: texmf/scripts/texlive/tlmgr.pl
        merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 0));
      }
    }
-@@ -976,6 +1024,7 @@
+@@ -976,6 +1038,7 @@
              if ($opt_dry) {
                print "Installing $pkg.$a\n";
              } else {
@@ -416,7 +479,7 @@ Index: texmf/scripts/texlive/tlmgr.pl
                merge_into(\%ret, $tlmediasrc->install_package("$pkg.$a", $localtlpdb, 0, 0));
              }
            }
-@@ -984,8 +1033,11 @@
+@@ -984,8 +1047,11 @@
      }
      if (TeXLive::TLUtils::member('win32', @todoarchs)) {
        # install the necessary win32 stuff
@@ -428,7 +491,7 @@ Index: texmf/scripts/texlive/tlmgr.pl
        merge_into (\%ret, $tlmediasrc->install_package("bin-tlpsv.win32", $localtlpdb, 1, 0));
      }
      # update the option_archs list of installed archs
-@@ -1072,6 +1124,9 @@
+@@ -1072,6 +1138,9 @@
    if (!defined($location)) {
      die("No installation source found, nor in the texlive.tlpdb nor on the cmd line.\nPlease specify one!");
    }