Commit | Line | Data |
---|---|---|
7b8ff279 MW |
1 | /* -*-c-*- |
2 | * | |
3 | * Dump custom Lisp images for faster script execution | |
4 | * | |
5 | * (c) 2020 Mark Wooding | |
6 | */ | |
7 | ||
8 | /*----- Licensing notice --------------------------------------------------* | |
9 | * | |
10 | * This file is part of Runlisp, a tool for invoking Common Lisp scripts. | |
11 | * | |
12 | * Runlisp is free software: you can redistribute it and/or modify it | |
13 | * under the terms of the GNU General Public License as published by the | |
14 | * Free Software Foundation; either version 3 of the License, or (at your | |
15 | * option) any later version. | |
16 | * | |
17 | * Runlisp is distributed in the hope that it will be useful, but WITHOUT | |
18 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
19 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
20 | * for more details. | |
21 | * | |
22 | * You should have received a copy of the GNU General Public License | |
23 | * along with Runlisp. If not, see <https://www.gnu.org/licenses/>. | |
24 | */ | |
25 | ||
6c39ec6d | 26 | /*----- Header files ------------------------------------------------------*/ |
7b8ff279 MW |
27 | |
28 | #include "config.h" | |
29 | ||
30 | #include <assert.h> | |
31 | #include <ctype.h> | |
32 | #include <errno.h> | |
33 | #include <signal.h> | |
34 | #include <stdio.h> | |
35 | #include <stdlib.h> | |
36 | #include <string.h> | |
37 | #include <time.h> | |
38 | ||
39 | #include <dirent.h> | |
40 | #include <fcntl.h> | |
41 | #include <unistd.h> | |
42 | ||
43 | #include <sys/select.h> | |
44 | #include <sys/stat.h> | |
45 | #include <sys/time.h> | |
46 | #include <sys/uio.h> | |
47 | #include <sys/wait.h> | |
48 | ||
49 | #include "common.h" | |
50 | #include "lib.h" | |
51 | #include "mdwopt.h" | |
6c39ec6d | 52 | #include "sha256.h" |
7b8ff279 MW |
53 | |
54 | /*----- Static data -------------------------------------------------------*/ | |
55 | ||
8996f767 MW |
56 | /* The state required to break an output stream from a subprocess into lines |
57 | * so we can prefix them appropriately. Once our process starts, the `buf' | |
58 | * points to a buffer of `MAXLINE' bytes. This is arranged as a circular | |
59 | * buffer, containing `len' bytes starting at offset `off', and wrapping | |
60 | * around to the start of the buffer if it runs off the end. | |
61 | * | |
62 | * The descriptor `fd' is reset to -1 after it's seen end-of-file. | |
63 | */ | |
7b8ff279 | 64 | struct linebuf { |
8996f767 MW |
65 | int fd; /* our file descriptor (or -1) */ |
66 | char *buf; /* line buffer, or null */ | |
67 | unsigned off, len; /* offset */ | |
7b8ff279 | 68 | }; |
8996f767 | 69 | #define MAXLINE 16384u /* maximum acceptable line length */ |
7b8ff279 | 70 | |
8996f767 | 71 | /* Job-state constants. */ |
7b8ff279 | 72 | enum { |
6c39ec6d MW |
73 | JST_INTERN, /* not that kind of job */ |
74 | JST_VERSION, /* hashing the Lisp version number */ | |
75 | JST_DUMP, /* dumping the custom image */ | |
7b8ff279 MW |
76 | JST_NSTATE |
77 | }; | |
78 | ||
8996f767 | 79 | /* The state associated with an image-dumping job. */ |
7b8ff279 | 80 | struct job { |
8996f767 MW |
81 | struct treap_node _node; /* treap intrusion */ |
82 | struct job *next; /* next job in whichever list */ | |
8996f767 | 83 | unsigned st; /* job state (`JST_...') */ |
6c39ec6d MW |
84 | struct config_section *sect; /* the system-definition section */ |
85 | struct config_var *dumpvar; /* the `dump-image' variable */ | |
86 | struct argv av_version, av_dump; /* argument vectors to execute */ | |
87 | char *imgnew, *imghash, *imgnewlink, *imglink; /* link and final outputs */ | |
88 | char *oldimg; /* old image name */ | |
8996f767 MW |
89 | FILE *log; /* log output file (`stdout'?) */ |
90 | pid_t kid; /* process id of child (or -1) */ | |
91 | int exit; /* exit status from child */ | |
6c39ec6d | 92 | struct sha256_state h; /* hash context for version */ |
8996f767 | 93 | struct linebuf out, err; /* line buffers for stdout, stderr */ |
7b8ff279 MW |
94 | }; |
95 | #define JOB_NAME(job) TREAP_NODE_KEY(job) | |
96 | #define JOB_NAMELEN(job) TREAP_NODE_KEYLEN(job) | |
97 | ||
10427eb2 MW |
98 | static struct treap jobs = TREAP_INIT, /* Lisp systems seen so far */ |
99 | good = TREAP_INIT; /* files ok to be in image dir */ | |
6c39ec6d MW |
100 | static struct job /* lists of jobs */ |
101 | *job_ready, **job_ready_tail = &job_ready, /* queue of jobs to start */ | |
102 | *job_delete, **job_delete_tail = &job_delete, /* queue of delete jobs */ | |
103 | *job_run; /* list of active jobs */ | |
8996f767 MW |
104 | static unsigned nrun, maxrun = 1; /* running and maximum job counts */ |
105 | static int rc = 0; /* code that we should return */ | |
106 | static int nullfd; /* file descriptor for `/dev/null' */ | |
107 | static const char *tmpdir; /* temporary directory path */ | |
7b8ff279 | 108 | |
8996f767 MW |
109 | static int sig_pipe[2] = { -1, -1 }; /* pipe for reporting signals */ |
110 | static sigset_t caught, pending; /* signals we catch; have caught */ | |
111 | static int sigloss = -1; /* signal that caused us to lose */ | |
7b8ff279 | 112 | |
8996f767 MW |
113 | static unsigned flags = 0; /* flags for the application */ |
114 | #define AF_BOGUS 0x0001u /* invalid comand-line syntax */ | |
115 | #define AF_SETCONF 0x0002u /* explicit configuration */ | |
116 | #define AF_DRYRUN 0x0004u /* don't actually do it */ | |
117 | #define AF_ALL 0x0008u /* dump all known Lisps */ | |
118 | #define AF_FORCE 0x0010u /* dump even if images exist */ | |
119 | #define AF_CHECKINST 0x0020u /* check Lisp exists before dump */ | |
10427eb2 MW |
120 | #define AF_REMOVE 0x0040u /* remove selected Lisp images */ |
121 | #define AF_CLEAN 0x0080u /* remove other Lisp images */ | |
122 | #define AF_JUNK 0x0100u /* remove unrecognized files */ | |
7b8ff279 | 123 | |
8996f767 | 124 | /*----- Miscellany --------------------------------------------------------*/ |
7b8ff279 | 125 | |
8996f767 | 126 | /* Report a (printf(3)-style) message MSG, and remember to fail later. */ |
7b8ff279 | 127 | static PRINTF_LIKE(1, 2) void bad(const char *msg, ...) |
8996f767 | 128 | { va_list ap; va_start(ap, msg); vmoan(msg, ap); va_end(ap); rc = 127; } |
7b8ff279 | 129 | |
6c39ec6d MW |
130 | /* Answer whether a string consists entirely of hex digits. */ |
131 | static int hex_digits_p(const char *p, size_t sz) | |
132 | { | |
133 | const char *l; | |
134 | ||
135 | for (l = p + sz; p < l; p++) if (!ISXDIGIT(*p)) return (0); | |
136 | return (1); | |
137 | } | |
138 | ||
8996f767 | 139 | /*----- File utilities ----------------------------------------------------*/ |
7b8ff279 | 140 | |
8996f767 MW |
141 | /* Main recursive subroutine for `recursive_delete'. |
142 | * | |
143 | * The string DD currently contains the pathname of a directory, without a | |
144 | * trailing `/' (though there is /space/ for a terminating zero or whatever). | |
145 | * Recursively delete all of the files and directories within it. Appending | |
146 | * further text to DD is OK, but clobbering the characters which are there | |
147 | * already isn't allowed. | |
148 | */ | |
7b8ff279 MW |
149 | static void recursive_delete_(struct dstr *dd) |
150 | { | |
7b8ff279 MW |
151 | DIR *dir; |
152 | struct dirent *d; | |
8996f767 | 153 | size_t n = dd->len; |
7b8ff279 | 154 | |
8996f767 MW |
155 | /* Open the directory. */ |
156 | dd->p[n] = 0; dir = opendir(dd->p); | |
7b8ff279 MW |
157 | if (!dir) |
158 | lose("failed to open directory `%s' for cleanup: %s", | |
159 | dd->p, strerror(errno)); | |
160 | ||
8996f767 MW |
161 | /* We'll need to build pathnames for the files inside the directory, so add |
162 | * the separating `/' character. Remember the length of this prefix | |
163 | * because this is the point we'll be rewinding to for each filename we | |
164 | * find. | |
165 | */ | |
7b8ff279 | 166 | dd->p[n++] = '/'; |
8996f767 MW |
167 | |
168 | /* Now go through each file in turn. */ | |
7b8ff279 | 169 | for (;;) { |
8996f767 MW |
170 | |
171 | /* Get a filename. If we've run out then we're done. Skip the special | |
172 | * `.' and `..' entries. | |
173 | */ | |
7b8ff279 MW |
174 | d = readdir(dir); if (!d) break; |
175 | if (d->d_name[0] == '.' && (!d->d_name[1] || | |
176 | (d->d_name[1] == '.' && !d->d_name[2]))) | |
177 | continue; | |
8996f767 MW |
178 | |
179 | /* Rewind the string offset and append the new filename. */ | |
7b8ff279 | 180 | dd->len = n; dstr_puts(dd, d->d_name); |
8996f767 MW |
181 | |
182 | /* Try to delete it the usual way. If it was actually a directory then | |
183 | * recursively delete it instead. (We could lstat(2) it first, but this | |
184 | * should be at least as quick to identify a directory, and it'll save a | |
185 | * lstat(2) call in the (common) case that it's not a directory. | |
186 | */ | |
7b8ff279 MW |
187 | if (!unlink(dd->p)); |
188 | else if (errno == EISDIR) recursive_delete_(dd); | |
189 | else lose("failed to delete file `%s': %s", dd->p, strerror(errno)); | |
190 | } | |
8996f767 MW |
191 | |
192 | /* We're done. Try to delete the directory. (It's possible that there was | |
193 | * some problem with enumerating the directory, but we'll ignore that: if | |
194 | * it matters then the directory won't be empty and the rmdir(2) will | |
195 | * fail.) | |
196 | */ | |
7b8ff279 MW |
197 | closedir(dir); |
198 | dd->p[--n] = 0; | |
199 | if (rmdir(dd->p)) | |
200 | lose("failed to delete directory `%s': %s", dd->p, strerror(errno)); | |
201 | } | |
202 | ||
8996f767 | 203 | /* Recursively delete the thing named PATH. */ |
7b8ff279 MW |
204 | static void recursive_delete(const char *path) |
205 | { | |
206 | struct dstr d = DSTR_INIT; | |
207 | dstr_puts(&d, path); recursive_delete_(&d); dstr_release(&d); | |
208 | } | |
209 | ||
8996f767 MW |
210 | /* Configure a file descriptor FD. |
211 | * | |
212 | * Set its nonblocking state to NONBLOCK and close-on-exec state to CLOEXEC. | |
213 | * In both cases, -1 means to leave it alone, zero means to turn it off, and | |
214 | * any other nonzero value means to turn it on. | |
215 | */ | |
7b8ff279 MW |
216 | static int configure_fd(const char *what, int fd, int nonblock, int cloexec) |
217 | { | |
218 | int fl, nfl; | |
219 | ||
220 | if (nonblock != -1) { | |
221 | fl = fcntl(fd, F_GETFL); if (fl < 0) goto fail; | |
222 | if (nonblock) nfl = fl | O_NONBLOCK; | |
223 | else nfl = fl&~O_NONBLOCK; | |
224 | if (fl != nfl && fcntl(fd, F_SETFL, nfl)) goto fail; | |
225 | } | |
226 | ||
227 | if (cloexec != -1) { | |
228 | fl = fcntl(fd, F_GETFD); if (fl < 0) goto fail; | |
229 | if (cloexec) nfl = fl | FD_CLOEXEC; | |
230 | else nfl = fl&~FD_CLOEXEC; | |
231 | if (fl != nfl && fcntl(fd, F_SETFD, nfl)) goto fail; | |
232 | } | |
233 | ||
234 | return (0); | |
235 | ||
236 | fail: | |
237 | bad("failed to configure %s descriptor: %s", what, strerror(errno)); | |
238 | return (-1); | |
239 | } | |
240 | ||
8996f767 MW |
241 | /* Create a temporary directory and remember where we put it. */ |
242 | static void set_tmpdir(void) | |
243 | { | |
244 | struct dstr d = DSTR_INIT; | |
245 | size_t n; | |
246 | unsigned i; | |
247 | ||
248 | /* Start building the path name. Remember the length: we'll rewind to | |
249 | * here and try again if our first attempt doesn't work. | |
250 | */ | |
251 | dstr_putf(&d, "%s/runlisp.%d.", my_getenv("TMPDIR", "/tmp"), getpid()); | |
252 | i = 0; n = d.len; | |
253 | ||
254 | /* Keep trying until it works. */ | |
255 | for (;;) { | |
256 | ||
257 | /* Build a complete name. */ | |
258 | d.len = n; dstr_putf(&d, "%d", rand()); | |
259 | ||
260 | /* Try to create the directory. If it worked, we're done. If it failed | |
261 | * with `EEXIST' then we'll try again for a while, but give up it it | |
262 | * doesn't look like we're making any progress. If it failed for some | |
263 | * other reason then there's probably not much hope so give up. | |
264 | */ | |
265 | if (!mkdir(d.p, 0700)) break; | |
266 | else if (errno != EEXIST) | |
267 | lose("failed to create temporary directory `%s': %s", | |
268 | d.p, strerror(errno)); | |
269 | else if (++i >= 32) { | |
270 | d.len = n; dstr_puts(&d, "???"); | |
271 | lose("failed to create temporary directory `%s': too many attempts", | |
272 | d.p); | |
273 | } | |
274 | } | |
275 | ||
276 | /* Remember the directory name. */ | |
277 | tmpdir = xstrndup(d.p, d.len); dstr_release(&d); | |
278 | } | |
279 | ||
280 | /*----- Signal handling ---------------------------------------------------*/ | |
281 | ||
282 | /* Forward reference into job management. */ | |
283 | static void reap_children(void); | |
284 | ||
285 | /* Clean things up on exit. | |
286 | * | |
287 | * Currently this just means to delete the temporary directory if we've made | |
288 | * one. | |
289 | */ | |
290 | static void cleanup(void) | |
291 | { if (tmpdir) { recursive_delete(tmpdir); tmpdir = 0; } } | |
292 | ||
293 | /* Check to see whether any signals have arrived, and do the sensible thing | |
294 | * with them. | |
295 | */ | |
296 | static void check_signals(void) | |
297 | { | |
298 | sigset_t old, pend; | |
299 | char buf[32]; | |
300 | ssize_t n; | |
301 | ||
302 | /* Ensure exclusive access to the signal-handling machinery, drain the | |
303 | * signal pipe, and take a copy of the set of caught signals. | |
304 | */ | |
305 | sigprocmask(SIG_BLOCK, &caught, &old); | |
306 | pend = pending; sigemptyset(&pending); | |
307 | for (;;) { | |
308 | n = read(sig_pipe[0], buf, sizeof(buf)); | |
309 | if (!n) lose("(internal) signal pipe closed!"); | |
310 | if (n < 0) break; | |
311 | } | |
312 | if (errno != EAGAIN && errno != EWOULDBLOCK) | |
313 | lose("failed to read signal pipe: %s", strerror(errno)); | |
314 | sigprocmask(SIG_SETMASK, &old, 0); | |
315 | ||
316 | /* Check for each signal of interest to us. | |
317 | * | |
318 | * Interrupty signals just set `sigloss' -- the `run_jobs' loop will know | |
319 | * to unravel everything if this happens. If `SIGCHLD' happened, then | |
320 | * check on job process status. | |
321 | */ | |
322 | if (sigismember(&pend, SIGINT)) sigloss = SIGINT; | |
323 | else if (sigismember(&pend, SIGHUP)) sigloss = SIGHUP; | |
324 | else if (sigismember(&pend, SIGTERM)) sigloss = SIGTERM; | |
325 | if (sigismember(&pend, SIGCHLD)) reap_children(); | |
326 | } | |
327 | ||
328 | /* The actual signal handler. | |
329 | * | |
330 | * Set the appropriate signal bit in `pending', and a byte (of any value) | |
331 | * down the signal pipe to wake up the select(2) loop. | |
332 | */ | |
7b8ff279 MW |
333 | static void handle_signal(int sig) |
334 | { | |
335 | sigset_t old; | |
336 | char x = '!'; | |
337 | ||
8996f767 | 338 | /* Ensure exclusive access while we fiddle with the `caught' set. */ |
7b8ff279 MW |
339 | sigprocmask(SIG_BLOCK, &caught, &old); |
340 | sigaddset(&pending, sig); | |
341 | sigprocmask(SIG_SETMASK, &old, 0); | |
342 | ||
8996f767 MW |
343 | /* Wake up the select(2) loop. If this fails, there's not a lot we can do |
344 | * about it. | |
345 | */ | |
7b8ff279 MW |
346 | DISCARD(write(sig_pipe[1], &x, 1)); |
347 | } | |
348 | ||
8996f767 MW |
349 | /* Install our signal handler to catch SIG. |
350 | * | |
351 | * If `SIGF_IGNOK' is set in F then don't trap the signal if it's currently | |
352 | * ignored. (This is used for signals like `SIGINT', which usually should | |
353 | * interrupt us; but if the caller wants us to ignore them, we should do as | |
354 | * it wants.) | |
355 | * | |
356 | * WHAT describes the signal, for use in diagnostic messages. | |
357 | */ | |
358 | #define SIGF_IGNOK 1u | |
359 | static void set_signal_handler(const char *what, int sig, unsigned f) | |
360 | { | |
361 | struct sigaction sa, sa_old; | |
362 | ||
363 | sigaddset(&caught, sig); | |
364 | ||
365 | if (f&SIGF_IGNOK) { | |
366 | if (sigaction(sig, 0, &sa_old)) goto fail; | |
367 | if (sa_old.sa_handler == SIG_IGN) return; | |
368 | } | |
369 | ||
370 | sa.sa_handler = handle_signal; | |
371 | sigemptyset(&sa.sa_mask); | |
372 | sa.sa_flags = SA_NOCLDSTOP; | |
373 | if (sigaction(sig, &sa, 0)) goto fail; | |
374 | ||
375 | return; | |
376 | ||
377 | fail: | |
378 | lose("failed to set %s signal handler: %s", what, strerror(errno)); | |
379 | } | |
380 | ||
381 | /*----- Line buffering ----------------------------------------------------*/ | |
382 | ||
383 | /* Find the next newline in the line buffer BUF. | |
384 | * | |
385 | * The search starts at `BUF->off', and potentially covers the entire buffer | |
386 | * contents. Set *LINESZ_OUT to the length of the line, in bytes. (Callers | |
387 | * must beware that the text of the line may wrap around the ends of the | |
388 | * buffer.) Return zero if we found a newline, or nonzero if the search | |
389 | * failed. | |
390 | */ | |
391 | static int find_newline(struct linebuf *buf, size_t *linesz_out) | |
392 | { | |
393 | char *nl; | |
394 | ||
395 | if (buf->off + buf->len <= MAXLINE) { | |
396 | /* The buffer contents is in one piece. Just search it. */ | |
397 | ||
398 | nl = memchr(buf->buf + buf->off, '\n', buf->len); | |
399 | if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); } | |
400 | ||
401 | } else { | |
402 | /* The buffer contents is in two pieces. We must search both of them. */ | |
403 | ||
404 | nl = memchr(buf->buf + buf->off, '\n', MAXLINE - buf->off); | |
405 | if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); } | |
406 | nl = memchr(buf->buf, '\n', buf->len - (MAXLINE - buf->off)); | |
407 | if (nl) | |
408 | { *linesz_out = (nl - buf->buf) + (MAXLINE - buf->off); return (0); } | |
409 | } | |
410 | ||
411 | return (-1); | |
412 | } | |
413 | ||
414 | /* Write a completed line out to the JOB's log file. | |
415 | * | |
416 | * The line starts at BUF->off, and continues for N bytes, not including the | |
417 | * newline (which, in fact, might not exist at all). Precede the actual text | |
418 | * of the line with the JOB's name, and the MARKER character, and follow it | |
419 | * with the TAIL text (which should include an actual newline character). | |
420 | */ | |
421 | static void write_line(struct job *job, struct linebuf *buf, | |
422 | size_t n, char marker, const char *tail) | |
423 | { | |
424 | fprintf(job->log, "%-13s %c ", JOB_NAME(job), marker); | |
425 | if (buf->off + n <= MAXLINE) | |
426 | fwrite(buf->buf + buf->off, 1, n, job->log); | |
427 | else { | |
428 | fwrite(buf->buf + buf->off, 1, MAXLINE - buf->off, job->log); | |
429 | fwrite(buf->buf, 1, n - (MAXLINE - buf->off), job->log); | |
430 | } | |
431 | fputs(tail, job->log); | |
432 | } | |
433 | ||
6c39ec6d MW |
434 | /* Hash N bytes freshly added to the buffer BUF. */ |
435 | static void hash_input(struct linebuf *buf, size_t n, struct sha256_state *h) | |
436 | { | |
437 | size_t start = (buf->off + buf->len)%MAXLINE; | |
438 | ||
439 | if (start + n <= MAXLINE) | |
440 | sha256_hash(h, buf->buf + start, n); | |
441 | else { | |
442 | sha256_hash(h, buf->buf + start, MAXLINE - start); | |
443 | sha256_hash(h, buf->buf, n - (MAXLINE - start)); | |
444 | } | |
445 | } | |
446 | ||
8996f767 MW |
447 | /* Collect output lines from JOB's process and write them to the log. |
448 | * | |
449 | * Read data from BUF's file descriptor. Output complete (or overlong) lines | |
450 | * usng `write_line'. On end-of-file, output any final incomplete line in | |
451 | * the same way, close the descriptor, and set it to -1. | |
6c39ec6d MW |
452 | * |
453 | * As a rather unpleasant quirk, if the hash-state pointer H is not null, | |
454 | * then also feed all the data received into it. | |
8996f767 | 455 | */ |
6c39ec6d MW |
456 | static void prefix_lines(struct job *job, struct linebuf *buf, char marker, |
457 | struct sha256_state *h) | |
8996f767 MW |
458 | { |
459 | struct iovec iov[2]; int niov; | |
460 | ssize_t n; | |
461 | size_t linesz; | |
462 | ||
463 | /* Read data into the buffer. This fancy dance with readv(2) is probably | |
464 | * overkill. | |
465 | * | |
466 | * We can't have BUF->len = MAXLINE because we'd have flushed out a | |
467 | * maximum-length buffer as an incomplete line last time. | |
468 | */ | |
469 | assert(buf->len < MAXLINE); | |
470 | if (!buf->off) { | |
471 | iov[0].iov_base = buf->buf + buf->len; | |
472 | iov[0].iov_len = MAXLINE - buf->len; | |
473 | niov = 1; | |
474 | } else if (buf->off + buf->len >= MAXLINE) { | |
475 | iov[0].iov_base = buf->buf + buf->off + buf->len - MAXLINE; | |
476 | iov[0].iov_len = MAXLINE - buf->len; | |
477 | niov = 1; | |
478 | } else { | |
479 | iov[0].iov_base = buf->buf + buf->off + buf->len; | |
480 | iov[0].iov_len = MAXLINE - (buf->off + buf->len); | |
481 | iov[1].iov_base = buf->buf; | |
482 | iov[1].iov_len = buf->off; | |
483 | niov = 1; | |
484 | } | |
485 | n = readv(buf->fd, iov, niov); | |
486 | ||
487 | if (n < 0) { | |
6c39ec6d MW |
488 | /* An error occurred. If there's no data to read after all then just |
489 | * move on. Otherwise we have a problem. | |
8996f767 | 490 | */ |
6c39ec6d | 491 | |
8996f767 MW |
492 | if (errno == EAGAIN || errno == EWOULDBLOCK) return; |
493 | lose("failed to read job `%s' output stream: %s", | |
494 | JOB_NAME(job), strerror(errno)); | |
6c39ec6d | 495 | } else if (!n) { |
8996f767 MW |
496 | /* We've hit end-of-file. Close the stream, and write out any |
497 | * unterminated partial line. | |
498 | */ | |
6c39ec6d | 499 | |
8996f767 MW |
500 | close(buf->fd); buf->fd = -1; |
501 | if (buf->len) | |
502 | write_line(job, buf, buf->len, marker, " [missing final newline]\n"); | |
6c39ec6d MW |
503 | } else { |
504 | /* We read some fresh data. Output any new complete lines. */ | |
505 | ||
506 | /* If we're supposed to hash data as it comes in then we should do that | |
507 | * now. | |
508 | */ | |
509 | if (h) hash_input(buf, n, h); | |
510 | ||
511 | /* Include the new material in the buffer length, and write out any | |
512 | * complete lines we find. | |
513 | */ | |
514 | buf->len += n; | |
515 | while (!find_newline(buf, &linesz)) { | |
516 | write_line(job, buf, linesz, marker, "\n"); | |
517 | buf->len -= linesz + 1; | |
518 | buf->off += linesz + 1; if (buf->off >= MAXLINE) buf->off -= MAXLINE; | |
519 | } | |
520 | ||
521 | if (!buf->len) | |
522 | /* If there's nothing left then we might as well reset the buffer | |
523 | * offset to the start of the buffer. | |
524 | */ | |
525 | buf->off = 0; | |
526 | else if (buf->len == MAXLINE) { | |
527 | /* We've filled the buffer with stuff that's not a whole line. Flush | |
528 | * it out anyway. | |
529 | */ | |
530 | write_line(job, buf, MAXLINE, marker, " [...]\n"); | |
531 | buf->off = buf->len = 0; | |
532 | } | |
8996f767 MW |
533 | } |
534 | } | |
535 | ||
536 | /*----- Job management ----------------------------------------------------*/ | |
537 | ||
6c39ec6d MW |
538 | /* Record the SZ-byte leafname at P as being legitimate, so that it doesn't |
539 | * get junked. | |
540 | */ | |
541 | static void notice_filename(const char *p, size_t sz) | |
542 | { | |
543 | struct treap_node *node; | |
544 | struct treap_path path; | |
545 | ||
546 | node = treap_probe(&good, p, sz, &path); | |
547 | if (!node) { | |
548 | node = xmalloc(sizeof(*node)); | |
549 | treap_insert(&good, &path, node, p, sz); | |
75a6ea60 | 550 | if (verbose >= 3) moan("noticed non-junk file `%.*s'", (int)sz, p); |
6c39ec6d MW |
551 | } |
552 | } | |
553 | ||
554 | /* There are basically two kinds of jobs. | |
555 | * | |
556 | * An `internal' job -- state `JST_INTERN' -- can be handled entirely within | |
557 | * this process. Internal jobs have trivial lifecycles: they're created, put | |
558 | * on a queue, executed, and thrown away. Jobs are executed when some code | |
559 | * decides to walk the appropriate queue and do the work. As a result, they | |
560 | * don't need to have distinctive states: `JST_INTERN' only exists to | |
561 | * distinguish internal jobs from active ones if they somehow manage to end | |
562 | * up in the external-job machinery. | |
563 | * | |
564 | * External jobs all work in basically the same way: we fork and exec a | |
565 | * sequence of subprocess to do the work. The majority of handling external | |
566 | * jobs is in the care and feeding of these subprocesses, so they end up on | |
567 | * various lists primarily concerned with the state of the subprocesses, and | |
568 | * the progress of the job through its sequence of subprocesses is recorded | |
569 | * in the job's `st' field. | |
570 | * | |
571 | * External jobs have a comparatively complicated lifecycle. | |
572 | * | |
573 | * * Initially, the job is on the `ready' queue by `add_job'. It has no | |
574 | * child process or log file. | |
575 | * | |
576 | * * At some point, `start_jobs' decides to start this job up: a log file | |
577 | * is created (if the job doesn't have one already), a child process is | |
578 | * forked, and pipes are set up to capture the child's output. It gets | |
579 | * moved to the `run' list (which is not maintained in any particular | |
580 | * order). Jobs on the `run' list participate in the main select(2) | |
581 | * loop. | |
582 | * | |
583 | * * When the job's child process dies and the pipes capturing its output | |
584 | * streams finally dry up, the job is considered finished. What happens | |
585 | * next depends on its state: either it gets updated somehow, and pushed | |
586 | * back onto the end of the `ready' queue so that another child can be | |
587 | * started, or the job is finished and dies. | |
588 | * | |
589 | * The counter `nrun' counts the number of actually running jobs, i.e., those | |
590 | * with living child processes. This doesn't simply count the number of jobs | |
591 | * on the `run' list: remember that the latter also contains jobs whose child | |
592 | * has died, but whose output has not yet been collected. | |
593 | */ | |
594 | ||
10427eb2 | 595 | /* Consider a Lisp system description and maybe add a job to the right queue. |
8996f767 | 596 | * |
10427eb2 MW |
597 | * The Lisp system is described by the configuration section SECT. Most of |
598 | * the function is spent on inspecting this section for suitability and | |
599 | * deciding what to do about it. | |
8996f767 | 600 | * |
10427eb2 MW |
601 | * The precise behaviour depends on F, which should be the bitwise-OR of a |
602 | * `JQ_...' constant and zero or more flags, as follows. | |
603 | * | |
604 | * * The bits covered by `JMASK_QUEUE' identify which queue the job should | |
605 | * be added to if the section defines a cromulent Lisp system: | |
606 | * | |
607 | * -- `JQ_NONE' -- don't actually make a job at all; | |
608 | * -- `JQ_READY' -- add the Lisp to the `job_ready' queue, so we'll; or | |
609 | * -- `JQ_DELETE' -- add the Lisp to the `job_delete' queue. | |
610 | * | |
611 | * * `JF_PICKY': The user identified this Lisp system explicitly, so | |
612 | * complain if the configuration section doesn't look right. This is | |
613 | * clear if the caller is just enumerating all of the configuration | |
614 | * sections: without this feature, we'd be checking everything twice, | |
615 | * which (a) is inefficient, and -- more importantly -- (b) could lead to | |
616 | * problems if the two checks are inconsistent. | |
617 | * | |
618 | * * `JF_CHECKINST': Ignore this Lisp if `AF_CHECKINST' is set and it's not | |
619 | * actually installed. (This is usually set for `JQ_READY' calls, so | |
620 | * that we don't try to dump Lisps which aren't there, but clear for | |
621 | * `JQ_DELETE' calls so that we clear out Lisps which have gone away.) | |
622 | * | |
623 | * * `JF_CHECKEXIST': Ignore this Lisp if its image file already exists. | |
624 | * | |
625 | * * `JF_NOTICE': Record the Lisp's image basename in the `good' treap so | |
626 | * that we can identify everything else we find in the image directory as | |
627 | * junk. | |
8996f767 | 628 | */ |
10427eb2 MW |
629 | #define JMASK_QUEUE 3u /* which queue to add good Lisp to */ |
630 | #define JQ_NONE 0u /* don't add to any queue */ | |
631 | #define JQ_READY 1u /* `job_ready' */ | |
632 | #define JQ_DELETE 2u /* `job_delete' */ | |
633 | #define JF_PICKY 4u /* lose if section isn't Lisp defn */ | |
634 | #define JF_CHECKINST 8u /* maybe check Lisp is installed */ | |
635 | #define JF_CHECKEXIST 16u /* skip if image already exists */ | |
636 | #define JF_NOTICE 32u /* record Lisp's image basename */ | |
637 | ||
638 | #define JADD_NAMED (JQ_READY | JF_PICKY | JF_CHECKINST) | |
639 | #define JADD_DEFAULT (JQ_READY | JF_CHECKINST) | |
640 | #define JADD_CLEANUP (JQ_DELETE) | |
641 | #define JADD_NOTICE (JQ_NONE) | |
642 | static void add_job(unsigned f, struct config_section *sect) | |
7b8ff279 | 643 | { |
10427eb2 MW |
644 | const char *name; |
645 | struct job *job, ***tail; | |
6c39ec6d MW |
646 | struct treap_path jobpath; |
647 | struct config_var *dumpvar, *runvar, *imgvar; | |
648 | struct dstr d = DSTR_INIT, dd = DSTR_INIT; | |
649 | struct argv av_version = ARGV_INIT, av_dump = ARGV_INIT; | |
650 | struct stat st; | |
651 | char *imgnewlink = 0, *imglink = 0, *oldimg = 0, *p; | |
652 | unsigned jst; | |
10427eb2 | 653 | size_t i, len; |
6c39ec6d | 654 | ssize_t n; |
7b8ff279 MW |
655 | unsigned fef; |
656 | ||
10427eb2 MW |
657 | /* We'll want the section's name for all sorts of things. */ |
658 | name = CONFIG_SECTION_NAME(sect); | |
659 | len = CONFIG_SECTION_NAMELEN(sect); | |
660 | ||
661 | /* Check to see whether this Lisp system is already queued up. | |
662 | * | |
663 | * We'll get around to adding the new job node to the treap right at the | |
664 | * end, so use a separate path object to keep track of where to put it. | |
665 | */ | |
666 | job = treap_probe(&jobs, name, len, &jobpath); | |
7b8ff279 | 667 | if (job) { |
10427eb2 | 668 | if ((f&JF_PICKY) && verbose >= 1) |
7b8ff279 | 669 | moan("ignoring duplicate Lisp `%s'", JOB_NAME(job)); |
10427eb2 | 670 | goto end; |
7b8ff279 MW |
671 | } |
672 | ||
10427eb2 MW |
673 | /* Check that the section defines a Lisp, and that it can be dumped. |
674 | * | |
675 | * It's not obvious that this is right. Maybe there should be some | |
676 | * additional flag so that we don't check dumpability if we're planning to | |
677 | * delete the image. But it /is/ right: since the thing which tells us | |
678 | * whether we can dump is that the section tells us the image's name, if | |
679 | * it can't be dumped then we won't know what file to delete! So we have | |
680 | * no choice. | |
8996f767 | 681 | */ |
6c39ec6d MW |
682 | runvar = config_find_var(&config, sect, CF_INHERIT, "run-script"); |
683 | if (!runvar) { | |
10427eb2 MW |
684 | if (f&JF_PICKY) lose("unknown Lisp implementation `%s'", name); |
685 | else if (verbose >= 3) moan("skipping non-Lisp section `%s'", name); | |
686 | goto end; | |
687 | } | |
688 | imgvar = config_find_var(&config, sect, CF_INHERIT, "image-file"); | |
689 | if (!imgvar) { | |
690 | if (f&JF_PICKY) | |
691 | lose("Lisp implementation `%s' doesn't use custom images", name); | |
692 | else if (verbose >= 3) | |
693 | moan("skipping Lisp `%s': no custom image support", name); | |
7b8ff279 MW |
694 | goto end; |
695 | } | |
7b8ff279 | 696 | |
8996f767 | 697 | /* Check that the other necessary variables are present. */ |
10427eb2 MW |
698 | dumpvar = config_find_var(&config, sect, CF_INHERIT, "dump-image"); |
699 | if (!dumpvar) | |
700 | lose("variable `dump-image' not defined for Lisp `%s'", name); | |
8996f767 | 701 | |
6c39ec6d MW |
702 | /* Build the job's command lines. */ |
703 | config_subst_split_var(&config, sect, runvar, &av_version); | |
704 | if (!av_version.n) | |
705 | lose("empty `run-script' command for Lisp implementation `%s'", name); | |
90fec59b MW |
706 | argv_append(&av_version, |
707 | config_subst_string_alloc | |
708 | (&config, sect, "<internal>", | |
709 | "?${lisp-version?(lisp-implementation-version)}")); | |
6c39ec6d MW |
710 | config_subst_split_var(&config, sect, dumpvar, &av_dump); |
711 | if (!av_dump.n) | |
8996f767 MW |
712 | lose("empty `dump-image' command for Lisp implementation `%s'", name); |
713 | ||
714 | /* If we're supposed to check that the Lisp exists before proceeding then | |
715 | * do that. There are /two/ commands to check: the basic Lisp command, | |
716 | * /and/ the command to actually do the dumping, which might not be the | |
717 | * same thing. (Be careful not to check the same command twice, though, | |
718 | * because that would cause us to spam the user with redundant | |
719 | * diagnostics.) | |
720 | */ | |
10427eb2 | 721 | if ((f&JF_CHECKINST) && (flags&AF_CHECKINST)) { |
10427eb2 | 722 | fef = (verbose >= 3 ? FEF_VERBOSE : 0); |
6c39ec6d | 723 | if (!found_in_path_p(av_version.v[0], fef)) { |
10427eb2 MW |
724 | if (verbose >= 3) |
725 | moan("skipping Lisp `%s': can't find Lisp command `%s'", | |
6c39ec6d | 726 | name, av_version.v[0]); |
10427eb2 MW |
727 | goto end; |
728 | } | |
6c39ec6d MW |
729 | if (STRCMP(av_version.v[0], !=, av_dump.v[0]) && |
730 | !found_in_path_p(av_dump.v[0], fef)) { | |
731 | if (verbose >= 3) | |
10427eb2 | 732 | moan("skipping Lisp `%s': can't find dump command `%s'", |
6c39ec6d | 733 | av_dump.v[0], d.p); |
7b8ff279 MW |
734 | goto end; |
735 | } | |
736 | } | |
737 | ||
6c39ec6d MW |
738 | /* Collect the output image file names. */ |
739 | imglink = | |
740 | config_subst_string_alloc(&config, sect, "<internal>", "${@image-link}"); | |
741 | imgnewlink = | |
742 | config_subst_string_alloc(&config, sect, | |
743 | "<internal>", "${@image-newlink}"); | |
744 | ||
745 | /* Determine the image link basename. If necessary, record it so that it | |
746 | * doesn't get junked. | |
10427eb2 | 747 | */ |
6c39ec6d MW |
748 | dstr_reset(&dd); config_subst_var(&config, sect, imgvar, &dd); |
749 | if (f&JF_NOTICE) notice_filename(dd.p, dd.len); | |
10427eb2 | 750 | |
6c39ec6d MW |
751 | /* Fill in the directory name for the output image. */ |
752 | dstr_reset(&d); | |
753 | p = strrchr(imglink, '/'); | |
754 | if (p) dstr_putm(&d, imglink, p + 1 - imglink); | |
8996f767 | 755 | |
6c39ec6d MW |
756 | /* Inspect the existing image link if there is one, and record its |
757 | * destination. | |
8996f767 | 758 | */ |
6c39ec6d MW |
759 | for (;;) { |
760 | ||
761 | /* Read the link destination. The `lstat'/`readlink' two-step is | |
762 | * suggested by the POSIX specification. | |
763 | */ | |
764 | if (lstat(imglink, &st)) { | |
765 | if (verbose >= (errno == ENOENT ? 3 : 1)) | |
766 | moan("failed to read metadata for Lisp `%s' image link `%s': %s", | |
767 | name, imglink, strerror(errno)); | |
768 | break; | |
769 | } | |
770 | if (!S_ISLNK(st.st_mode)) { | |
771 | if (verbose >= 1) | |
772 | moan("Lisp `%s' image link `%s' isn't a symbolic link", | |
773 | name, imglink); | |
774 | break; | |
775 | } | |
776 | dstr_ensure(&d, st.st_size + 1); | |
777 | n = readlink(imglink, d.p + d.len, d.sz - d.len); | |
778 | if (n < 0) { | |
779 | moan("failed to read Lisp `%s' image link `%s': %s", | |
780 | name, imglink, strerror(errno)); | |
781 | break; | |
782 | } | |
783 | if (n == d.sz - d.len) continue; | |
784 | ||
785 | /* Check that the link has the right form. (We don't want to delete the | |
786 | * referent if it's not actually our image.) | |
787 | * | |
788 | * We expect the referent to look like ${image-file} followed by a hyphen | |
789 | * and some hex digits. | |
790 | */ | |
791 | if (n <= dd.len || | |
792 | STRNCMP(d.p + d.len, !=, dd.p, dd.len) || | |
793 | d.p[d.len + dd.len] != '-' || | |
794 | !hex_digits_p(d.p + (d.len + dd.len + 1), n - (dd.len + 1))) { | |
795 | if (verbose >= 1) | |
796 | moan("Lisp `%s' image link `%s' has unexpected referent `%s'", | |
797 | name, imglink, d.p); | |
798 | break; | |
7b8ff279 | 799 | } |
6c39ec6d MW |
800 | |
801 | /* OK, so it looks legit. Protect it from being junked. */ | |
802 | if (f&JF_NOTICE) notice_filename(d.p + d.len, n); | |
803 | d.p[d.len + n] = 0; d.len += n; | |
804 | oldimg = xstrndup(d.p, d.len); | |
805 | break; | |
7b8ff279 MW |
806 | } |
807 | ||
8996f767 MW |
808 | /* All preflight checks complete. Build the job and hook it onto the end |
809 | * of the list. (Steal the command-line vector so that we don't try to | |
810 | * free it during cleanup.) | |
811 | */ | |
10427eb2 | 812 | switch (f&JMASK_QUEUE) { |
6c39ec6d MW |
813 | case JQ_NONE: jst = JST_INTERN; tail = 0; break; |
814 | case JQ_READY: jst = JST_VERSION; tail = &job_ready_tail; break; | |
815 | case JQ_DELETE: jst = JST_INTERN; tail = &job_delete_tail; break; | |
10427eb2 MW |
816 | default: assert(0); |
817 | } | |
7b8ff279 | 818 | job = xmalloc(sizeof(*job)); |
6c39ec6d | 819 | job->st = jst; job->sect = sect; job->dumpvar = dumpvar; |
10427eb2 | 820 | job->kid = -1; job->log = 0; |
7b8ff279 MW |
821 | job->out.fd = -1; job->out.buf = 0; |
822 | job->err.fd = -1; job->err.buf = 0; | |
6c39ec6d MW |
823 | job->av_version = av_version; argv_init(&av_version); |
824 | argv_init(&job->av_dump); | |
825 | job->imgnew = 0; job->imghash = 0; | |
826 | job->imgnewlink = imgnewlink; imgnewlink = 0; | |
827 | job->imglink = imglink; imglink = 0; | |
828 | job->oldimg = oldimg; oldimg = 0; | |
10427eb2 MW |
829 | treap_insert(&jobs, &jobpath, &job->_node, name, len); |
830 | if (tail) { **tail = job; *tail = &job->next; } | |
8996f767 | 831 | |
7b8ff279 | 832 | end: |
8996f767 | 833 | /* All done. Cleanup time. */ |
6c39ec6d MW |
834 | for (i = 0; i < av_version.n; i++) free(av_version.v[i]); |
835 | for (i = 0; i < av_dump.n; i++) free(av_dump.v[i]); | |
836 | free(imgnewlink); free(imglink); free(oldimg); | |
837 | dstr_release(&d); dstr_release(&dd); | |
838 | argv_release(&av_version); argv_release(&av_dump); | |
7b8ff279 MW |
839 | } |
840 | ||
10427eb2 MW |
841 | /* As `add_job' above, but look the Lisp implementation up by name. |
842 | * | |
843 | * The flags passed to `add_job' are augmented with `JF_PICKY' because this | |
844 | * is an explicitly-named Lisp implementation. | |
845 | */ | |
846 | static void add_named_job(unsigned f, const char *name, size_t len) | |
847 | { | |
848 | struct config_section *sect; | |
849 | ||
850 | sect = config_find_section_n(&config, 0, name, len); | |
851 | if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name); | |
852 | add_job(f | JF_PICKY, sect); | |
853 | } | |
854 | ||
8996f767 MW |
855 | /* Free the JOB and all the resources it holds. |
856 | * | |
857 | * Close the pipes; kill the child process. Everything must go. | |
858 | */ | |
7b8ff279 MW |
859 | static void release_job(struct job *job) |
860 | { | |
8996f767 | 861 | size_t i; |
10427eb2 | 862 | struct job *j; |
8996f767 | 863 | |
7b8ff279 MW |
864 | if (job->kid > 0) kill(job->kid, SIGKILL); /* ?? */ |
865 | if (job->log && job->log != stdout) fclose(job->log); | |
6c39ec6d MW |
866 | free(job->imgnew); free(job->imghash); |
867 | free(job->imglink); free(job->imgnewlink); | |
868 | free(job->oldimg); | |
869 | for (i = 0; i < job->av_version.n; i++) free(job->av_version.v[i]); | |
870 | for (i = 0; i < job->av_dump.n; i++) free(job->av_dump.v[i]); | |
871 | argv_release(&job->av_version); argv_release(&job->av_dump); | |
7b8ff279 MW |
872 | free(job->out.buf); if (job->out.fd >= 0) close(job->out.fd); |
873 | free(job->err.buf); if (job->err.fd >= 0) close(job->err.fd); | |
10427eb2 | 874 | j = treap_remove(&jobs, JOB_NAME(job), JOB_NAMELEN(job)); assert(j == job); |
7b8ff279 MW |
875 | free(job); |
876 | } | |
877 | ||
8996f767 MW |
878 | /* Do all the necessary things when JOB finishes (successfully or not). |
879 | * | |
6c39ec6d MW |
880 | * Eventually the job is either freed (using `release_job'), or updated and |
881 | * stuffed back into the `job_run' queue. The caller is expected to have | |
882 | * already unlinked the job from its current list. | |
8996f767 | 883 | */ |
7b8ff279 MW |
884 | static void finish_job(struct job *job) |
885 | { | |
6c39ec6d MW |
886 | char buf[16483], *p; |
887 | unsigned char *hbuf; | |
888 | struct dstr d = DSTR_INIT; | |
889 | size_t i, n; | |
7b8ff279 MW |
890 | int ok = 0; |
891 | ||
8996f767 MW |
892 | /* Start a final line to the job log describing its eventual fate. |
893 | * | |
894 | * This is where we actually pick apart the exit status. Set `ok' if it | |
895 | * actually succeeded, because that's all anything else cares about. | |
896 | */ | |
7b8ff279 MW |
897 | fprintf(job->log, "%-13s > ", JOB_NAME(job)); |
898 | if (WIFEXITED(job->exit)) { | |
899 | if (!WEXITSTATUS(job->exit)) | |
900 | { fputs("completed successfully\n", job->log); ok = 1; } | |
901 | else | |
902 | fprintf(job->log, "failed with exit status %d\n", | |
903 | WEXITSTATUS(job->exit)); | |
904 | } else if (WIFSIGNALED(job->exit)) | |
905 | fprintf(job->log, "killed by signal %d (%s%s)", WTERMSIG(job->exit), | |
906 | #if defined(HAVE_STRSIGNAL) | |
907 | strsignal(WTERMSIG(job->exit)), | |
908 | #elif defined(HAVE_DECL_SYS_SIGLIST) | |
909 | sys_siglist[WTERMSIG(job->exit)], | |
910 | #else | |
911 | "unknown signal", | |
912 | #endif | |
913 | #ifdef WCOREDUMP | |
914 | WCOREDUMP(job->exit) ? "; core dumped" : | |
915 | #endif | |
916 | ""); | |
8996f767 MW |
917 | else |
918 | fprintf(job->log, "exited with incomprehensible status %06o\n", | |
919 | job->exit); | |
7b8ff279 | 920 | |
6c39ec6d | 921 | /* What happens next depends on the state of the job. This is the main |
1740a58c | 922 | * place which advances the job state machine. |
8996f767 | 923 | */ |
6c39ec6d MW |
924 | if (ok) switch (job->st) { |
925 | ||
926 | case JST_VERSION: | |
927 | /* We've retrieved the Lisp system's version string. */ | |
928 | ||
929 | /* Complete the hashing and convert to hex. */ | |
930 | hbuf = (unsigned char *)buf + 32; sha256_done(&job->h, hbuf); | |
931 | for (i = 0; i < 8; i++) sprintf(buf + 2*i, "%02x", hbuf[i]); | |
932 | if (verbose >= 2) | |
933 | moan("Lisp `%s' version hash = %s", JOB_NAME(job), buf); | |
934 | ||
935 | /* Determine the final version-qualified name for the image. */ | |
936 | config_set_var(&config, job->sect, CF_LITERAL, "@hash", buf); | |
937 | job->imghash = | |
938 | config_subst_string_alloc(&config, job->sect, | |
939 | "<internal>", "${@image-out}"); | |
940 | job->imgnew = | |
941 | config_subst_string_alloc(&config, job->sect, | |
942 | "<internal>", "${@image-new}"); | |
943 | ||
944 | /* Determine the basename of the final image. */ | |
945 | p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash; | |
946 | ||
947 | /* Inspect the current link pointer to see if we have the right | |
948 | * version. | |
949 | */ | |
950 | if (!(flags&AF_FORCE) && | |
951 | job->oldimg && | |
952 | STRCMP(job->oldimg, ==, job->imghash) && | |
953 | !access(job->oldimg, F_OK)) { | |
954 | if (verbose >= 2) | |
955 | moan("Lisp `%s' image `%s' already up-to-date", | |
956 | JOB_NAME(job), job->imghash); | |
957 | break; | |
958 | } | |
959 | ||
960 | /* Make sure that there's a clear space for the new image to be | |
961 | * written. | |
962 | */ | |
963 | if (!(flags&AF_DRYRUN) && unlink(job->imgnew) && errno != ENOENT) { | |
964 | bad("failed to clear Lisp `%s' image staging path `%s': %s", | |
965 | JOB_NAME(job), job->imgnew, strerror(errno)); | |
966 | break; | |
967 | } | |
968 | ||
969 | /* If we're still here then we've decided to dump a new image. Update | |
970 | * the job state, and put it back on the run queue. | |
971 | */ | |
972 | config_subst_split_var(&config, job->sect, | |
973 | job->dumpvar, &job->av_dump); | |
974 | assert(job->av_dump.n); | |
975 | job->st = JST_DUMP; | |
976 | *job_ready_tail = job; job_ready_tail = &job->next; job->next = 0; | |
977 | job = 0; | |
978 | break; | |
979 | ||
980 | case JST_DUMP: | |
981 | /* We've finished dumping a custom image. It's time to apply the | |
982 | * finishing touches. | |
983 | */ | |
984 | ||
985 | /* Rename the image into place. If this fails, blame it on the dump | |
986 | * job, because the chances are good that it failed to produce the | |
987 | * image properly. | |
988 | */ | |
164c2063 MW |
989 | if (verbose >= 3) |
990 | moan("rename completed Lisp `%s' image `%s' to `%s'", | |
991 | JOB_NAME(job), job->imgnew, job->imghash); | |
6c39ec6d MW |
992 | if (rename(job->imgnew, job->imghash)) { |
993 | fprintf(job->log, "%-13s > failed to rename Lisp `%s' " | |
994 | "output image `%s' to `%s': %s", | |
995 | JOB_NAME(job), JOB_NAME(job), | |
996 | job->imgnew, job->imghash, strerror(errno)); | |
997 | ok = 0; break; | |
998 | } | |
999 | ||
cf51f4b4 MW |
1000 | /* Notice the image so that it doesn't get junked. */ |
1001 | if (flags&AF_JUNK) { | |
1002 | p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash; | |
1003 | notice_filename(p, strlen(p)); | |
1004 | } | |
1005 | ||
6c39ec6d MW |
1006 | /* Determine the basename of the final image. */ |
1007 | p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash; | |
1008 | ||
1009 | /* Build the symlink. Start by setting the link in the staging path, | |
1010 | * and then rename, in order to ensure continuity. | |
1011 | */ | |
1012 | if (unlink(job->imgnewlink) && errno != ENOENT) { | |
1013 | bad("failed to clear Lisp `%s' link staging path `%s': %s", | |
1014 | JOB_NAME(job), job->imgnewlink, strerror(errno)); | |
1015 | break; | |
1016 | } | |
164c2063 MW |
1017 | if (verbose >= 3) |
1018 | moan("establish Lisp `%s' image link `%s' referring to `%s'", | |
1019 | JOB_NAME(job), job->imglink, job->imghash); | |
6c39ec6d MW |
1020 | if (symlink(p, job->imgnewlink)) { |
1021 | bad("failed to create Lisp `%s' image link `%s': %s", | |
1022 | JOB_NAME(job), job->imgnewlink, strerror(errno)); | |
1023 | break; | |
1024 | } | |
1025 | if (rename(job->imgnewlink, job->imglink)) { | |
1026 | bad("failed to rename Lisp `%s' image link `%s' to `%s': %s", | |
1027 | JOB_NAME(job), job->imgnewlink, job->imglink, strerror(errno)); | |
1028 | break; | |
1029 | } | |
164c2063 MW |
1030 | if (job->oldimg && STRCMP(job->oldimg, !=, job->imghash)) { |
1031 | if (verbose >= 3) | |
1032 | moan("remove old Lisp `%s' image `%s'", | |
1033 | JOB_NAME(job), job->oldimg); | |
1034 | if (unlink(job->oldimg) && errno != ENOENT) { | |
1035 | if (verbose >= 1) | |
1036 | moan("failed to delete old Lisp `%s' image `%s': %s", | |
1037 | JOB_NAME(job), job->oldimg, strerror(errno)); | |
1038 | } | |
6c39ec6d MW |
1039 | } |
1040 | ||
1041 | /* I think we're all done. */ | |
1042 | break; | |
1043 | ||
1044 | default: | |
1045 | assert(0); | |
7b8ff279 MW |
1046 | } |
1047 | ||
8996f767 MW |
1048 | /* If the job failed and we're being quiet then write out the log that we |
1049 | * made. | |
1050 | */ | |
1051 | if (!ok && verbose < 2) { | |
1052 | rewind(job->log); | |
1053 | for (;;) { | |
1054 | n = fread(buf, 1, sizeof(buf), job->log); | |
1055 | if (n) fwrite(buf, 1, n, stdout); | |
1056 | if (n < sizeof(buf)) break; | |
1057 | } | |
7b8ff279 | 1058 | } |
7b8ff279 | 1059 | |
8996f767 MW |
1060 | /* Also make a node to stderr about what happened. (Just to make sure |
1061 | * that we've gotten someone's attention.) | |
1062 | */ | |
1063 | if (!ok) bad("failed to dump Lisp `%s'", JOB_NAME(job)); | |
7b8ff279 | 1064 | |
8996f767 | 1065 | /* Finally free the job control block. */ |
6c39ec6d MW |
1066 | if (job) release_job(job); |
1067 | dstr_release(&d); | |
7b8ff279 MW |
1068 | } |
1069 | ||
8996f767 | 1070 | /* Called after `SIGCHLD': collect exit statuses and mark jobs as dead. */ |
7b8ff279 MW |
1071 | static void reap_children(void) |
1072 | { | |
6c39ec6d | 1073 | struct job *job; |
7b8ff279 MW |
1074 | pid_t kid; |
1075 | int st; | |
1076 | ||
1077 | for (;;) { | |
8996f767 MW |
1078 | |
1079 | /* Collect a child exit status. If there aren't any more then we're | |
1080 | * done. | |
1081 | */ | |
7b8ff279 MW |
1082 | kid = waitpid(0, &st, WNOHANG); |
1083 | if (kid <= 0) break; | |
8996f767 MW |
1084 | |
1085 | /* Try to find a matching job. If we can't, then we should just ignore | |
1086 | * it. | |
1087 | */ | |
6c39ec6d | 1088 | for (job = job_run; job; job = job->next) |
7b8ff279 | 1089 | if (job->kid == kid) goto found; |
7b8ff279 | 1090 | continue; |
8996f767 | 1091 | |
7b8ff279 | 1092 | found: |
6c39ec6d MW |
1093 | /* Mark the job as dead, and save its exit status. */ |
1094 | job->exit = st; job->kid = -1; nrun--; | |
7b8ff279 | 1095 | } |
8996f767 MW |
1096 | |
1097 | /* If there was a problem with waitpid(2) then report it. */ | |
7b8ff279 MW |
1098 | if (kid < 0 && errno != ECHILD) |
1099 | lose("failed to collect child process exit status: %s", strerror(errno)); | |
1100 | } | |
1101 | ||
8996f767 | 1102 | /* Execute the handler for some JOB. */ |
6c39ec6d | 1103 | static NORETURN void job_child(struct job *job, struct argv *av) |
7b8ff279 | 1104 | { |
6c39ec6d MW |
1105 | try_exec(av, 0); |
1106 | moan("failed to run `%s': %s", av->v[0], strerror(errno)); | |
8996f767 | 1107 | _exit(127); |
7b8ff279 MW |
1108 | } |
1109 | ||
8996f767 MW |
1110 | /* Start up jobs while there are (a) jobs to run and (b) slots to run them |
1111 | * in. | |
1112 | */ | |
7b8ff279 MW |
1113 | static void start_jobs(void) |
1114 | { | |
1115 | struct dstr d = DSTR_INIT; | |
1116 | int p_out[2], p_err[2]; | |
1117 | struct job *job; | |
6c39ec6d | 1118 | struct argv *av; |
7b8ff279 MW |
1119 | pid_t kid; |
1120 | ||
8996f767 MW |
1121 | /* Keep going until either we run out of jobs, or we've got enough running |
1122 | * already. | |
1123 | */ | |
7b8ff279 | 1124 | while (job_ready && nrun < maxrun) { |
8996f767 MW |
1125 | |
1126 | /* Set things up ready. If things go wrong, we need to know what stuff | |
1127 | * needs to be cleaned up. | |
1128 | */ | |
7b8ff279 | 1129 | job = job_ready; job_ready = job->next; |
6c39ec6d | 1130 | if (!job_ready) job_ready_tail = &job_ready; |
7b8ff279 | 1131 | p_out[0] = p_out[1] = p_err[0] = p_err[1] = -1; |
8996f767 | 1132 | |
6c39ec6d MW |
1133 | /* Figure out what to do. */ |
1134 | switch (job->st) { | |
1135 | case JST_VERSION: av = &job->av_version; break; | |
1136 | case JST_DUMP: av = &job->av_dump; break; | |
1137 | default: assert(0); | |
1138 | } | |
1139 | ||
10427eb2 | 1140 | /* If we're not actually going to do anything, now is the time to not do |
6c39ec6d | 1141 | * that. We should do the version-hashing step unconditionally. |
10427eb2 | 1142 | */ |
6c39ec6d MW |
1143 | switch (job->st) { |
1144 | case JST_VERSION: | |
1145 | break; | |
1146 | case JST_DUMP: | |
1147 | if (flags&AF_DRYRUN) { | |
1148 | if (try_exec(av, | |
1149 | TEF_DRYRUN | | |
1150 | (verbose >= 2 && !(flags&AF_CHECKINST) | |
1151 | ? TEF_VERBOSE : 0))) | |
1152 | rc = 127; | |
1153 | else if (verbose >= 2) | |
1154 | printf("%-13s > not dumping `%s' (dry run)\n", | |
1155 | JOB_NAME(job), JOB_NAME(job)); | |
1156 | release_job(job); | |
1157 | continue; | |
1158 | } | |
1159 | break; | |
1160 | default: | |
1161 | assert(0); | |
10427eb2 MW |
1162 | } |
1163 | ||
6c39ec6d MW |
1164 | /* Do one-time setup for external jobs. */ |
1165 | if (!job->log) { | |
8996f767 | 1166 | |
6c39ec6d MW |
1167 | /* Make a temporary subdirectory for this job to use. */ |
1168 | dstr_reset(&d); dstr_putf(&d, "%s/%s", tmpdir, JOB_NAME(job)); | |
1169 | if (mkdir(d.p, 0700)) { | |
1170 | bad("failed to create working directory for job `%s': %s", | |
1171 | JOB_NAME(job), strerror(errno)); | |
1172 | goto fail; | |
1173 | } | |
1174 | ||
1175 | /* Create the job's log file. If we're being verbose then that's just | |
1176 | * our normal standard output -- /not/ stderr: it's likely that users | |
1177 | * will want to pipe this stuff through a pager or something, and | |
1178 | * that'll be easier if we use stdout. Otherwise, make a file in the | |
1179 | * temporary directory. | |
1180 | */ | |
1181 | if (verbose >= 2) | |
1182 | job->log = stdout; | |
1183 | else { | |
1184 | dstr_puts(&d, "/log"); job->log = fopen(d.p, "w+"); | |
1185 | if (!job->log) | |
1186 | lose("failed to open log file `%s': %s", d.p, strerror(errno)); | |
1187 | } | |
7b8ff279 | 1188 | } |
8996f767 MW |
1189 | |
1190 | /* Make the pipes to capture the child process's standard output and | |
1191 | * error streams. | |
1192 | */ | |
7b8ff279 MW |
1193 | if (pipe(p_out) || pipe(p_err)) { |
1194 | bad("failed to create pipes for job `%s': %s", | |
1195 | JOB_NAME(job), strerror(errno)); | |
1196 | goto fail; | |
1197 | } | |
1198 | if (configure_fd("job stdout pipe", p_out[0], 1, 1) || | |
1199 | configure_fd("job stdout pipe", p_out[1], 0, 1) || | |
1200 | configure_fd("job stderr pipe", p_err[0], 1, 1) || | |
1201 | configure_fd("job stderr pipe", p_err[1], 0, 1) || | |
1202 | configure_fd("log file", fileno(job->log), 1, 1)) | |
1203 | goto fail; | |
8996f767 | 1204 | |
6c39ec6d MW |
1205 | /* Initialize the output-processing structures ready for use. */ |
1206 | if (job->st == JST_VERSION) sha256_init(&job->h); | |
7b8ff279 MW |
1207 | job->out.buf = xmalloc(MAXLINE); job->out.off = job->out.len = 0; |
1208 | job->out.fd = p_out[0]; p_out[0] = -1; | |
1209 | job->err.buf = xmalloc(MAXLINE); job->err.off = job->err.len = 0; | |
1210 | job->err.fd = p_err[0]; p_err[0] = -1; | |
8996f767 MW |
1211 | |
1212 | /* Print a note to the top of the log. */ | |
6c39ec6d | 1213 | dstr_reset(&d); argv_string(&d, av); |
7b8ff279 | 1214 | fprintf(job->log, "%-13s > starting %s\n", JOB_NAME(job), d.p); |
8996f767 MW |
1215 | |
1216 | /* Flush the standard output stream. (Otherwise the child might try to | |
1217 | * flush it too.) | |
1218 | */ | |
7b8ff279 | 1219 | fflush(stdout); |
8996f767 MW |
1220 | |
1221 | /* Spin up the child process. */ | |
7b8ff279 MW |
1222 | kid = fork(); |
1223 | if (kid < 0) { | |
1224 | bad("failed to fork process for job `%s': %s", | |
1225 | JOB_NAME(job), strerror(errno)); | |
1226 | goto fail; | |
1227 | } | |
1228 | if (!kid) { | |
1229 | if (dup2(nullfd, 0) < 0 || | |
1230 | dup2(p_out[1], 1) < 0 || | |
1231 | dup2(p_err[1], 2) < 0) | |
1232 | lose("failed to juggle job `%s' file descriptors: %s", | |
1233 | JOB_NAME(job), strerror(errno)); | |
6c39ec6d | 1234 | job_child(job, av); |
7b8ff279 | 1235 | } |
8996f767 MW |
1236 | |
1237 | /* Close the ends of the pipes that we don't need. Move the job into | |
1238 | * the running list. | |
1239 | */ | |
7b8ff279 | 1240 | close(p_out[1]); close(p_err[1]); |
6c39ec6d | 1241 | job->kid = kid; job->next = job_run; job_run = job; nrun++; |
7b8ff279 | 1242 | continue; |
8996f767 | 1243 | |
7b8ff279 | 1244 | fail: |
8996f767 | 1245 | /* Clean up the wreckage if it didn't work. */ |
7b8ff279 MW |
1246 | if (p_out[0] >= 0) close(p_out[0]); |
1247 | if (p_out[1] >= 0) close(p_out[1]); | |
1248 | if (p_err[0] >= 0) close(p_err[0]); | |
1249 | if (p_err[1] >= 0) close(p_err[1]); | |
1250 | release_job(job); | |
1251 | } | |
8996f767 MW |
1252 | |
1253 | /* All done except for some final tidying up. */ | |
7b8ff279 MW |
1254 | dstr_release(&d); |
1255 | } | |
1256 | ||
8996f767 MW |
1257 | /* Take care of all of the jobs until they're all done. */ |
1258 | static void run_jobs(void) | |
1259 | { | |
1260 | struct job *job, *next, **link; | |
1261 | int nfd; | |
1262 | fd_set fd_in; | |
1263 | ||
1264 | for (;;) { | |
1265 | ||
1266 | /* If there are jobs still to be started and we have slots to spare then | |
1267 | * start some more up. | |
1268 | */ | |
1269 | start_jobs(); | |
1270 | ||
1271 | /* If the queues are now all empty then we're done. (No need to check | |
1272 | * `job_ready' here: `start_jobs' would have started them if `job_run' | |
1273 | * was empty. | |
1274 | */ | |
6c39ec6d | 1275 | if (!job_run) break; |
8996f767 MW |
1276 | |
1277 | /* Prepare for the select(2) call: watch for the signal pipe and all of | |
1278 | * the job pipes. | |
1279 | */ | |
1280 | #define SET_FD(dir, fd) do { \ | |
1281 | int _fd = (fd); \ | |
1282 | FD_SET(_fd, &fd_##dir); \ | |
1283 | if (_fd >= nfd) nfd = _fd + 1; \ | |
1284 | } while (0) | |
1285 | ||
1286 | FD_ZERO(&fd_in); nfd = 0; | |
1287 | SET_FD(in, sig_pipe[0]); | |
1288 | for (job = job_run; job; job = job->next) { | |
1289 | if (job->out.fd >= 0) SET_FD(in, job->out.fd); | |
1290 | if (job->err.fd >= 0) SET_FD(in, job->err.fd); | |
1291 | } | |
8996f767 MW |
1292 | |
1293 | #undef SET_FD | |
1294 | ||
1295 | /* Find out what's going on. */ | |
1296 | if (select(nfd, &fd_in, 0, 0, 0) < 0) { | |
1297 | if (errno == EINTR) continue; | |
1298 | else lose("select failed: %s", strerror(errno)); | |
1299 | } | |
1300 | ||
1301 | /* If there were any signals then handle them. */ | |
1302 | if (FD_ISSET(sig_pipe[0], &fd_in)) { | |
1303 | check_signals(); | |
1304 | if (sigloss >= 0) { | |
1305 | /* We hit a fatal signal. Kill off the remaining jobs and abort. */ | |
1306 | for (job = job_ready; job; job = next) | |
1307 | { next = job->next; release_job(job); } | |
1308 | for (job = job_run; job; job = next) | |
1309 | { next = job->next; release_job(job); } | |
8996f767 MW |
1310 | break; |
1311 | } | |
1312 | } | |
1313 | ||
6c39ec6d MW |
1314 | /* Collect output from running jobs, and clear away any dead jobs once |
1315 | * we've collected all their output. | |
8996f767 | 1316 | */ |
6c39ec6d | 1317 | for (link = &job_run, job = *link; job; job = next) { |
10427eb2 | 1318 | if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in)) |
6c39ec6d MW |
1319 | prefix_lines(job, &job->out, '|', |
1320 | job->st == JST_VERSION ? &job->h : 0); | |
10427eb2 | 1321 | if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in)) |
6c39ec6d | 1322 | prefix_lines(job, &job->err, '*', 0); |
8996f767 | 1323 | next = job->next; |
6c39ec6d MW |
1324 | if (job->kid > 0 || job->out.fd >= 0 || job->err.fd >= 0) |
1325 | link = &job->next; | |
1326 | else | |
1327 | { *link = next; finish_job(job); } | |
8996f767 MW |
1328 | } |
1329 | } | |
1330 | } | |
1331 | ||
1332 | /*----- Main program ------------------------------------------------------*/ | |
1333 | ||
1334 | /* Help and related functions. */ | |
7b8ff279 MW |
1335 | static void version(FILE *fp) |
1336 | { fprintf(fp, "%s, runlisp version %s\n", progname, PACKAGE_VERSION); } | |
1337 | ||
1338 | static void usage(FILE *fp) | |
1339 | { | |
1340 | fprintf(fp, "\ | |
60db9fab | 1341 | usage: %s [-RUafinqrv] [+RUfinr] [-c CONF] [-o [SECT:]VAR=VAL]\n\ |
7b8ff279 MW |
1342 | [-O FILE|DIR] [-j NJOBS] [LISP ...]\n", |
1343 | progname); | |
1344 | } | |
1345 | ||
1346 | static void help(FILE *fp) | |
1347 | { | |
1348 | version(fp); fputc('\n', fp); usage(fp); | |
1349 | fputs("\n\ | |
1350 | Help options:\n\ | |
1351 | -h, --help Show this help text and exit successfully.\n\ | |
1352 | -V, --version Show version number and exit successfully.\n\ | |
1353 | \n\ | |
1354 | Diagnostics:\n\ | |
1355 | -n, --dry-run Don't run run anything (useful with `-v').\n\ | |
1356 | -q, --quiet Don't print warning messages.\n\ | |
1357 | -v, --verbose Print informational messages (repeatable).\n\ | |
1358 | \n\ | |
1359 | Configuration:\n\ | |
1360 | -c, --config-file=CONF Read configuration from CONF (repeatable).\n\ | |
1361 | -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\ | |
1362 | \n\ | |
1363 | Image dumping:\n\ | |
1364 | -O, --output=FILE|DIR Store image(s) in FILE or DIR.\n\ | |
10427eb2 MW |
1365 | -R, --remove-other Delete image files for other Lisp systems.\n\ |
1366 | -U, --remove-unknown Delete unrecognized files in image dir.\n\ | |
1367 | -a, --all-configured Select all configured implementations.\n\ | |
7b8ff279 | 1368 | -f, --force Dump images even if they already exist.\n\ |
10427eb2 MW |
1369 | -i, --check-installed Check Lisp systems exist before dumping.\n\ |
1370 | -j, --jobs=NJOBS Run up to NJOBS jobs in parallel.\n\ | |
1371 | -r, --remove-image Delete image files, instead of creating.\n", | |
7b8ff279 MW |
1372 | fp); |
1373 | } | |
1374 | ||
10427eb2 MW |
1375 | static void show_job_list(const char *what, struct job *job) |
1376 | { | |
1377 | struct dstr d = DSTR_INIT; | |
1378 | int first; | |
1379 | ||
1380 | first = 1; | |
1381 | for (; job; job = job->next) { | |
1382 | if (first) first = 0; | |
1383 | else dstr_puts(&d, ", "); | |
1384 | dstr_putf(&d, "`%s'", JOB_NAME(job)); | |
1385 | } | |
1386 | if (first) dstr_puts(&d, "(none)"); | |
1387 | dstr_putz(&d); | |
1388 | moan("%s: %s", what, d.p); | |
1389 | } | |
1390 | ||
8996f767 | 1391 | /* Main program. */ |
7b8ff279 MW |
1392 | int main(int argc, char *argv[]) |
1393 | { | |
1394 | struct config_section_iter si; | |
1395 | struct config_section *sect; | |
1396 | struct config_var *var; | |
1397 | const char *out = 0, *p, *q, *l; | |
10427eb2 | 1398 | struct job *job; |
7b8ff279 MW |
1399 | struct stat st; |
1400 | struct dstr d = DSTR_INIT; | |
10427eb2 MW |
1401 | DIR *dir; |
1402 | struct dirent *de; | |
1403 | int i, fd; | |
1404 | size_t n, o; | |
1405 | unsigned f; | |
7b8ff279 | 1406 | |
8996f767 | 1407 | /* Command-line options. */ |
7b8ff279 MW |
1408 | static const struct option opts[] = { |
1409 | { "help", 0, 0, 'h' }, | |
1410 | { "version", 0, 0, 'V' }, | |
1411 | { "output", OPTF_ARGREQ, 0, 'O' }, | |
10427eb2 MW |
1412 | { "remove-other", OPTF_NEGATE, 0, 'R' }, |
1413 | { "remove-unknown", OPTF_NEGATE, 0, 'U' }, | |
7b8ff279 MW |
1414 | { "all-configured", 0, 0, 'a' }, |
1415 | { "config-file", OPTF_ARGREQ, 0, 'c' }, | |
1416 | { "force", OPTF_NEGATE, 0, 'f' }, | |
1417 | { "check-installed", OPTF_NEGATE, 0, 'i' }, | |
1418 | { "jobs", OPTF_ARGREQ, 0, 'j' }, | |
1419 | { "dry-run", OPTF_NEGATE, 0, 'n' }, | |
1420 | { "set-option", OPTF_ARGREQ, 0, 'o' }, | |
1421 | { "quiet", 0, 0, 'q' }, | |
10427eb2 | 1422 | { "remove-image", OPTF_NEGATE, 0, 'r' }, |
7b8ff279 MW |
1423 | { "verbose", 0, 0, 'v' }, |
1424 | { 0, 0, 0, 0 } | |
1425 | }; | |
1426 | ||
8996f767 | 1427 | /* Initial setup. */ |
7b8ff279 MW |
1428 | set_progname(argv[0]); |
1429 | init_config(); | |
9ecf91d0 | 1430 | srand(time(0)); |
7b8ff279 | 1431 | |
8996f767 | 1432 | /* Parse the options. */ |
7b8ff279 | 1433 | optprog = (/*unconst*/ char *)progname; |
10427eb2 MW |
1434 | |
1435 | #define FLAGOPT(ch, f) \ | |
1436 | case ch: \ | |
1437 | flags |= f; \ | |
1438 | break; \ | |
1439 | case ch | OPTF_NEGATED: \ | |
1440 | flags &= ~f; \ | |
1441 | break | |
1442 | ||
7b8ff279 | 1443 | for (;;) { |
60db9fab | 1444 | i = mdwopt(argc - 1, argv + 1, "hVO:R+U+ac:f+i+j:n+o:qr+v", opts, 0, 0, |
7b8ff279 MW |
1445 | OPTF_NEGATION | OPTF_NOPROGNAME); |
1446 | if (i < 0) break; | |
1447 | switch (i) { | |
1448 | case 'h': help(stdout); exit(0); | |
1449 | case 'V': version(stdout); exit(0); | |
1450 | case 'O': out = optarg; break; | |
10427eb2 MW |
1451 | FLAGOPT('R', AF_CLEAN); |
1452 | FLAGOPT('U', AF_JUNK); | |
7b8ff279 MW |
1453 | case 'a': flags |= AF_ALL; break; |
1454 | case 'c': read_config_path(optarg, 0); flags |= AF_SETCONF; break; | |
10427eb2 MW |
1455 | FLAGOPT('f', AF_FORCE); |
1456 | FLAGOPT('i', AF_CHECKINST); | |
7b8ff279 | 1457 | case 'j': maxrun = parse_int("number of jobs", optarg, 1, 65535); break; |
10427eb2 | 1458 | FLAGOPT('n', AF_DRYRUN); |
7b8ff279 MW |
1459 | case 'o': if (set_config_var(optarg)) flags |= AF_BOGUS; break; |
1460 | case 'q': if (verbose) verbose--; break; | |
10427eb2 | 1461 | FLAGOPT('r', AF_REMOVE); |
7b8ff279 MW |
1462 | case 'v': verbose++; break; |
1463 | default: flags |= AF_BOGUS; break; | |
1464 | } | |
1465 | } | |
1466 | ||
10427eb2 MW |
1467 | #undef FLAGOPT |
1468 | ||
8996f767 | 1469 | /* CHeck that everything worked. */ |
7b8ff279 MW |
1470 | optind++; |
1471 | if ((flags&AF_ALL) ? optind < argc : optind >= argc) flags |= AF_BOGUS; | |
8996f767 | 1472 | if (flags&AF_BOGUS) { usage(stderr); exit(127); } |
7b8ff279 | 1473 | |
8996f767 | 1474 | /* Load default configuration if no explicit files were requested. */ |
7b8ff279 MW |
1475 | if (!(flags&AF_SETCONF)) load_default_config(); |
1476 | ||
8996f767 MW |
1477 | /* OK, so we've probably got some work to do. Let's set things up ready. |
1478 | * It'll be annoying if our standard descriptors aren't actually set up | |
1479 | * properly, so we'll make sure those slots are populated. We'll need a | |
1480 | * `/dev/null' descriptor anyway (to be stdin for the jobs). We'll also | |
1481 | * need a temporary directory, and it'll be less temporary if we don't | |
1482 | * arrange to delete it when we're done. And finally we'll need to know | |
1483 | * when a child process exits. | |
1484 | */ | |
1485 | for (;;) { | |
1486 | fd = open("/dev/null", O_RDWR); | |
1487 | if (fd < 0) lose("failed to open `/dev/null': %s", strerror(errno)); | |
1488 | if (fd > 2) { nullfd = fd; break; } | |
7b8ff279 | 1489 | } |
8996f767 | 1490 | configure_fd("null fd", nullfd, 0, 1); |
7b8ff279 MW |
1491 | atexit(cleanup); |
1492 | if (pipe(sig_pipe)) | |
1493 | lose("failed to create signal pipe: %s", strerror(errno)); | |
1494 | configure_fd("signal pipe (read end)", sig_pipe[0], 1, 1); | |
1495 | configure_fd("signal pipe (write end)", sig_pipe[1], 1, 1); | |
1496 | sigemptyset(&caught); sigemptyset(&pending); | |
1497 | set_signal_handler("SIGTERM", SIGTERM, SIGF_IGNOK); | |
1498 | set_signal_handler("SIGINT", SIGINT, SIGF_IGNOK); | |
1499 | set_signal_handler("SIGHUP", SIGHUP, SIGF_IGNOK); | |
1500 | set_signal_handler("SIGCHLD", SIGCHLD, 0); | |
1501 | ||
8996f767 | 1502 | /* Create the temporary directory and export it into the configuration. */ |
7b8ff279 | 1503 | set_tmpdir(); |
8996f767 | 1504 | config_set_var(&config, builtin, CF_LITERAL, "@%tmp-dir", tmpdir); |
7b8ff279 | 1505 | config_set_var(&config, builtin, 0, |
8996f767 MW |
1506 | "@tmp-dir", "${@BUILTIN:@%tmp-dir}/${@name}"); |
1507 | ||
1508 | /* Work out where the image files are going to go. If there's no `-O' | |
1509 | * option then we use the main `image-dir'. Otherwise what happens depends | |
1510 | * on whether this is a file or a directory. | |
1511 | */ | |
6c39ec6d | 1512 | if (!out) { |
8996f767 | 1513 | config_set_var(&config, builtin, 0, |
6c39ec6d MW |
1514 | "@image-link", "${@image-dir}/${image-file}"); |
1515 | var = config_find_var(&config, builtin, CF_INHERIT, "@image-dir"); | |
1516 | assert(var); out = config_subst_var_alloc(&config, builtin, var); | |
1517 | } else if (!stat(out, &st) && S_ISDIR(st.st_mode)) { | |
8996f767 MW |
1518 | config_set_var(&config, builtin, CF_LITERAL, "@%out-dir", out); |
1519 | config_set_var(&config, builtin, 0, | |
6c39ec6d | 1520 | "@image-link", "${@BUILTIN:@%out-dir}/${image-file}"); |
8996f767 MW |
1521 | } else if (argc - optind != 1) |
1522 | lose("can't dump multiple Lisps to a single output file"); | |
10427eb2 MW |
1523 | else if (flags&AF_JUNK) |
1524 | lose("can't clear junk in a single output file"); | |
1525 | else if (flags&AF_CLEAN) | |
1526 | lose("can't clean other images with a single output file"); | |
8996f767 | 1527 | else |
6c39ec6d | 1528 | config_set_var(&config, builtin, CF_LITERAL, "@image-link", out); |
7b8ff279 | 1529 | |
6c39ec6d MW |
1530 | /* Set the staging and versioned filenames. */ |
1531 | config_set_var(&config, builtin, 0, | |
1532 | "@image-out", "${@image-link}-${@hash}"); | |
8996f767 | 1533 | config_set_var(&config, builtin, 0, "@image-new", "${@image-out}.new"); |
6c39ec6d MW |
1534 | config_set_var(&config, builtin, 0, |
1535 | "@image-newlink", "${@image-link}.new"); | |
1536 | ||
1537 | config_set_var(&config, builtin, 0, "@script", | |
1538 | "${@ENV:RUNLISP_EVAL?" | |
1539 | "${@CONFIG:eval-script?" | |
1540 | "${@data-dir}/eval.lisp}}"); | |
1541 | ||
1542 | /* Configure an initial value for `@hash'. This is necessary so that | |
1543 | * `add_job' can expand `dump-image' to check that the command exists. | |
1544 | */ | |
1545 | config_set_var(&config, builtin, CF_LITERAL, "@hash", "!!!unset!!!"); | |
8996f767 MW |
1546 | |
1547 | /* Dump the final configuration if we're being very verbose. */ | |
7b8ff279 MW |
1548 | if (verbose >= 5) dump_config(); |
1549 | ||
10427eb2 MW |
1550 | /* There are a number of different strategies we might employ, depending on |
1551 | * the exact request. | |
1552 | * | |
1553 | * queue queue clear | |
1554 | * REMOVE CLEAN JUNK selected others junk? | |
1555 | * | |
1556 | * * nil nil ready/delete -- no | |
1557 | * * nil t ready/delete none yes | |
1558 | * nil t nil ready delete no | |
1559 | * nil t t ready -- yes | |
1560 | * t t nil -- delete no | |
1561 | * t t t -- -- yes | |
1562 | */ | |
1563 | ||
1564 | /* First step: if `AF_REMOVE' and `AF_CLEAN' are not both set, then scan | |
1565 | * the selected Lisp systems and add them to the appropriate queue. | |
1566 | * | |
1567 | * Bit-hack: if they are not both set, then their complements are not both | |
1568 | * clear. | |
1569 | */ | |
1570 | if (~flags&(AF_REMOVE | AF_CLEAN)) { | |
1571 | ||
1572 | /* Determine the flags for `add_job' when we select the Lisp systems. If | |
1573 | * we intend to clear junk then we must notice the image names we | |
1574 | * encounter. If we're supposed to check that Lisps exist before dumping | |
1575 | * then do that -- but it doesn't make any sense for deletion. | |
1576 | */ | |
1577 | f = flags&AF_REMOVE ? JQ_DELETE : JQ_READY; | |
1578 | if (flags&AF_JUNK) f |= JF_NOTICE; | |
1579 | if (flags&AF_CHECKINST) f |= JF_CHECKINST; | |
1580 | if (!(flags&(AF_FORCE | AF_REMOVE))) f |= JF_CHECKEXIST; | |
1581 | ||
1582 | /* If we have named Lisps, then process them. */ | |
1583 | if (!(flags&AF_ALL)) | |
1584 | for (i = optind; i < argc; i++) | |
1585 | add_named_job(f, argv[i], strlen(argv[i])); | |
1586 | ||
1587 | /* Otherwise we're supposed to dump `all' of them. If there's a `dump' | |
8996f767 MW |
1588 | * configuration setting then we need to parse that. Otherwise we just |
1589 | * try all of them. | |
1590 | */ | |
10427eb2 MW |
1591 | else { |
1592 | var = config_find_var(&config, toplevel, CF_INHERIT, "dump"); | |
1593 | if (!var) { | |
1594 | /* No setting. Just do all of the Lisps which look available. */ | |
1595 | ||
1596 | f |= JF_CHECKINST; | |
1597 | for (config_start_section_iter(&config, &si); | |
1598 | (sect = config_next_section(&si)); ) | |
1599 | add_job(f, sect); | |
1600 | } else { | |
1601 | /* Parse the `dump' list. */ | |
1602 | ||
1603 | dstr_reset(&d); config_subst_var(&config, toplevel, var, &d); | |
1604 | p = d.p; l = p + d.len; | |
1605 | for (;;) { | |
1606 | while (p < l && ISSPACE(*p)) p++; | |
1607 | if (p >= l) break; | |
1608 | q = p; | |
1609 | while (p < l && !ISSPACE(*p) && *p != ',') p++; | |
1610 | add_named_job(f, q, p - q); | |
1611 | while (p < l && ISSPACE(*p)) p++; | |
1612 | if (p < l && *p == ',') p++; | |
1613 | } | |
7b8ff279 MW |
1614 | } |
1615 | } | |
1616 | } | |
10427eb2 MW |
1617 | |
1618 | /* Second step: if exactly one of `AF_CLEAN' and `AF_JUNK' is set, then we | |
1619 | * need to scan all of the remaining Lisps and add them to the `delete' | |
1620 | * queue. | |
1621 | */ | |
1622 | if (!(flags&AF_CLEAN) != !(flags&AF_JUNK)) { | |
1623 | ||
1624 | /* Determine the flag settings. If we're junking, then we're not | |
1625 | * cleaning -- we just want to mark images belonging to other Lisps as | |
1626 | * off-limits to the junking scan. | |
1627 | */ | |
1628 | f = flags&AF_CLEAN ? JQ_DELETE : JQ_NONE | JF_NOTICE; | |
1629 | ||
1630 | /* Now scan the Lisp systems. */ | |
1631 | for (config_start_section_iter(&config, &si); | |
1632 | (sect = config_next_section(&si)); ) | |
1633 | add_job(f, sect); | |
1634 | } | |
1635 | ||
1636 | /* Terminate the job queues. */ | |
1637 | *job_ready_tail = 0; | |
1638 | *job_delete_tail = 0; | |
7b8ff279 | 1639 | |
8996f767 | 1640 | /* Report on what it is we're about to do. */ |
7b8ff279 | 1641 | if (verbose >= 3) { |
10427eb2 MW |
1642 | show_job_list("dumping Lisp images", job_ready); |
1643 | show_job_list("deleting Lisp images", job_delete); | |
7b8ff279 MW |
1644 | } |
1645 | ||
10427eb2 MW |
1646 | /* If there turns out to be nothing to do, then mention this. */ |
1647 | if (!(flags&AF_REMOVE) && verbose >= 2 && !job_ready) | |
1648 | moan("no Lisp images to dump"); | |
7b8ff279 | 1649 | |
10427eb2 | 1650 | /* Run the dumping jobs. */ |
8996f767 | 1651 | run_jobs(); |
7b8ff279 | 1652 | |
10427eb2 MW |
1653 | /* Check for any last signals. If we hit any fatal signals then we should |
1654 | * kill ourselves so that the exit status will be right. | |
8996f767 | 1655 | */ |
7b8ff279 MW |
1656 | check_signals(); |
1657 | if (sigloss) { cleanup(); signal(sigloss, SIG_DFL); raise(sigloss); } | |
1658 | ||
10427eb2 MW |
1659 | /* Now delete Lisps which need deleting. */ |
1660 | while (job_delete) { | |
1661 | job = job_delete; job_delete = job->next; | |
1662 | if (flags&AF_DRYRUN) { | |
1663 | if (verbose >= 2) | |
6c39ec6d MW |
1664 | moan("not deleting `%s' image link `%s' (dry run)", |
1665 | JOB_NAME(job), job->imglink); | |
1666 | if (job->oldimg && verbose >= 2) | |
10427eb2 | 1667 | moan("not deleting `%s' image `%s' (dry run)", |
6c39ec6d | 1668 | JOB_NAME(job), job->oldimg); |
10427eb2 MW |
1669 | } else { |
1670 | if (verbose >= 2) | |
6af30eee | 1671 | moan("deleting `%s' image `%s'", |
6c39ec6d MW |
1672 | JOB_NAME(job), job->imglink); |
1673 | if (unlink(job->imglink) && errno != ENOENT) | |
1674 | bad("failed to delete `%s' image link `%s': %s", | |
1675 | JOB_NAME(job), job->imglink, strerror(errno)); | |
1676 | if (job->oldimg && unlink(job->oldimg) && errno != ENOENT) | |
10427eb2 | 1677 | bad("failed to delete `%s' image `%s': %s", |
6c39ec6d | 1678 | JOB_NAME(job), job->oldimg, strerror(errno)); |
10427eb2 MW |
1679 | } |
1680 | } | |
1681 | ||
1682 | /* Finally, maybe delete all of the junk files in the image directory. */ | |
1683 | if (flags&AF_JUNK) { | |
10427eb2 MW |
1684 | dir = opendir(out); |
1685 | if (!dir) | |
1686 | lose("failed to open image directory `%s': %s", out, strerror(errno)); | |
1687 | dstr_reset(&d); | |
1688 | dstr_puts(&d, out); dstr_putc(&d, '/'); o = d.len; | |
1689 | if (verbose >= 2) | |
1690 | moan("cleaning up junk in image directory `%s'", out); | |
1691 | for (;;) { | |
1692 | de = readdir(dir); if (!de) break; | |
1693 | if (de->d_name[0] == '.' && | |
1694 | (!de->d_name[1] || (de->d_name[1] == '.' && !de->d_name[2]))) | |
1695 | continue; | |
1696 | n = strlen(de->d_name); | |
1697 | d.len = o; dstr_putm(&d, de->d_name, n + 1); | |
1698 | if (!treap_lookup(&good, de->d_name, n)) { | |
1699 | if (flags&AF_DRYRUN) { | |
1700 | if (verbose >= 2) | |
1701 | moan("not deleting junk file `%s' (dry run)", d.p); | |
1702 | } else { | |
1703 | if (verbose >= 2) | |
1704 | moan("deleting junk file `%s'", d.p); | |
1705 | if (unlink(d.p) && errno != ENOENT) | |
1706 | bad("failed to delete junk file `%s': %s", d.p, strerror(errno)); | |
1707 | } | |
1708 | } | |
1709 | } | |
1710 | } | |
1711 | ||
8996f767 | 1712 | /* All done! */ |
7b8ff279 MW |
1713 | return (rc); |
1714 | } | |
1715 | ||
1716 | /*----- That's all, folks -------------------------------------------------*/ |