- initial

Changed files:
    file-fetcher.pl -> 1.1

diff --git a/file-fetcher.pl b/file-fetcher.pl
new file mode 100644 (file)
index 0000000..0e7085c
--- /dev/null
+++ b/file-fetcher.pl
@@ -0,0 +1,137 @@
+#!/usr/bin/perl -w
+#
+
+$spool_dir = "./spool";
+$ftp_dir = "./ftp";
+$email_cc = "";
+
+
+@md5 = ();
+%url = ();
+$problems = "";
+$normal_out = "";
+$requester = "";
+$file = "";
+
+# try lookup some file in spool, exit if it cannot be done
+sub find_file_in_spool()
+{
+  opendir(DIR, $spool_dir) || die "can't opendir $spool_dir: $!";
+  while (1) {
+    my $f = readdir(DIR);
+    defined $f or last;
+    -f "$spool_dir/$f" or next;
+    $file = "$spool_dir/$f";
+    last;
+  }
+  closedir(DIR);
+
+  exit 0 if ($file eq "");
+}
+
+# read file from spool, and try unlink it. if cannot unlink -- exit
+# sets $requester (email), $problems, @md5 (arrays of md5's) 
+# and %url (map from md5 to urls)
+sub read_spool_file()
+{
+  open(F, "< $file") || exit 0;
+  $requester = <F>;
+  chomp $requester;
+  $requester =~ /^[a-zA-Z_\-0-9\@\.]+$/ 
+       or die "$file: evil requester: $requester";
+       
+  while (<F>) {
+    if (/^ERROR/) {
+      s/^ERROR: //;
+      $problems .= $_;
+    }
+    /^([a-f0-9]{32})\s+((ftp|http):\/\/([a-z0-9A-Z:\+\~\.\-\/_]|\%[0-9])+)\s*$/ 
+       or die "$file: corrupted";
+    push @md5, $1;
+    $url{$1} = $2;
+    /\/$/ and die "$file: cannot fetch dir";
+  }
+  close(F);
+
+  unlink($file) || exit 0;
+}
+
+sub move_file($$)
+{
+  my ($md5, $url) = @_;
+  
+  $md5 =~ /^(.)(.)/;
+  my $md5_dir = "$ftp_dir/by-md5/$1/$2/$md5";
+  
+  mkdir("$ftp_dir/by-md5/$1");
+  mkdir("$ftp_dir/by-md5/$1/$2");
+  mkdir($md5_dir);
+  
+  $url =~ /\/([^\/]+)$/ or die;
+  my $basename = $1;
+  if (system("mv -f \"tmp/$md5\" \"$md5_dir/$basename\"")) {
+    $problems .= "FATAL: cannot mv file ($url)\n";
+  } else {
+    $normal_out .= "STORED: $url ($md5, " . 
+                       (-s "$md5_dir/$basename") . " bytes)\n";
+  }
+}
+
+sub fetch_file($$)
+{
+  my ($md5, $url) = @_;
+  my $out = "";
+  my $cmd = "wget -nv -O tmp/$md5 \"$url\"";
+  open(W, "$cmd 2>&1 |");
+  while (<W>) {
+    /URL:.*\s+\-\>\s+.*/ and next;
+    $out .= $_;
+  }
+  close(W);
+  if ($out ne "") {
+    $problems .= "$cmd:\n$out\n\n";
+  }
+  if (-f "tmp/$md5" && -s "tmp/$md5" > 0) {
+    my $computed_md5 = `md5sum tmp/$md5`;
+    $computed_md5 =~ /^([a-f0-9]{32})/ and $computed_md5 = $1;
+    if ($computed_md5 ne $md5) {
+      $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
+    } else {
+      move_file($md5, $url);
+    }
+  } else {
+    $problems .= "FATAL: $url ($md5) was not fetched\n";
+  }
+}
+
+sub fetch_files()
+{
+  $problems .= "\n\n" if ($problems ne "");
+  foreach $md5 (@md5) {
+    fetch_file($md5, $url{$md5});
+  }
+}
+
+sub send_email()
+{
+  #open(EMAIL, "| /usr/sbin/sendmail -t");
+  open(EMAIL, "| cat");
+  my $marker = "OK";
+  if ($problems ne "") {
+    $marker = "ERRORS";
+  }
+  print EMAIL "To: $requester
+Cc: $email_cc
+Subject: [distfiles] sources fetched $marker
+From: distfiles <feedback\@pld.org.pl>
+
+$problems
+$normal_out
+";
+  close(EMAIL) or die;
+}
+
+find_file_in_spool();
+read_spool_file();
+fetch_files();
+send_email();