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