X-Git-Url: https://git.pld-linux.org/?a=blobdiff_plain;f=file-fetcher.pl;h=3b08f279414ce0ec712385e1ea1572310031f0e3;hb=958ed10fe8f0ee29ee2063f6358747b3434b192f;hp=52d6f7f2bdd746fc4dafa6f9fa4b6db673a12f3b;hpb=92eba545da20c2fac194d4cad0c1737aad4c23b7;p=projects%2Fdistfiles.git

diff --git a/file-fetcher.pl b/file-fetcher.pl
old mode 100644
new mode 100755
index 52d6f7f..3b08f27
--- a/file-fetcher.pl
+++ b/file-fetcher.pl
@@ -1,15 +1,17 @@
 #!/usr/bin/perl -w
-# $Id$
-
 use IPC::Run qw(run);
 
+use Sys::Syslog;
+
+openlog("distfiles-ff", "pid", "user"); 
+
 $commits_list = "pld-cvs-commit\@lists.pld-linux.org";
 
 $spool_dir = "./spool";
 $copy_dir = "src"; # relative to ftp root
 $no_url_dir = "./upload";
 $df_server = "distfiles.pld-linux.org";
-$df_scp = "plddist\@ep09.pld-linux.org:ftp";
+$df_scp = "plddist\@distfiles.pld-linux.org:ftp";
 $user_agent = "PLD/distfiles";
 
 @md5 = ();
@@ -24,10 +26,18 @@ $req_login = "nobody";
 $spec = "";
 @files = ();
 
+sub fatal($)
+{
+  my $msg = shift;
+
+  syslog("err","FATAL: $msg");
+  die "$msg";
+}
+
 # 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: $!";
+  opendir(DIR, $spool_dir) || fatal("can't opendir $spool_dir: $!");
   while (1) {
     my $f = readdir(DIR);
     defined $f or last;
@@ -45,14 +55,15 @@ sub find_file_in_spool()
 # and @url (map from md5 to urls)
 sub read_spool_file()
 {
+  syslog("info","reading spool file $file");
   open(F, "< $file") || exit 0;
   $requester = <F>;
   chomp $requester;
   $requester =~ /^[a-zA-Z_0-9@.-]+$/
-        or die "$file: evil requester: $requester";
+        or fatal("$file: evil requester: $requester");
   $req_login = "";
   $requester =~ /^([^@]+)\@/ and $req_login = $1;
-  $req_login =~ /^[a-z0-9A-Z_.]+$/ or die "$file: evil requester $requester";
+  $req_login =~ /^[a-z0-9A-Z_.]+$/ or fatal("$file: evil requester $requester");
   $spec = <F>;
   chomp $spec;
   $spec =~ s/\.spec$//;
@@ -66,7 +77,7 @@ sub read_spool_file()
       $problems .= $_;
       next;
     }
-    if (/^([a-f0-9]{32})\s+((ftp|http|https|no-url|no-url-copy):\/\/([a-z0-9A-Z;:\=\?&\@\+\~\.,\-\/_]|\%[0-9])+(#\/[a-zA-Z0-9\._-]+)?)\s*$/) {
+    if (/^([a-f0-9]{32})\s+((ftp|http|https|no-url|no-url-copy):\/\/([a-z0-9A-Z;:\=\?&\@\+\~\.,\-\/\#_]|\%[0-9])+(#\/[a-zA-Z0-9\._-]+)?)\s*$/) {
       if (/\/$/) {
         $problems .= "$file: cannot fetch dir";
       } else {
@@ -100,7 +111,7 @@ sub got_on_distfiles($$)
 {
   my ($md5, $url) = @_;
   my $p = by_md5($md5, $url);
-  my $l = `lftp -c 'debug 0; open $df_server; quote size $p'`;
+  my $l = `lftp -c 'debug 0; open $df_server; quote size \"$p\"'`;
   return $l =~ /^213 /;
 }
 
@@ -108,7 +119,7 @@ sub copy_to_df($$)
 {
   my ($from, $to) = @_;
   my $cmd = "scp -pr -B -q $from $df_scp/$to";
-  open(E, "$cmd 2>&1 |") or die;
+  open(E, "$cmd 2>&1 |") or fatal("$cmd failed");
   my $oops = "";
   while (<E>) {
     $oops .= $_;
@@ -117,6 +128,7 @@ sub copy_to_df($$)
     unless (close (E));
   $problems .= "scp problems: $cmd:\n$oops\n"
     if ($oops ne "");
+  syslog("err","copy_to_df oops for '$cmd': $oops") if ($oops ne "");
   return ($oops ne "");
 }
 
@@ -133,6 +145,9 @@ sub move_file($$$)
     }
     $local_copy = "$tmp_dir/$md5/$bn";
   }
+  # no-url local copy may have wrong permissions (it's created by ftp upload)
+  # always fix them
+  chmod(0644, $local_copy);
 
   if (open(D, "> $tmp_dir/$md5/$bn.desc")) {
     print D "URL: $url\n";
@@ -204,18 +219,18 @@ sub handle_no_url($$)
     return;
   }
   my $basename = $1;
-  my $file = "$no_url_dir/$req_login/$basename";
+  my $file = "$no_url_dir/$basename";
 
   if (-f $file) {
     my $computed_md5 = md5($file);
     if ($computed_md5 ne $md5) {
-      $problems .= "FATAL: $file md5 mismatch, needed $md5, got $computed_md5\n";
+      $problems .= "FATAL: $basename md5 mismatch, needed $md5, got $computed_md5\n";
     } else {
       move_file($md5, $url, $file);
       make_src_symlink($md5, $url);
     }
   } else {
-    $problems .= "FATAL: $file was not uploaded\n";
+    $problems .= "FATAL: $basename was not uploaded\n";
   }
 }
 
@@ -226,11 +241,22 @@ sub fetch_file($$)
   my $all_out = "";
   my $bn = basename($url);
   my $local = "$tmp_dir/$md5/$bn";
-  my $cmd = "wget -nv --no-check-certificate --user-agent=$user_agent -O $local \"$url\"";
-  my $cmd2 = "wget -nv --no-check-certificate --user-agent=$user_agent --passive-ftp -O $local \"$url\"";
+  my @cmd = ("wget", "-nv", "--no-check-certificate", "--user-agent=$user_agent", "-O", $local, $url);
+  my $cmd_joined = join(' ', @cmd);
+  my @cmd2 = ("wget",  "-nv", "--no-check-certificate", "--user-agent=$user_agent", "--passive-ftp", "-O", $local, $url);
+  my $cmd2_joined = join(' ', @cmd2);
+
+  syslog("info","fetch_file($md5,$url)");
 
   push @files, $bn;
 
+  if ( $bn =~ m/(%[0-9a-f]{2})/i ) {
+    $problems .= "$bn: refusing to download file with uri escape codes ($1) in the name\n";
+    $bn =~ s/%[0-9a-f]{2}/_/g;
+    $problems .= "HINT: use $url?/$bn as source to rename the file\n\n";
+    return;
+  }
+
   if (got_on_distfiles($md5, $url)) {
     $normal_out .=
         "ALREADY GOT: $url\n" .
@@ -246,7 +272,12 @@ sub fetch_file($$)
     return;
   }
 
-  open(W, "$cmd 2>&1 |");
+  my $pid = open(W, "-|");
+  fatal("Cannot fork $!") unless defined $pid;
+  unless ( $pid ) {
+    open STDERR, ">&", \*STDOUT  or fatal("$0: open: $!");
+    exec { $cmd[0] } @cmd or fatal("$0: exec: $!");
+  }
   while (<W>) {
     $all_out .= $_;
     /URL:.*\s+\-\>\s+.*/ and next;
@@ -254,16 +285,23 @@ sub fetch_file($$)
   }
   close(W);
   if ($out ne "") {
-    $problems .= "$cmd:\n$out\n\n";
+    syslog("err","$cmd_joined: $out");
+    $problems .= "$cmd_joined:\n$out\n\n";
   }
   if ( $? ) {
-    $problems .= sprintf "$cmd:\nexited with code %d (0x%02x)\n\n",
+    $problems .= sprintf "%s:\nexited with code %d (0x%02x)\n\n",
+      $cmd_joined,
       $? >> 8,
       $? & 0xff;
   }
   if (-f $local && -s $local == 0 && $url =~ /^ftp:/) {
     $out = "";
-    open(W, "$cmd2 2>&1 |");
+    my $pid = open(W, "-|");
+    fatal("Cannot fork $!") unless defined $pid;
+    unless ( $pid ) {
+      open STDERR, ">&", \*STDOUT  or fatal("$0: open: $!");
+      exec { $cmd2[0] } @cmd2 or fatal("$0: exec: $!");
+    }
     while (<W>) {
       $all_out .= "\n\t\t$_";
       /URL:.*\s+\-\>\s+.*/ and next;
@@ -271,10 +309,11 @@ sub fetch_file($$)
     }
     close(W);
     if ($out ne "") {
-      $problems .= "$cmd2:\n$out\n\n";
+      $problems .= "$cmd2_joined:\n$out\n\n";
     }
     if ( $? ) {
-      $problems .= sprintf "$cmd2:\nexited with code %d (0x%02x)\n\n",
+      $problems .= sprintf "%s:\nexited with code %d (0x%02x)\n\n",
+        $cmd2_joined,
         $? >> 8,
         $? & 0xff;
     }
@@ -287,7 +326,7 @@ sub fetch_file($$)
       my $testcmd = "file \"$local\" |";
       my $testres = "";
       if ($url =~ /^(http|https):/ && $local =~ /\.(tar\.(bz2|gz)|tgz|zip|jar|xpi)$/) {
-        open(T, $testcmd) or die;
+        open(T, $testcmd) or fatal("$testcmd failed");
         $testres = <T>;
         close(T);
       }
@@ -299,11 +338,11 @@ sub fetch_file($$)
       }
     }
   } elsif (-f $local && -s $local > 0) {
-    $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out): file is not readable\n";
+    $problems .= "FATAL: $url ($md5) was not fetched correctly ($cmd_joined: $all_out): file is not readable\n";
   } elsif (-f $local && not -s $local) {
-    $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out): file exists but has 0 length\n";
+    $problems .= "FATAL: $url ($md5) was not fetched correctly ($cmd_joined: $all_out): file fetched but has 0 length\n";
   } else {
-    $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out)\n";
+    $problems .= "FATAL: $url ($md5) was not fetched correctly ($cmd_joined: $all_out)\n";
   }
   # save space
   unlink($local);
@@ -319,8 +358,6 @@ sub fetch_files()
 
 sub send_email()
 {
-  open(EMAIL, "| /usr/sbin/sendmail -t");
-  #open(EMAIL, "| cat");
   my $marker = "";
   if ($problems ne "") {
     $marker = "ERRORS: ";
@@ -331,16 +368,13 @@ sub send_email()
   splice(@files, 10, @files - 10, "...")
     if (@files > 10);
 
-  print EMAIL
+  my $message_id = 
+  my $email_head =
 "From: $req_login <$requester>
-To: $commits_list
-Cc: $requester
 Subject: DISTFILES: ${spec}: ${marker}@{files}
-Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
-X-distfiles-program: file-fetcher.pl
-X-distfiles-version: " . '$Id$' . "
-
-$problems
+X-distfiles-program: file-fetcher.pl";
+  my $email_body =
+"$problems
 Files fetched: $fetched_count
 
 $normal_out
@@ -348,7 +382,34 @@ $normal_out
 -- 
 Virtually Yours: distfiles.
 ";
-  close(EMAIL) or die;
+
+  syslog("info","sending email to $requester");
+  open(EMAIL, "| /usr/sbin/sendmail -t");
+  #open(EMAIL, "| cat");
+
+  print EMAIL
+"To: $requester
+$email_head
+Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
+
+$email_body";
+
+  close(EMAIL) or fatal("close() failed");
+
+  syslog("info","sending email to $commits_list");
+  open(EMAIL, "| /usr/sbin/sendmail -t");
+  #open(EMAIL, "| cat");
+
+  print EMAIL
+"To: $commits_list
+$email_head
+Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
+
+Request by: $requester
+
+$email_body";
+
+  close(EMAIL) or fatal("close() failed");
 }
 
 sub make_tmp_dir()
@@ -357,7 +418,7 @@ sub make_tmp_dir()
   chomp $id;
   $id = rand if (!defined $id or $id eq "");
   $tmp_dir = "./tmp/$id";
-  mkdir($tmp_dir) or die;
+  mkdir($tmp_dir) or fatal("mkdir($tmp_dir) failed");
 }
 
 sub clean_tmp_dir()