gpgscm/main.c - master - githubmirror/libgpg-error

gpgscm/main.c
351 строка8 KB
Werner Koch
core: New functions gpgrt_abort and gpgrt_add_emergency_cleanup.
04 янв 2019, 15:13
04 янв 2019, 15:13933bfd7
/* TinyScheme-based test driver.
 * Copyright (C) 2016 g10 Code GmbH
 *
 * This file is part of Libgpg-error.
 *
 * Libgpg-error is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 2.1 of
 * the License, or (at your option) any later version.
 *
 * Libgpg-error 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
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this program; if not, see <https://www.gnu.org/licenses/>.
 */

#include <config.h>

#include <ctype.h>
#include <errno.h>
#include <fcntl.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>

#if HAVE_MMAP
#include <sys/mman.h>
#endif


#include "private.h"
#include "scheme.h"
#include "scheme-private.h"
#include "ffi.h"


/* The TinyScheme banner.  Unfortunately, it isn't in the header
   file.  */
#define ts_banner "TinyScheme 1.41"

int verbose;



/* Constants to identify the commands and options. */
enum cmd_and_opt_values
  {
    aNull	= 0,
    oVerbose	= 'v',
  };

/* The list of commands and options. */
/* static ARGPARSE_OPTS opts[] = */
/*   { */
/*     ARGPARSE_s_n (oVerbose, "verbose", N_("verbose")), */
/*     ARGPARSE_end (), */
/*   }; */

char *scmpath = "";
size_t scmpath_len = 0;

/* Command line parsing.  */
/* static void */
/* parse_arguments (ARGPARSE_ARGS *pargs, ARGPARSE_OPTS *popts) */
/* { */
  /* int no_more_options = 0; */

  /* while (!no_more_options && optfile_parse (NULL, NULL, NULL, pargs, popts)) */
  /*   { */
  /*     switch (pargs->r_opt) */
  /*       { */
  /*       case oVerbose: */
  /*         verbose++; */
  /*         break; */

  /*       default: */
  /*         pargs->err = 2; */
  /*         break; */
  /*       } */
  /*   } */
/* } */

/* Print usage information and provide strings for help. */
static const char *
my_strusage( int level )
{
  const char *p;

  switch (level)
    {
    case 11: p = "gpgscm";
      break;
    case 13: p = VERSION; break;
    case 19: p = "Please report bugs to <@EMAIL@>.\n"; break;

    case 1:
    case 40:
      p = "Usage: gpgscm [options] [file] (-h for help)";
      break;
    case 41:
      p = "Syntax: gpgscm [options] [file]\n"
          "Execute the given Scheme program, or spawn interactive shell.\n";
      break;

    default: p = NULL; break;
    }
  return p;
}



static int
path_absolute_p (const char *p)
{
#if _WIN32
  return ((strlen (p) > 2 && p[1] == ':' && (p[2] == '\\' || p[2] == '/'))
          || p[0] == '\\' || p[0] == '/');
#else
  return p[0] == '/';
#endif
}


/* Load the Scheme program from FILE_NAME.  If FILE_NAME is not an
   absolute path, and LOOKUP_IN_PATH is given, then it is qualified
   with the values in scmpath until the file is found.  */
static gpg_error_t
load (scheme *sc, char *file_name,
      int lookup_in_cwd, int lookup_in_path)
{
  gpg_error_t err = 0;
  size_t n;
  const char *directory;
  char *qualified_name = file_name;
  int use_path;
  FILE *h = NULL;

  use_path =
    lookup_in_path && ! (path_absolute_p (file_name) || scmpath_len == 0);

  if (path_absolute_p (file_name) || lookup_in_cwd || scmpath_len == 0)
    {
      h = fopen (file_name, "r");
      if (! h)
        err = gpg_error_from_syserror ();
    }

  if (h == NULL && use_path)
    for (directory = scmpath, n = scmpath_len; n;
         directory += strlen (directory) + 1, n--)
      {
        if (asprintf (&qualified_name, "%s/%s", directory, file_name) < 0)
          return gpg_error_from_syserror ();

        h = fopen (qualified_name, "r");
        if (h)
          {
            err = 0;
            break;
          }

        if (n > 1)
          {
            free (qualified_name);
            continue; 	/* Try again!  */
          }

        err = gpg_error_from_syserror ();
      }

  if (h == NULL)
    {
      /* Failed and no more elements in scmpath to try.  */
      fprintf (stderr, "Could not read %s: %s.\n",
               qualified_name, gpg_strerror (err));
      if (lookup_in_path)
        fprintf (stderr,
                 "Consider using GPGSCM_PATH to specify the location "
                 "of the Scheme library.\n");
      goto leave;
    }
  if (verbose > 2)
    fprintf (stderr, "Loading %s...\n", qualified_name);

#if HAVE_MMAP
  /* Always try to mmap the file.  This allows the pages to be shared
   * between processes.  If anything fails, we fall back to using
   * buffered streams.  */
  if (1)
    {
      struct stat st;
      void *map;
      size_t len;
      int fd = fileno (h);

      if (fd < 0)
        goto fallback;

      if (fstat (fd, &st))
        goto fallback;

      len = (size_t) st.st_size;
      if ((off_t) len != st.st_size)
        goto fallback;	/* Truncated.  */

      map = mmap (NULL, len, PROT_READ, MAP_SHARED, fd, 0);
      if (map == MAP_FAILED)
        goto fallback;

      scheme_load_memory (sc, map, len, qualified_name);
      munmap (map, len);
    }
  else
  fallback:
#endif
    scheme_load_named_file (sc, h, qualified_name);
  fclose (h);

  if (sc->retcode && sc->nesting)
    {
      fprintf (stderr, "%s: Unbalanced parenthesis\n", qualified_name);
      err = gpg_error (GPG_ERR_GENERAL);
    }

 leave:
  if (file_name != qualified_name)
    free (qualified_name);
  return err;
}



int
main (int argc, char **argv)
{
  int retcode;
  gpg_error_t err;
  char *argv0;
  /* ARGPARSE_ARGS pargs; */
  scheme *sc;
  char *p;
#if _WIN32
  char pathsep = ';';
#else
  char pathsep = ':';
#endif
  char *script = NULL;

  /* Save argv[0] so that we can re-exec.  */
  argv0 = argv[0];

  if (!gpgrt_check_version (PACKAGE_VERSION))
    {
      fprintf (stderr, _("%s is too old (need %s, have %s)\n"), "libgpg-error",
               PACKAGE_VERSION, gpgrt_check_version (NULL));
      exit (2);
    }

  /* Parse path.  */
  if (getenv ("GPGSCM_PATH"))
    scmpath = getenv ("GPGSCM_PATH");

  p = scmpath = strdup (scmpath);
  if (p == NULL)
    return 2;

  if (*p)
    scmpath_len++;
  for (; *p; p++)
    if (*p == pathsep)
      *p = 0, scmpath_len++;

  /* set_strusage (my_strusage); */
  gpgrt_log_set_prefix ("gpgscm", GPGRT_LOG_WITH_PREFIX);

  /* Make sure that our subsystems are ready.  */
  /* i18n_init (); */
  /* init_common_subsystems (&argc, &argv); */

  /* Parse the command line. */
  /* pargs.argc  = &argc; */
  /* pargs.argv  = &argv; */
  /* pargs.flags = 0; */
  /* parse_arguments (&pargs, opts); */

  if (gpgrt_get_errorcount (0))
    exit (2);

  sc = scheme_init_new_custom_alloc (gpgrt_malloc, gpgrt_free);
  if (!sc)
    {
      fprintf (stderr, "Could not initialize TinyScheme!\n");
      return 2;
    }
  scheme_set_input_port_file (sc, stdin);
  scheme_set_output_port_file (sc, stderr);

  if (argc)
    {
      script = argv[0];
      argc--, argv++;
    }

  err = load (sc, "init.scm", 0, 1);
  if (! err)
    err = load (sc, "ffi.scm", 0, 1);
  if (! err)
    err = ffi_init (sc, argv0, script ? script : "interactive",
                    argc, (const char **) argv);
  if (! err)
    err = load (sc, "lib.scm", 0, 1);
  if (! err)
    err = load (sc, "repl.scm", 0, 1);
  if (! err)
    err = load (sc, "xml.scm", 0, 1);
  if (! err)
    err = load (sc, "tests.scm", 0, 1);
  if (! err)
    err = load (sc, "gnupg.scm", 0, 1);
  if (err)
    {
      fprintf (stderr, "Error initializing gpgscm: %s.\n",
               gpg_strerror (err));
      exit (2);
    }

  if (script == NULL)
    {
      /* Interactive shell.  */
      fprintf (stderr, "gpgscm/"ts_banner".\n");
      scheme_load_string (sc, "(interactive-repl)");
    }
  else
    {
      err = load (sc, script, 1, 1);
      if (err)
        gpgrt_log_fatal ("%s: %s", script, gpg_strerror (err));
    }

  retcode = sc->retcode;
  scheme_load_string (sc, "(*run-atexit-handlers*)");
  scheme_deinit (sc);
  xfree (sc);
  return retcode;
}