#!/usr/bin/perl -w
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 = ();
$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;
# 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$//;
$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 {
{
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 /;
}
{
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 .= $_;
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 "");
}
}
$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";
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";
}
}
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;
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;
}
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 "%s:\nexited with code %d (0x%02x)\n\n",
- $cmd,
+ $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;
}
close(W);
if ($out ne "") {
- $problems .= "$cmd2:\n$out\n\n";
+ $problems .= "$cmd2_joined:\n$out\n\n";
}
if ( $? ) {
$problems .= sprintf "%s:\nexited with code %d (0x%02x)\n\n",
- $cmd2,
+ $cmd2_joined,
$? >> 8,
$? & 0xff;
}
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);
}
}
}
} elsif (-f $local && -s $local > 0) {
- $problems .= "FATAL: $url ($md5) was not fetched correctly ($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 correctly ($cmd: $all_out): file fetched 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 correctly ($cmd: $all_out)\n";
+ $problems .= "FATAL: $url ($md5) was not fetched correctly ($cmd_joined: $all_out)\n";
}
# save space
unlink($local);
sub send_email()
{
- open(EMAIL, "| /usr/sbin/sendmail -t");
- #open(EMAIL, "| cat");
my $marker = "";
if ($problems ne "") {
$marker = "ERRORS: ";
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
--
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()
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()