#!/usr/bin/perl -w
#
+$commits_list = "pld-cvs-commit\@pld-linux.org";
+
$spool_dir = "./spool";
$ftp_dir = "./ftp";
-$email_cc = "";
-
+$copy_dir = "src"; # relative to $ftp_dir
+$no_url_dir = "./plddfadd";
@md5 = ();
%url = ();
$file = "";
$fetched_count = 0;
$force_reply = 0;
+@files = ();
# try lookup some file in spool, exit if it cannot be done
sub find_file_in_spool()
if (/^ERROR/) {
s/^ERROR: //;
$problems .= $_;
+ next;
}
- /^([a-f0-9]{32})\s+((ftp|http):\/\/([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;
unlink($file) || exit 0;
}
+sub basename($)
+{
+ my $f = shift;
+ $f =~ s|.*/||;
+ return $f;
+}
+
sub file_path($$)
{
my ($md5, $url) = @_;
-
$md5 =~ /^(.)(.)/;
- my $md5_dir = "$ftp_dir/by-md5/$1/$2/$md5";
- $url =~ /\/([^\/]+)$/ or die;
- my $basename = $1;
- return "$md5_dir/$basename";
+ return "$ftp_dir/by-md5/$1/$2/$md5/" . basename($url);
}
sub install_dir
mkdir($dir);
}
-sub move_file($$)
+sub move_file($$$)
{
- my ($md5, $url) = @_;
+ my ($md5, $url, $local_copy) = @_;
my $path = file_path($md5, $url);
$path =~ /(.*)\/[^\/]+$/ and install_dir($1);
- if (system("mv -f \"tmp/$md5\" \"$path\"")) {
+ if (system("mv -f \"$local_copy\" \"$path\"")) {
$problems .= "FATAL: cannot mv file ($url)\n";
} else {
- $normal_out .= "STORED: $url ($md5, " . (-s $path) . " bytes)\n";
+ 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);
+ }
+
+ $normal_out .=
+ "STORED: $url\n" .
+ "\t$md5 " . basename($url) . "\n" .
+ "\tSize: " . (-s $path) . " bytes\n";
$fetched_count++;
}
}
+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 ($!) {
+ 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";
+ } else {
+ $normal_out .= "Symlink in src/ for $basename already there\n";
+ }
+ } else {
+ unlink($symlink);
+ $problems .= "WARNING: Removed symlink $symlink\n";
+ }
+}
+
+sub md5($)
+{
+ my $file = shift;
+ my $md5 = `md5sum "$file" 2>/dev/null`;
+ $md5 =~ /^([a-f0-9]{32})/ and $md5 = $1;
+ return $md5;
+}
+
+sub handle_no_url($$)
+{
+ my ($md5, $url) = @_;
+
+ $url =~ m|://([^/]+)| or die "corrupted! (no-url)";
+ my $basename = $1;
+ 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";
+ } else {
+ move_file($md5, $url, $file);
+ make_src_symlink($md5, $url);
+ }
+ } else {
+ $problems .= "FATAL: $file was not scp'ed\n";
+ }
+}
+
sub fetch_file($$)
{
my ($md5, $url) = @_;
my $out = "";
my $cmd = "wget -nv -O tmp/$md5 \"$url\"";
-
+
+ push @files, basename($url);
+
my $path = file_path($md5, $url);
if (-f $path) {
- $normal_out .= "ALREADY GOT: $url ($md5, " . (-s $path) . " bytes)\n";
+ $normal_out .=
+ "ALREADY GOT: $url\n" .
+ "\t$md5 " . basename($url) . "\n" .
+ "\tSize: " . (-s $path) . " bytes.\n";
+ make_src_symlink($md5, $url);
return;
}
+ if ($url =~ /^no-url/) {
+ handle_no_url($md5, $url);
+ return;
+ }
+
open(W, "$cmd 2>&1 |");
while (<W>) {
/URL:.*\s+\-\>\s+.*/ and next;
$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;
+ my $computed_md5 = md5("tmp/$md5");
if ($computed_md5 ne $md5) {
$problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
} else {
- move_file($md5, $url);
+ move_file($md5, $url, "tmp/$md5");
}
} else {
$problems .= "FATAL: $url ($md5) was not fetched\n";
sub send_email()
{
- #open(EMAIL, "| /usr/sbin/sendmail -t");
- open(EMAIL, "| cat");
- my $marker = "OK";
+ open(EMAIL, "| /usr/sbin/sendmail -t");
+ #open(EMAIL, "| cat");
+ my $marker = "";
if ($problems ne "") {
- $marker = "ERRORS";
+ $marker = "ERRORS: ";
}
+ my $req_login;
+ $requester =~ /^(.*)\@/ and $req_login = $1;
+
+ splice(@files, 10, @files - 10, "...")
+ if (@files > 10);
+
print EMAIL
-"From: distfiles <feedback\@pld-linux.org>
-To: $requester
-Cc: $email_cc
-Subject: [distfiles] sources fetched $marker
+"From: $req_login <$requester>
+To: $commits_list
+Cc: $requester
+Subject: DISTFILES: ${marker}@{files}
Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
X-distfiles-program: file-fetcher.pl
X-distfiles-version: " . '$Id$' . "
$normal_out
--
-Virtually yours: distfiles.
+Virtually Yours: distfiles.
";
close(EMAIL) or die;
}