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 $copy_dir = "src"; # relative to ftp root
   8 $no_url_dir = "./upload";
   9 $df_server = "distfiles.pld-linux.org";
  10 $df_scp = "plddist\@$df_server:ftp";
  11
  12 @md5 = ();
  13 %url = ();
  14 $problems = "";
  15 $normal_out = "";
  16 $requester = "";
  17 $file = "";
  18 $fetched_count = 0;
  19 $force_reply = 0;
  20 $req_login = "nobody";
  21 @files = ();
  22
  23 # try lookup some file in spool, exit if it cannot be done
  24 sub find_file_in_spool()
  25 {
  26   opendir(DIR, $spool_dir) || die "can't opendir $spool_dir: $!";
  27   while (1) {
  28     my $f = readdir(DIR);
  29     defined $f or last;
  30     -f "$spool_dir/$f" or next;
  31     $file = "$spool_dir/$f";
  32     last;
  33   }
  34   closedir(DIR);
  35
  36   exit 0 if ($file eq "");
  37 }
  38
  39 # read file from spool, and try unlink it. if cannot unlink -- exit
  40 # sets $requester (email), $problems, @md5 (arrays of md5's)
  41 # and %url (map from md5 to urls)
  42 sub read_spool_file()
  43 {
  44   open(F, "< $file") || exit 0;
  45   $requester = <F>;
  46   chomp $requester;
  47   $requester =~ /^[a-zA-Z_\-0-9\@\.]+$/
  48         or die "$file: evil requester: $requester";
  49   $req_login = "";
  50   $requester =~ /^([^@]+)\@/ and $req_login = $1;
  51   $req_login =~ /^[a-z0-9A-Z_]+$/ or die "$file: evil requester $requester";
  52   my $flags = <F>;
  53   $force_reply++ if ($flags =~ /force-reply/);
  54
  55   while (<F>) {
  56     if (/^ERROR/) {
  57       s/^ERROR: //;
  58       $problems .= $_;
  59       next;
  60     }
  61     /^([a-f0-9]{32})\s+((ftp|http|no-url|no-url-copy):\/\/([=\?a-z0-9A-Z:\+\~\.\-\/_]|\%[0-9])+)\s*$/
  62         or die "$file: corrupted";
  63     push @md5, $1;
  64     $url{$1} = $2;
  65     /\/$/ and die "$file: cannot fetch dir";
  66   }
  67   close(F);
  68
  69   unlink($file) || exit 0;
  70 }
  71
  72 sub basename($)
  73 {
  74   my $f = shift;
  75   $f =~ s|.*/||;
  76   return $f;
  77 }
  78
  79 sub by_md5($$)
  80 {
  81   my ($md5, $url) = @_;
  82   $md5 =~ /^(.)(.)/;
  83   return "/by-md5/$1/$2/$md5/" . basename($url);
  84 }
  85
  86 sub got_on_distfiles($$)
  87 {
  88   my ($md5, $url) = @_;
  89   my $p = by_md5($md5, $url);
  90   my $l = `lftp -c 'debug 0; open $df_server; quote size $p'`;
  91   return $l =~ /^213 /;
  92 }
  93
  94 sub copy_to_df($$)
  95 {
  96   my ($from, $to) = @_;
  97   my $cmd = "scp -r -B -q $from $df_scp/$to";
  98   open(E, "$cmd 2>&1 |") or die;
  99   my $oops = "";
 100   while (<E>) {
 101     $oops .= $_;
 102   }
 103   close(E);
 104   $problems .= "scp problems: $cmd:\n$oops\n"
 105     if ($oops ne "");
 106   return ($oops ne "");
 107 }
 108
 109 sub move_file($$$)
 110 {
 111   my ($md5, $url, $local_copy) = @_;
 112
 113   my $bn = basename($url);
 114
 115   if ($local_copy ne "$tmp_dir/$md5/$bn") {
 116     if (system("mv -f \"$local_copy\" \"$tmp_dir/$md5/$bn\"")) {
 117       $problems .= "FATAL: cannot move $local_copy to $tmp_dir\n";
 118       return;
 119     }
 120     $local_copy = "$tmp_dir/$md5/$bn";
 121   }
 122
 123   if (open(D, "> $tmp_dir/$md5/$bn.desc")) {
 124     print D "URL: $url\n";
 125     print D "Login: $req_login\n";
 126     print D "MD5: $md5\n";
 127     print D 'Fetched-by: $Id$'."\n";
 128     print D "Time: " . time . "\n";
 129     close(D);
 130   } else {
 131     $problems .= "ERROR: cannot write $bn.desc\n";
 132   }
 133
 134   my $dir = by_md5($md5, $url);
 135   $dir =~ s|/[^/]+/[^/]+$||;
 136   if (copy_to_df("$tmp_dir/$md5/", $dir) == 0) {
 137     $normal_out .=
 138       "STORED: $url\n" .
 139       "\t$md5  " . basename($url) . "\n" .
 140       "\tSize: " .  (-s $local_copy) . " bytes\n";
 141     $fetched_count++;
 142   }
 143 }
 144
 145 sub make_src_symlink($$)
 146 {
 147   my ($md5, $url) = @_;
 148
 149   return unless ($url =~ /^no-url/);
 150
 151   my $b = basename($url);
 152   if (open(S, "> $tmp_dir/$b.link")) {
 153     if ($url =~ /^no-url-copy/) {
 154       print S (".." . by_md5($md5, $url));
 155     } else {
 156       print S "REMOVE";
 157     }
 158     close(S);
 159     copy_to_df("$tmp_dir/$b.link", "$copy_dir/$b.link");
 160   } else {
 161     $problems .= "ERROR: cannot write $tmp_dir/$b.link\n";
 162   }
 163 }
 164
 165 sub md5($)
 166 {
 167   my $file = shift;
 168   my $md5 = `md5sum "$file" 2>/dev/null`;
 169   $md5 =~ /^([a-f0-9]{32})/ and $md5 = $1;
 170   return $md5;
 171 }
 172
 173 sub handle_no_url($$)
 174 {
 175   my ($md5, $url) = @_;
 176
 177   $url =~ m|://([^/]+)| or die "corrupted! (no-url)";
 178   my $basename = $1;
 179   my $file = "$no_url_dir/$req_login/$basename";
 180
 181   if (-f $file) {
 182     my $computed_md5 = md5($file);
 183     if ($computed_md5 ne $md5) {
 184       $problems .= "FATAL: $file md5 mismatch, needed $md5, got $computed_md5\n";
 185     } else {
 186       move_file($md5, $url, $file);
 187       make_src_symlink($md5, $url);
 188     }
 189   } else {
 190     $problems .= "FATAL: $file was not uploaded\n";
 191   }
 192 }
 193
 194 sub fetch_file($$)
 195 {
 196   my ($md5, $url) = @_;
 197   my $out = "";
 198   my $all_out = "";
 199   my $bn = basename($url);
 200   my $local = "$tmp_dir/$md5/$bn";
 201   my $cmd = "wget -nv -O $local \"$url\"";
 202
 203   push @files, $bn;
 204
 205   if (got_on_distfiles($md5, $url)) {
 206     $normal_out .=
 207         "ALREADY GOT: $url\n" .
 208         "\t$md5  " . basename($url) . "\n";
 209     make_src_symlink($md5, $url);
 210     return;
 211   }
 212
 213   mkdir("$tmp_dir/$md5") or die;
 214
 215   if ($url =~ /^no-url/) {
 216     handle_no_url($md5, $url);
 217     return;
 218   }
 219
 220   open(W, "$cmd 2>&1 |");
 221   while (<W>) {
 222     $all_out .= $_;
 223     /URL:.*\s+\-\>\s+.*/ and next;
 224     $out .= $_;
 225   }
 226   close(W);
 227   if ($out ne "") {
 228     $problems .= "$cmd:\n$out\n\n";
 229   }
 230   if (-f $local && -s $local > 0) {
 231     my $computed_md5 = md5($local);
 232     if ($computed_md5 ne $md5) {
 233       $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
 234     } else {
 235       my $testcmd = "file \"$local\" |";
 236       my $testres = "";
 237       if ($url =~ /^http:/ && $local =~ /\.(tar\.(bz2|gz)|tgz|zip|jar|xpi)$/) {
 238         open(T, $testcmd) or die;
 239         $testres = <T>;
 240         close(T);
 241       }
 242       if ($testres =~ /empty|(ASCII|HTML|SGML).*text/) {
 243         $testres =~ s/.*://;
 244         $problems .= "FATAL: data returned from $url: $testres";
 245       } else {
 246         move_file($md5, $url, $local);
 247       }
 248     }
 249   } else {
 250     $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out)\n";
 251   }
 252   # save space
 253   unlink($local);
 254 }
 255
 256 sub fetch_files()
 257 {
 258   $problems .= "\n\n" if ($problems ne "");
 259   foreach $md5 (@md5) {
 260     fetch_file($md5, $url{$md5});
 261   }
 262 }
 263
 264 sub send_email()
 265 {
 266   open(EMAIL, "| /usr/sbin/sendmail -t");
 267   #open(EMAIL, "| cat");
 268   my $marker = "";
 269   if ($problems ne "") {
 270     $marker = "ERRORS: ";
 271   }
 272   my $req_login;
 273   $requester =~ /^(.*)\@/ and $req_login = $1;
 274
 275   splice(@files, 10, @files - 10, "...")
 276     if (@files > 10);
 277
 278   print EMAIL
 279 "From: $req_login <$requester>
 280 To: $commits_list
 281 Cc: $requester
 282 Subject: DISTFILES: ${marker}@{files}
 283 Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
 284 X-distfiles-program: file-fetcher.pl
 285 X-distfiles-version: " . '$Id$' . "
 286
 287 $problems
 288 Files fetched: $fetched_count
 289
 290 $normal_out
 291
 292 --
 293 Virtually Yours: distfiles.
 294 ";
 295   close(EMAIL) or die;
 296 }
 297
 298 sub make_tmp_dir()
 299 {
 300   my $id = `uuidgen 2>/dev/null`;
 301   chomp $id;
 302   $id = rand if (!defined $id or $id eq "");
 303   $tmp_dir = "./tmp/$id";
 304   mkdir($tmp_dir) or die;
 305 }
 306
 307 sub clean_tmp_dir()
 308 {
 309   system("rm -rf $tmp_dir")
 310     if ($tmp_dir ne "" && -d $tmp_dir);
 311 }
 312
 313 umask(002);
 314
 315 find_file_in_spool();
 316 read_spool_file();
 317 make_tmp_dir();
 318 fetch_files();
 319 send_email() unless (!$force_reply and $problems eq "" and $fetched_count == 0);
 320 clean_tmp_dir();