tests/gpgscm/main.c

   1 /* TinyScheme-based test driver.
   2  *
   3  * Copyright (C) 2016 g10 code GmbH
   4  *
   5  * This file is part of GnuPG.
   6  *
   7  * GnuPG is free software; you can redistribute it and/or modify
   8  * it under the terms of the GNU General Public License as published by
   9  * the Free Software Foundation; either version 3 of the License, or
  10  * (at your option) any later version.
  11  *
  12  * GnuPG is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with this program; if not, see <https://www.gnu.org/licenses/>.
  19  */
  20
  21 #include <config.h>
  22
  23 #include <assert.h>
  24 #include <ctype.h>
  25 #include <errno.h>
  26 #include <gcrypt.h>
  27 #include <gpg-error.h>
  28 #include <stdio.h>
  29 #include <stdlib.h>
  30 #include <string.h>
  31 #include <unistd.h>
  32
  33 #include "private.h"
  34 #include "scheme.h"
  35 #include "scheme-private.h"
  36 #include "ffi.h"
  37 #include "i18n.h"
  38 #include "../../common/argparse.h"
  39 #include "../../common/init.h"
  40 #include "../../common/logging.h"
  41 #include "../../common/strlist.h"
  42 #include "../../common/sysutils.h"
  43 #include "../../common/util.h"
  44
  45 /* The TinyScheme banner.  Unfortunately, it isn't in the header
  46    file.  */
  47 #define ts_banner "TinyScheme 1.41"
  48
  49 int verbose;
  50
  51 \f
  52
  53 /* Constants to identify the commands and options. */
  54 enum cmd_and_opt_values
  55   {
  56     aNull       = 0,
  57     oVerbose    = 'v',
  58   };
  59
  60 /* The list of commands and options. */
  61 static ARGPARSE_OPTS opts[] =
  62   {
  63     ARGPARSE_s_n (oVerbose, "verbose", N_("verbose")),
  64     ARGPARSE_end (),
  65   };
  66
  67 char *scmpath = "";
  68 size_t scmpath_len = 0;
  69
  70 /* Command line parsing.  */
  71 static void
  72 parse_arguments (ARGPARSE_ARGS *pargs, ARGPARSE_OPTS *popts)
  73 {
  74   int no_more_options = 0;
  75
  76   while (!no_more_options && optfile_parse (NULL, NULL, NULL, pargs, popts))
  77     {
  78       switch (pargs->r_opt)
  79         {
  80         case oVerbose:
  81           verbose++;
  82           break;
  83
  84         default:
  85           pargs->err = 2;
  86           break;
  87         }
  88     }
  89 }
  90
  91 /* Print usage information and and provide strings for help. */
  92 static const char *
  93 my_strusage( int level )
  94 {
  95   const char *p;
  96
  97   switch (level)
  98     {
  99     case 11: p = "gpgscm (@GNUPG@)";
 100       break;
 101     case 13: p = VERSION; break;
 102     case 17: p = PRINTABLE_OS_NAME; break;
 103     case 19: p = _("Please report bugs to <@EMAIL@>.\n"); break;
 104
 105     case 1:
 106     case 40:
 107       p = _("Usage: gpgscm [options] [file] (-h for help)");
 108       break;
 109     case 41:
 110       p = _("Syntax: gpgscm [options] [file]\n"
 111             "Execute the given Scheme program, or spawn interactive shell.\n");
 112       break;
 113
 114     default: p = NULL; break;
 115     }
 116   return p;
 117 }
 118
 119 \f
 120 /* Load the Scheme program from FILE_NAME.  If FILE_NAME is not an
 121    absolute path, and LOOKUP_IN_PATH is given, then it is qualified
 122    with the values in scmpath until the file is found.  */
 123 static gpg_error_t
 124 load (scheme *sc, char *file_name,
 125       int lookup_in_cwd, int lookup_in_path)
 126 {
 127   gpg_error_t err = 0;
 128   size_t n;
 129   const char *directory;
 130   char *qualified_name = file_name;
 131   int use_path;
 132   FILE *h = NULL;
 133
 134   use_path =
 135     lookup_in_path && ! (file_name[0] == '/' || scmpath_len == 0);
 136
 137   if (file_name[0] == '/' || lookup_in_cwd || scmpath_len == 0)
 138     {
 139       h = fopen (file_name, "r");
 140       if (! h)
 141         err = gpg_error_from_syserror ();
 142     }
 143
 144   if (h == NULL && use_path)
 145     for (directory = scmpath, n = scmpath_len; n;
 146          directory += strlen (directory) + 1, n--)
 147       {
 148         if (asprintf (&qualified_name, "%s/%s", directory, file_name) < 0)
 149           return gpg_error_from_syserror ();
 150
 151         h = fopen (qualified_name, "r");
 152         if (h)
 153           {
 154             err = 0;
 155             break;
 156           }
 157
 158         if (n > 1)
 159           {
 160             free (qualified_name);
 161             continue;   /* Try again!  */
 162           }
 163
 164         err = gpg_error_from_syserror ();
 165       }
 166
 167   if (h == NULL)
 168     {
 169       /* Failed and no more elements in scmpath to try.  */
 170       fprintf (stderr, "Could not read %s: %s.\n",
 171                qualified_name, gpg_strerror (err));
 172       if (lookup_in_path)
 173         fprintf (stderr,
 174                  "Consider using GPGSCM_PATH to specify the location "
 175                  "of the Scheme library.\n");
 176       goto leave;
 177     }
 178   if (verbose > 1)
 179     fprintf (stderr, "Loading %s...\n", qualified_name);
 180   scheme_load_named_file (sc, h, qualified_name);
 181   fclose (h);
 182
 183   if (sc->retcode && sc->nesting)
 184     {
 185       fprintf (stderr, "%s: Unbalanced parenthesis\n", qualified_name);
 186       err = gpg_error (GPG_ERR_GENERAL);
 187     }
 188
 189  leave:
 190   if (file_name != qualified_name)
 191     free (qualified_name);
 192   return err;
 193 }
 194
 195 \f
 196
 197 int
 198 main (int argc, char **argv)
 199 {
 200   int retcode;
 201   gpg_error_t err;
 202   char *argv0;
 203   ARGPARSE_ARGS pargs;
 204   scheme *sc;
 205   char *p;
 206 #if _WIN32
 207   char pathsep = ';';
 208 #else
 209   char pathsep = ':';
 210 #endif
 211   char *script = NULL;
 212
 213   /* Save argv[0] so that we can re-exec.  */
 214   argv0 = argv[0];
 215
 216   /* Parse path.  */
 217   if (getenv ("GPGSCM_PATH"))
 218     scmpath = getenv ("GPGSCM_PATH");
 219
 220   p = scmpath = strdup (scmpath);
 221   if (p == NULL)
 222     return 2;
 223
 224   if (*p)
 225     scmpath_len++;
 226   for (; *p; p++)
 227     if (*p == pathsep)
 228       *p = 0, scmpath_len++;
 229
 230   set_strusage (my_strusage);
 231   log_set_prefix ("gpgscm", GPGRT_LOG_WITH_PREFIX);
 232
 233   /* Make sure that our subsystems are ready.  */
 234   i18n_init ();
 235   init_common_subsystems (&argc, &argv);
 236
 237   if (!gcry_check_version (NEED_LIBGCRYPT_VERSION))
 238     {
 239       fputs ("libgcrypt version mismatch\n", stderr);
 240       exit (2);
 241     }
 242
 243   /* Parse the command line. */
 244   pargs.argc  = &argc;
 245   pargs.argv  = &argv;
 246   pargs.flags = 0;
 247   parse_arguments (&pargs, opts);
 248
 249   if (log_get_errorcount (0))
 250     exit (2);
 251
 252   sc = scheme_init_new_custom_alloc (gcry_malloc, gcry_free);
 253   if (! sc) {
 254     fprintf (stderr, "Could not initialize TinyScheme!\n");
 255     return 2;
 256   }
 257   scheme_set_input_port_file (sc, stdin);
 258   scheme_set_output_port_file (sc, stderr);
 259
 260   if (argc)
 261     {
 262       script = argv[0];
 263       argc--, argv++;
 264     }
 265
 266   err = load (sc, "init.scm", 0, 1);
 267   if (! err)
 268     err = load (sc, "ffi.scm", 0, 1);
 269   if (! err)
 270     err = ffi_init (sc, argv0, script ? script : "interactive",
 271                     argc, (const char **) argv);
 272   if (! err)
 273     err = load (sc, "lib.scm", 0, 1);
 274   if (! err)
 275     err = load (sc, "repl.scm", 0, 1);
 276   if (! err)
 277     err = load (sc, "tests.scm", 0, 1);
 278   if (err)
 279     {
 280       fprintf (stderr, "Error initializing gpgscm: %s.\n",
 281                gpg_strerror (err));
 282       exit (2);
 283     }
 284
 285   if (script == NULL)
 286     {
 287       /* Interactive shell.  */
 288       fprintf (stderr, "gpgscm/"ts_banner".\n");
 289       scheme_load_string (sc, "(interactive-repl)");
 290     }
 291   else
 292     {
 293       err = load (sc, script, 1, 1);
 294       if (err)
 295         log_fatal ("%s: %s", script, gpg_strerror (err));
 296     }
 297
 298   retcode = sc->retcode;
 299   scheme_load_string (sc, "(*run-atexit-handlers*)");
 300   scheme_deinit (sc);
 301   xfree (sc);
 302   return retcode;
 303 }