- allow commas in url

[projects/distfiles.git] / file-fetcher.pl

diff --git a/file-fetcher.pl b/file-fetcher.pl
index 8c5e2760316bfcca2f17d8a302521269c19e45bb..32cce7a1bf9c8b450c15c76d1c8f3e2314dc6a3e 100644 (file)
--- a/file-fetcher.pl
+++ b/file-fetcher.pl
@@ -1,16 +1,18 @@
 #!/usr/bin/perl -w
-#
+# $Id$
 
-$commits_list = "pld-cvs-commit\@pld-linux.org";
+use IPC::Run qw(run);
+
+$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\@$df_server:ftp";
+$df_scp = "plddist\@ep09.pld-linux.org:ftp";
 
 @md5 = ();
-%url = ();
+@url = ();
 $problems = "";
 $normal_out = "";
 $requester = "";
@@ -38,7 +40,7 @@ sub find_file_in_spool()
 
 # 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)
+# and @url (map from md5 to urls)
 sub read_spool_file()
 {
   open(F, "< $file") || exit 0;
@@ -58,11 +60,16 @@ sub read_spool_file()
       $problems .= $_;
       next;
     }
-    /^([a-f0-9]{32})\s+((ftp|http|no-url|no-url-copy):\/\/([=\@\?a-z0-9A-Z:\+\~\.\-\/_]|\%[0-9])+)\s*$/ 
-       or die "$file: corrupted";
-    push @md5, $1;
-    $url{$1} = $2;
-    /\/$/ and die "$file: cannot fetch dir";
+    if (/^([a-f0-9]{32})\s+((ftp|http|https|no-url|no-url-copy):\/\/([=\@\?a-z0-9A-Z:\+\~\.,\-\/_]|\%[0-9])+)\s*$/) {
+      if (/\/$/) {
+       $problems .= "$file: cannot fetch dir";
+      } else {
+       push @md5, $1;
+       push @url, $2;
+      }
+    } else {
+       $problems .= "FILE: $file: corrupted";
+    }
   }
   close(F);
 
@@ -100,7 +107,8 @@ sub copy_to_df($$)
   while (<E>) {
     $oops .= $_;
   }
-  close(E);
+  $oops .= "\nThe command has exited with a non-zero status."
+    unless (close (E));
   $problems .= "scp problems: $cmd:\n$oops\n"
     if ($oops ne "");
   return ($oops ne "");
@@ -165,7 +173,18 @@ sub make_src_symlink($$)
 sub md5($)
 {
   my $file = shift;
-  my $md5 = `md5sum "$file" 2>/dev/null`;
+  my $in = "";
+  my $md5 = "";
+  my $err = "";
+  my @cmd = ("md5sum", $file);
+
+  run \@cmd, \$in, \$md5, \$err;
+  if ($err ne "") {
+    chomp($err);
+    $problems .= "FATAL: " . $err . "\n";
+    return "error";
+  }
+  chomp $md5;
   $md5 =~ /^([a-f0-9]{32})/ and $md5 = $1;
   return $md5;
 }
@@ -174,7 +193,10 @@ sub handle_no_url($$)
 {
   my ($md5, $url) = @_;
   
-  $url =~ m|://([^/]+)| or die "corrupted! (no-url)";
+  unless ($url =~ m#://([^/]+)#) {
+    $problems .= "$url: corrupted! (no-url)";
+    return;
+  }
   my $basename = $1;
   my $file = "$no_url_dir/$req_login/$basename";
 
@@ -198,8 +220,8 @@ sub fetch_file($$)
   my $all_out = "";
   my $bn = basename($url);
   my $local = "$tmp_dir/$md5/$bn";
-  my $cmd = "wget -nv -O $local \"$url\"";
-  my $cmd2 = "wget -nv --passive-ftp -O $local \"$url\"";
+  my $cmd = "wget -nv --no-check-certificate -O $local \"$url\"";
+  my $cmd2 = "wget -nv --no-check-certificate --passive-ftp -O $local \"$url\"";
 
   push @files, $bn;
 
@@ -241,14 +263,14 @@ sub fetch_file($$)
       $problems .= "$cmd:\n$out\n\n";
     }
   }
-  if (-f $local && -s $local > 0) {
+  if (-r $local && -s $local > 0) {
     my $computed_md5 = md5($local);
     if ($computed_md5 ne $md5) {
       $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
     } else {
       my $testcmd = "file \"$local\" |";
       my $testres = "";
-      if ($url =~ /^http:/ && $local =~ /\.(tar\.(bz2|gz)|tgz|zip|jar|xpi)$/) {
+      if ($url =~ /^(http|https):/ && $local =~ /\.(tar\.(bz2|gz)|tgz|zip|jar|xpi)$/) {
         open(T, $testcmd) or die;
         $testres = <T>;
         close(T);
@@ -260,6 +282,8 @@ sub fetch_file($$)
         move_file($md5, $url, $local);
       }
     }
+  } elsif (-f $local && -s $local > 0) {
+    $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out): file is not readable\n";
   } else {
     $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out)\n";
   }
@@ -270,8 +294,8 @@ sub fetch_file($$)
 sub fetch_files()
 {
   $problems .= "\n\n" if ($problems ne "");
-  foreach $md5 (@md5) {
-    fetch_file($md5, $url{$md5});
+  foreach $i (0..$#md5) {
+    fetch_file($md5[$i], $url[$i]);
   }
 }