/* 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 <http://www.gnu.org/licenses/>.
*/
#include <config.h>
#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <gcrypt.h>
#include <gpg-error.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include "private.h"
#include "scheme.h"
#include "ffi.h"
#include "i18n.h"
#include "../../common/argparse.h"
#include "../../common/init.h"
#include "../../common/logging.h"
#include "../../common/strlist.h"
#include "../../common/sysutils.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 and provide strings for help. */
static const char *
my_strusage( int level )
{
const char *p;
switch (level)
{
case 11: p = "gpgscm (@GNUPG@)";
break;
case 13: p = VERSION; 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;
}
/* 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 && ! (file_name[0] == '/' || scmpath_len == 0);
if (file_name[0] == '/' || 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)
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");
return err;
}
if (verbose > 1)
fprintf (stderr, "Loading %s...\n", qualified_name);
scheme_load_named_file (sc, h, qualified_name);
fclose (h);
if (file_name != qualified_name)
free (qualified_name);
return 0;
}
int
main (int argc, char **argv)
{
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", 1);
/* Make sure that our subsystems are ready. */
i18n_init ();
init_common_subsystems (&argc, &argv);
if (!gcry_check_version (GCRYPT_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);
if (log_get_errorcount (0))
exit (2);
sc = scheme_init_new ();
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, 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, "tests.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));
}
scheme_deinit (sc);
return EXIT_SUCCESS;
}