summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-06-30 16:37:31 +0000
committerNorbert Preining <preining@logic.at>2008-06-30 16:37:31 +0000
commita210df813ed206966a0f02b1e3ec47370d306c26 (patch)
treedc4d8501c7c1d9f69e7710366ddb56e7255cf5cf /Master/tlpkg/TeXLive
parent18bb1e2c2cf25f1d0e33edb438a899f6a80cae02 (diff)
adding support for md5 sums
git-svn-id: svn://tug.org/texlive/trunk@9115 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r--Master/tlpkg/TeXLive/TLPOBJ.pm47
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm62
2 files changed, 96 insertions, 13 deletions
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index f911f2a6cff..61f766d8e19 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -179,6 +179,18 @@ sub from_fh {
$self->doccontainersize("$1");
$lastcmd = "doccontainersize";
next;
+ } elsif ($line =~ /^containermd5\s+([a-f0-9]+)\s*/o) {
+ $self->containermd5("$1");
+ $lastcmd = "containermd5";
+ next;
+ } elsif ($line =~ /^srccontainermd5\s+([a-f0-9]+)\s*/o) {
+ $self->srccontainermd5("$1");
+ $lastcmd = "srccontainermd5";
+ next;
+ } elsif ($line =~ /^doccontainermd5\s+([a-f0-9]+)\s*/o) {
+ $self->doccontainermd5("$1");
+ $lastcmd = "doccontainermd5";
+ next;
} elsif ($line =~ /^catalogue\s+(.*)\s*/o) {
$self->catalogue("$1");
$lastcmd = "catalogue";
@@ -305,9 +317,15 @@ sub writeout {
if (defined($self->{'containersize'})) {
print $fd "containersize $self->{'containersize'}\n";
}
+ if (defined($self->{'containermd5'})) {
+ print $fd "containermd5 $self->{'containermd5'}\n";
+ }
if (defined($self->{'doccontainersize'})) {
print $fd "doccontainersize $self->{'doccontainersize'}\n";
}
+ if (defined($self->{'doccontainermd5'})) {
+ print $fd "doccontainermd5 $self->{'doccontainermd5'}\n";
+ }
if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) {
print $fd "docfiles size=$self->{'docsize'}\n";
foreach my $f (sort @{$self->{'docfiles'}}) {
@@ -324,6 +342,9 @@ sub writeout {
if (defined($self->{'srccontainersize'})) {
print $fd "srccontainersize $self->{'srccontainersize'}\n";
}
+ if (defined($self->{'srccontainermd5'})) {
+ print $fd "srccontainermd5 $self->{'srccontainermd5'}\n";
+ }
if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) {
print $fd "srcfiles size=$self->{'srcsize'}\n";
foreach (sort @{$self->{'srcfiles'}}) {
@@ -587,12 +608,13 @@ sub make_container {
}
# compute the size
my $size = (stat "$destdir/$tarname.lzma") [7];
+ my $m = TeXLive::TLUtils::tlmd5("$destdir/$tarname.lzma");
# cleaning up
unlink("$tlpobjdir/$self->{'name'}.tlpobj");
rmdir("$tlpobjdir") if $removetlpobjdir;
chdir($cwd);
ddebug("Done $containername\n");
- return($size);
+ return($size,$m);
}
@@ -907,6 +929,21 @@ sub doccontainersize {
if (@_) { $self->{'doccontainersize'} = shift }
return ( defined($self->{'doccontainersize'}) ? $self->{'doccontainersize'} : -1 );
}
+sub containermd5 {
+ my $self = shift;
+ if (@_) { $self->{'containermd5'} = shift }
+ return ( defined($self->{'containermd5'}) ? $self->{'containermd5'} : "" );
+}
+sub srccontainermd5 {
+ my $self = shift;
+ if (@_) { $self->{'srccontainermd5'} = shift }
+ return ( defined($self->{'srccontainermd5'}) ? $self->{'srccontainermd5'} : "" );
+}
+sub doccontainermd5 {
+ my $self = shift;
+ if (@_) { $self->{'doccontainermd5'} = shift }
+ return ( defined($self->{'doccontainermd5'}) ? $self->{'doccontainermd5'} : "" );
+}
sub srcsize {
my $self = shift;
if (@_) { $self->{'srcsize'} = shift }
@@ -1165,13 +1202,17 @@ architectures as keys, similar to the C<runfiles> functions (see above).
Futhermore, if the tlpobj is contained ina tlpdb which describes a media
where the files are distributed in packed format (usually as .tar.lzma),
-there are 3 more possible keys:
+there are 6 more possible keys:
$tlpobj->containersize
$tlpobj->doccontainersize
$tlpobj->srccontainersize
+ $tlpobj->containermd5
+ $tlpobj->doccontainermd5
+ $tlpobj->srccontainermd5
-describing the respective sizes in bytes. The latter two are only present
+describing the respective sizes and md5sums in bytes and as hex string, resp.
+The latter two are only present
if src/doc file container splitting is activated for that install medium.
=head1 OTHER FUNCTIONS
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 3968c18bcae..59ab8bd92d8 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -66,6 +66,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
TeXLive::TLUtils::kpsewhich;
TeXLive::TLUtils::conv_to_win_path($path);
TeXLive::TLUtils::give_ctan_mirror($path);
+ TeXLive::TLUtils::tlmd5($path);
=head1 DESCRIPTION
@@ -115,6 +116,7 @@ BEGIN {
&welcome
&welcome_paths
&give_ctan_mirror
+ &tlmd5
);
@EXPORT = qw(setup_programs download_file info log debug ddebug tlwarn process_logging_options win32);
}
@@ -122,6 +124,7 @@ BEGIN {
use TeXLive::TLConfig;
use Getopt::Long;
+use Digest::MD5;
$::opt_verbosity = 0;
@@ -622,7 +625,7 @@ sub install_packages {
} elsif (&media eq 'NET') {
$container = "$TeXLiveURL/$NetArchive/$package.$DefaultContainerExtension";
}
- install_package($container, $tlpobj->containersize,\@installfiles,$totlpdb->root,$vars{'this_platform'});
+ install_package($container, $tlpobj->containersize, $tlpobj->containermd5, \@installfiles,$totlpdb->root,$vars{'this_platform'});
# if we are installing from CD or NET we have to fetch the respective
# source and doc packages $pkg.source and $pkg.doc and install them, too
if ((&media eq 'NET') || (&media eq 'CD')) {
@@ -635,13 +638,13 @@ sub install_packages {
($package !~ m/\./) && $tlpobj->srcfiles) {
my $srccontainer = $container;
$srccontainer =~ s/(\.tar\.lzma|\.zip)$/.source$1/;
- install_package($srccontainer, $tlpobj->srccontainersize,\@installfiles,$totlpdb->root,$vars{'this_platform'});
+ install_package($srccontainer, $tlpobj->srccontainersize, $tlpobj->srccontainermd5, \@installfiles,$totlpdb->root,$vars{'this_platform'});
}
if ($container_doc_split && $real_opt_doc &&
($package !~ m/\./) && $tlpobj->docfiles) {
my $doccontainer = $container;
$doccontainer =~ s/(\.tar\.lzma|\.zip)$/.doc$1/;
- install_package($doccontainer, $tlpobj->doccontainersize, \@installfiles,$totlpdb->root,$vars{'this_platform'});
+ install_package($doccontainer, $tlpobj->doccontainersize, $tlpobj->doccontainermd5, \@installfiles,$totlpdb->root,$vars{'this_platform'});
}
}
# we don't want to have wrong information in the tlpdb, so remove the
@@ -693,7 +696,7 @@ is not taken into account (should be fixed!).
=cut
sub install_package {
- my ($what, $whatsize, $filelistref, $target, $platform) = @_;
+ my ($what, $whatsize, $whatmd5, $filelistref, $target, $platform) = @_;
my @filelist = @$filelistref;
@@ -737,14 +740,41 @@ sub install_package {
my $gotfiledone = 0;
if (-r $lzmafile) {
# check that the downloaded file is not partial
- my $size = (stat $lzmafile)[7];
- if ($size == $whatsize) {
- debug("Reusing already downloaded container $lzmafile\n");
- $gotfiledone = 1;
+ if ($whatsize >= 0) {
+ # we have the size given, so check that first
+ my $size = (stat $lzmafile)[7];
+ if ($size == $whatsize) {
+ # we want to check also the md5sum if we have it present
+ if ($whatmd5) {
+ if (tlmd5($what) eq $whatmd5) {
+ $gotfiledone = 1;
+ } else {
+ tlwarn("Downloaded file present, size equal, but md5sum differs\nredownloading $what!\n");
+ }
+ } else {
+ # size ok, no md5sum
+ tlwarn("Downloaded container present, size equal, but no md5sum available. Hope that is fine!\n");
+ $gotfiledone = 1;
+ }
+ } else {
+ tlwarn("Partial download of $what found, removing it!\n");
+ unlink($tarfile, $lzmafile);
+ }
} else {
- tlwarn("Partial download of $what found, removing it!\n");
- unlink($tarfile, $lzmafile);
+ # ok no size information, hopefully we have md5 sums
+ if ($whatmd5) {
+ if (tlmd5($what) eq $whatmd5) {
+ $gotfiledone = 1;
+ } else {
+ tlwarn("Downloaded file present, but md5sum differs, removing it!\n");
+ }
+ } else {
+ tlwarn("container found, but we cannot verify size of md5sum!\nContinuing with it and hope that it is ok!\n");
+ $gotfiledone = 1;
+ }
}
+ debug("Reusing already downloaded container $lzmafile\n")
+ if ($gotfiledone);
}
if (!$gotfiledone) {
if ($what =~ m,http://|ftp://,) {
@@ -1448,6 +1478,18 @@ sub give_ctan_mirror {
return($mirror);
}
+sub tlmd5 {
+ my $file = shift;
+ if (-r $file) {
+ open(FILE, $file) or die "Can't open '$file': $!";
+ binmode(FILE);
+ return Digest::MD5->new->addfile(*FILE)->hexdigest;
+ close(FILE);
+ } else {
+ return "";
+ }
+}
+
#############################################
#
# Taken from Text::ParseWords