dump-runlisp-image.c: Delete traces of decoy `-d' (`--cleanup') option.

[runlisp] / common.c

/* -*-c-*-
 *
 * Common functionality of a less principled nature
 *
 * (c) 2020 Mark Wooding
 */

/*----- Licensing notice --------------------------------------------------*
 *
 * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
 *
 * Runlisp is free software: you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the
 * Free Software Foundation; either version 3 of the License, or (at your
 * option) any later version.
 *
 * Runlisp is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 * for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with Runlisp.  If not, see <https://www.gnu.org/licenses/>.
 */

/*----- Header files ------------------------------------------------------*/

#include "config.h"

#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <stdlib.h>
#include <string.h>

#include <dirent.h>
#include <pwd.h>
#include <unistd.h>

#include <sys/stat.h>

#include "common.h"
#include "lib.h"

/*----- Public variables --------------------------------------------------*/

struct config config = CONFIG_INIT;     /* main configuration */
struct config_section *toplevel, *builtin, *common, *env; /* well-known
                                                           * sections */
unsigned verbose = 1;                   /* verbosity level */

/*----- Miscellany --------------------------------------------------------*/

/* Look up the environment variable NAME.
 *
 * If it's found, return the value; otherwise return DFLT.  This function
 * looks up the environment variable in the `@ENV' configuration section, so
 * (a) it's likely more efficient than getenv(3), and (b) the `init_config'
 * function must have been called earlier.
 */
const char *my_getenv(const char *name, const char *dflt)
{
  struct config_var *var;

  var = config_find_var(&config, env, 0, name);
  return (var ? var->val : dflt);
}

/* Parse and return an integer from the string P.
 *
 * Report an error if the string doesn't look like an integer, or if it's not
 * between MIN and MAX (inclusive).  Qualify error messages using the
 * adjective WHAT.
 */
long parse_int(const char *what, const char *p, long min, long max)
{
  long n;
  int oerr = errno;
  char *q;

  errno = 0;
  n = strtol(p, &q, 0);
  while (ISSPACE(*q)) q++;
  if (errno || *q) lose("invalid %s `%s'", what, p);
  if (n < min || n > max)
    lose("%s %ld out of range (must be between %ld and %ld)",
         what, n, min, max);
  errno = oerr;
  return (n);
}

/* Append a word P to string D, quoting and/or escaping it in shell style.
 *
 * It tries to pick a `good' way to protect metacharacters, but the precise
 * details aren't guaranteed to remain stable.
 */
static void putword(struct dstr *d, const char *p)
{
  unsigned bare = 0, sq = 2, dq = 2;
  const char *q, *e, *f;
  size_t n;

  /* Pass one: count up how many extra escaping and/or quoting characters
   * we'd need for each quoting strategy: `bare' is no quoting, just adding
   * toothpicks before naughty characters; `dq' is double quotes, with fewer
   * toothpicks; and `sq' is single quotes, with the somewhat awful rune
   * `'\''' rune replacing embedded single quotes.  The quoting strategies
   * start off with a two-character penalty for the surrounding quotes.
   */
  for (q = p; *q; q++)
    switch (*q) {
      case '\\': case '"': case '`': case '$': case '!': bare++; dq++; break;
      case '\'': bare++; sq += 3; break;
      case '^': case '|': case ';': case '&': case '(': case ')':
      case '<': case '>':
      case '*': case '?': case '[':
      case '#':
        bare++; break;
      default:
        if (ISSPACE(*q)) bare++;
        break;
    }

  /* Prepare for the output loop: `q' will be a string of naughty characters
   * which need escaping somehow; `e' is a sequence to insert before each
   * naughty character, and `f' is a final string to add to the end.  We'll
   * put the initial quote on ourselves, if necessary.
   */
  if (bare < dq && bare < sq)
    { q = "\\\"`$!'^|;&()<>*?[# \b\f\n\r\t\v"; e = "\\"; f = ""; }
  else if (dq < sq)
    { q = "\\\"`$!"; e = "\\"; dstr_putc(d, '"'); f = "\""; }
  else
    { q = "'"; e = "'\\'"; dstr_putc(d, '\''); f = "'"; }

  /* Work through the input string inserting escapes as we go. */
  for (;;) {
    n = strcspn(p, q);
    if (n) { dstr_putm(d, p, n); p += n; }
    if (!*p) break;
    dstr_puts(d, e); dstr_putc(d, *p++);
  }
  dstr_puts(d, f);
}

/* Format string-vector AV as a sequence of possibly-quoted words.
 *
 * Append the resulting list to D.
 */
void argv_string(struct dstr *d, const struct argv *av)
{
  size_t i;

  for (i = 0; i < av->n; i++) {
    if (i) dstr_putc(d, ' ');
    putword(d, av->v[i]);
  }
  dstr_putz(d);
}

/*----- Internal utilities ------------------------------------------------*/

/* Append the user's home directory to D. */
static void homedir(struct dstr *d)
{
  static const char *home = 0;
  const char *p;
  struct passwd *pw;

  if (!home) {

    p = my_getenv("HOME", 0);
    if (p) home = p;
    else {
      pw = getpwuid(getuid());
      if (!pw) lose("can't find user in password database");
      home = xstrdup(pw->pw_dir);
    }
  }
  dstr_puts(d, home);
}

/* Append the user's XDG configuration directory to D. */
static void user_config_dir(struct dstr *d)
{
  const char *p;

  p = my_getenv("XDG_CONFIG_HOME", 0);
  if (p) dstr_puts(d, p);
  else { homedir(d); dstr_puts(d, "/.config"); }
}

/*----- File utilities ----------------------------------------------------*/

/* Return whether PATH names an existing file.
 *
 * This will return zero if PATH names something which isn't a regular file.
 * If `FEF_EXEC' is set in F, then additionally ensure that it's executable
 * by the (real) calling uid.  If `FEF_VERBOSE' is set in F, then report on
 * the outcome of the check to standard error.
 */
int file_exists_p(const char *path, unsigned f)
{
  struct stat st;

  if (stat(path, &st)) {
    if (f&FEF_VERBOSE) moan("file `%s' not found", path);
    return (0);
  } else if (!(S_ISREG(st.st_mode))) {
    if (f&FEF_VERBOSE) moan("`%s' is not a regular file", path);
    return (0);
  } else if ((f&FEF_EXEC) && access(path, X_OK)) {
    if (f&FEF_VERBOSE) moan("file `%s' is not executable", path);
    return (0);
  } else {
    if (f&FEF_VERBOSE) moan("found file `%s'", path);
    return (1);
  }
}

/* Return whether PROG can be found in the `PATH'.
 *
 * If PROG is a pathname (absolute or relative -- i.e., if it contains a
 * `/'), then just check that it names an executable program.  Otherwise
 * check to see whether `DIR/PROG' exists and is executable for any DIR in
 * the `PATH'.  The flags F are as for `file_exists_p'.
 */
int found_in_path_p(const char *prog, unsigned f)
{
  struct dstr p = DSTR_INIT, d = DSTR_INIT;
  const char *path;
  char *q;
  size_t n, avail, proglen;
  int i, rc;

  if (strchr(prog, '/'))
    return (file_exists_p(prog, f | FEF_EXEC));
  path = my_getenv("PATH", 0);
  if (path)
    dstr_puts(&p, path);
  else {
    dstr_puts(&p, ".:");
    i = 0;
  again:
    avail = p.sz - p.len;
    n = confstr(_CS_PATH, p.p + p.len, avail);
    if (avail > n) { i++; assert(i < 2); dstr_ensure(&p, n); goto again; }
  }

  q = p.p; proglen = strlen(prog);
  for (;;) {
    n = strcspn(q, ":");
    dstr_reset(&d);
    if (n) dstr_putm(&d, q, n);
    else dstr_putc(&d, '.');
    dstr_putc(&d, '/');
    dstr_putm(&d, prog, proglen);
    dstr_putz(&d);
    if (file_exists_p(d.p, (verbose >= 4 ? f : f&~FEF_VERBOSE) | FEF_EXEC)) {
      if (verbose == 2) moan("found program `%s'", d.p);
      rc = 1; goto end;
    }
    q += n; if (!*q) break; else q++;
  }

  rc = 0;
end:
  dstr_release(&p); dstr_release(&d);
  return (rc);
}

/* Try to run a program as indicated by the argument list AV.
 *
 * This is essentially execvp(3).  If `TEF_VERBOSE' is set in F then trace
 * what's going on to standard error.  If `TEF_DRYRUN' is set in F then don't
 * actually try to run the program: just check whether it exists and is
 * vaguely plausible.  Return -1 if there was a problem, or 0 if it was
 * successful but didn't actually run the program because of the flags
 * settings.
 */
int try_exec(struct argv *av, unsigned f)
{
  struct dstr d = DSTR_INIT;
  int rc;

  assert(av->n); argv_appendz(av);
  if (verbose >= 2) { argv_string(&d, av); moan("trying %s...", d.p); }
  if (f&TEF_DRYRUN) {
    if (found_in_path_p(av->v[0], f&TEF_VERBOSE ? FEF_VERBOSE : 0))
      { rc = 0; goto end; }
  } else {
    execvp(av->v[0], av->v);
    if (errno != ENOENT) {
      moan("failed to exec `%s': %s", av->v[0], strerror(errno));
      _exit(127);
    }
  }

  if (verbose >= 2) moan("`%s' not found", av->v[0]);
  rc = -1;
end:
  dstr_release(&d);
  return (rc);
}

/*----- Configuration -----------------------------------------------------*/

/* Initialize the configuration machinery.
 *
 * This establishes the standard configuration sections `@CONFIG',
 * `@BUILTIN', `@COMMON', and `@ENV', setting the corresponding global
 * variables, and populates `@BUILTIN' (from compile-time configuration) and
 * `@ENV' (from the environment variables).
 */
void init_config(void)
{
  toplevel = config_find_section(&config, CF_CREAT, "@CONFIG");
  builtin = config_find_section(&config, CF_CREAT, "@BUILTIN");
  common = config_find_section(&config, CF_CREAT, "@COMMON");
  env = config_find_section(&config, CF_CREAT, "@ENV");
  config_set_fallback(&config, common);
  config_set_parent(builtin, 0);
  config_set_parent(common, builtin);
  config_set_parent(env, 0);
  config_read_env(&config, env);

  config_set_var(&config, builtin, CF_LITERAL,
                 "@%data-dir", DATADIR);
  config_set_var(&config, builtin, 0,
                 "@data-dir", "${@ENV:RUNLISP_DATADIR?"
                               "${@CONFIG:data-dir?"
                                 "${@BUILTIN:@%data-dir}}}");
  config_set_var(&config, builtin, CF_LITERAL,
                 "@%image-dir", IMAGEDIR);
  config_set_var(&config, builtin, 0,
                 "@image-dir", "${@ENV:RUNLISP_IMAGEDIR?"
                                "${@CONFIG:image-dir?"
                                  "${@BUILTIN:@%image-dir}}}");

#ifdef ECL_OPTIONS_GNU
  config_set_var(&config, builtin, CF_LITERAL, "@%ecl-opt", "--");
#else
  config_set_var(&config, builtin, CF_LITERAL, "@%ecl-opt", "-");
#endif
  config_set_var(&config, builtin, 0,
                 "@ecl-opt", "${@CONFIG:ecl-opt?${@BUILTIN:@%ecl-opt}}");
}

/* Read a named configuration FILE.
 *
 * WHAT is an adjective describing the configuration file, to be used in
 * diagnostics; FILE is the actual filename to read; and F holds `CF_...'
 * flags for `config_read_file', which actually does most of the work.
 */
void read_config_file(const char *what, const char *file, unsigned f)
{
  if (!config_read_file(&config, file, f)) {
    if (verbose >= 2)
      moan("read %s configuration file `%s'", what, file);
  } else {
    if (verbose >= 3)
      moan("ignoring missing %s configuration file `%s'", what, file);
  }
}

/* Order strings lexicographically.
 *
 * This function is intended to be passed an argument to qsort(3).
 */
static int order_strings(const void *xx, const void *yy)
  { const char *const *x = xx, *const *y = yy; return (strcmp(*x, *y)); }

/* Read all of the configuration files in directory PATH.
 *
 * WHAT is an adjective describing the configuration directory, to be used in
 * diagnostics; FILE is the actual filename to read; and F holds `CF_...'
 * flags for `config_read_file', which actually reads the files.
 *
 * All of the files named `*.conf' in the directory are read, in ascending
 * lexicographical order by name.  If `CF_NOENTOK' is set in F, then ignore
 * an error explaining that the directory doesn't exist.  (This only ignores
 * `ENOENT': any other problem is still a fatal error.)
 */
void read_config_dir(const char *what, const char *path, unsigned f)
{
  struct argv av = ARGV_INIT;
  struct dstr dd = DSTR_INIT;
  struct stat st;
  DIR *dir;
  struct dirent *d;
  size_t i, n, len;

  dir = opendir(path);
  if (!dir) {
    if (!(f&CF_NOENTOK) || errno != ENOENT)
      lose("failed to read %s configuration directory `%s': %s",
           what, path, strerror(errno));
    if (verbose >= 3)
      moan("ignoring missing %s configuration directory `%s'", what, path);
    return;
  }

  dstr_puts(&dd, path); dstr_putc(&dd, '/'); n = dd.len;
  for (;;) {
    d = readdir(dir); if (!d) break;
    len = strlen(d->d_name);
    if (len < 5 || STRCMP(d->d_name + len - 5, !=, ".conf")) continue;
    dd.len = n; dstr_putm(&dd, d->d_name, len); dstr_putz(&dd);
    if (stat(dd.p, &st))
      lose("failed to read file metadata for `%s': %s",
           dd.p, strerror(errno));
    if (!S_ISREG(st.st_mode)) continue;
    argv_append(&av, xstrdup(d->d_name));
  }

  qsort(av.v, av.n, sizeof(*av.v), order_strings);

  for (i = 0; i < av.n; i++) {
    dd.len = n; dstr_puts(&dd, av.v[i]);
    read_config_file(what, dd.p, f&~CF_NOENTOK);
  }

  for (i = 0; i < av.n; i++) free(av.v[i]);
  argv_release(&av); dstr_release(&dd); closedir(dir);
  return;
}

/* Read configuration from a file or directory PATH.
 *
 * If PATH exists and names a directory then process all of the files within,
 * as for `read_config_dir'; otherwise try to read it as a file, as for
 * `read_config_file'. The flags F are passed to the respective function.
 */
void read_config_path(const char *path, unsigned f)
{
  struct stat st;

  if (!stat(path, &st) && S_ISDIR(st.st_mode))
    read_config_dir("command-line specified ", path, f);
  else
    read_config_file("command-line specified", path, f);
}

/* Apply a configuration variable setting in command-line syntax.
 *
 * ASSIGN should be a string in the form `[SECT:]VAR=VALUE'.  Set VAR to
 * VALUE in section SECT (defaults to `@CONFIG').  The variable is set with
 * `CF_OVERRIDE' set to prevent the setting from being overwritten by a
 * configuration file.
 */
int set_config_var(const char *assign)
{
  struct config_section *sect;
  const char *p, *q;

  p = strchr(assign, '=');
  if (!p) { moan("missing `=' in option assignment"); return (-1); }
  q = strchr(assign, ':');
  if (!q || q > p)
    { sect = toplevel; q = assign; }
  else if (q == assign)
    lose("expected section or variable name in option assignment");
  else {
    sect = config_find_section_n(&config, CF_CREAT, assign, q - assign);
    q++;
  }
  if (p == q) lose("expected variable name in option assignment");
  config_set_var_n(&config, sect, CF_LITERAL | CF_OVERRIDE,
                   q, p - q, p + 1, strlen(p + 1));
  return (0);
}

/* Load the default configuration files.
 *
 * This will read `ETCDIR/runlisp.d/*.conf', `ETCDIR/runlisp.conf',
 * `~/.runlisp.conf', and `~/.config/runlisp.conf'.
 */
void load_default_config(void)
{
  const char *p;
  struct dstr d = DSTR_INIT;

  p = my_getenv("RUNLISP_SYSCONFIG_DIR", ETCDIR "/runlisp.d");
  read_config_dir("system", p, CF_NOENTOK);
  p = my_getenv("RUNLISP_SYSCONFIG", ETCDIR "/runlisp.conf");
  read_config_file("system", p, 0);

  p = my_getenv("RUNLISP_USERCONFIG", 0);
  if (p)
    read_config_file("user", p, CF_NOENTOK);
  else {
    dstr_reset(&d); homedir(&d); dstr_puts(&d, "/.runlisp.conf");
    read_config_file("user", d.p, CF_NOENTOK);
    dstr_reset(&d); user_config_dir(&d); dstr_puts(&d, "/runlisp.conf");
    read_config_file("user", d.p, CF_NOENTOK);
  }
  dstr_release(&d);
}

/* Dump the configuration to standard error. */
void dump_config(void)
{
  struct config_section_iter si;
  struct config_section *sect;
  struct config_var_iter vi;
  struct config_var *var;

  for (config_start_section_iter(&config, &si);
       (sect = config_next_section(&si)); )
    for (config_start_var_iter(&config, sect, &vi);
         (var = config_next_var(&vi)); )
      moan("config %s:%s = %s",
           CONFIG_SECTION_NAME(sect), CONFIG_VAR_NAME(var), var->val);
}

/*----- That's all, folks -------------------------------------------------*/