file-fetcher.pl

   1 #!/usr/bin/perl -w
   2 #
   3
   4 $spool_dir = "./spool";
   5 $ftp_dir = "./ftp";
   6 $email_cc = "";
   7
   8
   9 @md5 = ();
  10 %url = ();
  11 $problems = "";
  12 $normal_out = "";
  13 $requester = "";
  14 $file = "";
  15
  16 # try lookup some file in spool, exit if it cannot be done
  17 sub find_file_in_spool()
  18 {
  19   opendir(DIR, $spool_dir) || die "can't opendir $spool_dir: $!";
  20   while (1) {
  21     my $f = readdir(DIR);
  22     defined $f or last;
  23     -f "$spool_dir/$f" or next;
  24     $file = "$spool_dir/$f";
  25     last;
  26   }
  27   closedir(DIR);
  28
  29   exit 0 if ($file eq "");
  30 }
  31
  32 # read file from spool, and try unlink it. if cannot unlink -- exit
  33 # sets $requester (email), $problems, @md5 (arrays of md5's)
  34 # and %url (map from md5 to urls)
  35 sub read_spool_file()
  36 {
  37   open(F, "< $file") || exit 0;
  38   $requester = <F>;
  39   chomp $requester;
  40   $requester =~ /^[a-zA-Z_\-0-9\@\.]+$/
  41         or die "$file: evil requester: $requester";
  42
  43   while (<F>) {
  44     if (/^ERROR/) {
  45       s/^ERROR: //;
  46       $problems .= $_;
  47     }
  48     /^([a-f0-9]{32})\s+((ftp|http):\/\/([a-z0-9A-Z:\+\~\.\-\/_]|\%[0-9])+)\s*$/
  49         or die "$file: corrupted";
  50     push @md5, $1;
  51     $url{$1} = $2;
  52     /\/$/ and die "$file: cannot fetch dir";
  53   }
  54   close(F);
  55
  56   unlink($file) || exit 0;
  57 }
  58
  59 sub move_file($$)
  60 {
  61   my ($md5, $url) = @_;
  62
  63   $md5 =~ /^(.)(.)/;
  64   my $md5_dir = "$ftp_dir/by-md5/$1/$2/$md5";
  65
  66   mkdir("$ftp_dir/by-md5/$1");
  67   mkdir("$ftp_dir/by-md5/$1/$2");
  68   mkdir($md5_dir);
  69
  70   $url =~ /\/([^\/]+)$/ or die;
  71   my $basename = $1;
  72   if (system("mv -f \"tmp/$md5\" \"$md5_dir/$basename\"")) {
  73     $problems .= "FATAL: cannot mv file ($url)\n";
  74   } else {
  75     $normal_out .= "STORED: $url ($md5, " .
  76                         (-s "$md5_dir/$basename") . " bytes)\n";
  77   }
  78 }
  79
  80 sub fetch_file($$)
  81 {
  82   my ($md5, $url) = @_;
  83   my $out = "";
  84   my $cmd = "wget -nv -O tmp/$md5 \"$url\"";
  85   open(W, "$cmd 2>&1 |");
  86   while (<W>) {
  87     /URL:.*\s+\-\>\s+.*/ and next;
  88     $out .= $_;
  89   }
  90   close(W);
  91   if ($out ne "") {
  92     $problems .= "$cmd:\n$out\n\n";
  93   }
  94   if (-f "tmp/$md5" && -s "tmp/$md5" > 0) {
  95     my $computed_md5 = `md5sum tmp/$md5`;
  96     $computed_md5 =~ /^([a-f0-9]{32})/ and $computed_md5 = $1;
  97     if ($computed_md5 ne $md5) {
  98       $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
  99     } else {
 100       move_file($md5, $url);
 101     }
 102   } else {
 103     $problems .= "FATAL: $url ($md5) was not fetched\n";
 104   }
 105 }
 106
 107 sub fetch_files()
 108 {
 109   $problems .= "\n\n" if ($problems ne "");
 110   foreach $md5 (@md5) {
 111     fetch_file($md5, $url{$md5});
 112   }
 113 }
 114
 115 sub send_email()
 116 {
 117   #open(EMAIL, "| /usr/sbin/sendmail -t");
 118   open(EMAIL, "| cat");
 119   my $marker = "OK";
 120   if ($problems ne "") {
 121     $marker = "ERRORS";
 122   }
 123   print EMAIL "To: $requester
 124 Cc: $email_cc
 125 Subject: [distfiles] sources fetched $marker
 126 From: distfiles <feedback\@pld.org.pl>
 127
 128 $problems
 129 $normal_out
 130 ";
 131   close(EMAIL) or die;
 132 }
 133
 134 find_file_in_spool();
 135 read_spool_file();
 136 fetch_files();
 137 send_email();