tests/gpgscm: Add a TinySCHEME-based test driver.
[gnupg.git] / 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 <http://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 "ffi.h"
36 #include "i18n.h"
37 #include "../../common/argparse.h"
38 #include "../../common/init.h"
39 #include "../../common/logging.h"
40 #include "../../common/strlist.h"
41 #include "../../common/sysutils.h"
42
43 /* The TinyScheme banner.  Unfortunately, it isn't in the header
44    file.  */
45 #define ts_banner "TinyScheme 1.41"
46
47 int verbose;
48
49 \f
50
51 /* Constants to identify the commands and options. */
52 enum cmd_and_opt_values
53   {
54     aNull       = 0,
55     oVerbose    = 'v',
56   };
57
58 /* The list of commands and options. */
59 static ARGPARSE_OPTS opts[] =
60   {
61     ARGPARSE_s_n (oVerbose, "verbose", N_("verbose")),
62     ARGPARSE_end (),
63   };
64
65 char *scmpath = "";
66 size_t scmpath_len = 0;
67
68 /* Command line parsing.  */
69 static void
70 parse_arguments (ARGPARSE_ARGS *pargs, ARGPARSE_OPTS *popts)
71 {
72   int no_more_options = 0;
73
74   while (!no_more_options && optfile_parse (NULL, NULL, NULL, pargs, popts))
75     {
76       switch (pargs->r_opt)
77         {
78         case oVerbose:
79           verbose++;
80           break;
81
82         default:
83           pargs->err = 2;
84           break;
85         }
86     }
87 }
88
89 /* Print usage information and and provide strings for help. */
90 static const char *
91 my_strusage( int level )
92 {
93   const char *p;
94
95   switch (level)
96     {
97     case 11: p = "gpgscm (@GNUPG@)";
98       break;
99     case 13: p = VERSION; break;
100     case 17: p = PRINTABLE_OS_NAME; break;
101     case 19: p = _("Please report bugs to <@EMAIL@>.\n"); break;
102
103     case 1:
104     case 40:
105       p = _("Usage: gpgscm [options] [file] (-h for help)");
106       break;
107     case 41:
108       p = _("Syntax: gpgscm [options] [file]\n"
109             "Execute the given Scheme program, or spawn interactive shell.\n");
110       break;
111
112     default: p = NULL; break;
113     }
114   return p;
115 }
116
117 \f
118 /* Load the Scheme program from FILE_NAME.  If FILE_NAME is not an
119    absolute path, and LOOKUP_IN_PATH is given, then it is qualified
120    with the values in scmpath until the file is found.  */
121 static gpg_error_t
122 load (scheme *sc, char *file_name,
123       int lookup_in_cwd, int lookup_in_path)
124 {
125   gpg_error_t err = 0;
126   size_t n;
127   const char *directory;
128   char *qualified_name = file_name;
129   int use_path;
130   FILE *h = NULL;
131
132   use_path =
133     lookup_in_path && ! (file_name[0] == '/' || scmpath_len == 0);
134
135   if (file_name[0] == '/' || lookup_in_cwd || scmpath_len == 0)
136     {
137       h = fopen (file_name, "r");
138       if (! h)
139         err = gpg_error_from_syserror ();
140     }
141
142   if (h == NULL && use_path)
143     for (directory = scmpath, n = scmpath_len; n;
144          directory += strlen (directory) + 1, n--)
145       {
146         if (asprintf (&qualified_name, "%s/%s", directory, file_name) < 0)
147           return gpg_error_from_syserror ();
148
149         h = fopen (qualified_name, "r");
150         if (h)
151           break;
152
153         if (n > 1)
154           {
155             free (qualified_name);
156             continue;   /* Try again!  */
157           }
158
159         err = gpg_error_from_syserror ();
160       }
161
162   if (h == NULL)
163     {
164       /* Failed and no more elements in scmpath to try.  */
165       fprintf (stderr, "Could not read %s: %s.\n",
166                qualified_name, gpg_strerror (err));
167       if (lookup_in_path)
168         fprintf (stderr,
169                  "Consider using GPGSCM_PATH to specify the location "
170                  "of the Scheme library.\n");
171       return err;
172     }
173   if (verbose > 1)
174     fprintf (stderr, "Loading %s...\n", qualified_name);
175   scheme_load_named_file (sc, h, qualified_name);
176   fclose (h);
177
178   if (file_name != qualified_name)
179     free (qualified_name);
180   return 0;
181 }
182
183 \f
184
185 int
186 main (int argc, char **argv)
187 {
188   gpg_error_t err;
189   char *argv0;
190   ARGPARSE_ARGS pargs;
191   scheme *sc;
192   char *p;
193 #if _WIN32
194   char pathsep = ';';
195 #else
196   char pathsep = ':';
197 #endif
198   char *script = NULL;
199
200   /* Save argv[0] so that we can re-exec.  */
201   argv0 = argv[0];
202
203   /* Parse path.  */
204   if (getenv ("GPGSCM_PATH"))
205     scmpath = getenv ("GPGSCM_PATH");
206
207   p = scmpath = strdup (scmpath);
208   if (p == NULL)
209     return 2;
210
211   if (*p)
212     scmpath_len++;
213   for (; *p; p++)
214     if (*p == pathsep)
215       *p = 0, scmpath_len++;
216
217   set_strusage (my_strusage);
218   log_set_prefix ("gpgscm", 1);
219
220   /* Make sure that our subsystems are ready.  */
221   i18n_init ();
222   init_common_subsystems (&argc, &argv);
223
224   if (!gcry_check_version (GCRYPT_VERSION))
225     {
226       fputs ("libgcrypt version mismatch\n", stderr);
227       exit (2);
228     }
229
230   /* Parse the command line. */
231   pargs.argc  = &argc;
232   pargs.argv  = &argv;
233   pargs.flags = 0;
234   parse_arguments (&pargs, opts);
235
236   if (log_get_errorcount (0))
237     exit (2);
238
239   sc = scheme_init_new ();
240   if (! sc) {
241     fprintf (stderr, "Could not initialize TinyScheme!\n");
242     return 2;
243   }
244   scheme_set_input_port_file (sc, stdin);
245   scheme_set_output_port_file (sc, stderr);
246
247   if (argc)
248     {
249       script = argv[0];
250       argc--, argv++;
251     }
252
253   err = load (sc, "init.scm", 0, 1);
254   if (! err)
255     err = load (sc, "ffi.scm", 0, 1);
256   if (! err)
257     err = ffi_init (sc, argv0, argc, (const char **) argv);
258   if (! err)
259     err = load (sc, "lib.scm", 0, 1);
260   if (! err)
261     err = load (sc, "repl.scm", 0, 1);
262   if (! err)
263     err = load (sc, "tests.scm", 0, 1);
264   if (err)
265     {
266       fprintf (stderr, "Error initializing gpgscm: %s.\n",
267                gpg_strerror (err));
268       exit (2);
269     }
270
271   if (script == NULL)
272     {
273       /* Interactive shell.  */
274       fprintf (stderr, "gpgscm/"ts_banner".\n");
275       scheme_load_string (sc, "(interactive-repl)");
276     }
277   else
278     {
279       err = load (sc, script, 1, 1);
280       if (err)
281         log_fatal ("%s: %s", script, gpg_strerror (err));
282     }
283
284   scheme_deinit (sc);
285   return EXIT_SUCCESS;
286 }