add more checks to check-tlnet-consistency: md5/size/file lists

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

1 files changed, 121 insertions, 1 deletions

diff --git a/Master/tlpkg/bin/check-tlnet-consistency b/Master/tlpkg/bin/check-tlnet-consistency
index 13d50a9da86..da247343045 100755
--- a/Master/tlpkg/bin/check-tlnet-consistency
+++ b/Master/tlpkg/bin/check-tlnet-consistency
@@ -71,21 +71,75 @@ sub main
   }
   my @notlpobj;
   my @revisionerror;
+  my @missingsrccontainer;
+  my @missingdoccontainer;
+  my @sizeerror;
+  my %filedifferrors;
   foreach my $pkg ($tlpdb->list_packages()) {
     next if ($pkg =~ m/^00texlive/);
+    my $cont = "$opt_location/archive/$pkg.tar.lzma";
+    my $srccont = "$opt_location/archive/$pkg.source.tar.lzma";
+    my $doccont = "$opt_location/archive/$pkg.doc.tar.lzma";
     my $tlpdbtlpobj = $tlpdb->get_package($pkg);
-    system("cat $opt_location/archive/$pkg.tar.lzma | $::progs{lzmadec} | $::progs{tar} -C \"$temp\" -xf - tlpkg/tlpobj");
+    my $dodoc = ($tlpdb->config_doc_container && $tlpdbtlpobj->docfiles);
+    my $dosrc = ($tlpdb->config_src_container && $tlpdbtlpobj->srcfiles);
+    system("cat $cont | $::progs{lzmadec} | $::progs{tar} -C \"$temp\" -xf - tlpkg/tlpobj");
     if (! -r "$temp/tlpkg/tlpobj/$pkg.tlpobj") {
       push @notlpobj, $pkg;
     } else {
       my $tartlpobj = TeXLive::TLPOBJ->new;
       $tartlpobj->from_file("$temp/tlpkg/tlpobj/$pkg.tlpobj");
       die "Cannot load tlpobj from $temp/$pkg.tlpobj: $!" unless defined($tartlpobj);
+      # get the src and doc containers unpacked and add the respective files
+      if ($dosrc) {
+        system("cat $srccont | $::progs{lzmadec} | $::progs{tar} -C \"$temp\" -xf - tlpkg/tlpobj");
+        if (! -r "$temp/tlpkg/tlpobj/$pkg.source.tlpobj") {
+          push @missingsrccontainer, $pkg;
+        } else {
+          my $srctlpobj = TeXLive::TLPOBJ->new;
+          $srctlpobj->from_file("$temp/tlpkg/tlpobj/$pkg.source.tlpobj");
+          die "Cannot load tlpobj from $temp/$pkg.source.tlpobj: $!" unless defined($srctlpobj);
+          $tartlpobj->add_srcfiles($srctlpobj->srcfiles);
+        }
+      }
+      if ($dodoc) {
+        system("cat $doccont | $::progs{lzmadec} | $::progs{tar} -C \"$temp\" -xf - tlpkg/tlpobj");
+        if (! -r "$temp/tlpkg/tlpobj/$pkg.doc.tlpobj") {
+          push @missingdoccontainer, $pkg;
+        } else {
+          my $doctlpobj = TeXLive::TLPOBJ->new;
+          $doctlpobj->from_file("$temp/tlpkg/tlpobj/$pkg.doc.tlpobj");
+          die "Cannot load tlpobj from $temp/$pkg.doc.tlpobj: $!" unless defined($doctlpobj);
+          $tartlpobj->add_docfiles($doctlpobj->docfiles);
+        }
+      }
+      # check the revisions
       if ($tlpdbtlpobj->revision != $tartlpobj->revision) {
         push @revisionerror, "$pkg (tlpdb: " . $tlpdbtlpobj->revision . ", tar: " . $tartlpobj->revision . ")";
       }
+      # check that the files are the same
+      my @a = $tlpdbtlpobj->all_files;
+      my @b = $tartlpobj->all_files;
+      my @ret = compare_lists(\@a, \@b);
+      push @{$filedifferrors{$pkg}}, @ret if @ret;
+      # check the file sizes and md5sums
+      my $c = check_size_md($cont, $tlpdbtlpobj->containersize, 
+                                   $tlpdbtlpobj->containermd5);
+      push @sizeerror, "$pkg (" . ($c == 1 ? "size" : "md5") if ($c > 0);
+      if ($dodoc) {
+        my $c = check_size_md($doccont, $tlpdbtlpobj->doccontainersize, 
+                                        $tlpdbtlpobj->doccontainermd5);
+        push @sizeerror, "$pkg.doc (" . ($c == 1 ? "size" : "md5") if ($c > 0);
+      }
+      if ($dosrc) {
+        my $c = check_size_md($srccont, $tlpdbtlpobj->srccontainersize, 
+                                        $tlpdbtlpobj->srccontainermd5);
+        push @sizeerror, "$pkg.source (" . ($c == 1 ? "size" : "md5") if ($c > 0);
+      }
       # should we do more checks?
       unlink("$temp/tlpkg/tlpobj/$pkg.tlpobj");
+      unlink("$temp/tlpkg/tlpobj/$pkg.source.tlpobj");
+      unlink("$temp/tlpkg/tlpobj/$pkg.doc.tlpobj");
     }
   }
   system("rmdir --ignore-fail-on-non-empty $temp/tlpkg/tlpobj");
@@ -103,9 +157,75 @@ sub main
       print "$p\n";
     }
   }
+  if (@missingsrccontainer) {
+    print "packages with missing src containers:\n";
+    for my $p (@missingsrccontainer) {
+      print "$p\n";
+    }
+  }
+  if (@missingdoccontainer) {
+    print "packages with missing doc containers:\n";
+    for my $p (@missingdoccontainer) {
+      print "$p\n";
+    }
+  }
+  if (@sizeerror) {
+    print "packages with wront container size/md5s:\n";
+    for my $p (@sizeerror) {
+      print "$p\n";
+    }
+  }
+  for my $pkg (keys %filedifferrors) {
+    print "file differences in $pkg:\n";
+    for my $l (@{$filedifferrors{$pkg}}) {
+      print "  $l\n";
+    }
+  }
 }
 
 
+sub compare_lists {
+  my ($la, $lb) = @_;
+  my @la = @$la;
+  my @lb = @$lb;
+  my %onlyfirst;
+  my %onlysecond;
+  my @ret;
+  for my $f (@la) { $onlyfirst{$f} = 1; }
+  for my $f (@lb) { delete($onlyfirst{$f}); $onlysecond{$f} = 1; }
+  for my $f (@la) { delete($onlysecond{$f}); }
+  for my $f (sort keys %onlyfirst) { push @ret, "-$f"; }
+  for my $f (sort keys %onlysecond) { push @ret, "+$f"; }
+  return(@ret);
+}
+
+sub check_size_md {
+  my ($cont, $size, $md) = @_;
+  my $sizeerror = 0;
+  my $mderror = 0;
+  if ($size > -1) {
+    my $s = (stat $cont)[7];
+    if ($s == $size) {
+      if ($md) {
+        if (TeXLive::TLUtils::tlmd5($cont) ne $md) {
+          $mderror = 1;
+        }
+      }
+    } else {
+      $sizeerror = 1;
+    }
+  } else {
+    if ($md) {
+      if (tlmd5($cont) ne $md) {
+        $mderror = 1;
+      }
+    }
+  }
+  return 1 if $sizeerror;
+  return 2 if $mderror;
+  return 0;
+}
+
 __END__
 
 =head1 NAME