Imported Upstream version 2.1.20upstream/2.1.20

9 files changed, 170 insertions, 36 deletions

diff --git a/tests/openpgp/Makefile.am b/tests/openpgp/Makefile.am
index afac58f..40f947b 100644
--- a/tests/openpgp/Makefile.am
+++ b/tests/openpgp/Makefile.am
@@ -33,12 +33,9 @@ noinst_PROGRAMS = fake-pinentry
 
 fake_pinentry_SOURCES = fake-pinentry.c
 
-TMP ?= /tmp
-
 TESTS_ENVIRONMENT = LC_ALL=C \
 	EXEEXT=$(EXEEXT) \
 	PATH=../gpgscm:$(PATH) \
-	TMP=$(TMP) \
 	srcdir=$(abs_srcdir) \
 	objdir=$(abs_top_builddir) \
 	GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm:$(abs_top_srcdir)/tests/openpgp
@@ -51,6 +48,7 @@ XTESTS = \
 	decrypt-multifile.scm \
 	decrypt-dsa.scm \
 	decrypt-session-key.scm \
+	decrypt-unwrap-verify.scm \
 	sigs.scm \
 	sigs-dsa.scm \
 	encrypt.scm \
@@ -221,10 +219,34 @@ sample_keys = samplekeys/README \
 	      samplekeys/authenticate-only.pub.asc \
 	      samplekeys/authenticate-only.sec.asc
 
-sample_msgs = samplemsgs/issue2419.asc \
-	      samplemsgs/clearsig-1-key-1.asc \
+sample_msgs = samplemsgs/clearsig-1-key-1.asc \
+	      samplemsgs/clearsig-2-keys-1.asc \
+	      samplemsgs/clearsig-2-keys-2.asc \
+	      samplemsgs/enc-1-key-1.asc \
+	      samplemsgs/enc-1-key-2.asc \
+	      samplemsgs/enc-2-keys-1.asc \
+	      samplemsgs/enc-2-keys-2.asc \
+	      samplemsgs/enc-2-keys-hh-1.asc \
+	      samplemsgs/enc-2-keys-hr-1.asc \
+	      samplemsgs/enc-2-keys-rh-1.asc \
+	      samplemsgs/encsig-2-2-keys-3.asc \
+	      samplemsgs/encsig-2-2-keys-4.asc \
+	      samplemsgs/encsig-2-keys-1.asc \
+	      samplemsgs/encsig-2-keys-2.asc \
+	      samplemsgs/encsig-2-keys-3.asc \
+	      samplemsgs/encsig-2-keys-4.asc \
+	      samplemsgs/encz0-1-key-1.asc \
+	      samplemsgs/encz0-1-key-2.asc \
+	      samplemsgs/issue2419.asc \
+	      samplemsgs/revoke-2D727CC768697734.asc \
+	      samplemsgs/sig-1-key-1.asc \
+	      samplemsgs/sig-1-key-2.asc \
+	      samplemsgs/sig-2-keys-1.asc \
+	      samplemsgs/sig-2-keys-2.asc \
 	      samplemsgs/signed-1-key-1.asc \
-	      samplemsgs/revoke-2D727CC768697734.asc
+	      samplemsgs/signed-1-key-2.asc \
+	      samplemsgs/signed-2-keys-1.asc \
+	      samplemsgs/signed-2-keys-2.asc
 
 EXTRA_DIST = defs.scm $(XTESTS) $(TEST_FILES) \
 	     mkdemodirs signdemokey $(priv_keys) $(sample_keys)   \
diff --git a/tests/openpgp/README b/tests/openpgp/README
index eba77b1..b9d5607 100644
--- a/tests/openpgp/README
+++ b/tests/openpgp/README
@@ -30,7 +30,7 @@ This is a bit tricky because one needs to manually set some
 environment variables.  We should make that easier.  See discussion
 below.  From your build directory, do:
 
-  obj $ TMP=/tmp srcdir=<path to>/tests/openpgp \
+  obj $ srcdir=<path to>/tests/openpgp \
         GPGSCM_PATH=<path to>/tests/gpgscm:<path to>/tests/openpgp \
         $(pwd)/tests/gpgscm/gpgscm [gpgscm args] \
         run-tests.scm [test suite runner args]
diff --git a/tests/openpgp/decrypt-unwrap-verify.scm b/tests/openpgp/decrypt-unwrap-verify.scm
new file mode 100755
index 0000000..97a72e4
--- /dev/null
+++ b/tests/openpgp/decrypt-unwrap-verify.scm
@@ -0,0 +1,41 @@
+#!/usr/bin/env gpgscm
+
+;; Copyright (C) 2017 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/>.
+
+(load (with-path "defs.scm"))
+(setup-legacy-environment)
+
+(lettmp (steve's-key)
+  (call-check `(,@gpg --output ,steve's-key --export "1D777619BE310D79"))
+
+  (for-each-p
+   "Checking unwrapping the encryption."
+   (lambda (name)
+     ;; First, unwrap the encrypted message using Steve's secret key.
+     (lettmp (unwrapped)
+       (tr:do
+	(tr:open (in-srcdir "samplemsgs" (string-append name ".asc")))
+	(tr:gpg "" `(--yes --decrypt --unwrap))
+	(tr:write-to unwrapped))
+
+       ;; Then, verify the signature with a clean working directory
+       ;; containing only Steve's public key.
+       (with-ephemeral-home-directory
+	(call-check `(,@gpg --import ,steve's-key))
+	(call-check `(,@gpg --verify ,unwrapped)))))
+  '("encsig-2-keys-3" "encsig-2-keys-4")))
diff --git a/tests/openpgp/defs.scm b/tests/openpgp/defs.scm
index a06a570..e8d06c0 100644
--- a/tests/openpgp/defs.scm
+++ b/tests/openpgp/defs.scm
@@ -140,10 +140,16 @@
 (define valgrind
   '("/usr/bin/valgrind" --leak-check=full --error-exitcode=154))
 
+(unless installed?
+	(setenv "GNUPG_BUILDDIR" (getenv "objdir") #t))
+
 (define (gpg-conf . args)
   (gpg-conf' "" args))
 (define (gpg-conf' input args)
-  (let ((s (call-popen `(,(tool-hardcoded 'gpgconf) ,@args) input)))
+  (let ((s (call-popen `(,(tool-hardcoded 'gpgconf)
+			 ,@(if installed? '()
+			       (list '--build-prefix (getenv "objdir")))
+			 ,@args) input)))
     (map (lambda (line) (map percent-decode (string-split line #\:)))
 	 (string-split-newlines s))))
 (define :gc:c:name car)
@@ -180,13 +186,7 @@
      (gpg-conf' (string-append key ":16:")
 		`(--change-options ,component)))))
 
-
-(unless installed?
-	(setenv "GNUPG_BUILDDIR" (getenv "objdir") #t))
-(define gpg-components (apply gpg-conf
-			`(,@(if installed? '()
-				(list '--build-prefix (getenv "objdir")))
-			  --list-components)))
+(define gpg-components (apply gpg-conf '(--list-components)))
 
 (define (tool which)
   (case which
@@ -278,6 +278,15 @@
 ;; GnuPG helper.
 ;;
 
+;; Evaluate a sequence of expressions with the given home directory.
+(define-macro (with-home-directory gnupghome . expressions)
+  (let ((original-home-directory (gensym)))
+    `(let ((,original-home-directory (getenv "GNUPGHOME")))
+       (dynamic-wind
+	   (lambda () (setenv "GNUPGHOME" ,gnupghome #t))
+	   (lambda () ,@expressions)
+	   (lambda () (setenv "GNUPGHOME" ,original-home-directory #t))))))
+
 ;; Evaluate a sequence of expressions with an ephemeral home
 ;; directory.
 (define-macro (with-ephemeral-home-directory . expressions)
@@ -364,7 +373,6 @@
 
 (define (create-legacy-gpghome)
   (create-sample-files)
-  (mkdir "private-keys-v1.d" "-rwx")
 
   (log "Storing private keys")
   (for-each
@@ -434,7 +442,10 @@
 ;; Create the socket dir and start the agent.
 (define (start-agent)
   (log "Starting gpg-agent...")
-  (atexit stop-agent)
+  (let ((gnupghome (getenv "GNUPGHOME")))
+    (atexit (lambda ()
+	      (with-home-directory gnupghome
+				   (stop-agent)))))
   (catch (log "Warning: Creating socket directory failed:" (car *error*))
 	 (call-popen `(,(tool 'gpgconf) --create-socketdir) ""))
   (call-check `(,(tool 'gpg-connect-agent) --verbose
@@ -442,10 +453,12 @@
 				"|--debug-quick-random")
 		/bye)))
 
-;; Stop the agent and remove the socket dir.
+;; Stop the agent and other daemons and remove the socket dir.
 (define (stop-agent)
   (log "Stopping gpg-agent...")
+  (call-check `(,(tool 'gpgconf) --kill all))
   (catch (log "Warning: Removing socket directory failed.")
-	 (call-popen `(,(tool 'gpgconf) --remove-socketdir) ""))
-  (call-check `(,(tool 'gpg-connect-agent) --verbose --no-autostart
-		killagent /bye)))
+	 (call-popen `(,(tool 'gpgconf) --remove-socketdir) "")))
+
+
+;; end
diff --git a/tests/openpgp/quick-key-manipulation.scm b/tests/openpgp/quick-key-manipulation.scm
index 7ede5e9..85e56ca 100755
--- a/tests/openpgp/quick-key-manipulation.scm
+++ b/tests/openpgp/quick-key-manipulation.scm
@@ -21,10 +21,6 @@
 (load (with-path "time.scm"))
 (setup-environment)
 
- ;; XXX because of --always-trust, the trustdb is not created.
- ;; Therefore, we redefine GPG without --always-trust.
-(define GPG `(,(tool 'gpg) --no-permission-warning))
-
 (define (exact id)
   (string-append "=" id))
 
@@ -37,6 +33,7 @@
 
 (define alpha "Alpha <alpha@invalid.example.net>")
 (define bravo "Bravo <bravo@invalid.example.net>")
+(define charlie "Charlie <charlie@invalid.example.net>")
 
 (define (key-data key)
   (filter (lambda (x) (or (string=? (car x) "pub")
@@ -76,9 +73,30 @@
 (assert (= 2 (count-uids-of-secret-key alpha)))
 (assert (= 2 (count-uids-of-secret-key bravo)))
 
+(info "Checking that we can mark an user ID as primary.")
+(call-check `(,@gpg --quick-set-primary-uid ,(exact alpha) ,alpha))
+(call-check `(,@gpg --quick-set-primary-uid ,(exact alpha) ,bravo))
+;; XXX I don't know how to verify this.  The keylisting does not seem
+;; to indicate the primary UID.
+
+(info "Checking that we get an error making non-existant user ID the primary one.")
+(catch '()
+       (call-check `(,@GPG --quick-set-primary-uid ,(exact alpha) ,charlie))
+       (error "Expected an error, but get none."))
+
 (info "Checking that we can revoke a user ID...")
 (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,alpha))
 
+(info "Checking that we get an error revoking a non-existant user ID.")
+(catch '()
+       (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,charlie))
+       (error "Expected an error, but get none."))
+
+(info "Checking that we get an error revoking the last valid user ID.")
+(catch '()
+       (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,bravo))
+       (error "Expected an error, but get none."))
+
 (assert (= 1 (count-uids-of-secret-key bravo)))
 
 (info "Checking that we can change the expiration time.")
@@ -123,8 +141,13 @@
    (default default never)
    (rsa "sign auth encr" "seconds=600") ;; GPGME uses this
    (rsa "auth,encr" "2") ;; "without a letter, days is assumed"
-   (rsa "sign" "2105-01-01") ;; "last year GnuPG can represent is 2105"
-   (rsa "sign" "21050101T115500") ;; "last year GnuPG can represent is 2105"
+   ;; Sadly, the timestamp is truncated by the use of time_t on
+   ;; systems where time_t is a signed 32 bit value.
+   (rsa "sign" "2038-01-01")      ;; unix millennium
+   (rsa "sign" "20380101T115500") ;; unix millennium
+   ;; Once fixed, we can use later timestamps:
+   ;; (rsa "sign" "2105-01-01")      ;; "last year GnuPG can represent is 2105"
+   ;; (rsa "sign" "21050101T115500") ;; "last year GnuPG can represent is 2105"
    (rsa sign "2d")
    (rsa1024 sign "2w")
    (rsa2048 encr "2m")
@@ -155,7 +178,8 @@
   (lambda (subkey)
     (assert (= 1 (:alg subkey)))
     (assert (string-contains? (:cap subkey) "s"))
-    (assert (time-matches? 4260207600 ;; 2105-01-01
+    (assert (time-matches? 2145916800    ;; 2038-01-01
+			   ;; 4260207600 ;; 2105-01-01
 			   (string->number (:expire subkey))
 			   ;; This is off by 12h, but I guess it just
 			   ;; choses the middle of the day.
@@ -163,7 +187,8 @@
   (lambda (subkey)
     (assert (= 1 (:alg subkey)))
     (assert (string-contains? (:cap subkey) "s"))
-    (assert (time-matches? 4260254100 ;; UTC 2105-01-01 11:55:00
+    (assert (time-matches? 2145959700    ;; UTC 2038-01-01 11:55:00
+			   ;; 4260254100 ;; UTC 2105-01-01 11:55:00
 			   (string->number (:expire subkey))
 			   (minutes->seconds 5))))
   (lambda (subkey)
diff --git a/tests/openpgp/run-tests.scm b/tests/openpgp/run-tests.scm
index 546d7d4..139f618 100644
--- a/tests/openpgp/run-tests.scm
+++ b/tests/openpgp/run-tests.scm
@@ -27,9 +27,9 @@
 (setenv "objdir" (getcwd) #f)
 
 (let* ((tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
+       (setup (make-environment-cache (test::scm #f "setup.scm" "setup.scm")))
        (runner (if (and (member "--parallel" *args*)
 			(> (length tests) 1))
 		   run-tests-parallel
 		   run-tests-sequential)))
-  (runner (test::scm "setup.scm" "setup.scm")
-	  (map (lambda (t) (test::scm t t)) tests)))
+  (runner (map (lambda (t) (test::scm setup t t)) tests))))
diff --git a/tests/openpgp/setup.scm b/tests/openpgp/setup.scm
index d13799d..4b3bfcb 100755
--- a/tests/openpgp/setup.scm
+++ b/tests/openpgp/setup.scm
@@ -22,9 +22,28 @@
 (unless (member "--create-tarball" *args*)
 	(fail "Usage: setup.scm --create-tarball <file>"))
 
+(when (> (*verbose*) 0)
+      (define (pad symbol length)
+	(let loop ((cs (string->list (symbol->string symbol)))
+		   (result (make-string length #\space))
+		   (i 0))
+	  (if (null? cs)
+	      result
+	      (begin
+		(string-set! result i (car cs))
+		(loop (cdr cs) result (+ 1 i))))))
+      (log " I am going to use these tools:\n"
+	   "==============================")
+      (for-each
+       (lambda (t)
+	 (log (pad t 25) (tool t)))
+       '(gpgconf gpg gpg-agent scdaemon gpgsm dirmngr gpg-connect-agent
+		 gpg-preset-passphrase gpgtar pinentry)))
+
 (with-ephemeral-home-directory
  (chdir (getenv "GNUPGHOME"))
  (create-gpghome)
+ (start-agent)
  (create-legacy-gpghome)
  (stop-agent)
  (call-check `(,(tool 'gpgtar) --create --output ,(cadr *args*) ".")))
diff --git a/tests/openpgp/ssh-import.scm b/tests/openpgp/ssh-import.scm
index 7a4364c..d210056 100755
--- a/tests/openpgp/ssh-import.scm
+++ b/tests/openpgp/ssh-import.scm
@@ -36,8 +36,13 @@
 (catch (skip "ssh-keygen not found")
        (set! ssh-keygen (path-expand "ssh-keygen" path)))
 
+(define ssh-version-string
+  (:stderr (call-with-io `(,ssh "-V") "")))
+
+(log "Using" ssh "version:" ssh-version-string)
+
 (define ssh-version
-  (let ((tmp (:stderr (call-with-io `(,ssh "-V") "")))
+  (let ((tmp ssh-version-string)
 	(prefix "OpenSSH_"))
     (unless (string-prefix? tmp prefix)
 	    (skip "This doesn't look like OpenSSH:" tmp))
@@ -45,14 +50,22 @@
 			       (+ 3 (string-length prefix))))))
 
 (define (ssh-supports? algorithm)
+  ;; We exploit ssh-keygen as an oracle to test what algorithms ssh
+  ;; supports.
   (cond
    ((equal? algorithm "ed25519")
+    ;; Unfortunately, our oracle does not work for ed25519 because
+    ;; this is a specific curve and not a family, so the key size
+    ;; parameter is ignored.
     (>= ssh-version 6.5))
    (else
-    (not (string-contains? (:stderr (call-with-io `(,ssh-keygen
-						    -t ,algorithm
-						    -b "1009") ""))
-			   "unknown key type")))))
+    ;; We call ssh-keygen with the algorithm to test, specify an
+    ;; invalid key size, and observe the error message.
+    (let ((output (:stderr (call-with-io `(,ssh-keygen
+					   -t ,algorithm
+					   -b "1009") ""))))
+      (log "(ssh-supports?" algorithm "), ssh algorithm oracle replied:" output)
+      (not (string-contains? output "unknown key type"))))))
 
 (define keys
   '(("dsa" "9a:e1:f1:5f:46:ea:a5:06:e1:e2:f8:38:8e:06:54:58")
diff --git a/tests/openpgp/tofu.scm b/tests/openpgp/tofu.scm
index f4eab41..aeeef07 100755
--- a/tests/openpgp/tofu.scm
+++ b/tests/openpgp/tofu.scm
@@ -120,6 +120,7 @@
 (checktrust "1C005AF3" "f" '--tofu-default-policy=good)
 (checktrust "1C005AF3" "-" '--tofu-default-policy=unknown)
 (checktrust "1C005AF3" "n" '--tofu-default-policy=bad)
+(checktrust "1C005AF3" "q" '--tofu-default-policy=ask)
 
 ;; Change the policy to something other than auto and make sure the
 ;; policy and the trust are correct.