]> git.pld-linux.org Git - projects/distfiles.git/blobdiff - file-fetcher.pl
- add alternative passive-ftp; untested
[projects/distfiles.git] / file-fetcher.pl
index ab6fdc08346d02b7804c4e57c1c5ad5f91daf664..8b299a25af999dce60aaf1eb8714d645497f2b7d 100644 (file)
@@ -4,9 +4,10 @@
 $commits_list = "pld-cvs-commit\@pld-linux.org";
 
 $spool_dir = "./spool";
-$ftp_dir = "./ftp";
-$copy_dir = "src"; # relative to $ftp_dir
-$no_url_dir = "./plddfadd";
+$copy_dir = "src"; # relative to ftp root
+$no_url_dir = "./upload";
+$df_server = "distfiles.pld-linux.org";
+$df_scp = "plddist\@$df_server:ftp";
 
 @md5 = ();
 %url = ();
@@ -16,6 +17,7 @@ $requester = "";
 $file = "";
 $fetched_count = 0;
 $force_reply = 0;
+$req_login = "nobody";
 @files = ();
 
 # try lookup some file in spool, exit if it cannot be done
@@ -44,6 +46,9 @@ sub read_spool_file()
   chomp $requester;
   $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";
   my $flags = <F>;
   $force_reply++ if ($flags =~ /force-reply/);
        
@@ -53,7 +58,7 @@ 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*$/ 
+    /^([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;
@@ -71,54 +76,68 @@ sub basename($)
   return $f;
 }
 
-sub file_path($$)
+sub by_md5($$)
 {
   my ($md5, $url) = @_;
   $md5 =~ /^(.)(.)/;
-  return "$ftp_dir/by-md5/$1/$2/$md5/" . basename($url);
+  return "/by-md5/$1/$2/$md5/" . basename($url);
 }
 
-sub install_dir
+sub got_on_distfiles($$)
 {
-  my $dir = shift;
-  return if (-e $dir);
-  $dir =~ /(.*)\/[^\/]+$/ and install_dir($1);
-  mkdir($dir);
+  my ($md5, $url) = @_;
+  my $p = by_md5($md5, $url);
+  my $l = `lftp -c 'debug 0; open $df_server; quote size $p'`;
+  return $l =~ /^213 /;
+}
+
+sub copy_to_df($$)
+{
+  my ($from, $to) = @_;
+  my $cmd = "scp -r -B -q $from $df_scp/$to";
+  open(E, "$cmd 2>&1 |") or die;
+  my $oops = "";
+  while (<E>) {
+    $oops .= $_;
+  }
+  close(E);
+  $problems .= "scp problems: $cmd:\n$oops\n"
+    if ($oops ne "");
+  return ($oops ne "");
 }
 
 sub move_file($$$)
 {
   my ($md5, $url, $local_copy) = @_;
 
-  my $path = file_path($md5, $url);
+  my $bn = basename($url);
   
-  $path =~ /(.*)\/[^\/]+$/ and install_dir($1);
+  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";
+      return;
+    }
+    $local_copy = "$tmp_dir/$md5/$bn";
+  }
   
-  if (system("mv -f \"$local_copy\" \"$path\"")) {
-    $problems .= "FATAL: cannot mv file ($url)\n";
+  if (open(D, "> $tmp_dir/$md5/$bn.desc")) {
+    print D "URL: $url\n";
+    print D "Login: $req_login\n";
+    print D "MD5: $md5\n";
+    print D 'Fetched-by: $Id$'."\n";
+    print D "Time: " . time . "\n";
+    close(D);
   } else {
-    if (open(D, "> $path.desc")) {
-      print D "URL: $url\n";
-      print D "MD5: $md5\n";
-      print D 'Fetched-by: $Id$'."\n";
-      print D "Time: " . time . "\n";
-      close(D);
-    } else {
-      $problems .= "ERROR: cannot write $path.desc\n";
-    }
-    
-    # Forg logs
-    $md5 =~ /^(..)/ and my $m2 = $1;
-    $md5 =~ /^(.)(.)/;
-    if (open(L, ">> $ENV{HOME}/.lists/lista_$m2")) {
-      print L "/home/ftp/pub/Linux/distfiles/by-md5/$1/$2/$md5/" . basename($url) . "\n";
-      close(L);
-    }
-    
+    $problems .= "ERROR: cannot write $bn.desc\n";
+  }
+
+  my $dir = by_md5($md5, $url);
+  $dir =~ s|/[^/]+/[^/]+$||;
+  if (copy_to_df("$tmp_dir/$md5/", $dir) == 0) {
     $normal_out .= 
       "STORED: $url\n" .
       "\t$md5  " . basename($url) . "\n" .
-      "\tSize: " .  (-s $path) . " bytes\n";
+      "\tSize: " .  (-s $local_copy) . " bytes\n";
     $fetched_count++;
   }
 }
@@ -126,30 +145,20 @@ sub move_file($$$)
 sub make_src_symlink($$)
 {
   my ($md5, $url) = @_;
-  my $path = file_path($md5, $url);
-  $path =~ s/.*?by-md5/..\/by-md5/;
-  $url =~ m|://([^/]+)| or die "corrupted! (no-url, copy)";
-  my $basename = $1;
-  my $symlink = "$ftp_dir/$copy_dir/$basename";
-  $! = 0;
-  my $old = readlink $symlink;
-  if ($!) {
+  
+  return unless ($url =~ /^no-url/);
+  
+  my $b = basename($url);
+  if (open(S, "> $tmp_dir/$b.link")) {
     if ($url =~ /^no-url-copy/) {
-      symlink($path, $symlink);
-      $force_reply++;
-      $normal_out .= "Made symlink in src/ for $basename\n";
-    }
-  } elsif ($url =~ /^no-url-copy/) {
-    if ($old ne $path) {
-      unlink($symlink);
-      symlink($path, $symlink);
-      $problems .= "WARNING: $symlink already existed with value $old, set to $path\n";
+      print S (".." . by_md5($md5, $url));
     } else {
-      $normal_out .= "Symlink in src/ for $basename already there\n";
+      print S "REMOVE";
     }
+    close(S);
+    copy_to_df("$tmp_dir/$b.link", "$copy_dir/$b.link");
   } else {
-    unlink($symlink);
-    $problems .= "WARNING: Removed symlink $symlink\n";
+    $problems .= "ERROR: cannot write $tmp_dir/$b.link\n";
   }
 }
 
@@ -167,7 +176,7 @@ sub handle_no_url($$)
   
   $url =~ m|://([^/]+)| or die "corrupted! (no-url)";
   my $basename = $1;
-  my $file = "$no_url_dir/$basename";
+  my $file = "$no_url_dir/$req_login/$basename";
 
   if (-f $file) {
     my $computed_md5 = md5($file);
@@ -178,7 +187,7 @@ sub handle_no_url($$)
       make_src_symlink($md5, $url);
     }
   } else {
-    $problems .= "FATAL: $file was not scp'ed\n";
+    $problems .= "FATAL: $file was not uploaded\n";
   }
 }
 
@@ -186,17 +195,24 @@ sub fetch_file($$)
 {
   my ($md5, $url) = @_;
   my $out = "";
-  my $cmd = "wget -nv -O tmp/$md5 \"$url\"";
+  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\"";
 
-  push @files, basename($url);
+  push @files, $bn;
 
-  my $path = file_path($md5, $url);
-  if (-f $path) {
-    $normal_out .= "ALREADY GOT: $url ($md5, " .  (-s $path) . " bytes)\n";
+  if (got_on_distfiles($md5, $url)) {
+    $normal_out .= 
+       "ALREADY GOT: $url\n" .
+       "\t$md5  " . basename($url) . "\n";
     make_src_symlink($md5, $url);
     return;
   }
-    
+
+  mkdir("$tmp_dir/$md5") or die;
+  
   if ($url =~ /^no-url/) {
     handle_no_url($md5, $url);
     return;
@@ -204,6 +220,7 @@ sub fetch_file($$)
   
   open(W, "$cmd 2>&1 |");
   while (<W>) {
+    $all_out .= $_;
     /URL:.*\s+\-\>\s+.*/ and next;
     $out .= $_;
   }
@@ -211,17 +228,42 @@ sub fetch_file($$)
   if ($out ne "") {
     $problems .= "$cmd:\n$out\n\n";
   }
-  if (-f "tmp/$md5" && -s "tmp/$md5" > 0) {
-    my $computed_md5 = md5("tmp/$md5");
+  if (-f $local && -s $local > 0 && $url =~ /^ftp:/) {
+    open(W, "$cmd2 2>&1 |");
+    while (<W>) {
+      $all_out .= $_;
+      /URL:.*\s+\-\>\s+.*/ and next;
+      $out .= $_;
+    }
+    close(W);
+    if ($out ne "") {
+      $problems .= "$cmd:\n$out\n\n";
+    }
+  }
+  if (-f $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 {
-      move_file($md5, $url, "tmp/$md5");
+      my $testcmd = "file \"$local\" |";
+      my $testres = "";
+      if ($url =~ /^http:/ && $local =~ /\.(tar\.(bz2|gz)|tgz|zip|jar|xpi)$/) {
+        open(T, $testcmd) or die;
+        $testres = <T>;
+        close(T);
+      }
+      if ($testres =~ /empty|(ASCII|HTML|SGML).*text/) {
+        $testres =~ s/.*://;
+        $problems .= "FATAL: data returned from $url: $testres";
+      } else {
+        move_file($md5, $url, $local);
+      }
     }
   } else {
-    $problems .= "FATAL: $url ($md5) was not fetched\n";
+    $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out)\n";
   }
-  unlink("tmp/$md5");
+  # save space
+  unlink($local);
 }
 
 sub fetch_files()
@@ -266,7 +308,26 @@ Virtually Yours: distfiles.
   close(EMAIL) or die;
 }
 
+sub make_tmp_dir()
+{
+  my $id = `uuidgen 2>/dev/null`;
+  chomp $id;
+  $id = rand if (!defined $id or $id eq "");
+  $tmp_dir = "./tmp/$id";
+  mkdir($tmp_dir) or die;
+}
+
+sub clean_tmp_dir()
+{
+  system("rm -rf $tmp_dir")
+    if ($tmp_dir ne "" && -d $tmp_dir);
+}
+
+umask(002);
+
 find_file_in_spool();
 read_spool_file();
+make_tmp_dir();
 fetch_files();
 send_email() unless (!$force_reply and $problems eq "" and $fetched_count == 0);
+clean_tmp_dir();
This page took 0.08518 seconds and 4 git commands to generate.