diff options
author | Norbert Preining <preining@logic.at> | 2008-06-30 16:37:31 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2008-06-30 16:37:31 +0000 |
commit | a210df813ed206966a0f02b1e3ec47370d306c26 (patch) | |
tree | dc4d8501c7c1d9f69e7710366ddb56e7255cf5cf /Master | |
parent | 18bb1e2c2cf25f1d0e33edb438a899f6a80cae02 (diff) |
adding support for md5 sums
git-svn-id: svn://tug.org/texlive/trunk@9115 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 47 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 62 | ||||
-rwxr-xr-x | Master/tlpkg/bin/tl-update-containers | 21 | ||||
-rw-r--r-- | Master/tlpkg/installer/perllib/Digest/MD5.pm | 376 | ||||
-rw-r--r-- | Master/tlpkg/installer/perllib/Digest/base.pm | 100 | ||||
-rw-r--r-- | Master/tlpkg/installer/perllib/Digest/file.pm | 85 | ||||
-rw-r--r-- | Master/tlpkg/installer/perllib/auto/Digest/MD5/MD5.bs | 0 | ||||
-rwxr-xr-x | Master/tlpkg/installer/perllib/auto/Digest/MD5/MD5.dll | bin | 0 -> 15872 bytes |
8 files changed, 672 insertions, 19 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 diff --git a/Master/tlpkg/bin/tl-update-containers b/Master/tlpkg/bin/tl-update-containers index 2b447b02018..caa47470a16 100755 --- a/Master/tlpkg/bin/tl-update-containers +++ b/Master/tlpkg/bin/tl-update-containers @@ -151,32 +151,41 @@ sub main my $objsrc = $obj->srcfiles_package; $objcopy->clear_srcfiles; if ($objsrc) { - my $s = $objsrc->make_container($type, $Master, $opt_containerdir, - "$pkg.source", $opt_relative); + my ($s,$m) = $objsrc->make_container($type, $Master, $opt_containerdir, + "$pkg.source", $opt_relative); if ($s > 0) { # something was created # important, we have to add it to the original $obj $obj->srccontainersize($s); } + if ($m ne "") { + $obj->srccontainermd5($m); + } } } if ($docsplit) { my $objdoc = $obj->docfiles_package; $objcopy->clear_docfiles; if ($objdoc) { - my $s = $objdoc->make_container($type, $Master, $opt_containerdir, - "$pkg.doc", $opt_relative); + my ($s,$m) = $objdoc->make_container($type, $Master, $opt_containerdir, + "$pkg.doc", $opt_relative); if ($s > 0) { # something was created $obj->doccontainersize($s); } + if ($m ne "") { + $obj->doccontainermd5($m); + } } } - my $s = $objcopy->make_container($type, $Master, $opt_containerdir, - $pkg, $opt_relative); + my ($s,$m) = $objcopy->make_container($type, $Master, $opt_containerdir, + $pkg, $opt_relative); if ($s > 0) { $obj->containersize($s); } + if ($m ne "") { + $obj->containermd5($m); + } # add the updated (or new) TLPOBJ to NET TLPDB # that way the other container sizes are not destroyed $nettlpdb->add_tlpobj($obj); diff --git a/Master/tlpkg/installer/perllib/Digest/MD5.pm b/Master/tlpkg/installer/perllib/Digest/MD5.pm new file mode 100644 index 00000000000..17fb11d678a --- /dev/null +++ b/Master/tlpkg/installer/perllib/Digest/MD5.pm @@ -0,0 +1,376 @@ +package Digest::MD5; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK); + +$VERSION = '2.36'; # $Date: 2005/11/30 13:46:47 $ + +require Exporter; +*import = \&Exporter::import; +@EXPORT_OK = qw(md5 md5_hex md5_base64); + +eval { + require Digest::base; + push(@ISA, 'Digest::base'); +}; +if ($@) { + my $err = $@; + *add_bits = sub { die $err }; +} + + +eval { + require XSLoader; + XSLoader::load('Digest::MD5', $VERSION); +}; +if ($@) { + my $olderr = $@; + eval { + # Try to load the pure perl version + require Digest::Perl::MD5; + + Digest::Perl::MD5->import(qw(md5 md5_hex md5_base64)); + push(@ISA, "Digest::Perl::MD5"); # make OO interface work + }; + if ($@) { + # restore the original error + die $olderr; + } +} +else { + *reset = \&new; +} + +1; +__END__ + +=head1 NAME + +Digest::MD5 - Perl interface to the MD5 Algorithm + +=head1 SYNOPSIS + + # Functional style + use Digest::MD5 qw(md5 md5_hex md5_base64); + + $digest = md5($data); + $digest = md5_hex($data); + $digest = md5_base64($data); + + # OO style + use Digest::MD5; + + $ctx = Digest::MD5->new; + + $ctx->add($data); + $ctx->addfile(*FILE); + + $digest = $ctx->digest; + $digest = $ctx->hexdigest; + $digest = $ctx->b64digest; + +=head1 DESCRIPTION + +The C<Digest::MD5> module allows you to use the RSA Data Security +Inc. MD5 Message Digest algorithm from within Perl programs. The +algorithm takes as input a message of arbitrary length and produces as +output a 128-bit "fingerprint" or "message digest" of the input. + +Note that the MD5 algorithm is not as strong as it used to be. It has +since 2005 been easy to generate different messages that produce the +same MD5 digest. It still seems hard to generate messages that +produce a given digest, but it is probably wise to move to stronger +algorithms for applications that depend on the digest to uniquely identify +a message. + +The C<Digest::MD5> module provide a procedural interface for simple +use, as well as an object oriented interface that can handle messages +of arbitrary length and which can read files directly. + +=head1 FUNCTIONS + +The following functions are provided by the C<Digest::MD5> module. +None of these functions are exported by default. + +=over 4 + +=item md5($data,...) + +This function will concatenate all arguments, calculate the MD5 digest +of this "message", and return it in binary form. The returned string +will be 16 bytes long. + +The result of md5("a", "b", "c") will be exactly the same as the +result of md5("abc"). + +=item md5_hex($data,...) + +Same as md5(), but will return the digest in hexadecimal form. The +length of the returned string will be 32 and it will only contain +characters from this set: '0'..'9' and 'a'..'f'. + +=item md5_base64($data,...) + +Same as md5(), but will return the digest as a base64 encoded string. +The length of the returned string will be 22 and it will only contain +characters from this set: 'A'..'Z', 'a'..'z', '0'..'9', '+' and +'/'. + +Note that the base64 encoded string returned is not padded to be a +multiple of 4 bytes long. If you want interoperability with other +base64 encoded md5 digests you might want to append the redundant +string "==" to the result. + +=back + +=head1 METHODS + +The object oriented interface to C<Digest::MD5> is described in this +section. After a C<Digest::MD5> object has been created, you will add +data to it and finally ask for the digest in a suitable format. A +single object can be used to calculate multiple digests. + +The following methods are provided: + +=over 4 + +=item $md5 = Digest::MD5->new + +The constructor returns a new C<Digest::MD5> object which encapsulate +the state of the MD5 message-digest algorithm. + +If called as an instance method (i.e. $md5->new) it will just reset the +state the object to the state of a newly created object. No new +object is created in this case. + +=item $md5->reset + +This is just an alias for $md5->new. + +=item $md5->clone + +This a copy of the $md5 object. It is useful when you do not want to +destroy the digests state, but need an intermediate value of the +digest, e.g. when calculating digests iteratively on a continuous data +stream. Example: + + my $md5 = Digest::MD5->new; + while (<>) { + $md5->add($_); + print "Line $.: ", $md5->clone->hexdigest, "\n"; + } + +=item $md5->add($data,...) + +The $data provided as argument are appended to the message we +calculate the digest for. The return value is the $md5 object itself. + +All these lines will have the same effect on the state of the $md5 +object: + + $md5->add("a"); $md5->add("b"); $md5->add("c"); + $md5->add("a")->add("b")->add("c"); + $md5->add("a", "b", "c"); + $md5->add("abc"); + +=item $md5->addfile($io_handle) + +The $io_handle will be read until EOF and its content appended to the +message we calculate the digest for. The return value is the $md5 +object itself. + +The addfile() method will croak() if it fails reading data for some +reason. If it croaks it is unpredictable what the state of the $md5 +object will be in. The addfile() method might have been able to read +the file partially before it failed. It is probably wise to discard +or reset the $md5 object if this occurs. + +In most cases you want to make sure that the $io_handle is in +C<binmode> before you pass it as argument to the addfile() method. + +=item $md5->add_bits($data, $nbits) + +=item $md5->add_bits($bitstring) + +Since the MD5 algorithm is byte oriented you might only add bits as +multiples of 8, so you probably want to just use add() instead. The +add_bits() method is provided for compatibility with other digest +implementations. See L<Digest> for description of the arguments +that add_bits() take. + +=item $md5->digest + +Return the binary digest for the message. The returned string will be +16 bytes long. + +Note that the C<digest> operation is effectively a destructive, +read-once operation. Once it has been performed, the C<Digest::MD5> +object is automatically C<reset> and can be used to calculate another +digest value. Call $md5->clone->digest if you want to calculate the +digest without resetting the digest state. + +=item $md5->hexdigest + +Same as $md5->digest, but will return the digest in hexadecimal +form. The length of the returned string will be 32 and it will only +contain characters from this set: '0'..'9' and 'a'..'f'. + +=item $md5->b64digest + +Same as $md5->digest, but will return the digest as a base64 encoded +string. The length of the returned string will be 22 and it will only +contain characters from this set: 'A'..'Z', 'a'..'z', '0'..'9', '+' +and '/'. + + +The base64 encoded string returned is not padded to be a multiple of 4 +bytes long. If you want interoperability with other base64 encoded +md5 digests you might want to append the string "==" to the result. + +=back + + +=head1 EXAMPLES + +The simplest way to use this library is to import the md5_hex() +function (or one of its cousins): + + use Digest::MD5 qw(md5_hex); + print "Digest is ", md5_hex("foobarbaz"), "\n"; + +The above example would print out the message: + + Digest is 6df23dc03f9b54cc38a0fc1483df6e21 + +The same checksum can also be calculated in OO style: + + use Digest::MD5; + + $md5 = Digest::MD5->new; + $md5->add('foo', 'bar'); + $md5->add('baz'); + $digest = $md5->hexdigest; + + print "Digest is $digest\n"; + +With OO style you can break the message arbitrary. This means that we +are no longer limited to have space for the whole message in memory, i.e. +we can handle messages of any size. + +This is useful when calculating checksum for files: + + use Digest::MD5; + + my $file = shift || "/etc/passwd"; + open(FILE, $file) or die "Can't open '$file': $!"; + binmode(FILE); + + $md5 = Digest::MD5->new; + while (<FILE>) { + $md5->add($_); + } + close(FILE); + print $md5->b64digest, " $file\n"; + +Or we can use the addfile method for more efficient reading of +the file: + + use Digest::MD5; + + my $file = shift || "/etc/passwd"; + open(FILE, $file) or die "Can't open '$file': $!"; + binmode(FILE); + + print Digest::MD5->new->addfile(*FILE)->hexdigest, " $file\n"; + +Perl 5.8 support Unicode characters in strings. Since the MD5 +algorithm is only defined for strings of bytes, it can not be used on +strings that contains chars with ordinal number above 255. The MD5 +functions and methods will croak if you try to feed them such input +data: + + use Digest::MD5 qw(md5_hex); + + my $str = "abc\x{300}"; + print md5_hex($str), "\n"; # croaks + # Wide character in subroutine entry + +What you can do is calculate the MD5 checksum of the UTF-8 +representation of such strings. This is achieved by filtering the +string through encode_utf8() function: + + use Digest::MD5 qw(md5_hex); + use Encode qw(encode_utf8); + + my $str = "abc\x{300}"; + print md5_hex(encode_utf8($str)), "\n"; + # 8c2d46911f3f5a326455f0ed7a8ed3b3 + +=head1 SEE ALSO + +L<Digest>, +L<Digest::MD2>, +L<Digest::SHA1>, +L<Digest::HMAC> + +L<md5sum(1)> + +RFC 1321 + +http://en.wikipedia.org/wiki/MD5 + +The paper "How to Break MD5 and Other Hash Functions" by Xiaoyun Wang +and Hongbo Yu. + +=head1 COPYRIGHT + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + Copyright 1998-2003 Gisle Aas. + Copyright 1995-1996 Neil Winton. + Copyright 1991-1992 RSA Data Security, Inc. + +The MD5 algorithm is defined in RFC 1321. This implementation is +derived from the reference C code in RFC 1321 which is covered by +the following copyright statement: + +=over 4 + +=item + +Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All +rights reserved. + +License to copy and use this software is granted provided that it +is identified as the "RSA Data Security, Inc. MD5 Message-Digest +Algorithm" in all material mentioning or referencing this software +or this function. + +License is also granted to make and use derivative works provided +that such works are identified as "derived from the RSA Data +Security, Inc. MD5 Message-Digest Algorithm" in all material +mentioning or referencing the derived work. + +RSA Data Security, Inc. makes no representations concerning either +the merchantability of this software or the suitability of this +software for any particular purpose. It is provided "as is" +without express or implied warranty of any kind. + +These notices must be retained in any copies of any part of this +documentation and/or software. + +=back + +This copyright does not prohibit distribution of any version of Perl +containing this extension under the terms of the GNU or Artistic +licenses. + +=head1 AUTHORS + +The original C<MD5> interface was written by Neil Winton +(C<N.Winton@axion.bt.co.uk>). + +The C<Digest::MD5> module is written by Gisle Aas <gisle@ActiveState.com>. + +=cut diff --git a/Master/tlpkg/installer/perllib/Digest/base.pm b/Master/tlpkg/installer/perllib/Digest/base.pm new file mode 100644 index 00000000000..cb336c2cf61 --- /dev/null +++ b/Master/tlpkg/installer/perllib/Digest/base.pm @@ -0,0 +1,100 @@ +package Digest::base; + +use strict; +use vars qw($VERSION); +$VERSION = "1.00"; + +# subclass is supposed to implement at least these +sub new; +sub clone; +sub add; +sub digest; + +sub reset { + my $self = shift; + $self->new(@_); # ugly +} + +sub addfile { + my ($self, $handle) = @_; + + my $n; + my $buf = ""; + + while (($n = read($handle, $buf, 4*1024))) { + $self->add($buf); + } + unless (defined $n) { + require Carp; + Carp::croak("Read failed: $!"); + } + + $self; +} + +sub add_bits { + my $self = shift; + my $bits; + my $nbits; + if (@_ == 1) { + my $arg = shift; + $bits = pack("B*", $arg); + $nbits = length($arg); + } + else { + ($bits, $nbits) = @_; + } + if (($nbits % 8) != 0) { + require Carp; + Carp::croak("Number of bits must be multiple of 8 for this algorithm"); + } + return $self->add(substr($bits, 0, $nbits/8)); +} + +sub hexdigest { + my $self = shift; + return unpack("H*", $self->digest(@_)); +} + +sub b64digest { + my $self = shift; + require MIME::Base64; + my $b64 = MIME::Base64::encode($self->digest(@_), ""); + $b64 =~ s/=+$//; + return $b64; +} + +1; + +__END__ + +=head1 NAME + +Digest::base - Digest base class + +=head1 SYNOPSIS + + package Digest::Foo; + use base 'Digest::base'; + +=head1 DESCRIPTION + +The C<Digest::base> class provide implementations of the methods +C<addfile> and C<add_bits> in terms of C<add>, and of the methods +C<hexdigest> and C<b64digest> in terms of C<digest>. + +Digest implementations might want to inherit from this class to get +this implementations of the alternative I<add> and I<digest> methods. +A minimal subclass needs to implement the following methods by itself: + + new + clone + add + digest + +The arguments and expected behaviour of these methods are described in +L<Digest>. + +=head1 SEE ALSO + +L<Digest> diff --git a/Master/tlpkg/installer/perllib/Digest/file.pm b/Master/tlpkg/installer/perllib/Digest/file.pm new file mode 100644 index 00000000000..67985fd7599 --- /dev/null +++ b/Master/tlpkg/installer/perllib/Digest/file.pm @@ -0,0 +1,85 @@ +package Digest::file; + +use strict; + +use Exporter (); +use Carp qw(croak); +use Digest (); + +use vars qw($VERSION @ISA @EXPORT_OK); + +$VERSION = "1.00"; +@ISA = qw(Exporter); +@EXPORT_OK = qw(digest_file_ctx digest_file digest_file_hex digest_file_base64); + +sub digest_file_ctx { + my $file = shift; + croak("No digest algorithm specified") unless @_; + local *F; + open(F, $file) || croak("Can't open '$file': $!"); + binmode(F); + my $ctx = Digest->new(@_); + $ctx->addfile(*F); + close(F); + return $ctx; +} + +sub digest_file { + digest_file_ctx(@_)->digest; +} + +sub digest_file_hex { + digest_file_ctx(@_)->hexdigest; +} + +sub digest_file_base64 { + digest_file_ctx(@_)->b64digest; +} + +1; + +__END__ + +=head1 NAME + +Digest::file - Calculate digests of files + +=head1 SYNOPSIS + + # Poor mans "md5sum" command + use Digest::file qw(digest_file_hex); + for (@ARGV) { + print digest_file_hex($_, "MD5"), " $_\n"; + } + +=head1 DESCRIPTION + +This module provide 3 convenience functions to calculate the digest +of files. The following functions are provided: + +=over + +=item digest_file( $file, $algorithm, [$arg,...] ) + +This function will calculate and return the binary digest of the bytes +of the given file. The function will croak if it fails to open or +read the file. + +The $algorithm is a string like "MD2", "MD5", "SHA-1", "SHA-512". +Additional arguments are passed to the constructor for the +implementation of the given algorithm. + +=item digest_file_hex( $file, $algorithm, [$arg,...] ) + +Same as digest_file(), but return the digest in hex form. + +=item digest_file_base64( $file, $algorithm, [$arg,...] ) + +Same as digest_file(), but return the digest as a base64 encoded +string. + +=back + +=head1 SEE ALSO + +L<Digest> diff --git a/Master/tlpkg/installer/perllib/auto/Digest/MD5/MD5.bs b/Master/tlpkg/installer/perllib/auto/Digest/MD5/MD5.bs new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/Master/tlpkg/installer/perllib/auto/Digest/MD5/MD5.bs diff --git a/Master/tlpkg/installer/perllib/auto/Digest/MD5/MD5.dll b/Master/tlpkg/installer/perllib/auto/Digest/MD5/MD5.dll Binary files differnew file mode 100755 index 00000000000..72ba4df2758 --- /dev/null +++ b/Master/tlpkg/installer/perllib/auto/Digest/MD5/MD5.dll |