#!/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. # # Updates/fixes the sizes and md5sums of all containers in a tlpdb. BEGIN { $vc_id = '$Id$'; $^W = 1; ($mydir = $0) =~ s,/[^/]*$,,; unshift (@INC, "$mydir/.."); } use strict; use TeXLive::TLConfig; use TeXLive::TLCrypto; use TeXLive::TLPOBJ; use TeXLive::TLPDB; use TeXLive::TLUtils; use Getopt::Long; use Pod::Usage; use File::Path; our ($mydir, $vc_id); my $opt_dry_run = 0; my $opt_location = "."; my $opt_nosetup = 0; my $opt_version = 0; my $opt_help = 0; TeXLive::TLUtils::process_logging_options(); GetOptions( "dry-run|n" => \$opt_dry_run, "location=s" => \$opt_location, "no-setup" => \$opt_nosetup, "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 { chomp(my $Master = `cd $mydir/../.. && pwd`); # check that we have a target db. if (! -r "$opt_location/tlpkg/texlive.tlpdb") { die "no file $opt_location/tlpkg/texlive.tlpdb"; } # get source db, same hierarchy from which we are being run. my $tlpdb = TeXLive::TLPDB->new("root" => $opt_location); die "cannot load tlpdb from root=$opt_location" unless defined($tlpdb); 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 $opt_containerdir = "$opt_location/$TeXLive::TLConfig::Archive"; # 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("$Master/tlpkg/installer"); if (!$ret) { tlwarn("$0: binaries could not be set up, aborting.\n"); exit 1; } } # get list of packages. for my $pkg (sort $tlpdb->list_packages) { next if $pkg =~ /00texlive/; my $obj = $tlpdb->get_package ($pkg); die "no package $pkg in master $Master, goodbye" if ! $obj; debug("doing $pkg containers ...\n"); my $newobj = do_containers($obj, $srcsplit, $docsplit); # replace with the new one with checksum and size changed, if needed $tlpdb->add_tlpobj($newobj || $obj); } if (! $opt_dry_run) { $tlpdb->save; xsystem("xz --force -k -z $opt_location/tlpkg/texlive.tlpdb"); } return 0; } sub do_containers { my ($obj, $dosrc, $dodoc) = @_; my $name = $obj->name; my $csize = $obj->containersize; my $csum = $obj->containerchecksum; return undef if $csize && $csum; info ("updating $name ($csize, no checksum)\n"); my $fbase = "$opt_location/archive/" . $obj->name; my ($a, $b) = do_size_checksum ("${fbase}.tar.xz"); $obj->containersize($a); $obj->containerchecksum($b); # # if no main checksum, almost certainly need to update src/doc too. if ($dosrc && $obj->srcfiles) { ($a, $b) = do_size_checksum ("${fbase}.source.tar.xz"); $obj->srccontainersize($a); $obj->srccontainerchecksum($b); } # if ($dodoc && $obj->docfiles) { ($a, $b) = do_size_checksum ("${fbase}.doc.tar.xz"); $obj->doccontainersize($a); $obj->doccontainerchecksum($b); } return $obj; } # computation of size/checksum values. # sub do_size_checksum{ my $f = shift; my $size = (stat $f)[7]; my $md = TeXLive::TLCrypto::tlchecksum($f); return($size, $md); } __END__ =head1 NAME tl-fix-container-infos - updates or adds size and checksum for containers =head1 SYNOPSIS tl-fix-container-infos [I