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 file_path($$)
  60 {
  61   my ($md5, $url) = @_;
  62
  63   $md5 =~ /^(.)(.)/;
  64   my $md5_dir = "$ftp_dir/by-md5/$1/$2/$md5";
  65   $url =~ /\/([^\/]+)$/ or die;
  66   my $basename = $1;
  67   return "$md5_dir/$basename";
  68 }
  69
  70 sub install_dir($)
  71 {
  72   my $dir = shift;
  73   return if (-e $dir);
  74   $dir =~ /(.*)\/[^\/]+$/ and install_dir($1);
  75   mkdir($dir);
  76 }
  77
  78 sub move_file($$)
  79 {
  80   my ($md5, $url) = @_;
  81
  82   my $path = file_path($md5, $url);
  83
  84   $path =~ /(.*)\/[^\/]+$/ and install_dir($1);
  85
  86   if (system("mv -f \"tmp/$md5\" \"$path\"")) {
  87     $problems .= "FATAL: cannot mv file ($url)\n";
  88   } else {
  89     $normal_out .= "STORED: $url ($md5, " .  (-s $path) . " bytes)\n";
  90   }
  91 }
  92
  93 sub fetch_file($$)
  94 {
  95   my ($md5, $url) = @_;
  96   my $out = "";
  97   my $cmd = "wget -nv -O tmp/$md5 \"$url\"";
  98
  99   my $path = file_path($md5, $url);
 100   if (-f $path) {
 101     $normal_out .= "ALREADY GOT: $url ($md5, " .  (-s $path) . " bytes)\n";
 102     return;
 103   }
 104
 105   open(W, "$cmd 2>&1 |");
 106   while (<W>) {
 107     /URL:.*\s+\-\>\s+.*/ and next;
 108     $out .= $_;
 109   }
 110   close(W);
 111   if ($out ne "") {
 112     $problems .= "$cmd:\n$out\n\n";
 113   }
 114   if (-f "tmp/$md5" && -s "tmp/$md5" > 0) {
 115     my $computed_md5 = `md5sum tmp/$md5`;
 116     $computed_md5 =~ /^([a-f0-9]{32})/ and $computed_md5 = $1;
 117     if ($computed_md5 ne $md5) {
 118       $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
 119     } else {
 120       move_file($md5, $url);
 121     }
 122   } else {
 123     $problems .= "FATAL: $url ($md5) was not fetched\n";
 124   }
 125 }
 126
 127 sub fetch_files()
 128 {
 129   $problems .= "\n\n" if ($problems ne "");
 130   foreach $md5 (@md5) {
 131     fetch_file($md5, $url{$md5});
 132   }
 133 }
 134
 135 sub send_email()
 136 {
 137   #open(EMAIL, "| /usr/sbin/sendmail -t");
 138   open(EMAIL, "| cat");
 139   my $marker = "OK";
 140   if ($problems ne "") {
 141     $marker = "ERRORS";
 142   }
 143   print EMAIL "To: $requester
 144 Cc: $email_cc
 145 Subject: [distfiles] sources fetched $marker
 146 From: distfiles <feedback\@pld.org.pl>
 147
 148 $problems
 149 $normal_out
 150 ";
 151   close(EMAIL) or die;
 152 }
 153
 154 find_file_in_spool();
 155 read_spool_file();
 156 fetch_files();
 157 send_email();