diff options
| -rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 82 | ||||
| -rwxr-xr-x | Master/tlpkg/bin/tl-update-containers | 5 | ||||
| -rwxr-xr-x | Master/tlpkg/bin/tl-update-tlnet | 6 |
3 files changed, 53 insertions, 40 deletions
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index 0a087d22d00..7b75b4cd2cc 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -8,10 +8,7 @@ package TeXLive::TLPOBJ; use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp $MetaCategoriesRegexp $InfraLocation); use TeXLive::TLUtils; -#use File::Path; use TeXLive::TLTREE; -#use FileHandle; # format_name in writeout, no idea how to rewrite -#use File::Basename; our $_tmp; my $_containerdir; @@ -419,10 +416,11 @@ sub writeout_simple { } } + sub make_container { my ($self,$type,$instroot,$destdir,$containername,$relative) = @_; if (($type ne "lzma") && ($type ne "tar")) { - die "TLPOBJ currently supports only plain or lzma containers, not $type"; + die "$0: TLPOBJ supports tar and lzma containers, not $type"; } if (!defined($containername)) { $containername = $self->name; @@ -446,7 +444,8 @@ sub make_container { my $tmp; ($tmp) = split m@/@; if (defined($tltree) && ($tltree ne $tmp)) { - die "Not generating relative package for multiple tree spanning packages\n"; + die ("$0: package $containername spans multiple trees, " + . "relative generation not allowed"); } else { $tltree = $tmp; } @@ -476,7 +475,8 @@ sub make_container { &TeXLive::TLUtils::mkdirhier("$tlpobjdir"); $removetlpobjdir = 1; } - open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") or die "Cannot create $tlpobjdir/$self->{'name'}.tlpobj"; + open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") + || die "$0: create($tlpobjdir/$self->{'name'}.tlpobj) failed: $!"; $self->writeout(\*TMP); close(TMP); push @files, "$tlpobjdir/$self->{'name'}.tlpobj"; @@ -491,57 +491,71 @@ sub make_container { my $tar = $::progs{'tar'}; my $lzma; if (!defined($tar)) { - tlwarn("Programs have not been set up, trying with \"tar\"!\n"); + tlwarn("$0: programs not set up, trying \"tar\".\n"); $tar = "tar"; } if ($type eq "lzma") { $lzma = $::progs{'lzma'}; if (!defined($lzma)) { - tlwarn("Programs have not been set up, trying with \"lzma\"!\n"); + tlwarn("$0: programs not set up, trying \"lzma\".\n"); $lzma = "lzma"; } } - my @cmdline = ($tar, "--owner", "0", "--group", "0", "-c", "-f", "$destdir/$tarname", "--files-from=-"); - #debug("make_container: running @cmdline\n"); - unlink("$destdir/$containername"); - unlink("$destdir/$tarname"); - if (win32()) { - # we have to hack around this stupid win32 ... - open ZIP, "|$tar -c -f \"$destdir/$tarname\" --files-from=-" - or die "Cannot open container program $tar -c -f \"$destdir/$tarname\" --files-from=-: $!"; - } else { - open ZIP, "|-", @cmdline or die "Cannot open container program @cmdline: $!"; - } - map { - if (-f $_ || -l $_) { - print ZIP "$_\n"; - + # No owner/group options if we are being called on a user's machine to + # make a backup. We only want these when we are making the master + # containers for tlnet. + my @attrs = $containername =~ /\.r[0-9]/ + ? () : ("--owner", "0", "--group", "0"); + my @cmdline = ($tar, "-cf", "$destdir/$tarname", @attrs); + + # Get list of files. We have to pass them all on the command line, + # because there is no portable way to pass them on stdin. This can be + # a lengthy command line, but modern systems have enough argv space. + # our biggest package is tex4ht, which needs about 200k. + for my $f (@files) { + if (-f $f || -l $f) { + push(@cmdline, $f); } else { - tlwarn("!!!Error: non-existent $_\n"); + tlwarn("$0: (make_container) $_ not a file or directory"); } - } @files; - close ZIP; + } + + # create tar file. + # unlink both here in case the container is also the plain tar. + unlink("$destdir/$tarname"); + unlink("$destdir/$containername"); + xsystem(@cmdline); + + # compress it. if ($type eq "lzma") { if (-r "$destdir/$tarname") { system($lzma, "--force", "-z", "$destdir/$tarname"); } else { - tlwarn("Couldn't find $destdir/$tarname\n"); - return(0,0,""); + tlwarn("$0: Couldn't find $destdir/$tarname to run $lzma\n"); + return (0, 0, ""); } } - # compute the size + + # compute the size. + if (! -r "$destdir/$containername") { + tlwarn ("$0: Couldn't find $destdir/$containername\n"); + return (0, 0, ""); + } my $size = (stat "$destdir/$containername") [7]; - my $m = TeXLive::TLUtils::tlmd5("$destdir/$containername"); + my $md5 = TeXLive::TLUtils::tlmd5("$destdir/$containername"); + # cleaning up unlink("$tlpobjdir/$self->{'name'}.tlpobj"); - rmdir("$tlpobjdir") if $removetlpobjdir; - chdir($cwd); - ddebug("Done $containername\n"); - return($size,$m,"$destdir/$containername"); + rmdir($tlpobjdir) if $removetlpobjdir; + xchdir($cwd); + + debug(" done $containername, size $size, $md5\n"); + return ($size, $md5, "$destdir/$containername"); } + sub is_arch_dependent { my $self = shift; if (keys %{$self->{'binfiles'}}) { diff --git a/Master/tlpkg/bin/tl-update-containers b/Master/tlpkg/bin/tl-update-containers index 6a96f6e7b71..a7ae8e9c69c 100755 --- a/Master/tlpkg/bin/tl-update-containers +++ b/Master/tlpkg/bin/tl-update-containers @@ -158,9 +158,8 @@ sub main } else { # This can happen when packages get renamed or files get # shuffled from one package to another. - tlwarn("The revision of $pkg in texlive.tlpdb ", - "($newrev) is OLDER than the one in ", - "$opt_location/tlpkg/texlive.tlpdb ($oldrev)\n"); + tlwarn("$0: $pkg in source tree is OLDER ($newrev) than in ", + "$opt_location/tlpkg/texlive.tlpdb ($oldrev); continuing.\n"); push @todopacks, $pkg; } } diff --git a/Master/tlpkg/bin/tl-update-tlnet b/Master/tlpkg/bin/tl-update-tlnet index 9b90328faf6..78d4fcc442d 100755 --- a/Master/tlpkg/bin/tl-update-tlnet +++ b/Master/tlpkg/bin/tl-update-tlnet @@ -14,7 +14,7 @@ yyyy=2008 chicken=false critical= recreate= -testinstall=true +do_testinstall=true verbose= @@ -23,7 +23,7 @@ while test $# -gt 0; do --critical) critical=--all;; --dry-run|-n) chicken=true;; --master) shift; Master=$1;; - --no-testinstall|-N) testinstall=false;; + --no-testinstall|-N) do_testinstall=false;; --recreate) recreate=--recreate;; --testlocation) shift; tltrybase=$1;; -v|-vv|-vvv) verbose=$1;; @@ -79,7 +79,7 @@ $Master/tlpkg/bin/tl-update-install-pkg -o $tltry END_COW # if not doing the test installation, never push anything out. -$testinstall || exit 0 +$do_testinstall || exit 0 # # Now we have an updated tlweb in $tltry where only the changed files |