* along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
*/
-/*----- Header files ------------------------------------------------------*/
+/*----- Header files ---------------------------------------------------------*/
#include "config.h"
/* Job-state constants. */
enum {
JST_READY, /* not yet started */
+ JST_DELETE, /* just delete the image file */
JST_RUN, /* currently running */
JST_DEAD, /* process exited */
JST_NSTATE
struct job {
struct treap_node _node; /* treap intrusion */
struct job *next; /* next job in whichever list */
+ unsigned op; /* operation (`JOP_...') */
struct argv av; /* argument vector to execute */
char *imgnew, *imgout; /* staging and final output files */
unsigned st; /* job state (`JST_...') */
#define JOB_NAME(job) TREAP_NODE_KEY(job)
#define JOB_NAMELEN(job) TREAP_NODE_KEYLEN(job)
-static struct treap jobs = TREAP_INIT; /* Lisp systems scheduled to dump */
-static struct job *job_ready, *job_run, *job_dead; /* list jobs by state */
+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 by state */
+ *job_ready, **job_ready_tail = &job_ready, /* some have tail pointers... */
+ *job_delete, **job_delete_tail = &job_delete,
+ *job_run, *job_dead; /* ... and some don't */
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' */
#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 --------------------------------------------------------*/
/*----- Job management ----------------------------------------------------*/
-/* Add a new job to the `ready' queue.
+/* Consider a Lisp system description and maybe add a job to the right queue.
*
- * The job will be to dump the Lisp system with the given LEN-byte NAME. On
- * entry, *TAIL_INOUT should point to the `next' link of the last node in the
- * list (or the list head pointer), and will be updated on exit.
+ * 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.
*
- * This function reports (fatal) errors for most kinds of problems. If
- * `JF_QUIET' is set in F then silently ignore a well-described Lisp system
- * which nonetheless isn't suitable. (This is specifically intended for the
- * case where we try to dump all known Lisp systems, but some don't have a
- * `dump-image' command.)
+ * 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 JF_QUIET 1u
-static void add_job(struct job ***tail_inout, unsigned f,
- const char *name, size_t len)
+#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)
{
- struct job *job;
- struct treap_path path;
- struct config_section *sect;
+ const char *name;
+ struct job *job, ***tail;
+ struct treap_path path, jobpath;
struct config_var *dumpvar, *cmdvar, *imgvar;
+ struct treap_node *n;
struct dstr d = DSTR_INIT;
struct argv av = ARGV_INIT;
char *imgnew = 0, *imgout = 0;
- size_t i;
+ size_t i, len;
unsigned fef;
- /* Check to see whether this Lisp system is already queued up. */
- 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;
}
- /* Find the configuration for this Lisp system and check that it can be
- * dumped.
+ /* 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.
*/
- sect = config_find_section_n(&config, 0, name, len);
- if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name);
- name = CONFIG_SECTION_NAME(sect);
- dumpvar = config_find_var(&config, sect, 0, "dump-image");
- if (!dumpvar) {
- if (!(f&JF_QUIET))
- lose("don't know how to dump images for Lisp implementation `%s'",
- name);
+ if (!config_find_var(&config, sect, CF_INHERIT, "run-script")) {
+ 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;
}
/* Check that the other necessary variables are present. */
- imgvar = config_find_var(&config, sect, 0, "image-file");
- if (!imgvar) lose("variable `image-file' not defined for Lisp `%s'", name);
- cmdvar = config_find_var(&config, sect, 0, "command");
- if (!cmdvar) lose("variable `command' not defined for Lisp `%s'", name);
+ dumpvar = config_find_var(&config, sect, CF_INHERIT, "dump-image");
+ if (!dumpvar)
+ lose("variable `dump-image' not defined for Lisp `%s'", name);
+ cmdvar = config_find_var(&config, sect, CF_INHERIT, "command");
+ if (!cmdvar)
+ lose("variable `command' not defined for Lisp `%s'", name);
/* Build the job's command line. */
config_subst_split_var(&config, sect, dumpvar, &av);
* because that would cause us to spam the user with redundant
* diagnostics.)
*/
- if (flags&AF_CHECKINST) {
+ if ((f&JF_CHECKINST) && (flags&AF_CHECKINST)) {
dstr_reset(&d);
- fef = (verbose >= 2 ? FEF_VERBOSE : 0);
+ fef = (verbose >= 3 ? FEF_VERBOSE : 0);
config_subst_var(&config, sect, cmdvar, &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);
+ if (!found_in_path_p(d.p, fef)) {
+ if (verbose >= 3)
+ moan("skipping Lisp `%s': can't find Lisp command `%s'",
+ name, d.p);
+ goto end;
+ }
+ if (STRCMP(d.p, !=, av.v[0]) && !found_in_path_p(av.v[0], fef)) {
+ moan("skipping Lisp `%s': can't find dump command `%s'",
+ av.v[0], d.p);
goto end;
}
}
+ /* If we're supposed to, then notice that this is the name of a good Lisp
+ * image.
+ */
+ if (f&JF_NOTICE) {
+ dstr_reset(&d); config_subst_var(&config, sect, imgvar, &d);
+ n = treap_probe(&good, d.p, d.len, &path);
+ if (!n) {
+ n = xmalloc(sizeof(*n));
+ treap_insert(&good, &path, n, d.p, d.len);
+ }
+ }
+
/* Collect the output image file names. */
imgnew =
config_subst_string_alloc(&config, sect, "<internal>", "${@image-new}");
/* If we're supposed to check whether the image file exists, then we should
* do that.
*/
- if (!(flags&AF_FORCE)) {
+ if ((f&JF_CHECKEXIST) && !(flags&AF_FORCE)) {
if (!access(imgout, F_OK)) {
- if (verbose >= 2)
- moan("image `%s' already exists: skipping `%s'", d.p, name);
- goto end;
+ if (verbose >= 3)
+ moan("skipping Lisp `%s': image `%s' already exists", name, imgout);
+ f = (f&~JMASK_QUEUE) | JQ_NONE;
}
}
* 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: tail = 0; break;
+ case JQ_READY: tail = &job_ready_tail; break;
+ case JQ_DELETE: tail = &job_delete_tail; break;
+ default: assert(0);
+ }
job = xmalloc(sizeof(*job));
job->st = JST_READY;
- job->kid = -1;
+ 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);
job->imgnew = imgnew; job->imgout = imgout; imgnew = imgout = 0;
- treap_insert(&jobs, &path, &job->_node, name, len);
- **tail_inout = job; *tail_inout = &job->next;
+ treap_insert(&jobs, &jobpath, &job->_node, name, len);
+ if (tail) { **tail = job; *tail = &job->next; }
end:
/* All done. Cleanup time. */
dstr_release(&d); argv_release(&av);
}
+/* 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);
argv_release(&job->av);
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);
}
job = job_ready; job_ready = job->next;
p_out[0] = p_out[1] = p_err[0] = p_err[1] = -1;
+ /* If we're not actually going to do anything, now is the time to not do
+ * that.
+ */
+ if (flags&AF_DRYRUN) {
+ if (try_exec(&job->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;
+ }
+
/* 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)) {
* output.
*/
for (link = &job_dead, job = *link; 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, '*');
next = job->next;
if (job->out.fd >= 0 || job->err.fd >= 0) link = &job->next;
else { *link = next; finish_job(job); }
static void usage(FILE *fp)
{
fprintf(fp, "\
-usage: %s [-afnqv] [-c CONF] [-o [SECT:]VAR=VAL]\n\
+usage: %s [-RUadfinqrv] [+RUdfinr] [-c CONF] [-o [SECT:]VAR=VAL]\n\
[-O FILE|DIR] [-j NJOBS] [LISP ...]\n",
progname);
}
\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\
+ -d, --cleanup Delete images which are no longer wanted.\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 *sect;
struct config_var *var;
const char *out = 0, *p, *q, *l;
- struct job *job, **tail;
+ struct job *job;
struct stat st;
struct dstr d = DSTR_INIT;
- int i, fd, first;
+ 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 }
};
/* 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:d+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;
"@image-out", "${@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-out", out);
/* Dump the final configuration if we're being very verbose. */
if (verbose >= 5) dump_config();
- /* Create jobs for the Lisp systems we're supposed to be dumping. */
- tail = &job_ready;
- if (!(flags&AF_ALL))
- for (i = optind; i < argc; i++)
- add_job(&tail, 0, argv[i], strlen(argv[i]));
- else {
- /* So we're supposed to dump `all' of them. If there's a `dump'
+ /* 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.
*/
- var = config_find_var(&config, toplevel, 0, "dump");
- if (!var) {
- /* No setting. Just do all of the Lisps which look available. */
-
- flags |= AF_CHECKINST;
- 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));
- } else {
- /* Parse the `dump' list. */
-
- 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);
- while (p < l && ISSPACE(*p)) p++;
- if (p < l && *p == ',') p++;
+ else {
+ 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;
+
+ /* 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);
+ }
+
+ /* Terminate the job queues. */
+ *job_ready_tail = 0;
+ *job_delete_tail = 0;
/* Report on what it is we're about to do. */
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);
+ show_job_list("dumping Lisp images", job_ready);
+ show_job_list("deleting Lisp images", job_delete);
}
- /* If we're not actually going to do anything after all then now's the time
- * to, err, not do that.
- */
- 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);
- }
+ /* 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");
- /* Run the jobs. */
+ /* Run the dumping jobs. */
run_jobs();
- /* Finally, 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 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); }
+ /* 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 `%s' (dry run)",
+ JOB_NAME(job), job->imgout);
+ } else {
+ if (verbose >= 2)
+ moan("deleting `%s' image `%s' (dry run)",
+ JOB_NAME(job), job->imgout);
+ if (unlink(job->imgout) && errno != ENOENT)
+ bad("failed to delete `%s' image `%s': %s",
+ JOB_NAME(job), job->imgout, strerror(errno));
+ }
+ }
+
+ /* Finally, maybe delete all of the junk files in the image directory. */
+ if (flags&AF_JUNK) {
+ if (!out) {
+ var = config_find_var(&config, builtin, CF_INHERIT, "@image-dir");
+ assert(var); out = config_subst_var_alloc(&config, builtin, var);
+ }
+ 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));
+ }
+ }
+ }
+ }
+
/* All done! */
return (rc);
}
~mdw / runlisp / blobdiff