#!/usr/bin/env perl # $Id$ # Copyright 2008-2018 Norbert Preining # This file is licensed under the GNU General Public License version 2 # or any later version. # # Generate archive file(s) for the packages specified on the cmdline # (doesn't really work, not documented), or all (except some critical # packages) if none specified. BEGIN { $vc_id = '$Id$'; $^W = 1; ($mydir = $0) =~ s,/[^/]*$,,; unshift (@INC, "$mydir/.."); } use strict; use TeXLive::TLConfig; use TeXLive::TLPOBJ; use TeXLive::TLPDB; use TeXLive::TLUtils; use Getopt::Long; use Pod::Usage; use File::Path; my $script_master; # packages matching these re's will not be updated without --all. my @critical_pkg_list = qw/texlive\.infra tlperl\.win32/; our ($mydir, $vc_id); my $opt_all = 0; my $opt_dry = 0; my $opt_gpgcmd = ""; my $opt_location = "."; my $opt_master; my $opt_nosetup = 0; my $opt_recreate = 0; my $opt_relative = 1; my $opt_version = 0; my $opt_help = 0; my $opt_nosign = 0; TeXLive::TLUtils::process_logging_options(); GetOptions( "all|a" => \$opt_all, "dry-run|n" => \$opt_dry, "gpgcmd=s" => \$opt_gpgcmd, "location=s" => \$opt_location, "master=s" => \$opt_master, "no-setup" => \$opt_nosetup, "no-sign" => \$opt_nosign, "recreate" => \$opt_recreate, "relative!" => \$opt_relative, "version" => \$opt_version, "help|?" => \$opt_help) or pod2usage(1); pod2usage("-exitstatus" => 0, "-verbose" => 2) if $opt_help; if ($opt_version) { print "$vc_id\n"; exit 0; } exit (&main()); sub main { # check that we have a target db. if (! $opt_recreate && ! -r "$opt_location/tlpkg/texlive.tlpdb") { die "$0: Cannot load tlpdb from output directory $opt_location;\n" . " specify --recreate if you want to populate anew.\n"; } # get source db, same hierarchy from which we are being run. chomp(my $script_master = `cd $mydir/../.. && pwd`); my $Master = ($opt_master ? $opt_master : $script_master); my $tlpdb = TeXLive::TLPDB->new("root" => $Master); die "cannot find tlpdb in $Master" unless defined($tlpdb); my @packs = $tlpdb->expand_dependencies("-only-arch", $tlpdb, @ARGV ? @ARGV : $tlpdb->list_packages); # if no argument passed, we use tl-sign-file from script_master if (! $opt_gpgcmd) { $opt_gpgcmd = "$script_master/tlpkg/bin/tl-sign-file"; } if (! TeXLive::TLCrypto::setup_checksum_method()) { die "TLCrypto::setup_checksum_method() failed"; } # get configuration of package splitting my $srcsplit = $tlpdb->config_src_container; my $docsplit = $tlpdb->config_doc_container; my $format = $tlpdb->config_container_format; my $type = "xz"; if ($format eq "xz") { $type = $format; } else { tlwarn("$0: unknown container format $format in 00texlive.config; ", "ignoring and continuing with $type"); } debug("$Master: format=$type srcsplit=$srcsplit docsplit=$docsplit\n"); my $nettlpdb; my %count; my @todopacks = (); my @removepacks = (); my @removecontainers = (); my $opt_containerdir = "$opt_location/$TeXLive::TLConfig::Archive"; &debug("output containerdir = $opt_containerdir\n"); my @disabled_pkgs = TeXLive::TLUtils::tlnet_disabled_packages($Master); print "additional tlnet disabled packages: @disabled_pkgs\n"; if ($opt_recreate) { # remake everything. if (@ARGV) { @todopacks = @packs; $nettlpdb = TeXLive::TLPDB->new; die "cannot create new tlpdb" unless defined($nettlpdb); } else { @todopacks = $tlpdb->list_packages; $nettlpdb = $tlpdb->copy; } $nettlpdb->root($opt_location); } else { $nettlpdb = TeXLive::TLPDB->new("root" => $opt_location); if (!defined($nettlpdb)) { die "cannot init tlpdb from $opt_location"; } my %archiverevs; for my $pkg ($nettlpdb->list_packages()) { $archiverevs{$pkg} = $nettlpdb->get_package($pkg)->revision(); if (!defined($tlpdb->get_package($pkg))) { # $pkg has disappeared, removing it push @removepacks, $pkg; } } # collect packages to be updated. $count{"new"} = $count{"removed"} = $count{"updated"} = $count{"unchanged"} = 0; for my $pkg (@packs) { # by definition, any 00texlive... package does not need containers. next if $pkg =~ /00texlive/; # disable all packages (ignoring .ARCH parts) if they appear in # tlnet-disabled-packages.txt my $shortpkg = $pkg; $shortpkg =~ s/\..*$//; if (TeXLive::TLUtils::member($shortpkg, @disabled_pkgs)) { if ($opt_all || $opt_recreate) { tlwarn("$0: Updating tlnet disabled $pkg due to -all\n"); } else { tlwarn("$0: $pkg disabled for tlnet updates\n"); next; } } my $oldrev = 0; if (-r "$opt_containerdir/$pkg.tar.$type" && defined($archiverevs{$pkg})) { $oldrev = $archiverevs{$pkg}; } else { info("$0: $pkg is new\n"); $count{"new"}++; } my $tlp = $tlpdb->get_package($pkg); my $newrev = 0; if (defined($tlp)) { $newrev = $tlp->revision; } else { # this can happen with typos on the command line. die "no package $pkg in location $opt_location, goodbye"; } if ($oldrev == $newrev) { ddebug("$pkg up to date\n"); # check for the existence of all containers in case they go missing if (($tlp->runfiles && ! -r "$opt_containerdir/$pkg.tar.$type") || ($srcsplit && $tlp->srcfiles && ! -r "$opt_containerdir/$pkg.source.tar.$type") || ($docsplit && $tlp->docfiles && ! -r "$opt_containerdir/$pkg.doc.tar.$type")) { info("$0: container(s) for $pkg disappeared, recreating them.\n"); push @todopacks, $pkg; $count{"updated"}++; } else { $count{"unchanged"}++; } } elsif ($oldrev < $newrev) { push @todopacks, $pkg; $count{"updated"}++ if $oldrev; } else { # This can happen when packages get renamed or files get # shuffled from one package to another. tlwarn("$0: $pkg in source tree is OLDER ($newrev) than in ", "$opt_location/tlpkg/texlive.tlpdb ($oldrev); continuing.\n"); push @todopacks, $pkg; } } } # The two packages 00texlive.config and 00texlive.installation # are essential and have to be included in each and every case. # # 00texlive.installer and 00texlive.image are not essential, but keep # them up to date in the net directory (tlnet) to avoid stale data in # the tlpdb there. # # If more 00texlive.* packages are needed in tlpdb in the future, # most likely they should be added here too. # for my $name (qw(config installation installer image)) { my $tlp00 = $tlpdb->get_package("00texlive.$name"); if ($tlp00) { $nettlpdb->add_tlpobj($tlp00); } else { if ($name eq "config" || $name eq "installation") { tlwarn("$0: essential package 00texlive.$name seems to be missing!\n"); } } } # set up the programs. if ($opt_nosetup) { # do a minimal setup $::progs{'xz'} = "xz"; $::progs{'tar'} = "tar"; } else { # do a full setup my $ret = &TeXLive::TLUtils::setup_programs("$script_master/tlpkg/installer"); if (!$ret) { tlwarn("$0: binaries could not be set up, aborting.\n"); exit 1; } } # get list of packages. PACKS: for my $pkg (sort @todopacks) { next if $pkg =~ /00texlive/; foreach my $manualpkgre (@critical_pkg_list) { # we match the initial string of the package name, so that all the # .arch packages are skipped, too if ($pkg =~ m/^$manualpkgre/) { if ($opt_all || $opt_recreate) { tlwarn("$0: Updating critical $pkg due to -all\n"); last; # of the manualpkgre checks } else { tlwarn("$0: Skipping critical $pkg\n"); # we assume that the packages in @critical_pkg_list always # exist, so if they are there then the number of updated packages # should be reduced. $count{'updated'}--; # the following line skips all other regexp checks on critical # packages and skips everything below this (the part which # actually builds the containers) and continues with the next # package (the PACKS: label above). next PACKS; } } } my $obj = $tlpdb->get_package ($pkg); die "no package $pkg in master $Master, goodbye" if ! $obj; debug("updating $pkg containers ...\n"); # we have to make a copy otherwise the src/doc files in the original # tlpobj are removed, and thus also in the tlpdb to be saved!!! my $objcopy = $obj->copy; # if we try to create relative containers we check the package # for residing only in texmf-dist, and being relocatable, and # not having a dependency on $pkg.ARCH # TLPOBJ->common_texmf_tree returns the string of the # common temxf tree or undefined, so we can use it in && my $ctt = $objcopy->common_texmf_tree; my $deps_on_arch = 0; for ($objcopy->depends) { if (m/^$pkg\.ARCH$/) { $deps_on_arch = 1; last; } } my $do_relative = $opt_relative && # user option ($deps_on_arch?0:1) && # no $pkg.ARCH dep (defined($ctt)?1:0) && # see above (($ctt eq $TeXLive::TLConfig::RelocTree) ? 1 : 0); # only for texmf-dist debug("pkg=$pkg, do_relative=$do_relative, deps_on_arch=$deps_on_arch, " . "ctt=", defined($ctt) ? $ctt : "(undefined)", "\n"); if ($srcsplit) { if (!$opt_dry) { my $objsrc = $obj->srcfiles_package; $objcopy->clear_srcfiles; if ($objsrc) { my ($s,$m) = $objsrc->make_container($type, $Master, destdir => $opt_containerdir, containername => "$pkg.source", relative => $do_relative, user => 0); if ($s > 0) { # something was created # important, we have to add it to the original $obj $obj->srccontainersize($s); } if ($m ne "") { $obj->srccontainerchecksum($m); } } else { # no src files in the package, so remove old .source containers push @removecontainers, "$pkg.source"; } } } else { # remove the .source container push @removecontainers, "$pkg.source"; } if ($docsplit) { if (!$opt_dry) { my $objdoc = $obj->docfiles_package; $objcopy->clear_docfiles; if ($objdoc) { my ($s,$m) = $objdoc->make_container($type, $Master, destdir => $opt_containerdir, containername => "$pkg.doc", relative => $do_relative, user => 0); if ($s > 0) { # something was created $obj->doccontainersize($s); } if ($m ne "") { $obj->doccontainerchecksum($m); } } else { # no doc files in the package, so remove old .doc containers push @removecontainers, "$pkg.doc"; } } } else { # remove the .doc containers push @removecontainers, "$pkg.doc"; } if (!$opt_dry) { my ($s,$m) = $objcopy->make_container($type, $Master, destdir => $opt_containerdir, containername => $pkg, relative => $do_relative, user => 0); if ($s > 0) { $obj->containersize($s); } if ($m ne "") { $obj->containerchecksum($m); } } # if the container has been build relocatable we save that information $obj->relocated($do_relative); # and remove the common prefix from the files in the tlpobj $obj->cancel_common_texmf_tree if $do_relative; # add the updated (or new) TLPOBJ to NET TLPDB # that way the other container sizes are not destroyed $nettlpdb->add_tlpobj($obj) unless $opt_dry; } # remove old containers for my $op (@removecontainers) { if (-r "$opt_containerdir/$op.tar.xz") { info("$0: $op container is old, removing it\n"); `rm $opt_containerdir/$op.*` unless $opt_dry; } } # next we remove those containers which have been gone! REMOVEPACK: for my $op (@removepacks) { foreach my $manualpkgre (@critical_pkg_list) { # we match the initial string of the package name, so that all the # .arch packages are skipped, too if ($op =~ m/^$manualpkgre/) { if ($opt_all || $opt_recreate) { tlwarn("$0: Removing critical $op due to -all\n"); last; # of the manualpkgre checks } else { tlwarn("$0: Skipping removal of critical $op\n"); # the following line skips all other regexp checks on critical # packages and skips everything below this (the part which # actually builds the containers) and continues with the next # package (the PACKS: label above). next REMOVEPACK; } } } info("$0: $op has disappeared, removing its containers\n"); `rm $opt_containerdir/$op.*` unless $opt_dry; $nettlpdb->remove_package($op) unless $opt_dry; $count{"removed"}++; } if ($opt_recreate) { info("$0: all packages recreated.\n"); } else { if (@todopacks) { # we updated something info("$0: $count{new} new, $count{removed} removed, " . "$count{updated} updated, $count{unchanged} unchanged.\n"); } else { info("$0: nothing to be done.\n"); } } return 0 if $opt_dry; # STRANGE: It seems that calling -recreate did not save the # docfiles into the texlive.tlpdb, no idea why. So update should now # do that. $nettlpdb->save; system("$::progs{'xz'} --force -k -z $opt_location/tlpkg/texlive.tlpdb"); chomp (my $olddir = `pwd`); if (chdir("$opt_location/tlpkg/")) { xsystem("md5sum texlive.tlpdb > texlive.tlpdb.md5"); xsystem("$TeXLive::TLConfig::ChecksumProgram texlive.tlpdb > texlive.tlpdb.$TeXLive::TLConfig::ChecksumExtension"); # remove signature, otherwise gpg breaks xsystem("rm -f texlive.tlpdb.$TeXLive::TLConfig::ChecksumExtension.asc"); if (! $opt_nosign) { xsystem($opt_gpgcmd, "texlive.tlpdb.$TeXLive::TLConfig::ChecksumExtension"); } xchdir($olddir); } else { tldie("chdir($opt_location/tlpkg/) for md5/checksum creation failed\n: $!"); } if (! @ARGV) { # do a last check that all the containers are actually present foreach my $p ($nettlpdb->list_packages) { next if $p =~ /00texlive/; if (! -r "$opt_containerdir/$p.tar.xz") { tlwarn("$0: container for $p is missing, strange\n"); } } } return 0; } __END__ =head1 NAME tl-update-containers - create, update, or remove TL containers =head1 SYNOPSIS tl-update-containers [I