[git] GnuPG - branch, justus/scm-2, created. gnupg-2.1.10-124-gb4ac83f
by Justus Winter
cvs at cvs.gnupg.org
Thu Jan 14 18:37:13 CET 2016
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "The GNU Privacy Guard".
The branch, justus/scm-2 has been created
at b4ac83f6f3352194d54938d5b48c02a7ef97d289 (commit)
- Log -----------------------------------------------------------------
commit b4ac83f6f3352194d54938d5b48c02a7ef97d289
Author: Justus Winter <justus at g10code.com>
Date: Thu Jan 7 17:01:45 2016 +0100
tests/openpgp: Reimplement tests in Scheme.
* tests/openpgp/Makefile.am (required_pgms): Add gpgscm.
(TESTS_ENVIRONMENT): Make sure gpgscm and the libraries are found.
(TESTS): Replace tests with the new Scheme implementations.
* tests/openpgp/4gb-packet.scm: New file.
* tests/openpgp/clearsig.scm: Likewise.
* tests/openpgp/decrypt.scm: Likewise.
* tests/openpgp/defs.scm: Likewise.
* tests/openpgp/encrypt.scm: Likewise.
* tests/openpgp/encryptp.scm: Likewise.
* tests/openpgp/mds.scm: Likewise.
* tests/openpgp/seat.scm: Likewise.
* tests/openpgp/sigs.scm: Likewise.
* tests/openpgp/version.scm: Likewise.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/openpgp/4gb-packet.scm b/tests/openpgp/4gb-packet.scm
new file mode 100755
index 0000000..09a171e
--- /dev/null
+++ b/tests/openpgp/4gb-packet.scm
@@ -0,0 +1,10 @@
+#!/usr/bin/env gpgscm
+
+;; GnuPG through 2.1.7 would incorrect mark packets whose size is
+;; 2^32-1 as invalid and exit with status code 2.
+
+(load (in-srcdir "defs.scm"))
+
+(if (= 0 (call `(,GPG --list-packets ,(in-srcdir "4gb-packet.asc"))))
+ (info "Can parse 4GB packets.")
+ (error "Failed to parse 4GB packet."))
diff --git a/tests/openpgp/Makefile.am b/tests/openpgp/Makefile.am
index bab724b..433cfde 100644
--- a/tests/openpgp/Makefile.am
+++ b/tests/openpgp/Makefile.am
@@ -22,9 +22,11 @@
# Programs required before we can run these tests.
required_pgms = ../../g10/gpg2$(EXEEXT) ../../agent/gpg-agent$(EXEEXT) \
../../tools/gpg-connect-agent$(EXEEXT) \
- ../../tools/mk-tdata$(EXEEXT)
+ ../../tools/mk-tdata$(EXEEXT) \
+ ../gpgscm/gpgscm$(EXEEXT)
-TESTS_ENVIRONMENT = GNUPGHOME=$(abs_builddir) GPG_AGENT_INFO= LC_ALL=C
+TESTS_ENVIRONMENT = GNUPGHOME=$(abs_builddir) GPG_AGENT_INFO= LC_ALL=C \
+ PATH=../gpgscm:$(PATH) GPGSCM_BASE=$(top_srcdir)/tests/gpgscm
if SQLITE3
sqlite3_dependent_tests = tofu.test
@@ -34,18 +36,23 @@ endif
# Note: version.test needs to be the first test to run and finish.test
# the last one
-TESTS = version.test mds.test \
- decrypt.test decrypt-dsa.test \
- sigs.test sigs-dsa.test \
- encrypt.test encrypt-dsa.test \
- seat.test clearsig.test encryptp.test detach.test \
+TESTS = version.test \
+ version.scm \
+ mds.scm \
+ decrypt.scm \
+ sigs.scm \
+ encrypt.scm \
+ seat.scm \
+ clearsig.scm \
+ encryptp.scm \
+ detach.test \
armsigs.test armencrypt.test armencryptp.test \
signencrypt.test signencrypt-dsa.test \
armsignencrypt.test armdetach.test \
armdetachm.test detachm.test genkey1024.test \
conventional.test conventional-mdc.test \
multisig.test verify.test armor.test \
- import.test ecc.test 4gb-packet.test \
+ import.test ecc.test 4gb-packet.scm \
$(sqlite3_dependent_tests) \
gpgtar.test use-exact-key.test default-key.test \
finish.test
diff --git a/tests/openpgp/clearsig.scm b/tests/openpgp/clearsig.scm
new file mode 100755
index 0000000..1b4744f
--- /dev/null
+++ b/tests/openpgp/clearsig.scm
@@ -0,0 +1,90 @@
+#!/usr/bin/env gpgscm
+
+(load (in-srcdir "defs.scm"))
+
+(define (check-signing args input)
+ (lambda (source sink)
+ (lettmp (signed)
+ (call-popen `(,GPG --output ,signed --yes
+ , at args ,source) input)
+ (call-popen `(,GPG --output ,sink --yes ,signed) ""))))
+
+(for-each-p
+ "Test signing and verifying plain text messages"
+ (lambda (source)
+ ((if (equal? "plain-3" source)
+ ;; plain-3 does not end in a newline, and gpg will add one.
+ ;; Therefore, we merely check that the verification is ok.
+ check-execution
+ ;; Otherwise, we do check that we recover the original file.
+ check-identity)
+ source
+ (check-signing '(--passphrase-fd "0" --clearsign) usrpass1)))
+ (append plain-files '("plain-large")))
+
+;; The test vectors are lists of length three, containing
+;; - a string to be signed,
+;; - a flag indicating whether we verify that the exact message is
+;; reconstructed (whitespace at the end is normalized for plain text
+;; messages),
+;; - and a list of arguments to add to gpg when encoding
+;; the string.
+
+(define :string car)
+(define :check-equality cadr)
+(define :options caddr)
+
+(define
+ vectors
+ '(;; one with long lines
+ ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyx
+
+xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+" #t ())
+
+ ;; one with only one long line
+ ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyx
+" #t ())
+
+ ;; and one with an empty body
+ ("" #f ())
+
+ ;; and one with one empty line at the end
+ ("line 1
+line 2
+line 3
+there is a blank line after this
+
+" #t ())
+
+ ;; I think this file will be constructed wrong (gpg 0.9.3) but it
+ ;; should verify okay anyway.
+ ("this is a sig test
+ " #f ())
+
+ ;; check our special diff mode
+ ("--- mainproc.c Tue Jun 27 09:28:11 2000
++++ mainproc.c~ Thu Jun 8 22:50:25 2000
+@@ -1190,16 +1190,13 @@
+ md_enable( c->mfx.md, n1->pkt->pkt.signature->digest_algo);
+ }
+ /* ask for file and hash it */
+- if( c->sigs_only ) {
++ if( c->sigs_only )
+ rc = hash_datafiles( c->mfx.md, NULL,
+ c->signed_data, c->sigfilename,
+ n1? (n1->pkt->pkt.onepass_sig->sig_class == 0x01):0 );
+" #t (--not-dash-escaped))))
+
+(define counter (make-counter))
+(for-each-p'
+ "Test signing and verifying test vectors"
+ (lambda (vec)
+ (lettmp (tmp)
+ (with-output-to-file tmp (lambda () (display (:string vec))))
+ ((if (:check-equality vec) check-identity check-execution)
+ tmp
+ (check-signing `(--passphrase-fd "0" --clearsign ,@(:options vec))
+ usrpass1))))
+ (lambda (vec) (number->string (counter)))
+ vectors)
diff --git a/tests/openpgp/decrypt.scm b/tests/openpgp/decrypt.scm
new file mode 100755
index 0000000..8312f49
--- /dev/null
+++ b/tests/openpgp/decrypt.scm
@@ -0,0 +1,21 @@
+#!/usr/bin/env gpgscm
+
+(load (in-srcdir "defs.scm"))
+
+(define (decrypt source sink)
+ (call-popen `(,GPG --output ,sink --yes ,source) ""))
+
+(define (check-file plain-name cipher-name)
+ (lettmp (decrypted-name)
+ (decrypt cipher-name decrypted-name)
+ (if (not (file=? plain-name decrypted-name))
+ (error "mismatch"))))
+
+(for-each-p "Checking decryption of supplied files"
+ (lambda (f) (check-file
+ f (in-srcdir (string-append f ".asc"))))
+ plain-files)
+(for-each-p "Checking decryption of supplied DSA encrypted file"
+ (lambda (f) (check-file
+ f (in-srcdir (string-append f "-pgp.asc"))))
+ (list (car plain-files)))
diff --git a/tests/openpgp/defs.scm b/tests/openpgp/defs.scm
new file mode 100644
index 0000000..1972f92
--- /dev/null
+++ b/tests/openpgp/defs.scm
@@ -0,0 +1,60 @@
+;; Common definitions for the OpenPGP test scripts.
+;;
+;; 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/>.
+
+;;
+;; Constants.
+;;
+
+(define usrname1 "one at example.com")
+(define usrpass1 "def")
+(define usrname2 "two at example.com")
+(define usrpass2 "")
+(define usrname3 "three at example.com")
+(define usrpass3 "")
+
+(define dsa-usrname1 "pgp5")
+;; we use the sub key because we do not yet have the logic to to derive
+;; the first encryption key from a keyblock (I guess) (Well of course
+;; we have this by now and the notation below will lookup the primary
+;; first and then search for the encryption subkey.)
+(define dsa-usrname2 "0xCB879DE9")
+
+(define plain-files '("plain-1" "plain-2" "plain-3"))
+(define data-files '("data-500" "data-9000" "data-32000" "data-80000"))
+(define exp-files '())
+
+(define GPG "../../g10/gpg2")
+
+(define (get-config what)
+ (let* ((config-string
+ (call-popen `(,GPG --with-colons --list-config ,what) ""))
+ (config (string-splitn
+ (filter-whitespace config-string) #\: 2)))
+ (string-split (caddr config) #\;)))
+
+(define all-pubkey-algos (get-config "pubkeyname"))
+(define all-hash-algos (get-config "digestname"))
+(define all-cipher-algos (get-config "ciphername"))
+
+(define (have-pubkey-algo? x)
+ (not (null? (memq x all-pubkey-algos))))
+(define (have-hash-algo? x)
+ (not (null? (memq x all-hash-algos))))
+(define (have-cipher-algo? x)
+ (not (null? (memq x all-cipher-algos))))
diff --git a/tests/openpgp/encrypt.scm b/tests/openpgp/encrypt.scm
new file mode 100755
index 0000000..016110f
--- /dev/null
+++ b/tests/openpgp/encrypt.scm
@@ -0,0 +1,49 @@
+#!/usr/bin/env gpgscm
+
+(load (in-srcdir "defs.scm"))
+
+(define (check-encrypt-decrypt args input)
+ (lambda (source sink)
+ (lettmp (encrypted)
+ (call-popen `(,GPG --output ,encrypted --yes --encrypt
+ --always-trust ;; XXX
+ , at args ,source) input)
+ (call-popen `(,GPG --output ,sink --yes ,encrypted) ""))))
+
+(for-each-p
+ "Test encryption"
+ (lambda (source)
+ (check-identity source (check-encrypt-decrypt
+ `(--recipient ,usrname2) "")))
+ (append plain-files data-files))
+
+(for-each-p
+ "Test encryption using a specific cipher algorithm"
+ (lambda (cipher)
+ (for-each-p
+ ""
+ (lambda (source)
+ (check-identity source
+ (check-encrypt-decrypt
+ `(--recipient ,usrname2 --cipher-algo ,cipher) "")))
+ (append plain-files data-files)))
+ all-cipher-algos)
+
+(for-each-p
+ "Test encryption using DSA"
+ (lambda (source)
+ (check-identity source (check-encrypt-decrypt
+ `(--recipient ,dsa-usrname2) "")))
+ (append plain-files data-files))
+
+(for-each-p
+ "Test encryption using DSA and a specific cipher algorithm"
+ (lambda (cipher)
+ (for-each-p
+ ""
+ (lambda (source)
+ (check-identity source
+ (check-encrypt-decrypt
+ `(--recipient ,dsa-usrname2 --cipher-algo ,cipher) "")))
+ (append plain-files data-files)))
+ all-cipher-algos)
diff --git a/tests/openpgp/encryptp.scm b/tests/openpgp/encryptp.scm
new file mode 100755
index 0000000..b6fcaf3
--- /dev/null
+++ b/tests/openpgp/encryptp.scm
@@ -0,0 +1,28 @@
+#!/usr/bin/env gpgscm
+
+(load (in-srcdir "defs.scm"))
+
+(define :read-end car)
+(define :write-end cadr)
+
+(define (gpg-pipe args errfd)
+ (lambda (source sink)
+ (let* ((p (pipe))
+ (task0 (spawn-process-fd
+ `(,GPG --output - --yes , at args ,source)
+ -1 (:write-end p) errfd))
+ (task1 (spawn-process-fd
+ `(,GPG --output ,sink --yes -)
+ (:read-end p) -1 errfd)))
+ (close (:read-end p))
+ (close (:write-end p))
+ (wait-processes (list GPG GPG) (list task0 task1) 1))))
+
+(for-each-p
+ "Test encryption and decryption using pipes"
+ (lambda (source)
+ (check-identity source
+ (gpg-pipe `(--always-trust --encrypt
+ --recipient ,usrname2)
+ (if *verbose* STDERR_FILENO -1))))
+ (append plain-files data-files))
diff --git a/tests/openpgp/mds.scm b/tests/openpgp/mds.scm
new file mode 100755
index 0000000..98f05e6
--- /dev/null
+++ b/tests/openpgp/mds.scm
@@ -0,0 +1,60 @@
+#!/usr/bin/env gpgscm
+
+(load (in-srcdir "defs.scm"))
+
+(define empty-string-hashes
+ `((1 "D41D8CD98F00B204E9800998ECF8427E" "MD5")
+ (2 "DA39A3EE5E6B4B0D3255BFEF95601890AFD80709" "SHA1")
+ (3 "9C1185A5C5E9FC54612808977EE8F548B2258D31" "RIPEMD160")
+ (11 "D14A028C2A3A2BC9476102BB288234C415A2B01F828EA62AC5B3E42F" "SHA224")
+ (8 "E3B0C44298FC1C149AFBF4C8996FB92427AE41E4649B934CA495991B7852B855" "SHA256")
+ (9 "38B060A751AC96384CD9327EB1B1E36A21FDB71114BE07434C0CC7BF63F6E1DA274EDEBFE76F65FBD51AD2F14898B95B" "SHA384")
+ (10
+ "CF83E1357EEFB8BDF1542850D66D8007D620E4050B5715DC83F4A921D36CE9CE47D0D13C5D85F2B0FF8318D2877EEC2F63B931BD47417A81A538327AF927DA3E"
+ "SHA512")))
+
+(define abc-hashes
+ `((1 "C3FCD3D76192E4007DFB496CCA67E13B" "MD5")
+ (2 "32D10C7B8CF96570CA04CE37F2A19D84240D3A89" "SHA1")
+ (3 "F71C27109C692C1B56BBDCEB5B9D2865B3708DBC" "RIPEMD160")
+ (11 "45A5F72C39C5CFF2522EB3429799E49E5F44B356EF926BCF390DCCC2" "SHA224")
+ (8 "71C480DF93D6AE2F1EFAD1447C66C9525E316218CF51FC8D9ED832F2DAF18B73" "SHA256")
+ (9 "FEB67349DF3DB6F5924815D6C3DC133F091809213731FE5C7B5F4999E463479FF2877F5F2936FA63BB43784B12F3EBB4" "SHA384")
+ (10 "4DBFF86CC2CA1BAE1E16468A05CB9881C97F1753BCE3619034898FAA1AABE429955A1BF8EC483D7421FE3C1646613A59ED5441FB0F321389F77F48A879C7B1F1" "SHA512")))
+
+;; Symbolic names for the triples above.
+(define :algo car)
+(define :value cadr)
+(define :name caddr)
+
+;; Call GPG to obtain the hash sums for the given string S.
+(define (gpg-hash-string s)
+ (map
+ (lambda (line)
+ (let ((p (string-split line #\:)))
+ (list (string->number (cadr p)) (caddr p))))
+ (string-split
+ (call-popen `(,GPG --with-colons --print-mds) s) #\newline)))
+
+;; Test whether HASH matches REF.
+(define (test-hash hash ref)
+ (unless (eq? #f ref)
+ (if (not (string=? (:value hash) (:value ref)))
+ (error "failed"))))
+
+;; Test whether the hashes computed over S match the REFERENCE set.
+(define (test-hashes msg s reference)
+ (for-each-p'
+ msg
+ (lambda (hash) (test-hash hash (assv (:algo hash) reference)))
+ (lambda (hash)
+ (let ((ref (assv (:algo hash) reference)))
+ (if (eq? #f ref)
+ (string-append "no-ref-for:" (number->string (:algo hash)))
+ (:name ref))))
+ (gpg-hash-string s)))
+
+(test-hashes "Hashing the empty string"
+ "" empty-string-hashes)
+(test-hashes "Hashing the string \"abcdefghijklmnopqrstuvwxyz\""
+ "abcdefghijklmnopqrstuvwxyz" abc-hashes)
diff --git a/tests/openpgp/seat.scm b/tests/openpgp/seat.scm
new file mode 100755
index 0000000..e95ede8
--- /dev/null
+++ b/tests/openpgp/seat.scm
@@ -0,0 +1,19 @@
+#!/usr/bin/env gpgscm
+
+(load (in-srcdir "defs.scm"))
+
+(define (check-seat args input)
+ (lambda (source sink)
+ (lettmp (encrypted)
+ (call-popen `(,GPG --output ,encrypted --yes -seat
+ --always-trust ;; XXX
+ , at args ,source) input)
+ (call-popen `(,GPG --output ,sink --yes ,encrypted) ""))))
+
+(for-each-p
+ "Test encryption, signing, and producing armored output"
+ (lambda (source)
+ (check-identity source
+ (check-seat '(-r two at example.com --passphrase-fd "0")
+ usrpass1)))
+ plain-files)
diff --git a/tests/openpgp/sigs.scm b/tests/openpgp/sigs.scm
new file mode 100755
index 0000000..9eb5704
--- /dev/null
+++ b/tests/openpgp/sigs.scm
@@ -0,0 +1,48 @@
+#!/usr/bin/env gpgscm
+
+(load (in-srcdir "defs.scm"))
+
+(define (check-signature args input)
+ (lambda (source sink)
+ (lettmp (signed)
+ (call-popen `(,GPG --output ,signed --yes --sign
+ , at args ,source) input)
+ (call-popen `(,GPG --output ,sink --yes ,signed) ""))))
+
+(for-each-p
+ "Test signing with the default hash algorithm"
+ (lambda (source) (check-identity source (check-signature '() "")))
+ (append plain-files data-files))
+
+(for-each-p
+ "Test signing with a specific hash algorithm"
+ (lambda (hash)
+ (if (have-pubkey-algo? "RSA")
+ ;; RSA key, so any hash is okay.
+ (check-identity (car plain-files)
+ (check-signature
+ `(--user ,usrname3 --digest-algo ,hash) "")))
+ (if (not (equal? "MD5" hash))
+ ;; Using the DSA sig key - only 160 bit or larger hashes
+ (check-identity (car plain-files)
+ (check-signature
+ `(--passphrase-fd "0" --digest-algo ,hash) usrpass1))))
+ all-hash-algos)
+
+(for-each-p
+ "Test signing using DSA with the default hash algorithm"
+ (lambda (source)
+ (check-identity source
+ (check-signature `(--user ,dsa-usrname1) "")))
+ (append plain-files data-files))
+
+(define algos (if (have-hash-algo? "RIPEMD160")
+ '("SHA1" "RIPEMD160")
+ '("SHA1")))
+(for-each-p
+ "Test signing using DSA with a specific hash algorithm"
+ (lambda (hash)
+ (check-identity (car plain-files)
+ (check-signature
+ `(--user ,dsa-usrname1 --digest-algo ,hash) "")))
+ algos)
diff --git a/tests/openpgp/version.scm b/tests/openpgp/version.scm
new file mode 100755
index 0000000..794d88d
--- /dev/null
+++ b/tests/openpgp/version.scm
@@ -0,0 +1,8 @@
+#!/usr/bin/env gpgscm
+
+(load (in-srcdir "defs.scm"))
+
+(info "Printing the GPG version")
+(assert (= 0 (call `(,GPG --version))))
+
+;; fixme: check that the output is as expected
commit abb8b14f512c5b79e47ac5b78e0279d332049301
Author: Justus Winter <justus at g10code.com>
Date: Wed Jan 6 11:55:25 2016 +0100
tests/gpgscm: XXX
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/configure.ac b/configure.ac
index 266eae5..56a5875 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1836,6 +1836,7 @@ tools/gpg-zip
tools/Makefile
doc/Makefile
tests/Makefile
+tests/gpgscm/Makefile
tests/openpgp/Makefile
tests/pkits/Makefile
g10/gpg.w32-manifest
diff --git a/tests/Makefile.am b/tests/Makefile.am
index 307d829..e49c283 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -25,7 +25,7 @@ else
openpgp =
endif
-SUBDIRS = ${openpgp} . pkits
+SUBDIRS = gpgscm ${openpgp} . pkits
GPGSM = ../sm/gpgsm
diff --git a/tests/gpgscm/Makefile.am b/tests/gpgscm/Makefile.am
new file mode 100644
index 0000000..c02da3b
--- /dev/null
+++ b/tests/gpgscm/Makefile.am
@@ -0,0 +1,44 @@
+# 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/>.
+
+EXTRA_DIST = \
+ COPYING \
+ init.scm
+
+AM_CPPFLAGS = -I$(top_srcdir)/common
+include $(top_srcdir)/am/cmacros.am
+
+AM_CFLAGS =
+
+bin_PROGRAMS = gpgscm
+
+common_libs = ../$(libcommon)
+commonpth_libs = ../$(libcommonpth)
+
+gpgscm_CFLAGS = -imacros scheme-config.h \
+ $(LIBGCRYPT_CFLAGS) $(LIBASSUAN_CFLAGS) $(GPG_ERROR_CFLAGS)
+gpgscm_SOURCES = main.c scheme-config.h ffi.c ffi.h ffi-private.h \
+ opdefines.h scheme.c scheme.h scheme-private.h
+gpgscm_LDADD = $(LDADD) $(common_libs) \
+ $(NETLIBS) $(LIBICONV) $(LIBREADLINE) \
+ $(LIBGCRYPT_LIBS) $(GPG_ERROR_LIBS)
+
+# Make sure that all libs are build before we use them. This is
+# important for things like make -j2.
+$(PROGRAMS): $(common_libs)
diff --git a/tests/gpgscm/ffi-private.h b/tests/gpgscm/ffi-private.h
new file mode 100644
index 0000000..dd6f0cc
--- /dev/null
+++ b/tests/gpgscm/ffi-private.h
@@ -0,0 +1,128 @@
+/* FFI interface for TinySCHEME.
+ *
+ * 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/>.
+ */
+
+#ifndef _GPGSCM_FFI_PRIVATE_H
+#define _GPGSCM_FFI_PRIVATE_H
+
+#include "scheme.h"
+#include "scheme-private.h"
+
+#define SC_FFI_PROLOG() \
+ unsigned int __ffi_arg_index __attribute__ ((unused)) = 1; \
+ int err __attribute__ ((unused)) = 0 \
+
+#define CONVERSION_pointer(SC, X) (void *) ivalue
+#define CONVERSION_number(SC, X) ivalue
+#define CONVERSION_string(SC, X) string_value
+#define CONVERSION_list(SC, X)
+#define CONVERSION_path(SC, X) ((SC)->vptr->is_string (X) \
+ ? (SC)->vptr->string_value \
+ : (SC)->vptr->symname)
+
+#define IS_A_pointer(SC, X) (SC)->vptr->is_number (X)
+#define IS_A_number(SC, X) (SC)->vptr->is_number (X)
+#define IS_A_string(SC, X) (SC)->vptr->is_string (X)
+#define IS_A_list(SC, X) (SC)->vptr->is_list (SC, X)
+#define IS_A_path(SC, X) ((SC)->vptr->is_string (X) \
+ || (SC)->vptr->is_symbol (X))
+
+#define SC_ARG(SC, CTYPE, TARGET, WANT, ARGS) \
+ ({ \
+ if ((ARGS) == (SC)->NIL) \
+ return (SC)->vptr->mk_string ((SC), \
+ "too few arguments: want " \
+ #TARGET "("#WANT"/"#CTYPE")\n"); \
+ if (! IS_A_##WANT ((SC), pair_car (ARGS))) { \
+ char __ffi_error_message[256]; \
+ snprintf (__ffi_error_message, sizeof __ffi_error_message, \
+ "argument %d must be: " #WANT "\n", __ffi_arg_index); \
+ return (SC)->vptr->mk_string ((SC), __ffi_error_message); \
+ } \
+ TARGET = CONVERSION_##WANT (SC, pair_car (ARGS)) (pair_car (ARGS)); \
+ ARGS = pair_cdr (ARGS); \
+ __ffi_arg_index += 1; \
+ })
+
+#define SC_ARGS_DONE(SC, ARGS) \
+ ({ \
+ if ((ARGS) != (SC)->NIL) \
+ return (SC)->vptr->mk_string ((SC), "too many arguments"); \
+ })
+
+#define SC_RETURN_ERR(SC, ERR) \
+ return _cons ((SC), mk_integer ((SC), (ERR)), (SC)->NIL, 1)
+
+#define SC_RETURN(SC) SC_RETURN_ERR (SC, err)
+
+#define SC_RETURN_POINTER(SC, X) \
+ return _cons ((SC), mk_integer ((SC), err), \
+ _cons ((SC), (X), (SC)->NIL, 1), 1)
+#define SC_RETURN_INT(SC, X) \
+ SC_RETURN_POINTER ((SC), mk_integer ((SC), (X)))
+#define SC_RETURN_STRING(SC, X) \
+ SC_RETURN_POINTER ((SC), mk_string ((SC), (X)))
+
+const char *schemify_name (const char *s, int macro);
+
+void ffi_scheme_eval (scheme *sc, const char *format, ...)
+ __attribute__ ((format (printf, 2, 3)));
+
+#define define_function(S, F) \
+ define_function_name ((S), schemify_name (#F, 0), F)
+
+#define define_function_name(S, NAME, F) \
+ ({ \
+ scheme_define ((S), \
+ (S)->global_env, \
+ mk_symbol ((S), schemify_name ("_" #F, 0)), \
+ mk_foreign_func ((S), (do_##F))); \
+ ffi_scheme_eval ((S), \
+ "(define (%s . a) (ffi-apply \"%s\" %s a))", \
+ (NAME), (NAME), schemify_name ("_" #F, 0)); \
+ })
+
+#define define_constant(S, C) \
+ scheme_define ((S), \
+ (S)->global_env, \
+ mk_symbol ((S), schemify_name (#C, 1)), \
+ mk_integer ((S), (C)))
+
+#define define_(S, SYM, EXP) \
+ scheme_define ((S), (S)->global_env, mk_symbol ((S), (SYM)), EXP)
+
+#define define_variable(S, C) \
+ scheme_define ((S), \
+ (S)->global_env, \
+ mk_symbol ((S), schemify_name (#C, 0)), \
+ mk_integer ((S), (C)))
+
+#define define_variable_pointer(S, C, P) \
+ scheme_define ((S), \
+ (S)->global_env, \
+ mk_symbol ((S), schemify_name (#C, 0)), \
+ (P))
+
+#define define_variable_string(S, C) \
+ define_variable_pointer (S, C, (S)->vptr->mk_string (S, C ?: ""))
+
+void ffi_list2argv (scheme *sc, pointer list, char ***argv);
+gpg_error_t ffi_list2intv (scheme *sc, pointer list, int **intv, size_t *len);
+
+#endif /* _GPGSCM_FFI_PRIVATE_H */
diff --git a/tests/gpgscm/ffi.c b/tests/gpgscm/ffi.c
new file mode 100644
index 0000000..acd45be
--- /dev/null
+++ b/tests/gpgscm/ffi.c
@@ -0,0 +1,691 @@
+/* FFI interface for TinySCHEME.
+ *
+ * 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 <fcntl.h>
+#include <gpg-error.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+
+#if HAVE_LIBREADLINE
+#include <readline/readline.h>
+#include <readline/history.h>
+#endif
+
+#include "../../common/exechelp.h"
+
+#include "private.h"
+#include "ffi.h"
+#include "ffi-private.h"
+
+static pointer
+do_logand (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ unsigned int v, acc = ~0;
+ while (args != sc->NIL)
+ {
+ SC_ARG (sc, unsigned int, v, number, args);
+ acc &= v;
+ }
+ SC_RETURN_INT (sc, acc);
+}
+
+static pointer
+do_logior (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ unsigned int v, acc = 0;
+ while (args != sc->NIL)
+ {
+ SC_ARG (sc, unsigned int, v, number, args);
+ acc |= v;
+ }
+ SC_RETURN_INT (sc, acc);
+}
+
+static pointer
+do_logxor (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ unsigned int v, acc = 0;
+ while (args != sc->NIL)
+ {
+ SC_ARG (sc, unsigned int, v, number, args);
+ acc ^= v;
+ }
+ SC_RETURN_INT (sc, acc);
+}
+
+static pointer
+do_lognot (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ unsigned int v;
+ SC_ARG (sc, unsigned int, v, number, args);
+ SC_ARGS_DONE (sc, args);
+ SC_RETURN_INT (sc, ~v);
+}
+
+/* User interface. */
+
+int use_libreadline;
+
+/* Read a string, and return a pointer to it. Returns NULL on EOF. */
+char *
+rl_gets (const char *prompt)
+{
+ static char *line = NULL;
+ char *p;
+ free (line);
+
+#if HAVE_LIBREADLINE
+ if (use_libreadline)
+ {
+ line = readline (prompt);
+ if (line && *line)
+ add_history (line);
+ }
+ else
+#endif
+ {
+ size_t max_size = 0xff;
+ printf ("%s", prompt);
+ fflush (stdout);
+ line = malloc (max_size);
+ if (line != NULL)
+ fgets (line, max_size, stdin);
+ }
+
+ /* Strip trailing whitespace. */
+ if (line && strlen (line) > 0)
+ for (p = &line[strlen (line) - 1]; isspace (*p); p--)
+ *p = 0;
+
+ return line;
+}
+
+static pointer
+do_enable_readline (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ SC_ARGS_DONE (sc, args);
+ use_libreadline = 1;
+ SC_RETURN (sc);
+}
+
+static pointer
+do_prompt (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ const char *prompt;
+ const char *line;
+ SC_ARG (sc, const char *, prompt, string, args);
+ SC_ARGS_DONE (sc, args);
+ line = rl_gets (prompt);
+ ffi_update (sc);
+ if (! line)
+ SC_RETURN_POINTER (sc, sc->EOF_OBJ);
+
+ SC_RETURN_STRING (sc, line);
+}
+
+static pointer
+do_sleep (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ unsigned int seconds;
+ SC_ARG (sc, unsigned int, seconds, number, args);
+ SC_ARGS_DONE (sc, args);
+ sleep (seconds);
+ ffi_update (sc);
+ SC_RETURN (sc);
+}
+
+static pointer
+do_usleep (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ useconds_t microseconds;
+ SC_ARG (sc, useconds_t, microseconds, number, args);
+ SC_ARGS_DONE (sc, args);
+ usleep (microseconds);
+ ffi_update (sc);
+ SC_RETURN (sc);
+}
+
+static pointer
+do_chdir (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ char *name;
+ SC_ARG (sc, char *, name, path, args);
+ SC_ARGS_DONE (sc, args);
+ if (chdir (name))
+ SC_RETURN_ERR (sc, errno);
+ SC_RETURN (sc);
+}
+
+static pointer
+do_strerror (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ int error;
+ SC_ARG (sc, int, error, number, args);
+ SC_ARGS_DONE (sc, args);
+ SC_RETURN_STRING (sc, gpg_strerror (error));
+}
+
+static pointer
+do_getenv (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ char *name;
+ SC_ARG (sc, char *, name, string, args);
+ SC_ARGS_DONE (sc, args);
+ SC_RETURN_STRING (sc, getenv (name) ?: "");
+}
+
+static pointer
+do_exit (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ int retcode;
+ SC_ARG (sc, int, retcode, number, args);
+ SC_ARGS_DONE (sc, args);
+ exit (retcode);
+}
+
+static pointer
+do_close (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ int fd;
+ SC_ARG (sc, int, fd, number, args);
+ SC_ARGS_DONE (sc, args);
+ SC_RETURN_ERR (sc, close (fd) == 0 ? 0 : gpg_error_from_syserror ());
+}
+
+static pointer
+do_mktemp (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ char *template;
+ char buffer[128];
+ SC_ARG (sc, char *, template, string, args);
+ SC_ARGS_DONE (sc, args);
+
+ if (strlen (template) > sizeof buffer - 1)
+ SC_RETURN_ERR (sc, EINVAL);
+ strncpy (buffer, template, sizeof buffer);
+
+ SC_RETURN_STRING (sc, mktemp (buffer));
+}
+
+static pointer
+do_unlink (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ char *name;
+ SC_ARG (sc, char *, name, string, args);
+ SC_ARGS_DONE (sc, args);
+ if (unlink (name) == -1)
+ SC_RETURN_ERR (sc, gpg_error_from_syserror ());
+ SC_RETURN (sc);
+}
+
+/* Process handling. */
+
+static pointer
+do_spawn_process (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ pointer arguments;
+ char **argv;
+ unsigned int flags;
+
+ estream_t infp;
+ estream_t outfp;
+ estream_t errfp;
+ pid_t pid;
+
+ SC_ARG (sc, pointer, arguments, list, args);
+ SC_ARG (sc, unsigned int, flags, number, args);
+ SC_ARGS_DONE (sc, args);
+
+ ffi_list2argv (sc, arguments, &argv);
+ if (argv == NULL)
+ SC_RETURN_ERR (sc, errno);
+
+ err = gnupg_spawn_process (argv[0], (const char **) &argv[1],
+ GPG_ERR_SOURCE_DEFAULT, /* XXX */
+ NULL, /* XXX */
+ flags,
+ &infp, &outfp, &errfp, &pid);
+ free (argv);
+#define IMC(A, B) \
+ _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1)
+ SC_RETURN_POINTER (sc, IMC (infp,
+ IMC (outfp,
+ IMC (errfp,
+ IMC (pid, sc->NIL)))));
+#undef IMC
+}
+
+static pointer
+do_spawn_process_fd (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ pointer arguments;
+ char **argv;
+ int infd, outfd, errfd;
+
+ pid_t pid;
+
+ SC_ARG (sc, pointer, arguments, list, args);
+ SC_ARG (sc, int, infd, number, args);
+ SC_ARG (sc, int, outfd, number, args);
+ SC_ARG (sc, int, errfd, number, args);
+ SC_ARGS_DONE (sc, args);
+
+ ffi_list2argv (sc, arguments, &argv);
+ if (argv == NULL)
+ SC_RETURN_ERR (sc, errno);
+
+ err = gnupg_spawn_process_fd (argv[0], (const char **) &argv[1],
+ infd, outfd, errfd,
+ &pid);
+ free (argv);
+ SC_RETURN_INT (sc, pid);
+}
+
+static pointer
+do_wait_process (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ const char *name;
+ pid_t pid;
+ int hang;
+
+ int retcode;
+
+ SC_ARG (sc, const char *, name, string, args);
+ SC_ARG (sc, pid_t, pid, number, args);
+ SC_ARG (sc, int, hang, number, args);
+ SC_ARGS_DONE (sc, args);
+ err = gnupg_wait_process (name, pid, hang, &retcode);
+ if (err == GPG_ERR_GENERAL)
+ err = 0; /* Let the return code speak for itself. */
+
+ ffi_update (sc);
+ SC_RETURN_INT (sc, retcode);
+}
+
+
+static pointer
+do_wait_processes (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ pointer list_names;
+ char **names;
+ pointer list_pids;
+ size_t count;
+ pid_t *pids;
+ int hang;
+
+ SC_ARG (sc, pointer, list_names, list, args);
+ SC_ARG (sc, pointer, list_pids, list, args);
+ SC_ARG (sc, int, hang, number, args);
+ SC_ARGS_DONE (sc, args);
+
+ if (sc->vptr->list_length (sc, list_names)
+ != sc->vptr->list_length (sc, list_pids))
+ return
+ sc->vptr->mk_string (sc, "length of first two arguments must match");
+
+ ffi_list2argv (sc, list_names, &names);
+ if (names == NULL)
+ SC_RETURN_ERR (sc, gpg_error_from_syserror ());
+
+ err = ffi_list2intv (sc, list_pids, (int **) &pids, &count);
+ if (err)
+ SC_RETURN (sc);
+
+ err = gnupg_wait_processes (names, pids, count, hang, NULL);
+
+ SC_RETURN_INT (sc, 0 /* XXX */);
+}
+
+
+static pointer
+do_pipe (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ int filedes[2];
+ SC_ARGS_DONE (sc, args);
+ err = gnupg_create_pipe (filedes);
+#define IMC(A, B) \
+ _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1)
+ SC_RETURN_POINTER (sc, IMC (filedes[0],
+ IMC (filedes[1], sc->NIL)));
+#undef IMC
+}
+
+
+
+/* estream functions. */
+static pointer
+do_es_fclose (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ estream_t stream;
+ SC_ARG (sc, estream_t, stream, pointer, args);
+ SC_ARGS_DONE (sc, args);
+ SC_RETURN_ERR (sc, es_fclose (stream));
+}
+
+static pointer
+do_es_read (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ estream_t stream;
+ size_t bytes_to_read;
+
+ pointer result;
+ void *buffer;
+ size_t bytes_read;
+
+ SC_ARG (sc, estream_t, stream, pointer, args);
+ SC_ARG (sc, size_t, bytes_to_read, number, args);
+ SC_ARGS_DONE (sc, args);
+
+ buffer = malloc (bytes_to_read);
+ if (buffer == NULL)
+ SC_RETURN_ERR (sc, ENOMEM);
+
+ err = es_read (stream, buffer, bytes_to_read, &bytes_read);
+ if (err)
+ SC_RETURN_ERR (sc, err);
+
+ result = sc->vptr->mk_counted_string (sc, buffer, bytes_read);
+ free (buffer);
+ SC_RETURN_POINTER (sc, result);
+}
+
+static pointer
+do_es_feof (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ estream_t stream;
+ SC_ARG (sc, estream_t, stream, pointer, args);
+ SC_ARGS_DONE (sc, args);
+
+ SC_RETURN_POINTER (sc, es_feof (stream) ? sc->T : sc->F);
+}
+
+static pointer
+do_es_write (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ estream_t stream;
+ const char *buffer;
+ size_t bytes_to_write, bytes_written;
+
+ SC_ARG (sc, estream_t, stream, pointer, args);
+ /* XXX how to get the length of the string buffer? scheme strings
+ may contain \0. */
+ SC_ARG (sc, const char *, buffer, string, args);
+ SC_ARGS_DONE (sc, args);
+
+ bytes_to_write = strlen (buffer);
+ while (bytes_to_write > 0)
+ {
+ err = es_write (stream, buffer, bytes_to_write, &bytes_written);
+ if (err)
+ break;
+ bytes_to_write -= bytes_written;
+ buffer += bytes_written;
+ }
+
+ SC_RETURN (sc);
+}
+
+/* Test helper functions. */
+static pointer
+do_file_equal (scheme *sc, pointer args)
+{
+ SC_FFI_PROLOG ();
+ pointer result = sc->F;
+ char *a_name, *b_name;
+ FILE *a_stream = NULL, *b_stream = NULL;
+ struct stat a_stat, b_stat;
+#define BUFFER_SIZE 1024
+ char a_buf[BUFFER_SIZE], b_buf[BUFFER_SIZE];
+#undef BUFFER_SIZE
+ size_t size, chunk;
+
+ SC_ARG (sc, char *, a_name, string, args);
+ SC_ARG (sc, char *, b_name, string, args);
+ SC_ARGS_DONE (sc, args);
+
+ a_stream = fopen (a_name, "rb");
+ if (a_stream == NULL)
+ goto errout;
+
+ b_stream = fopen (b_name, "rb");
+ if (b_stream == NULL)
+ goto errout;
+
+ if (fstat (fileno (a_stream), &a_stat) < 0)
+ goto errout;
+
+ if (fstat (fileno (b_stream), &b_stat) < 0)
+ goto errout;
+
+ if (a_stat.st_size != b_stat.st_size)
+ goto out;
+
+ for (size = a_stat.st_size; size > 0; size -= chunk)
+ {
+ chunk = size;
+ if (chunk > sizeof a_buf)
+ chunk = sizeof a_buf;
+
+ if (fread (a_buf, 1, chunk, a_stream) < chunk)
+ goto errout;
+ if (fread (b_buf, 1, chunk, b_stream) < chunk)
+ goto errout;
+ if (memcmp (a_buf, b_buf, chunk) != 0)
+ goto out;
+ }
+
+ /* They match. */
+ result = sc->T;
+
+ out:
+ if (a_stream)
+ fclose (a_stream);
+ if (b_stream)
+ fclose (b_stream);
+ SC_RETURN_POINTER (sc, result);
+ errout:
+ err = gpg_error_from_syserror ();
+ goto out;
+}
+
+void
+ffi_list2argv (scheme *sc, pointer list, char ***argv)
+{
+ int i, length;
+
+ length = sc->vptr->list_length (sc, list);
+ *argv = calloc (length + 1, sizeof **argv);
+ if (*argv == NULL)
+ return;
+
+ for (i = 0; sc->vptr->is_pair (list); list = sc->vptr->pair_cdr (list))
+ {
+ if (sc->vptr->is_string (sc->vptr->pair_car (list)))
+ (*argv)[i++] = sc->vptr->string_value (sc->vptr->pair_car (list));
+ else if (sc->vptr->is_symbol (sc->vptr->pair_car (list)))
+ (*argv)[i++] = sc->vptr->symname (sc->vptr->pair_car (list));
+ else
+ continue; /* XXX this just silently drops values */
+ }
+ (*argv)[i] = NULL;
+}
+
+gpg_error_t
+ffi_list2intv (scheme *sc, pointer list, int **intv, size_t *len)
+{
+ int i;
+
+ *len = sc->vptr->list_length (sc, list);
+ *intv = calloc (*len, sizeof *intv);
+ if (*intv == NULL)
+ return gpg_error_from_syserror ();
+
+ for (i = 0; sc->vptr->is_pair (list); list = sc->vptr->pair_cdr (list))
+ {
+ if (sc->vptr->is_number (sc->vptr->pair_car (list)))
+ (*intv)[i++] = sc->vptr->ivalue (sc->vptr->pair_car (list));
+ else
+ return GPG_ERR_INV_ARG;
+ }
+
+ return 0;
+}
+
+
+const char *
+schemify_name (const char *s, int macro)
+{
+ char *n = strdup (s), *p;
+ if (n == NULL)
+ return s;
+ for (p = n; *p; p++)
+ {
+ *p = (char) tolower (*p);
+ /* We convert _ to - in identifiers. We allow, however, for
+ function names to start with a leading _. The functions in
+ this namespace are not yet finalized and might change or
+ vanish without warning. Use them with care. */
+ if (! macro
+ && p != n
+ && *p == '_')
+ *p = '-';
+ }
+ return n;
+}
+
+void
+ffi_scheme_eval (scheme *sc, const char *format, ...)
+{
+ va_list listp;
+ char *expression;
+ int size, written;
+
+ va_start (listp, format);
+ size = vsnprintf (NULL, 0, format, listp);
+ va_end (listp);
+
+ expression = malloc (size + 1);
+ if (expression == NULL)
+ return;
+
+ va_start (listp, format);
+ written = vsnprintf (expression, size + 1, format, listp);
+ va_end (listp);
+
+ assert (size == written);
+
+ sc->vptr->load_string (sc, expression);
+ free (expression);
+}
+
+void
+ffi_init (scheme *sc)
+{
+ /* bitwise arithmetic */
+ define_function (sc, logand);
+ define_function (sc, logior);
+ define_function (sc, logxor);
+ define_function (sc, lognot);
+
+ /* libc. */
+ define_constant (sc, O_RDONLY);
+ define_constant (sc, O_WRONLY);
+ define_constant (sc, O_RDWR);
+ define_constant (sc, O_CREAT);
+ define_constant (sc, STDIN_FILENO);
+ define_constant (sc, STDOUT_FILENO);
+ define_constant (sc, STDERR_FILENO);
+
+ define_function (sc, sleep);
+ define_function (sc, usleep);
+ define_function (sc, chdir);
+ define_function (sc, strerror);
+ define_function (sc, getenv);
+ define_function (sc, exit);
+ define_function (sc, close);
+ define_function (sc, mktemp);
+ define_function (sc, unlink);
+
+ /* Process management. */
+ define_function_name (sc, "spawn-process'", spawn_process);
+ define_function (sc, spawn_process_fd);
+ define_function (sc, wait_process);
+ define_function (sc, wait_processes);
+ define_function (sc, pipe);
+
+ /* estream functions. */
+ define_function_name (sc, "es-fclose", es_fclose);
+ define_function_name (sc, "es-read", es_read);
+ define_function_name (sc, "es-feof", es_feof);
+ define_function_name (sc, "es-write", es_write);
+
+ /* Test helper functions. */
+ define_function_name (sc, "file=?", file_equal);
+
+ /* User interface. */
+ define_function (sc, enable_readline);
+ define_function (sc, prompt);
+
+ /* Configuration. */
+ ffi_scheme_eval (sc, "(define *verbose* %s)", verbose ? "#t" : "#f");
+
+ ffi_update (sc);
+}
+
+void
+ffi_update (scheme *sc)
+{
+ /* XXX it is not clear whether that is even possible to get right. */
+ (void) sc;
+}
diff --git a/tests/gpgscm/ffi.h b/tests/gpgscm/ffi.h
new file mode 100644
index 0000000..49dad5a
--- /dev/null
+++ b/tests/gpgscm/ffi.h
@@ -0,0 +1,29 @@
+/* FFI interface for TinySCHEME.
+ *
+ * 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/>.
+ */
+
+#ifndef _GPGSCM_FFI_H
+#define _GPGSCM_FFI_H
+
+#include "scheme.h"
+
+void ffi_init (scheme *sc);
+void ffi_update (scheme *sc);
+
+#endif /* _GPGSCM_FFI_H */
diff --git a/tests/gpgscm/ffi.scm b/tests/gpgscm/ffi.scm
new file mode 100644
index 0000000..d0b8a99
--- /dev/null
+++ b/tests/gpgscm/ffi.scm
@@ -0,0 +1,40 @@
+;; FFI interface for TinySCHEME.
+;;
+;; 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/>.
+
+;; Foreign function wrapper. Expects F to return a list with the
+;; first element being the `error_t' value returned by the foreign
+;; function. The error is thrown, or the cdr of the result is
+;; returned.
+(define (ffi-apply name f args)
+ (let ((result (apply f args)))
+ (cond
+ ((string? result)
+ (ffi-fail name args result))
+ ((not (= (car result) 0))
+ (ffi-fail name args (strerror (car result))))
+ ((and (= (car result) 0) (pair? (cdr result))) (cadr result))
+ ((= (car result) 0) '())
+ (else
+ (throw (list "Result violates FFI calling convention: " result))))))
+
+(define (ffi-fail name args message)
+ (let ((args' (open-output-string)))
+ (write (cons (string->symbol name) args) args')
+ (throw (string-append
+ (get-output-string args') ": " message))))
diff --git a/tests/gpgscm/lib.scm b/tests/gpgscm/lib.scm
new file mode 100644
index 0000000..d0057f9
--- /dev/null
+++ b/tests/gpgscm/lib.scm
@@ -0,0 +1,96 @@
+;; Additional library functions for TinySCHEME.
+;;
+;; 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/>.
+
+(define (filter pred lst)
+ (cond ((null? lst) '())
+ ((pred (car lst))
+ (cons (car lst) (filter pred (cdr lst))))
+ (else (filter pred (cdr lst)))))
+
+(define (any p l)
+ (cond ((null? l) #f)
+ ((p (car l)) #t)
+ (else (any p (cdr l)))))
+
+;; Is s1 a prefix of s2 ?
+(define (string-prefix? s1 s2)
+ (and (>= (string-length s2) (string-length s1))
+ (string=? s1 (substring s2 0 (string-length s1)))))
+
+;; Given a list of prefixes, does s start with any of them ?
+(define (string-prefix-any? lp s)
+ (any (lambda (p) (string-prefix? p s)) lp))
+
+;; Locate the first occurrence of needle in haystack.
+(define (string-index haystack needle)
+ (define (index i haystack needle)
+ (if (= (length haystack) 0)
+ #f
+ (if (char=? (car haystack) needle)
+ i
+ (index (+ i 1) (cdr haystack) needle))))
+ (index 0 (string->list haystack) needle))
+
+;; Split haystack at delimiter at most n times.
+(define (string-splitn haystack delimiter n)
+ (define (split acc haystack delimiter n)
+ (if (= (string-length haystack) 0)
+ (reverse acc)
+ (let ((i (string-index haystack delimiter)))
+ (if (not (or (eq? i #f) (= 0 n)))
+ (split (cons (substring haystack 0 i) acc)
+ (substring haystack (+ i 1) (string-length haystack))
+ delimiter (- n 1))
+ (split (cons haystack acc) "" delimiter 0)
+ ))))
+ (split '() haystack delimiter n))
+
+;; Split haystack at delimiter.
+(define (string-split haystack delimiter)
+ (string-splitn haystack delimiter -1))
+
+;; Drop whitespace.
+(define (filter-whitespace s)
+ (list->string (filter (lambda (c) (not (char=? #\newline c))) (string->list s))))
+
+(define (echo . msg)
+ (for-each (lambda (x) (display x) (display " ")) msg)
+ (newline))
+
+;; Read a word from port P.
+(define (read-word p)
+ (list->string
+ (let f ()
+ (let ((c (peek-char p)))
+ (cond
+ ((eof-object? c) '())
+ ((char-alphabetic? c)
+ (read-char p)
+ (cons c (f)))
+ (else '()))))))
+
+;; Read everything from port P.
+(define (read-all p)
+ (list->string
+ (let f ()
+ (let ((c (peek-char p)))
+ (cond
+ ((eof-object? c) '())
+ (else (read-char p)
+ (cons c (f))))))))
diff --git a/tests/gpgscm/main.c b/tests/gpgscm/main.c
new file mode 100644
index 0000000..e7cc3e3
--- /dev/null
+++ b/tests/gpgscm/main.c
@@ -0,0 +1,219 @@
+/* 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 <npth.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"
+
+/* 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',
+ oBase = 500,
+ };
+
+/* The list of commands and options. */
+static ARGPARSE_OPTS opts[] =
+ {
+ ARGPARSE_s_n (oVerbose, "verbose", N_("verbose")),
+ ARGPARSE_s_s (oBase, "base", "base directory (containing 'init.scm')"),
+ ARGPARSE_end (),
+ };
+
+const char *basedir = "../tests/gpgscm";
+
+/* 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;
+
+ case oBase:
+ basedir = pargs->r.ret_str;
+ 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 PATH is not NULL, then it is qualified with
+ PATH. */
+void
+load (scheme *sc, const char *path, const char *file_name)
+{
+ char *qualified_name;
+ FILE *h;
+
+ if (path != NULL && file_name[0] != '/')
+ {
+ if (asprintf (&qualified_name, "%s/%s", path, file_name) < 0)
+ {
+ fprintf (stderr, "asprintf: %s\n", strerror (errno));
+ exit (EXIT_FAILURE);
+ }
+ }
+ else
+ qualified_name = (char *) file_name;
+
+ if (verbose)
+ fprintf (stderr, "Loading %s...\n", qualified_name);
+ h = fopen (qualified_name, "r");
+ if (! h)
+ {
+ fprintf (stderr, "Could not read %s: %s.\n"
+ "Consider using --base to specify the location of the "
+ "Scheme library.\n", qualified_name, strerror (errno));
+ exit (EXIT_FAILURE);
+ }
+
+ scheme_load_named_file (sc, h, qualified_name);
+ fclose (h);
+
+ if (file_name != qualified_name)
+ free (qualified_name);
+}
+
+
+
+int
+main (int argc, char **argv)
+{
+ ARGPARSE_ARGS pargs;
+ scheme *sc;
+
+ if (getenv ("GPGSCM_BASE"))
+ basedir = getenv ("GPGSCM_BASE");
+
+ 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);
+
+ load (sc, basedir, "init.scm");
+ load (sc, basedir, "ffi.scm");
+ ffi_init (sc);
+ load (sc, basedir, "lib.scm");
+ load (sc, basedir, "tests.scm");
+
+ if (argc == 0)
+ {
+ /* Interactive shell. */
+ fprintf (stderr, "gpgscm/"ts_banner".\n");
+ scheme_load_named_file (sc, stdin, 0);
+ }
+ else
+ load (sc, NULL, argv[0]);
+
+ scheme_deinit (sc);
+ return EXIT_SUCCESS;
+}
diff --git a/tests/gpgscm/private.h b/tests/gpgscm/private.h
new file mode 100644
index 0000000..efa0cb0
--- /dev/null
+++ b/tests/gpgscm/private.h
@@ -0,0 +1,26 @@
+/* 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/>.
+ */
+
+#ifndef __GPGSCM_PRIVATE_H__
+#define __GPGSCM_PRIVATE_H__
+
+extern int verbose;
+
+#endif /* __GPGSCM_PRIVATE_H__ */
diff --git a/tests/gpgscm/scheme-config.h b/tests/gpgscm/scheme-config.h
new file mode 100644
index 0000000..b2b4db0
--- /dev/null
+++ b/tests/gpgscm/scheme-config.h
@@ -0,0 +1,38 @@
+/* TinyScheme configuration.
+ *
+ * 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/>.
+ */
+
+#define STANDALONE 0
+#define USE_MATH 0
+#define USE_CHAR_CLASSIFIERS 1
+#define USE_ASCII_NAMES 1
+#define USE_STRING_PORTS 1
+#define USE_ERROR_HOOK 1
+#define USE_TRACING 1
+#define USE_COLON_HOOK 0
+#define USE_DL 0
+#define USE_PLIST 0
+#define USE_INTERFACE 1
+#define SHOW_ERROR_LINE 1
+
+#define STRBUFFSIZE 4096
+
+#if __MINGW32__
+# define USE_STRLWR 0
+#endif /* __MINGW32__ */
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
new file mode 100644
index 0000000..439cf87
--- /dev/null
+++ b/tests/gpgscm/tests.scm
@@ -0,0 +1,155 @@
+;; Common definitions for writing tests.
+;;
+;; 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/>.
+
+(define (trace x)
+ (display x)
+ (newline)
+ x)
+
+;; Reporting.
+(define (info msg)
+ (display msg)
+ (newline))
+
+(define (error msg)
+ (display msg)
+ (newline)
+ (exit 1))
+
+(define (skip msg)
+ (display msg)
+ (newline)
+ (exit 77))
+
+(define (make-counter)
+ (let ((c 0))
+ (lambda ()
+ (let ((r c))
+ (set! c (+ 1 c))
+ r))))
+
+(macro (assert form)
+ `(if (not ,(cadr form))
+ (error (list "Assertion failed:" (quote ,(cadr form))))))
+(assert #t)
+
+(define *progress-nesting* 0)
+
+(define (call-with-progress msg what)
+ (set! *progress-nesting* (+ 1 *progress-nesting*))
+ (if (= 1 *progress-nesting*)
+ (begin
+ (display msg)
+ (newline)
+ (display " > ")
+ (what (lambda (item)
+ (display item)
+ (display " ")))
+ (display "< ")
+ (newline))
+ (begin
+ (what (lambda (item) (display ".")))
+ (display " ")))
+ (set! *progress-nesting* (- *progress-nesting* 1)))
+
+(define (for-each-p msg proc lst)
+ (for-each-p' msg proc (lambda (x) x) lst))
+
+(define (for-each-p' msg proc fmt lst)
+ (call-with-progress
+ msg
+ (lambda (progress)
+ (for-each (lambda (a)
+ (progress (fmt a))
+ (proc a))
+ lst))))
+
+;; Process management.
+(define (call what)
+ (wait-process (car what) (spawn-process-fd what -1 -1 2) 1))
+
+;; Accessor functions for the results of
+(define :stdin car)
+(define :stdout cadr)
+(define :stderr caddr)
+(define :pid cadddr)
+
+(define (call-with-io what in)
+ (if *verbose*
+ (echo "Calling" what))
+ (let ((h (spawn-process' what 0)))
+ (es-write (:stdin h) in)
+ (es-fclose (:stdin h))
+ (let ((out (es-read-all (:stdout h)))
+ (err (es-read (:stderr h) 1024)))
+ (es-fclose (:stdout h))
+ (es-fclose (:stderr h))
+ ;; maybe wait earlier??
+ (list (wait-process (car what) (:pid h) 1) out err))))
+
+(define :retcode car)
+
+(define (call-popen command input-string)
+ (let ((result (call-with-io command input-string)))
+ (if (= 0 (:retcode result))
+ (:stdout result)
+ (throw (:stderr result)))))
+
+;;
+;; estream helpers.
+;;
+
+(define (es-read-all stream)
+ (let loop
+ ((acc ""))
+ (if (es-feof stream)
+ acc
+ (loop (string-append acc (es-read stream 4096))))))
+
+;; File management.
+(define (in-srcdir what)
+ (string-append (getenv "srcdir") "/" what))
+
+
+;; let-like macro that manages temporary files.
+;;
+;; (lettmp <bindings> <body>)
+;;
+;; Bind all variables given in <bindings>, initialize each of them to
+;; a string representing an unique path in the filesystem, and delete
+;; them after evaluting <body>.
+(macro (lettmp form)
+ (let ((result-sym (gensym)))
+ `((lambda (,(caadr form))
+ (let ((,result-sym
+ ,(if (= 1 (length (cadr form)))
+ `(begin ,@(cddr form))
+ `(lettmp ,(cdadr form) ,@(cddr form)))))
+ (catch #t (unlink ,(caadr form)))
+ ,result-sym)) (mktemp "gpgscm-XXXXXX"))))
+
+(define (check-execution source transformer)
+ (lettmp (sink)
+ (transformer source sink)))
+
+(define (check-identity source transformer)
+ (lettmp (sink)
+ (transformer source sink)
+ (if (not (file=? source sink))
+ (error "mismatch"))))
commit 412149bc67b2666f68048ccd7011114ee338de88
Author: Justus Winter <justus at g10code.com>
Date: Thu Jan 14 18:20:14 2016 +0100
common/exechelp: Provide a way to wait for multiple processes.
* common/exechelp-posix.c (gnupg_wait_process): Generalize to
'gnupg_wait_processes'.
* common/exechelp-w32.c (gnupg_wait_process): Likewise.
* common/exechelp-w32ce.c (gnupg_wait_process): New function stub.
* common/exechelp.h (gnupg_wait_process): New prototype.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/common/exechelp-posix.c b/common/exechelp-posix.c
index 37abf55..307e2d7 100644
--- a/common/exechelp-posix.c
+++ b/common/exechelp-posix.c
@@ -522,60 +522,94 @@ gnupg_spawn_process_fd (const char *pgmname, const char *argv[],
}
-/* See exechelp.h for the description. */
+/* See exechelp.h for a description. */
gpg_error_t
gnupg_wait_process (const char *pgmname, pid_t pid, int hang, int *r_exitcode)
{
- gpg_err_code_t ec;
- int i, status;
+ return gnupg_wait_processes (&pgmname, &pid, 1, hang,
+ r_exitcode ? &r_exitcode : NULL);
+}
- if (r_exitcode)
- *r_exitcode = -1;
+/* See exechelp.h for a description. */
+gpg_error_t
+gnupg_wait_processes (const char **pgmnames, pid_t *pids, size_t count,
+ int hang, int **r_exitcodes)
+{
+ gpg_err_code_t ec = 0;
+ size_t i, left;
- if (pid == (pid_t)(-1))
- return gpg_error (GPG_ERR_INV_VALUE);
+ for (i = 0; i < count; i++)
+ {
+ if (r_exitcodes)
+ (*r_exitcodes)[i] = -1;
+
+ if (pids[i] == (pid_t)(-1))
+ return gpg_error (GPG_ERR_INV_VALUE);
+ }
+
+ left = count;
+ while (left > 0 && ec == 0)
+ {
+ pid_t pid;
+ int status;
#ifdef USE_NPTH
- i = npth_waitpid (pid, &status, hang? 0:WNOHANG);
+ pid = npth_waitpid (-1, &status, hang ? 0 : WNOHANG);
#else
- while ((i=waitpid (pid, &status, hang? 0:WNOHANG)) == (pid_t)(-1)
- && errno == EINTR);
+ while ((pid = waitpid (-1, &status, hang ? 0 : WNOHANG)) == (pid_t)(-1)
+ && errno == EINTR);
#endif
- if (i == (pid_t)(-1))
- {
- ec = gpg_err_code_from_errno (errno);
- log_error (_("waiting for process %d to terminate failed: %s\n"),
- (int)pid, strerror (errno));
- }
- else if (!i)
- {
- ec = GPG_ERR_TIMEOUT; /* Still running. */
- }
- else if (WIFEXITED (status) && WEXITSTATUS (status) == 127)
- {
- log_error (_("error running '%s': probably not installed\n"), pgmname);
- ec = GPG_ERR_CONFIGURATION;
- }
- else if (WIFEXITED (status) && WEXITSTATUS (status))
- {
- if (!r_exitcode)
- log_error (_("error running '%s': exit status %d\n"), pgmname,
- WEXITSTATUS (status));
+ if (pid == (pid_t)(-1))
+ {
+ ec = gpg_err_code_from_errno (errno);
+ log_error (_("waiting for processes to terminate failed: %s\n"),
+ strerror (errno));
+ }
+ else if (!pid)
+ {
+ ec = GPG_ERR_TIMEOUT; /* Still running. */
+ }
else
- *r_exitcode = WEXITSTATUS (status);
- ec = GPG_ERR_GENERAL;
- }
- else if (!WIFEXITED (status))
- {
- log_error (_("error running '%s': terminated\n"), pgmname);
- ec = GPG_ERR_GENERAL;
- }
- else
- {
- if (r_exitcode)
- *r_exitcode = 0;
- ec = 0;
+ {
+ for (i = 0; i < count; i++)
+ if (pid == pids[i])
+ break;
+
+ if (i == count)
+ /* No match, ignore this pid. */
+ continue;
+
+ /* Process PIDS[i] died. */
+ left -= 1;
+
+ if (WIFEXITED (status) && WEXITSTATUS (status) == 127)
+ {
+ log_error (_("error running '%s': probably not installed\n"),
+ pgmnames[i]);
+ ec = GPG_ERR_CONFIGURATION;
+ }
+ else if (WIFEXITED (status) && WEXITSTATUS (status))
+ {
+ if (!r_exitcodes)
+ log_error (_("error running '%s': exit status %d\n"),
+ pgmnames[i], WEXITSTATUS (status));
+ else
+ (*r_exitcodes)[i] = WEXITSTATUS (status);
+ ec = GPG_ERR_GENERAL;
+ }
+ else if (!WIFEXITED (status))
+ {
+ log_error (_("error running '%s': terminated\n"), pgmnames[i]);
+ ec = GPG_ERR_GENERAL;
+ }
+ else
+ {
+ if (r_exitcodes)
+ (*r_exitcodes)[i] = 0;
+ ec = 0;
+ }
+ }
}
return gpg_err_make (GPG_ERR_SOURCE_DEFAULT, ec);
diff --git a/common/exechelp-w32.c b/common/exechelp-w32.c
index d81c445..05573f8 100644
--- a/common/exechelp-w32.c
+++ b/common/exechelp-w32.c
@@ -701,21 +701,39 @@ gnupg_spawn_process_fd (const char *pgmname, const char *argv[],
gpg_error_t
gnupg_wait_process (const char *pgmname, pid_t pid, int hang, int *r_exitcode)
{
- gpg_err_code_t ec;
- HANDLE proc = fd_to_handle (pid);
+ return gnupg_wait_processes (&pgmname, &pid, 1, hang,
+ r_exitcode ? &r_exitcode : NULL);
+}
+
+/* See exechelp.h for a description. */
+gpg_error_t
+gnupg_wait_processes (const char **pgmnames, pid_t *pids, size_t count,
+ int hang, int **r_exitcodes)
+{
+ gpg_err_code_t ec = 0;
+ size_t i;
+ HANDLE *procs;
int code;
- DWORD exc;
- if (r_exitcode)
- *r_exitcode = -1;
+ procs = xtrycalloc (count, sizeof *procs);
+ if (procs == NULL)
+ return gpg_error_from_syserror ();
+
+ for (i = 0; i < count; i++)
+ {
+ if (r_exitcodes)
+ (*r_exitcodes)[i] = -1;
+
+ if (pids[i] == (pid_t)(-1))
+ return gpg_error (GPG_ERR_INV_VALUE);
- if (pid == (pid_t)(-1))
- return gpg_error (GPG_ERR_INV_VALUE);
+ procs[i] = fd_to_handle (pids[i]);
+ }
/* FIXME: We should do a pth_waitpid here. However this has not yet
been implemented. A special W32 pth system call would even be
better. */
- code = WaitForSingleObject (proc, hang? INFINITE : 0);
+ code = WaitForMultipleObjects (count, procs, TRUE, hang? INFINITE : 0);
switch (code)
{
case WAIT_TIMEOUT:
@@ -723,37 +741,42 @@ gnupg_wait_process (const char *pgmname, pid_t pid, int hang, int *r_exitcode)
break;
case WAIT_FAILED:
- log_error (_("waiting for process %d to terminate failed: %s\n"),
- (int)pid, w32_strerror (-1));
+ log_error (_("waiting for processes to terminate failed: %s\n"),
+ w32_strerror (-1));
ec = GPG_ERR_GENERAL;
break;
case WAIT_OBJECT_0:
- if (!GetExitCodeProcess (proc, &exc))
- {
- log_error (_("error getting exit code of process %d: %s\n"),
- (int)pid, w32_strerror (-1) );
- ec = GPG_ERR_GENERAL;
- }
- else if (exc)
+ for (i = 0; i < count && ec == 0; i++)
{
- log_error (_("error running '%s': exit status %d\n"),
- pgmname, (int)exc );
- if (r_exitcode)
- *r_exitcode = (int)exc;
- ec = GPG_ERR_GENERAL;
- }
- else
- {
- if (r_exitcode)
- *r_exitcode = 0;
- ec = 0;
+ DWORD exc;
+
+ if (! GetExitCodeProcess (procs[i], &exc))
+ {
+ log_error (_("error getting exit code of process %d: %s\n"),
+ (int) pids[i], w32_strerror (-1) );
+ ec = GPG_ERR_GENERAL;
+ }
+ else if (exc)
+ {
+ log_error (_("error running '%s': exit status %d\n"),
+ pgmnames[i], (int)exc );
+ if (r_exitcodes)
+ (*r_exitcodes)[i] = (int)exc;
+ ec = GPG_ERR_GENERAL;
+ }
+ else
+ {
+ if (r_exitcodes)
+ (*r_exitcodes)[i] = 0;
+ ec = 0;
+ }
}
break;
default:
- log_error ("WaitForSingleObject returned unexpected "
- "code %d for pid %d\n", code, (int)pid );
+ log_error ("WaitForMultipleObjects returned unexpected "
+ "code %d\n", code);
ec = GPG_ERR_GENERAL;
break;
}
diff --git a/common/exechelp-w32ce.c b/common/exechelp-w32ce.c
index 710c828..f1a80a2 100644
--- a/common/exechelp-w32ce.c
+++ b/common/exechelp-w32ce.c
@@ -796,6 +796,15 @@ gnupg_wait_process (const char *pgmname, pid_t pid, int hang, int *exitcode)
}
+/* See exechelp.h for a description. */
+gpg_error_t
+gnupg_wait_processes (const char **pgmnames, pid_t *pids, size_t count,
+ int hang, int **r_exitcodes)
+{
+ return gpg_error (GPG_ERR_NOT_IMPLEMENTED);
+}
+
+
void
gnupg_release_process (pid_t pid)
{
diff --git a/common/exechelp.h b/common/exechelp.h
index cdee300..e6bf93f 100644
--- a/common/exechelp.h
+++ b/common/exechelp.h
@@ -161,6 +161,10 @@ gpg_error_t gnupg_spawn_process_fd (const char *pgmname,
gpg_error_t gnupg_wait_process (const char *pgmname, pid_t pid, int hang,
int *r_exitcode);
+/* Like gnupg_wait_process, but for COUNT processes. */
+gpg_error_t gnupg_wait_processes (const char **pgmnames, pid_t *pids,
+ size_t count, int hang, int **r_exitcodes);
+
/* Kill a process; that is send an appropriate signal to the process.
gnupg_wait_process must be called to actually remove the process
commit 58e772e90715b75e6f3054ecd23b7912fdc2274b
Author: Justus Winter <justus at g10code.com>
Date: Thu Jan 14 14:14:25 2016 +0100
common/exechelp: Add general pipe function.
* common/exechelp-posix.c (gnupg_create_pipe): New function.
* common/exechelp-w32.c (duplicate_function): New function.
(INHERIT_{READ,WRITE,BOTH}): New macros.
(create_inheritable_pipe): Generalize so that both ends can be
inherited.
(do_create_pipe): Rename argument accordingly.
(gnupg_create_{in,out}bound_pipe): Use new flags.
(gnupg_create_pipe): New function.
* common/exechelp-w32ce.c (gnupg_create_pipe): New stub.
* common/exechelp.h (gnupg_create_pipe): New prototype.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/common/exechelp-posix.c b/common/exechelp-posix.c
index 5706dbe..37abf55 100644
--- a/common/exechelp-posix.c
+++ b/common/exechelp-posix.c
@@ -310,6 +310,15 @@ gnupg_create_outbound_pipe (int filedes[2])
}
+/* Portable function to create a pipe. Under Windows both ends are
+ inheritable. */
+gpg_error_t
+gnupg_create_pipe (int filedes[2])
+{
+ return do_create_pipe (filedes);
+}
+
+
static gpg_error_t
create_pipe_and_estream (int filedes[2], estream_t *r_fp,
diff --git a/common/exechelp-w32.c b/common/exechelp-w32.c
index bc9b5b4..d81c445 100644
--- a/common/exechelp-w32.c
+++ b/common/exechelp-w32.c
@@ -233,12 +233,34 @@ build_w32_commandline (const char *pgmname, const char * const *argv,
}
-/* Create pipe where one end is inheritable: With an INHERIT_IDX of 0
- the read end is inheritable, with 1 the write end is inheritable. */
+static BOOL
+duplicate_handle (HANDLE source, HANDLE *target)
+{
+ BOOL ok;
+ HANDLE new;
+
+ ok = DuplicateHandle (GetCurrentProcess (), source,
+ GetCurrentProcess (), &new,
+ 0, /* access */
+ TRUE, /* inherit? */
+ DUPLICATE_SAME_ACCESS);
+ if (ok)
+ {
+ CloseHandle (source);
+ *target = new;
+ }
+ return ok;
+}
+
+#define INHERIT_READ 1
+#define INHERIT_WRITE 2
+#define INHERIT_BOTH (INHERIT_READ|INHERIT_WRITE)
+
+/* Create pipe. FLAGS indicates which ends are inheritable. */
static int
-create_inheritable_pipe (HANDLE filedes[2], int inherit_idx)
+create_inheritable_pipe (HANDLE filedes[2], int flags)
{
- HANDLE r, w, h;
+ HANDLE r, w;
SECURITY_ATTRIBUTES sec_attr;
memset (&sec_attr, 0, sizeof sec_attr );
@@ -248,30 +270,23 @@ create_inheritable_pipe (HANDLE filedes[2], int inherit_idx)
if (!CreatePipe (&r, &w, &sec_attr, 0))
return -1;
- if (!DuplicateHandle (GetCurrentProcess(), inherit_idx? w : r,
- GetCurrentProcess(), &h, 0,
- TRUE, DUPLICATE_SAME_ACCESS ))
- {
- log_error ("DuplicateHandle failed: %s\n", w32_strerror (-1));
- CloseHandle (r);
- CloseHandle (w);
- return -1;
- }
+ if (flags & INHERIT_READ)
+ if (! duplicate_handle (r, &r))
+ goto fail;
- if (inherit_idx)
- {
- CloseHandle (w);
- w = h;
- }
- else
- {
- CloseHandle (r);
- r = h;
- }
+ if (flags & INHERIT_WRITE)
+ if (! duplicate_handle (r, &r))
+ goto fail;
filedes[0] = r;
filedes[1] = w;
return 0;
+
+ fail:
+ log_error ("DuplicateHandle failed: %s\n", w32_strerror (-1));
+ CloseHandle (r);
+ CloseHandle (w);
+ return -1;
}
@@ -291,14 +306,14 @@ w32_open_null (int for_write)
static gpg_error_t
-do_create_pipe (int filedes[2], int inherit_idx)
+do_create_pipe (int filedes[2], int flags)
{
gpg_error_t err = 0;
HANDLE fds[2];
filedes[0] = filedes[1] = -1;
err = gpg_error (GPG_ERR_GENERAL);
- if (!create_inheritable_pipe (fds, inherit_idx))
+ if (!create_inheritable_pipe (fds, flags))
{
filedes[0] = _open_osfhandle (handle_to_fd (fds[0]), 0);
if (filedes[0] == -1)
@@ -328,7 +343,7 @@ do_create_pipe (int filedes[2], int inherit_idx)
gpg_error_t
gnupg_create_inbound_pipe (int filedes[2])
{
- return do_create_pipe (filedes, 1);
+ return do_create_pipe (filedes, INHERIT_WRITE);
}
@@ -337,7 +352,16 @@ gnupg_create_inbound_pipe (int filedes[2])
gpg_error_t
gnupg_create_outbound_pipe (int filedes[2])
{
- return do_create_pipe (filedes, 0);
+ return do_create_pipe (filedes, INHERIT_READ);
+}
+
+
+/* Portable function to create a pipe. Under Windows both ends are
+ inheritable. */
+gpg_error_t
+gnupg_create_pipe (int filedes[2])
+{
+ return do_create_pipe (filedes, INHERIT_BOTH);
}
diff --git a/common/exechelp-w32ce.c b/common/exechelp-w32ce.c
index 49ccdbb..710c828 100644
--- a/common/exechelp-w32ce.c
+++ b/common/exechelp-w32ce.c
@@ -465,6 +465,15 @@ gnupg_create_outbound_pipe (int filedes[2])
}
+/* Portable function to create a pipe. Under Windows both ends are
+ inheritable. */
+gpg_error_t
+gnupg_create_pipe (int filedes[2])
+{
+ return gpg_error (GPG_ERR_NOT_IMPLEMENTED);
+}
+
+
static int
create_process (const char *pgmname, const char *cmdline,
PROCESS_INFORMATION *pi)
diff --git a/common/exechelp.h b/common/exechelp.h
index 9088342..cdee300 100644
--- a/common/exechelp.h
+++ b/common/exechelp.h
@@ -59,6 +59,11 @@ gpg_error_t gnupg_create_inbound_pipe (int filedes[2]);
inheritable. */
gpg_error_t gnupg_create_outbound_pipe (int filedes[2]);
+/* Portable function to create a pipe. Under Windows both ends are
+ inheritable. */
+gpg_error_t gnupg_create_pipe (int filedes[2]);
+
+
#define GNUPG_SPAWN_NONBLOCK 16
#define GNUPG_SPAWN_RUN_ASFW 64
#define GNUPG_SPAWN_DETACHED 128
commit 10ffd84981692bc004ee5ae59415cc42271adfbf
Author: Justus Winter <justus at g10code.com>
Date: Thu Jan 14 13:58:30 2016 +0100
tests/gpgscm: Make various limits configurable.
* tests/gpgscm/scheme-private.h: Make various limits configurable.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/scheme-private.h b/tests/gpgscm/scheme-private.h
index 3395328..404243e 100644
--- a/tests/gpgscm/scheme-private.h
+++ b/tests/gpgscm/scheme-private.h
@@ -68,8 +68,12 @@ int retcode;
int tracing;
+#ifndef CELL_SEGSIZE
#define CELL_SEGSIZE 5000 /* # of cells in one segment */
+#endif
+#ifndef CELL_NSEGMENT
#define CELL_NSEGMENT 10 /* # of segments for cells */
+#endif
char *alloc_seg[CELL_NSEGMENT];
pointer cell_seg[CELL_NSEGMENT];
int last_cell_seg;
@@ -117,7 +121,9 @@ pointer outport;
pointer save_inport;
pointer loadport;
+#ifndef MAXFIL
#define MAXFIL 64
+#endif
port load_stack[MAXFIL]; /* Stack of open files for port -1 (LOADing) */
int nesting_stack[MAXFIL];
int file_i;
@@ -126,9 +132,13 @@ int nesting;
char gc_verbose; /* if gc_verbose is not zero, print gc status */
char no_memory; /* Whether mem. alloc. has failed */
+#ifndef LINESIZE
#define LINESIZE 1024
+#endif
char linebuff[LINESIZE];
+#ifndef STRBUFFSIZE
#define STRBUFFSIZE 256
+#endif
char strbuff[STRBUFFSIZE];
FILE *tmpfp;
-----------------------------------------------------------------------
hooks/post-receive
--
The GNU Privacy Guard
http://git.gnupg.org
More information about the Gnupg-commits
mailing list