- allow ";" in uris

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

diff --git a/file-fetcher.pl b/file-fetcher.pl
index e5b08fcf678cf67211ed2793ec0919f826bdb80b..c7fdf186b7c621d174f30949dd660b44b02cf8f1 100644 (file)
--- a/file-fetcher.pl
+++ b/file-fetcher.pl
@@ -21,6 +21,7 @@ $file = "";
 $fetched_count = 0;
 $force_reply = 0;
 $req_login = "nobody";
+$spec = "";
 @files = ();
 
 # try lookup some file in spool, exit if it cannot be done
@@ -40,21 +41,23 @@ 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) 
+# 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\@\.]+$/ 
+  $requester =~ /^[a-zA-Z_0-9@.-]+$/
        or die "$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 die "$file: evil requester $requester";
+  $spec = <F>;
+  $spec =~ s/\.spec$//;
   my $flags = <F>;
   $force_reply++ if ($flags =~ /force-reply/);
-       
+
   while (<F>) {
     if (/^ERROR/) {
       s/^ERROR: //;
@@ -120,7 +123,7 @@ sub move_file($$$)
   my ($md5, $url, $local_copy) = @_;
 
   my $bn = basename($url);
-  
+
   if ($local_copy ne "$tmp_dir/$md5/$bn") {
     if (system("mv -f \"$local_copy\" \"$tmp_dir/$md5/$bn\"")) {
       $problems .= "FATAL: cannot move $local_copy to $tmp_dir\n";
@@ -128,7 +131,7 @@ sub move_file($$$)
     }
     $local_copy = "$tmp_dir/$md5/$bn";
   }
-  
+
   if (open(D, "> $tmp_dir/$md5/$bn.desc")) {
     print D "URL: $url\n";
     print D "Login: $req_login\n";
@@ -143,7 +146,7 @@ sub move_file($$$)
   my $dir = by_md5($md5, $url);
   $dir =~ s|/[^/]+/[^/]+$||;
   if (copy_to_df("$tmp_dir/$md5/", $dir) == 0) {
-    $normal_out .= 
+    $normal_out .=
       "STORED: $url\n" .
       "\t$md5  " . basename($url) . "\n" .
       "\tSize: " .  (-s $local_copy) . " bytes\n";
@@ -154,9 +157,9 @@ sub move_file($$$)
 sub make_src_symlink($$)
 {
   my ($md5, $url) = @_;
-  
+
   return unless ($url =~ /^no-url/);
-  
+
   my $b = basename($url);
   if (open(S, "> $tmp_dir/$b.link")) {
     if ($url =~ /^no-url-copy/) {
@@ -193,7 +196,7 @@ sub md5($)
 sub handle_no_url($$)
 {
   my ($md5, $url) = @_;
-  
+
   unless ($url =~ m#://([^/]+)#) {
     $problems .= "$url: corrupted! (no-url)";
     return;
@@ -227,7 +230,7 @@ sub fetch_file($$)
   push @files, $bn;
 
   if (got_on_distfiles($md5, $url)) {
-    $normal_out .= 
+    $normal_out .=
        "ALREADY GOT: $url\n" .
        "\t$md5  " . basename($url) . "\n";
     make_src_symlink($md5, $url);
@@ -235,12 +238,12 @@ sub fetch_file($$)
   }
 
   mkdir("$tmp_dir/$md5");
-  
+
   if ($url =~ /^no-url/) {
     handle_no_url($md5, $url);
     return;
   }
-  
+
   open(W, "$cmd 2>&1 |");
   while (<W>) {
     $all_out .= $_;
@@ -313,12 +316,12 @@ sub send_email()
 
   splice(@files, 10, @files - 10, "...")
     if (@files > 10);
-  
-  print EMAIL 
+
+  print EMAIL
 "From: $req_login <$requester>
 To: $commits_list
 Cc: $requester
-Subject: DISTFILES: ${marker}@{files}
+Subject: DISTFILES: ${spec}: ${marker}@{files}
 Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
 X-distfiles-program: file-fetcher.pl
 X-distfiles-version: " . '$Id$' . "