6 $commits_list = "pld-cvs-commit\@lists.pld-linux.org";
8 $spool_dir = "./spool";
9 $copy_dir = "src"; # relative to ftp root
10 $no_url_dir = "./upload";
11 $df_server = "distfiles.pld-linux.org";
12 $df_scp = "plddist\@ep09.pld-linux.org:ftp";
13 $user_agent = "PLD/distfiles";
23 $req_login = "nobody";
27 # try lookup some file in spool, exit if it cannot be done
28 sub find_file_in_spool()
30 opendir(DIR, $spool_dir) || die "can't opendir $spool_dir: $!";
34 -f "$spool_dir/$f" or next;
35 $file = "$spool_dir/$f";
40 exit 0 if ($file eq "");
43 # read file from spool, and try unlink it. if cannot unlink -- exit
44 # sets $requester (email), $problems, @md5 (arrays of md5's)
45 # and @url (map from md5 to urls)
48 open(F, "< $file") || exit 0;
51 $requester =~ /^[a-zA-Z_0-9@.-]+$/
52 or die "$file: evil requester: $requester";
54 $requester =~ /^([^@]+)\@/ and $req_login = $1;
55 $req_login =~ /^[a-z0-9A-Z_.]+$/ or die "$file: evil requester $requester";
59 $force_reply++ if ($flags =~ /force-reply/);
67 if (/^([a-f0-9]{32})\s+((ftp|http|https|no-url|no-url-copy):\/\/([=\@\?a-z0-9A-Z:\+\~\.,\-\/_]|\%[0-9])+)\s*$/) {
69 $problems .= "$file: cannot fetch dir";
75 $problems .= "FILE: $file: corrupted";
80 unlink($file) || exit 0;
94 return "/by-md5/$1/$2/$md5/" . basename($url);
97 sub got_on_distfiles($$)
100 my $p = by_md5($md5, $url);
101 my $l = `lftp -c 'debug 0; open $df_server; quote size $p'`;
102 return $l =~ /^213 /;
107 my ($from, $to) = @_;
108 my $cmd = "scp -r -B -q $from $df_scp/$to";
109 open(E, "$cmd 2>&1 |") or die;
114 $oops .= "\nThe command has exited with a non-zero status."
116 $problems .= "scp problems: $cmd:\n$oops\n"
118 return ($oops ne "");
123 my ($md5, $url, $local_copy) = @_;
125 my $bn = basename($url);
127 if ($local_copy ne "$tmp_dir/$md5/$bn") {
128 if (system("mv -f \"$local_copy\" \"$tmp_dir/$md5/$bn\"")) {
129 $problems .= "FATAL: cannot move $local_copy to $tmp_dir\n";
132 $local_copy = "$tmp_dir/$md5/$bn";
135 if (open(D, "> $tmp_dir/$md5/$bn.desc")) {
136 print D "URL: $url\n";
137 print D "Login: $req_login\n";
138 print D "MD5: $md5\n";
139 print D 'Fetched-by: $Id$'."\n";
140 print D "Time: " . time . "\n";
143 $problems .= "ERROR: cannot write $bn.desc\n";
146 my $dir = by_md5($md5, $url);
147 $dir =~ s|/[^/]+/[^/]+$||;
148 if (copy_to_df("$tmp_dir/$md5/", $dir) == 0) {
151 "\t$md5 " . basename($url) . "\n" .
152 "\tSize: " . (-s $local_copy) . " bytes\n";
157 sub make_src_symlink($$)
159 my ($md5, $url) = @_;
161 return unless ($url =~ /^no-url/);
163 my $b = basename($url);
164 if (open(S, "> $tmp_dir/$b.link")) {
165 if ($url =~ /^no-url-copy/) {
166 print S (".." . by_md5($md5, $url));
171 copy_to_df("$tmp_dir/$b.link", "$copy_dir/$b.link");
173 $problems .= "ERROR: cannot write $tmp_dir/$b.link\n";
183 my @cmd = ("md5sum", $file);
185 run \@cmd, \$in, \$md5, \$err;
188 $problems .= "FATAL: " . $err . "\n";
192 $md5 =~ /^([a-f0-9]{32})/ and $md5 = $1;
196 sub handle_no_url($$)
198 my ($md5, $url) = @_;
200 unless ($url =~ m#://([^/]+)#) {
201 $problems .= "$url: corrupted! (no-url)";
205 my $file = "$no_url_dir/$req_login/$basename";
208 my $computed_md5 = md5($file);
209 if ($computed_md5 ne $md5) {
210 $problems .= "FATAL: $file md5 mismatch, needed $md5, got $computed_md5\n";
212 move_file($md5, $url, $file);
213 make_src_symlink($md5, $url);
216 $problems .= "FATAL: $file was not uploaded\n";
222 my ($md5, $url) = @_;
225 my $bn = basename($url);
226 my $local = "$tmp_dir/$md5/$bn";
227 my $cmd = "wget -nv --no-check-certificate --user-agent=$user_agent -O $local \"$url\"";
228 my $cmd2 = "wget -nv --no-check-certificate --user-agent=$user_agent --passive-ftp -O $local \"$url\"";
232 if (got_on_distfiles($md5, $url)) {
234 "ALREADY GOT: $url\n" .
235 "\t$md5 " . basename($url) . "\n";
236 make_src_symlink($md5, $url);
240 mkdir("$tmp_dir/$md5");
242 if ($url =~ /^no-url/) {
243 handle_no_url($md5, $url);
247 open(W, "$cmd 2>&1 |");
250 /URL:.*\s+\-\>\s+.*/ and next;
255 $problems .= "$cmd:\n$out\n\n";
257 if (-f $local && -s $local == 0 && $url =~ /^ftp:/) {
259 open(W, "$cmd2 2>&1 |");
261 $all_out .= "\n\t\t$_";
262 /URL:.*\s+\-\>\s+.*/ and next;
267 $problems .= "$cmd:\n$out\n\n";
270 if (-r $local && -s $local > 0) {
271 my $computed_md5 = md5($local);
272 if ($computed_md5 ne $md5) {
273 $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
275 my $testcmd = "file \"$local\" |";
277 if ($url =~ /^(http|https):/ && $local =~ /\.(tar\.(bz2|gz)|tgz|zip|jar|xpi)$/) {
278 open(T, $testcmd) or die;
282 if ($testres =~ /empty|(ASCII|HTML|SGML).*text/) {
284 $problems .= "FATAL: data returned from $url: $testres";
286 move_file($md5, $url, $local);
289 } elsif (-f $local && -s $local > 0) {
290 $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out): file is not readable\n";
292 $problems .= "FATAL: $url ($md5) was not fetched ($cmd: $all_out)\n";
300 $problems .= "\n\n" if ($problems ne "");
301 foreach $i (0..$#md5) {
302 fetch_file($md5[$i], $url[$i]);
308 open(EMAIL, "| /usr/sbin/sendmail -t");
309 #open(EMAIL, "| cat");
311 if ($problems ne "") {
312 $marker = "ERRORS: ";
315 $requester =~ /^(.*)\@/ and $req_login = $1;
317 splice(@files, 10, @files - 10, "...")
321 "From: $req_login <$requester>
324 Subject: DISTFILES: ${spec}: ${marker}@{files}
325 Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
326 X-distfiles-program: file-fetcher.pl
327 X-distfiles-version: " . '$Id$' . "
330 Files fetched: $fetched_count
335 Virtually Yours: distfiles.
342 my $id = `uuidgen 2>/dev/null`;
344 $id = rand if (!defined $id or $id eq "");
345 $tmp_dir = "./tmp/$id";
346 mkdir($tmp_dir) or die;
351 system("rm -rf $tmp_dir")
352 if ($tmp_dir ne "" && -d $tmp_dir);
357 find_file_in_spool();
361 send_email() unless (!$force_reply and $problems eq "" and $fetched_count == 0);