From ec1e0195429b544a33f9d02b31cbd7acdbc4253d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 31 Jan 2024 22:07:08 +0000 Subject: [PATCH] updating installer data --- texmf-dist/scripts/texlive/tlmgr.pl | 104 ++++++++++++++---- tlpkg/TeXLive/TLPDB.pm | 160 +++++++++++++--------------- tlpkg/TeXLive/TLUtils.pm | 61 +++++++---- 3 files changed, 202 insertions(+), 123 deletions(-) diff --git a/texmf-dist/scripts/texlive/tlmgr.pl b/texmf-dist/scripts/texlive/tlmgr.pl index fa98ec78..e1ec0d50 100755 --- a/texmf-dist/scripts/texlive/tlmgr.pl +++ b/texmf-dist/scripts/texlive/tlmgr.pl @@ -65,7 +65,7 @@ BEGIN $kpsewhichname = "kpsewhich"; } if (-r "$bindir/$kpsewhichname") { - # if not in bootstrapping mode => kpsewhich exists, so use it to get $Master + # not in bootstrapping mode => kpsewhich exists, so use it to get $Master chomp($Master = `kpsewhich -var-value=TEXMFROOT`); } @@ -835,7 +835,8 @@ sub execute_action { # run CMD with notice to the user and if exit status is nonzero, complain. -# return exit status. +# log output with logcommand (tlmgr-commands.log). +# return F_OK or F_ERROR. # sub do_cmd_and_check { my $cmd = shift; @@ -851,7 +852,8 @@ sub do_cmd_and_check { $out = ""; } elsif (wndws() && (! -r "$Master/bin/windows/luatex.dll")) { # deal with the case where only scheme-infrastructure is installed - # on Windows, thus no luatex.dll is available and the wrapper cannot be started + # on Windows, thus no luatex.dll is available and the wrapper cannot + # be started tlwarn("Cannot run wrapper due to missing luatex.dll\n"); $ret = $F_OK; $out = ""; @@ -860,27 +862,28 @@ sub do_cmd_and_check { } $out =~ s/\n+$//; # trailing newlines don't seem interesting my $outmsg = "output:\n$out\n--end of output of $cmd.\n"; - if ($ret == $F_OK) { + if ($ret == 0) { info("done running $cmd.\n") unless $cmd =~ /^fmtutil/; logcommand("success, $outmsg"); ddebug("$cmd $outmsg"); - return ($F_OK); } else { info("\n"); tlwarn("$prg: $cmd failed (status $ret), output:\n$out\n"); logcommand("error, status: $ret, $outmsg"); - return ($F_ERROR); + $ret = $F_ERROR; } + return $ret; } # run external programs (mktexlsr, updmap-sys, etc.) as specified by the -# keys in the RET hash. We return the number of unsuccessful runs, zero -# if all ok. +# keys in the ::execute_actions hash. We return the number of +# unsuccessful runs, zero if all ok. # # If the "map" key is specified, the value may be a reference to a list # of map command strings to pass to updmap, e.g., "enable Map=ascii.map". # sub handle_execute_actions { + debug("starting handle_execute_actions\n"); my $errors = 0; my $sysmode = ($opts{"usermode"} ? "-user" : "-sys"); @@ -988,7 +991,7 @@ sub handle_execute_actions { for my $e (keys %updated_engines) { debug ("updating formats based on $e\n"); $errors += do_cmd_and_check - ("$fmtutil_cmd --byengine $e --no-error-if-no-format $fmtutil_args"); + ("$fmtutil_cmd --byengine $e --no-error-if-no-format $fmtutil_args"); read_and_report_fmtutil_status_file($status_file); unlink($status_file); } @@ -1007,10 +1010,10 @@ sub handle_execute_actions { # now go back to the hyphenation patterns and regenerate formats # based on the various language files - # this of course will in some cases duplicate fmtutil calls, + # this will in some cases duplicate fmtutil calls, # but it is much easier than actually checking which formats # don't need to be updated - + # if ($regenerate_language) { for my $ext ("dat", "def", "dat.lua") { my $lang = "language.$ext"; @@ -1030,8 +1033,9 @@ sub handle_execute_actions { # --refresh existing formats to avoid generating new ones. if ($::regenerate_all_formats) { info("Regenerating existing formats, this may take some time ..."); - # --refresh might already be in $invoke_fmtutil, but we don't care - $errors += do_cmd_and_check("$fmtutil_cmd --refresh --all $fmtutil_args"); + # --refresh might already be in $fmtutil_args, but that's ok. + my $args = "--refresh --all"; + $errors += do_cmd_and_check("$fmtutil_cmd $args $fmtutil_args"); read_and_report_fmtutil_status_file($status_file); unlink($status_file); info("done\n"); @@ -1039,18 +1043,70 @@ sub handle_execute_actions { } } + # lmtx/context cache creation/update. This variable is set, in + # TLPDB::install_package, when the context package is updated or installed. + if (defined $::context_cache_update_needed + && $::context_cache_update_needed) { + if ($opts{"dry-run"}) { + debug("dry-run, skipping context cache update\n"); + } else { + my $progext = ($^O =~ /^MSWin/i ? ".exe" : ""); + $errors += + TeXLive::TLUtils::update_context_cache($bindir, $progext, + \&run_postinst_logcommand); + } + $::context_cache_update_needed = 0; + } + # undefine the global var, otherwise in GUI mode the actions # are accumulating undef %::execute_actions; + debug("finished handle_execute_actions, errors=$errors\n"); if ($errors > 0) { - # should we return warning here? + # warning might suffice sometimes, but safer to return error. return $F_ERROR; } else { return $F_OK; } } +# Run CMD with output logged via logcommand(). We use this for the +# ConTeXt cache updates (above); since they are so verbose, we want the +# output to be only in tlmgr-commands.log, not tlmgr.log or the terminal. +# +# This is the same result as do_cmd_and_check, which we use for the +# other postaction commands (fmtutil, etc.); the difference is that for +# context, we want to share the code to actually do the updates with +# install-tl, so there is a common routine TLUtils::update_context_cache, +# and thus we have to handle the logging differently. +# +# Another approach would be to move do_cmd_and_check to TLUtils and +# have install-tl call that. Perhaps that would be cleaner, but then +# there is tlmgr-specific stuff that would have to be conditionalized. +# So, not great either way. Maybe someday we will merge install-tl and tlmgr. +# +# As a result, the logging text here surrounding the output is mostly a +# duplicate of what's in do_cmd_and_check. +# +sub run_postinst_logcommand { + my ($cmd) = @_; + logpackage("command: $cmd"); + logcommand("running $cmd"); + my $ret = TeXLive::TLUtils::run_cmd_with_log ($cmd, \&logcommand_bare); + my $outmsg = "\n--end of output of $cmd"; + if ($ret == 0) { + info("done running $cmd.\n") unless $cmd =~ /^fmtutil/; + logcommand("$outmsg (success).\n"); + } else { + info("\n"); + tlwarn("$prg: $cmd failed (status $ret), see $commandlogfile\n"); + logcommand("$outmsg (failure, status $ret"); + $ret = 1; + } + return $ret; +} + sub read_and_report_fmtutil_status_file { my $status_file = shift; my $fh; @@ -2258,7 +2314,7 @@ sub action_backup { if ($clean_mode) { clear_old_backups ($pkg, $opts{"backupdir"}, $opts{"clean"}, $opts{"dry-run"}, 1); } else { - # for now default to xz and allow overriding with env var + # for now default to xz and allow overriding with envvar my $compressorextension = $Compressors{$::progs{'compressor'}}{'extension'}; my $tlp = $localtlpdb->get_package($pkg); my $saving_verb = $opts{"dry-run"} ? "would save" : "saving"; @@ -3530,7 +3586,6 @@ sub action_update { print "end-of-updates\n" if $::machinereadable; - # # check that if updates to the critical packages are present all of # them have been successfully updated my $infra_update_done = 1; @@ -3926,6 +3981,7 @@ sub action_install { if (!$opts{"dry-run"}) { if ($remotetlpdb->install_package($pkg, $localtlpdb, ($packs{$pkg} ? $packs{$pkg} : undef) )) { + # installation succeeded because we got a reference logpackage("${re}install: $pkg$tagstr"); } else { logpackage("failed ${re}install: $pkg$tagstr"); @@ -5433,7 +5489,8 @@ sub action_recreate_tlpdb { next if $dirent eq "."; next if $dirent eq ".."; next unless -d "$Master/bin/$dirent"; - if (-r "$Master/bin/$dirent/kpsewhich" || -r "$Master/bin/$dirent/kpsewhich.exe") { + if (-r "$Master/bin/$dirent/kpsewhich" + || -r "$Master/bin/$dirent/kpsewhich.exe") { push @archs, $dirent; debug("$prg: skipping directory $Master/bin/$dirent, no kpsewhich there\n"); } @@ -6553,7 +6610,7 @@ sub action_key { chomp (my $TEXMFSYSCONFIG = `kpsewhich -var-value=TEXMFSYSCONFIG`); my $local_keyring = "$Master/tlpkg/gpg/repository-keys.gpg"; if ($arg eq 'list') { - debug("running $::gpg --list-keys\n"); + debug("running: $::gpg --list-keys\n"); system("$::gpg --list-keys"); return $F_OK; } elsif ($arg eq 'remove') { @@ -7691,11 +7748,18 @@ sub logpackage { } sub logcommand { if ($commandlogfile) { - $commandslogged++; + $commandslogged++; # not really counting commands logged, but calls my $tim = localtime(); print COMMANDLOG "[$tim] @_\n"; } } +# without the timestamp +sub logcommand_bare { + if ($commandlogfile) { + $commandslogged++; + print COMMANDLOG "@_\n"; + } +} # resolve relative paths from tlpdb wrt tlroot @@ -7767,7 +7831,7 @@ sub check_for_critical_updates { my $localrev = $tlp->revision; my $mtlp = $mediatlpdb->get_package($pkg); if (!defined($mtlp)) { - debug("Very surprising, $pkg is not present in the remote tlpdb.\n"); + debug("Surprising, $pkg not present in remote tlpdb.\n"); next; } my $remoterev = $mtlp->revision; diff --git a/tlpkg/TeXLive/TLPDB.pm b/tlpkg/TeXLive/TLPDB.pm index 06da78f3..2224e8ad 100644 --- a/tlpkg/TeXLive/TLPDB.pm +++ b/tlpkg/TeXLive/TLPDB.pm @@ -1658,42 +1658,11 @@ sub install_package_files { # place from where files should be installed if (!_install_data ($tmpdir, \@installfiles, $reloc, \@installfiles, $self)) { - tlwarn("TLPDB::install_package_files: couldn't install_data files: " + tlwarn("TLPDB::install_package_files: couldn't _install_data files: " . "@installfiles\n"); next; } - if ($reloc) { - if ($self->setting("usertree")) { - $tlpobj->cancel_reloc_prefix; - } else { - $tlpobj->replace_reloc_prefix; - } - $tlpobj->relocated(0); - } - my $tlpod = $self->root . "/tlpkg/tlpobj"; - mkdirhier( $tlpod ); - open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") or - die("Cannot open tlpobj file for ".$tlpobj->name); - $tlpobj->writeout(\*TMP); - close(TMP); - $self->add_tlpobj($tlpobj); - $self->save; - TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj); - # do the postinstallation actions - # - # Run the post installation code in the postaction tlpsrc entries - # in case we are on w32 and the admin did install for himself only - # we switch off admin mode - if (wndws() && admin() && !$self->option("w32_multi_user")) { - non_admin(); - } - # for now desktop_integration maps to both installation - # of desktop shortcuts and menu items, but we can split them later - &TeXLive::TLUtils::do_postaction("install", $tlpobj, - $self->option("file_assocs"), - $self->option("desktop_integration"), - $self->option("desktop_integration"), - $self->option("post_code")); + _post_install_package ($self, $tlpobj); # remember that we installed this package correctly $ret++; @@ -1701,12 +1670,14 @@ sub install_package_files { return $ret; } - + =pod =item C<< $tlpdb->install_package($pkg, $dest_tlpdb [, $tag]) >> -Installs the package $pkg into $dest_tlpdb. +Installs the package $pkg into $dest_tlpdb. Returns a reference to the +package, or undef if failure. + If C<$tag> is present and the tlpdb is virtual, tries to install $pkg from the repository tagged with $tag. @@ -1721,7 +1692,7 @@ sub install_package { } else { tlwarn("TLPDB::install_package: package $pkg not found" . " in repository $tag\n"); - return; + return undef; } } else { my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) @@ -1735,7 +1706,7 @@ sub install_package { } return $self->not_virtual_install_package($pkg, $totlpdb); } - return; + return undef; } sub not_virtual_install_package { @@ -1882,55 +1853,73 @@ sub not_virtual_install_package { if (!$real_opt_doc) { $tlpobj->clear_docfiles; } - # if a package is relocatable we have to cancel the reloc prefix - # and unset the relocated setting - # before we save it to the local tlpdb - if ($tlpobj->relocated) { - if ($totlpdb->setting("usertree")) { - $tlpobj->cancel_reloc_prefix; - } else { - $tlpobj->replace_reloc_prefix; - } - $tlpobj->relocated(0); - } - # we have to write out the tlpobj file since it is contained in the - # archives (.tar.xz) but at DVD install time we don't have them - my $tlpod = $totlpdb->root . "/tlpkg/tlpobj"; - mkdirhier($tlpod); - my $count = 0; - my $tlpobj_file = ">$tlpod/" . $tlpobj->name . ".tlpobj"; - until (open(TMP, $tlpobj_file)) { - # The open might fail for no good reason on Windows. - # Try again for a while, but not forever. - if ($count++ == 100) { die "$0: open($tlpobj_file) failed: $!"; } - select (undef, undef, undef, .1); # sleep briefly - } - $tlpobj->writeout(\*TMP); - close(TMP); - $totlpdb->add_tlpobj($tlpobj); - $totlpdb->save; - # compute the return value - TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj); - # do the postinstallation actions - # - # Run the post installation code in the postaction tlpsrc entries - # in case we are on w32 and the admin did install for himself only - # we switch off admin mode - if (wndws() && admin() && !$totlpdb->option("w32_multi_user")) { - non_admin(); - } - # for now desktop_integration maps to both installation - # of desktop shortcuts and menu items, but we can split them later - &TeXLive::TLUtils::do_postaction("install", $tlpobj, - $totlpdb->option("file_assocs"), - $totlpdb->option("desktop_integration"), - $totlpdb->option("desktop_integration"), - $totlpdb->option("post_code")); + _post_install_pkg ($totlpdb, $tlpobj); } return 1; } -# +# In TLPDB, Do post-install stuff for TLPOBJ: +# - cancel relocation stuff +# - write the tlpobj +# - handle post-installation actions +# +sub _post_install_pkg { + my ($tlpdb,$tlpobj) = @_; + + # if a package is relocatable we have to cancel the reloc prefix + # and unset the relocated setting + # before we save it to the local tlpdb + if ($tlpobj->relocated) { + if ($tlpdb->setting("usertree")) { + $tlpobj->cancel_reloc_prefix; + } else { + $tlpobj->replace_reloc_prefix; + } + $tlpobj->relocated(0); + } + # we have to write out the tlpobj file since it is contained in the + # archives (.tar.xz) but at DVD install time we don't have them + my $tlpod = $tlpdb->root . "/tlpkg/tlpobj"; + mkdirhier($tlpod); + my $count = 0; + my $tlpobj_file = ">$tlpod/" . $tlpobj->name . ".tlpobj"; + until (open(TMP, $tlpobj_file)) { + # The open might fail for no good reason on Windows. + # Try again for a while, but not forever. + if ($count++ == 100) { die "$0: open($tlpobj_file) failed: $!"; } + select(undef, undef, undef, .1); # sleep briefly + } + $tlpobj->writeout(\*TMP); + close(TMP); + $tlpdb->add_tlpobj($tlpobj); + $tlpdb->save; + # + # do postinstallation actions. + # + # Remember to do any postactions, including recording whether files + # have changed. + TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj); + # + # If this was context, remember to do its cache. + if ($tlpobj->name eq "context") { + TeXLive::TLUtils::announce_execute_actions("context-cache", $tlpobj); + } + # + # Run the post installation code in the postaction tlpsrc entries + # in case we are on w32 and the admin did install for himself only + # we switch off admin mode + if (wndws() && admin() && !$tlpdb->option("w32_multi_user")) { + non_admin(); + } + # for now desktop_integration maps to both installation + # of desktop shortcuts and menu items, but we can split them if need be. + &TeXLive::TLUtils::do_postaction("install", $tlpobj, + $tlpdb->option("file_assocs"), + $tlpdb->option("desktop_integration"), + $tlpdb->option("desktop_integration"), + $tlpdb->option("post_code")); +} + # _install_data # actually does the installation work # returns 1 on success and 0 on error @@ -1939,7 +1928,7 @@ sub not_virtual_install_package { # otherwise it is a tlpdb from where to install # sub _install_data { - my ($self, $what, $reloc, $filelistref, $totlpdb, $whatsize, $whatcheck) = @_; + my ($self, $what, $reloc, $filelistref, $totlpdb, $whatsize, $whatcheck) =@_; my $target = $totlpdb->root; my $tempdir = TeXLive::TLUtils::tl_tmpdir(); @@ -1997,6 +1986,7 @@ sub _install_data { } } + =pod =item << $tlpdb->remove_package($pkg, %options) >> @@ -2162,7 +2152,7 @@ sub remove_package { # files are already removed. # Again, desktop integration maps to desktop and menu links if (!$opts{'nopostinstall'}) { - debug(" TLPDB::remove_package: running remove postinstall"); + debug(" TLPDB::remove_package: running remove postinstall\n"); &TeXLive::TLUtils::do_postaction("remove", $tlp, $localtlpdb->option("file_assocs"), $localtlpdb->option("desktop_integration"), @@ -2558,7 +2548,7 @@ The purpose of virtual databases is to collect several data sources and present them in one way. The normal functions will always return the best candidate for the set of functions. -More docs to be written someday, maybe. +More docs to be written if there is any demand. =over 4 diff --git a/tlpkg/TeXLive/TLUtils.pm b/tlpkg/TeXLive/TLUtils.pm index 7cbf7be3..95f24576 100644 --- a/tlpkg/TeXLive/TLUtils.pm +++ b/tlpkg/TeXLive/TLUtils.pm @@ -1,6 +1,6 @@ # $Id$ # TeXLive::TLUtils.pm - the inevitable utilities for TeX Live. -# Copyright 2007-2023 Norbert Preining, Reinhard Kotucha +# Copyright 2007-2024 Norbert Preining, Reinhard Kotucha # This file is licensed under the GNU General Public License version 2 # or any later version. @@ -147,7 +147,8 @@ our $PERL_SINGLE_QUOTE; # we steal code from Text::ParseWords # We use myriad global and package-global variables, unfortunately. # To avoid "used only once" warnings, we must use the variable names again. # -# This ugly repetition in the BEGIN block works with all Perl versions. +# This ugly repetition in the BEGIN block works with all Perl versions; +# cleaner/fancier ways of handling this don't. BEGIN { $::LOGFILE = $::LOGFILE; $::LOGFILENAME = $::LOGFILENAME; @@ -164,6 +165,7 @@ BEGIN { $::machinereadable = $::machinereadable; $::no_execute_actions = $::no_execute_actions; $::regenerate_all_formats = $::regenerate_all_formats; + $::context_cache_update_needed = $::context_cache_update_needed; # $JSON::false = $JSON::false; $JSON::true = $JSON::true; @@ -818,6 +820,8 @@ the exit status of C<$cmd>. Environment variable overrides cannot be passed. (This is used for running special post-installation commands in install-tl and tlmgr.) +The C function is called to report what is happening. + =cut sub run_cmd_with_log { @@ -830,9 +834,9 @@ sub run_cmd_with_log { } else { info ("failed\n"); tlwarn ("$0: $cmd failed (status $ret): $!\n"); - $ret = 1; # be sure we don't overflow the sum on anything crazy + $ret = 1; } - &$logfn ($out); + &$logfn ($out); # log the output return $ret; } # run_cmd_with_log @@ -2275,11 +2279,11 @@ sub update_context_cache { my $errcount = 0; - # The story here is that in 2023, the lmtx binary for x86_64-linux was - # too new to run on the system where we build TL. (luametatex: - # /lib64/libm.so.6: version `GLIBC_2.23' not found) So we have to try - # running it to see if it is available, not just test for the - # program's existence. And since it exits nonzero given no args, we + # The story here is that in 2023, the provided lmtx binary for + # x86_64-linux was too new to run on the system where we build TL. + # (luametatex: /lib64/libm.so.6: version `GLIBC_2.23' not found) + # So we have to try running the binary to see if it works, not just + # test for its existence. And since it exits nonzero given no args, we # have to specify --version. Hope it keeps working like that ... # # If lmtx is not runnable, don't consider that an error, since nothing @@ -2294,6 +2298,10 @@ sub update_context_cache { $errcount += &$run_postinst_cmd("context --luatex --generate"); # # If context succeeded too, try luajittex. Missing on some platforms. + # Although we build luajittex normally, instead of importing the + # binary, testing for file existence should suffice, we may as + # well test execution since it's just as easy. + # if ($errcount == 0) { my $luajittex = "$bindir/luajittex$progext"; if (TeXLive::TLUtils::system_ok("$luajittex --version")) { @@ -2307,19 +2315,29 @@ sub update_context_cache { return $errcount; } -=item C +=item C + +Announces (records) that the actions, usually given in C<$tlpobj> (but +can be omitted for global actions), should be executed after all +packages have been unpacked. The optional C<$what> depends on the +action, e.g., a parse_AddFormat_line reference for formats; not sure if +it's used for anything else. -Announces that the actions given in C<$tlpobj> should be executed -after all packages have been unpacked. C<$what> provides -additional information. +This is called for every package that gets installed. =cut sub announce_execute_actions { - my ($type, $tlp, $what) = @_; - # do simply return immediately if execute actions are suppressed + my ($type,$tlp,$what) = @_; + # return immediately if execute actions are suppressed return if $::no_execute_actions; - + + # since we're called for every package with "enable", + # it's not helpful to report that again. + if ($type ne "enable") { + my $forpkg = $tlp ? ("for " . $tlp->name) : "no package"; + debug("announce_execute_actions: given $type ($forpkg)\n"); + } if (defined($type) && ($type eq "regenerate-formats")) { $::regenerate_all_formats = 1; return; @@ -2328,6 +2346,10 @@ sub announce_execute_actions { $::files_changed = 1; return; } + if (defined($type) && ($type eq "context-cache")) { + $::context_cache_update_needed = 1; + return; + } if (defined($type) && ($type eq "rebuild-format")) { # rebuild-format must feed in a hashref of a parse_AddFormat_line data # the $tlp argument is not used @@ -2337,17 +2359,18 @@ sub announce_execute_actions { if (!defined($type) || (($type ne "enable") && ($type ne "disable"))) { die "announce_execute_actions: enable or disable, not type $type"; } - my (@maps, @formats, @dats); if ($tlp->runfiles || $tlp->srcfiles || $tlp->docfiles) { $::files_changed = 1; } - $what = "map format hyphen" if (!defined($what)); + # + $what = "map format hyphen" if (!defined($what)); # do all by default foreach my $e ($tlp->executes) { if ($e =~ m/^add((Mixed|Kanji)?Map)\s+([^\s]+)\s*$/) { # save the refs as we have another =~ grep in the following lines my $a = $1; my $b = $3; $::execute_actions{$type}{'maps'}{$b} = $a if ($what =~ m/map/); + } elsif ($e =~ m/^AddFormat\s+(.*)\s*$/) { my %r = TeXLive::TLUtils::parse_AddFormat_line("$1"); if (defined($r{"error"})) { @@ -2356,6 +2379,7 @@ sub announce_execute_actions { $::execute_actions{$type}{'formats'}{$r{'name'}} = \%r if ($what =~ m/format/); } + } elsif ($e =~ m/^AddHyphen\s+(.*)\s*$/) { my %r = TeXLive::TLUtils::parse_AddHyphen_line("$1"); if (defined($r{"error"})) { @@ -2364,6 +2388,7 @@ sub announce_execute_actions { $::execute_actions{$type}{'hyphens'}{$r{'name'}} = \%r if ($what =~ m/hyphen/); } + } else { tlwarn("Unknown execute $e in ", $tlp->name, "\n"); }