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   my $cmd2 = "wget -nv --passive-ftp -O $local \"$url\"";
 203
 204   push @files, $bn;
 205
 206   if (got_on_distfiles($md5, $url)) {
 207     $normal_out .=
 208         "ALREADY GOT: $url\n" .
 209         "\t$md5  " . basename($url) . "\n";
 210     make_src_symlink($md5, $url);
 211     return;
 212   }
 213
 214   mkdir("$tmp_dir/$md5") or die;
 215
 216   if ($url =~ /^no-url/) {
 217     handle_no_url($md5, $url);
 218     return;
 219   }
 220
 221   open(W, "$cmd 2>&1 |");
 222   while (<W>) {
 223     $all_out .= $_;
 224     /URL:.*\s+\-\>\s+.*/ and next;
 225     $out .= $_;
 226   }
 227   close(W);
 228   if ($out ne "") {
 229     $problems .= "$cmd:\n$out\n\n";
 230   }
 231   if (-f $local && -s $local > 0 && $url =~ /^ftp:/) {
 232     open(W, "$cmd2 2>&1 |");
 233     while (<W>) {
 234       $all_out .= $_;
 235       /URL:.*\s+\-\>\s+.*/ and next;
 236       $out .= $_;
 237     }
 238     close(W);
 239     if ($out ne "") {
 240       $problems .= "$cmd:\n$out\n\n";
 241     }
 242   }
 243   if (-f $local && -s $local > 0) {
 244     my $computed_md5 = md5($local);
 245     if ($computed_md5 ne $md5) {
 246       $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
 247     } else {
 248       my $testcmd = "file \"$local\" |";
 249       my $testres = "";
 250       if ($url =~ /^http:/ && $local =~ /\.(tar\.(bz2|gz)|tgz|zip|jar|xpi)$/) {
 251         open(T, $testcmd) or die;
 252         $testres = <T>;
 253         close(T);
 254       }
 255       if ($testres =~ /empty|(ASCII|HTML|SGML).*text/) {
 256         $testres =~ s/.*://;
 257         $problems .= "FATAL: data returned from $url: $testres";
 258       } else {
 259         move_file($md5, $url, $local);
 260       }
 261     }
 262   } else {
 263     $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out)\n";
 264   }
 265   # save space
 266   unlink($local);
 267 }
 268
 269 sub fetch_files()
 270 {
 271   $problems .= "\n\n" if ($problems ne "");
 272   foreach $md5 (@md5) {
 273     fetch_file($md5, $url{$md5});
 274   }
 275 }
 276
 277 sub send_email()
 278 {
 279   open(EMAIL, "| /usr/sbin/sendmail -t");
 280   #open(EMAIL, "| cat");
 281   my $marker = "";
 282   if ($problems ne "") {
 283     $marker = "ERRORS: ";
 284   }
 285   my $req_login;
 286   $requester =~ /^(.*)\@/ and $req_login = $1;
 287
 288   splice(@files, 10, @files - 10, "...")
 289     if (@files > 10);
 290
 291   print EMAIL
 292 "From: $req_login <$requester>
 293 To: $commits_list
 294 Cc: $requester
 295 Subject: DISTFILES: ${marker}@{files}
 296 Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
 297 X-distfiles-program: file-fetcher.pl
 298 X-distfiles-version: " . '$Id$' . "
 299
 300 $problems
 301 Files fetched: $fetched_count
 302
 303 $normal_out
 304
 305 --
 306 Virtually Yours: distfiles.
 307 ";
 308   close(EMAIL) or die;
 309 }
 310
 311 sub make_tmp_dir()
 312 {
 313   my $id = `uuidgen 2>/dev/null`;
 314   chomp $id;
 315   $id = rand if (!defined $id or $id eq "");
 316   $tmp_dir = "./tmp/$id";
 317   mkdir($tmp_dir) or die;
 318 }
 319
 320 sub clean_tmp_dir()
 321 {
 322   system("rm -rf $tmp_dir")
 323     if ($tmp_dir ne "" && -d $tmp_dir);
 324 }
 325
 326 umask(002);
 327
 328 find_file_in_spool();
 329 read_spool_file();
 330 make_tmp_dir();
 331 fetch_files();
 332 send_email() unless (!$force_reply and $problems eq "" and $fetched_count == 0);
 333 clean_tmp_dir();