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); | |
550 | } | |
551 | } | |
552 | ||
553 | /* There are basically two kinds of jobs. | |
554 | * | |
555 | * An `internal' job -- state `JST_INTERN' -- can be handled entirely within | |
556 | * this process. Internal jobs have trivial lifecycles: they're created, put | |
557 | * on a queue, executed, and thrown away. Jobs are executed when some code | |
558 | * decides to walk the appropriate queue and do the work. As a result, they | |
559 | * don't need to have distinctive states: `JST_INTERN' only exists to | |
560 | * distinguish internal jobs from active ones if they somehow manage to end | |
561 | * up in the external-job machinery. | |
562 | * | |
563 | * External jobs all work in basically the same way: we fork and exec a | |
564 | * sequence of subprocess to do the work. The majority of handling external | |
565 | * jobs is in the care and feeding of these subprocesses, so they end up on | |
566 | * various lists primarily concerned with the state of the subprocesses, and | |
567 | * the progress of the job through its sequence of subprocesses is recorded | |
568 | * in the job's `st' field. | |
569 | * | |
570 | * External jobs have a comparatively complicated lifecycle. | |
571 | * | |
572 | * * Initially, the job is on the `ready' queue by `add_job'. It has no | |
573 | * child process or log file. | |
574 | * | |
575 | * * At some point, `start_jobs' decides to start this job up: a log file | |
576 | * is created (if the job doesn't have one already), a child process is | |
577 | * forked, and pipes are set up to capture the child's output. It gets | |
578 | * moved to the `run' list (which is not maintained in any particular | |
579 | * order). Jobs on the `run' list participate in the main select(2) | |
580 | * loop. | |
581 | * | |
582 | * * When the job's child process dies and the pipes capturing its output | |
583 | * streams finally dry up, the job is considered finished. What happens | |
584 | * next depends on its state: either it gets updated somehow, and pushed | |
585 | * back onto the end of the `ready' queue so that another child can be | |
586 | * started, or the job is finished and dies. | |
587 | * | |
588 | * The counter `nrun' counts the number of actually running jobs, i.e., those | |
589 | * with living child processes. This doesn't simply count the number of jobs | |
590 | * on the `run' list: remember that the latter also contains jobs whose child | |
591 | * has died, but whose output has not yet been collected. | |
592 | */ | |
593 | ||
10427eb2 | 594 | /* Consider a Lisp system description and maybe add a job to the right queue. |
8996f767 | 595 | * |
10427eb2 MW |
596 | * The Lisp system is described by the configuration section SECT. Most of |
597 | * the function is spent on inspecting this section for suitability and | |
598 | * deciding what to do about it. | |
8996f767 | 599 | * |
10427eb2 MW |
600 | * The precise behaviour depends on F, which should be the bitwise-OR of a |
601 | * `JQ_...' constant and zero or more flags, as follows. | |
602 | * | |
603 | * * The bits covered by `JMASK_QUEUE' identify which queue the job should | |
604 | * be added to if the section defines a cromulent Lisp system: | |
605 | * | |
606 | * -- `JQ_NONE' -- don't actually make a job at all; | |
607 | * -- `JQ_READY' -- add the Lisp to the `job_ready' queue, so we'll; or | |
608 | * -- `JQ_DELETE' -- add the Lisp to the `job_delete' queue. | |
609 | * | |
610 | * * `JF_PICKY': The user identified this Lisp system explicitly, so | |
611 | * complain if the configuration section doesn't look right. This is | |
612 | * clear if the caller is just enumerating all of the configuration | |
613 | * sections: without this feature, we'd be checking everything twice, | |
614 | * which (a) is inefficient, and -- more importantly -- (b) could lead to | |
615 | * problems if the two checks are inconsistent. | |
616 | * | |
617 | * * `JF_CHECKINST': Ignore this Lisp if `AF_CHECKINST' is set and it's not | |
618 | * actually installed. (This is usually set for `JQ_READY' calls, so | |
619 | * that we don't try to dump Lisps which aren't there, but clear for | |
620 | * `JQ_DELETE' calls so that we clear out Lisps which have gone away.) | |
621 | * | |
622 | * * `JF_CHECKEXIST': Ignore this Lisp if its image file already exists. | |
623 | * | |
624 | * * `JF_NOTICE': Record the Lisp's image basename in the `good' treap so | |
625 | * that we can identify everything else we find in the image directory as | |
626 | * junk. | |
8996f767 | 627 | */ |
10427eb2 MW |
628 | #define JMASK_QUEUE 3u /* which queue to add good Lisp to */ |
629 | #define JQ_NONE 0u /* don't add to any queue */ | |
630 | #define JQ_READY 1u /* `job_ready' */ | |
631 | #define JQ_DELETE 2u /* `job_delete' */ | |
632 | #define JF_PICKY 4u /* lose if section isn't Lisp defn */ | |
633 | #define JF_CHECKINST 8u /* maybe check Lisp is installed */ | |
634 | #define JF_CHECKEXIST 16u /* skip if image already exists */ | |
635 | #define JF_NOTICE 32u /* record Lisp's image basename */ | |
636 | ||
637 | #define JADD_NAMED (JQ_READY | JF_PICKY | JF_CHECKINST) | |
638 | #define JADD_DEFAULT (JQ_READY | JF_CHECKINST) | |
639 | #define JADD_CLEANUP (JQ_DELETE) | |
640 | #define JADD_NOTICE (JQ_NONE) | |
641 | static void add_job(unsigned f, struct config_section *sect) | |
7b8ff279 | 642 | { |
10427eb2 MW |
643 | const char *name; |
644 | struct job *job, ***tail; | |
6c39ec6d MW |
645 | struct treap_path jobpath; |
646 | struct config_var *dumpvar, *runvar, *imgvar; | |
647 | struct dstr d = DSTR_INIT, dd = DSTR_INIT; | |
648 | struct argv av_version = ARGV_INIT, av_dump = ARGV_INIT; | |
649 | struct stat st; | |
650 | char *imgnewlink = 0, *imglink = 0, *oldimg = 0, *p; | |
651 | unsigned jst; | |
10427eb2 | 652 | size_t i, len; |
6c39ec6d | 653 | ssize_t n; |
7b8ff279 MW |
654 | unsigned fef; |
655 | ||
10427eb2 MW |
656 | /* We'll want the section's name for all sorts of things. */ |
657 | name = CONFIG_SECTION_NAME(sect); | |
658 | len = CONFIG_SECTION_NAMELEN(sect); | |
659 | ||
660 | /* Check to see whether this Lisp system is already queued up. | |
661 | * | |
662 | * We'll get around to adding the new job node to the treap right at the | |
663 | * end, so use a separate path object to keep track of where to put it. | |
664 | */ | |
665 | job = treap_probe(&jobs, name, len, &jobpath); | |
7b8ff279 | 666 | if (job) { |
10427eb2 | 667 | if ((f&JF_PICKY) && verbose >= 1) |
7b8ff279 | 668 | moan("ignoring duplicate Lisp `%s'", JOB_NAME(job)); |
10427eb2 | 669 | goto end; |
7b8ff279 MW |
670 | } |
671 | ||
10427eb2 MW |
672 | /* Check that the section defines a Lisp, and that it can be dumped. |
673 | * | |
674 | * It's not obvious that this is right. Maybe there should be some | |
675 | * additional flag so that we don't check dumpability if we're planning to | |
676 | * delete the image. But it /is/ right: since the thing which tells us | |
677 | * whether we can dump is that the section tells us the image's name, if | |
678 | * it can't be dumped then we won't know what file to delete! So we have | |
679 | * no choice. | |
8996f767 | 680 | */ |
6c39ec6d MW |
681 | runvar = config_find_var(&config, sect, CF_INHERIT, "run-script"); |
682 | if (!runvar) { | |
10427eb2 MW |
683 | if (f&JF_PICKY) lose("unknown Lisp implementation `%s'", name); |
684 | else if (verbose >= 3) moan("skipping non-Lisp section `%s'", name); | |
685 | goto end; | |
686 | } | |
687 | imgvar = config_find_var(&config, sect, CF_INHERIT, "image-file"); | |
688 | if (!imgvar) { | |
689 | if (f&JF_PICKY) | |
690 | lose("Lisp implementation `%s' doesn't use custom images", name); | |
691 | else if (verbose >= 3) | |
692 | moan("skipping Lisp `%s': no custom image support", name); | |
7b8ff279 MW |
693 | goto end; |
694 | } | |
7b8ff279 | 695 | |
8996f767 | 696 | /* Check that the other necessary variables are present. */ |
10427eb2 MW |
697 | dumpvar = config_find_var(&config, sect, CF_INHERIT, "dump-image"); |
698 | if (!dumpvar) | |
699 | lose("variable `dump-image' not defined for Lisp `%s'", name); | |
8996f767 | 700 | |
6c39ec6d MW |
701 | /* Build the job's command lines. */ |
702 | config_subst_split_var(&config, sect, runvar, &av_version); | |
703 | if (!av_version.n) | |
704 | lose("empty `run-script' command for Lisp implementation `%s'", name); | |
705 | argv_append(&av_version, xstrdup("?(lisp-implementation-version)")); | |
706 | config_subst_split_var(&config, sect, dumpvar, &av_dump); | |
707 | if (!av_dump.n) | |
8996f767 MW |
708 | lose("empty `dump-image' command for Lisp implementation `%s'", name); |
709 | ||
710 | /* If we're supposed to check that the Lisp exists before proceeding then | |
711 | * do that. There are /two/ commands to check: the basic Lisp command, | |
712 | * /and/ the command to actually do the dumping, which might not be the | |
713 | * same thing. (Be careful not to check the same command twice, though, | |
714 | * because that would cause us to spam the user with redundant | |
715 | * diagnostics.) | |
716 | */ | |
10427eb2 | 717 | if ((f&JF_CHECKINST) && (flags&AF_CHECKINST)) { |
10427eb2 | 718 | fef = (verbose >= 3 ? FEF_VERBOSE : 0); |
6c39ec6d | 719 | if (!found_in_path_p(av_version.v[0], fef)) { |
10427eb2 MW |
720 | if (verbose >= 3) |
721 | moan("skipping Lisp `%s': can't find Lisp command `%s'", | |
6c39ec6d | 722 | name, av_version.v[0]); |
10427eb2 MW |
723 | goto end; |
724 | } | |
6c39ec6d MW |
725 | if (STRCMP(av_version.v[0], !=, av_dump.v[0]) && |
726 | !found_in_path_p(av_dump.v[0], fef)) { | |
727 | if (verbose >= 3) | |
10427eb2 | 728 | moan("skipping Lisp `%s': can't find dump command `%s'", |
6c39ec6d | 729 | av_dump.v[0], d.p); |
7b8ff279 MW |
730 | goto end; |
731 | } | |
732 | } | |
733 | ||
6c39ec6d MW |
734 | /* Collect the output image file names. */ |
735 | imglink = | |
736 | config_subst_string_alloc(&config, sect, "<internal>", "${@image-link}"); | |
737 | imgnewlink = | |
738 | config_subst_string_alloc(&config, sect, | |
739 | "<internal>", "${@image-newlink}"); | |
740 | ||
741 | /* Determine the image link basename. If necessary, record it so that it | |
742 | * doesn't get junked. | |
10427eb2 | 743 | */ |
6c39ec6d MW |
744 | dstr_reset(&dd); config_subst_var(&config, sect, imgvar, &dd); |
745 | if (f&JF_NOTICE) notice_filename(dd.p, dd.len); | |
10427eb2 | 746 | |
6c39ec6d MW |
747 | /* Fill in the directory name for the output image. */ |
748 | dstr_reset(&d); | |
749 | p = strrchr(imglink, '/'); | |
750 | if (p) dstr_putm(&d, imglink, p + 1 - imglink); | |
8996f767 | 751 | |
6c39ec6d MW |
752 | /* Inspect the existing image link if there is one, and record its |
753 | * destination. | |
8996f767 | 754 | */ |
6c39ec6d MW |
755 | for (;;) { |
756 | ||
757 | /* Read the link destination. The `lstat'/`readlink' two-step is | |
758 | * suggested by the POSIX specification. | |
759 | */ | |
760 | if (lstat(imglink, &st)) { | |
761 | if (verbose >= (errno == ENOENT ? 3 : 1)) | |
762 | moan("failed to read metadata for Lisp `%s' image link `%s': %s", | |
763 | name, imglink, strerror(errno)); | |
764 | break; | |
765 | } | |
766 | if (!S_ISLNK(st.st_mode)) { | |
767 | if (verbose >= 1) | |
768 | moan("Lisp `%s' image link `%s' isn't a symbolic link", | |
769 | name, imglink); | |
770 | break; | |
771 | } | |
772 | dstr_ensure(&d, st.st_size + 1); | |
773 | n = readlink(imglink, d.p + d.len, d.sz - d.len); | |
774 | if (n < 0) { | |
775 | moan("failed to read Lisp `%s' image link `%s': %s", | |
776 | name, imglink, strerror(errno)); | |
777 | break; | |
778 | } | |
779 | if (n == d.sz - d.len) continue; | |
780 | ||
781 | /* Check that the link has the right form. (We don't want to delete the | |
782 | * referent if it's not actually our image.) | |
783 | * | |
784 | * We expect the referent to look like ${image-file} followed by a hyphen | |
785 | * and some hex digits. | |
786 | */ | |
787 | if (n <= dd.len || | |
788 | STRNCMP(d.p + d.len, !=, dd.p, dd.len) || | |
789 | d.p[d.len + dd.len] != '-' || | |
790 | !hex_digits_p(d.p + (d.len + dd.len + 1), n - (dd.len + 1))) { | |
791 | if (verbose >= 1) | |
792 | moan("Lisp `%s' image link `%s' has unexpected referent `%s'", | |
793 | name, imglink, d.p); | |
794 | break; | |
7b8ff279 | 795 | } |
6c39ec6d MW |
796 | |
797 | /* OK, so it looks legit. Protect it from being junked. */ | |
798 | if (f&JF_NOTICE) notice_filename(d.p + d.len, n); | |
799 | d.p[d.len + n] = 0; d.len += n; | |
800 | oldimg = xstrndup(d.p, d.len); | |
801 | break; | |
7b8ff279 MW |
802 | } |
803 | ||
8996f767 MW |
804 | /* All preflight checks complete. Build the job and hook it onto the end |
805 | * of the list. (Steal the command-line vector so that we don't try to | |
806 | * free it during cleanup.) | |
807 | */ | |
10427eb2 | 808 | switch (f&JMASK_QUEUE) { |
6c39ec6d MW |
809 | case JQ_NONE: jst = JST_INTERN; tail = 0; break; |
810 | case JQ_READY: jst = JST_VERSION; tail = &job_ready_tail; break; | |
811 | case JQ_DELETE: jst = JST_INTERN; tail = &job_delete_tail; break; | |
10427eb2 MW |
812 | default: assert(0); |
813 | } | |
7b8ff279 | 814 | job = xmalloc(sizeof(*job)); |
6c39ec6d | 815 | job->st = jst; job->sect = sect; job->dumpvar = dumpvar; |
10427eb2 | 816 | job->kid = -1; job->log = 0; |
7b8ff279 MW |
817 | job->out.fd = -1; job->out.buf = 0; |
818 | job->err.fd = -1; job->err.buf = 0; | |
6c39ec6d MW |
819 | job->av_version = av_version; argv_init(&av_version); |
820 | argv_init(&job->av_dump); | |
821 | job->imgnew = 0; job->imghash = 0; | |
822 | job->imgnewlink = imgnewlink; imgnewlink = 0; | |
823 | job->imglink = imglink; imglink = 0; | |
824 | job->oldimg = oldimg; oldimg = 0; | |
10427eb2 MW |
825 | treap_insert(&jobs, &jobpath, &job->_node, name, len); |
826 | if (tail) { **tail = job; *tail = &job->next; } | |
8996f767 | 827 | |
7b8ff279 | 828 | end: |
8996f767 | 829 | /* All done. Cleanup time. */ |
6c39ec6d MW |
830 | for (i = 0; i < av_version.n; i++) free(av_version.v[i]); |
831 | for (i = 0; i < av_dump.n; i++) free(av_dump.v[i]); | |
832 | free(imgnewlink); free(imglink); free(oldimg); | |
833 | dstr_release(&d); dstr_release(&dd); | |
834 | argv_release(&av_version); argv_release(&av_dump); | |
7b8ff279 MW |
835 | } |
836 | ||
10427eb2 MW |
837 | /* As `add_job' above, but look the Lisp implementation up by name. |
838 | * | |
839 | * The flags passed to `add_job' are augmented with `JF_PICKY' because this | |
840 | * is an explicitly-named Lisp implementation. | |
841 | */ | |
842 | static void add_named_job(unsigned f, const char *name, size_t len) | |
843 | { | |
844 | struct config_section *sect; | |
845 | ||
846 | sect = config_find_section_n(&config, 0, name, len); | |
847 | if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name); | |
848 | add_job(f | JF_PICKY, sect); | |
849 | } | |
850 | ||
8996f767 MW |
851 | /* Free the JOB and all the resources it holds. |
852 | * | |
853 | * Close the pipes; kill the child process. Everything must go. | |
854 | */ | |
7b8ff279 MW |
855 | static void release_job(struct job *job) |
856 | { | |
8996f767 | 857 | size_t i; |
10427eb2 | 858 | struct job *j; |
8996f767 | 859 | |
7b8ff279 MW |
860 | if (job->kid > 0) kill(job->kid, SIGKILL); /* ?? */ |
861 | if (job->log && job->log != stdout) fclose(job->log); | |
6c39ec6d MW |
862 | free(job->imgnew); free(job->imghash); |
863 | free(job->imglink); free(job->imgnewlink); | |
864 | free(job->oldimg); | |
865 | for (i = 0; i < job->av_version.n; i++) free(job->av_version.v[i]); | |
866 | for (i = 0; i < job->av_dump.n; i++) free(job->av_dump.v[i]); | |
867 | argv_release(&job->av_version); argv_release(&job->av_dump); | |
7b8ff279 MW |
868 | free(job->out.buf); if (job->out.fd >= 0) close(job->out.fd); |
869 | free(job->err.buf); if (job->err.fd >= 0) close(job->err.fd); | |
10427eb2 | 870 | j = treap_remove(&jobs, JOB_NAME(job), JOB_NAMELEN(job)); assert(j == job); |
7b8ff279 MW |
871 | free(job); |
872 | } | |
873 | ||
8996f767 MW |
874 | /* Do all the necessary things when JOB finishes (successfully or not). |
875 | * | |
6c39ec6d MW |
876 | * Eventually the job is either freed (using `release_job'), or updated and |
877 | * stuffed back into the `job_run' queue. The caller is expected to have | |
878 | * already unlinked the job from its current list. | |
8996f767 | 879 | */ |
7b8ff279 MW |
880 | static void finish_job(struct job *job) |
881 | { | |
6c39ec6d MW |
882 | char buf[16483], *p; |
883 | unsigned char *hbuf; | |
884 | struct dstr d = DSTR_INIT; | |
885 | size_t i, n; | |
7b8ff279 MW |
886 | int ok = 0; |
887 | ||
8996f767 MW |
888 | /* Start a final line to the job log describing its eventual fate. |
889 | * | |
890 | * This is where we actually pick apart the exit status. Set `ok' if it | |
891 | * actually succeeded, because that's all anything else cares about. | |
892 | */ | |
7b8ff279 MW |
893 | fprintf(job->log, "%-13s > ", JOB_NAME(job)); |
894 | if (WIFEXITED(job->exit)) { | |
895 | if (!WEXITSTATUS(job->exit)) | |
896 | { fputs("completed successfully\n", job->log); ok = 1; } | |
897 | else | |
898 | fprintf(job->log, "failed with exit status %d\n", | |
899 | WEXITSTATUS(job->exit)); | |
900 | } else if (WIFSIGNALED(job->exit)) | |
901 | fprintf(job->log, "killed by signal %d (%s%s)", WTERMSIG(job->exit), | |
902 | #if defined(HAVE_STRSIGNAL) | |
903 | strsignal(WTERMSIG(job->exit)), | |
904 | #elif defined(HAVE_DECL_SYS_SIGLIST) | |
905 | sys_siglist[WTERMSIG(job->exit)], | |
906 | #else | |
907 | "unknown signal", | |
908 | #endif | |
909 | #ifdef WCOREDUMP | |
910 | WCOREDUMP(job->exit) ? "; core dumped" : | |
911 | #endif | |
912 | ""); | |
8996f767 MW |
913 | else |
914 | fprintf(job->log, "exited with incomprehensible status %06o\n", | |
915 | job->exit); | |
7b8ff279 | 916 | |
6c39ec6d MW |
917 | /* What happens next depends on the state of the job. This is the main |
918 | * place which advanced the job state machine. | |
8996f767 | 919 | */ |
6c39ec6d MW |
920 | if (ok) switch (job->st) { |
921 | ||
922 | case JST_VERSION: | |
923 | /* We've retrieved the Lisp system's version string. */ | |
924 | ||
925 | /* Complete the hashing and convert to hex. */ | |
926 | hbuf = (unsigned char *)buf + 32; sha256_done(&job->h, hbuf); | |
927 | for (i = 0; i < 8; i++) sprintf(buf + 2*i, "%02x", hbuf[i]); | |
928 | if (verbose >= 2) | |
929 | moan("Lisp `%s' version hash = %s", JOB_NAME(job), buf); | |
930 | ||
931 | /* Determine the final version-qualified name for the image. */ | |
932 | config_set_var(&config, job->sect, CF_LITERAL, "@hash", buf); | |
933 | job->imghash = | |
934 | config_subst_string_alloc(&config, job->sect, | |
935 | "<internal>", "${@image-out}"); | |
936 | job->imgnew = | |
937 | config_subst_string_alloc(&config, job->sect, | |
938 | "<internal>", "${@image-new}"); | |
939 | ||
940 | /* Determine the basename of the final image. */ | |
941 | p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash; | |
942 | ||
943 | /* Inspect the current link pointer to see if we have the right | |
944 | * version. | |
945 | */ | |
946 | if (!(flags&AF_FORCE) && | |
947 | job->oldimg && | |
948 | STRCMP(job->oldimg, ==, job->imghash) && | |
949 | !access(job->oldimg, F_OK)) { | |
950 | if (verbose >= 2) | |
951 | moan("Lisp `%s' image `%s' already up-to-date", | |
952 | JOB_NAME(job), job->imghash); | |
953 | break; | |
954 | } | |
955 | ||
956 | /* Make sure that there's a clear space for the new image to be | |
957 | * written. | |
958 | */ | |
959 | if (!(flags&AF_DRYRUN) && unlink(job->imgnew) && errno != ENOENT) { | |
960 | bad("failed to clear Lisp `%s' image staging path `%s': %s", | |
961 | JOB_NAME(job), job->imgnew, strerror(errno)); | |
962 | break; | |
963 | } | |
964 | ||
965 | /* If we're still here then we've decided to dump a new image. Update | |
966 | * the job state, and put it back on the run queue. | |
967 | */ | |
968 | config_subst_split_var(&config, job->sect, | |
969 | job->dumpvar, &job->av_dump); | |
970 | assert(job->av_dump.n); | |
971 | job->st = JST_DUMP; | |
972 | *job_ready_tail = job; job_ready_tail = &job->next; job->next = 0; | |
973 | job = 0; | |
974 | break; | |
975 | ||
976 | case JST_DUMP: | |
977 | /* We've finished dumping a custom image. It's time to apply the | |
978 | * finishing touches. | |
979 | */ | |
980 | ||
981 | /* Rename the image into place. If this fails, blame it on the dump | |
982 | * job, because the chances are good that it failed to produce the | |
983 | * image properly. | |
984 | */ | |
985 | if (rename(job->imgnew, job->imghash)) { | |
986 | fprintf(job->log, "%-13s > failed to rename Lisp `%s' " | |
987 | "output image `%s' to `%s': %s", | |
988 | JOB_NAME(job), JOB_NAME(job), | |
989 | job->imgnew, job->imghash, strerror(errno)); | |
990 | ok = 0; break; | |
991 | } | |
992 | ||
993 | /* Determine the basename of the final image. */ | |
994 | p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash; | |
995 | ||
996 | /* Build the symlink. Start by setting the link in the staging path, | |
997 | * and then rename, in order to ensure continuity. | |
998 | */ | |
999 | if (unlink(job->imgnewlink) && errno != ENOENT) { | |
1000 | bad("failed to clear Lisp `%s' link staging path `%s': %s", | |
1001 | JOB_NAME(job), job->imgnewlink, strerror(errno)); | |
1002 | break; | |
1003 | } | |
1004 | if (symlink(p, job->imgnewlink)) { | |
1005 | bad("failed to create Lisp `%s' image link `%s': %s", | |
1006 | JOB_NAME(job), job->imgnewlink, strerror(errno)); | |
1007 | break; | |
1008 | } | |
1009 | if (rename(job->imgnewlink, job->imglink)) { | |
1010 | bad("failed to rename Lisp `%s' image link `%s' to `%s': %s", | |
1011 | JOB_NAME(job), job->imgnewlink, job->imglink, strerror(errno)); | |
1012 | break; | |
1013 | } | |
1014 | if (job->oldimg && STRCMP(job->oldimg, !=, job->imghash) && | |
1015 | unlink(job->oldimg) && errno != ENOENT) { | |
1016 | if (verbose >= 1) | |
1017 | moan("failed to delete old Lisp `%s' image `%s': %s", | |
1018 | JOB_NAME(job), job->oldimg, strerror(errno)); | |
1019 | } | |
1020 | ||
1021 | /* I think we're all done. */ | |
1022 | break; | |
1023 | ||
1024 | default: | |
1025 | assert(0); | |
7b8ff279 MW |
1026 | } |
1027 | ||
8996f767 MW |
1028 | /* If the job failed and we're being quiet then write out the log that we |
1029 | * made. | |
1030 | */ | |
1031 | if (!ok && verbose < 2) { | |
1032 | rewind(job->log); | |
1033 | for (;;) { | |
1034 | n = fread(buf, 1, sizeof(buf), job->log); | |
1035 | if (n) fwrite(buf, 1, n, stdout); | |
1036 | if (n < sizeof(buf)) break; | |
1037 | } | |
7b8ff279 | 1038 | } |
7b8ff279 | 1039 | |
8996f767 MW |
1040 | /* Also make a node to stderr about what happened. (Just to make sure |
1041 | * that we've gotten someone's attention.) | |
1042 | */ | |
1043 | if (!ok) bad("failed to dump Lisp `%s'", JOB_NAME(job)); | |
7b8ff279 | 1044 | |
8996f767 | 1045 | /* Finally free the job control block. */ |
6c39ec6d MW |
1046 | if (job) release_job(job); |
1047 | dstr_release(&d); | |
7b8ff279 MW |
1048 | } |
1049 | ||
8996f767 | 1050 | /* Called after `SIGCHLD': collect exit statuses and mark jobs as dead. */ |
7b8ff279 MW |
1051 | static void reap_children(void) |
1052 | { | |
6c39ec6d | 1053 | struct job *job; |
7b8ff279 MW |
1054 | pid_t kid; |
1055 | int st; | |
1056 | ||
1057 | for (;;) { | |
8996f767 MW |
1058 | |
1059 | /* Collect a child exit status. If there aren't any more then we're | |
1060 | * done. | |
1061 | */ | |
7b8ff279 MW |
1062 | kid = waitpid(0, &st, WNOHANG); |
1063 | if (kid <= 0) break; | |
8996f767 MW |
1064 | |
1065 | /* Try to find a matching job. If we can't, then we should just ignore | |
1066 | * it. | |
1067 | */ | |
6c39ec6d | 1068 | for (job = job_run; job; job = job->next) |
7b8ff279 | 1069 | if (job->kid == kid) goto found; |
7b8ff279 | 1070 | continue; |
8996f767 | 1071 | |
7b8ff279 | 1072 | found: |
6c39ec6d MW |
1073 | /* Mark the job as dead, and save its exit status. */ |
1074 | job->exit = st; job->kid = -1; nrun--; | |
7b8ff279 | 1075 | } |
8996f767 MW |
1076 | |
1077 | /* If there was a problem with waitpid(2) then report it. */ | |
7b8ff279 MW |
1078 | if (kid < 0 && errno != ECHILD) |
1079 | lose("failed to collect child process exit status: %s", strerror(errno)); | |
1080 | } | |
1081 | ||
8996f767 | 1082 | /* Execute the handler for some JOB. */ |
6c39ec6d | 1083 | static NORETURN void job_child(struct job *job, struct argv *av) |
7b8ff279 | 1084 | { |
6c39ec6d MW |
1085 | try_exec(av, 0); |
1086 | moan("failed to run `%s': %s", av->v[0], strerror(errno)); | |
8996f767 | 1087 | _exit(127); |
7b8ff279 MW |
1088 | } |
1089 | ||
8996f767 MW |
1090 | /* Start up jobs while there are (a) jobs to run and (b) slots to run them |
1091 | * in. | |
1092 | */ | |
7b8ff279 MW |
1093 | static void start_jobs(void) |
1094 | { | |
1095 | struct dstr d = DSTR_INIT; | |
1096 | int p_out[2], p_err[2]; | |
1097 | struct job *job; | |
6c39ec6d | 1098 | struct argv *av; |
7b8ff279 MW |
1099 | pid_t kid; |
1100 | ||
8996f767 MW |
1101 | /* Keep going until either we run out of jobs, or we've got enough running |
1102 | * already. | |
1103 | */ | |
7b8ff279 | 1104 | while (job_ready && nrun < maxrun) { |
8996f767 MW |
1105 | |
1106 | /* Set things up ready. If things go wrong, we need to know what stuff | |
1107 | * needs to be cleaned up. | |
1108 | */ | |
7b8ff279 | 1109 | job = job_ready; job_ready = job->next; |
6c39ec6d | 1110 | if (!job_ready) job_ready_tail = &job_ready; |
7b8ff279 | 1111 | p_out[0] = p_out[1] = p_err[0] = p_err[1] = -1; |
8996f767 | 1112 | |
6c39ec6d MW |
1113 | /* Figure out what to do. */ |
1114 | switch (job->st) { | |
1115 | case JST_VERSION: av = &job->av_version; break; | |
1116 | case JST_DUMP: av = &job->av_dump; break; | |
1117 | default: assert(0); | |
1118 | } | |
1119 | ||
10427eb2 | 1120 | /* If we're not actually going to do anything, now is the time to not do |
6c39ec6d | 1121 | * that. We should do the version-hashing step unconditionally. |
10427eb2 | 1122 | */ |
6c39ec6d MW |
1123 | switch (job->st) { |
1124 | case JST_VERSION: | |
1125 | break; | |
1126 | case JST_DUMP: | |
1127 | if (flags&AF_DRYRUN) { | |
1128 | if (try_exec(av, | |
1129 | TEF_DRYRUN | | |
1130 | (verbose >= 2 && !(flags&AF_CHECKINST) | |
1131 | ? TEF_VERBOSE : 0))) | |
1132 | rc = 127; | |
1133 | else if (verbose >= 2) | |
1134 | printf("%-13s > not dumping `%s' (dry run)\n", | |
1135 | JOB_NAME(job), JOB_NAME(job)); | |
1136 | release_job(job); | |
1137 | continue; | |
1138 | } | |
1139 | break; | |
1140 | default: | |
1141 | assert(0); | |
10427eb2 MW |
1142 | } |
1143 | ||
6c39ec6d MW |
1144 | /* Do one-time setup for external jobs. */ |
1145 | if (!job->log) { | |
8996f767 | 1146 | |
6c39ec6d MW |
1147 | /* Make a temporary subdirectory for this job to use. */ |
1148 | dstr_reset(&d); dstr_putf(&d, "%s/%s", tmpdir, JOB_NAME(job)); | |
1149 | if (mkdir(d.p, 0700)) { | |
1150 | bad("failed to create working directory for job `%s': %s", | |
1151 | JOB_NAME(job), strerror(errno)); | |
1152 | goto fail; | |
1153 | } | |
1154 | ||
1155 | /* Create the job's log file. If we're being verbose then that's just | |
1156 | * our normal standard output -- /not/ stderr: it's likely that users | |
1157 | * will want to pipe this stuff through a pager or something, and | |
1158 | * that'll be easier if we use stdout. Otherwise, make a file in the | |
1159 | * temporary directory. | |
1160 | */ | |
1161 | if (verbose >= 2) | |
1162 | job->log = stdout; | |
1163 | else { | |
1164 | dstr_puts(&d, "/log"); job->log = fopen(d.p, "w+"); | |
1165 | if (!job->log) | |
1166 | lose("failed to open log file `%s': %s", d.p, strerror(errno)); | |
1167 | } | |
7b8ff279 | 1168 | } |
8996f767 MW |
1169 | |
1170 | /* Make the pipes to capture the child process's standard output and | |
1171 | * error streams. | |
1172 | */ | |
7b8ff279 MW |
1173 | if (pipe(p_out) || pipe(p_err)) { |
1174 | bad("failed to create pipes for job `%s': %s", | |
1175 | JOB_NAME(job), strerror(errno)); | |
1176 | goto fail; | |
1177 | } | |
1178 | if (configure_fd("job stdout pipe", p_out[0], 1, 1) || | |
1179 | configure_fd("job stdout pipe", p_out[1], 0, 1) || | |
1180 | configure_fd("job stderr pipe", p_err[0], 1, 1) || | |
1181 | configure_fd("job stderr pipe", p_err[1], 0, 1) || | |
1182 | configure_fd("log file", fileno(job->log), 1, 1)) | |
1183 | goto fail; | |
8996f767 | 1184 | |
6c39ec6d MW |
1185 | /* Initialize the output-processing structures ready for use. */ |
1186 | if (job->st == JST_VERSION) sha256_init(&job->h); | |
7b8ff279 MW |
1187 | job->out.buf = xmalloc(MAXLINE); job->out.off = job->out.len = 0; |
1188 | job->out.fd = p_out[0]; p_out[0] = -1; | |
1189 | job->err.buf = xmalloc(MAXLINE); job->err.off = job->err.len = 0; | |
1190 | job->err.fd = p_err[0]; p_err[0] = -1; | |
8996f767 MW |
1191 | |
1192 | /* Print a note to the top of the log. */ | |
6c39ec6d | 1193 | dstr_reset(&d); argv_string(&d, av); |
7b8ff279 | 1194 | fprintf(job->log, "%-13s > starting %s\n", JOB_NAME(job), d.p); |
8996f767 MW |
1195 | |
1196 | /* Flush the standard output stream. (Otherwise the child might try to | |
1197 | * flush it too.) | |
1198 | */ | |
7b8ff279 | 1199 | fflush(stdout); |
8996f767 MW |
1200 | |
1201 | /* Spin up the child process. */ | |
7b8ff279 MW |
1202 | kid = fork(); |
1203 | if (kid < 0) { | |
1204 | bad("failed to fork process for job `%s': %s", | |
1205 | JOB_NAME(job), strerror(errno)); | |
1206 | goto fail; | |
1207 | } | |
1208 | if (!kid) { | |
1209 | if (dup2(nullfd, 0) < 0 || | |
1210 | dup2(p_out[1], 1) < 0 || | |
1211 | dup2(p_err[1], 2) < 0) | |
1212 | lose("failed to juggle job `%s' file descriptors: %s", | |
1213 | JOB_NAME(job), strerror(errno)); | |
6c39ec6d | 1214 | job_child(job, av); |
7b8ff279 | 1215 | } |
8996f767 MW |
1216 | |
1217 | /* Close the ends of the pipes that we don't need. Move the job into | |
1218 | * the running list. | |
1219 | */ | |
7b8ff279 | 1220 | close(p_out[1]); close(p_err[1]); |
6c39ec6d | 1221 | job->kid = kid; job->next = job_run; job_run = job; nrun++; |
7b8ff279 | 1222 | continue; |
8996f767 | 1223 | |
7b8ff279 | 1224 | fail: |
8996f767 | 1225 | /* Clean up the wreckage if it didn't work. */ |
7b8ff279 MW |
1226 | if (p_out[0] >= 0) close(p_out[0]); |
1227 | if (p_out[1] >= 0) close(p_out[1]); | |
1228 | if (p_err[0] >= 0) close(p_err[0]); | |
1229 | if (p_err[1] >= 0) close(p_err[1]); | |
1230 | release_job(job); | |
1231 | } | |
8996f767 MW |
1232 | |
1233 | /* All done except for some final tidying up. */ | |
7b8ff279 MW |
1234 | dstr_release(&d); |
1235 | } | |
1236 | ||
8996f767 MW |
1237 | /* Take care of all of the jobs until they're all done. */ |
1238 | static void run_jobs(void) | |
1239 | { | |
1240 | struct job *job, *next, **link; | |
1241 | int nfd; | |
1242 | fd_set fd_in; | |
1243 | ||
1244 | for (;;) { | |
1245 | ||
1246 | /* If there are jobs still to be started and we have slots to spare then | |
1247 | * start some more up. | |
1248 | */ | |
1249 | start_jobs(); | |
1250 | ||
1251 | /* If the queues are now all empty then we're done. (No need to check | |
1252 | * `job_ready' here: `start_jobs' would have started them if `job_run' | |
1253 | * was empty. | |
1254 | */ | |
6c39ec6d | 1255 | if (!job_run) break; |
8996f767 MW |
1256 | |
1257 | /* Prepare for the select(2) call: watch for the signal pipe and all of | |
1258 | * the job pipes. | |
1259 | */ | |
1260 | #define SET_FD(dir, fd) do { \ | |
1261 | int _fd = (fd); \ | |
1262 | FD_SET(_fd, &fd_##dir); \ | |
1263 | if (_fd >= nfd) nfd = _fd + 1; \ | |
1264 | } while (0) | |
1265 | ||
1266 | FD_ZERO(&fd_in); nfd = 0; | |
1267 | SET_FD(in, sig_pipe[0]); | |
1268 | for (job = job_run; job; job = job->next) { | |
1269 | if (job->out.fd >= 0) SET_FD(in, job->out.fd); | |
1270 | if (job->err.fd >= 0) SET_FD(in, job->err.fd); | |
1271 | } | |
8996f767 MW |
1272 | |
1273 | #undef SET_FD | |
1274 | ||
1275 | /* Find out what's going on. */ | |
1276 | if (select(nfd, &fd_in, 0, 0, 0) < 0) { | |
1277 | if (errno == EINTR) continue; | |
1278 | else lose("select failed: %s", strerror(errno)); | |
1279 | } | |
1280 | ||
1281 | /* If there were any signals then handle them. */ | |
1282 | if (FD_ISSET(sig_pipe[0], &fd_in)) { | |
1283 | check_signals(); | |
1284 | if (sigloss >= 0) { | |
1285 | /* We hit a fatal signal. Kill off the remaining jobs and abort. */ | |
1286 | for (job = job_ready; job; job = next) | |
1287 | { next = job->next; release_job(job); } | |
1288 | for (job = job_run; job; job = next) | |
1289 | { next = job->next; release_job(job); } | |
8996f767 MW |
1290 | break; |
1291 | } | |
1292 | } | |
1293 | ||
6c39ec6d MW |
1294 | /* Collect output from running jobs, and clear away any dead jobs once |
1295 | * we've collected all their output. | |
8996f767 | 1296 | */ |
6c39ec6d | 1297 | for (link = &job_run, job = *link; job; job = next) { |
10427eb2 | 1298 | if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in)) |
6c39ec6d MW |
1299 | prefix_lines(job, &job->out, '|', |
1300 | job->st == JST_VERSION ? &job->h : 0); | |
10427eb2 | 1301 | if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in)) |
6c39ec6d | 1302 | prefix_lines(job, &job->err, '*', 0); |
8996f767 | 1303 | next = job->next; |
6c39ec6d MW |
1304 | if (job->kid > 0 || job->out.fd >= 0 || job->err.fd >= 0) |
1305 | link = &job->next; | |
1306 | else | |
1307 | { *link = next; finish_job(job); } | |
8996f767 MW |
1308 | } |
1309 | } | |
1310 | } | |
1311 | ||
1312 | /*----- Main program ------------------------------------------------------*/ | |
1313 | ||
1314 | /* Help and related functions. */ | |
7b8ff279 MW |
1315 | static void version(FILE *fp) |
1316 | { fprintf(fp, "%s, runlisp version %s\n", progname, PACKAGE_VERSION); } | |
1317 | ||
1318 | static void usage(FILE *fp) | |
1319 | { | |
1320 | fprintf(fp, "\ | |
10427eb2 | 1321 | usage: %s [-RUadfinqrv] [+RUdfinr] [-c CONF] [-o [SECT:]VAR=VAL]\n\ |
7b8ff279 MW |
1322 | [-O FILE|DIR] [-j NJOBS] [LISP ...]\n", |
1323 | progname); | |
1324 | } | |
1325 | ||
1326 | static void help(FILE *fp) | |
1327 | { | |
1328 | version(fp); fputc('\n', fp); usage(fp); | |
1329 | fputs("\n\ | |
1330 | Help options:\n\ | |
1331 | -h, --help Show this help text and exit successfully.\n\ | |
1332 | -V, --version Show version number and exit successfully.\n\ | |
1333 | \n\ | |
1334 | Diagnostics:\n\ | |
1335 | -n, --dry-run Don't run run anything (useful with `-v').\n\ | |
1336 | -q, --quiet Don't print warning messages.\n\ | |
1337 | -v, --verbose Print informational messages (repeatable).\n\ | |
1338 | \n\ | |
1339 | Configuration:\n\ | |
1340 | -c, --config-file=CONF Read configuration from CONF (repeatable).\n\ | |
1341 | -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\ | |
1342 | \n\ | |
1343 | Image dumping:\n\ | |
1344 | -O, --output=FILE|DIR Store image(s) in FILE or DIR.\n\ | |
10427eb2 MW |
1345 | -R, --remove-other Delete image files for other Lisp systems.\n\ |
1346 | -U, --remove-unknown Delete unrecognized files in image dir.\n\ | |
1347 | -a, --all-configured Select all configured implementations.\n\ | |
1348 | -d, --cleanup Delete images which are no longer wanted.\n\ | |
7b8ff279 | 1349 | -f, --force Dump images even if they already exist.\n\ |
10427eb2 MW |
1350 | -i, --check-installed Check Lisp systems exist before dumping.\n\ |
1351 | -j, --jobs=NJOBS Run up to NJOBS jobs in parallel.\n\ | |
1352 | -r, --remove-image Delete image files, instead of creating.\n", | |
7b8ff279 MW |
1353 | fp); |
1354 | } | |
1355 | ||
10427eb2 MW |
1356 | static void show_job_list(const char *what, struct job *job) |
1357 | { | |
1358 | struct dstr d = DSTR_INIT; | |
1359 | int first; | |
1360 | ||
1361 | first = 1; | |
1362 | for (; job; job = job->next) { | |
1363 | if (first) first = 0; | |
1364 | else dstr_puts(&d, ", "); | |
1365 | dstr_putf(&d, "`%s'", JOB_NAME(job)); | |
1366 | } | |
1367 | if (first) dstr_puts(&d, "(none)"); | |
1368 | dstr_putz(&d); | |
1369 | moan("%s: %s", what, d.p); | |
1370 | } | |
1371 | ||
8996f767 | 1372 | /* Main program. */ |
7b8ff279 MW |
1373 | int main(int argc, char *argv[]) |
1374 | { | |
1375 | struct config_section_iter si; | |
1376 | struct config_section *sect; | |
1377 | struct config_var *var; | |
1378 | const char *out = 0, *p, *q, *l; | |
10427eb2 | 1379 | struct job *job; |
7b8ff279 MW |
1380 | struct stat st; |
1381 | struct dstr d = DSTR_INIT; | |
10427eb2 MW |
1382 | DIR *dir; |
1383 | struct dirent *de; | |
1384 | int i, fd; | |
1385 | size_t n, o; | |
1386 | unsigned f; | |
7b8ff279 | 1387 | |
8996f767 | 1388 | /* Command-line options. */ |
7b8ff279 MW |
1389 | static const struct option opts[] = { |
1390 | { "help", 0, 0, 'h' }, | |
1391 | { "version", 0, 0, 'V' }, | |
1392 | { "output", OPTF_ARGREQ, 0, 'O' }, | |
10427eb2 MW |
1393 | { "remove-other", OPTF_NEGATE, 0, 'R' }, |
1394 | { "remove-unknown", OPTF_NEGATE, 0, 'U' }, | |
7b8ff279 MW |
1395 | { "all-configured", 0, 0, 'a' }, |
1396 | { "config-file", OPTF_ARGREQ, 0, 'c' }, | |
1397 | { "force", OPTF_NEGATE, 0, 'f' }, | |
1398 | { "check-installed", OPTF_NEGATE, 0, 'i' }, | |
1399 | { "jobs", OPTF_ARGREQ, 0, 'j' }, | |
1400 | { "dry-run", OPTF_NEGATE, 0, 'n' }, | |
1401 | { "set-option", OPTF_ARGREQ, 0, 'o' }, | |
1402 | { "quiet", 0, 0, 'q' }, | |
10427eb2 | 1403 | { "remove-image", OPTF_NEGATE, 0, 'r' }, |
7b8ff279 MW |
1404 | { "verbose", 0, 0, 'v' }, |
1405 | { 0, 0, 0, 0 } | |
1406 | }; | |
1407 | ||
8996f767 | 1408 | /* Initial setup. */ |
7b8ff279 MW |
1409 | set_progname(argv[0]); |
1410 | init_config(); | |
9ecf91d0 | 1411 | srand(time(0)); |
7b8ff279 | 1412 | |
8996f767 | 1413 | /* Parse the options. */ |
7b8ff279 | 1414 | optprog = (/*unconst*/ char *)progname; |
10427eb2 MW |
1415 | |
1416 | #define FLAGOPT(ch, f) \ | |
1417 | case ch: \ | |
1418 | flags |= f; \ | |
1419 | break; \ | |
1420 | case ch | OPTF_NEGATED: \ | |
1421 | flags &= ~f; \ | |
1422 | break | |
1423 | ||
7b8ff279 | 1424 | for (;;) { |
10427eb2 | 1425 | i = mdwopt(argc - 1, argv + 1, "hVO:R+U+ac:d+f+i+j:n+o:qr+v", opts, 0, 0, |
7b8ff279 MW |
1426 | OPTF_NEGATION | OPTF_NOPROGNAME); |
1427 | if (i < 0) break; | |
1428 | switch (i) { | |
1429 | case 'h': help(stdout); exit(0); | |
1430 | case 'V': version(stdout); exit(0); | |
1431 | case 'O': out = optarg; break; | |
10427eb2 MW |
1432 | FLAGOPT('R', AF_CLEAN); |
1433 | FLAGOPT('U', AF_JUNK); | |
7b8ff279 MW |
1434 | case 'a': flags |= AF_ALL; break; |
1435 | case 'c': read_config_path(optarg, 0); flags |= AF_SETCONF; break; | |
10427eb2 MW |
1436 | FLAGOPT('f', AF_FORCE); |
1437 | FLAGOPT('i', AF_CHECKINST); | |
7b8ff279 | 1438 | case 'j': maxrun = parse_int("number of jobs", optarg, 1, 65535); break; |
10427eb2 | 1439 | FLAGOPT('n', AF_DRYRUN); |
7b8ff279 MW |
1440 | case 'o': if (set_config_var(optarg)) flags |= AF_BOGUS; break; |
1441 | case 'q': if (verbose) verbose--; break; | |
10427eb2 | 1442 | FLAGOPT('r', AF_REMOVE); |
7b8ff279 MW |
1443 | case 'v': verbose++; break; |
1444 | default: flags |= AF_BOGUS; break; | |
1445 | } | |
1446 | } | |
1447 | ||
10427eb2 MW |
1448 | #undef FLAGOPT |
1449 | ||
8996f767 | 1450 | /* CHeck that everything worked. */ |
7b8ff279 MW |
1451 | optind++; |
1452 | if ((flags&AF_ALL) ? optind < argc : optind >= argc) flags |= AF_BOGUS; | |
8996f767 | 1453 | if (flags&AF_BOGUS) { usage(stderr); exit(127); } |
7b8ff279 | 1454 | |
8996f767 | 1455 | /* Load default configuration if no explicit files were requested. */ |
7b8ff279 MW |
1456 | if (!(flags&AF_SETCONF)) load_default_config(); |
1457 | ||
8996f767 MW |
1458 | /* OK, so we've probably got some work to do. Let's set things up ready. |
1459 | * It'll be annoying if our standard descriptors aren't actually set up | |
1460 | * properly, so we'll make sure those slots are populated. We'll need a | |
1461 | * `/dev/null' descriptor anyway (to be stdin for the jobs). We'll also | |
1462 | * need a temporary directory, and it'll be less temporary if we don't | |
1463 | * arrange to delete it when we're done. And finally we'll need to know | |
1464 | * when a child process exits. | |
1465 | */ | |
1466 | for (;;) { | |
1467 | fd = open("/dev/null", O_RDWR); | |
1468 | if (fd < 0) lose("failed to open `/dev/null': %s", strerror(errno)); | |
1469 | if (fd > 2) { nullfd = fd; break; } | |
7b8ff279 | 1470 | } |
8996f767 | 1471 | configure_fd("null fd", nullfd, 0, 1); |
7b8ff279 MW |
1472 | atexit(cleanup); |
1473 | if (pipe(sig_pipe)) | |
1474 | lose("failed to create signal pipe: %s", strerror(errno)); | |
1475 | configure_fd("signal pipe (read end)", sig_pipe[0], 1, 1); | |
1476 | configure_fd("signal pipe (write end)", sig_pipe[1], 1, 1); | |
1477 | sigemptyset(&caught); sigemptyset(&pending); | |
1478 | set_signal_handler("SIGTERM", SIGTERM, SIGF_IGNOK); | |
1479 | set_signal_handler("SIGINT", SIGINT, SIGF_IGNOK); | |
1480 | set_signal_handler("SIGHUP", SIGHUP, SIGF_IGNOK); | |
1481 | set_signal_handler("SIGCHLD", SIGCHLD, 0); | |
1482 | ||
8996f767 | 1483 | /* Create the temporary directory and export it into the configuration. */ |
7b8ff279 | 1484 | set_tmpdir(); |
8996f767 | 1485 | config_set_var(&config, builtin, CF_LITERAL, "@%tmp-dir", tmpdir); |
7b8ff279 | 1486 | config_set_var(&config, builtin, 0, |
8996f767 MW |
1487 | "@tmp-dir", "${@BUILTIN:@%tmp-dir}/${@name}"); |
1488 | ||
1489 | /* Work out where the image files are going to go. If there's no `-O' | |
1490 | * option then we use the main `image-dir'. Otherwise what happens depends | |
1491 | * on whether this is a file or a directory. | |
1492 | */ | |
6c39ec6d | 1493 | if (!out) { |
8996f767 | 1494 | config_set_var(&config, builtin, 0, |
6c39ec6d MW |
1495 | "@image-link", "${@image-dir}/${image-file}"); |
1496 | var = config_find_var(&config, builtin, CF_INHERIT, "@image-dir"); | |
1497 | assert(var); out = config_subst_var_alloc(&config, builtin, var); | |
1498 | } else if (!stat(out, &st) && S_ISDIR(st.st_mode)) { | |
8996f767 MW |
1499 | config_set_var(&config, builtin, CF_LITERAL, "@%out-dir", out); |
1500 | config_set_var(&config, builtin, 0, | |
6c39ec6d | 1501 | "@image-link", "${@BUILTIN:@%out-dir}/${image-file}"); |
8996f767 MW |
1502 | } else if (argc - optind != 1) |
1503 | lose("can't dump multiple Lisps to a single output file"); | |
10427eb2 MW |
1504 | else if (flags&AF_JUNK) |
1505 | lose("can't clear junk in a single output file"); | |
1506 | else if (flags&AF_CLEAN) | |
1507 | lose("can't clean other images with a single output file"); | |
8996f767 | 1508 | else |
6c39ec6d | 1509 | config_set_var(&config, builtin, CF_LITERAL, "@image-link", out); |
7b8ff279 | 1510 | |
6c39ec6d MW |
1511 | /* Set the staging and versioned filenames. */ |
1512 | config_set_var(&config, builtin, 0, | |
1513 | "@image-out", "${@image-link}-${@hash}"); | |
8996f767 | 1514 | config_set_var(&config, builtin, 0, "@image-new", "${@image-out}.new"); |
6c39ec6d MW |
1515 | config_set_var(&config, builtin, 0, |
1516 | "@image-newlink", "${@image-link}.new"); | |
1517 | ||
1518 | config_set_var(&config, builtin, 0, "@script", | |
1519 | "${@ENV:RUNLISP_EVAL?" | |
1520 | "${@CONFIG:eval-script?" | |
1521 | "${@data-dir}/eval.lisp}}"); | |
1522 | ||
1523 | /* Configure an initial value for `@hash'. This is necessary so that | |
1524 | * `add_job' can expand `dump-image' to check that the command exists. | |
1525 | */ | |
1526 | config_set_var(&config, builtin, CF_LITERAL, "@hash", "!!!unset!!!"); | |
8996f767 MW |
1527 | |
1528 | /* Dump the final configuration if we're being very verbose. */ | |
7b8ff279 MW |
1529 | if (verbose >= 5) dump_config(); |
1530 | ||
10427eb2 MW |
1531 | /* There are a number of different strategies we might employ, depending on |
1532 | * the exact request. | |
1533 | * | |
1534 | * queue queue clear | |
1535 | * REMOVE CLEAN JUNK selected others junk? | |
1536 | * | |
1537 | * * nil nil ready/delete -- no | |
1538 | * * nil t ready/delete none yes | |
1539 | * nil t nil ready delete no | |
1540 | * nil t t ready -- yes | |
1541 | * t t nil -- delete no | |
1542 | * t t t -- -- yes | |
1543 | */ | |
1544 | ||
1545 | /* First step: if `AF_REMOVE' and `AF_CLEAN' are not both set, then scan | |
1546 | * the selected Lisp systems and add them to the appropriate queue. | |
1547 | * | |
1548 | * Bit-hack: if they are not both set, then their complements are not both | |
1549 | * clear. | |
1550 | */ | |
1551 | if (~flags&(AF_REMOVE | AF_CLEAN)) { | |
1552 | ||
1553 | /* Determine the flags for `add_job' when we select the Lisp systems. If | |
1554 | * we intend to clear junk then we must notice the image names we | |
1555 | * encounter. If we're supposed to check that Lisps exist before dumping | |
1556 | * then do that -- but it doesn't make any sense for deletion. | |
1557 | */ | |
1558 | f = flags&AF_REMOVE ? JQ_DELETE : JQ_READY; | |
1559 | if (flags&AF_JUNK) f |= JF_NOTICE; | |
1560 | if (flags&AF_CHECKINST) f |= JF_CHECKINST; | |
1561 | if (!(flags&(AF_FORCE | AF_REMOVE))) f |= JF_CHECKEXIST; | |
1562 | ||
1563 | /* If we have named Lisps, then process them. */ | |
1564 | if (!(flags&AF_ALL)) | |
1565 | for (i = optind; i < argc; i++) | |
1566 | add_named_job(f, argv[i], strlen(argv[i])); | |
1567 | ||
1568 | /* Otherwise we're supposed to dump `all' of them. If there's a `dump' | |
8996f767 MW |
1569 | * configuration setting then we need to parse that. Otherwise we just |
1570 | * try all of them. | |
1571 | */ | |
10427eb2 MW |
1572 | else { |
1573 | var = config_find_var(&config, toplevel, CF_INHERIT, "dump"); | |
1574 | if (!var) { | |
1575 | /* No setting. Just do all of the Lisps which look available. */ | |
1576 | ||
1577 | f |= JF_CHECKINST; | |
1578 | for (config_start_section_iter(&config, &si); | |
1579 | (sect = config_next_section(&si)); ) | |
1580 | add_job(f, sect); | |
1581 | } else { | |
1582 | /* Parse the `dump' list. */ | |
1583 | ||
1584 | dstr_reset(&d); config_subst_var(&config, toplevel, var, &d); | |
1585 | p = d.p; l = p + d.len; | |
1586 | for (;;) { | |
1587 | while (p < l && ISSPACE(*p)) p++; | |
1588 | if (p >= l) break; | |
1589 | q = p; | |
1590 | while (p < l && !ISSPACE(*p) && *p != ',') p++; | |
1591 | add_named_job(f, q, p - q); | |
1592 | while (p < l && ISSPACE(*p)) p++; | |
1593 | if (p < l && *p == ',') p++; | |
1594 | } | |
7b8ff279 MW |
1595 | } |
1596 | } | |
1597 | } | |
10427eb2 MW |
1598 | |
1599 | /* Second step: if exactly one of `AF_CLEAN' and `AF_JUNK' is set, then we | |
1600 | * need to scan all of the remaining Lisps and add them to the `delete' | |
1601 | * queue. | |
1602 | */ | |
1603 | if (!(flags&AF_CLEAN) != !(flags&AF_JUNK)) { | |
1604 | ||
1605 | /* Determine the flag settings. If we're junking, then we're not | |
1606 | * cleaning -- we just want to mark images belonging to other Lisps as | |
1607 | * off-limits to the junking scan. | |
1608 | */ | |
1609 | f = flags&AF_CLEAN ? JQ_DELETE : JQ_NONE | JF_NOTICE; | |
1610 | ||
1611 | /* Now scan the Lisp systems. */ | |
1612 | for (config_start_section_iter(&config, &si); | |
1613 | (sect = config_next_section(&si)); ) | |
1614 | add_job(f, sect); | |
1615 | } | |
1616 | ||
1617 | /* Terminate the job queues. */ | |
1618 | *job_ready_tail = 0; | |
1619 | *job_delete_tail = 0; | |
7b8ff279 | 1620 | |
8996f767 | 1621 | /* Report on what it is we're about to do. */ |
7b8ff279 | 1622 | if (verbose >= 3) { |
10427eb2 MW |
1623 | show_job_list("dumping Lisp images", job_ready); |
1624 | show_job_list("deleting Lisp images", job_delete); | |
7b8ff279 MW |
1625 | } |
1626 | ||
10427eb2 MW |
1627 | /* If there turns out to be nothing to do, then mention this. */ |
1628 | if (!(flags&AF_REMOVE) && verbose >= 2 && !job_ready) | |
1629 | moan("no Lisp images to dump"); | |
7b8ff279 | 1630 | |
10427eb2 | 1631 | /* Run the dumping jobs. */ |
8996f767 | 1632 | run_jobs(); |
7b8ff279 | 1633 | |
10427eb2 MW |
1634 | /* Check for any last signals. If we hit any fatal signals then we should |
1635 | * kill ourselves so that the exit status will be right. | |
8996f767 | 1636 | */ |
7b8ff279 MW |
1637 | check_signals(); |
1638 | if (sigloss) { cleanup(); signal(sigloss, SIG_DFL); raise(sigloss); } | |
1639 | ||
10427eb2 MW |
1640 | /* Now delete Lisps which need deleting. */ |
1641 | while (job_delete) { | |
1642 | job = job_delete; job_delete = job->next; | |
1643 | if (flags&AF_DRYRUN) { | |
1644 | if (verbose >= 2) | |
6c39ec6d MW |
1645 | moan("not deleting `%s' image link `%s' (dry run)", |
1646 | JOB_NAME(job), job->imglink); | |
1647 | if (job->oldimg && verbose >= 2) | |
10427eb2 | 1648 | moan("not deleting `%s' image `%s' (dry run)", |
6c39ec6d | 1649 | JOB_NAME(job), job->oldimg); |
10427eb2 MW |
1650 | } else { |
1651 | if (verbose >= 2) | |
1652 | moan("deleting `%s' image `%s' (dry run)", | |
6c39ec6d MW |
1653 | JOB_NAME(job), job->imglink); |
1654 | if (unlink(job->imglink) && errno != ENOENT) | |
1655 | bad("failed to delete `%s' image link `%s': %s", | |
1656 | JOB_NAME(job), job->imglink, strerror(errno)); | |
1657 | if (job->oldimg && unlink(job->oldimg) && errno != ENOENT) | |
10427eb2 | 1658 | bad("failed to delete `%s' image `%s': %s", |
6c39ec6d | 1659 | JOB_NAME(job), job->oldimg, strerror(errno)); |
10427eb2 MW |
1660 | } |
1661 | } | |
1662 | ||
1663 | /* Finally, maybe delete all of the junk files in the image directory. */ | |
1664 | if (flags&AF_JUNK) { | |
10427eb2 MW |
1665 | dir = opendir(out); |
1666 | if (!dir) | |
1667 | lose("failed to open image directory `%s': %s", out, strerror(errno)); | |
1668 | dstr_reset(&d); | |
1669 | dstr_puts(&d, out); dstr_putc(&d, '/'); o = d.len; | |
1670 | if (verbose >= 2) | |
1671 | moan("cleaning up junk in image directory `%s'", out); | |
1672 | for (;;) { | |
1673 | de = readdir(dir); if (!de) break; | |
1674 | if (de->d_name[0] == '.' && | |
1675 | (!de->d_name[1] || (de->d_name[1] == '.' && !de->d_name[2]))) | |
1676 | continue; | |
1677 | n = strlen(de->d_name); | |
1678 | d.len = o; dstr_putm(&d, de->d_name, n + 1); | |
1679 | if (!treap_lookup(&good, de->d_name, n)) { | |
1680 | if (flags&AF_DRYRUN) { | |
1681 | if (verbose >= 2) | |
1682 | moan("not deleting junk file `%s' (dry run)", d.p); | |
1683 | } else { | |
1684 | if (verbose >= 2) | |
1685 | moan("deleting junk file `%s'", d.p); | |
1686 | if (unlink(d.p) && errno != ENOENT) | |
1687 | bad("failed to delete junk file `%s': %s", d.p, strerror(errno)); | |
1688 | } | |
1689 | } | |
1690 | } | |
1691 | } | |
1692 | ||
8996f767 | 1693 | /* All done! */ |
7b8ff279 MW |
1694 | return (rc); |
1695 | } | |
1696 | ||
1697 | /*----- That's all, folks -------------------------------------------------*/ |