file-fetcher.pl

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