]>
Commit | Line | Data |
---|---|---|
7ebf9245 MM |
1 | #!/usr/bin/perl -w |
2 | # | |
3 | ||
482655f9 | 4 | $commits_list = "pld-cvs-commit\@pld-linux.org"; |
7ebf9245 | 5 | |
b5c674c5 MM |
6 | $spool_dir = "./spool"; |
7 | $ftp_dir = "./ftp"; | |
8 | $copy_dir = "src"; # relative to $ftp_dir | |
9 | $no_url_dir = "./plddfadd"; | |
7ebf9245 MM |
10 | |
11 | @md5 = (); | |
12 | %url = (); | |
13 | $problems = ""; | |
14 | $normal_out = ""; | |
15 | $requester = ""; | |
16 | $file = ""; | |
47f8fda7 MM |
17 | $fetched_count = 0; |
18 | $force_reply = 0; | |
44cd280f | 19 | @files = (); |
7ebf9245 MM |
20 | |
21 | # try lookup some file in spool, exit if it cannot be done | |
22 | sub find_file_in_spool() | |
23 | { | |
24 | opendir(DIR, $spool_dir) || die "can't opendir $spool_dir: $!"; | |
25 | while (1) { | |
26 | my $f = readdir(DIR); | |
27 | defined $f or last; | |
28 | -f "$spool_dir/$f" or next; | |
29 | $file = "$spool_dir/$f"; | |
30 | last; | |
31 | } | |
32 | closedir(DIR); | |
33 | ||
34 | exit 0 if ($file eq ""); | |
35 | } | |
36 | ||
37 | # read file from spool, and try unlink it. if cannot unlink -- exit | |
38 | # sets $requester (email), $problems, @md5 (arrays of md5's) | |
39 | # and %url (map from md5 to urls) | |
40 | sub read_spool_file() | |
41 | { | |
42 | open(F, "< $file") || exit 0; | |
43 | $requester = <F>; | |
44 | chomp $requester; | |
45 | $requester =~ /^[a-zA-Z_\-0-9\@\.]+$/ | |
46 | or die "$file: evil requester: $requester"; | |
47f8fda7 MM |
47 | my $flags = <F>; |
48 | $force_reply++ if ($flags =~ /force-reply/); | |
7ebf9245 MM |
49 | |
50 | while (<F>) { | |
51 | if (/^ERROR/) { | |
52 | s/^ERROR: //; | |
53 | $problems .= $_; | |
f2a640bf | 54 | next; |
7ebf9245 | 55 | } |
b5c674c5 | 56 | /^([a-f0-9]{32})\s+((ftp|http|no-url|no-url-copy):\/\/([a-z0-9A-Z:\+\~\.\-\/_]|\%[0-9])+)\s*$/ |
7ebf9245 MM |
57 | or die "$file: corrupted"; |
58 | push @md5, $1; | |
59 | $url{$1} = $2; | |
60 | /\/$/ and die "$file: cannot fetch dir"; | |
61 | } | |
62 | close(F); | |
63 | ||
64 | unlink($file) || exit 0; | |
65 | } | |
66 | ||
44cd280f MM |
67 | sub basename($) |
68 | { | |
69 | my $f = shift; | |
70 | $f =~ s|.*/||; | |
71 | return $f; | |
72 | } | |
73 | ||
6ce39ee7 | 74 | sub file_path($$) |
7ebf9245 MM |
75 | { |
76 | my ($md5, $url) = @_; | |
7ebf9245 | 77 | $md5 =~ /^(.)(.)/; |
44cd280f | 78 | return "$ftp_dir/by-md5/$1/$2/$md5/" . basename($url); |
6ce39ee7 MM |
79 | } |
80 | ||
47f8fda7 | 81 | sub install_dir |
6ce39ee7 MM |
82 | { |
83 | my $dir = shift; | |
84 | return if (-e $dir); | |
85 | $dir =~ /(.*)\/[^\/]+$/ and install_dir($1); | |
86 | mkdir($dir); | |
87 | } | |
88 | ||
b5c674c5 | 89 | sub move_file($$$) |
6ce39ee7 | 90 | { |
b5c674c5 | 91 | my ($md5, $url, $local_copy) = @_; |
6ce39ee7 MM |
92 | |
93 | my $path = file_path($md5, $url); | |
94 | ||
95 | $path =~ /(.*)\/[^\/]+$/ and install_dir($1); | |
96 | ||
b5c674c5 | 97 | if (system("mv -f \"$local_copy\" \"$path\"")) { |
7ebf9245 MM |
98 | $problems .= "FATAL: cannot mv file ($url)\n"; |
99 | } else { | |
032dd834 MM |
100 | if (open(D, "> $path.desc")) { |
101 | print D "URL: $url\n"; | |
102 | print D "MD5: $md5\n"; | |
2fe72b7b | 103 | print D 'Fetched-by: $Id$'."\n"; |
b5c674c5 | 104 | print D "Time: " . time . "\n"; |
032dd834 MM |
105 | close(D); |
106 | } else { | |
107 | $problems .= "ERROR: cannot write $path.desc\n"; | |
108 | } | |
f0760d64 MM |
109 | |
110 | # Forg logs | |
111 | $md5 =~ /^(..)/ and my $m2 = $1; | |
112 | $md5 =~ /^(.)(.)/; | |
113 | if (open(L, ">> $ENV{HOME}/.lists/lista_$m2")) { | |
44cd280f | 114 | print L "/home/ftp/pub/Linux/distfiles/by-md5/$1/$2/$md5/" . basename($url) . "\n"; |
f0760d64 MM |
115 | close(L); |
116 | } | |
117 | ||
44cd280f MM |
118 | $normal_out .= |
119 | "STORED: $url\n" . | |
120 | "\t$md5 " . basename($url) . "\n" . | |
121 | "\tSize: " . (-s $path) . " bytes\n"; | |
47f8fda7 | 122 | $fetched_count++; |
7ebf9245 MM |
123 | } |
124 | } | |
125 | ||
b5c674c5 MM |
126 | sub make_src_symlink($$) |
127 | { | |
128 | my ($md5, $url) = @_; | |
129 | my $path = file_path($md5, $url); | |
130 | $path =~ s/.*?by-md5/..\/by-md5/; | |
131 | $url =~ m|://([^/]+)| or die "corrupted! (no-url, copy)"; | |
132 | my $basename = $1; | |
133 | my $symlink = "$ftp_dir/$copy_dir/$basename"; | |
134 | $! = 0; | |
135 | my $old = readlink $symlink; | |
136 | if ($!) { | |
137 | if ($url =~ /^no-url-copy/) { | |
138 | symlink($path, $symlink); | |
139 | $force_reply++; | |
140 | $normal_out .= "Made symlink in src/ for $basename\n"; | |
141 | } | |
142 | } elsif ($url =~ /^no-url-copy/) { | |
143 | if ($old ne $path) { | |
144 | unlink($symlink); | |
145 | symlink($path, $symlink); | |
146 | $problems .= "WARNING: $symlink already existed with value $old, set to $path\n"; | |
147 | } else { | |
148 | $normal_out .= "Symlink in src/ for $basename already there\n"; | |
149 | } | |
150 | } else { | |
151 | unlink($symlink); | |
152 | $problems .= "WARNING: Removed symlink $symlink\n"; | |
153 | } | |
154 | } | |
155 | ||
156 | sub md5($) | |
157 | { | |
158 | my $file = shift; | |
159 | my $md5 = `md5sum "$file" 2>/dev/null`; | |
160 | $md5 =~ /^([a-f0-9]{32})/ and $md5 = $1; | |
161 | return $md5; | |
162 | } | |
163 | ||
164 | sub handle_no_url($$) | |
165 | { | |
166 | my ($md5, $url) = @_; | |
167 | ||
168 | $url =~ m|://([^/]+)| or die "corrupted! (no-url)"; | |
169 | my $basename = $1; | |
170 | my $file = "$no_url_dir/$basename"; | |
171 | ||
172 | if (-f $file) { | |
173 | my $computed_md5 = md5($file); | |
174 | if ($computed_md5 ne $md5) { | |
175 | $problems .= "FATAL: $file md5 mismatch, needed $md5, got $computed_md5\n"; | |
176 | } else { | |
177 | move_file($md5, $url, $file); | |
178 | make_src_symlink($md5, $url); | |
179 | } | |
180 | } else { | |
181 | $problems .= "FATAL: $file was not scp'ed\n"; | |
182 | } | |
183 | } | |
184 | ||
7ebf9245 MM |
185 | sub fetch_file($$) |
186 | { | |
187 | my ($md5, $url) = @_; | |
188 | my $out = ""; | |
189 | my $cmd = "wget -nv -O tmp/$md5 \"$url\""; | |
b5c674c5 | 190 | |
44cd280f MM |
191 | push @files, basename($url); |
192 | ||
6ce39ee7 MM |
193 | my $path = file_path($md5, $url); |
194 | if (-f $path) { | |
00eefa39 MM |
195 | $normal_out .= |
196 | "ALREADY GOT: $url\n" . | |
197 | "\t$md5 " . basename($url) . "\n" . | |
198 | "\tSize: " . (-s $path) . " bytes.\n"; | |
b5c674c5 | 199 | make_src_symlink($md5, $url); |
6ce39ee7 MM |
200 | return; |
201 | } | |
202 | ||
b5c674c5 MM |
203 | if ($url =~ /^no-url/) { |
204 | handle_no_url($md5, $url); | |
205 | return; | |
206 | } | |
207 | ||
7ebf9245 MM |
208 | open(W, "$cmd 2>&1 |"); |
209 | while (<W>) { | |
210 | /URL:.*\s+\-\>\s+.*/ and next; | |
211 | $out .= $_; | |
212 | } | |
213 | close(W); | |
214 | if ($out ne "") { | |
215 | $problems .= "$cmd:\n$out\n\n"; | |
216 | } | |
217 | if (-f "tmp/$md5" && -s "tmp/$md5" > 0) { | |
b5c674c5 | 218 | my $computed_md5 = md5("tmp/$md5"); |
7ebf9245 MM |
219 | if ($computed_md5 ne $md5) { |
220 | $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n"; | |
221 | } else { | |
b5c674c5 | 222 | move_file($md5, $url, "tmp/$md5"); |
7ebf9245 MM |
223 | } |
224 | } else { | |
225 | $problems .= "FATAL: $url ($md5) was not fetched\n"; | |
226 | } | |
ce5a46fa | 227 | unlink("tmp/$md5"); |
7ebf9245 MM |
228 | } |
229 | ||
230 | sub fetch_files() | |
231 | { | |
232 | $problems .= "\n\n" if ($problems ne ""); | |
233 | foreach $md5 (@md5) { | |
234 | fetch_file($md5, $url{$md5}); | |
235 | } | |
236 | } | |
237 | ||
238 | sub send_email() | |
239 | { | |
9a1e36f3 MM |
240 | open(EMAIL, "| /usr/sbin/sendmail -t"); |
241 | #open(EMAIL, "| cat"); | |
44cd280f | 242 | my $marker = ""; |
7ebf9245 | 243 | if ($problems ne "") { |
44cd280f | 244 | $marker = "ERRORS: "; |
7ebf9245 | 245 | } |
04550b88 MM |
246 | my $req_login; |
247 | $requester =~ /^(.*)\@/ and $req_login = $1; | |
44cd280f MM |
248 | |
249 | splice(@files, 10, @files - 10, "...") | |
250 | if (@files > 10); | |
251 | ||
e157986d | 252 | print EMAIL |
04550b88 | 253 | "From: $req_login <$requester> |
482655f9 MM |
254 | To: $commits_list |
255 | Cc: $requester | |
44cd280f | 256 | Subject: DISTFILES: ${marker}@{files} |
e157986d MM |
257 | Message-ID: <$$." . time . "\@distfiles.pld-linux.org> |
258 | X-distfiles-program: file-fetcher.pl | |
259 | X-distfiles-version: " . '$Id$' . " | |
7ebf9245 MM |
260 | |
261 | $problems | |
47f8fda7 MM |
262 | Files fetched: $fetched_count |
263 | ||
7ebf9245 | 264 | $normal_out |
e157986d MM |
265 | |
266 | -- | |
d8cd573c | 267 | Virtually Yours: distfiles. |
7ebf9245 MM |
268 | "; |
269 | close(EMAIL) or die; | |
270 | } | |
271 | ||
272 | find_file_in_spool(); | |
273 | read_spool_file(); | |
274 | fetch_files(); | |
47f8fda7 | 275 | send_email() unless (!$force_reply and $problems eq "" and $fetched_count == 0); |