gpgscm: Add more file handling functions.

* tests/gpgscm/ffi.c (do_glob): New function.
(ffi_init): Define new function.
* tests/gpgscm/tests.scm (basename-suffix): New function.x

Signed-off-by: Justus Winter <justus@g10code.com>

tests/gpgscm/ffi.c

@@ -25,6 +25,7 @@
 #include <dirent.h>
 #include <errno.h>
 #include <fcntl.h>
+#include <glob.h>
 #include <gpg-error.h>
 #include <stdarg.h>
 #include <stdlib.h>
@@ -1005,6 +1006,42 @@ do_string_contains (scheme *sc, pointer args)
   FFI_RETURN_POINTER (sc, strstr (haystack, needle) ? sc->T : sc->F);
 }
 
+static pointer
+do_glob (scheme *sc, pointer args)
+{
+  FFI_PROLOG ();
+  pointer result = sc->NIL;
+  size_t i;
+  char *pattern;
+  glob_t pglob;
+  FFI_ARG_OR_RETURN (sc, char *, pattern, string, args);
+  FFI_ARGS_DONE_OR_RETURN (sc, args);
+
+  switch (glob (pattern, 0, NULL, &pglob))
+    {
+    case 0:
+      for (i = 0; i < pglob.gl_pathc; i++)
+        result =
+          (sc->vptr->cons) (sc,
+                            sc->vptr->mk_string (sc, pglob.gl_pathv[i]),
+                            result);
+      globfree (&pglob);
+      break;
+
+    case GLOB_NOMATCH:
+      /* Return the empty list.  */
+      break;
+
+    case GLOB_NOSPACE:
+      return ffi_sprintf (sc, "out of memory");
+    case GLOB_ABORTED:
+      return ffi_sprintf (sc, "read error");
+    default:
+      assert (! "not reached");
+    }
+  FFI_RETURN_POINTER (sc, result);
+}
+
 
 gpg_error_t
 ffi_list2argv (scheme *sc, pointer list, char ***argv, size_t *len)
@@ -1203,6 +1240,7 @@ ffi_init (scheme *sc, const char *argv0, int argc, const char **argv)
   ffi_define_function (sc, string_index);
   ffi_define_function (sc, string_rindex);
   ffi_define_function_name (sc, "string-contains?", string_contains);
+  ffi_define_function (sc, glob);
 
   /* User interface.  */
   ffi_define_function (sc, flush_stdio);

tests/gpgscm/tests.scm

@@ -185,6 +185,12 @@
 	path
 	(basename (substring path (+ 1 i) (string-length path))))))
 
+(define (basename-suffix path suffix)
+  (basename
+   (if (string-suffix? path suffix)
+       (substring path 0 (- (string-length path) (string-length suffix)))
+       path)))
+
 ;; Helper for (pipe).
 (define :read-end car)
 (define :write-end cadr)