file-fetcher.pl

   1 #!/usr/bin/perl -w
   2 #
   3
   4 $email_cc = "pld-cvs-commit\@pld-linux.org";
   5
   6 $spool_dir = "./spool";
   7 $ftp_dir = "./ftp";
   8 $copy_dir = "src"; # relative to $ftp_dir
   9 $no_url_dir = "./plddfadd";
  10
  11 @md5 = ();
  12 %url = ();
  13 $problems = "";
  14 $normal_out = "";
  15 $requester = "";
  16 $file = "";
  17 $fetched_count = 0;
  18 $force_reply = 0;
  19
  20 # try lookup some file in spool, exit if it cannot be done
  21 sub find_file_in_spool()
  22 {
  23   opendir(DIR, $spool_dir) || die "can't opendir $spool_dir: $!";
  24   while (1) {
  25     my $f = readdir(DIR);
  26     defined $f or last;
  27     -f "$spool_dir/$f" or next;
  28     $file = "$spool_dir/$f";
  29     last;
  30   }
  31   closedir(DIR);
  32
  33   exit 0 if ($file eq "");
  34 }
  35
  36 # read file from spool, and try unlink it. if cannot unlink -- exit
  37 # sets $requester (email), $problems, @md5 (arrays of md5's)
  38 # and %url (map from md5 to urls)
  39 sub read_spool_file()
  40 {
  41   open(F, "< $file") || exit 0;
  42   $requester = <F>;
  43   chomp $requester;
  44   $requester =~ /^[a-zA-Z_\-0-9\@\.]+$/
  45         or die "$file: evil requester: $requester";
  46   my $flags = <F>;
  47   $force_reply++ if ($flags =~ /force-reply/);
  48
  49   while (<F>) {
  50     if (/^ERROR/) {
  51       s/^ERROR: //;
  52       $problems .= $_;
  53       next;
  54     }
  55     /^([a-f0-9]{32})\s+((ftp|http|no-url|no-url-copy):\/\/([a-z0-9A-Z:\+\~\.\-\/_]|\%[0-9])+)\s*$/
  56         or die "$file: corrupted";
  57     push @md5, $1;
  58     $url{$1} = $2;
  59     /\/$/ and die "$file: cannot fetch dir";
  60   }
  61   close(F);
  62
  63   unlink($file) || exit 0;
  64 }
  65
  66 sub file_path($$)
  67 {
  68   my ($md5, $url) = @_;
  69
  70   $md5 =~ /^(.)(.)/;
  71   my $md5_dir = "$ftp_dir/by-md5/$1/$2/$md5";
  72   $url =~ /\/([^\/]+)$/ or die;
  73   my $basename = $1;
  74   return "$md5_dir/$basename";
  75 }
  76
  77 sub install_dir
  78 {
  79   my $dir = shift;
  80   return if (-e $dir);
  81   $dir =~ /(.*)\/[^\/]+$/ and install_dir($1);
  82   mkdir($dir);
  83 }
  84
  85 sub move_file($$$)
  86 {
  87   my ($md5, $url, $local_copy) = @_;
  88
  89   my $path = file_path($md5, $url);
  90
  91   $path =~ /(.*)\/[^\/]+$/ and install_dir($1);
  92
  93   if (system("mv -f \"$local_copy\" \"$path\"")) {
  94     $problems .= "FATAL: cannot mv file ($url)\n";
  95   } else {
  96     if (open(D, "> $path.desc")) {
  97       print D "URL: $url\n";
  98       print D "MD5: $md5\n";
  99       print D 'Fetched-by: $Id$'."\n";
 100       print D "Time: " . time . "\n";
 101       close(D);
 102     } else {
 103       $problems .= "ERROR: cannot write $path.desc\n";
 104     }
 105
 106     # Forg logs
 107     $md5 =~ /^(..)/ and my $m2 = $1;
 108     $md5 =~ /^(.)(.)/;
 109     if (open(L, ">> $ENV{HOME}/.lists/lista_$m2")) {
 110       print L "/home/ftp/pub/Linux/distfiles/by-md5/$1/$2/$md5/";
 111       $url =~ /\/([^\/]+)$/;
 112       print L "$1\n";
 113       close(L);
 114     }
 115
 116     $normal_out .= "STORED: $url ($md5, " .  (-s $path) . " bytes)\n";
 117     $fetched_count++;
 118   }
 119 }
 120
 121 sub make_src_symlink($$)
 122 {
 123   my ($md5, $url) = @_;
 124   my $path = file_path($md5, $url);
 125   $path =~ s/.*?by-md5/..\/by-md5/;
 126   $url =~ m|://([^/]+)| or die "corrupted! (no-url, copy)";
 127   my $basename = $1;
 128   my $symlink = "$ftp_dir/$copy_dir/$basename";
 129   $! = 0;
 130   my $old = readlink $symlink;
 131   if ($!) {
 132     if ($url =~ /^no-url-copy/) {
 133       symlink($path, $symlink);
 134       $force_reply++;
 135       $normal_out .= "Made symlink in src/ for $basename\n";
 136     }
 137   } elsif ($url =~ /^no-url-copy/) {
 138     if ($old ne $path) {
 139       unlink($symlink);
 140       symlink($path, $symlink);
 141       $problems .= "WARNING: $symlink already existed with value $old, set to $path\n";
 142     } else {
 143       $normal_out .= "Symlink in src/ for $basename already there\n";
 144     }
 145   } else {
 146     unlink($symlink);
 147     $problems .= "WARNING: Removed symlink $symlink\n";
 148   }
 149 }
 150
 151 sub md5($)
 152 {
 153   my $file = shift;
 154   my $md5 = `md5sum "$file" 2>/dev/null`;
 155   $md5 =~ /^([a-f0-9]{32})/ and $md5 = $1;
 156   return $md5;
 157 }
 158
 159 sub handle_no_url($$)
 160 {
 161   my ($md5, $url) = @_;
 162
 163   $url =~ m|://([^/]+)| or die "corrupted! (no-url)";
 164   my $basename = $1;
 165   my $file = "$no_url_dir/$basename";
 166
 167   if (-f $file) {
 168     my $computed_md5 = md5($file);
 169     if ($computed_md5 ne $md5) {
 170       $problems .= "FATAL: $file md5 mismatch, needed $md5, got $computed_md5\n";
 171     } else {
 172       move_file($md5, $url, $file);
 173       make_src_symlink($md5, $url);
 174     }
 175   } else {
 176     $problems .= "FATAL: $file was not scp'ed\n";
 177   }
 178 }
 179
 180 sub fetch_file($$)
 181 {
 182   my ($md5, $url) = @_;
 183   my $out = "";
 184   my $cmd = "wget -nv -O tmp/$md5 \"$url\"";
 185
 186   my $path = file_path($md5, $url);
 187   if (-f $path) {
 188     $normal_out .= "ALREADY GOT: $url ($md5, " .  (-s $path) . " bytes)\n";
 189     make_src_symlink($md5, $url);
 190     return;
 191   }
 192
 193   if ($url =~ /^no-url/) {
 194     handle_no_url($md5, $url);
 195     return;
 196   }
 197
 198   open(W, "$cmd 2>&1 |");
 199   while (<W>) {
 200     /URL:.*\s+\-\>\s+.*/ and next;
 201     $out .= $_;
 202   }
 203   close(W);
 204   if ($out ne "") {
 205     $problems .= "$cmd:\n$out\n\n";
 206   }
 207   if (-f "tmp/$md5" && -s "tmp/$md5" > 0) {
 208     my $computed_md5 = md5("tmp/$md5");
 209     if ($computed_md5 ne $md5) {
 210       $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
 211     } else {
 212       move_file($md5, $url, "tmp/$md5");
 213     }
 214   } else {
 215     $problems .= "FATAL: $url ($md5) was not fetched\n";
 216   }
 217   unlink("tmp/$md5");
 218 }
 219
 220 sub fetch_files()
 221 {
 222   $problems .= "\n\n" if ($problems ne "");
 223   foreach $md5 (@md5) {
 224     fetch_file($md5, $url{$md5});
 225   }
 226 }
 227
 228 sub send_email()
 229 {
 230   open(EMAIL, "| /usr/sbin/sendmail -t");
 231   #open(EMAIL, "| cat");
 232   my $marker = "OK";
 233   if ($problems ne "") {
 234     $marker = "ERRORS";
 235   }
 236   print EMAIL
 237 "From: distfiles <feedback\@pld-linux.org>
 238 To: $requester
 239 Cc: $email_cc
 240 Subject: [distfiles] sources fetched $marker
 241 Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
 242 X-distfiles-program: file-fetcher.pl
 243 X-distfiles-version: " . '$Id$' . "
 244
 245 $problems
 246 Files fetched: $fetched_count
 247
 248 $normal_out
 249
 250 --
 251 Virtually Yours: distfiles.
 252 ";
 253   close(EMAIL) or die;
 254 }
 255
 256 find_file_in_spool();
 257 read_spool_file();
 258 fetch_files();
 259 send_email() unless (!$force_reply and $problems eq "" and $fetched_count == 0);