updater-w32 changes:

- all logic related to update preparation moved to tlmgr.pl
- batch updater created from an interpolated string in tlmgr.pl
  with only the necessary commands and simple control flow, no 
  more tricky processing routines there
- update is run in a separate cmd.exe process as before but now
  always with echo on and with all output redirected into a file 
  (or stderr in debug mode: tlmgr -v ...); the only user visible 
  messages are those explicitly redirected to con:[sole] device


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

2 files changed, 186 insertions, 39 deletions

diff --git a/Master/bin/win32/tlmgr.bat b/Master/bin/win32/tlmgr.bat
index 2d411d1a92d..193d1b81d92 100755
--- a/Master/bin/win32/tlmgr.bat
+++ b/Master/bin/win32/tlmgr.bat
@@ -26,13 +26,17 @@ if not exist "%tlupdater%" goto :eof
 rem Rename updater script before it is run

 move /y "%tlupdater%" "%tlupdater%.bat">nul

 if errorlevel 1 goto :err_rename_updater

-rem Run updater

-call "%tlupdater%.bat" & goto :eof

+rem Run updater and don't return

+"%tlupdater%.bat"

+

+rem This should never execute

+echo %~nx0: this message should never show up, please report it to tex-live@tug.org>&2

+exit /b 1

 

 :err_updater_exists

-echo %~nx0: locked updater script detected, infrastructure update might be running>&2

+echo %~nx0: failed to remove previous updater script>&2

 exit /b 1

 

 :err_rename_updater

-echo %~nx0: failed to move "%tlupdater%">&2

+echo %~nx0: failed to rename "%tlupdater%">&2

 exit /b 1

diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 5fef883efde..3c1ef0bf8e1 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -37,7 +37,9 @@ BEGIN {
   if ($^O =~ /^MSWin/i) {
     # on win32 $0 and __FILE__ point directly to tlmgr.pl; they can be relative
     $Master = __FILE__;
-    $Master = "$Master/../../../..";
+    $Master =~ s!\\!/!g;
+    $Master =~ s![^/]*$!../../..!
+      unless ($Master =~ s!texmf/scripts/texlive/tlmgr\.pl$!!i);
     $bindir = "$Master/bin/win32";
     $kpsewhichname = "kpsewhich.exe";
     # path already set by wrapper batchfile
@@ -1291,6 +1293,53 @@ sub action_backup {
   }
 }
 
+# =====================================================================
+#                  INFRASTRUCTURE UPDATE ON WINDOWS
+# =====================================================================
+#      Infrastructure files cannot be updated directly from the 
+# tlmgr.pl script due to file locking problem on Windows - files that 
+# are in use (either open or executing) cannot be removed or replaced. 
+# For that reason the update process is performed by a batch script 
+# outside of tlmgr.pl.
+#      There are three pieces involved in the update: tlmgr.bat 
+# launcher, write_w32_updater subroutine below and a batch 
+# updater script. Their roles are as follows:
+# * tlmgr.bat is a watchdog, it launches tlmgr.pl and watches for
+#   the updater script that is to be executed. If the updater script 
+#   exists before tlmgr.pl is launched, it will be removed or 
+#   tlmgr.bat will abort if it fails to do so. This means that the 
+#   updater script has to be created by the current invocation of 
+#   tlmgr.pl. Futhermore, the updater script is renamed from 
+#   updater-w32 to updater-w32.bat just before it is run, and thus 
+#   it can be executed only once.
+# * write_w32_updater subroutine in tlmgr.pl prepares the update
+#   and writes the updater script. Packages in .xz archives are
+#   dowloaded/copied and uncompressed to .tar files. Also .tar 
+#   backups of the current packages are made. If everything is 
+#   successful, the update script is created from the template. 
+#   Otherwise the update is aborted.
+# * updater-w32[.bat] batch script, triggers and executes the actual 
+#   update. It first restarts itself in a separate instance of cmd.exe 
+#   (and in a new console window in gui mode) and runs the update 
+#   from there. The update is run with echo on and all output is 
+#   logged to a file (or stderr in verbose mode). After successful 
+#   infrastructure update, tlmgr is optionally restarted if update 
+#   of other packages is asked for.
+#      The infrastructure update itself proceeds as follows:
+#   (1) untar all package archives
+#   (2) include .tlpobj files into tlpdb
+#   (3) print update info to console
+#      Any error during (1) or (2) triggers the rollback sequence:
+#   (1) print failed update info to console
+#   (2) untar all package backups
+#   (3) include .tlpobj files (from backup) into tlpdb
+#   (4) print restore info to console
+#      Any error during (2) or (3) and we go into panic state.  At this 
+#   point there is no guarantee that the installation is still working. 
+#   There is not much we can do but to print failed restore info and 
+#   give instructions to download and run 'update-tlmgr-latest.exe'
+#   to repair the installation.
+# =====================================================================
 #
 sub write_w32_updater {
   my ($restart_tlmgr, @w32_updated) = @_;
@@ -1313,33 +1362,34 @@ sub write_w32_updater {
     tlwarn("But it should not be necessary!\n");
     return 1; # abort
   }
-  my ($mediatlp, $localtlp, $opt_real_doc, $sysret, $size, $md5, $fullname,
-      $oldrev, $newrev, $pkg_part, @pkg_parts, @updater_args);
-  my $totalnr = $#w32_updated + 1;
-  my $currnr = 0;
+  my (@upd_tar, @upd_tlpobj, @upd_info, @rst_tar, @rst_tlpobj, @rst_info);
   foreach my $pkg (@w32_updated) {
-    $mediatlp = $mediatlpdb->get_package($pkg);
-    $localtlp = $localtlpdb->get_package($pkg);
-    $oldrev = $localtlp->revision;
-    $newrev = $mediatlp->revision;
+    my $mediatlp = $mediatlpdb->get_package($pkg);
+    my $localtlp = $localtlpdb->get_package($pkg);
+    my $oldrev = $localtlp->revision;
+    my $newrev = $mediatlp->revision;
     # we do install documenation files for category Documentation even if
     # option("install_docfiles") is false
-    $opt_real_doc = ($mediatlp->category =~ m/documentation/i) ? 1 : $opt_doc;
-    @pkg_parts = ($pkg);
+    my $opt_real_doc = ($mediatlp->category =~ m/documentation/i) ? 1 : $opt_doc;
+    my @pkg_parts = ($pkg);
     push(@pkg_parts, "$pkg.source") if ($container_src_split && $opt_src && $mediatlp->srcfiles);
     push(@pkg_parts, "$pkg.doc") if ($container_doc_split && $opt_real_doc && $mediatlp->docfiles);
-    $currnr++;
-    if ($opts{"dry-run"}) {
-      info("[$currnr/$totalnr] update: $pkg ($oldrev -> $newrev)\n");
-      next;
-    }
+    foreach my $pkg_part (@pkg_parts) {
+      push (@upd_tar, "$pkg_part.tar");
+      push (@upd_tlpobj, "tlpkg\\tlpobj\\$pkg_part.tlpobj");
+    }
+    push (@upd_info, "$pkg ^($oldrev -^> $newrev^)");
+    push (@rst_tar, "__BACKUP_$pkg.r$oldrev");
+    push (@rst_tlpobj, "tlpkg\\tlpobj\\$pkg.tlpobj");
+    push (@rst_info, "$pkg ^($oldrev^)");
+    next if ($opts{"dry-run"});
     # create backup; make_container expects file name in a format: some-name.r[0-9]+
-    ($size, $md5, $fullname) = $localtlp->make_container("tar", $root, $temp, "__BACKUP_$pkg.r$oldrev");
+    my ($size, $md5, $fullname) = $localtlp->make_container("tar", $root, $temp, "__BACKUP_$pkg.r$oldrev");
     if ($size <= 0) {
       tlwarn("Creation of backup container of $pkg failed.\n");
       return 1; # backup failed? abort
     }
-    foreach $pkg_part (@pkg_parts) {
+    foreach my $pkg_part (@pkg_parts) {
       if ($media eq 'CD') {
         copy("$repo/$pkg_part.tar.xz", "$temp");
       } else { # net
@@ -1351,31 +1401,119 @@ sub write_w32_updater {
         return 1; # abort
       }
       # unpack xz archive
-      $sysret = system("$::progs{'xzdec'} < \"$temp/$pkg_part.tar.xz\" > \"$temp/$pkg_part.tar\"");
+      my $sysret = system("$::progs{'xzdec'} < \"$temp/$pkg_part.tar.xz\" > \"$temp/$pkg_part.tar\"");
       if ($sysret) {
         tlwarn("Couldn't unpack $pkg_part.tar.xz\n");
         return 1; # unpack failed? abort
       }
       unlink("$temp/$pkg_part.tar.xz"); # we don't need that archive anymore
-      push @updater_args, $pkg_part, $oldrev, $newrev;
     }
   }
-  return 0 if ($opts{"dry-run"}); # nothing else to do
-  my @rerun_tlmgr_args;
-  # quote all arguments in case of manes with spaces
-  @rerun_tlmgr_args = map ("\"$_\"", @::SAVEDARGV) if $restart_tlmgr;
+  
   # prepare updater script
-  copy("$root/texmf/scripts/texlive/updater-w32", "$temp");
-  open UPDATER, ">>$temp/updater-w32" or die "Cannot open updater script: $!";
-  print UPDATER "
-:setupenv
-set w32upd_gui_mode=$::gui_mode
-set w32upd_title=TeX Live Manager $TeXLive::TLConfig::ReleaseYear Update
-set w32upd_debug=$::opt_verbosity
-set w32upd_args=@updater_args
-set w32upd_rerun_args=@rerun_tlmgr_args
-";
-  close UPDATER;
+  my $respawn_cmd = "cmd.exe /e:on/v:off/d/c";
+  $respawn_cmd = "start /wait $respawn_cmd" if ($::gui_mode);
+  my $gui_pause = ($::gui_mode ? "pause" : "rem");
+  my $upd_log = ($::opt_verbosity ? "STDERR" : '"%~dp0update-self.log"');
+  my $std_handles_redir = ($::opt_verbosity ? "1^>^&2" : "2^>$upd_log 1^>^&2");
+  my $pkg_log = ($packagelogfile ? "\"$packagelogfile\"" : "nul");
+  my $post_update_msg = "You may now close this window.";
+  my $rerun_tlmgr = "rem";
+  if ($restart_tlmgr) {
+    $post_update_msg = "About to restart tlmgr to complete update ...";
+    # quote all arguments for tlmgr restart in case of spaces
+    $rerun_tlmgr = join (" ", map ("\"$_\"", @::SAVEDARGV) );
+    $rerun_tlmgr = "if not errorlevel 1 tlmgr.bat $rerun_tlmgr";
+  }
+  my $batch_script = <<"EOF";
+:: This file is part of an automated update process of
+:: infrastructure files and should not be run standalone. 
+:: For more details about the update process see comments 
+:: in tlmgr.pl (subroutine write_w32_updater).
+
+  if [%1]==[:doit] goto :doit
+  if not exist "%~dp0tar.exe" goto :notar
+  $respawn_cmd call "%~f0" :doit $std_handles_redir
+  $rerun_tlmgr
+  goto :eof
+
+:notar
+  echo %~nx0: cannot run without "%~dp0tar.exe"
+  findstr "^::" <"%~f0"
+  exit /b 1
+
+:doit
+  set prompt=TL\$G
+  title TeX Live Manager $TeXLive::TLConfig::ReleaseYear Upadate
+  set PERL5LIB=$root/tlpkg/tlperl/lib
+  >con echo DO NOT CLOSE THIS WINDOW!
+  >con echo TeX Live infrastructure update in progress ...
+  >con echo Detailed command logging to $upd_log
+  chdir /d "%~dp0.."
+  if not errorlevel 1 goto :update
+  >con echo Could not change working directory to "%~dp0.."
+  >con echo Aborting infrastructure update, no changes have been made.
+  >con $gui_pause 
+  exit /b 1
+    
+:update
+  for %%I in (@upd_tar) do (
+    temp\\tar.exe -xf temp\\%%I
+    if errorlevel 1 goto :rollback
+  )
+  tlpkg\\tlperl\\bin\\perl.exe texmf\\scripts\\texlive\\tlmgr.pl _include_tlpobj @upd_tlpobj
+  if errorlevel 1 goto :rollback
+  >>$pkg_log echo [%date% %time%] self update: @upd_info
+  >con echo self update: @upd_info
+  del "%~dp0*.tar" "%~dp0tar.exe" 
+  >con echo Infrastructure update finished successfully.
+  >con echo $post_update_msg
+  >con $gui_pause 
+  exit /b 0
+
+:rollback
+  >>$pkg_log echo [%date% %time%] failed self update: @upd_info
+  >con echo failed self update: @upd_info
+  >con echo Rolling back to previous version ...
+  for %%I in (@rst_tar) do (
+    temp\\tar.exe -xf temp\\%%I
+    if errorlevel 1 goto :panic
+  )
+  tlpkg\\tlperl\\bin\\perl.exe texmf\\scripts\\texlive\\tlmgr.pl _include_tlpobj @rst_tlpobj
+  if errorlevel 1 goto :panic
+  >>$pkg_log echo [%date% %time%] self restore: @rst_info
+  >con echo self restore: @rst_info
+  >con echo Infrastructure update failed. Previous version has been restored.
+  >con $gui_pause 
+  exit /b 1
+
+:panic
+  >>$pkg_log echo [%date% %time%] failed self restore: @rst_info
+  >con echo failed self restore: @rst_info
+  >con echo FATAL ERROR:
+  >con echo Infrastructure update failed and backup recovery failed too.
+  >con echo To repair your TeX Live installation download and run:
+  >con echo $TeXLive::TLConfig::TeXLiveURL/update-tlmgr-latest.exe
+  >con $gui_pause 
+  exit /b 666
+EOF
+
+  ddebug("\n:: UPDATER BATCH SCRIPT ::\n$batch_script\n:: END OF FILE ::\n");
+  if ($opts{"dry-run"}) {
+    my $upd_info = "self update: @upd_info";
+    $upd_info =~ s/\^//g;
+    info($upd_info);
+  } else {
+    copy("$root/tlpkg/installer/tar.exe", "$temp");
+    # make sure copied tar is working
+    if (system("\"$temp/tar.exe\" --version >nul")) {
+      tlwarn("Could not copy tar.exe, that is bad.\n");
+      return 1; # abort
+    }
+    open UPDATER, ">$temp/updater-w32" or die "Cannot create updater script: $!";
+    print UPDATER $batch_script;
+    close UPDATER;
+  }
   return 0;
 }
 
@@ -1934,6 +2072,11 @@ sub action_update {
     #
     # the remove_package should also remove empty dirs in case
     # a dir is changed into a file
+    if ($pkg =~ m/$CriticalPackagesRegexp/) {
+      debug("Not removing critical package $pkg\n");
+    } else {
+      $localtlmedia->remove_package($pkg);
+    }
     $localtlmedia->remove_package($pkg);
     if ($tlmediasrc->install_package($pkg, $localtlpdb)) {
       # installation succeeded because we got a reference