Adding upstream version 2.2.40.upstream/2.2.40

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 362 insertions, 0 deletions

diff --git a/tests/gpgscm/main.c b/tests/gpgscm/main.c
new file mode 100644
index 0000000..f2b12aa
--- /dev/null
+++ b/tests/gpgscm/main.c
@@ -0,0 +1,362 @@
+/* TinyScheme-based test driver.
+ *
+ * Copyright (C) 2016 g10 code GmbH
+ *
+ * This file is part of GnuPG.
+ *
+ * GnuPG 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.
+ *
+ * GnuPG 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 this program; if not, see <https://www.gnu.org/licenses/>.
+ * SPDX-License-Identifier: GPL-3.0-or-later
+ */
+
+#include <config.h>
+
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <gcrypt.h>
+#include <gpg-error.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"
+#include "../common/i18n.h"
+#include "../../common/argparse.h"
+#include "../../common/init.h"
+#include "../../common/logging.h"
+#include "../../common/strlist.h"
+#include "../../common/sysutils.h"
+#include "../../common/util.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)
+{
+
+  while (gnupg_argparse (NULL, pargs, popts))
+    {
+      switch (pargs->r_opt)
+        {
+        case oVerbose:
+          verbose++;
+          break;
+
+        default:
+	  pargs->err = ARGPARSE_PRINT_ERROR;
+	  break;
+	}
+    }
+}
+
+/* Print usage information and provide strings for help. */
+static const char *
+my_strusage( int level )
+{
+  const char *p;
+
+  switch (level)
+    {
+    case  9: p = "GPL-3.0-or-later"; break;
+    case 11: p = "gpgscm (@GNUPG@)";
+      break;
+    case 13: p = VERSION; break;
+    case 14: p = GNUPG_DEF_COPYRIGHT_LINE; break;
+    case 17: p = PRINTABLE_OS_NAME; 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];
+
+  /* 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);
+  log_set_prefix ("gpgscm", GPGRT_LOG_WITH_PREFIX);
+
+  /* Make sure that our subsystems are ready.  */
+  i18n_init ();
+  init_common_subsystems (&argc, &argv);
+
+  if (!gcry_check_version (NEED_LIBGCRYPT_VERSION))
+    {
+      fputs ("libgcrypt version mismatch\n", stderr);
+      exit (2);
+    }
+
+  /* Parse the command line. */
+  pargs.argc  = &argc;
+  pargs.argv  = &argv;
+  pargs.flags = 0;
+  parse_arguments (&pargs, opts);
+  gnupg_argparse (NULL, &pargs, NULL);
+
+  if (log_get_errorcount (0))
+    exit (2);
+
+  sc = scheme_init_new_custom_alloc (gcry_malloc, gcry_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)
+        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;
+}