summaryrefslogtreecommitdiffstats
path: root/tests/gpgscm/main.c
diff options
context:
space:
mode:
Diffstat (limited to 'tests/gpgscm/main.c')
-rw-r--r--tests/gpgscm/main.c362
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;
+}