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 $fetched_count = 0;
  16 $force_reply = 0;
  17
  18 # try lookup some file in spool, exit if it cannot be done
  19 sub find_file_in_spool()
  20 {
  21   opendir(DIR, $spool_dir) || die "can't opendir $spool_dir: $!";
  22   while (1) {
  23     my $f = readdir(DIR);
  24     defined $f or last;
  25     -f "$spool_dir/$f" or next;
  26     $file = "$spool_dir/$f";
  27     last;
  28   }
  29   closedir(DIR);
  30
  31   exit 0 if ($file eq "");
  32 }
  33
  34 # read file from spool, and try unlink it. if cannot unlink -- exit
  35 # sets $requester (email), $problems, @md5 (arrays of md5's)
  36 # and %url (map from md5 to urls)
  37 sub read_spool_file()
  38 {
  39   open(F, "< $file") || exit 0;
  40   $requester = <F>;
  41   chomp $requester;
  42   $requester =~ /^[a-zA-Z_\-0-9\@\.]+$/
  43         or die "$file: evil requester: $requester";
  44   my $flags = <F>;
  45   $force_reply++ if ($flags =~ /force-reply/);
  46
  47   while (<F>) {
  48     if (/^ERROR/) {
  49       s/^ERROR: //;
  50       $problems .= $_;
  51       next;
  52     }
  53     /^([a-f0-9]{32})\s+((ftp|http):\/\/([a-z0-9A-Z:\+\~\.\-\/_]|\%[0-9])+)\s*$/
  54         or die "$file: corrupted";
  55     push @md5, $1;
  56     $url{$1} = $2;
  57     /\/$/ and die "$file: cannot fetch dir";
  58   }
  59   close(F);
  60
  61   unlink($file) || exit 0;
  62 }
  63
  64 sub file_path($$)
  65 {
  66   my ($md5, $url) = @_;
  67
  68   $md5 =~ /^(.)(.)/;
  69   my $md5_dir = "$ftp_dir/by-md5/$1/$2/$md5";
  70   $url =~ /\/([^\/]+)$/ or die;
  71   my $basename = $1;
  72   return "$md5_dir/$basename";
  73 }
  74
  75 sub install_dir
  76 {
  77   my $dir = shift;
  78   return if (-e $dir);
  79   $dir =~ /(.*)\/[^\/]+$/ and install_dir($1);
  80   mkdir($dir);
  81 }
  82
  83 sub move_file($$)
  84 {
  85   my ($md5, $url) = @_;
  86
  87   my $path = file_path($md5, $url);
  88
  89   $path =~ /(.*)\/[^\/]+$/ and install_dir($1);
  90
  91   if (system("mv -f \"tmp/$md5\" \"$path\"")) {
  92     $problems .= "FATAL: cannot mv file ($url)\n";
  93   } else {
  94     if (open(D, "> $path.desc")) {
  95       print D "URL: $url\n";
  96       print D "MD5: $md5\n";
  97       print D 'Fetched-by: $Id$'."\n";
  98       close(D);
  99     } else {
 100       $problems .= "ERROR: cannot write $path.desc\n";
 101     }
 102
 103     # Forg logs
 104     $md5 =~ /^(..)/ and my $m2 = $1;
 105     $md5 =~ /^(.)(.)/;
 106     if (open(L, ">> $ENV{HOME}/.lists/lista_$m2")) {
 107       print L "/home/ftp/pub/Linux/distfiles/by-md5/$1/$2/$md5/";
 108       $url =~ /\/([^\/]+)$/;
 109       print L "$1\n";
 110       close(L);
 111     }
 112
 113     $normal_out .= "STORED: $url ($md5, " .  (-s $path) . " bytes)\n";
 114     $fetched_count++;
 115   }
 116 }
 117
 118 sub fetch_file($$)
 119 {
 120   my ($md5, $url) = @_;
 121   my $out = "";
 122   my $cmd = "wget -nv -O tmp/$md5 \"$url\"";
 123
 124   my $path = file_path($md5, $url);
 125   if (-f $path) {
 126     $normal_out .= "ALREADY GOT: $url ($md5, " .  (-s $path) . " bytes)\n";
 127     return;
 128   }
 129
 130   open(W, "$cmd 2>&1 |");
 131   while (<W>) {
 132     /URL:.*\s+\-\>\s+.*/ and next;
 133     $out .= $_;
 134   }
 135   close(W);
 136   if ($out ne "") {
 137     $problems .= "$cmd:\n$out\n\n";
 138   }
 139   if (-f "tmp/$md5" && -s "tmp/$md5" > 0) {
 140     my $computed_md5 = `md5sum tmp/$md5`;
 141     $computed_md5 =~ /^([a-f0-9]{32})/ and $computed_md5 = $1;
 142     if ($computed_md5 ne $md5) {
 143       $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
 144     } else {
 145       move_file($md5, $url);
 146     }
 147   } else {
 148     $problems .= "FATAL: $url ($md5) was not fetched\n";
 149   }
 150   unlink("tmp/$md5");
 151 }
 152
 153 sub fetch_files()
 154 {
 155   $problems .= "\n\n" if ($problems ne "");
 156   foreach $md5 (@md5) {
 157     fetch_file($md5, $url{$md5});
 158   }
 159 }
 160
 161 sub send_email()
 162 {
 163   open(EMAIL, "| /usr/sbin/sendmail -t");
 164   #open(EMAIL, "| cat");
 165   my $marker = "OK";
 166   if ($problems ne "") {
 167     $marker = "ERRORS";
 168   }
 169   print EMAIL
 170 "From: distfiles <feedback\@pld-linux.org>
 171 To: $requester
 172 Cc: $email_cc
 173 Subject: [distfiles] sources fetched $marker
 174 Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
 175 X-distfiles-program: file-fetcher.pl
 176 X-distfiles-version: " . '$Id$' . "
 177
 178 $problems
 179 Files fetched: $fetched_count
 180
 181 $normal_out
 182
 183 --
 184 Virtually Yours: distfiles.
 185 ";
 186   close(EMAIL) or die;
 187 }
 188
 189 find_file_in_spool();
 190 read_spool_file();
 191 fetch_files();
 192 send_email() unless (!$force_reply and $problems eq "" and $fetched_count == 0);