LCOV - code coverage report
Current view: top level - tests/gpgscm - ffi.c (source / functions) Hit Total Coverage
Test: coverage.info Lines: 477 639 74.6 %
Date: 2016-09-12 12:29:17 Functions: 44 55 80.0 %

          Line data    Source code
       1             : /* FFI interface for TinySCHEME.
       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 <dirent.h>
      26             : #include <errno.h>
      27             : #include <fcntl.h>
      28             : #include <glob.h>
      29             : #include <gpg-error.h>
      30             : #include <stdarg.h>
      31             : #include <stdlib.h>
      32             : #include <stdio.h>
      33             : #include <string.h>
      34             : #include <sys/types.h>
      35             : #include <sys/stat.h>
      36             : #include <unistd.h>
      37             : 
      38             : #if HAVE_LIBREADLINE
      39             : #include <readline/readline.h>
      40             : #include <readline/history.h>
      41             : #endif
      42             : 
      43             : #include "../../common/util.h"
      44             : #include "../../common/exechelp.h"
      45             : #include "../../common/sysutils.h"
      46             : 
      47             : #include "private.h"
      48             : #include "ffi.h"
      49             : #include "ffi-private.h"
      50             : 
      51             : 
      52             : 
      53             : int
      54        3044 : ffi_bool_value (scheme *sc, pointer p)
      55             : {
      56        3044 :   return ! (p == sc->F);
      57             : }
      58             : 
      59             : 
      60             : 
      61             : static pointer
      62           0 : do_logand (scheme *sc, pointer args)
      63             : {
      64           0 :   FFI_PROLOG ();
      65           0 :   unsigned int v, acc = ~0;
      66           0 :   while (args != sc->NIL)
      67             :     {
      68           0 :       FFI_ARG_OR_RETURN (sc, unsigned int, v, number, args);
      69           0 :       acc &= v;
      70             :     }
      71           0 :   FFI_RETURN_INT (sc, acc);
      72             : }
      73             : 
      74             : static pointer
      75         215 : do_logior (scheme *sc, pointer args)
      76             : {
      77         215 :   FFI_PROLOG ();
      78         215 :   unsigned int v, acc = 0;
      79         976 :   while (args != sc->NIL)
      80             :     {
      81         546 :       FFI_ARG_OR_RETURN (sc, unsigned int, v, number, args);
      82         546 :       acc |= v;
      83             :     }
      84         215 :   FFI_RETURN_INT (sc, acc);
      85             : }
      86             : 
      87             : static pointer
      88           0 : do_logxor (scheme *sc, pointer args)
      89             : {
      90           0 :   FFI_PROLOG ();
      91           0 :   unsigned int v, acc = 0;
      92           0 :   while (args != sc->NIL)
      93             :     {
      94           0 :       FFI_ARG_OR_RETURN (sc, unsigned int, v, number, args);
      95           0 :       acc ^= v;
      96             :     }
      97           0 :   FFI_RETURN_INT (sc, acc);
      98             : }
      99             : 
     100             : static pointer
     101           0 : do_lognot (scheme *sc, pointer args)
     102             : {
     103           0 :   FFI_PROLOG ();
     104             :   unsigned int v;
     105           0 :   FFI_ARG_OR_RETURN (sc, unsigned int, v, number, args);
     106           0 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     107           0 :   FFI_RETURN_INT (sc, ~v);
     108             : }
     109             : 
     110             : /* User interface.  */
     111             : 
     112             : static pointer
     113        1008 : do_flush_stdio (scheme *sc, pointer args)
     114             : {
     115        1008 :   FFI_PROLOG ();
     116        1008 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     117        1008 :   fflush (stdout);
     118        1008 :   fflush (stderr);
     119        1008 :   FFI_RETURN (sc);
     120             : }
     121             : 
     122             : 
     123             : int use_libreadline;
     124             : 
     125             : /* Read a string, and return a pointer to it.  Returns NULL on EOF. */
     126             : char *
     127           0 : rl_gets (const char *prompt)
     128             : {
     129             :   static char *line = NULL;
     130             :   char *p;
     131           0 :   xfree (line);
     132             : 
     133             : #if HAVE_LIBREADLINE
     134             :     {
     135           0 :       line = readline (prompt);
     136           0 :       if (line && *line)
     137           0 :         add_history (line);
     138             :     }
     139             : #else
     140             :     {
     141             :       size_t max_size = 0xff;
     142             :       printf ("%s", prompt);
     143             :       fflush (stdout);
     144             :       line = xtrymalloc (max_size);
     145             :       if (line != NULL)
     146             :         fgets (line, max_size, stdin);
     147             :     }
     148             : #endif
     149             : 
     150             :   /* Strip trailing whitespace.  */
     151           0 :   if (line && strlen (line) > 0)
     152           0 :     for (p = &line[strlen (line) - 1]; isspace (*p); p--)
     153           0 :       *p = 0;
     154             : 
     155           0 :   return line;
     156             : }
     157             : 
     158             : static pointer
     159           0 : do_prompt (scheme *sc, pointer args)
     160             : {
     161           0 :   FFI_PROLOG ();
     162             :   const char *prompt;
     163             :   const char *line;
     164           0 :   FFI_ARG_OR_RETURN (sc, const char *, prompt, string, args);
     165           0 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     166           0 :   line = rl_gets (prompt);
     167           0 :   if (! line)
     168           0 :     FFI_RETURN_POINTER (sc, sc->EOF_OBJ);
     169             : 
     170           0 :   FFI_RETURN_STRING (sc, line);
     171             : }
     172             : 
     173             : static pointer
     174           0 : do_sleep (scheme *sc, pointer args)
     175             : {
     176           0 :   FFI_PROLOG ();
     177             :   unsigned int seconds;
     178           0 :   FFI_ARG_OR_RETURN (sc, unsigned int, seconds, number, args);
     179           0 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     180           0 :   sleep (seconds);
     181           0 :   FFI_RETURN (sc);
     182             : }
     183             : 
     184             : static pointer
     185           0 : do_usleep (scheme *sc, pointer args)
     186             : {
     187           0 :   FFI_PROLOG ();
     188             :   useconds_t microseconds;
     189           0 :   FFI_ARG_OR_RETURN (sc, useconds_t, microseconds, number, args);
     190           0 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     191           0 :   usleep (microseconds);
     192           0 :   FFI_RETURN (sc);
     193             : }
     194             : 
     195             : static pointer
     196         279 : do_chdir (scheme *sc, pointer args)
     197             : {
     198         279 :   FFI_PROLOG ();
     199             :   char *name;
     200         279 :   FFI_ARG_OR_RETURN (sc, char *, name, path, args);
     201         279 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     202         279 :   if (chdir (name))
     203           0 :     FFI_RETURN_ERR (sc, errno);
     204         279 :   FFI_RETURN (sc);
     205             : }
     206             : 
     207             : static pointer
     208          32 : do_strerror (scheme *sc, pointer args)
     209             : {
     210          32 :   FFI_PROLOG ();
     211             :   int error;
     212          32 :   FFI_ARG_OR_RETURN (sc, int, error, number, args);
     213          32 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     214          32 :   FFI_RETURN_STRING (sc, gpg_strerror (error));
     215             : }
     216             : 
     217             : static pointer
     218        5312 : do_getenv (scheme *sc, pointer args)
     219             : {
     220        5312 :   FFI_PROLOG ();
     221             :   char *name;
     222             :   char *value;
     223        5312 :   FFI_ARG_OR_RETURN (sc, char *, name, string, args);
     224        5312 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     225        5312 :   value = getenv (name);
     226        5312 :   FFI_RETURN_STRING (sc, value ? value : "");
     227             : }
     228             : 
     229             : static pointer
     230         263 : do_setenv (scheme *sc, pointer args)
     231             : {
     232         263 :   FFI_PROLOG ();
     233             :   char *name;
     234             :   char *value;
     235             :   int overwrite;
     236         263 :   FFI_ARG_OR_RETURN (sc, char *, name, string, args);
     237         263 :   FFI_ARG_OR_RETURN (sc, char *, value, string, args);
     238         263 :   FFI_ARG_OR_RETURN (sc, int, overwrite, bool, args);
     239         263 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     240         263 :   FFI_RETURN_ERR (sc, gnupg_setenv (name, value, overwrite));
     241             : }
     242             : 
     243             : static pointer
     244           1 : do_exit (scheme *sc, pointer args)
     245             : {
     246           1 :   FFI_PROLOG ();
     247             :   int retcode;
     248           1 :   FFI_ARG_OR_RETURN (sc, int, retcode, number, args);
     249           1 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     250           1 :   exit (retcode);
     251             : }
     252             : 
     253             : /* XXX: use gnupgs variant b/c mode as string */
     254             : static pointer
     255         215 : do_open (scheme *sc, pointer args)
     256             : {
     257         215 :   FFI_PROLOG ();
     258             :   int fd;
     259             :   char *pathname;
     260             :   int flags;
     261         215 :   mode_t mode = 0;
     262         215 :   FFI_ARG_OR_RETURN (sc, char *, pathname, path, args);
     263         215 :   FFI_ARG_OR_RETURN (sc, int, flags, number, args);
     264         215 :   if (args != sc->NIL)
     265         116 :     FFI_ARG_OR_RETURN (sc, mode_t, mode, number, args);
     266         215 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     267             : 
     268         215 :   fd = open (pathname, flags, mode);
     269         215 :   if (fd == -1)
     270           0 :     FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     271         215 :   FFI_RETURN_INT (sc, fd);
     272             : }
     273             : 
     274             : static pointer
     275          50 : do_fdopen (scheme *sc, pointer args)
     276             : {
     277          50 :   FFI_PROLOG ();
     278             :   FILE *stream;
     279             :   int fd;
     280             :   char *mode;
     281             :   int kind;
     282          50 :   FFI_ARG_OR_RETURN (sc, int, fd, number, args);
     283          50 :   FFI_ARG_OR_RETURN (sc, char *, mode, string, args);
     284          50 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     285             : 
     286          50 :   stream = fdopen (fd, mode);
     287          50 :   if (stream == NULL)
     288           0 :     FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     289             : 
     290          50 :   if (setvbuf (stream, NULL, _IONBF, 0) != 0)
     291           0 :     FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     292             : 
     293          50 :   kind = 0;
     294          50 :   if (strchr (mode, 'r'))
     295           0 :     kind |= port_input;
     296          50 :   if (strchr (mode, 'w'))
     297          50 :     kind |= port_output;
     298             : 
     299          50 :   FFI_RETURN_POINTER (sc, sc->vptr->mk_port_from_file (sc, stream, kind));
     300             : }
     301             : 
     302             : static pointer
     303         535 : do_close (scheme *sc, pointer args)
     304             : {
     305         535 :   FFI_PROLOG ();
     306             :   int fd;
     307         535 :   FFI_ARG_OR_RETURN (sc, int, fd, number, args);
     308         535 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     309         535 :   FFI_RETURN_ERR (sc, close (fd) == 0 ? 0 : gpg_error_from_syserror ());
     310             : }
     311             : 
     312             : static pointer
     313        1206 : do_mkdtemp (scheme *sc, pointer args)
     314             : {
     315        1206 :   FFI_PROLOG ();
     316             :   char *template;
     317             :   char buffer[128];
     318             :   char *name;
     319        1206 :   FFI_ARG_OR_RETURN (sc, char *, template, string, args);
     320        1206 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     321             : 
     322        1206 :   if (strlen (template) > sizeof buffer - 1)
     323           0 :     FFI_RETURN_ERR (sc, EINVAL);
     324        1206 :   strncpy (buffer, template, sizeof buffer);
     325             : 
     326        1206 :   name = gnupg_mkdtemp (buffer);
     327        1206 :   if (name == NULL)
     328           0 :     FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     329        1206 :   FFI_RETURN_STRING (sc, name);
     330             : }
     331             : 
     332             : static pointer
     333        1185 : do_unlink (scheme *sc, pointer args)
     334             : {
     335        1185 :   FFI_PROLOG ();
     336             :   char *name;
     337        1185 :   FFI_ARG_OR_RETURN (sc, char *, name, string, args);
     338        1185 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     339        1185 :   if (unlink (name) == -1)
     340          31 :     FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     341        1154 :   FFI_RETURN (sc);
     342             : }
     343             : 
     344             : static gpg_error_t
     345        1544 : unlink_recursively (const char *name)
     346             : {
     347        1544 :   gpg_error_t err = 0;
     348             :   struct stat st;
     349             : 
     350        1544 :   if (stat (name, &st) == -1)
     351           1 :     return gpg_error_from_syserror ();
     352             : 
     353        1543 :   if (S_ISDIR (st.st_mode))
     354             :     {
     355             :       DIR *dir;
     356             :       struct dirent *dent;
     357             : 
     358         106 :       dir = opendir (name);
     359         106 :       if (dir == NULL)
     360           0 :         return gpg_error_from_syserror ();
     361             : 
     362        1910 :       while ((dent = readdir (dir)))
     363             :         {
     364             :           char *child;
     365             : 
     366        1698 :           if (strcmp (dent->d_name, ".") == 0
     367        1592 :               || strcmp (dent->d_name, "..") == 0)
     368         212 :             continue;
     369             : 
     370        1486 :           child = xtryasprintf ("%s/%s", name, dent->d_name);
     371        1486 :           if (child == NULL)
     372             :             {
     373           0 :               err = gpg_error_from_syserror ();
     374           0 :               goto leave;
     375             :             }
     376             : 
     377        1486 :           err = unlink_recursively (child);
     378        1486 :           xfree (child);
     379        1486 :           if (err == gpg_error_from_errno (ENOENT))
     380           0 :             err = 0;
     381        1486 :           if (err)
     382           0 :             goto leave;
     383             :         }
     384             : 
     385             :     leave:
     386         106 :       closedir (dir);
     387         106 :       if (! err)
     388         106 :         rmdir (name);
     389         106 :       return err;
     390             :     }
     391             :   else
     392        1437 :     if (unlink (name) == -1)
     393           0 :       return gpg_error_from_syserror ();
     394        1437 :   return 0;
     395             : }
     396             : 
     397             : static pointer
     398          58 : do_unlink_recursively (scheme *sc, pointer args)
     399             : {
     400          58 :   FFI_PROLOG ();
     401             :   char *name;
     402          58 :   FFI_ARG_OR_RETURN (sc, char *, name, string, args);
     403          58 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     404          58 :   err = unlink_recursively (name);
     405          58 :   FFI_RETURN (sc);
     406             : }
     407             : 
     408             : static pointer
     409           0 : do_rename (scheme *sc, pointer args)
     410             : {
     411           0 :   FFI_PROLOG ();
     412             :   char *old;
     413             :   char *new;
     414           0 :   FFI_ARG_OR_RETURN (sc, char *, old, string, args);
     415           0 :   FFI_ARG_OR_RETURN (sc, char *, new, string, args);
     416           0 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     417           0 :   if (rename (old, new) == -1)
     418           0 :     FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     419           0 :   FFI_RETURN (sc);
     420             : }
     421             : 
     422             : static pointer
     423         284 : do_getcwd (scheme *sc, pointer args)
     424             : {
     425         284 :   FFI_PROLOG ();
     426             :   pointer result;
     427             :   char *cwd;
     428         284 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     429         284 :   cwd = gnupg_getcwd ();
     430         284 :   if (cwd == NULL)
     431           0 :     FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     432         284 :   result = sc->vptr->mk_string (sc, cwd);
     433         284 :   xfree (cwd);
     434         284 :   FFI_RETURN_POINTER (sc, result);
     435             : }
     436             : 
     437             : static pointer
     438           3 : do_mkdir (scheme *sc, pointer args)
     439             : {
     440           3 :   FFI_PROLOG ();
     441             :   char *name;
     442             :   char *mode;
     443           3 :   FFI_ARG_OR_RETURN (sc, char *, name, string, args);
     444           3 :   FFI_ARG_OR_RETURN (sc, char *, mode, string, args);
     445           3 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     446           3 :   if (gnupg_mkdir (name, mode) == -1)
     447           0 :     FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     448           3 :   FFI_RETURN (sc);
     449             : }
     450             : 
     451             : static pointer
     452        1148 : do_rmdir (scheme *sc, pointer args)
     453             : {
     454        1148 :   FFI_PROLOG ();
     455             :   char *name;
     456        1148 :   FFI_ARG_OR_RETURN (sc, char *, name, string, args);
     457        1148 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     458        1148 :   if (rmdir (name) == -1)
     459           0 :     FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     460        1148 :   FFI_RETURN (sc);
     461             : }
     462             : 
     463             : 
     464             : 
     465             : /* estream functions.  */
     466             : 
     467             : struct es_object_box
     468             : {
     469             :   estream_t stream;
     470             :   int closed;
     471             : };
     472             : 
     473             : static void
     474        5892 : es_object_finalize (scheme *sc, void *data)
     475             : {
     476        5892 :   struct es_object_box *box = data;
     477             :   (void) sc;
     478             : 
     479        5892 :   if (! box->closed)
     480           0 :     es_fclose (box->stream);
     481        5892 :   xfree (box);
     482        5892 : }
     483             : 
     484             : static void
     485           0 : es_object_to_string (scheme *sc, char *out, size_t size, void *data)
     486             : {
     487           0 :   struct es_object_box *box = data;
     488             :   (void) sc;
     489             : 
     490           0 :   snprintf (out, size, "#estream %p", box->stream);
     491           0 : }
     492             : 
     493             : static struct foreign_object_vtable es_object_vtable =
     494             :   {
     495             :     es_object_finalize,
     496             :     es_object_to_string,
     497             :   };
     498             : 
     499             : static pointer
     500        5892 : es_wrap (scheme *sc, estream_t stream)
     501             : {
     502        5892 :   struct es_object_box *box = xmalloc (sizeof *box);
     503        5892 :   if (box == NULL)
     504           0 :     return sc->NIL;
     505             : 
     506        5892 :   box->stream = stream;
     507        5892 :   box->closed = 0;
     508        5892 :   return sc->vptr->mk_foreign_object (sc, &es_object_vtable, box);
     509             : }
     510             : 
     511             : static struct es_object_box *
     512       39780 : es_unwrap (scheme *sc, pointer object)
     513             : {
     514             :   (void) sc;
     515             : 
     516       39780 :   if (! is_foreign_object (object))
     517           0 :     return NULL;
     518             : 
     519       39780 :   if (sc->vptr->get_foreign_object_vtable (object) != &es_object_vtable)
     520           0 :     return NULL;
     521             : 
     522       39780 :   return sc->vptr->get_foreign_object_data (object);
     523             : }
     524             : 
     525             : #define CONVERSION_estream(SC, X)       es_unwrap (SC, X)
     526             : #define IS_A_estream(SC, X)             es_unwrap (SC, X)
     527             : 
     528             : static pointer
     529        5892 : do_es_fclose (scheme *sc, pointer args)
     530             : {
     531        5892 :   FFI_PROLOG ();
     532             :   struct es_object_box *box;
     533        5892 :   FFI_ARG_OR_RETURN (sc, struct es_object_box *, box, estream, args);
     534        5892 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     535        5892 :   err = es_fclose (box->stream);
     536        5892 :   if (! err)
     537        5892 :     box->closed = 1;
     538        5892 :   FFI_RETURN (sc);
     539             : }
     540             : 
     541             : static pointer
     542        4053 : do_es_read (scheme *sc, pointer args)
     543             : {
     544        4053 :   FFI_PROLOG ();
     545             :   struct es_object_box *box;
     546             :   size_t bytes_to_read;
     547             : 
     548             :   pointer result;
     549             :   void *buffer;
     550             :   size_t bytes_read;
     551             : 
     552        4053 :   FFI_ARG_OR_RETURN (sc, struct es_object_box *, box, estream, args);
     553        4053 :   FFI_ARG_OR_RETURN (sc, size_t, bytes_to_read, number, args);
     554        4053 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     555             : 
     556        4053 :   buffer = xtrymalloc (bytes_to_read);
     557        4053 :   if (buffer == NULL)
     558           0 :     FFI_RETURN_ERR (sc, ENOMEM);
     559             : 
     560        4053 :   err = es_read (box->stream, buffer, bytes_to_read, &bytes_read);
     561        4053 :   if (err)
     562           0 :     FFI_RETURN_ERR (sc, err);
     563             : 
     564        4053 :   result = sc->vptr->mk_counted_string (sc, buffer, bytes_read);
     565        4053 :   xfree (buffer);
     566        4053 :   FFI_RETURN_POINTER (sc, result);
     567             : }
     568             : 
     569             : static pointer
     570        7981 : do_es_feof (scheme *sc, pointer args)
     571             : {
     572        7981 :   FFI_PROLOG ();
     573             :   struct es_object_box *box;
     574        7981 :   FFI_ARG_OR_RETURN (sc, struct es_object_box *, box, estream, args);
     575        7981 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     576             : 
     577        7981 :   FFI_RETURN_POINTER (sc, es_feof (box->stream) ? sc->T : sc->F);
     578             : }
     579             : 
     580             : static pointer
     581        1964 : do_es_write (scheme *sc, pointer args)
     582             : {
     583        1964 :   FFI_PROLOG ();
     584             :   struct es_object_box *box;
     585             :   const char *buffer;
     586             :   size_t bytes_to_write, bytes_written;
     587             : 
     588        1964 :   FFI_ARG_OR_RETURN (sc, struct es_object_box *, box, estream, args);
     589             :   /* XXX how to get the length of the string buffer?  scheme strings
     590             :      may contain \0.  */
     591        1964 :   FFI_ARG_OR_RETURN (sc, const char *, buffer, string, args);
     592        1964 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     593             : 
     594        1964 :   bytes_to_write = strlen (buffer);
     595        4440 :   while (bytes_to_write > 0)
     596             :     {
     597         512 :       err = es_write (box->stream, buffer, bytes_to_write, &bytes_written);
     598         512 :       if (err)
     599           0 :         break;
     600         512 :       bytes_to_write -= bytes_written;
     601         512 :       buffer += bytes_written;
     602             :     }
     603             : 
     604        1964 :   FFI_RETURN (sc);
     605             : }
     606             : 
     607             : 
     608             : 
     609             : /* Process handling.  */
     610             : 
     611             : static pointer
     612        1964 : do_spawn_process (scheme *sc, pointer args)
     613             : {
     614        1964 :   FFI_PROLOG ();
     615             :   pointer arguments;
     616             :   char **argv;
     617             :   size_t len;
     618             :   unsigned int flags;
     619             : 
     620             :   estream_t infp;
     621             :   estream_t outfp;
     622             :   estream_t errfp;
     623             :   pid_t pid;
     624             : 
     625        1964 :   FFI_ARG_OR_RETURN (sc, pointer, arguments, list, args);
     626        1964 :   FFI_ARG_OR_RETURN (sc, unsigned int, flags, number, args);
     627        1964 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     628             : 
     629        1964 :   err = ffi_list2argv (sc, arguments, &argv, &len);
     630        1964 :   if (err == gpg_error (GPG_ERR_INV_VALUE))
     631           0 :     return ffi_sprintf (sc, "%luth element of first argument is "
     632             :                         "neither string nor symbol",
     633             :                         (unsigned long) len);
     634        1964 :   if (err)
     635           0 :     FFI_RETURN_ERR (sc, err);
     636             : 
     637        1964 :   if (verbose > 1)
     638             :     {
     639             :       char **p;
     640           0 :       fprintf (stderr, "Executing:");
     641           0 :       for (p = argv; *p; p++)
     642           0 :         fprintf (stderr, " '%s'", *p);
     643           0 :       fprintf (stderr, "\n");
     644             :     }
     645             : 
     646        1964 :   err = gnupg_spawn_process (argv[0], (const char **) &argv[1],
     647             :                              GPG_ERR_SOURCE_DEFAULT,
     648             :                              NULL,
     649             :                              flags,
     650             :                              &infp, &outfp, &errfp, &pid);
     651        1964 :   xfree (argv);
     652             : #define IMC(A, B)                                                       \
     653             :   _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1)
     654             : #define IMS(A, B)                                                       \
     655             :   _cons (sc, es_wrap (sc, (A)), (B), 1)
     656        1964 :   FFI_RETURN_POINTER (sc, IMS (infp,
     657             :                               IMS (outfp,
     658             :                                    IMS (errfp,
     659             :                                         IMC (pid, sc->NIL)))));
     660             : #undef IMS
     661             : #undef IMC
     662             : }
     663             : 
     664             : static pointer
     665         336 : do_spawn_process_fd (scheme *sc, pointer args)
     666             : {
     667         336 :   FFI_PROLOG ();
     668             :   pointer arguments;
     669             :   char **argv;
     670             :   size_t len;
     671             :   int infd, outfd, errfd;
     672             : 
     673             :   pid_t pid;
     674             : 
     675         336 :   FFI_ARG_OR_RETURN (sc, pointer, arguments, list, args);
     676         336 :   FFI_ARG_OR_RETURN (sc, int, infd, number, args);
     677         336 :   FFI_ARG_OR_RETURN (sc, int, outfd, number, args);
     678         336 :   FFI_ARG_OR_RETURN (sc, int, errfd, number, args);
     679         336 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     680             : 
     681         336 :   err = ffi_list2argv (sc, arguments, &argv, &len);
     682         336 :   if (err == gpg_error (GPG_ERR_INV_VALUE))
     683           0 :     return ffi_sprintf (sc, "%luth element of first argument is "
     684             :                         "neither string nor symbol",
     685             :                         (unsigned long) len);
     686         336 :   if (err)
     687           0 :     FFI_RETURN_ERR (sc, err);
     688             : 
     689         336 :   if (verbose > 1)
     690             :     {
     691             :       char **p;
     692           0 :       fprintf (stderr, "Executing:");
     693           0 :       for (p = argv; *p; p++)
     694           0 :         fprintf (stderr, " '%s'", *p);
     695           0 :       fprintf (stderr, "\n");
     696             :     }
     697             : 
     698         336 :   err = gnupg_spawn_process_fd (argv[0], (const char **) &argv[1],
     699             :                                 infd, outfd, errfd, &pid);
     700         336 :   xfree (argv);
     701         336 :   FFI_RETURN_INT (sc, pid);
     702             : }
     703             : 
     704             : static pointer
     705        2117 : do_wait_process (scheme *sc, pointer args)
     706             : {
     707        2117 :   FFI_PROLOG ();
     708             :   const char *name;
     709             :   pid_t pid;
     710             :   int hang;
     711             : 
     712             :   int retcode;
     713             : 
     714        2117 :   FFI_ARG_OR_RETURN (sc, const char *, name, string, args);
     715        2117 :   FFI_ARG_OR_RETURN (sc, pid_t, pid, number, args);
     716        2117 :   FFI_ARG_OR_RETURN (sc, int, hang, bool, args);
     717        2117 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     718        2117 :   err = gnupg_wait_process (name, pid, hang, &retcode);
     719        2117 :   if (err == GPG_ERR_GENERAL)
     720          18 :     err = 0;    /* Let the return code speak for itself.  */
     721             : 
     722        2117 :   FFI_RETURN_INT (sc, retcode);
     723             : }
     724             : 
     725             : 
     726             : static pointer
     727         134 : do_wait_processes (scheme *sc, pointer args)
     728             : {
     729         134 :   FFI_PROLOG ();
     730             :   pointer list_names;
     731             :   char **names;
     732             :   pointer list_pids;
     733             :   size_t i, count;
     734             :   pid_t *pids;
     735             :   int hang;
     736             :   int *retcodes;
     737         134 :   pointer retcodes_list = sc->NIL;
     738             : 
     739         134 :   FFI_ARG_OR_RETURN (sc, pointer, list_names, list, args);
     740         134 :   FFI_ARG_OR_RETURN (sc, pointer, list_pids, list, args);
     741         134 :   FFI_ARG_OR_RETURN (sc, int, hang, bool, args);
     742         134 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     743             : 
     744         268 :   if (sc->vptr->list_length (sc, list_names)
     745         134 :       != sc->vptr->list_length (sc, list_pids))
     746           0 :     return
     747           0 :       sc->vptr->mk_string (sc, "length of first two arguments must match");
     748             : 
     749         134 :   err = ffi_list2argv (sc, list_names, &names, &count);
     750         134 :   if (err == gpg_error (GPG_ERR_INV_VALUE))
     751           0 :     return ffi_sprintf (sc, "%luth element of first argument is "
     752             :                         "neither string nor symbol",
     753             :                         (unsigned long) count);
     754         134 :   if (err)
     755           0 :     FFI_RETURN_ERR (sc, err);
     756             : 
     757         134 :   err = ffi_list2intv (sc, list_pids, (int **) &pids, &count);
     758         134 :   if (err == gpg_error (GPG_ERR_INV_VALUE))
     759           0 :     return ffi_sprintf (sc, "%luth element of second argument is "
     760             :                         "neither string nor symbol",
     761             :                         (unsigned long) count);
     762         134 :   if (err)
     763           0 :     FFI_RETURN_ERR (sc, err);
     764             : 
     765         134 :   retcodes = xtrycalloc (sizeof *retcodes, count);
     766         134 :   if (retcodes == NULL)
     767             :     {
     768           0 :       xfree (names);
     769           0 :       xfree (pids);
     770           0 :       FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     771             :     }
     772             : 
     773         134 :   err = gnupg_wait_processes ((const char **) names, pids, count, hang,
     774             :                               retcodes);
     775         134 :   if (err == GPG_ERR_GENERAL)
     776           9 :     err = 0;    /* Let the return codes speak.  */
     777             : 
     778         317 :   for (i = 0; i < count; i++)
     779         183 :     retcodes_list =
     780         366 :       (sc->vptr->cons) (sc,
     781         183 :                         sc->vptr->mk_integer (sc,
     782         183 :                                               (long) retcodes[count-1-i]),
     783             :                         retcodes_list);
     784             : 
     785         134 :   xfree (names);
     786         134 :   xfree (pids);
     787         134 :   xfree (retcodes);
     788         134 :   FFI_RETURN_POINTER (sc, retcodes_list);
     789             : }
     790             : 
     791             : 
     792             : static pointer
     793          93 : do_pipe (scheme *sc, pointer args)
     794             : {
     795          93 :   FFI_PROLOG ();
     796             :   int filedes[2];
     797          93 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     798          93 :   err = gnupg_create_pipe (filedes);
     799             : #define IMC(A, B)                                                       \
     800             :   _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1)
     801          93 :   FFI_RETURN_POINTER (sc, IMC (filedes[0],
     802             :                               IMC (filedes[1], sc->NIL)));
     803             : #undef IMC
     804             : }
     805             : 
     806             : static pointer
     807          42 : do_inbound_pipe (scheme *sc, pointer args)
     808             : {
     809          42 :   FFI_PROLOG ();
     810             :   int filedes[2];
     811          42 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     812          42 :   err = gnupg_create_inbound_pipe (filedes, NULL, 0);
     813             : #define IMC(A, B)                                                       \
     814             :   _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1)
     815          42 :   FFI_RETURN_POINTER (sc, IMC (filedes[0],
     816             :                               IMC (filedes[1], sc->NIL)));
     817             : #undef IMC
     818             : }
     819             : 
     820             : static pointer
     821          49 : do_outbound_pipe (scheme *sc, pointer args)
     822             : {
     823          49 :   FFI_PROLOG ();
     824             :   int filedes[2];
     825          49 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     826          49 :   err = gnupg_create_outbound_pipe (filedes, NULL, 0);
     827             : #define IMC(A, B)                                                       \
     828             :   _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1)
     829          49 :   FFI_RETURN_POINTER (sc, IMC (filedes[0],
     830             :                               IMC (filedes[1], sc->NIL)));
     831             : #undef IMC
     832             : }
     833             : 
     834             : 
     835             : 
     836             : /* Test helper functions.  */
     837             : static pointer
     838         530 : do_file_equal (scheme *sc, pointer args)
     839             : {
     840         530 :   FFI_PROLOG ();
     841         530 :   pointer result = sc->F;
     842             :   char *a_name, *b_name;
     843             :   int binary;
     844             :   const char *mode;
     845         530 :   FILE *a_stream = NULL, *b_stream = NULL;
     846             :   struct stat a_stat, b_stat;
     847             : #define BUFFER_SIZE     1024
     848             :   char a_buf[BUFFER_SIZE], b_buf[BUFFER_SIZE];
     849             : #undef BUFFER_SIZE
     850             :   size_t chunk;
     851             : 
     852         530 :   FFI_ARG_OR_RETURN (sc, char *, a_name, string, args);
     853         530 :   FFI_ARG_OR_RETURN (sc, char *, b_name, string, args);
     854         530 :   FFI_ARG_OR_RETURN (sc, int, binary, bool, args);
     855         530 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     856             : 
     857         530 :   mode = binary ? "rb" : "r";
     858         530 :   a_stream = fopen (a_name, mode);
     859         530 :   if (a_stream == NULL)
     860           0 :     goto errout;
     861             : 
     862         530 :   b_stream = fopen (b_name, mode);
     863         530 :   if (b_stream == NULL)
     864           0 :     goto errout;
     865             : 
     866         530 :   if (fstat (fileno (a_stream), &a_stat) < 0)
     867           0 :     goto errout;
     868             : 
     869         530 :   if (fstat (fileno (b_stream), &b_stat) < 0)
     870           0 :     goto errout;
     871             : 
     872         530 :   if (binary && a_stat.st_size != b_stat.st_size)
     873             :     {
     874           0 :       if (verbose)
     875           0 :         fprintf (stderr, "Files %s and %s differ in size %lu != %lu\n",
     876           0 :                  a_name, b_name, (unsigned long) a_stat.st_size,
     877           0 :                  (unsigned long) b_stat.st_size);
     878             : 
     879           0 :       goto out;
     880             :     }
     881             : 
     882        7901 :   while (! feof (a_stream))
     883             :     {
     884        6841 :       chunk = sizeof a_buf;
     885             : 
     886        6841 :       chunk = fread (a_buf, 1, chunk, a_stream);
     887        6841 :       if (chunk == 0 && ferror (a_stream))
     888           0 :         goto errout;    /* some error */
     889             : 
     890        6841 :       if (fread (b_buf, 1, chunk, b_stream) < chunk)
     891             :         {
     892           0 :           if (feof (b_stream))
     893           0 :             goto out;   /* short read */
     894           0 :           goto errout;  /* some error */
     895             :         }
     896             : 
     897        6841 :       if (chunk > 0 && memcmp (a_buf, b_buf, chunk) != 0)
     898           0 :         goto out;
     899             :     }
     900             : 
     901         530 :   fread (b_buf, 1, 1, b_stream);
     902         530 :   if (! feof (b_stream))
     903           0 :     goto out;   /* b is longer */
     904             : 
     905             :   /* They match.  */
     906         530 :   result = sc->T;
     907             : 
     908             :  out:
     909         530 :   if (a_stream)
     910         530 :     fclose (a_stream);
     911         530 :   if (b_stream)
     912         530 :     fclose (b_stream);
     913         530 :   FFI_RETURN_POINTER (sc, result);
     914             :  errout:
     915           0 :   err = gpg_error_from_syserror ();
     916           0 :   goto out;
     917             : }
     918             : 
     919             : static pointer
     920          79 : do_splice (scheme *sc, pointer args)
     921             : {
     922          79 :   FFI_PROLOG ();
     923             :   int source;
     924             :   int sink;
     925          79 :   ssize_t len = -1;
     926             :   char buffer[1024];
     927             :   ssize_t bytes_read;
     928          79 :   FFI_ARG_OR_RETURN (sc, int, source, number, args);
     929          79 :   FFI_ARG_OR_RETURN (sc, int, sink, number, args);
     930          79 :   if (args != sc->NIL)
     931          17 :     FFI_ARG_OR_RETURN (sc, ssize_t, len, number, args);
     932          79 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     933        1567 :   while (len == -1 || len > 0)
     934             :     {
     935        1471 :       size_t want = sizeof buffer;
     936        1471 :       if (len > 0 && (ssize_t) want > len)
     937          15 :         want = (size_t) len;
     938             : 
     939        1471 :       bytes_read = read (source, buffer, want);
     940        1471 :       if (bytes_read == 0)
     941          62 :         break;
     942        1409 :       if (bytes_read < 0)
     943           0 :         FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     944        1409 :       if (write (sink, buffer, bytes_read) != bytes_read)
     945           0 :         FFI_RETURN_ERR (sc, gpg_error_from_syserror ());
     946        1409 :       if (len != -1)
     947          54 :         len -= bytes_read;
     948             :     }
     949          79 :   FFI_RETURN (sc);
     950             : }
     951             : 
     952             : static pointer
     953       11197 : do_string_index (scheme *sc, pointer args)
     954             : {
     955       11197 :   FFI_PROLOG ();
     956             :   char *haystack;
     957             :   char needle;
     958       11197 :   ssize_t offset = 0;
     959             :   char *position;
     960       11197 :   FFI_ARG_OR_RETURN (sc, char *, haystack, string, args);
     961       11197 :   FFI_ARG_OR_RETURN (sc, char, needle, character, args);
     962       11197 :   if (args != sc->NIL)
     963             :     {
     964       10939 :       FFI_ARG_OR_RETURN (sc, ssize_t, offset, number, args);
     965       10939 :       if (offset < 0)
     966           0 :         return ffi_sprintf (sc, "offset must be positive");
     967       10939 :       if (offset > strlen (haystack))
     968           0 :         return ffi_sprintf (sc, "offset exceeds haystack");
     969             :     }
     970       11197 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     971             : 
     972       11197 :   position = strchr (haystack+offset, needle);
     973       11197 :   if (position)
     974        9639 :     FFI_RETURN_INT (sc, position - haystack);
     975             :   else
     976        1558 :     FFI_RETURN_POINTER (sc, sc->F);
     977             : }
     978             : 
     979             : static pointer
     980        1535 : do_string_rindex (scheme *sc, pointer args)
     981             : {
     982        1535 :   FFI_PROLOG ();
     983             :   char *haystack;
     984             :   char needle;
     985        1535 :   ssize_t offset = 0;
     986             :   char *position;
     987        1535 :   FFI_ARG_OR_RETURN (sc, char *, haystack, string, args);
     988        1535 :   FFI_ARG_OR_RETURN (sc, char, needle, character, args);
     989        1535 :   if (args != sc->NIL)
     990             :     {
     991         129 :       FFI_ARG_OR_RETURN (sc, ssize_t, offset, number, args);
     992         129 :       if (offset < 0)
     993           0 :         return ffi_sprintf (sc, "offset must be positive");
     994         129 :       if (offset > strlen (haystack))
     995           0 :         return ffi_sprintf (sc, "offset exceeds haystack");
     996             :     }
     997        1535 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
     998             : 
     999        1535 :   position = strrchr (haystack+offset, needle);
    1000        1535 :   if (position)
    1001        1277 :     FFI_RETURN_INT (sc, position - haystack);
    1002             :   else
    1003         258 :     FFI_RETURN_POINTER (sc, sc->F);
    1004             : }
    1005             : 
    1006             : static pointer
    1007         471 : do_string_contains (scheme *sc, pointer args)
    1008             : {
    1009         471 :   FFI_PROLOG ();
    1010             :   char *haystack;
    1011             :   char *needle;
    1012         471 :   FFI_ARG_OR_RETURN (sc, char *, haystack, string, args);
    1013         471 :   FFI_ARG_OR_RETURN (sc, char *, needle, string, args);
    1014         471 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
    1015         471 :   FFI_RETURN_POINTER (sc, strstr (haystack, needle) ? sc->T : sc->F);
    1016             : }
    1017             : 
    1018             : static pointer
    1019           1 : do_glob (scheme *sc, pointer args)
    1020             : {
    1021           1 :   FFI_PROLOG ();
    1022           1 :   pointer result = sc->NIL;
    1023             :   size_t i;
    1024             :   char *pattern;
    1025             :   glob_t pglob;
    1026           1 :   FFI_ARG_OR_RETURN (sc, char *, pattern, string, args);
    1027           1 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
    1028             : 
    1029           1 :   switch (glob (pattern, 0, NULL, &pglob))
    1030             :     {
    1031             :     case 0:
    1032          15 :       for (i = 0; i < pglob.gl_pathc; i++)
    1033          14 :         result =
    1034          28 :           (sc->vptr->cons) (sc,
    1035          14 :                             sc->vptr->mk_string (sc, pglob.gl_pathv[i]),
    1036             :                             result);
    1037           1 :       globfree (&pglob);
    1038           1 :       break;
    1039             : 
    1040             :     case GLOB_NOMATCH:
    1041             :       /* Return the empty list.  */
    1042           0 :       break;
    1043             : 
    1044             :     case GLOB_NOSPACE:
    1045           0 :       return ffi_sprintf (sc, "out of memory");
    1046             :     case GLOB_ABORTED:
    1047           0 :       return ffi_sprintf (sc, "read error");
    1048             :     default:
    1049           0 :       assert (! "not reached");
    1050             :     }
    1051           1 :   FFI_RETURN_POINTER (sc, result);
    1052             : }
    1053             : 
    1054             : 
    1055             : 
    1056             : static pointer
    1057        2229 : do_get_verbose (scheme *sc, pointer args)
    1058             : {
    1059        2229 :   FFI_PROLOG ();
    1060        2229 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
    1061        2229 :   FFI_RETURN_INT (sc, verbose);
    1062             : }
    1063             : 
    1064             : static pointer
    1065           0 : do_set_verbose (scheme *sc, pointer args)
    1066             : {
    1067           0 :   FFI_PROLOG ();
    1068             :   int new_verbosity, old;
    1069           0 :   FFI_ARG_OR_RETURN (sc, int, new_verbosity, number, args);
    1070           0 :   FFI_ARGS_DONE_OR_RETURN (sc, args);
    1071             : 
    1072           0 :   old = verbose;
    1073           0 :   verbose = new_verbosity;
    1074             : 
    1075           0 :   FFI_RETURN_INT (sc, old);
    1076             : }
    1077             : 
    1078             : 
    1079             : gpg_error_t
    1080        2434 : ffi_list2argv (scheme *sc, pointer list, char ***argv, size_t *len)
    1081             : {
    1082             :   int i;
    1083             : 
    1084        2434 :   *len = sc->vptr->list_length (sc, list);
    1085        2434 :   *argv = xtrycalloc (*len + 1, sizeof **argv);
    1086        2434 :   if (*argv == NULL)
    1087           0 :     return gpg_error_from_syserror ();
    1088             : 
    1089       19793 :   for (i = 0; sc->vptr->is_pair (list); list = sc->vptr->pair_cdr (list))
    1090             :     {
    1091       17359 :       if (sc->vptr->is_string (sc->vptr->pair_car (list)))
    1092        6958 :         (*argv)[i++] = sc->vptr->string_value (sc->vptr->pair_car (list));
    1093       10401 :       else if (sc->vptr->is_symbol (sc->vptr->pair_car (list)))
    1094       10401 :         (*argv)[i++] = sc->vptr->symname (sc->vptr->pair_car (list));
    1095             :       else
    1096             :         {
    1097           0 :           xfree (*argv);
    1098           0 :           *argv = NULL;
    1099           0 :           *len = i;
    1100           0 :           return gpg_error (GPG_ERR_INV_VALUE);
    1101             :         }
    1102             :     }
    1103        2434 :   (*argv)[i] = NULL;
    1104        2434 :   return 0;
    1105             : }
    1106             : 
    1107             : gpg_error_t
    1108         134 : ffi_list2intv (scheme *sc, pointer list, int **intv, size_t *len)
    1109             : {
    1110             :   int i;
    1111             : 
    1112         134 :   *len = sc->vptr->list_length (sc, list);
    1113         134 :   *intv = xtrycalloc (*len, sizeof **intv);
    1114         134 :   if (*intv == NULL)
    1115           0 :     return gpg_error_from_syserror ();
    1116             : 
    1117         317 :   for (i = 0; sc->vptr->is_pair (list); list = sc->vptr->pair_cdr (list))
    1118             :     {
    1119         183 :       if (sc->vptr->is_number (sc->vptr->pair_car (list)))
    1120         183 :         (*intv)[i++] = sc->vptr->ivalue (sc->vptr->pair_car (list));
    1121             :       else
    1122             :         {
    1123           0 :           xfree (*intv);
    1124           0 :           *intv = NULL;
    1125           0 :           *len = i;
    1126           0 :           return gpg_error (GPG_ERR_INV_VALUE);
    1127             :         }
    1128             :     }
    1129             : 
    1130         134 :   return 0;
    1131             : }
    1132             : 
    1133             : 
    1134             : char *
    1135       11094 : ffi_schemify_name (const char *s, int macro)
    1136             : {
    1137             :   /* Fixme: We should use xtrystrdup and return NULL.  However, this
    1138             :    * requires a lot more changes.  Simply returning S as done
    1139             :    * originally is not an option.  */
    1140       11094 :   char *n = xstrdup (s), *p;
    1141             :   /* if (n == NULL) */
    1142             :   /*   return s; */
    1143             : 
    1144      113004 :   for (p = n; *p; p++)
    1145             :     {
    1146      101910 :       *p = (char) tolower (*p);
    1147             :        /* We convert _ to - in identifiers.  We allow, however, for
    1148             :           function names to start with a leading _.  The functions in
    1149             :           this namespace are not yet finalized and might change or
    1150             :           vanish without warning.  Use them with care.  */
    1151      101910 :       if (! macro
    1152       90429 :           && p != n
    1153       80625 :           && *p == '_')
    1154        9417 :         *p = '-';
    1155             :     }
    1156       11094 :   return n;
    1157             : }
    1158             : 
    1159             : pointer
    1160           0 : ffi_sprintf (scheme *sc, const char *format, ...)
    1161             : {
    1162             :   pointer result;
    1163             :   va_list listp;
    1164             :   char *expression;
    1165             :   int size, written;
    1166             : 
    1167           0 :   va_start (listp, format);
    1168           0 :   size = vsnprintf (NULL, 0, format, listp);
    1169           0 :   va_end (listp);
    1170             : 
    1171           0 :   expression = xtrymalloc (size + 1);
    1172           0 :   if (expression == NULL)
    1173           0 :     return NULL;
    1174             : 
    1175           0 :   va_start (listp, format);
    1176           0 :   written = vsnprintf (expression, size + 1, format, listp);
    1177           0 :   va_end (listp);
    1178             : 
    1179           0 :   assert (size == written);
    1180             : 
    1181           0 :   result = sc->vptr->mk_string (sc, expression);
    1182           0 :   xfree (expression);
    1183           0 :   return result;
    1184             : }
    1185             : 
    1186             : void
    1187        5418 : ffi_scheme_eval (scheme *sc, const char *format, ...)
    1188             : {
    1189             :   va_list listp;
    1190             :   char *expression;
    1191             :   int size, written;
    1192             : 
    1193        5418 :   va_start (listp, format);
    1194        5418 :   size = vsnprintf (NULL, 0, format, listp);
    1195        5418 :   va_end (listp);
    1196             : 
    1197        5418 :   expression = xtrymalloc (size + 1);
    1198        5418 :   if (expression == NULL)
    1199        5418 :     return;
    1200             : 
    1201        5418 :   va_start (listp, format);
    1202        5418 :   written = vsnprintf (expression, size + 1, format, listp);
    1203        5418 :   va_end (listp);
    1204             : 
    1205        5418 :   assert (size == written);
    1206             : 
    1207        5418 :   sc->vptr->load_string (sc, expression);
    1208        5418 :   xfree (expression);
    1209             : }
    1210             : 
    1211             : gpg_error_t
    1212         129 : ffi_init (scheme *sc, const char *argv0, int argc, const char **argv)
    1213             : {
    1214             :   int i;
    1215         129 :   pointer args = sc->NIL;
    1216             : 
    1217             :   /* bitwise arithmetic */
    1218         129 :   ffi_define_function (sc, logand);
    1219         129 :   ffi_define_function (sc, logior);
    1220         129 :   ffi_define_function (sc, logxor);
    1221         129 :   ffi_define_function (sc, lognot);
    1222             : 
    1223             :   /* libc.  */
    1224         129 :   ffi_define_constant (sc, O_RDONLY);
    1225         129 :   ffi_define_constant (sc, O_WRONLY);
    1226         129 :   ffi_define_constant (sc, O_RDWR);
    1227         129 :   ffi_define_constant (sc, O_CREAT);
    1228         129 :   ffi_define_constant (sc, O_APPEND);
    1229             : #ifndef O_BINARY
    1230             : # define O_BINARY       0
    1231             : #endif
    1232             : #ifndef O_TEXT
    1233             : # define O_TEXT         0
    1234             : #endif
    1235         129 :   ffi_define_constant (sc, O_BINARY);
    1236         129 :   ffi_define_constant (sc, O_TEXT);
    1237         129 :   ffi_define_constant (sc, STDIN_FILENO);
    1238         129 :   ffi_define_constant (sc, STDOUT_FILENO);
    1239         129 :   ffi_define_constant (sc, STDERR_FILENO);
    1240             : 
    1241         129 :   ffi_define_function (sc, sleep);
    1242         129 :   ffi_define_function (sc, usleep);
    1243         129 :   ffi_define_function (sc, chdir);
    1244         129 :   ffi_define_function (sc, strerror);
    1245         129 :   ffi_define_function (sc, getenv);
    1246         129 :   ffi_define_function (sc, setenv);
    1247         129 :   ffi_define_function (sc, exit);
    1248         129 :   ffi_define_function (sc, open);
    1249         129 :   ffi_define_function (sc, fdopen);
    1250         129 :   ffi_define_function (sc, close);
    1251         129 :   ffi_define_function_name (sc, "_mkdtemp", mkdtemp);
    1252         129 :   ffi_define_function (sc, unlink);
    1253         129 :   ffi_define_function (sc, unlink_recursively);
    1254         129 :   ffi_define_function (sc, rename);
    1255         129 :   ffi_define_function (sc, getcwd);
    1256         129 :   ffi_define_function (sc, mkdir);
    1257         129 :   ffi_define_function (sc, rmdir);
    1258             : 
    1259             :   /* Process management.  */
    1260         129 :   ffi_define_function (sc, spawn_process);
    1261         129 :   ffi_define_function (sc, spawn_process_fd);
    1262         129 :   ffi_define_function (sc, wait_process);
    1263         129 :   ffi_define_function (sc, wait_processes);
    1264         129 :   ffi_define_function (sc, pipe);
    1265         129 :   ffi_define_function (sc, inbound_pipe);
    1266         129 :   ffi_define_function (sc, outbound_pipe);
    1267             : 
    1268             :   /* estream functions.  */
    1269         129 :   ffi_define_function_name (sc, "es-fclose", es_fclose);
    1270         129 :   ffi_define_function_name (sc, "es-read", es_read);
    1271         129 :   ffi_define_function_name (sc, "es-feof", es_feof);
    1272         129 :   ffi_define_function_name (sc, "es-write", es_write);
    1273             : 
    1274             :   /* Test helper functions.  */
    1275         129 :   ffi_define_function (sc, file_equal);
    1276         129 :   ffi_define_function (sc, splice);
    1277         129 :   ffi_define_function (sc, string_index);
    1278         129 :   ffi_define_function (sc, string_rindex);
    1279         129 :   ffi_define_function_name (sc, "string-contains?", string_contains);
    1280         129 :   ffi_define_function (sc, glob);
    1281             : 
    1282             :   /* User interface.  */
    1283         129 :   ffi_define_function (sc, flush_stdio);
    1284         129 :   ffi_define_function (sc, prompt);
    1285             : 
    1286             :   /* Configuration.  */
    1287         129 :   ffi_define_function_name (sc, "*verbose*", get_verbose);
    1288         129 :   ffi_define_function_name (sc, "*set-verbose!*", set_verbose);
    1289             : 
    1290         129 :   ffi_define (sc, "*argv0*", sc->vptr->mk_string (sc, argv0));
    1291         254 :   for (i = argc - 1; i >= 0; i--)
    1292             :     {
    1293         125 :       pointer value = sc->vptr->mk_string (sc, argv[i]);
    1294         125 :       args = (sc->vptr->cons) (sc, value, args);
    1295             :     }
    1296         129 :   ffi_define (sc, "*args*", args);
    1297             : 
    1298             : #if _WIN32
    1299             :   ffi_define (sc, "*pathsep*", sc->vptr->mk_character (sc, ';'));
    1300             : #else
    1301         129 :   ffi_define (sc, "*pathsep*", sc->vptr->mk_character (sc, ':'));
    1302             : #endif
    1303             : 
    1304         129 :   ffi_define (sc, "*stdin*",
    1305             :               sc->vptr->mk_port_from_file (sc, stdin, port_input));
    1306         129 :   ffi_define (sc, "*stdout*",
    1307             :               sc->vptr->mk_port_from_file (sc, stdout, port_output));
    1308         129 :   ffi_define (sc, "*stderr*",
    1309             :               sc->vptr->mk_port_from_file (sc, stderr, port_output));
    1310             : 
    1311         129 :   return 0;
    1312             : }

Generated by: LCOV version 1.11