4 $commits_list = "pld-cvs-commit\@pld-linux.org";
6 $spool_dir = "./spool";
7 $copy_dir = "src"; # relative to ftp root
8 $no_url_dir = "./upload";
9 $df_server = "distfiles.pld-linux.org";
10 $df_scp = "plddist\@$df_server:ftp";
20 $req_login = "nobody";
23 # try lookup some file in spool, exit if it cannot be done
24 sub find_file_in_spool()
26 opendir(DIR, $spool_dir) || die "can't opendir $spool_dir: $!";
30 -f "$spool_dir/$f" or next;
31 $file = "$spool_dir/$f";
36 exit 0 if ($file eq "");
39 # read file from spool, and try unlink it. if cannot unlink -- exit
40 # sets $requester (email), $problems, @md5 (arrays of md5's)
41 # and %url (map from md5 to urls)
44 open(F, "< $file") || exit 0;
47 $requester =~ /^[a-zA-Z_\-0-9\@\.]+$/
48 or die "$file: evil requester: $requester";
50 $requester =~ /^([^@]+)\@/ and $req_login = $1;
51 $req_login =~ /^[a-z0-9A-Z_]+$/ or die "$file: evil requester $requester";
53 $force_reply++ if ($flags =~ /force-reply/);
61 /^([a-f0-9]{32})\s+((ftp|http|no-url|no-url-copy):\/\/([a-z0-9A-Z:\+\~\.\-\/_]|\%[0-9])+)\s*$/
62 or die "$file: corrupted";
65 /\/$/ and die "$file: cannot fetch dir";
69 unlink($file) || exit 0;
83 return "/by-md5/$1/$2/$md5/" . basename($url);
86 sub got_on_distfiles($$)
89 my $p = by_md5($md5, $url);
90 my $l = `lftp -c 'debug 0; open $df_server; quote size $p'`;
97 my $cmd = "scp -r -B -q $from $df_scp/$to";
98 open(E, "$cmd 2>&1 |") or die;
104 $problems .= "scp problems: $cmd:\n$oops\n"
106 return ($oops ne "");
111 my ($md5, $url, $local_copy) = @_;
113 my $bn = basename($url);
115 if ($local_copy ne "$tmp_dir/$md5/$bn") {
116 if (system("mv -f \"$local_copy\" \"$tmp_dir/$md5/$bn\"")) {
117 $problems .= "FATAL: cannot move $local_copy to $tmp_dir\n";
120 $local_copy = "$tmp_dir/$md5/$bn";
123 if (open(D, "> $tmp_dir/$md5/$bn.desc")) {
124 print D "URL: $url\n";
125 print D "Login: $req_login\n";
126 print D "MD5: $md5\n";
127 print D 'Fetched-by: $Id$'."\n";
128 print D "Time: " . time . "\n";
131 $problems .= "ERROR: cannot write $bn.desc\n";
134 my $dir = by_md5($md5, $url);
135 $dir =~ s|/[^/]+/[^/]+$||;
136 if (copy_to_df("$tmp_dir/$md5/", $dir) == 0) {
139 "\t$md5 " . basename($url) . "\n" .
140 "\tSize: " . (-s $local_copy) . " bytes\n";
145 sub make_src_symlink($$)
147 my ($md5, $url) = @_;
149 return unless ($url =~ /^no-url/);
151 my $b = basename($url);
152 if (open(S, "> $tmp_dir/$b.link")) {
153 if ($url =~ /^no-url-copy/) {
154 print S (".." . by_md5($md5, $url));
159 copy_to_df("$tmp_dir/$b.link", "$copy_dir/$b.link");
161 $problems .= "ERROR: cannot write $tmp_dir/$b.link\n";
168 my $md5 = `md5sum "$file" 2>/dev/null`;
169 $md5 =~ /^([a-f0-9]{32})/ and $md5 = $1;
173 sub handle_no_url($$)
175 my ($md5, $url) = @_;
177 $url =~ m|://([^/]+)| or die "corrupted! (no-url)";
179 my $file = "$no_url_dir/$req_login/$basename";
182 my $computed_md5 = md5($file);
183 if ($computed_md5 ne $md5) {
184 $problems .= "FATAL: $file md5 mismatch, needed $md5, got $computed_md5\n";
186 move_file($md5, $url, $file);
187 make_src_symlink($md5, $url);
190 $problems .= "FATAL: $file was not uploaded\n";
196 my ($md5, $url) = @_;
198 my $bn = basename($url);
199 my $local = "$tmp_dir/$md5/$bn";
200 my $cmd = "wget -nv -O $local \"$url\"";
204 if (got_on_distfiles($md5, $url)) {
206 "ALREADY GOT: $url\n" .
207 "\t$md5 " . basename($url) . "\n";
208 make_src_symlink($md5, $url);
212 mkdir("$tmp_dir/$md5") or die;
214 if ($url =~ /^no-url/) {
215 handle_no_url($md5, $url);
219 open(W, "$cmd 2>&1 |");
221 /URL:.*\s+\-\>\s+.*/ and next;
226 $problems .= "$cmd:\n$out\n\n";
228 if (-f $local && -s $local > 0) {
229 my $computed_md5 = md5($local);
230 if ($computed_md5 ne $md5) {
231 $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
233 move_file($md5, $url, $local);
236 $problems .= "FATAL: $url ($md5) was not fetched\n";
244 $problems .= "\n\n" if ($problems ne "");
245 foreach $md5 (@md5) {
246 fetch_file($md5, $url{$md5});
252 open(EMAIL, "| /usr/sbin/sendmail -t");
253 #open(EMAIL, "| cat");
255 if ($problems ne "") {
256 $marker = "ERRORS: ";
259 $requester =~ /^(.*)\@/ and $req_login = $1;
261 splice(@files, 10, @files - 10, "...")
265 "From: $req_login <$requester>
268 Subject: DISTFILES: ${marker}@{files}
269 Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
270 X-distfiles-program: file-fetcher.pl
271 X-distfiles-version: " . '$Id$' . "
274 Files fetched: $fetched_count
279 Virtually Yours: distfiles.
286 my $id = `uuidgen 2>/dev/null`;
288 $id = rand if (!defined $id or $id eq "");
289 $tmp_dir = "./tmp/$id";
290 mkdir($tmp_dir) or die;
295 system("rm -rf $tmp_dir")
296 if ($tmp_dir ne "" && -d $tmp_dir);
301 find_file_in_spool();
305 send_email() unless (!$force_reply and $problems eq "" and $fetched_count == 0);