/* 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 . */ #include #include #include #include #include #include #include #include #include #include #if HAVE_MMAP #include #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; }