verify also local copies, triggered by new parameter to TLPDB->new

git-svn-id: svn://tug.org/texlive/trunk@40464 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 22 insertions, 10 deletions

diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl
index d4f152e985f..5644095a598 100755
--- a/Master/texmf-dist/scripts/texlive/tlmgr.pl
+++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl
@@ -5883,7 +5883,7 @@ END_NO_INTERNET
     }
   }
   if (!$local_copy_tlpdb_used) {
-    $remotetlpdb = TeXLive::TLPDB->new(root => $location);
+    $remotetlpdb = TeXLive::TLPDB->new(root => $location, verify => 1);
   }
   if (!defined($remotetlpdb)) {
     return(undef, $loadmediasrcerror . $location);
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index f8da3fea605..c4d4ab313ce 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -134,10 +134,13 @@ sub new {
     root => $params{'root'},
     tlps => $params{'tlps'}
   };
+  my $verify = defined($params{'verify'}) ? $params{'verify'} : 0;
+  ddebug("TLPDB new: args: @_ ; verify = $verify\n");
   $_listdir = $params{'listdir'} if defined($params{'listdir'});
   bless $self, $class;
   if (defined($params{'tlpdbfile'})) {
-    my $nr_packages_read = $self->from_file($params{'tlpdbfile'}, '-from-file');
+    my $nr_packages_read = $self->from_file($params{'tlpdbfile'}, 
+      'from-file' => 1, 'verify' => $verify);
     if ($nr_packages_read == 0) {
       # that is bad, we didn't read anything, so return undef.
       return undef;
@@ -146,7 +149,8 @@ sub new {
   } 
   if (defined($self->{'root'})) {
     my $nr_packages_read
-      = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
+      = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName",
+        'verify' => $verify);
     if ($nr_packages_read == 0) {
       # that is bad, we didn't read anything, so return undef.
       return undef;
@@ -239,7 +243,7 @@ sub remove_tlpobj {
 
 =pod
 
-=item C<< $tlpdb->from_file($filename) >>
+=item C<< $tlpdb->from_file($filename, @args) >>
 
 The C<from_file> function initializes the C<TLPDB> if the root was not
 given at generation time.  See L<TLPDB::new> for more information.
@@ -249,7 +253,8 @@ It returns the actual number of packages (TLPOBJs) read from C<$filename>.
 =cut
 
 sub from_file {
-  my ($self, $path, $arg) = @_;
+  my ($self, $path, @args) = @_;
+  my %params = @args;
   if ($self->is_virtual) {
     tlwarn("TLPDB: cannot initialize a virtual tlpdb from_file\n");
     return 0;
@@ -260,8 +265,7 @@ sub from_file {
   my $root_from_path = dirname(dirname($path));
   if (defined($self->{'root'})) {
     if ($self->{'root'} ne $root_from_path) {
-     # only warn if we are not given $arg = "-from-file"
-     if (!defined($arg) || ($arg ne "-from-file")) {
+     if (!$params{'from-file'}) {
       tlwarn("TLPDB: initialization from different location than original;\n");
       tlwarn("TLPDB: hope you are sure!\n");
       tlwarn("TLPDB: root=$self->{'root'}, root_from_path=$root_from_path\n");
@@ -362,12 +366,20 @@ sub from_file {
     # cases the result, i.e., the unpackaged tlpdb, is in $tlpdbfile
     #
     # before we open and proceed, verify the downloaded file
-    my ($r, $m) = TeXLive::TLUtils::verify_checksum($tlpdbfile, "$path.$TeXLive::TLConfig::ChecksumExtension");
-    if ($r != 0) {
-      tldie("$0: verification of $tlpdbfile from $path failed ($r): $m\n");
+    if ($params{'verify'}) {
+      my ($r, $m) = TeXLive::TLUtils::verify_checksum($tlpdbfile, "$path.$TeXLive::TLConfig::ChecksumExtension");
+      if ($r != 0) {
+        tldie("$0: verification of $tlpdbfile from $path failed ($r): $m\n");
+      }
     }
     open($retfh, "<$tlpdbfile") || die "$0: open($tlpdbfile) failed: $!";
   } else {
+    if ($params{'verify'}) {
+      my ($r, $m) = TeXLive::TLUtils::verify_checksum($path, "$path.$TeXLive::TLConfig::ChecksumExtension");
+      if ($r != 0) {
+        tldie("$0: verification of $path failed ($r): $m\n");
+      }
+    }
     open(TMP, "<$path") || die "$0: open($path) failed: $!";
     $retfh = \*TMP;
   }