check that 02packages is sane-ish

rjbs · Feb 7, 2013 · 83a55e9 · 83a55e9
1 parent 5988421
commit 83a55e9
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 1 deletion.
diff --git a/Changes b/Changes
@@ -1,6 +1,7 @@
 Revision history for CPAN-Mini
 
 {{$NEXT}}
+          check that the received 02packages seems at least remotely plausible
 
 1.111010  2012-10-24 10:46:35 America/New_York
           fix the old ->trace method, broken in 1.111004

diff --git a/lib/CPAN/Mini.pm b/lib/CPAN/Mini.pm
@@ -215,12 +215,24 @@ sub _get_mirror_list {
     or die "Cannot open details: $Compress::Zlib::gzerrno";
 
   my $inheader = 1;
+  my $file_ok  = 0;
   while ($gz->gzreadline($_) > 0) {
     if ($inheader) {
-      $inheader = 0 unless /\S/;
+      if (/\S/) {
+        my ($header, $value) = split /:\s*/, $_, 2;
+        chomp $value;
+        $file_ok = 1 if $header eq 'File'
+                    and $value eq '02packages.details.txt';
+      } else {
+        $inheader = 0;
+      }
+
       next;
     }
 
+    die "02packages.details.txt file is not a valid index\n"
+      unless $file_ok;
+
     my ($module, $version, $path) = split;
     next if $self->_filter_module({
       module  => $module,