#include "common.h"
#include "lib.h"
#include "mdwopt.h"
+#include "sha256.h"
/*----- Static data -------------------------------------------------------*/
-#define MAXLINE 16384u
+/* The state required to break an output stream from a subprocess into lines
+ * so we can prefix them appropriately. Once our process starts, the `buf'
+ * points to a buffer of `MAXLINE' bytes. This is arranged as a circular
+ * buffer, containing `len' bytes starting at offset `off', and wrapping
+ * around to the start of the buffer if it runs off the end.
+ *
+ * The descriptor `fd' is reset to -1 after it's seen end-of-file.
+ */
struct linebuf {
- int fd;
- char *buf;
- unsigned off, len;
+ int fd; /* our file descriptor (or -1) */
+ char *buf; /* line buffer, or null */
+ unsigned off, len; /* offset */
};
+#define MAXLINE 16384u /* maximum acceptable line length */
+/* Job-state constants. */
enum {
- JST_READY,
- JST_RUN,
- JST_DEAD,
+ JST_INTERN, /* not that kind of job */
+ JST_VERSION, /* hashing the Lisp version number */
+ JST_DUMP, /* dumping the custom image */
JST_NSTATE
};
+/* The state associated with an image-dumping job. */
struct job {
- struct treap_node _node;
- struct job *next;
- struct argv av;
- unsigned st;
- FILE *log;
- pid_t kid;
- int exit;
- struct linebuf out, err;
+ struct treap_node _node; /* treap intrusion */
+ struct job *next; /* next job in whichever list */
+ unsigned st; /* job state (`JST_...') */
+ struct config_section *sect; /* the system-definition section */
+ struct config_var *dumpvar; /* the `dump-image' variable */
+ struct argv av_version, av_dump; /* argument vectors to execute */
+ char *imgnew, *imghash, *imgnewlink, *imglink; /* link and final outputs */
+ char *oldimg; /* old image name */
+ FILE *log; /* log output file (`stdout'?) */
+ pid_t kid; /* process id of child (or -1) */
+ int exit; /* exit status from child */
+ struct sha256_state h; /* hash context for version */
+ struct linebuf out, err; /* line buffers for stdout, stderr */
};
#define JOB_NAME(job) TREAP_NODE_KEY(job)
#define JOB_NAMELEN(job) TREAP_NODE_KEYLEN(job)
-static struct treap jobs = TREAP_INIT;
-static struct job *job_ready, *job_run, *job_dead;
-static unsigned nrun, maxrun = 1;
-static int rc = 0;
-static int nullfd;
-
-static int sig_pipe[2] = { -1, -1 };
-static sigset_t caught, pending;
-static int sigloss = -1;
-
-static unsigned flags = 0;
-#define AF_BOGUS 0x0001u
-#define AF_SETCONF 0x0002u
-#define AF_DRYRUN 0x0004u
-#define AF_ALL 0x0008u
-#define AF_FORCE 0x0010u
-#define AF_CHECKINST 0x0020u
-
-/*----- Main code ---------------------------------------------------------*/
-
+static struct treap jobs = TREAP_INIT, /* Lisp systems seen so far */
+ good = TREAP_INIT; /* files ok to be in image dir */
+static struct job /* lists of jobs */
+ *job_ready, **job_ready_tail = &job_ready, /* queue of jobs to start */
+ *job_delete, **job_delete_tail = &job_delete, /* queue of delete jobs */
+ *job_run; /* list of active jobs */
+static unsigned nrun, maxrun = 1; /* running and maximum job counts */
+static int rc = 0; /* code that we should return */
+static int nullfd; /* file descriptor for `/dev/null' */
+static const char *tmpdir; /* temporary directory path */
+
+static int sig_pipe[2] = { -1, -1 }; /* pipe for reporting signals */
+static sigset_t caught, pending; /* signals we catch; have caught */
+static int sigloss = -1; /* signal that caused us to lose */
+
+static unsigned flags = 0; /* flags for the application */
+#define AF_BOGUS 0x0001u /* invalid comand-line syntax */
+#define AF_SETCONF 0x0002u /* explicit configuration */
+#define AF_DRYRUN 0x0004u /* don't actually do it */
+#define AF_ALL 0x0008u /* dump all known Lisps */
+#define AF_FORCE 0x0010u /* dump even if images exist */
+#define AF_CHECKINST 0x0020u /* check Lisp exists before dump */
+#define AF_REMOVE 0x0040u /* remove selected Lisp images */
+#define AF_CLEAN 0x0080u /* remove other Lisp images */
+#define AF_JUNK 0x0100u /* remove unrecognized files */
+
+/*----- Miscellany --------------------------------------------------------*/
+
+/* Report a (printf(3)-style) message MSG, and remember to fail later. */
static PRINTF_LIKE(1, 2) void bad(const char *msg, ...)
- { va_list ap; va_start(ap, msg); vmoan(msg, ap); va_end(ap); rc = 2; }
-
-static const char *tmpdir;
+ { va_list ap; va_start(ap, msg); vmoan(msg, ap); va_end(ap); rc = 127; }
-static void set_tmpdir(void)
+/* Answer whether a string consists entirely of hex digits. */
+static int hex_digits_p(const char *p, size_t sz)
{
- struct dstr d = DSTR_INIT;
- size_t n;
- unsigned i;
+ const char *l;
- dstr_putf(&d, "%s/runlisp.%d.", my_getenv("TMPDIR", "/tmp"), getpid());
- i = 0; n = d.len;
- for (;;) {
- d.len = n; dstr_putf(&d, "%d", rand());
- if (!mkdir(d.p, 0700)) break;
- else if (errno != EEXIST)
- lose("failed to create temporary directory `%s': %s",
- d.p, strerror(errno));
- else if (++i >= 32) {
- dstr_puts(&d, "???");
- lose("failed to create temporary directory `%s': too many attempts",
- d.p);
- }
- }
- tmpdir = xstrndup(d.p, d.len); dstr_release(&d);
+ for (l = p + sz; p < l; p++) if (!ISXDIGIT(*p)) return (0);
+ return (1);
}
+/*----- File utilities ----------------------------------------------------*/
+
+/* Main recursive subroutine for `recursive_delete'.
+ *
+ * The string DD currently contains the pathname of a directory, without a
+ * trailing `/' (though there is /space/ for a terminating zero or whatever).
+ * Recursively delete all of the files and directories within it. Appending
+ * further text to DD is OK, but clobbering the characters which are there
+ * already isn't allowed.
+ */
static void recursive_delete_(struct dstr *dd)
{
- size_t n = dd->len;
DIR *dir;
struct dirent *d;
+ size_t n = dd->len;
- dd->p[n] = 0;
- dir = opendir(dd->p);
+ /* Open the directory. */
+ dd->p[n] = 0; dir = opendir(dd->p);
if (!dir)
lose("failed to open directory `%s' for cleanup: %s",
dd->p, strerror(errno));
+ /* We'll need to build pathnames for the files inside the directory, so add
+ * the separating `/' character. Remember the length of this prefix
+ * because this is the point we'll be rewinding to for each filename we
+ * find.
+ */
dd->p[n++] = '/';
+
+ /* Now go through each file in turn. */
for (;;) {
+
+ /* Get a filename. If we've run out then we're done. Skip the special
+ * `.' and `..' entries.
+ */
d = readdir(dir); if (!d) break;
if (d->d_name[0] == '.' && (!d->d_name[1] ||
(d->d_name[1] == '.' && !d->d_name[2])))
continue;
+
+ /* Rewind the string offset and append the new filename. */
dd->len = n; dstr_puts(dd, d->d_name);
+
+ /* Try to delete it the usual way. If it was actually a directory then
+ * recursively delete it instead. (We could lstat(2) it first, but this
+ * should be at least as quick to identify a directory, and it'll save a
+ * lstat(2) call in the (common) case that it's not a directory.
+ */
if (!unlink(dd->p));
else if (errno == EISDIR) recursive_delete_(dd);
else lose("failed to delete file `%s': %s", dd->p, strerror(errno));
}
+
+ /* We're done. Try to delete the directory. (It's possible that there was
+ * some problem with enumerating the directory, but we'll ignore that: if
+ * it matters then the directory won't be empty and the rmdir(2) will
+ * fail.)
+ */
closedir(dir);
dd->p[--n] = 0;
if (rmdir(dd->p))
lose("failed to delete directory `%s': %s", dd->p, strerror(errno));
}
+/* Recursively delete the thing named PATH. */
static void recursive_delete(const char *path)
{
struct dstr d = DSTR_INIT;
dstr_puts(&d, path); recursive_delete_(&d); dstr_release(&d);
}
-static void cleanup(void)
- { if (tmpdir) { recursive_delete(tmpdir); tmpdir = 0; } }
-
+/* Configure a file descriptor FD.
+ *
+ * Set its nonblocking state to NONBLOCK and close-on-exec state to CLOEXEC.
+ * In both cases, -1 means to leave it alone, zero means to turn it off, and
+ * any other nonzero value means to turn it on.
+ */
static int configure_fd(const char *what, int fd, int nonblock, int cloexec)
{
int fl, nfl;
return (-1);
}
+/* Create a temporary directory and remember where we put it. */
+static void set_tmpdir(void)
+{
+ struct dstr d = DSTR_INIT;
+ size_t n;
+ unsigned i;
+
+ /* Start building the path name. Remember the length: we'll rewind to
+ * here and try again if our first attempt doesn't work.
+ */
+ dstr_putf(&d, "%s/runlisp.%d.", my_getenv("TMPDIR", "/tmp"), getpid());
+ i = 0; n = d.len;
+
+ /* Keep trying until it works. */
+ for (;;) {
+
+ /* Build a complete name. */
+ d.len = n; dstr_putf(&d, "%d", rand());
+
+ /* Try to create the directory. If it worked, we're done. If it failed
+ * with `EEXIST' then we'll try again for a while, but give up it it
+ * doesn't look like we're making any progress. If it failed for some
+ * other reason then there's probably not much hope so give up.
+ */
+ if (!mkdir(d.p, 0700)) break;
+ else if (errno != EEXIST)
+ lose("failed to create temporary directory `%s': %s",
+ d.p, strerror(errno));
+ else if (++i >= 32) {
+ d.len = n; dstr_puts(&d, "???");
+ lose("failed to create temporary directory `%s': too many attempts",
+ d.p);
+ }
+ }
+
+ /* Remember the directory name. */
+ tmpdir = xstrndup(d.p, d.len); dstr_release(&d);
+}
+
+/*----- Signal handling ---------------------------------------------------*/
+
+/* Forward reference into job management. */
+static void reap_children(void);
+
+/* Clean things up on exit.
+ *
+ * Currently this just means to delete the temporary directory if we've made
+ * one.
+ */
+static void cleanup(void)
+ { if (tmpdir) { recursive_delete(tmpdir); tmpdir = 0; } }
+
+/* Check to see whether any signals have arrived, and do the sensible thing
+ * with them.
+ */
+static void check_signals(void)
+{
+ sigset_t old, pend;
+ char buf[32];
+ ssize_t n;
+
+ /* Ensure exclusive access to the signal-handling machinery, drain the
+ * signal pipe, and take a copy of the set of caught signals.
+ */
+ sigprocmask(SIG_BLOCK, &caught, &old);
+ pend = pending; sigemptyset(&pending);
+ for (;;) {
+ n = read(sig_pipe[0], buf, sizeof(buf));
+ if (!n) lose("(internal) signal pipe closed!");
+ if (n < 0) break;
+ }
+ if (errno != EAGAIN && errno != EWOULDBLOCK)
+ lose("failed to read signal pipe: %s", strerror(errno));
+ sigprocmask(SIG_SETMASK, &old, 0);
+
+ /* Check for each signal of interest to us.
+ *
+ * Interrupty signals just set `sigloss' -- the `run_jobs' loop will know
+ * to unravel everything if this happens. If `SIGCHLD' happened, then
+ * check on job process status.
+ */
+ if (sigismember(&pend, SIGINT)) sigloss = SIGINT;
+ else if (sigismember(&pend, SIGHUP)) sigloss = SIGHUP;
+ else if (sigismember(&pend, SIGTERM)) sigloss = SIGTERM;
+ if (sigismember(&pend, SIGCHLD)) reap_children();
+}
+
+/* The actual signal handler.
+ *
+ * Set the appropriate signal bit in `pending', and a byte (of any value)
+ * down the signal pipe to wake up the select(2) loop.
+ */
static void handle_signal(int sig)
{
sigset_t old;
char x = '!';
+ /* Ensure exclusive access while we fiddle with the `caught' set. */
sigprocmask(SIG_BLOCK, &caught, &old);
sigaddset(&pending, sig);
sigprocmask(SIG_SETMASK, &old, 0);
+ /* Wake up the select(2) loop. If this fails, there's not a lot we can do
+ * about it.
+ */
DISCARD(write(sig_pipe[1], &x, 1));
}
-#define JF_QUIET 1u
-static void add_job(struct job ***tail_inout, unsigned f,
- const char *name, size_t len)
+/* Install our signal handler to catch SIG.
+ *
+ * If `SIGF_IGNOK' is set in F then don't trap the signal if it's currently
+ * ignored. (This is used for signals like `SIGINT', which usually should
+ * interrupt us; but if the caller wants us to ignore them, we should do as
+ * it wants.)
+ *
+ * WHAT describes the signal, for use in diagnostic messages.
+ */
+#define SIGF_IGNOK 1u
+static void set_signal_handler(const char *what, int sig, unsigned f)
{
- struct job *job;
+ struct sigaction sa, sa_old;
+
+ sigaddset(&caught, sig);
+
+ if (f&SIGF_IGNOK) {
+ if (sigaction(sig, 0, &sa_old)) goto fail;
+ if (sa_old.sa_handler == SIG_IGN) return;
+ }
+
+ sa.sa_handler = handle_signal;
+ sigemptyset(&sa.sa_mask);
+ sa.sa_flags = SA_NOCLDSTOP;
+ if (sigaction(sig, &sa, 0)) goto fail;
+
+ return;
+
+fail:
+ lose("failed to set %s signal handler: %s", what, strerror(errno));
+}
+
+/*----- Line buffering ----------------------------------------------------*/
+
+/* Find the next newline in the line buffer BUF.
+ *
+ * The search starts at `BUF->off', and potentially covers the entire buffer
+ * contents. Set *LINESZ_OUT to the length of the line, in bytes. (Callers
+ * must beware that the text of the line may wrap around the ends of the
+ * buffer.) Return zero if we found a newline, or nonzero if the search
+ * failed.
+ */
+static int find_newline(struct linebuf *buf, size_t *linesz_out)
+{
+ char *nl;
+
+ if (buf->off + buf->len <= MAXLINE) {
+ /* The buffer contents is in one piece. Just search it. */
+
+ nl = memchr(buf->buf + buf->off, '\n', buf->len);
+ if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
+
+ } else {
+ /* The buffer contents is in two pieces. We must search both of them. */
+
+ nl = memchr(buf->buf + buf->off, '\n', MAXLINE - buf->off);
+ if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
+ nl = memchr(buf->buf, '\n', buf->len - (MAXLINE - buf->off));
+ if (nl)
+ { *linesz_out = (nl - buf->buf) + (MAXLINE - buf->off); return (0); }
+ }
+
+ return (-1);
+}
+
+/* Write a completed line out to the JOB's log file.
+ *
+ * The line starts at BUF->off, and continues for N bytes, not including the
+ * newline (which, in fact, might not exist at all). Precede the actual text
+ * of the line with the JOB's name, and the MARKER character, and follow it
+ * with the TAIL text (which should include an actual newline character).
+ */
+static void write_line(struct job *job, struct linebuf *buf,
+ size_t n, char marker, const char *tail)
+{
+ fprintf(job->log, "%-13s %c ", JOB_NAME(job), marker);
+ if (buf->off + n <= MAXLINE)
+ fwrite(buf->buf + buf->off, 1, n, job->log);
+ else {
+ fwrite(buf->buf + buf->off, 1, MAXLINE - buf->off, job->log);
+ fwrite(buf->buf, 1, n - (MAXLINE - buf->off), job->log);
+ }
+ fputs(tail, job->log);
+}
+
+/* Hash N bytes freshly added to the buffer BUF. */
+static void hash_input(struct linebuf *buf, size_t n, struct sha256_state *h)
+{
+ size_t start = (buf->off + buf->len)%MAXLINE;
+
+ if (start + n <= MAXLINE)
+ sha256_hash(h, buf->buf + start, n);
+ else {
+ sha256_hash(h, buf->buf + start, MAXLINE - start);
+ sha256_hash(h, buf->buf, n - (MAXLINE - start));
+ }
+}
+
+/* Collect output lines from JOB's process and write them to the log.
+ *
+ * Read data from BUF's file descriptor. Output complete (or overlong) lines
+ * usng `write_line'. On end-of-file, output any final incomplete line in
+ * the same way, close the descriptor, and set it to -1.
+ *
+ * As a rather unpleasant quirk, if the hash-state pointer H is not null,
+ * then also feed all the data received into it.
+ */
+static void prefix_lines(struct job *job, struct linebuf *buf, char marker,
+ struct sha256_state *h)
+{
+ struct iovec iov[2]; int niov;
+ ssize_t n;
+ size_t linesz;
+
+ /* Read data into the buffer. This fancy dance with readv(2) is probably
+ * overkill.
+ *
+ * We can't have BUF->len = MAXLINE because we'd have flushed out a
+ * maximum-length buffer as an incomplete line last time.
+ */
+ assert(buf->len < MAXLINE);
+ if (!buf->off) {
+ iov[0].iov_base = buf->buf + buf->len;
+ iov[0].iov_len = MAXLINE - buf->len;
+ niov = 1;
+ } else if (buf->off + buf->len >= MAXLINE) {
+ iov[0].iov_base = buf->buf + buf->off + buf->len - MAXLINE;
+ iov[0].iov_len = MAXLINE - buf->len;
+ niov = 1;
+ } else {
+ iov[0].iov_base = buf->buf + buf->off + buf->len;
+ iov[0].iov_len = MAXLINE - (buf->off + buf->len);
+ iov[1].iov_base = buf->buf;
+ iov[1].iov_len = buf->off;
+ niov = 1;
+ }
+ n = readv(buf->fd, iov, niov);
+
+ if (n < 0) {
+ /* An error occurred. If there's no data to read after all then just
+ * move on. Otherwise we have a problem.
+ */
+
+ if (errno == EAGAIN || errno == EWOULDBLOCK) return;
+ lose("failed to read job `%s' output stream: %s",
+ JOB_NAME(job), strerror(errno));
+ } else if (!n) {
+ /* We've hit end-of-file. Close the stream, and write out any
+ * unterminated partial line.
+ */
+
+ close(buf->fd); buf->fd = -1;
+ if (buf->len)
+ write_line(job, buf, buf->len, marker, " [missing final newline]\n");
+ } else {
+ /* We read some fresh data. Output any new complete lines. */
+
+ /* If we're supposed to hash data as it comes in then we should do that
+ * now.
+ */
+ if (h) hash_input(buf, n, h);
+
+ /* Include the new material in the buffer length, and write out any
+ * complete lines we find.
+ */
+ buf->len += n;
+ while (!find_newline(buf, &linesz)) {
+ write_line(job, buf, linesz, marker, "\n");
+ buf->len -= linesz + 1;
+ buf->off += linesz + 1; if (buf->off >= MAXLINE) buf->off -= MAXLINE;
+ }
+
+ if (!buf->len)
+ /* If there's nothing left then we might as well reset the buffer
+ * offset to the start of the buffer.
+ */
+ buf->off = 0;
+ else if (buf->len == MAXLINE) {
+ /* We've filled the buffer with stuff that's not a whole line. Flush
+ * it out anyway.
+ */
+ write_line(job, buf, MAXLINE, marker, " [...]\n");
+ buf->off = buf->len = 0;
+ }
+ }
+}
+
+/*----- Job management ----------------------------------------------------*/
+
+/* Record the SZ-byte leafname at P as being legitimate, so that it doesn't
+ * get junked.
+ */
+static void notice_filename(const char *p, size_t sz)
+{
+ struct treap_node *node;
struct treap_path path;
- struct config_section *sect;
- struct config_var *dump_var, *cmd_var;
- struct dstr d = DSTR_INIT;
- struct argv av = ARGV_INIT;
+
+ node = treap_probe(&good, p, sz, &path);
+ if (!node) {
+ node = xmalloc(sizeof(*node));
+ treap_insert(&good, &path, node, p, sz);
+ if (verbose >= 3) moan("noticed non-junk file `%.*s'", (int)sz, p);
+ }
+}
+
+/* There are basically two kinds of jobs.
+ *
+ * An `internal' job -- state `JST_INTERN' -- can be handled entirely within
+ * this process. Internal jobs have trivial lifecycles: they're created, put
+ * on a queue, executed, and thrown away. Jobs are executed when some code
+ * decides to walk the appropriate queue and do the work. As a result, they
+ * don't need to have distinctive states: `JST_INTERN' only exists to
+ * distinguish internal jobs from active ones if they somehow manage to end
+ * up in the external-job machinery.
+ *
+ * External jobs all work in basically the same way: we fork and exec a
+ * sequence of subprocess to do the work. The majority of handling external
+ * jobs is in the care and feeding of these subprocesses, so they end up on
+ * various lists primarily concerned with the state of the subprocesses, and
+ * the progress of the job through its sequence of subprocesses is recorded
+ * in the job's `st' field.
+ *
+ * External jobs have a comparatively complicated lifecycle.
+ *
+ * * Initially, the job is on the `ready' queue by `add_job'. It has no
+ * child process or log file.
+ *
+ * * At some point, `start_jobs' decides to start this job up: a log file
+ * is created (if the job doesn't have one already), a child process is
+ * forked, and pipes are set up to capture the child's output. It gets
+ * moved to the `run' list (which is not maintained in any particular
+ * order). Jobs on the `run' list participate in the main select(2)
+ * loop.
+ *
+ * * When the job's child process dies and the pipes capturing its output
+ * streams finally dry up, the job is considered finished. What happens
+ * next depends on its state: either it gets updated somehow, and pushed
+ * back onto the end of the `ready' queue so that another child can be
+ * started, or the job is finished and dies.
+ *
+ * The counter `nrun' counts the number of actually running jobs, i.e., those
+ * with living child processes. This doesn't simply count the number of jobs
+ * on the `run' list: remember that the latter also contains jobs whose child
+ * has died, but whose output has not yet been collected.
+ */
+
+/* Consider a Lisp system description and maybe add a job to the right queue.
+ *
+ * The Lisp system is described by the configuration section SECT. Most of
+ * the function is spent on inspecting this section for suitability and
+ * deciding what to do about it.
+ *
+ * The precise behaviour depends on F, which should be the bitwise-OR of a
+ * `JQ_...' constant and zero or more flags, as follows.
+ *
+ * * The bits covered by `JMASK_QUEUE' identify which queue the job should
+ * be added to if the section defines a cromulent Lisp system:
+ *
+ * -- `JQ_NONE' -- don't actually make a job at all;
+ * -- `JQ_READY' -- add the Lisp to the `job_ready' queue, so we'll; or
+ * -- `JQ_DELETE' -- add the Lisp to the `job_delete' queue.
+ *
+ * * `JF_PICKY': The user identified this Lisp system explicitly, so
+ * complain if the configuration section doesn't look right. This is
+ * clear if the caller is just enumerating all of the configuration
+ * sections: without this feature, we'd be checking everything twice,
+ * which (a) is inefficient, and -- more importantly -- (b) could lead to
+ * problems if the two checks are inconsistent.
+ *
+ * * `JF_CHECKINST': Ignore this Lisp if `AF_CHECKINST' is set and it's not
+ * actually installed. (This is usually set for `JQ_READY' calls, so
+ * that we don't try to dump Lisps which aren't there, but clear for
+ * `JQ_DELETE' calls so that we clear out Lisps which have gone away.)
+ *
+ * * `JF_CHECKEXIST': Ignore this Lisp if its image file already exists.
+ *
+ * * `JF_NOTICE': Record the Lisp's image basename in the `good' treap so
+ * that we can identify everything else we find in the image directory as
+ * junk.
+ */
+#define JMASK_QUEUE 3u /* which queue to add good Lisp to */
+#define JQ_NONE 0u /* don't add to any queue */
+#define JQ_READY 1u /* `job_ready' */
+#define JQ_DELETE 2u /* `job_delete' */
+#define JF_PICKY 4u /* lose if section isn't Lisp defn */
+#define JF_CHECKINST 8u /* maybe check Lisp is installed */
+#define JF_CHECKEXIST 16u /* skip if image already exists */
+#define JF_NOTICE 32u /* record Lisp's image basename */
+
+#define JADD_NAMED (JQ_READY | JF_PICKY | JF_CHECKINST)
+#define JADD_DEFAULT (JQ_READY | JF_CHECKINST)
+#define JADD_CLEANUP (JQ_DELETE)
+#define JADD_NOTICE (JQ_NONE)
+static void add_job(unsigned f, struct config_section *sect)
+{
+ const char *name;
+ struct job *job, ***tail;
+ struct treap_path jobpath;
+ struct config_var *dumpvar, *runvar, *imgvar;
+ struct dstr d = DSTR_INIT, dd = DSTR_INIT;
+ struct argv av_version = ARGV_INIT, av_dump = ARGV_INIT;
+ struct stat st;
+ char *imgnewlink = 0, *imglink = 0, *oldimg = 0, *p;
+ unsigned jst;
+ size_t i, len;
+ ssize_t n;
unsigned fef;
- job = treap_probe(&jobs, name, len, &path);
+ /* We'll want the section's name for all sorts of things. */
+ name = CONFIG_SECTION_NAME(sect);
+ len = CONFIG_SECTION_NAMELEN(sect);
+
+ /* Check to see whether this Lisp system is already queued up.
+ *
+ * We'll get around to adding the new job node to the treap right at the
+ * end, so use a separate path object to keep track of where to put it.
+ */
+ job = treap_probe(&jobs, name, len, &jobpath);
if (job) {
- if (verbose >= 2) {
+ if ((f&JF_PICKY) && verbose >= 1)
moan("ignoring duplicate Lisp `%s'", JOB_NAME(job));
- return;
- }
+ goto end;
}
- sect = config_find_section_n(&config, 0, name, len);
- if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name);
- name = CONFIG_SECTION_NAME(sect);
- dump_var = config_find_var(&config, sect, 0, "dump-image");
- if (!dump_var) {
- if (!(f&JF_QUIET))
- lose("don't know how to dump images for Lisp implementation `%s'",
- name);
+ /* Check that the section defines a Lisp, and that it can be dumped.
+ *
+ * It's not obvious that this is right. Maybe there should be some
+ * additional flag so that we don't check dumpability if we're planning to
+ * delete the image. But it /is/ right: since the thing which tells us
+ * whether we can dump is that the section tells us the image's name, if
+ * it can't be dumped then we won't know what file to delete! So we have
+ * no choice.
+ */
+ runvar = config_find_var(&config, sect, CF_INHERIT, "run-script");
+ if (!runvar) {
+ if (f&JF_PICKY) lose("unknown Lisp implementation `%s'", name);
+ else if (verbose >= 3) moan("skipping non-Lisp section `%s'", name);
+ goto end;
+ }
+ imgvar = config_find_var(&config, sect, CF_INHERIT, "image-file");
+ if (!imgvar) {
+ if (f&JF_PICKY)
+ lose("Lisp implementation `%s' doesn't use custom images", name);
+ else if (verbose >= 3)
+ moan("skipping Lisp `%s': no custom image support", name);
goto end;
}
- cmd_var = config_find_var(&config, sect, 0, "command");
- if (!cmd_var)
- lose("no `command' defined for Lisp implementation `%s'", name);
-
- config_subst_split_var(&config, sect, dump_var, &av);
- if (!av.n) lose("empty command for Lisp implementation `%s'", name);
- if (flags&AF_CHECKINST) {
- dstr_reset(&d);
- fef = (verbose >= 2 ? FEF_VERBOSE : 0);
- config_subst_var(&config, sect, cmd_var, &d);
- if (!found_in_path_p(d.p, fef) ||
- (STRCMP(d.p, !=, av.v[0]) && !found_in_path_p(av.v[0], fef))) {
- if (verbose >= 2) moan("skipping Lisp implementation `%s'", name);
+ /* Check that the other necessary variables are present. */
+ dumpvar = config_find_var(&config, sect, CF_INHERIT, "dump-image");
+ if (!dumpvar)
+ lose("variable `dump-image' not defined for Lisp `%s'", name);
+
+ /* Build the job's command lines. */
+ config_subst_split_var(&config, sect, runvar, &av_version);
+ if (!av_version.n)
+ lose("empty `run-script' command for Lisp implementation `%s'", name);
+ argv_append(&av_version,
+ config_subst_string_alloc
+ (&config, sect, "<internal>",
+ "?${lisp-version?(lisp-implementation-version)}"));
+ config_subst_split_var(&config, sect, dumpvar, &av_dump);
+ if (!av_dump.n)
+ lose("empty `dump-image' command for Lisp implementation `%s'", name);
+
+ /* If we're supposed to check that the Lisp exists before proceeding then
+ * do that. There are /two/ commands to check: the basic Lisp command,
+ * /and/ the command to actually do the dumping, which might not be the
+ * same thing. (Be careful not to check the same command twice, though,
+ * because that would cause us to spam the user with redundant
+ * diagnostics.)
+ */
+ if ((f&JF_CHECKINST) && (flags&AF_CHECKINST)) {
+ fef = (verbose >= 3 ? FEF_VERBOSE : 0);
+ if (!found_in_path_p(av_version.v[0], fef)) {
+ if (verbose >= 3)
+ moan("skipping Lisp `%s': can't find Lisp command `%s'",
+ name, av_version.v[0]);
+ goto end;
+ }
+ if (STRCMP(av_version.v[0], !=, av_dump.v[0]) &&
+ !found_in_path_p(av_dump.v[0], fef)) {
+ if (verbose >= 3)
+ moan("skipping Lisp `%s': can't find dump command `%s'",
+ av_dump.v[0], d.p);
goto end;
}
}
- if (!(flags&AF_FORCE)) {
- dstr_reset(&d);
- config_subst_string(&config, sect, "<internal>", "${@IMAGE}", &d);
- if (!access(d.p, F_OK)) {
- if (verbose >= 2)
- moan("image `%s' already exists: skipping `%s'", d.p, name);
- goto end;
+ /* Collect the output image file names. */
+ imglink =
+ config_subst_string_alloc(&config, sect, "<internal>", "${@image-link}");
+ imgnewlink =
+ config_subst_string_alloc(&config, sect,
+ "<internal>", "${@image-newlink}");
+
+ /* Determine the image link basename. If necessary, record it so that it
+ * doesn't get junked.
+ */
+ dstr_reset(&dd); config_subst_var(&config, sect, imgvar, &dd);
+ if (f&JF_NOTICE) notice_filename(dd.p, dd.len);
+
+ /* Fill in the directory name for the output image. */
+ dstr_reset(&d);
+ p = strrchr(imglink, '/');
+ if (p) dstr_putm(&d, imglink, p + 1 - imglink);
+
+ /* Inspect the existing image link if there is one, and record its
+ * destination.
+ */
+ for (;;) {
+
+ /* Read the link destination. The `lstat'/`readlink' two-step is
+ * suggested by the POSIX specification.
+ */
+ if (lstat(imglink, &st)) {
+ if (verbose >= (errno == ENOENT ? 3 : 1))
+ moan("failed to read metadata for Lisp `%s' image link `%s': %s",
+ name, imglink, strerror(errno));
+ break;
}
+ if (!S_ISLNK(st.st_mode)) {
+ if (verbose >= 1)
+ moan("Lisp `%s' image link `%s' isn't a symbolic link",
+ name, imglink);
+ break;
+ }
+ dstr_ensure(&d, st.st_size + 1);
+ n = readlink(imglink, d.p + d.len, d.sz - d.len);
+ if (n < 0) {
+ moan("failed to read Lisp `%s' image link `%s': %s",
+ name, imglink, strerror(errno));
+ break;
+ }
+ if (n == d.sz - d.len) continue;
+
+ /* Check that the link has the right form. (We don't want to delete the
+ * referent if it's not actually our image.)
+ *
+ * We expect the referent to look like ${image-file} followed by a hyphen
+ * and some hex digits.
+ */
+ if (n <= dd.len ||
+ STRNCMP(d.p + d.len, !=, dd.p, dd.len) ||
+ d.p[d.len + dd.len] != '-' ||
+ !hex_digits_p(d.p + (d.len + dd.len + 1), n - (dd.len + 1))) {
+ if (verbose >= 1)
+ moan("Lisp `%s' image link `%s' has unexpected referent `%s'",
+ name, imglink, d.p);
+ break;
+ }
+
+ /* OK, so it looks legit. Protect it from being junked. */
+ if (f&JF_NOTICE) notice_filename(d.p + d.len, n);
+ d.p[d.len + n] = 0; d.len += n;
+ oldimg = xstrndup(d.p, d.len);
+ break;
}
+ /* All preflight checks complete. Build the job and hook it onto the end
+ * of the list. (Steal the command-line vector so that we don't try to
+ * free it during cleanup.)
+ */
+ switch (f&JMASK_QUEUE) {
+ case JQ_NONE: jst = JST_INTERN; tail = 0; break;
+ case JQ_READY: jst = JST_VERSION; tail = &job_ready_tail; break;
+ case JQ_DELETE: jst = JST_INTERN; tail = &job_delete_tail; break;
+ default: assert(0);
+ }
job = xmalloc(sizeof(*job));
- job->st = JST_READY;
- job->kid = -1;
+ job->st = jst; job->sect = sect; job->dumpvar = dumpvar;
+ job->kid = -1; job->log = 0;
job->out.fd = -1; job->out.buf = 0;
job->err.fd = -1; job->err.buf = 0;
- job->av = av; argv_init(&av);
- treap_insert(&jobs, &path, &job->_node, name, len);
- **tail_inout = job; *tail_inout = &job->next;
+ job->av_version = av_version; argv_init(&av_version);
+ argv_init(&job->av_dump);
+ job->imgnew = 0; job->imghash = 0;
+ job->imgnewlink = imgnewlink; imgnewlink = 0;
+ job->imglink = imglink; imglink = 0;
+ job->oldimg = oldimg; oldimg = 0;
+ treap_insert(&jobs, &jobpath, &job->_node, name, len);
+ if (tail) { **tail = job; *tail = &job->next; }
+
end:
- dstr_release(&d); argv_release(&av);
+ /* All done. Cleanup time. */
+ for (i = 0; i < av_version.n; i++) free(av_version.v[i]);
+ for (i = 0; i < av_dump.n; i++) free(av_dump.v[i]);
+ free(imgnewlink); free(imglink); free(oldimg);
+ dstr_release(&d); dstr_release(&dd);
+ argv_release(&av_version); argv_release(&av_dump);
+}
+
+/* As `add_job' above, but look the Lisp implementation up by name.
+ *
+ * The flags passed to `add_job' are augmented with `JF_PICKY' because this
+ * is an explicitly-named Lisp implementation.
+ */
+static void add_named_job(unsigned f, const char *name, size_t len)
+{
+ struct config_section *sect;
+
+ sect = config_find_section_n(&config, 0, name, len);
+ if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name);
+ add_job(f | JF_PICKY, sect);
}
+/* Free the JOB and all the resources it holds.
+ *
+ * Close the pipes; kill the child process. Everything must go.
+ */
static void release_job(struct job *job)
{
+ size_t i;
+ struct job *j;
+
if (job->kid > 0) kill(job->kid, SIGKILL); /* ?? */
if (job->log && job->log != stdout) fclose(job->log);
+ free(job->imgnew); free(job->imghash);
+ free(job->imglink); free(job->imgnewlink);
+ free(job->oldimg);
+ for (i = 0; i < job->av_version.n; i++) free(job->av_version.v[i]);
+ for (i = 0; i < job->av_dump.n; i++) free(job->av_dump.v[i]);
+ argv_release(&job->av_version); argv_release(&job->av_dump);
free(job->out.buf); if (job->out.fd >= 0) close(job->out.fd);
free(job->err.buf); if (job->err.fd >= 0) close(job->err.fd);
+ j = treap_remove(&jobs, JOB_NAME(job), JOB_NAMELEN(job)); assert(j == job);
free(job);
}
+/* Do all the necessary things when JOB finishes (successfully or not).
+ *
+ * Eventually the job is either freed (using `release_job'), or updated and
+ * stuffed back into the `job_run' queue. The caller is expected to have
+ * already unlinked the job from its current list.
+ */
static void finish_job(struct job *job)
{
- char buf[16483];
- size_t n;
+ char buf[16483], *p;
+ unsigned char *hbuf;
+ struct dstr d = DSTR_INIT;
+ size_t i, n;
int ok = 0;
+ /* Start a final line to the job log describing its eventual fate.
+ *
+ * This is where we actually pick apart the exit status. Set `ok' if it
+ * actually succeeded, because that's all anything else cares about.
+ */
fprintf(job->log, "%-13s > ", JOB_NAME(job));
if (WIFEXITED(job->exit)) {
if (!WEXITSTATUS(job->exit))
fprintf(job->log, "exited with incomprehensible status %06o\n",
job->exit);
- if (!ok && verbose < 2) {
- rewind(job->log);
- for (;;) {
- n = fread(buf, 1, sizeof(buf), job->log);
- if (n) fwrite(buf, 1, n, stdout);
- if (n < sizeof(buf)) break;
- }
- }
+ /* What happens next depends on the state of the job. This is the main
+ * place which advances the job state machine.
+ */
+ if (ok) switch (job->st) {
- release_job(job);
-}
+ case JST_VERSION:
+ /* We've retrieved the Lisp system's version string. */
-static int find_newline(struct linebuf *buf, size_t *linesz_out)
-{
- char *nl;
+ /* Complete the hashing and convert to hex. */
+ hbuf = (unsigned char *)buf + 32; sha256_done(&job->h, hbuf);
+ for (i = 0; i < 8; i++) sprintf(buf + 2*i, "%02x", hbuf[i]);
+ if (verbose >= 2)
+ moan("Lisp `%s' version hash = %s", JOB_NAME(job), buf);
+
+ /* Determine the final version-qualified name for the image. */
+ config_set_var(&config, job->sect, CF_LITERAL, "@hash", buf);
+ job->imghash =
+ config_subst_string_alloc(&config, job->sect,
+ "<internal>", "${@image-out}");
+ job->imgnew =
+ config_subst_string_alloc(&config, job->sect,
+ "<internal>", "${@image-new}");
+
+ /* Determine the basename of the final image. */
+ p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
+
+ /* Inspect the current link pointer to see if we have the right
+ * version.
+ */
+ if (!(flags&AF_FORCE) &&
+ job->oldimg &&
+ STRCMP(job->oldimg, ==, job->imghash) &&
+ !access(job->oldimg, F_OK)) {
+ if (verbose >= 2)
+ moan("Lisp `%s' image `%s' already up-to-date",
+ JOB_NAME(job), job->imghash);
+ break;
+ }
- if (buf->off + buf->len <= MAXLINE) {
- nl = memchr(buf->buf + buf->off, '\n', buf->len);
- if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
- } else {
- nl = memchr(buf->buf + buf->off, '\n', MAXLINE - buf->off);
- if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
- nl = memchr(buf->buf, '\n', buf->len - (MAXLINE - buf->off));
- if (nl)
- { *linesz_out = (nl - buf->buf) + (MAXLINE - buf->off); return (0); }
- }
- return (-1);
-}
+ /* Make sure that there's a clear space for the new image to be
+ * written.
+ */
+ if (!(flags&AF_DRYRUN) && unlink(job->imgnew) && errno != ENOENT) {
+ bad("failed to clear Lisp `%s' image staging path `%s': %s",
+ JOB_NAME(job), job->imgnew, strerror(errno));
+ break;
+ }
-static void write_line(struct job *job, struct linebuf *buf,
- size_t n, char marker, const char *tail)
-{
- fprintf(job->log, "%-13s %c ", JOB_NAME(job), marker);
- if (buf->off + n <= MAXLINE)
- fwrite(buf->buf + buf->off, 1, n, job->log);
- else {
- fwrite(buf->buf + buf->off, 1, MAXLINE - buf->off, job->log);
- fwrite(buf->buf, 1, n - (MAXLINE - buf->off), job->log);
- }
- fputs(tail, job->log);
-}
+ /* If we're still here then we've decided to dump a new image. Update
+ * the job state, and put it back on the run queue.
+ */
+ config_subst_split_var(&config, job->sect,
+ job->dumpvar, &job->av_dump);
+ assert(job->av_dump.n);
+ job->st = JST_DUMP;
+ *job_ready_tail = job; job_ready_tail = &job->next; job->next = 0;
+ job = 0;
+ break;
+
+ case JST_DUMP:
+ /* We've finished dumping a custom image. It's time to apply the
+ * finishing touches.
+ */
+
+ /* Rename the image into place. If this fails, blame it on the dump
+ * job, because the chances are good that it failed to produce the
+ * image properly.
+ */
+ if (verbose >= 3)
+ moan("rename completed Lisp `%s' image `%s' to `%s'",
+ JOB_NAME(job), job->imgnew, job->imghash);
+ if (rename(job->imgnew, job->imghash)) {
+ fprintf(job->log, "%-13s > failed to rename Lisp `%s' "
+ "output image `%s' to `%s': %s",
+ JOB_NAME(job), JOB_NAME(job),
+ job->imgnew, job->imghash, strerror(errno));
+ ok = 0; break;
+ }
+
+ /* Notice the image so that it doesn't get junked. */
+ if (flags&AF_JUNK) {
+ p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
+ notice_filename(p, strlen(p));
+ }
+
+ /* Determine the basename of the final image. */
+ p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
+
+ /* Build the symlink. Start by setting the link in the staging path,
+ * and then rename, in order to ensure continuity.
+ */
+ if (unlink(job->imgnewlink) && errno != ENOENT) {
+ bad("failed to clear Lisp `%s' link staging path `%s': %s",
+ JOB_NAME(job), job->imgnewlink, strerror(errno));
+ break;
+ }
+ if (verbose >= 3)
+ moan("establish Lisp `%s' image link `%s' referring to `%s'",
+ JOB_NAME(job), job->imglink, job->imghash);
+ if (symlink(p, job->imgnewlink)) {
+ bad("failed to create Lisp `%s' image link `%s': %s",
+ JOB_NAME(job), job->imgnewlink, strerror(errno));
+ break;
+ }
+ if (rename(job->imgnewlink, job->imglink)) {
+ bad("failed to rename Lisp `%s' image link `%s' to `%s': %s",
+ JOB_NAME(job), job->imgnewlink, job->imglink, strerror(errno));
+ break;
+ }
+ if (job->oldimg && STRCMP(job->oldimg, !=, job->imghash)) {
+ if (verbose >= 3)
+ moan("remove old Lisp `%s' image `%s'",
+ JOB_NAME(job), job->oldimg);
+ if (unlink(job->oldimg) && errno != ENOENT) {
+ if (verbose >= 1)
+ moan("failed to delete old Lisp `%s' image `%s': %s",
+ JOB_NAME(job), job->oldimg, strerror(errno));
+ }
+ }
-static void prefix_lines(struct job *job, struct linebuf *buf, char marker)
-{
- struct iovec iov[2]; int niov;
- ssize_t n;
- size_t linesz;
+ /* I think we're all done. */
+ break;
- assert(buf->len < MAXLINE);
- if (!buf->off) {
- iov[0].iov_base = buf->buf + buf->len;
- iov[0].iov_len = MAXLINE - buf->len;
- niov = 1;
- } else if (buf->off + buf->len >= MAXLINE) {
- iov[0].iov_base = buf->buf + buf->off + buf->len - MAXLINE;
- iov[0].iov_len = MAXLINE - buf->len;
- niov = 1;
- } else {
- iov[0].iov_base = buf->buf + buf->off + buf->len;
- iov[0].iov_len = MAXLINE - (buf->off + buf->len);
- iov[1].iov_base = buf->buf;
- iov[1].iov_len = buf->off;
- niov = 1;
+ default:
+ assert(0);
}
- n = readv(buf->fd, iov, niov);
- if (n < 0) {
- if (errno == EAGAIN || errno == EWOULDBLOCK) return;
- lose("failed to read job `%s' output stream: %s",
- JOB_NAME(job), strerror(errno));
+ /* If the job failed and we're being quiet then write out the log that we
+ * made.
+ */
+ if (!ok && verbose < 2) {
+ rewind(job->log);
+ for (;;) {
+ n = fread(buf, 1, sizeof(buf), job->log);
+ if (n) fwrite(buf, 1, n, stdout);
+ if (n < sizeof(buf)) break;
+ }
}
- buf->len += n;
- while (!find_newline(buf, &linesz)) {
- write_line(job, buf, linesz, marker, "\n");
- buf->len -= linesz + 1;
- buf->off += linesz + 1; if (buf->off >= MAXLINE) buf->off -= MAXLINE;
- }
- if (!buf->len)
- buf->off = 0;
- else if (buf->len == MAXLINE) {
- write_line(job, buf, MAXLINE, marker, " [...]\n");
- buf->off = buf->len = 0;
- }
+ /* Also make a node to stderr about what happened. (Just to make sure
+ * that we've gotten someone's attention.)
+ */
+ if (!ok) bad("failed to dump Lisp `%s'", JOB_NAME(job));
- if (!n) {
- close(buf->fd); buf->fd = -1;
- if (buf->len)
- write_line(job, buf, buf->len, marker, " [missing final newline]\n");
- }
+ /* Finally free the job control block. */
+ if (job) release_job(job);
+ dstr_release(&d);
}
+/* Called after `SIGCHLD': collect exit statuses and mark jobs as dead. */
static void reap_children(void)
{
- struct job *job, **link;
+ struct job *job;
pid_t kid;
int st;
for (;;) {
+
+ /* Collect a child exit status. If there aren't any more then we're
+ * done.
+ */
kid = waitpid(0, &st, WNOHANG);
if (kid <= 0) break;
- for (link = &job_run; (job = *link); link = &job->next)
+
+ /* Try to find a matching job. If we can't, then we should just ignore
+ * it.
+ */
+ for (job = job_run; job; job = job->next)
if (job->kid == kid) goto found;
- moan("unexpected child process %d exited with status %06o", kid, st);
continue;
+
found:
- job->exit = st; job->st = JST_DEAD; job->kid = -1; nrun--;
- *link = job->next; job->next = job_dead; job_dead = job;
+ /* Mark the job as dead, and save its exit status. */
+ job->exit = st; job->kid = -1; nrun--;
}
+
+ /* If there was a problem with waitpid(2) then report it. */
if (kid < 0 && errno != ECHILD)
lose("failed to collect child process exit status: %s", strerror(errno));
}
-static void check_signals(void)
-{
- sigset_t old, pend;
- char buf[32];
- ssize_t n;
-
- sigprocmask(SIG_BLOCK, &caught, &old);
- pend = pending; sigemptyset(&pending);
- for (;;) {
- n = read(sig_pipe[0], buf, sizeof(buf));
- if (!n) lose("(internal) signal pipe closed!");
- if (n < 0) break;
- }
- if (errno != EAGAIN && errno != EWOULDBLOCK)
- lose("failed to read signal pipe: %s", strerror(errno));
- sigprocmask(SIG_SETMASK, &old, 0);
-
- if (sigismember(&pend, SIGINT)) sigloss = SIGINT;
- else if (sigismember(&pend, SIGHUP)) sigloss = SIGHUP;
- else if (sigismember(&pend, SIGTERM)) sigloss = SIGTERM;
- if (sigismember(&pend, SIGCHLD)) reap_children();
-}
-
-#define SIGF_IGNOK 1u
-static void set_signal_handler(const char *what, int sig, unsigned f)
-{
- struct sigaction sa, sa_old;
-
- sigaddset(&caught, sig);
-
- if (f&SIGF_IGNOK) {
- if (sigaction(sig, 0, &sa_old)) goto fail;
- if (sa_old.sa_handler == SIG_IGN) return;
- }
-
- sa.sa_handler = handle_signal;
- sigemptyset(&sa.sa_mask);
- sa.sa_flags = SA_NOCLDSTOP;
- if (sigaction(sig, &sa, 0)) goto fail;
-
- return;
-
-fail:
- lose("failed to set %s signal handler: %s", what, strerror(errno));
-}
-
-static NORETURN void job_child(struct job *job)
+/* Execute the handler for some JOB. */
+static NORETURN void job_child(struct job *job, struct argv *av)
{
- try_exec(&job->av,
- !(flags&AF_CHECKINST) && verbose >= 2 ? TEF_VERBOSE : 0);
- moan("failed to run `%s': %s", job->av.v[0], strerror(errno));
- _exit(2);
+ try_exec(av, 0);
+ moan("failed to run `%s': %s", av->v[0], strerror(errno));
+ _exit(127);
}
+/* Start up jobs while there are (a) jobs to run and (b) slots to run them
+ * in.
+ */
static void start_jobs(void)
{
struct dstr d = DSTR_INIT;
int p_out[2], p_err[2];
struct job *job;
+ struct argv *av;
pid_t kid;
+ /* Keep going until either we run out of jobs, or we've got enough running
+ * already.
+ */
while (job_ready && nrun < maxrun) {
+
+ /* Set things up ready. If things go wrong, we need to know what stuff
+ * needs to be cleaned up.
+ */
job = job_ready; job_ready = job->next;
+ if (!job_ready) job_ready_tail = &job_ready;
p_out[0] = p_out[1] = p_err[0] = p_err[1] = -1;
- dstr_reset(&d); dstr_putf(&d, "%s/%s", tmpdir, JOB_NAME(job));
- if (mkdir(d.p, 0700)) {
- bad("failed to create working directory for job `%s': %s",
- JOB_NAME(job), strerror(errno));
- goto fail;
+
+ /* Figure out what to do. */
+ switch (job->st) {
+ case JST_VERSION: av = &job->av_version; break;
+ case JST_DUMP: av = &job->av_dump; break;
+ default: assert(0);
}
- if (verbose >= 2)
- job->log = stdout;
- else {
- dstr_puts(&d, "/log"); job->log = fopen(d.p, "w+");
- if (!job->log)
- lose("failed to open log file `%s': %s", d.p, strerror(errno));
+
+ /* If we're not actually going to do anything, now is the time to not do
+ * that. We should do the version-hashing step unconditionally.
+ */
+ switch (job->st) {
+ case JST_VERSION:
+ break;
+ case JST_DUMP:
+ if (flags&AF_DRYRUN) {
+ if (try_exec(av,
+ TEF_DRYRUN |
+ (verbose >= 2 && !(flags&AF_CHECKINST)
+ ? TEF_VERBOSE : 0)))
+ rc = 127;
+ else if (verbose >= 2)
+ printf("%-13s > not dumping `%s' (dry run)\n",
+ JOB_NAME(job), JOB_NAME(job));
+ release_job(job);
+ continue;
+ }
+ break;
+ default:
+ assert(0);
+ }
+
+ /* Do one-time setup for external jobs. */
+ if (!job->log) {
+
+ /* Make a temporary subdirectory for this job to use. */
+ dstr_reset(&d); dstr_putf(&d, "%s/%s", tmpdir, JOB_NAME(job));
+ if (mkdir(d.p, 0700)) {
+ bad("failed to create working directory for job `%s': %s",
+ JOB_NAME(job), strerror(errno));
+ goto fail;
+ }
+
+ /* Create the job's log file. If we're being verbose then that's just
+ * our normal standard output -- /not/ stderr: it's likely that users
+ * will want to pipe this stuff through a pager or something, and
+ * that'll be easier if we use stdout. Otherwise, make a file in the
+ * temporary directory.
+ */
+ if (verbose >= 2)
+ job->log = stdout;
+ else {
+ dstr_puts(&d, "/log"); job->log = fopen(d.p, "w+");
+ if (!job->log)
+ lose("failed to open log file `%s': %s", d.p, strerror(errno));
+ }
}
+
+ /* Make the pipes to capture the child process's standard output and
+ * error streams.
+ */
if (pipe(p_out) || pipe(p_err)) {
bad("failed to create pipes for job `%s': %s",
JOB_NAME(job), strerror(errno));
configure_fd("job stderr pipe", p_err[1], 0, 1) ||
configure_fd("log file", fileno(job->log), 1, 1))
goto fail;
+
+ /* Initialize the output-processing structures ready for use. */
+ if (job->st == JST_VERSION) sha256_init(&job->h);
job->out.buf = xmalloc(MAXLINE); job->out.off = job->out.len = 0;
job->out.fd = p_out[0]; p_out[0] = -1;
job->err.buf = xmalloc(MAXLINE); job->err.off = job->err.len = 0;
job->err.fd = p_err[0]; p_err[0] = -1;
- dstr_reset(&d); argv_string(&d, &job->av);
+
+ /* Print a note to the top of the log. */
+ dstr_reset(&d); argv_string(&d, av);
fprintf(job->log, "%-13s > starting %s\n", JOB_NAME(job), d.p);
+
+ /* Flush the standard output stream. (Otherwise the child might try to
+ * flush it too.)
+ */
fflush(stdout);
+
+ /* Spin up the child process. */
kid = fork();
if (kid < 0) {
bad("failed to fork process for job `%s': %s",
dup2(p_err[1], 2) < 0)
lose("failed to juggle job `%s' file descriptors: %s",
JOB_NAME(job), strerror(errno));
- job_child(job);
+ job_child(job, av);
}
+
+ /* Close the ends of the pipes that we don't need. Move the job into
+ * the running list.
+ */
close(p_out[1]); close(p_err[1]);
- job->kid = kid;
- job->st = JST_RUN; job->next = job_run; job_run = job; nrun++;
+ job->kid = kid; job->next = job_run; job_run = job; nrun++;
continue;
+
fail:
+ /* Clean up the wreckage if it didn't work. */
if (p_out[0] >= 0) close(p_out[0]);
if (p_out[1] >= 0) close(p_out[1]);
if (p_err[0] >= 0) close(p_err[0]);
if (p_err[1] >= 0) close(p_err[1]);
release_job(job);
}
+
+ /* All done except for some final tidying up. */
dstr_release(&d);
}
+/* Take care of all of the jobs until they're all done. */
+static void run_jobs(void)
+{
+ struct job *job, *next, **link;
+ int nfd;
+ fd_set fd_in;
+
+ for (;;) {
+
+ /* If there are jobs still to be started and we have slots to spare then
+ * start some more up.
+ */
+ start_jobs();
+
+ /* If the queues are now all empty then we're done. (No need to check
+ * `job_ready' here: `start_jobs' would have started them if `job_run'
+ * was empty.
+ */
+ if (!job_run) break;
+
+ /* Prepare for the select(2) call: watch for the signal pipe and all of
+ * the job pipes.
+ */
+#define SET_FD(dir, fd) do { \
+ int _fd = (fd); \
+ FD_SET(_fd, &fd_##dir); \
+ if (_fd >= nfd) nfd = _fd + 1; \
+} while (0)
+
+ FD_ZERO(&fd_in); nfd = 0;
+ SET_FD(in, sig_pipe[0]);
+ for (job = job_run; job; job = job->next) {
+ if (job->out.fd >= 0) SET_FD(in, job->out.fd);
+ if (job->err.fd >= 0) SET_FD(in, job->err.fd);
+ }
+
+#undef SET_FD
+
+ /* Find out what's going on. */
+ if (select(nfd, &fd_in, 0, 0, 0) < 0) {
+ if (errno == EINTR) continue;
+ else lose("select failed: %s", strerror(errno));
+ }
+
+ /* If there were any signals then handle them. */
+ if (FD_ISSET(sig_pipe[0], &fd_in)) {
+ check_signals();
+ if (sigloss >= 0) {
+ /* We hit a fatal signal. Kill off the remaining jobs and abort. */
+ for (job = job_ready; job; job = next)
+ { next = job->next; release_job(job); }
+ for (job = job_run; job; job = next)
+ { next = job->next; release_job(job); }
+ break;
+ }
+ }
+
+ /* Collect output from running jobs, and clear away any dead jobs once
+ * we've collected all their output.
+ */
+ for (link = &job_run, job = *link; job; job = next) {
+ if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
+ prefix_lines(job, &job->out, '|',
+ job->st == JST_VERSION ? &job->h : 0);
+ if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
+ prefix_lines(job, &job->err, '*', 0);
+ next = job->next;
+ if (job->kid > 0 || job->out.fd >= 0 || job->err.fd >= 0)
+ link = &job->next;
+ else
+ { *link = next; finish_job(job); }
+ }
+ }
+}
+
+/*----- Main program ------------------------------------------------------*/
+
+/* Help and related functions. */
static void version(FILE *fp)
{ fprintf(fp, "%s, runlisp version %s\n", progname, PACKAGE_VERSION); }
static void usage(FILE *fp)
{
fprintf(fp, "\
-usage: %s [-afnqv] [-c CONF] [-o [SECT:]VAR=VAL]\n\
+usage: %s [-RUafinqrv] [+RUfinr] [-c CONF] [-o [SECT:]VAR=VAL]\n\
[-O FILE|DIR] [-j NJOBS] [LISP ...]\n",
progname);
}
{
version(fp); fputc('\n', fp); usage(fp);
fputs("\n\
-Help options:\n\
+Help options\n\
-h, --help Show this help text and exit successfully.\n\
-V, --version Show version number and exit successfully.\n\
\n\
-Diagnostics:\n\
+Diagnostics\n\
-n, --dry-run Don't run run anything (useful with `-v').\n\
-q, --quiet Don't print warning messages.\n\
-v, --verbose Print informational messages (repeatable).\n\
\n\
-Configuration:\n\
+Configuration\n\
-c, --config-file=CONF Read configuration from CONF (repeatable).\n\
-o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\
\n\
-Image dumping:\n\
+Image dumping\n\
-O, --output=FILE|DIR Store image(s) in FILE or DIR.\n\
- -a, --all-configured Dump all implementations configured.\n\
+ -R, --remove-other Delete image files for other Lisp systems.\n\
+ -U, --remove-unknown Delete unrecognized files in image dir.\n\
+ -a, --all-configured Select all configured implementations.\n\
-f, --force Dump images even if they already exist.\n\
- -i, --check-installed Check Lisp systems exist before invoking.\n\
- -j, --jobs=NJOBS Run up to NJOBS jobs in parallel.\n",
+ -i, --check-installed Check Lisp systems exist before dumping.\n\
+ -j, --jobs=NJOBS Run up to NJOBS jobs in parallel.\n\
+ -r, --remove-image Delete image files, instead of creating.\n",
fp);
}
+static void show_job_list(const char *what, struct job *job)
+{
+ struct dstr d = DSTR_INIT;
+ int first;
+
+ first = 1;
+ for (; job; job = job->next) {
+ if (first) first = 0;
+ else dstr_puts(&d, ", ");
+ dstr_putf(&d, "`%s'", JOB_NAME(job));
+ }
+ if (first) dstr_puts(&d, "(none)");
+ dstr_putz(&d);
+ moan("%s: %s", what, d.p);
+}
+
+/* Main program. */
int main(int argc, char *argv[])
{
struct config_section_iter si;
struct config_section *sect;
struct config_var *var;
const char *out = 0, *p, *q, *l;
- struct job *job, **tail, **link, *next;
+ struct job *job;
struct stat st;
struct dstr d = DSTR_INIT;
- int i, fd, nfd, first;
- fd_set fd_in;
+ DIR *dir;
+ struct dirent *de;
+ int i, fd;
+ size_t n, o;
+ unsigned f;
+ /* Command-line options. */
static const struct option opts[] = {
{ "help", 0, 0, 'h' },
{ "version", 0, 0, 'V' },
{ "output", OPTF_ARGREQ, 0, 'O' },
+ { "remove-other", OPTF_NEGATE, 0, 'R' },
+ { "remove-unknown", OPTF_NEGATE, 0, 'U' },
{ "all-configured", 0, 0, 'a' },
{ "config-file", OPTF_ARGREQ, 0, 'c' },
{ "force", OPTF_NEGATE, 0, 'f' },
{ "dry-run", OPTF_NEGATE, 0, 'n' },
{ "set-option", OPTF_ARGREQ, 0, 'o' },
{ "quiet", 0, 0, 'q' },
+ { "remove-image", OPTF_NEGATE, 0, 'r' },
{ "verbose", 0, 0, 'v' },
{ 0, 0, 0, 0 }
};
+ /* Initial setup. */
set_progname(argv[0]);
init_config();
+ srand(time(0));
+ /* Parse the options. */
optprog = (/*unconst*/ char *)progname;
+
+#define FLAGOPT(ch, f) \
+ case ch: \
+ flags |= f; \
+ break; \
+ case ch | OPTF_NEGATED: \
+ flags &= ~f; \
+ break
+
for (;;) {
- i = mdwopt(argc - 1, argv + 1, "hVO:ac:f+i+j:n+o:qv", opts, 0, 0,
+ i = mdwopt(argc - 1, argv + 1, "hVO:R+U+ac:f+i+j:n+o:qr+v", opts, 0, 0,
OPTF_NEGATION | OPTF_NOPROGNAME);
if (i < 0) break;
switch (i) {
case 'h': help(stdout); exit(0);
case 'V': version(stdout); exit(0);
case 'O': out = optarg; break;
+ FLAGOPT('R', AF_CLEAN);
+ FLAGOPT('U', AF_JUNK);
case 'a': flags |= AF_ALL; break;
case 'c': read_config_path(optarg, 0); flags |= AF_SETCONF; break;
- case 'f': flags |= AF_FORCE; break;
- case 'f' | OPTF_NEGATED: flags &= ~AF_FORCE; break;
- case 'i': flags |= AF_CHECKINST; break;
- case 'i' | OPTF_NEGATED: flags &= ~AF_CHECKINST; break;
+ FLAGOPT('f', AF_FORCE);
+ FLAGOPT('i', AF_CHECKINST);
case 'j': maxrun = parse_int("number of jobs", optarg, 1, 65535); break;
- case 'n': flags |= AF_DRYRUN; break;
- case 'n' | OPTF_NEGATED: flags &= ~AF_DRYRUN; break;
+ FLAGOPT('n', AF_DRYRUN);
case 'o': if (set_config_var(optarg)) flags |= AF_BOGUS; break;
case 'q': if (verbose) verbose--; break;
+ FLAGOPT('r', AF_REMOVE);
case 'v': verbose++; break;
default: flags |= AF_BOGUS; break;
}
}
+#undef FLAGOPT
+
+ /* CHeck that everything worked. */
optind++;
if ((flags&AF_ALL) ? optind < argc : optind >= argc) flags |= AF_BOGUS;
- if (flags&AF_BOGUS) { usage(stderr); exit(2); }
+ if (flags&AF_BOGUS) { usage(stderr); exit(127); }
+ /* Load default configuration if no explicit files were requested. */
if (!(flags&AF_SETCONF)) load_default_config();
- if (!out)
- config_set_var(&config, builtin, 0,
- "@IMAGE", "${@CONFIG:image-dir}/${image-file}");
- else if (stat(out, &st) || !S_ISDIR(st.st_mode))
- config_set_var(&config, builtin, CF_LITERAL, "@IMAGE", out);
- else {
- config_set_var(&config, builtin, CF_LITERAL, "@%OUTDIR", out);
- config_set_var(&config, builtin, 0,
- "@IMAGE", "${@BUILTIN:@%OUTDIR}/${image-file}");
+ /* OK, so we've probably got some work to do. Let's set things up ready.
+ * It'll be annoying if our standard descriptors aren't actually set up
+ * properly, so we'll make sure those slots are populated. We'll need a
+ * `/dev/null' descriptor anyway (to be stdin for the jobs). We'll also
+ * need a temporary directory, and it'll be less temporary if we don't
+ * arrange to delete it when we're done. And finally we'll need to know
+ * when a child process exits.
+ */
+ for (;;) {
+ fd = open("/dev/null", O_RDWR);
+ if (fd < 0) lose("failed to open `/dev/null': %s", strerror(errno));
+ if (fd > 2) { nullfd = fd; break; }
}
-
+ configure_fd("null fd", nullfd, 0, 1);
atexit(cleanup);
if (pipe(sig_pipe))
lose("failed to create signal pipe: %s", strerror(errno));
set_signal_handler("SIGHUP", SIGHUP, SIGF_IGNOK);
set_signal_handler("SIGCHLD", SIGCHLD, 0);
+ /* Create the temporary directory and export it into the configuration. */
set_tmpdir();
- config_set_var(&config, builtin, CF_LITERAL, "@%TMPDIR", tmpdir);
+ config_set_var(&config, builtin, CF_LITERAL, "@%tmp-dir", tmpdir);
+ config_set_var(&config, builtin, 0,
+ "@tmp-dir", "${@BUILTIN:@%tmp-dir}/${@name}");
+
+ /* Work out where the image files are going to go. If there's no `-O'
+ * option then we use the main `image-dir'. Otherwise what happens depends
+ * on whether this is a file or a directory.
+ */
+ if (!out) {
+ config_set_var(&config, builtin, 0,
+ "@image-link", "${@image-dir}/${image-file}");
+ var = config_find_var(&config, builtin, CF_INHERIT, "@image-dir");
+ assert(var); out = config_subst_var_alloc(&config, builtin, var);
+ } else if (!stat(out, &st) && S_ISDIR(st.st_mode)) {
+ config_set_var(&config, builtin, CF_LITERAL, "@%out-dir", out);
+ config_set_var(&config, builtin, 0,
+ "@image-link", "${@BUILTIN:@%out-dir}/${image-file}");
+ } else if (argc - optind != 1)
+ lose("can't dump multiple Lisps to a single output file");
+ else if (flags&AF_JUNK)
+ lose("can't clear junk in a single output file");
+ else if (flags&AF_CLEAN)
+ lose("can't clean other images with a single output file");
+ else
+ config_set_var(&config, builtin, CF_LITERAL, "@image-link", out);
+
+ /* Set the staging and versioned filenames. */
+ config_set_var(&config, builtin, 0,
+ "@image-out", "${@image-link}-${@hash}");
+ config_set_var(&config, builtin, 0, "@image-new", "${@image-out}.new");
config_set_var(&config, builtin, 0,
- "@TMPDIR", "${@BUILTIN:@%TMPDIR}/${@NAME}");
+ "@image-newlink", "${@image-link}.new");
+ config_set_var(&config, builtin, 0, "@script",
+ "${@ENV:RUNLISP_EVAL?"
+ "${@CONFIG:eval-script?"
+ "${@data-dir}/eval.lisp}}");
+
+ /* Configure an initial value for `@hash'. This is necessary so that
+ * `add_job' can expand `dump-image' to check that the command exists.
+ */
+ config_set_var(&config, builtin, CF_LITERAL, "@hash", "!!!unset!!!");
+
+ /* Dump the final configuration if we're being very verbose. */
if (verbose >= 5) dump_config();
- tail = &job_ready;
- if (!(flags&AF_ALL))
- for (i = optind; i < argc; i++)
- add_job(&tail, 0, argv[i], strlen(argv[i]));
- else {
- var = config_find_var(&config, toplevel, 0, "dump");
- if (!var)
- for (config_start_section_iter(&config, &si);
- (sect = config_next_section(&si)); )
- add_job(&tail, JF_QUIET,
- CONFIG_SECTION_NAME(sect),
- CONFIG_SECTION_NAMELEN(sect));
+ /* There are a number of different strategies we might employ, depending on
+ * the exact request.
+ *
+ * queue queue clear
+ * REMOVE CLEAN JUNK selected others junk?
+ *
+ * * nil nil ready/delete -- no
+ * * nil t ready/delete none yes
+ * nil t nil ready delete no
+ * nil t t ready -- yes
+ * t t nil -- delete no
+ * t t t -- -- yes
+ */
+
+ /* First step: if `AF_REMOVE' and `AF_CLEAN' are not both set, then scan
+ * the selected Lisp systems and add them to the appropriate queue.
+ *
+ * Bit-hack: if they are not both set, then their complements are not both
+ * clear.
+ */
+ if (~flags&(AF_REMOVE | AF_CLEAN)) {
+
+ /* Determine the flags for `add_job' when we select the Lisp systems. If
+ * we intend to clear junk then we must notice the image names we
+ * encounter. If we're supposed to check that Lisps exist before dumping
+ * then do that -- but it doesn't make any sense for deletion.
+ */
+ f = flags&AF_REMOVE ? JQ_DELETE : JQ_READY;
+ if (flags&AF_JUNK) f |= JF_NOTICE;
+ if (flags&AF_CHECKINST) f |= JF_CHECKINST;
+ if (!(flags&(AF_FORCE | AF_REMOVE))) f |= JF_CHECKEXIST;
+
+ /* If we have named Lisps, then process them. */
+ if (!(flags&AF_ALL))
+ for (i = optind; i < argc; i++)
+ add_named_job(f, argv[i], strlen(argv[i]));
+
+ /* Otherwise we're supposed to dump `all' of them. If there's a `dump'
+ * configuration setting then we need to parse that. Otherwise we just
+ * try all of them.
+ */
else {
- p = var->val; l = p + var->n;
- for (;;) {
- while (p < l && ISSPACE(*p)) p++;
- if (p >= l) break;
- q = p;
- while (p < l && !ISSPACE(*p) && *p != ',') p++;
- add_job(&tail, 0, q, p - q);
- if (p < l) p++;
+ var = config_find_var(&config, toplevel, CF_INHERIT, "dump");
+ if (!var) {
+ /* No setting. Just do all of the Lisps which look available. */
+
+ f |= JF_CHECKINST;
+ for (config_start_section_iter(&config, &si);
+ (sect = config_next_section(&si)); )
+ add_job(f, sect);
+ } else {
+ /* Parse the `dump' list. */
+
+ dstr_reset(&d); config_subst_var(&config, toplevel, var, &d);
+ p = d.p; l = p + d.len;
+ for (;;) {
+ while (p < l && ISSPACE(*p)) p++;
+ if (p >= l) break;
+ q = p;
+ while (p < l && !ISSPACE(*p) && *p != ',') p++;
+ add_named_job(f, q, p - q);
+ while (p < l && ISSPACE(*p)) p++;
+ if (p < l && *p == ',') p++;
+ }
}
}
}
- *tail = 0;
- if (verbose >= 3) {
- dstr_reset(&d);
- first = 1;
- for (job = job_ready; job; job = job->next) {
- if (first) first = 0;
- else dstr_puts(&d, ", ");
- dstr_putf(&d, "`%s'", JOB_NAME(job));
- }
- if (first) dstr_puts(&d, "(none)");
- dstr_putz(&d);
- moan("dumping Lisps: %s", d.p);
+ /* Second step: if exactly one of `AF_CLEAN' and `AF_JUNK' is set, then we
+ * need to scan all of the remaining Lisps and add them to the `delete'
+ * queue.
+ */
+ if (!(flags&AF_CLEAN) != !(flags&AF_JUNK)) {
+
+ /* Determine the flag settings. If we're junking, then we're not
+ * cleaning -- we just want to mark images belonging to other Lisps as
+ * off-limits to the junking scan.
+ */
+ f = flags&AF_CLEAN ? JQ_DELETE : JQ_NONE | JF_NOTICE;
+
+ /* Now scan the Lisp systems. */
+ for (config_start_section_iter(&config, &si);
+ (sect = config_next_section(&si)); )
+ add_job(f, sect);
}
- if (flags&AF_DRYRUN) {
- for (job = job_ready; job; job = job->next) {
- if (try_exec(&job->av,
- TEF_DRYRUN |
- (verbose >= 2 && !(flags&AF_CHECKINST) ?
- TEF_VERBOSE : 0)))
- rc = 2;
- else if (verbose >= 2)
- printf("%-13s > (not dumping `%s': dry run)\n",
- JOB_NAME(job), JOB_NAME(job));
- }
- return (rc);
- }
+ /* Terminate the job queues. */
+ *job_ready_tail = 0;
+ *job_delete_tail = 0;
- for (;;) {
- fd = open("/dev/null", O_RDWR);
- if (fd < 0) lose("failed to open `/dev/null': %s", strerror(errno));
- if (fd > 2) { nullfd = fd; break; }
+ /* Report on what it is we're about to do. */
+ if (verbose >= 3) {
+ show_job_list("dumping Lisp images", job_ready);
+ show_job_list("deleting Lisp images", job_delete);
}
- configure_fd("null fd", nullfd, 0, 1);
-
- for (;;) {
- start_jobs();
- if (!job_run && !job_dead) break;
-#define SET_FD(dir, fd) do { \
- int _fd = (fd); \
- \
- FD_SET(_fd, &fd_##dir); \
- if (_fd >= nfd) nfd = _fd + 1; \
-} while (0)
+ /* If there turns out to be nothing to do, then mention this. */
+ if (!(flags&AF_REMOVE) && verbose >= 2 && !job_ready)
+ moan("no Lisp images to dump");
- FD_ZERO(&fd_in); nfd = 0;
- SET_FD(in, sig_pipe[0]);
- for (job = job_run; job; job = job->next) {
- if (job->out.fd >= 0) SET_FD(in, job->out.fd);
- if (job->err.fd >= 0) SET_FD(in, job->err.fd);
- }
- for (job = job_dead; job; job = job->next) {
- if (job->out.fd >= 0) SET_FD(in, job->out.fd);
- if (job->err.fd >= 0) SET_FD(in, job->err.fd);
- }
+ /* Run the dumping jobs. */
+ run_jobs();
-#undef SET_FD
+ /* Check for any last signals. If we hit any fatal signals then we should
+ * kill ourselves so that the exit status will be right.
+ */
+ check_signals();
+ if (sigloss) { cleanup(); signal(sigloss, SIG_DFL); raise(sigloss); }
- if (select(nfd, &fd_in, 0, 0, 0) < 0) {
- if (errno == EINTR) continue;
- else lose("select failed: %s", strerror(errno));
+ /* Now delete Lisps which need deleting. */
+ while (job_delete) {
+ job = job_delete; job_delete = job->next;
+ if (flags&AF_DRYRUN) {
+ if (verbose >= 2)
+ moan("not deleting `%s' image link `%s' (dry run)",
+ JOB_NAME(job), job->imglink);
+ if (job->oldimg && verbose >= 2)
+ moan("not deleting `%s' image `%s' (dry run)",
+ JOB_NAME(job), job->oldimg);
+ } else {
+ if (verbose >= 2)
+ moan("deleting `%s' image `%s'",
+ JOB_NAME(job), job->imglink);
+ if (unlink(job->imglink) && errno != ENOENT)
+ bad("failed to delete `%s' image link `%s': %s",
+ JOB_NAME(job), job->imglink, strerror(errno));
+ if (job->oldimg && unlink(job->oldimg) && errno != ENOENT)
+ bad("failed to delete `%s' image `%s': %s",
+ JOB_NAME(job), job->oldimg, strerror(errno));
}
+ }
- if (FD_ISSET(sig_pipe[0], &fd_in)) {
- check_signals();
- if (sigloss >= 0) {
- for (job = job_ready; job; job = next)
- { next = job->next; release_job(job); }
- for (job = job_run; job; job = next)
- { next = job->next; release_job(job); }
- for (job = job_dead; job; job = next)
- { next = job->next; release_job(job); }
- break;
+ /* Finally, maybe delete all of the junk files in the image directory. */
+ if (flags&AF_JUNK) {
+ dir = opendir(out);
+ if (!dir)
+ lose("failed to open image directory `%s': %s", out, strerror(errno));
+ dstr_reset(&d);
+ dstr_puts(&d, out); dstr_putc(&d, '/'); o = d.len;
+ if (verbose >= 2)
+ moan("cleaning up junk in image directory `%s'", out);
+ for (;;) {
+ de = readdir(dir); if (!de) break;
+ if (de->d_name[0] == '.' &&
+ (!de->d_name[1] || (de->d_name[1] == '.' && !de->d_name[2])))
+ continue;
+ n = strlen(de->d_name);
+ d.len = o; dstr_putm(&d, de->d_name, n + 1);
+ if (!treap_lookup(&good, de->d_name, n)) {
+ if (flags&AF_DRYRUN) {
+ if (verbose >= 2)
+ moan("not deleting junk file `%s' (dry run)", d.p);
+ } else {
+ if (verbose >= 2)
+ moan("deleting junk file `%s'", d.p);
+ if (unlink(d.p) && errno != ENOENT)
+ bad("failed to delete junk file `%s': %s", d.p, strerror(errno));
+ }
}
}
-
- for (job = job_run; job; job = job->next) {
- if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
- prefix_lines(job, &job->out, '|');
- if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
- prefix_lines(job, &job->err, '*');
- }
- for (link = &job_dead, job = *link; job; job = next) {
- next = job->next;
- if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
- prefix_lines(job, &job->out, '|');
- if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
- prefix_lines(job, &job->err, '*');
- if (job->out.fd >= 0 || job->err.fd >= 0) link = &job->next;
- else { *link = next; finish_job(job); }
- }
}
- check_signals();
- if (sigloss) { cleanup(); signal(sigloss, SIG_DFL); raise(sigloss); }
-
+ /* All done! */
return (rc);
}
~mdw / runlisp / blobdiff