diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 1c170b083..e2b38f5c7 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -1,495 +1,495 @@
;; 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 .
;; Trace displays and returns the given value. A debugging aid.
(define (trace x)
(display x)
(newline)
x)
;; Stringification.
(define (stringify expression)
(let ((p (open-output-string)))
(write expression p)
(get-output-string p)))
;; Reporting.
(define (echo . msg)
(for-each (lambda (x) (display x) (display " ")) msg)
(newline))
(define (info . msg)
(apply echo msg)
(flush-stdio))
(define (log . msg)
(if (> (*verbose*) 0)
(apply info msg)))
-(define (error . msg)
+(define (fail . msg)
(apply info msg)
(exit 1))
(define (skip . msg)
(apply info msg)
(exit 77))
(define (make-counter)
(let ((c 0))
(lambda ()
(let ((r c))
(set! c (+ 1 c))
r))))
(define *progress-nesting* 0)
(define (call-with-progress msg what)
(set! *progress-nesting* (+ 1 *progress-nesting*))
(if (= 1 *progress-nesting*)
(begin
(info msg)
(display " > ")
(flush-stdio)
(what (lambda (item)
(display item)
(display " ")
(flush-stdio)))
(info "< "))
(begin
(what (lambda (item) (display ".") (flush-stdio)))
(display " ")
(flush-stdio)))
(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 CLOSED_FD -1)
(define (call-with-fds what infd outfd errfd)
(wait-process (stringify what) (spawn-process-fd what infd outfd errfd) #t))
(define (call what)
(call-with-fds what
CLOSED_FD
(if (< (*verbose*) 0) STDOUT_FILENO CLOSED_FD)
(if (< (*verbose*) 0) STDERR_FILENO CLOSED_FD)))
;; Accessor functions for the results of 'spawn-process'.
(define :stdin car)
(define :stdout cadr)
(define :stderr caddr)
(define :pid cadddr)
(define (call-with-io what in)
(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-all (:stderr h)))
(result (wait-process (car what) (:pid h) #t)))
(es-fclose (:stdout h))
(es-fclose (:stderr h))
(if (> (*verbose*) 2)
(begin
(echo (stringify what) "returned:" result)
(echo (stringify what) "wrote to stdout:" out)
(echo (stringify what) "wrote to stderr:" err)))
(list result out err))))
;; Accessor function for the results of 'call-with-io'. ':stdout' and
;; ':stderr' can also be used.
(define :retcode car)
(define (call-check what)
(let ((result (call-with-io what "")))
(if (= 0 (:retcode result))
(:stdout result)
(throw (list what "failed:" (:stderr result))))))
(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 (file-exists? name)
(call-with-input-file name (lambda (port) #t)))
(define (file=? a b)
(file-equal a b #t))
(define (text-file=? a b)
(file-equal a b #f))
(define (file-copy from to)
(catch '() (unlink to))
(letfd ((source (open from (logior O_RDONLY O_BINARY)))
(sink (open to (logior O_WRONLY O_CREAT O_BINARY) #o600)))
(splice source sink)))
(define (text-file-copy from to)
(catch '() (unlink to))
(letfd ((source (open from O_RDONLY))
(sink (open to (logior O_WRONLY O_CREAT) #o600)))
(splice source sink)))
(define (path-join . components)
(let loop ((acc #f) (rest (filter (lambda (s)
(not (string=? "" s))) components)))
(if (null? rest)
acc
(loop (if (string? acc)
(string-append acc "/" (car rest))
(car rest))
(cdr rest)))))
(assert (string=? (path-join "foo" "bar" "baz") "foo/bar/baz"))
(assert (string=? (path-join "" "bar" "baz") "bar/baz"))
(define (canonical-path path)
(if (or (char=? #\/ (string-ref path 0))
(and *win32* (char=? #\\ (string-ref path 0)))
(and *win32*
(char-alphabetic? (string-ref path 0))
(char=? #\: (string-ref path 1))
(or (char=? #\/ (string-ref path 2))
(char=? #\\ (string-ref path 2)))))
path
(path-join (getcwd) path)))
(define (in-srcdir . names)
(canonical-path (apply path-join (cons (getenv "srcdir") names))))
;; Try to find NAME in PATHS. Returns the full path name on success,
;; or raises an error.
(define (path-expand name paths)
(let loop ((path paths))
(if (null? path)
(throw "Could not find" name "in" paths)
(let* ((qualified-name (path-join (car path) name))
(file-exists (call-with-input-file qualified-name
(lambda (x) #t))))
(if file-exists
qualified-name
(loop (cdr path)))))))
;; Expand NAME using the gpgscm load path. Use like this:
;; (load (with-path "library.scm"))
(define (with-path name)
(catch name
(path-expand name (string-split (getenv "GPGSCM_PATH") *pathsep*))))
(define (basename path)
(let ((i (string-index path #\/)))
(if (equal? i #f)
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)
;; let-like macro that manages file descriptors.
;;
;; (letfd )
;;
;; Bind all variables given in and initialize each of them
;; to the given initial value, and close them after evaluting .
(macro (letfd form)
(let ((result-sym (gensym)))
`((lambda (,(caaadr form))
(let ((,result-sym
,(if (= 1 (length (cadr form)))
`(catch (begin (close ,(caaadr form))
(apply throw *error*))
,@(cddr form))
`(letfd ,(cdadr form) ,@(cddr form)))))
(close ,(caaadr form))
,result-sym)) ,@(cdaadr form))))
(macro (with-working-directory form)
(let ((result-sym (gensym)) (cwd-sym (gensym)))
`(let* ((,cwd-sym (getcwd))
(_ (if ,(cadr form) (chdir ,(cadr form))))
(,result-sym (catch (begin (chdir ,cwd-sym)
(apply throw *error*))
,@(cddr form))))
(chdir ,cwd-sym)
,result-sym)))
;; Make a temporary directory. If arguments are given, they are
;; joined using path-join, and must end in a component ending in
;; "XXXXXX". If no arguments are given, a suitable location and
;; generic name is used.
(define (mkdtemp . components)
(_mkdtemp (if (null? components)
(path-join (getenv "TMP")
(string-append "gpgscm-" (get-isotime) "-"
(basename-suffix *scriptname* ".scm")
"-XXXXXX"))
(apply path-join components))))
(macro (with-temporary-working-directory form)
(let ((result-sym (gensym)) (cwd-sym (gensym)) (tmp-sym (gensym)))
`(let* ((,cwd-sym (getcwd))
(,tmp-sym (mkdtemp))
(_ (chdir ,tmp-sym))
(,result-sym (catch (begin (chdir ,cwd-sym)
(unlink-recursively ,tmp-sym)
(apply throw *error*))
,@(cdr form))))
(chdir ,cwd-sym)
(unlink-recursively ,tmp-sym)
,result-sym)))
(define (make-temporary-file . args)
(canonical-path (path-join
(mkdtemp)
(if (null? args) "a" (car args)))))
(define (remove-temporary-file filename)
(catch '()
(unlink filename))
(let ((dirname (substring filename 0 (string-rindex filename #\/))))
(catch (echo "removing temporary directory" dirname "failed")
(rmdir dirname))))
;; let-like macro that manages temporary files.
;;
;; (lettmp )
;;
;; Bind all variables given in , initialize each of them to
;; a string representing an unique path in the filesystem, and delete
;; them after evaluting .
(macro (lettmp form)
(let ((result-sym (gensym)))
`((lambda (,(caadr form))
(let ((,result-sym
,(if (= 1 (length (cadr form)))
`(catch (begin (remove-temporary-file ,(caadr form))
(apply throw *error*))
,@(cddr form))
`(lettmp ,(cdadr form) ,@(cddr form)))))
(remove-temporary-file ,(caadr form))
,result-sym)) (make-temporary-file ,(symbol->string (caadr form))))))
(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"))))
+ (fail "mismatch"))))
;;
;; Monadic pipe support.
;;
(define pipeM
(package
(define (new procs source sink producer)
(package
(define (dump)
(write (list procs source sink producer))
(newline))
(define (add-proc command pid)
(new (cons (list command pid) procs) source sink producer))
(define (commands)
(map car procs))
(define (pids)
(map cadr procs))
(define (set-source source')
(new procs source' sink producer))
(define (set-sink sink')
(new procs source sink' producer))
(define (set-producer producer')
(if producer
(throw "producer already set"))
(new procs source sink producer'))))))
(define (pipe:do . commands)
(let loop ((M (pipeM::new '() CLOSED_FD CLOSED_FD #f)) (cmds commands))
(if (null? cmds)
(begin
(if M::producer (M::producer))
(if (not (null? M::procs))
(let* ((retcodes (wait-processes (map stringify (M::commands))
(M::pids) #t))
(results (map (lambda (p r) (append p (list r)))
M::procs retcodes))
(failed (filter (lambda (x) (not (= 0 (caddr x))))
results)))
(if (not (null? failed))
(throw failed))))) ; xxx nicer reporting
(if (and (= 2 (length cmds)) (number? (cadr cmds)))
;; hack: if it's an fd, use it as sink
(let ((M' ((car cmds) (M::set-sink (cadr cmds)))))
(if (> M::source 2) (close M::source))
(if (> (cadr cmds) 2) (close (cadr cmds)))
(loop M' '()))
(let ((M' ((car cmds) M)))
(if (> M::source 2) (close M::source))
(loop M' (cdr cmds)))))))
(define (pipe:open pathname flags)
(lambda (M)
(M::set-source (open pathname flags))))
(define (pipe:defer producer)
(lambda (M)
(let* ((p (outbound-pipe))
(M' (M::set-source (:read-end p))))
(M'::set-producer (lambda ()
(producer (:write-end p))
(close (:write-end p)))))))
(define (pipe:echo data)
(pipe:defer (lambda (sink) (display data (fdopen sink "wb")))))
(define (pipe:spawn command)
(lambda (M)
(define (do-spawn M new-source)
(let ((pid (spawn-process-fd command M::source M::sink
(if (> (*verbose*) 0)
STDERR_FILENO CLOSED_FD)))
(M' (M::set-source new-source)))
(M'::add-proc command pid)))
(if (= CLOSED_FD M::sink)
(let* ((p (pipe))
(M' (do-spawn (M::set-sink (:write-end p)) (:read-end p))))
(close (:write-end p))
(M'::set-sink CLOSED_FD))
(do-spawn M CLOSED_FD))))
(define (pipe:splice sink)
(lambda (M)
(splice M::source sink)
(M::set-source CLOSED_FD)))
(define (pipe:write-to pathname flags mode)
(open pathname flags mode))
;;
;; Monadic transformer support.
;;
(define (tr:do . commands)
(let loop ((tmpfiles '()) (source #f) (cmds commands))
(if (null? cmds)
(for-each remove-temporary-file tmpfiles)
(let* ((v ((car cmds) tmpfiles source))
(tmpfiles' (car v))
(sink (cadr v))
(error (caddr v)))
(if error
(begin
(for-each remove-temporary-file tmpfiles')
(apply throw error)))
(loop tmpfiles' sink (cdr cmds))))))
(define (tr:open pathname)
(lambda (tmpfiles source)
(list tmpfiles pathname #f)))
(define (tr:spawn input command)
(lambda (tmpfiles source)
(if (and (member '**in** command) (not source))
- (error (string-append (stringify cmd) " needs an input")))
+ (fail (string-append (stringify cmd) " needs an input")))
(let* ((t (make-temporary-file))
(cmd (map (lambda (x)
(cond
((equal? '**in** x) source)
((equal? '**out** x) t)
(else x))) command)))
(catch (list (cons t tmpfiles) t *error*)
(call-popen cmd input)
(if (and (member '**out** command) (not (file-exists? t)))
- (error (string-append (stringify cmd)
+ (fail (string-append (stringify cmd)
" did not produce '" t "'.")))
(list (cons t tmpfiles) t #f)))))
(define (tr:write-to pathname)
(lambda (tmpfiles source)
(rename source pathname)
(list tmpfiles pathname #f)))
(define (tr:pipe-do . commands)
(lambda (tmpfiles source)
(let ((t (make-temporary-file)))
(apply pipe:do
`(,@(if source `(,(pipe:open source (logior O_RDONLY O_BINARY))) '())
,@commands
,(pipe:write-to t (logior O_WRONLY O_BINARY O_CREAT) #o600)))
(list (cons t tmpfiles) t #f))))
(define (tr:assert-identity reference)
(lambda (tmpfiles source)
(if (not (file=? source reference))
- (error "mismatch"))
+ (fail "mismatch"))
(list tmpfiles source #f)))
(define (tr:assert-weak-identity reference)
(lambda (tmpfiles source)
(if (not (text-file=? source reference))
- (error "mismatch"))
+ (fail "mismatch"))
(list tmpfiles source #f)))
(define (tr:call-with-content function . args)
(lambda (tmpfiles source)
(catch (list tmpfiles source *error*)
(apply function `(,(call-with-input-file source read-all) ,@args)))
(list tmpfiles source #f)))
;;
;; Developing and debugging tests.
;;
;; Spawn an os shell.
(define (interactive-shell)
(call-with-fds `(,(getenv "SHELL") -i) 0 1 2))
diff --git a/tests/openpgp/4gb-packet.scm b/tests/openpgp/4gb-packet.scm
index 9c387af30..b827181a6 100755
--- a/tests/openpgp/4gb-packet.scm
+++ b/tests/openpgp/4gb-packet.scm
@@ -1,28 +1,28 @@
#!/usr/bin/env gpgscm
;; 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 .
;; GnuPG through 2.1.7 would incorrect mark packets whose size is
;; 2^32-1 as invalid and exit with status code 2.
(load (with-path "defs.scm"))
(setup-environment)
(if (= 0 (call `(,@GPG --list-packets ,(in-srcdir "4gb-packet.asc"))))
(info "Can parse 4GB packets.")
- (error "Failed to parse 4GB packet."))
+ (fail "Failed to parse 4GB packet."))
diff --git a/tests/openpgp/decrypt-multifile.scm b/tests/openpgp/decrypt-multifile.scm
index 4efdf6631..a7695b1f0 100755
--- a/tests/openpgp/decrypt-multifile.scm
+++ b/tests/openpgp/decrypt-multifile.scm
@@ -1,47 +1,47 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-legacy-environment)
(info "Checking decryption of supplied files using --multifile.")
(define my-wd (getcwd))
(define encrypted-files (map (lambda (name)
(string-append name ".asc"))
plain-files))
(with-temporary-working-directory
;; First, copy the files so that GnuPG writes the decrypted files here
;; and not into the source directory.
(for-each (lambda (name)
(file-copy (in-srcdir name) name))
encrypted-files)
;; Now decrypt all files.
(call-check `(,@gpg --decrypt --multifile ,@encrypted-files))
;; And verify the result. Reference files are in our original
;; working directory courtesy of setup-legacy-environment.
(for-each-p
"Verifying files:"
(lambda (name)
(unless (file=? (path-join my-wd name) name)
- (error "decrypted file differs")))
+ (fail "decrypted file differs")))
plain-files))
diff --git a/tests/openpgp/ecc.scm b/tests/openpgp/ecc.scm
index 2190b9b89..a40869db4 100755
--- a/tests/openpgp/ecc.scm
+++ b/tests/openpgp/ecc.scm
@@ -1,250 +1,250 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-legacy-environment)
(define keygrips '("8E06A180EFFE4C65B812150CAF19BF30C0689A4C"
"E4403F3FD7A443FAC29FEF288FA0D20AC212851E"
"0B7554421FFB14A06CB9F63FB49A85A58E97ABAC"
"303ACC892C2D786C8A789677C0BE54DA8538F903"
"9FE5C36985351524B6AFA19FDCBC1A3A750B6F5F"
"145A52CC7ED3FD41C5B0A26BE220FEED36AF24DE"))
(define mainkeyids '("BAA59D9C" "0F54719F" "45AF2FFE"))
(unless (have-pubkey-algo? "ECDH")
(skip "No ECC support due to an old Libgcrypt"))
(info "Preparing for ECC test")
(for-each
(lambda (grip)
(catch '() (unlink (string-append "private-keys-v1.d/" grip ".key")))
(call-check `(,(tool 'gpg-preset-passphrase)
--preset --passphrase ecc ,grip)))
keygrips)
(info "Importing ECC public keys")
(for-each
(lambda (keyid)
(call `(,(tool 'gpg) --delete-key --batch --yes ,keyid)))
mainkeyids)
(for-each
(lambda (n)
(call-check `(,(tool 'gpg) --import
,(in-srcdir (string-append
"samplekeys/ecc-sample-"
(number->string n)
"-pub.asc")))))
'(1 2 3))
;; The following is an opaque ECDSA signature on a message "This is one
;; line\n" (17 byte long) by the primary 256 bit key:
(define msg_opaque_signed_256 "-----BEGIN PGP MESSAGE-----
Version: GnuPG v2.1.0-ecc (GNU/Linux)
owGbwMvMwCHMvVT3w66lc+cwrlFK4k5N1k3KT6nUK6ko8Zl8MSEkI7NYAYjy81IV
cjLzUrk64lgYhDkY2FiZQNIMXJwCMO31rxgZ+tW/zesUPxWzdKWrtLGW/LkP5rXL
V/Yvnr/EKjBbQuvZSYa/klsum6XFmTze+maVgclT6Rc6hzqqxNy6o6qdTTmLJuvp
AQA=
=GDv4
-----END PGP MESSAGE----")
;; The following is an opaque ECDSA signature on a message "This is one
;; line\n" (17 byte long) by the primary 384 bit key:
(define msg_opaque_signed_384 "-----BEGIN PGP MESSAGE-----
Version: PGP Command Line v10.0.0 (Linux)
qANQR1DIqwE7wsvMwCnM2WDcwR9SOJ/xtFISd25qcXFieqpeSUUJAxCEZGQWKwBR
fl6qQk5mXirXoXJmVgbfYC5xmC5hzsDPjHXqbDLzpXpTBXSZV3L6bAgP3Kq7Ykmo
7Ds1v4UfBS+3CSSon7Pzq79WLjzXXEH54MkjPxnrw+8cfMVnY7Bi18J702Nnsa7a
9lMv/PM0/ao9CZ3KX7Q+Tv1rllTZ5Hj4V1frw431QnHfAA==
=elKT
-----END PGP MESSAGE-----")
;; The following is an opaque ECDSA signature on a message "This is one
;; line\n" (17 byte long) by the primary 521 bit key:
(define msg_opaque_signed_521 "-----BEGIN PGP MESSAGE-----
Version: PGP Command Line v10.0.0 (Linux)
qANQR1DIwA8BO8LLzMAlnO3Y8tB1vf4/xtNKSdy5qcXFiempeiUVJQxAEJKRWawA
RPl5qQo5mXmpXIdmMLMy+AaLnoLpEubatpeJY2Lystd7Qt32q2UcvRS5kNPWtDB7
ryufvcrWtFM7Jx8qXKDxZuqr7b9PGv1Ssk+I8TzB2O9dZC+n/jv+PAdbuu7mLe33
Gf9pLd3weV3Qno6FOqxGa5ZszQx+uer2xH3/El9x/2pVeO4l15ScsL7qWMTmffmG
Ic1RdzgeCfosMF+l/zVRchcLKzenEQA=
=ATtX
-----END PGP MESSAGE-----")
(lettmp (z)
(letfd ((fd (open z (logior O_WRONLY O_CREAT O_BINARY) #o600)))
(display "This is one line\n" (fdopen fd "wb")))
(for-each-p
"Checking opaque ECDSA signatures"
(lambda (test)
(lettmp (x y)
(call-with-output-file
x (lambda (p) (display (eval test (current-environment)) p)))
(call-check `(,(tool 'gpg) --verify ,x))
(call-check `(,(tool 'gpg) --output ,y ,x))
- (unless (file=? y z) (error "mismatch"))))
+ (unless (file=? y z) (fail "mismatch"))))
'(msg_opaque_signed_256 msg_opaque_signed_384 msg_opaque_signed_521)))
;;
;; Import the secret keys so that we now can sign and decrypt.
;;
;; Note that the PGP generated secret keys are not self-signed, thus we
;; need to pass an appropriate option.
;;
(info "Importing ECC secret keys")
(setenv "PINENTRY_USER_DATA" "ecc" #t)
(for-each
(lambda (n)
(call-check `(,(tool 'gpg) --import
,@(if (> n 1) '(--allow-non-selfsigned-uid) '())
,(in-srcdir (string-append
"samplekeys/ecc-sample-"
(number->string n)
"-sec.asc")))))
'(1 2 3))
;;
;; Check a few sample encrtpted messages.
;;
(info "Checking ECC encryption")
;; The following block encrypts the text "This is one line\n", 17 bytes,
;; with the subkey 4089AB73.
(define msg_encrypted_256 "-----BEGIN PGP MESSAGE-----
Version: GnuPG v2.1.0-ecc (GNU/Linux)
hH4Dd863o0CJq3MSAgMEHdIYZQx+rV1cjy7qitIOEICFFzp4cjsRX4r+rDdMcQUs
h7VZmbP1c9C0s9sgCKwubWfkcYUl2ZOju4gy+s4MYTBb4/j8JjnJ9Bqn6LWutTXJ
zwsdP13VIJLnhiNqISdR3/6xWQ0ICRYzwb95nUZ1c1DSVgFpjPgUvi4pgYbTpcDB
jzILKWBfBDT/jck169XE8vgtbcqVQYZ7lZpaY9CzEbC+4dXZmV1gm5MafpTyFWgH
VnyrZB4gad9Lp9e0RKHHcOOE7s/NeLuu
=odUZ
-----END PGP MESSAGE-----")
;; The following block encrypts the text "This is one line\n", 17 bytes,
;; with the subkey 9A201946:
(define msg_encrypted_384 "-----BEGIN PGP MESSAGE-----
Version: PGP Command Line v10.0.0 (Linux)
qANQR1DBngOqi5OPmiAZRhIDAwQqIr/00cJyf+QP+VA4QKVkk77KMHdz9OVaR2XK
0VYu0F/HPm89vL2orfm2hrAZxY9G2R0PG4Wk5Lg04UjKca/O72uWtjdPYulFidmo
uB0QpzXFz22ZZinxeVPLPEr19Pow0EwCc95cg4HAgrD0nV9vRcTJ/+juVfvsJhAO
isMKqrFNMvwnK5A1ECeyVXe7oLZl0lUBRhLr59QTtvf85QJjg/m5kaGy8XCJvLv3
61pZa6KUmw89PjtPak7ebcjnINL01vwmyeg1PAyW/xjeGGvcO+R4P1b4ewyFnJyR
svzIJcP7d4DqYOw7
=oiTJ
-----END PGP MESSAGE-----")
;; The following block encrypts the text "This is one line\n", 17 bytes,
;; with the subkey A81C4838:
(define msg_encrypted_521 "-----BEGIN PGP MESSAGE-----
Version: PGP Command Line v10.0.0 (Linux)
qANQR1DBwAIDB+qqSKgcSDgSBCMEAKpzTUxB4c56C7g09ekD9I+ttC5ER/xzDmXU
OJmFqU5w3FllhFj4TgGxxdH+8fv4W2Ag0IKoJvIY9V1V7oUCClfqAR01QbN7jGH/
I9GFFnH19AYEgMKgFmh14ZwN1BS6/VHh+H4apaYqapbx8/09EL+DV9zWLX4GRLXQ
VqCR1N2rXE29MJFzGmDOCueQNkUjcbuenoCSKcNT+6xhO27U9IYVCg4BhRUDGfD6
dhfRzBLxL+bKR9JVAe46+K8NLjRVu/bd4Iounx4UF5dBk8ERy+/8k9XantDoQgo6
RPqCad4Dg/QqkpbK3y574ds3VFNJmc4dVpsXm7lGV5w0FBxhVNPoWNhhECMlTroX
Rg==
=5GqW
-----END PGP MESSAGE-----")
(lettmp (z)
(letfd ((fd (open z (logior O_WRONLY O_CREAT O_BINARY) #o600)))
(display "This is one line\n" (fdopen fd "wb")))
(for-each-p
"Checking ECDSA decryption"
(lambda (test)
(lettmp (x y)
(call-with-output-file
x (lambda (p) (display (eval test (current-environment)) p)))
(call-check `(,@GPG --yes --output ,y ,x))
- (unless (file=? y z) (error "mismatch"))))
+ (unless (file=? y z) (fail "mismatch"))))
'(msg_encrypted_256 msg_encrypted_384 msg_encrypted_521)))
;;
;; Now check that we can encrypt and decrypt our own messages.
;;
;; Note that we don't need to provide a passphrase because we already
;; preset the passphrase into the gpg-agent.
;;
(for-each-p
"Checking ECC encryption and decryption"
(lambda (source)
(for-each-p
""
(lambda (keyid)
(tr:do
(tr:open source)
(tr:gpg "" `(--yes --encrypt --recipient ,keyid))
(tr:gpg "" '(--yes))
(tr:assert-identity source)))
mainkeyids))
(append plain-files data-files))
;;
;; Now check that we can sign and verify our own messages.
;;
(for-each-p
"Checking ECC signing and verifiction"
(lambda (source)
(for-each-p
""
(lambda (keyid)
(tr:do
(tr:open source)
(tr:gpg "" `(--yes --sign --local-user ,keyid))
(tr:gpg "" '(--yes))
(tr:assert-identity source)))
mainkeyids))
(append plain-files data-files))
;;
;; Let us also try to import the keys only from a secret keyblock.
;;
;; Because PGP does not sign the UID, it is not very useful to work
;; with this key unless we go into the trouble of adding the
;; self-signature.
;;
(info "Importing ECC secret keys directly")
(for-each
(lambda (keyid)
(catch '() (unlink (string-append "private-keys-v1.d/" keyid ".key"))))
keygrips)
(for-each
(lambda (keyid)
(call `(,(tool 'gpg) --delete-key --batch --yes ,keyid)))
mainkeyids)
(for-each
(lambda (n)
(call-check `(,(tool 'gpg) --import
,@(if (> n 1) '(--allow-non-selfsigned-uid) '())
,(in-srcdir (string-append
"samplekeys/ecc-sample-"
(number->string n)
"-sec.asc")))))
'(1 2 3))
diff --git a/tests/openpgp/export.scm b/tests/openpgp/export.scm
index a79411c87..c10fc81cb 100755
--- a/tests/openpgp/export.scm
+++ b/tests/openpgp/export.scm
@@ -1,100 +1,100 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-legacy-environment)
(define (check-for predicate lines message)
(unless (any predicate lines)
- (error message)))
+ (fail message)))
(define (check-exported-key dump keyid)
(check-for (lambda (l)
(and (string-prefix? l " keyid: ")
(string-suffix? l keyid))) dump
"Keyid not found")
(check-for (lambda (l) (string-prefix? l ":user ID packet:")) dump
"User ID packet not found")
(check-for (lambda (l)
(and (string-prefix? l ":signature packet:")
(string-contains? l "keyid")
(string-suffix? l keyid))) dump
"Signature packet not found"))
(define (check-exported-public-key packet-dump keyid)
(let ((dump (string-split-newlines packet-dump)))
(check-for (lambda (l) (string-prefix? l ":public key packet:")) dump
"Public key packet not found")
(check-exported-key dump keyid)))
(define (check-exported-private-key packet-dump keyid)
(let ((dump (string-split-newlines packet-dump)))
(check-for (lambda (l) (string-prefix? l ":secret key packet:")) dump
"Secret key packet not found")
(check-exported-key dump keyid)))
(lettmp
;; Prepare two temporary files for communication with the fake
;; pinentry program.
(logfile ppfile)
(define (prepare-passphrases . passphrases)
(call-with-output-file ppfile
(lambda (port)
(for-each (lambda (passphrase)
(display passphrase port)
(display #\newline port)) passphrases))))
(define CONFIRM "fake-entry being started to CONFIRM the weak phrase")
(define (assert-passphrases-consumed)
(call-with-input-file ppfile
(lambda (port)
(unless
(eof-object? (peek-char port))
- (error (string-append
+ (fail (string-append
"Expected all passphrases to be consumed, but found: "
(read-all port)))))))
(setenv "PINENTRY_USER_DATA"
(string-append "--logfile=" logfile " --passphrasefile=" ppfile) #t)
(for-each-p
"Checking key export"
(lambda (keyid)
(tr:do
(tr:pipe-do
(pipe:gpg `(--export ,keyid))
(pipe:gpg '(--list-packets)))
(tr:call-with-content check-exported-public-key keyid))
(if (string=? "D74C5F22" keyid)
;; Key D74C5F22 is protected by a passphrase. Prepare this
;; one. Currently, GnuPG does not ask for an export passphrase
;; in this case.
(prepare-passphrases usrpass1))
(tr:do
(tr:pipe-do
(pipe:gpg `(--export-secret-keys ,keyid))
(pipe:gpg '(--list-packets)))
(tr:call-with-content check-exported-private-key keyid))
(assert-passphrases-consumed))
'("D74C5F22" "C40FDECF" "ECABF51D")))
diff --git a/tests/openpgp/gpgtar.scm b/tests/openpgp/gpgtar.scm
index cd692de84..c88589f5f 100755
--- a/tests/openpgp/gpgtar.scm
+++ b/tests/openpgp/gpgtar.scm
@@ -1,94 +1,94 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-legacy-environment)
(catch (skip "gpgtar not built")
(call-check `(,(tool 'gpgtar) --help)))
(define testfiles (append plain-files data-files))
(define gpgargs
(if have-opt-always-trust
"--no-permission-warning --always-trust"
"--no-permission-warning"))
(define (do-test create-flags inspect-flags extract-flags)
(lettmp (archive)
(call-check `(,(tool 'gpgtar) --gpg ,(tool 'gpg) --gpg-args ,gpgargs
,@create-flags
--output ,archive
,@testfiles))
(tr:do
(tr:pipe-do
(pipe:spawn `(,(tool 'gpgtar) --gpg ,(tool 'gpg) --gpg-args ,gpgargs
--list-archive ,@inspect-flags
,archive)))
(tr:call-with-content
(lambda (c)
(unless (all (lambda (f) (string-contains? c f)) testfiles)
- (error "some file(s) are missing from archive")))))
+ (fail "some file(s) are missing from archive")))))
(with-temporary-working-directory
(call-check `(,(tool 'gpgtar) --gpg ,(tool 'gpg) --gpg-args ,gpgargs
--tar-args --directory=.
,@extract-flags
,archive))
(for-each
(lambda (f) (unless (call-with-input-file f (lambda (x) #t))
- (error (string-append "missing file: " f))))
+ (fail (string-append "missing file: " f))))
testfiles))))
(info "Checking gpgtar without encryption")
(do-test '(--skip-crypto --encrypt) '(--skip-crypto)
'(--skip-crypto --decrypt))
(info "Checking gpgtar without encryption with nicer actions")
(do-test '(--create) '(--skip-crypto) '(--extract))
(info "Checking gpgtar with asymmetric encryption")
(do-test `(--encrypt --recipient ,usrname2) '() '(--decrypt))
(info "Checking gpgtar with asymmetric encryption and signature")
(do-test `(--encrypt --recipient ,usrname2 --sign --local-user ,usrname3)
'() '(--decrypt))
(info "Checking gpgtar with signature")
(do-test `(--sign --local-user ,usrname3) '() '(--decrypt))
(lettmp (passphrasefile)
(letfd ((fd (open passphrasefile (logior O_WRONLY O_CREAT O_BINARY) #o600)))
(display "streng geheimes hupsipupsi" (fdopen fd "wb")))
(let ((ppflags `(--gpg-args ,(string-append "--passphrase-file="
passphrasefile))))
(info "Checking gpgtar with symmetric encryption")
(do-test `(,@ppflags --symmetric) ppflags (cons '--decrypt ppflags))
(info "Checking gpgtar with symmetric encryption and chosen cipher")
(do-test `(,@ppflags --symmetric --gpg-args
,(string-append "--cipher="
(car (force all-cipher-algos))))
ppflags (cons '--decrypt ppflags))
(info "Checking gpgtar with both symmetric and asymmetric encryption")
(do-test `(,@ppflags --symmetric --encrypt --recipient ,usrname2
--sign --local-user ,usrname3)
ppflags (cons '--decrypt ppflags))))
diff --git a/tests/openpgp/gpgv-forged-keyring.scm b/tests/openpgp/gpgv-forged-keyring.scm
index 65d21c537..6885cd9fc 100755
--- a/tests/openpgp/gpgv-forged-keyring.scm
+++ b/tests/openpgp/gpgv-forged-keyring.scm
@@ -1,68 +1,68 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-legacy-environment)
(define msg_signed_asc "
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA256
This is an example text file to demonstrate a problem.
Using forged-keyring.gpg with signature cache, it looks like it is
signed by the following key:
Echo Test (demo key)
But actually not.
It is signed by a key (steve.biko@example.net) distributed as:
gnupg/tests/openpgp/samplekeys/rsa-rsa-sample-1.asc
in GnuPG.
The forged-keyring.gpg file is created by a key in
gnupg/tests/openpgp/pubdemo.asc
Replacing the raw key material packet by one of rsa-rsa-sample-1.asc.
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v2
iQEcBAEBCAAGBQJXp+5MAAoJEKpD8dzH/tG3bGMH/1idFLJAaMxkrq+JguvAboiN
tAA44IdAgJvAxtR5w5fgfed7PfsH70+tj54/ZTObt7rZDIlj/YBQ7XeCwd7/O5vx
W0QtjjAxMuAPH80rVv4JIoflxV/deD8YaV9EhPE+6W5G0Z8SYL9B2RzdBVMwJY9+
OZGJeKnUZ92Zg9jFr+H5gQNSeYdDHVDWYxr/xJUf0jYsZvAIBfB1mcSK1niiiVBv
GAcUC/I8g18a7pCS9Qf9iZflqxX4AXfocAGQqQAiG4744OCNhVa5q6TScqhaGUah
N1Glbw1OJfP1q+QFPMPKoCsTYmZpuugq2b5gV/eH0Abvk2pG4Fo/YTDPHhec7Jk=
=NnY/
-----END PGP SIGNATURE-----
")
(for-each-p
"Checking that a signature by bad key should not be verified"
(lambda (armored-file)
(catch '()
(pipe:do
(pipe:echo (eval armored-file (current-environment)))
(pipe:spawn `(,@GPGV --keyring ,(in-srcdir "forged-keyring.gpg"))))
- (error "verification succeeded but should not")))
+ (fail "verification succeeded but should not")))
'(msg_signed_asc))
diff --git a/tests/openpgp/import.scm b/tests/openpgp/import.scm
index c3547533d..3b41746eb 100755
--- a/tests/openpgp/import.scm
+++ b/tests/openpgp/import.scm
@@ -1,61 +1,61 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-environment)
(info "Checking bug 894: segv importing certain keys.")
(call-check `(,(tool 'gpg) --import ,(in-srcdir "bug894-test.asc")))
(define keyid "0xC108E83A")
(info "Checking bug 1223: designated revoker sigs are not properly merged.")
(call `(,(tool 'gpg) --delete-key --batch --yes ,keyid))
(call `(,(tool 'gpg) --import ,(in-srcdir "bug1223-bogus.asc")))
(call `(,(tool 'gpg) --import ,(in-srcdir "bug1223-good.asc")))
(tr:do
(tr:pipe-do
(pipe:gpg `(--list-keys --with-colons ,keyid)))
(tr:call-with-content
(lambda (c)
;; XXX we do not have a regexp library
(unless (any (lambda (line)
(and (string-prefix? line "rvk:")
(string-contains? line ":0EE5BE979282D80B9F7540F1CCD2ED94D21739E9:")))
(string-split-newlines c))
(exit 1)))))
(define fpr1 "9E669861368BCA0BE42DAF7DDDA252EBB8EBE1AF")
(define fpr2 "A55120427374F3F7AA5F1166DDA252EBB8EBE1AF")
(info "Checking import of two keys with colliding long key ids.")
(call `(,(tool 'gpg) --delete-key --batch --yes ,fpr1 ,fpr2))
(call `(,(tool 'gpg) --import ,(in-srcdir "samplekeys/dda252ebb8ebe1af-1.asc")))
(call `(,(tool 'gpg) --import ,(in-srcdir "samplekeys/dda252ebb8ebe1af-2.asc")))
(tr:do
(tr:pipe-do
(pipe:gpg `(--list-keys --with-colons ,fpr1 ,fpr2)))
(tr:call-with-content
(lambda (c)
;; XXX we do not have a regexp library
(let ((keys (filter
(lambda (line)
(and (string-prefix? line "pub:")
(string-contains? line ":4096:1:DDA252EBB8EBE1AF:")))
(string-split-newlines c))))
(unless (= 2 (length keys))
- (error "Importing keys with long id collision failed"))))))
+ (fail "Importing keys with long id collision failed"))))))
diff --git a/tests/openpgp/issue2015.scm b/tests/openpgp/issue2015.scm
index 4f151aaf2..39df3338b 100755
--- a/tests/openpgp/issue2015.scm
+++ b/tests/openpgp/issue2015.scm
@@ -1,31 +1,31 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-environment)
(info "Checking passphrase cache (issue2015)...")
(call-check `(,(tool 'gpg-preset-passphrase)
--preset --passphrase some_passphrase some_id))
(let ((response (call-popen `(,(tool 'gpg-connect-agent))
"GET_PASSPHRASE --no-ask some_id X X X")))
(unless (string=? (string-rtrim char-whitespace? response)
"OK 736F6D655F70617373706872617365")
- (error "Could not retrieve passphrase from cache:" response)))
+ (fail "Could not retrieve passphrase from cache:" response)))
diff --git a/tests/openpgp/issue2346.scm b/tests/openpgp/issue2346.scm
index cbe03f9b7..9765453ea 100755
--- a/tests/openpgp/issue2346.scm
+++ b/tests/openpgp/issue2346.scm
@@ -1,28 +1,28 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-environment)
(define key (in-srcdir "samplekeys/issue2346.gpg"))
(info "Checking import statistics (issue2346)...")
(let ((status (call-popen `(,@GPG --status-fd=1 --import ,key) "")))
(unless (string-contains? status "IMPORT_RES 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0")
- (error "Unexpected number of keys imported" status)))
+ (fail "Unexpected number of keys imported" status)))
diff --git a/tests/openpgp/issue2419.scm b/tests/openpgp/issue2419.scm
index 9b6785154..e397a8877 100755
--- a/tests/openpgp/issue2419.scm
+++ b/tests/openpgp/issue2419.scm
@@ -1,29 +1,29 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-environment)
(info "Checking iobuf_peek corner case (issue2419)...")
(lettmp
(onebyte)
(dearmor (in-srcdir "samplemsgs/issue2419.asc") onebyte)
(catch (assert (string-contains? (car *error*) "invalid packet"))
(call-popen `(,@GPG --list-packets ,onebyte) "")
- (error "Expected an error but got none")))
+ (fail "Expected an error but got none")))
diff --git a/tests/openpgp/key-selection.scm b/tests/openpgp/key-selection.scm
index 93bd001d7..020c9b422 100644
--- a/tests/openpgp/key-selection.scm
+++ b/tests/openpgp/key-selection.scm
@@ -1,83 +1,83 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-legacy-environment)
;; This test assumes a fixed time of 2004-01-01.
;; Redefine gpg with a fixed time.
(define gpg `(,@gpg --faked-system-time=1072911600))
;; We have a number of keys for Mr. Acejlnu Acdipr .
(define mailbox "acdipr@example.org")
;; The keys are sorted, from the least relevant to the most relevant
;; key.
(define keys
'(("ED087E9D3394340738E20A244892A3CF8F65EBAC"
"no encryption-capable subkey, created: 2003-11-30, expires: 2006-11-29"
4)
("D7388651A1B7466D03B538428178E04B0BAA385B"
"encryption-capable subkey, created: 2000-12-31, expired: 2001-12-31"
0)
("DDEF1BEC66C8BAC8D69CED2AEABED840EC98B024"
"encryption-capable subkey, created: 2001-12-31, expires: 2006-12-30"
1)
("03FCFEDE014027DD897AD2F23D32670A96A9C2BF"
"encryption-capable subkey, created: 2002-12-31, expires: 2005-12-30"
2)
("B95BD6175CB6339244355BA160B8117E6119CED6"
"encryption-capable subkeys, last created: 2003-05-31, expires: 2005-05-30"
3)))
;; Accessors for the elements of KEYS.
(define :fpr car)
(define :comment cadr)
(define :number caddr)
(define (:filename key)
(in-srcdir "key-selection"
(string-append (number->string (:number key)) ".asc")))
(define (delete-keys which)
(call-check `(,@gpg --delete-keys ,@(map :fpr which))))
(define (import-keys which)
(call-check `(,@gpg --import ,@(map :filename which))))
(for-each-p'
"Checking key selection"
(lambda (set)
(import-keys set)
(let ((fpr (list-ref (assoc "fpr"
(gpg-with-colons `(--locate-key ,mailbox)))
9))
(expected (:fpr (last set))))
(unless (equal? fpr expected)
(display "Given keys ")
(apply echo (map :fpr set))
(echo "This is what --locate-key says:")
(display (call-popen `(,@gpg --locate-key ,mailbox) ""))
(echo "This is the key we expected:")
(display (call-popen `(,@gpg --list-keys ,expected) ""))
- (error "Expected" expected "but got" fpr)))
+ (fail "Expected" expected "but got" fpr)))
(delete-keys set))
(lambda (set)
(length set))
(filter (lambda (x) (not (null? x))) (powerset keys)))
diff --git a/tests/openpgp/mds.scm b/tests/openpgp/mds.scm
index bf598eb66..fb468e5de 100755
--- a/tests/openpgp/mds.scm
+++ b/tests/openpgp/mds.scm
@@ -1,69 +1,69 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-environment)
(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)
;; Test whether HASH matches REF.
(define (test-hash hash ref)
(unless (eq? #f ref)
(if (not (string=? (:value hash) (:value ref)))
- (error "failed"))))
+ (fail "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 '(--print-mds) s)))
(test-hashes "Hashing the empty string"
"" empty-string-hashes)
(test-hashes "Hashing the string \"abcdefghijklmnopqrstuvwxyz\""
"abcdefghijklmnopqrstuvwxyz" abc-hashes)
diff --git a/tests/openpgp/multisig.scm b/tests/openpgp/multisig.scm
index 7f1c4c509..c643ac88d 100755
--- a/tests/openpgp/multisig.scm
+++ b/tests/openpgp/multisig.scm
@@ -1,169 +1,169 @@
#!/usr/bin/env gpgscm
;; 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 .
;; Check that gpg verifies only signatures where there is no ambiguity
;; in the order of packets. Needs the Demo Keys Lima and Mike.
;;
;; Note: We do not support multiple signatures anymore thus this test is
;; not really needed because verify could do the same. We keep it anyway.
(load (with-path "defs.scm"))
(setup-legacy-environment)
(define sig-1ls1ls-valid "
-----BEGIN PGP ARMORED FILE-----
kA0DAAIRN8q1H7eRA/gBrCdiBXRleHQxOogq9EkgYW0gc29ycnksIEkgY2FuJ3Qg
ZG8gdGhhdAqIPwMFADqIKvQ3yrUft5ED+BEC2joAoJaSaXOZEtSZqQ780HIXG77e
8PB7AJ4wCprmaFTO0fBaTcXDuEOBdAWnOZANAwACETfKtR+3kQP4AawnYgV0ZXh0
MTqIKvRJIGFtIHNvcnJ5LCBJIGNhbid0IGRvIHRoYXQKiD8DBQA6iCr0N8q1H7eR
A/gRAto6AKCWkmlzmRLUmakO/NByFxu+3vDwewCeMAqa5mhUztHwWk3Fw7hDgXQF
pzk=
=8jSC
-----END PGP ARMORED FILE-----
")
(define sig-ls-valid "
-----BEGIN PGP ARMORED FILE-----
rCdiBXRleHQxOogrS0kgYW0gc29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqI
K0s3yrUft5ED+BECLQMAn2jZUNOpB4OuurSQkc2TRfg6ek02AJ9+oJS0frQ+yUsT
QDUFTH2PvZRxjw==
=J+lb
-----END PGP ARMORED FILE-----
")
(define sig-sl-valid "
-----BEGIN PGP ARMORED FILE-----
iD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeDrrq0kJHNk0X4OnpNNgCffqCU
tH60PslLE0A1BUx9j72UcY+sJ2IFdGV4dDE6iCtLSSBhbSBzb3JyeSwgSSBjYW4n
dCBkbyB0aGF0Cg==
=N9MP
-----END PGP ARMORED FILE-----
")
(define sig-11lss-valid-but-is-not "
-----BEGIN PGP ARMORED FILE-----
kA0DAAIRN8q1H7eRA/gAkA0DAAIRN8q1H7eRA/gBrCdiBXRleHQxOogyXUkgYW0g
c29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqIMl03yrUft5ED+BECwQAAnRXT
mXjVd385oD38W80XuheWKTGcAJ9pZ6/flaKDfw+SLido7xaUHuhp5Yg/AwUAOogy
XTfKtR+3kQP4EQLBAACgnN0IP+NztE0aAc/DZ17yHWR9diwAniN0P01WmbgZJoZB
Q341WRXKS/at
=Ekrs
-----END PGP ARMORED FILE-----
")
(define sig-11lss11lss-valid-but-is-not "
-----BEGIN PGP ARMORED FILE-----
kA0DAAIRN8q1H7eRA/gAkA0DAAIRN8q1H7eRA/gBrCdiBXRleHQxOogyXUkgYW0g
c29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqIMl03yrUft5ED+BECwQAAnRXT
mXjVd385oD38W80XuheWKTGcAJ9pZ6/flaKDfw+SLido7xaUHuhp5Yg/AwUAOogy
XTfKtR+3kQP4EQLBAACgnN0IP+NztE0aAc/DZ17yHWR9diwAniN0P01WmbgZJoZB
Q341WRXKS/atkA0DAAIRN8q1H7eRA/gAkA0DAAIRN8q1H7eRA/gBrCdiBXRleHQx
OogyXUkgYW0gc29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqIMl03yrUft5ED
+BECwQAAnRXTmXjVd385oD38W80XuheWKTGcAJ9pZ6/flaKDfw+SLido7xaUHuhp
5Yg/AwUAOogyXTfKtR+3kQP4EQLBAACgnN0IP+NztE0aAc/DZ17yHWR9diwAniN0
P01WmbgZJoZBQ341WRXKS/at
=P1Mu
-----END PGP ARMORED FILE-----
")
(define sig-ssl-valid-but-is-not "
-----BEGIN PGP ARMORED FILE-----
iD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeDrrq0kJHNk0X4OnpNNgCffqCU
tH60PslLE0A1BUx9j72UcY+IPwMFADqIK0s3yrUft5ED+BECLQMAn2jZUNOpB4Ou
urSQkc2TRfg6ek02AJ9+oJS0frQ+yUsTQDUFTH2PvZRxj6wnYgV0ZXh0MTqIK0tJ
IGFtIHNvcnJ5LCBJIGNhbid0IGRvIHRoYXQK
=Zven
-----END PGP ARMORED FILE-----
")
(define sig-1lsls-invalid "
-----BEGIN PGP ARMORED FILE-----
kA0DAAIRN8q1H7eRA/gBrCdiBXRleHQxOogq9EkgYW0gc29ycnksIEkgY2FuJ3Qg
ZG8gdGhhdAqIPwMFADqIKvQ3yrUft5ED+BEC2joAoJaSaXOZEtSZqQ780HIXG77e
8PB7AJ4wCprmaFTO0fBaTcXDuEOBdAWnOawnYgV0ZXh0MTqIK0tJIGFtIHNvcnJ5
LCBJIGNhbid0IGRvIHRoYXQKiD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeD
rrq0kJHNk0X4OnpNNgCffqCUtH60PslLE0A1BUx9j72UcY8=
=nkeu
-----END PGP ARMORED FILE-----
")
(define sig-lsls-invalid "
-----BEGIN PGP ARMORED FILE-----
rCdiBXRleHQxOogrS0kgYW0gc29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqI
K0s3yrUft5ED+BECLQMAn2jZUNOpB4OuurSQkc2TRfg6ek02AJ9+oJS0frQ+yUsT
QDUFTH2PvZRxj6wnYgV0ZXh0MTqIK0tJIGFtIHNvcnJ5LCBJIGNhbid0IGRvIHRo
YXQKiD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeDrrq0kJHNk0X4OnpNNgCf
fqCUtH60PslLE0A1BUx9j72UcY8=
=BlZH
-----END PGP ARMORED FILE-----
")
(define sig-lss-invalid "
-----BEGIN PGP ARMORED FILE-----
rCdiBXRleHQxOogrS0kgYW0gc29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqI
K0s3yrUft5ED+BECLQMAn2jZUNOpB4OuurSQkc2TRfg6ek02AJ9+oJS0frQ+yUsT
QDUFTH2PvZRxj4g/AwUAOogrSzfKtR+3kQP4EQItAwCfaNlQ06kHg666tJCRzZNF
+Dp6TTYAn36glLR+tD7JSxNANQVMfY+9lHGP
=jmt6
-----END PGP ARMORED FILE-----
")
(define sig-slsl-invalid "
-----BEGIN PGP ARMORED FILE-----
iD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeDrrq0kJHNk0X4OnpNNgCffqCU
tH60PslLE0A1BUx9j72UcY+sJ2IFdGV4dDE6iCtLSSBhbSBzb3JyeSwgSSBjYW4n
dCBkbyB0aGF0Cog/AwUAOogrSzfKtR+3kQP4EQItAwCfaNlQ06kHg666tJCRzZNF
+Dp6TTYAn36glLR+tD7JSxNANQVMfY+9lHGPrCdiBXRleHQxOogrS0kgYW0gc29y
cnksIEkgY2FuJ3QgZG8gdGhhdAo=
=phBF
-----END PGP ARMORED FILE-----
")
(for-each-p
"Checking that a valid signature is verified as such"
(lambda (armored-file)
(tr:do
(tr:pipe-do
(pipe:echo (eval armored-file (current-environment)))
(pipe:spawn `(,@GPG --dearmor)))
(tr:spawn "" `(,@GPG --verify **in**))))
'(sig-sl-valid))
;; ???
;;
;; #for i in "$sig-11lss-valid-but-is-not" "$sig-11lss11lss-valid-but-is-not" \
;; # "$sig-ssl-valid-but-is-not"; do
;; # echo "$i" | $GPG --dearmor >x
;; # $GPG --verify /dev/null || error "valid is invalid"
;; #done
(for-each-p
"Checking that an invalid signature is verified as such"
(lambda (armored-file)
(lettmp (file)
(pipe:do
(pipe:echo (eval armored-file (current-environment)))
(pipe:spawn `(,@GPG --dearmor))
(pipe:write-to file (logior O_WRONLY O_CREAT O_BINARY) #o600))
(if (= 0 (call `(,@GPG --verify ,file)))
- (error "Bad signature verified ok"))))
+ (fail "Bad signature verified ok"))))
'(sig-1ls1ls-valid sig-ls-valid sig-1lsls-invalid
sig-lsls-invalid sig-lss-invalid sig-slsl-invalid))
diff --git a/tests/openpgp/setup.scm b/tests/openpgp/setup.scm
index d2e125e4e..fc0615fc8 100755
--- a/tests/openpgp/setup.scm
+++ b/tests/openpgp/setup.scm
@@ -1,30 +1,30 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(unless (member "--create-tarball" *args*)
- (error "Usage: setup.scm --create-tarball "))
+ (fail "Usage: setup.scm --create-tarball "))
(with-temporary-working-directory
(setenv "GNUPGHOME" (getcwd) #t)
(create-gpghome)
(create-legacy-gpghome)
(stop-agent)
(call-check `(,(tool 'gpgtar) --create --output ,(cadr *args*) ".")))
diff --git a/tests/openpgp/signencrypt.scm b/tests/openpgp/signencrypt.scm
index b4c3bd6df..35ac89a0f 100755
--- a/tests/openpgp/signencrypt.scm
+++ b/tests/openpgp/signencrypt.scm
@@ -1,40 +1,40 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-legacy-environment)
(for-each-p
"Checking signing and encryption"
(lambda (source)
(tr:do
(tr:open source)
(tr:gpg usrpass1 `(--yes --passphrase-fd "0" -se --recipient ,usrname2))
(tr:gpg "" '(--yes))
(tr:assert-identity source)))
(append plain-files data-files))
(info "Checking bug 537: MDC problem with old style compressed packets.")
(lettmp (tmp)
(call-popen `(,@GPG --yes --passphrase-fd "0"
--output ,tmp ,(in-srcdir "bug537-test.data.asc"))
usrpass1)
(if (not (string=? "4336AE2A528FAE091E73E59E325B588FEE795F9B"
(cadar (gpg-hash-string `(--print-md SHA1 ,tmp) ""))))
- (error "bug537-test.data.asc: mismatch (bug 537)")))
+ (fail "bug537-test.data.asc: mismatch (bug 537)")))
diff --git a/tests/openpgp/ssh-import.scm b/tests/openpgp/ssh-import.scm
index a825409d6..e8f12d36c 100755
--- a/tests/openpgp/ssh-import.scm
+++ b/tests/openpgp/ssh-import.scm
@@ -1,67 +1,67 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-environment)
(define GNUPGHOME (getenv "GNUPGHOME"))
(if (string=? "" GNUPGHOME)
- (error "GNUPGHOME not set"))
+ (fail "GNUPGHOME not set"))
(setenv "SSH_AUTH_SOCK"
(call-check `(,(tool 'gpgconf) --null --list-dirs agent-ssh-socket))
#t)
(define SSH-ADD #f)
(catch (skip "ssh-add not found")
(set! SSH-ADD
(path-expand "ssh-add" (string-split (getenv "PATH") *pathsep*))))
(define keys
'(("dsa" "9a:e1:f1:5f:46:ea:a5:06:e1:e2:f8:38:8e:06:54:58")
("rsa" "c9:85:b5:55:00:84:a9:82:5a:df:d6:62:1b:5a:28:22")
("ecdsa" "93:37:30:a6:4e:e7:6a:22:79:77:8e:bf:ed:14:e9:8e")
("ed25519" "08:df:be:af:d2:f5:32:20:3a:1c:56:06:be:31:0f:bf")))
(for-each-p'
"Importing ssh keys..."
(lambda (key)
(let ((file (path-join (in-srcdir "samplekeys")
(string-append "ssh-" (car key) ".key")))
(hash (cadr key)))
;; We pipe the key to ssh-add so that it won't complain about
;; file's permissions.
(pipe:do
(pipe:open file (logior O_RDONLY O_BINARY))
(pipe:spawn `(,SSH-ADD -)))
(unless (string-contains? (call-popen `(,SSH-ADD -l "-E" md5) "") hash)
- (error "key not added"))))
+ (fail "key not added"))))
car keys)
(info "Checking for issue2316...")
(unlink (string-append GNUPGHOME "/sshcontrol"))
(pipe:do
(pipe:open (path-join (in-srcdir "samplekeys")
(string-append "ssh-rsa.key"))
(logior O_RDONLY O_BINARY))
(pipe:spawn `(,SSH-ADD -)))
(unless
(string-contains? (call-popen `(,SSH-ADD -l "-E" md5) "")
"c9:85:b5:55:00:84:a9:82:5a:df:d6:62:1b:5a:28:22")
- (error "known private key not (re-)added to sshcontrol"))
+ (fail "known private key not (re-)added to sshcontrol"))
diff --git a/tests/openpgp/tofu.scm b/tests/openpgp/tofu.scm
index f9dc41102..47c3dd0a4 100755
--- a/tests/openpgp/tofu.scm
+++ b/tests/openpgp/tofu.scm
@@ -1,397 +1,397 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-environment)
;; Redefine GPG without --always-trust and a fixed time.
(define GPG `(,(tool 'gpg) --no-permission-warning
--faked-system-time=1480943782))
(define GNUPGHOME (getenv "GNUPGHOME"))
(if (string=? "" GNUPGHOME)
- (error "GNUPGHOME not set"))
+ (fail "GNUPGHOME not set"))
(catch (skip "Tofu not supported")
(call-check `(,@GPG --trust-model=tofu --list-config)))
(define KEYS '("1C005AF3" "BE04EB2B" "B662E42F"))
;; Import the test keys.
(for-each (lambda (keyid)
(call-check `(,@GPG --import
,(in-srcdir "tofu/conflicting/"
(string-append keyid ".gpg"))))
- (catch (error "Missing key" keyid)
+ (catch (fail "Missing key" keyid)
(call-check `(,@GPG --list-keys ,keyid))))
KEYS)
;; Get tofu policy for KEYID. Any remaining arguments are simply
;; passed to GPG.
;;
;; This function only supports keys with a single user id.
(define (getpolicy keyid . args)
(let ((policy
(list-ref (assoc "tfs" (gpg-with-colons
`(--trust-model=tofu --with-tofu-info
,@args
--list-keys ,keyid))) 5)))
(unless (member policy '("auto" "good" "unknown" "bad" "ask"))
- (error "Bad policy:" policy))
+ (fail "Bad policy:" policy))
policy))
;; Check that KEYID's tofu policy matches EXPECTED-POLICY. Any
;; remaining arguments are simply passed to GPG.
;;
;; This function only supports keys with a single user id.
(define (checkpolicy keyid expected-policy . args)
(let ((policy (apply getpolicy `(,keyid ,@args))))
(unless (string=? policy expected-policy)
- (error keyid ": Expected policy to be" expected-policy
+ (fail keyid ": Expected policy to be" expected-policy
"but got" policy))))
;; Get the trust level for KEYID. Any remaining arguments are simply
;; passed to GPG.
;;
;; This function only supports keys with a single user id.
(define (gettrust keyid . args)
(let ((trust
(list-ref (assoc "pub" (gpg-with-colons
`(--trust-model=tofu
,@args
--list-keys ,keyid))) 1)))
(unless (and (= 1 (string-length trust))
(member (string-ref trust 0) (string->list "oidreqnmfuws-")))
- (error "Bad trust value:" trust))
+ (fail "Bad trust value:" trust))
trust))
;; Check that KEYID's trust level matches EXPECTED-TRUST. Any
;; remaining arguments are simply passed to GPG.
;;
;; This function only supports keys with a single user id.
(define (checktrust keyid expected-trust . args)
(let ((trust (apply gettrust `(,keyid ,@args))))
(unless (string=? trust expected-trust)
- (error keyid ": Expected trust to be" expected-trust
+ (fail keyid ": Expected trust to be" expected-trust
"but got" trust))))
;; Set key KEYID's policy to POLICY. Any remaining arguments are
;; passed as options to gpg.
(define (setpolicy keyid policy . args)
(call-check `(,@GPG --trust-model=tofu ,@args
--tofu-policy ,policy ,keyid)))
(info "Checking tofu policies and trust...")
;; Carefully remove the TOFU db.
(catch '() (unlink (string-append GNUPGHOME "/tofu.db")))
;; Verify a message. There should be no conflict and the trust
;; policy should be set to auto.
(call-check `(,@GPG --trust-model=tofu
--verify ,(in-srcdir "tofu/conflicting/1C005AF3-1.txt")))
(checkpolicy "1C005AF3" "auto")
;; Check default trust.
(checktrust "1C005AF3" "m")
;; Trust should be derived lazily. Thus, if the policy is set to
;; auto and we change --tofu-default-policy, then the trust should
;; change as well. Try it.
(checktrust "1C005AF3" "f" '--tofu-default-policy=good)
(checktrust "1C005AF3" "-" '--tofu-default-policy=unknown)
(checktrust "1C005AF3" "n" '--tofu-default-policy=bad)
;; Change the policy to something other than auto and make sure the
;; policy and the trust are correct.
(for-each-p
"Setting a fixed policy..."
(lambda (policy)
(let ((expected-trust
(cond
((string=? "good" policy) "f")
((string=? "unknown" policy) "-")
(else "n"))))
(setpolicy "1C005AF3" policy)
;; Since we have a fixed policy, the trust level shouldn't
;; change if we change the default policy.
(for-each-p
""
(lambda (default-policy)
(checkpolicy "1C005AF3" policy
'--tofu-default-policy default-policy)
(checktrust "1C005AF3" expected-trust
'--tofu-default-policy default-policy))
'("auto" "good" "unknown" "bad" "ask"))))
'("good" "unknown" "bad"))
;; At the end, 1C005AF3's policy should be bad.
(checkpolicy "1C005AF3" "bad")
;; 1C005AF3 and BE04EB2B conflict. A policy setting of "auto"
;; (BE04EB2B's state) will result in an effective policy of ask. But,
;; a policy setting of "bad" will result in an effective policy of
;; bad.
(setpolicy "BE04EB2B" "auto")
(checkpolicy "BE04EB2B" "ask")
(checkpolicy "1C005AF3" "bad")
;; 1C005AF3, B662E42F, and BE04EB2B conflict. We change BE04EB2B's
;; policy to auto and leave 1C005AF3's policy at bad. This conflict
;; should cause BE04EB2B's effective policy to be ask (since it is
;; auto), but not affect 1C005AF3's policy.
(setpolicy "BE04EB2B" "auto")
(checkpolicy "BE04EB2B" "ask")
(call-check `(,@GPG --trust-model=tofu
--verify ,(in-srcdir "tofu/conflicting/B662E42F-1.txt")))
(checkpolicy "BE04EB2B" "ask")
(checkpolicy "1C005AF3" "bad")
(checkpolicy "B662E42F" "ask")
;; Check that the stats are emitted correctly.
(display "Checking TOFU stats...\n")
(define (check-counts keyid expected-sigs expected-encs . args)
(let*
((tfs (assoc "tfs"
(gpg-with-colons
`(--trust-model=tofu --with-tofu-info
,@args --list-keys ,keyid))))
(sigs (string->number (list-ref tfs 3)))
(encs (string->number (list-ref tfs 4))))
(unless (= sigs expected-sigs)
- (error keyid ": # signatures (" sigs ") does not match expected"
+ (fail keyid ": # signatures (" sigs ") does not match expected"
"# signatures (" expected-sigs ").\n"))
(unless (= encs expected-encs)
- (error keyid ": # encryptions (" encs ") does not match expected"
+ (fail keyid ": # encryptions (" encs ") does not match expected"
"# encryptions (" expected-encs ").\n"))
))
;; Carefully remove the TOFU db.
(catch '() (unlink (string-append GNUPGHOME "/tofu.db")))
(check-counts "1C005AF3" 0 0)
(check-counts "BE04EB2B" 0 0)
(check-counts "B662E42F" 0 0)
;; Verify a message. The signature count should increase by 1.
(call-check `(,@GPG --trust-model=tofu
--verify ,(in-srcdir "tofu/conflicting/1C005AF3-1.txt")))
(check-counts "1C005AF3" 1 0)
;; Verify the same message. The signature count should remain the
;; same.
(call-check `(,@GPG --trust-model=tofu
--verify ,(in-srcdir "tofu/conflicting/1C005AF3-1.txt")))
(check-counts "1C005AF3" 1 0)
;; Verify another message.
(call-check `(,@GPG --trust-model=tofu
--verify ,(in-srcdir "tofu/conflicting/1C005AF3-2.txt")))
(check-counts "1C005AF3" 2 0)
;; Verify another message.
(call-check `(,@GPG --trust-model=tofu
--verify ,(in-srcdir "tofu/conflicting/1C005AF3-3.txt")))
(check-counts "1C005AF3" 3 0)
;; Verify a message from a different sender. The signature count
;; should increase by 1 for that key.
(call-check `(,@GPG --trust-model=tofu
--verify ,(in-srcdir "tofu/conflicting/BE04EB2B-1.txt")))
(check-counts "1C005AF3" 3 0)
(check-counts "BE04EB2B" 1 0)
(check-counts "B662E42F" 0 0)
;; Check that we detect the following attack:
;;
;; Alice and Bob each have a key and cross sign them. Bob then adds a
;; new user id, "Alice". TOFU should now detect a conflict, because
;; Alice only signed Bob's "Bob" user id.
(display "Checking cross sigs...\n")
(define GPG `(,(tool 'gpg) --no-permission-warning
--faked-system-time=1476304861))
;; Carefully remove the TOFU db.
(catch '() (unlink (string-append GNUPGHOME "/tofu.db")))
(define DIR "tofu/cross-sigs")
;; The test keys.
(define KEYA "1938C3A0E4674B6C217AC0B987DB2814EC38277E")
(define KEYB "DC463A16E42F03240D76E8BA8B48C6BD871C2247")
(define KEYIDA (substring KEYA (- (string-length KEYA) 8)))
(define KEYIDB (substring KEYB (- (string-length KEYB) 8)))
(define (verify-messages)
(for-each
(lambda (key)
(for-each
(lambda (i)
(let ((fn (in-srcdir DIR (string-append key "-" i ".txt"))))
(call-check `(,@GPG --trust-model=tofu --verify ,fn))))
(list "1" "2")))
(list KEYIDA KEYIDB)))
;; Import the public keys.
(display " > Two keys. ")
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDA "-1.gpg"))))
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-1.gpg"))))
;; Make sure the tofu engine registers the keys.
(verify-messages)
(display "<\n")
;; Since there is no conflict, the policy should be auto.
(checkpolicy KEYA "auto")
(checkpolicy KEYB "auto")
;; Import the cross sigs.
(display " > Adding cross signatures. ")
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDA "-2.gpg"))))
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-2.gpg"))))
(verify-messages)
(display "<\n")
;; There is still no conflict, so the policy shouldn't have changed.
(checkpolicy KEYA "auto")
(checkpolicy KEYB "auto")
;; Import the conflicting user id.
(display " > Adding conflicting user id. ")
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-3.gpg"))))
(verify-messages)
(display "<\n")
(checkpolicy KEYA "ask")
(checkpolicy KEYB "ask")
;; Import Alice's signature on the conflicting user id. Since there
;; is now a cross signature, we should revert to the default policy.
(display " > Adding cross signature on user id. ")
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-4.gpg"))))
(verify-messages)
(display "<\n")
(checkpolicy KEYA "auto")
(checkpolicy KEYB "auto")
;; Remove the keys.
(call-check `(,@GPG --delete-key ,KEYA))
(call-check `(,@GPG --delete-key ,KEYB))
;; Check that we detect the following attack:
;;
;; Alice has an ultimately trusted key and she signs Bob's key. Then
;; Bob adds a new user id, "Alice". TOFU should now detect a
;; conflict, because Alice only signed Bob's "Bob" user id.
;;
;;
;; The Alice key:
;; pub rsa2048 2016-10-11 [SC]
;; 1938C3A0E4674B6C217AC0B987DB2814EC38277E
;; uid [ultimate] Spy Cow
;; sub rsa2048 2016-10-11 [E]
;;
;; The Bob key:
;;
;; pub rsa2048 2016-10-11 [SC]
;; DC463A16E42F03240D76E8BA8B48C6BD871C2247
;; uid [ full ] Spy R. Cow
;; uid [ full ] Spy R. Cow
;; sub rsa2048 2016-10-11 [E]
(display "Checking UTK sigs...\n")
(define GPG `(,(tool 'gpg) --no-permission-warning
--faked-system-time=1476304861))
;; Carefully remove the TOFU db.
(catch '() (unlink (string-append GNUPGHOME "/tofu.db")))
(define DIR "tofu/cross-sigs")
;; The test keys.
(define KEYA "1938C3A0E4674B6C217AC0B987DB2814EC38277E")
(define KEYB "DC463A16E42F03240D76E8BA8B48C6BD871C2247")
(define KEYIDA (substring KEYA (- (string-length KEYA) 8)))
(define KEYIDB (substring KEYB (- (string-length KEYB) 8)))
(define (verify-messages)
(for-each
(lambda (key)
(for-each
(lambda (i)
(let ((fn (in-srcdir DIR (string-append key "-" i ".txt"))))
(call-check `(,@GPG --trust-model=tofu --verify ,fn))))
(list "1" "2")))
(list KEYIDA KEYIDB)))
;; Import the public keys.
(display " > Two keys. ")
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDA "-1.gpg"))))
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-1.gpg"))))
(display "<\n")
(checkpolicy KEYA "auto")
(checkpolicy KEYB "auto")
;; Import the cross sigs.
(display " > Adding cross signatures. ")
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDA "-2.gpg"))))
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-2.gpg"))))
(display "<\n")
(checkpolicy KEYA "auto")
(checkpolicy KEYB "auto")
;; Make KEYA ultimately trusted.
(display (string-append " > Marking " KEYA " as ultimately trusted. "))
(pipe:do
(pipe:echo (string-append KEYA ":6:\n"))
(pipe:gpg `(--import-ownertrust)))
(display "<\n")
;; An ultimately trusted key's policy is good.
(checkpolicy KEYA "good")
;; A key signed by a UTK for which there is no policy gets the default
;; policy of good.
(checkpolicy KEYB "good")
;; Import the conflicting user id.
(display " > Adding conflicting user id. ")
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-3.gpg"))))
(verify-messages)
(display "<\n")
(checkpolicy KEYA "good")
(checkpolicy KEYB "ask")
;; Import Alice's signature on the conflicting user id.
(display " > Adding cross signature on user id. ")
(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-4.gpg"))))
(verify-messages)
(display "<\n")
(checkpolicy KEYA "good")
(checkpolicy KEYB "good")
;; Remove the keys.
(call-check `(,@GPG --delete-key ,KEYA))
(call-check `(,@GPG --delete-key ,KEYB))
diff --git a/tests/openpgp/verify.scm b/tests/openpgp/verify.scm
index 2c2c14a7f..a398a1483 100755
--- a/tests/openpgp/verify.scm
+++ b/tests/openpgp/verify.scm
@@ -1,350 +1,350 @@
#!/usr/bin/env gpgscm
;; 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 .
(load (with-path "defs.scm"))
(setup-legacy-environment)
;;
;; Two simple tests to check that verify fails for bad input data
;;
(for-each-p
"Checking bogus signature"
(lambda (char)
(lettmp (x)
(call-with-binary-output-file
x
(lambda (port)
(display (make-string 64 (integer->char (string->number char)))
port)))
(if (= 0 (call `(,@GPG --verify ,x data-500)))
- (error "no error code from verify"))))
+ (fail "no error code from verify"))))
'("#x2d" "#xca"))
;; A plain signed message created using
;; echo abc | gpg --homedir . --passphrase-fd 0 -u Alpha -z0 -sa msg
(define msg_ols_asc "
-----BEGIN PGP MESSAGE-----
kA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGluayB0aGF0IGFsbCByaWdo
dC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5IGFyZSBzaWNrIGFuZAp0
aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkgZGVjZW50IHBlb3BsZSBh
cmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJlaW5nIHNpY2sgYW5kIHRp
cmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdtCnNpY2sgYW5kIHRpcmVk
IG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5IFB5dGhvbgqIPwMFAEQM
UlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk01pbAKCIjkzLOAmkZNm0
D8luT78c/1x45Q==
=a29i
-----END PGP MESSAGE-----
")
;; A plain signed message created using
;; echo abc | gpg --homedir . --passphrase-fd 0 -u Alpha -sa msg
(define msg_cols_asc "
-----BEGIN PGP MESSAGE-----
owGbwMvMwCSoW1RzPCOz3IRxLSN7EnNucboLT6Cgp0JJRmZeNpBMLFFIzMlRKMpM
zyjRBQtm5qUrFKTmF+SkKmTmgdQVKyTnl+aVFFUqJBalKhRnJmcrJOalcJVkFqWm
KOSnKSSlgrSU5OekQMzLL0rJzEsEKk9JTU7NK4EZBtKcBtRRWgAzlwtmbnlmSQbU
GJjxCmDj9RQUPNVzFZJTi0oSM/NyKhXy8kuAYk6lJSBxLlTF2NziqZCYq8elq+Cb
n1dSqRBQWZKRn8fVYc/MygAKBljYCDIFiTDMT+9seu836Q+bevyHTJ0dzPNuvCjn
ZpgrwX38z58rJsfYDhwOSS4SkN/d6vUAAA==
=s6sY
-----END PGP MESSAGE-----
")
;; A PGP 2 style message.
(define msg_sl_asc "
-----BEGIN PGP MESSAGE-----
iD8DBQBEDFJaLXJ8x2hpdzQRAkeCAKCZRBk2Pmx4w9h2LgosS0AppNNaWwCgiI5M
yzgJpGTZtA/Jbk+/HP9ceOWtAQdiA21zZ0QMUlpJIHRoaW5rIHRoYXQgYWxsIHJp
Z2h0LXRoaW5raW5nIHBlb3BsZSBpbiB0aGlzIGNvdW50cnkgYXJlIHNpY2sgYW5k
CnRpcmVkIG9mIGJlaW5nIHRvbGQgdGhhdCBvcmRpbmFyeSBkZWNlbnQgcGVvcGxl
IGFyZSBmZWQgdXAgaW4gdGhpcwpjb3VudHJ5IHdpdGggYmVpbmcgc2ljayBhbmQg
dGlyZWQuICBJJ20gY2VydGFpbmx5IG5vdC4gIEJ1dCBJJ20Kc2ljayBhbmQgdGly
ZWQgb2YgYmVpbmcgdG9sZCB0aGF0IEkgYW0uCi0gTW9udHkgUHl0aG9uCg==
=0ukK
-----END PGP MESSAGE-----
")
;; An OpenPGP message lacking the onepass packet. We used to accept
;; such messages but now consider them invalid.
(define bad_ls_asc "
-----BEGIN PGP MESSAGE-----
rQEHYgNtc2dEDFJaSSB0aGluayB0aGF0IGFsbCByaWdodC10aGlua2luZyBwZW9w
bGUgaW4gdGhpcyBjb3VudHJ5IGFyZSBzaWNrIGFuZAp0aXJlZCBvZiBiZWluZyB0
b2xkIHRoYXQgb3JkaW5hcnkgZGVjZW50IHBlb3BsZSBhcmUgZmVkIHVwIGluIHRo
aXMKY291bnRyeSB3aXRoIGJlaW5nIHNpY2sgYW5kIHRpcmVkLiAgSSdtIGNlcnRh
aW5seSBub3QuICBCdXQgSSdtCnNpY2sgYW5kIHRpcmVkIG9mIGJlaW5nIHRvbGQg
dGhhdCBJIGFtLgotIE1vbnR5IFB5dGhvbgqIPwMFAEQMUlotcnzHaGl3NBECR4IA
oJlEGTY+bHjD2HYuCixLQCmk01pbAKCIjkzLOAmkZNm0D8luT78c/1x45Q==
=Mpiu
-----END PGP MESSAGE-----
")
;; A signed message prefixed with an unsigned literal packet.
;; (fols = faked-literal-data, one-pass, literal-data, signature)
;; This should throw an error because running gpg to extract the
;; signed data will return both literal data packets
(define bad_fols_asc "
-----BEGIN PGP MESSAGE-----
rF1iDG1zZy51bnNpZ25lZEQMY0x0aW1lc2hhcmluZywgbjoKCUFuIGFjY2VzcyBt
ZXRob2Qgd2hlcmVieSBvbmUgY29tcHV0ZXIgYWJ1c2VzIG1hbnkgcGVvcGxlLgqQ
DQMAAhEtcnzHaGl3NAGtAQdiA21zZ0QMUlpJIHRoaW5rIHRoYXQgYWxsIHJpZ2h0
LXRoaW5raW5nIHBlb3BsZSBpbiB0aGlzIGNvdW50cnkgYXJlIHNpY2sgYW5kCnRp
cmVkIG9mIGJlaW5nIHRvbGQgdGhhdCBvcmRpbmFyeSBkZWNlbnQgcGVvcGxlIGFy
ZSBmZWQgdXAgaW4gdGhpcwpjb3VudHJ5IHdpdGggYmVpbmcgc2ljayBhbmQgdGly
ZWQuICBJJ20gY2VydGFpbmx5IG5vdC4gIEJ1dCBJJ20Kc2ljayBhbmQgdGlyZWQg
b2YgYmVpbmcgdG9sZCB0aGF0IEkgYW0uCi0gTW9udHkgUHl0aG9uCog/AwUARAxS
Wi1yfMdoaXc0EQJHggCgmUQZNj5seMPYdi4KLEtAKaTTWlsAoIiOTMs4CaRk2bQP
yW5Pvxz/XHjl
=UNM4
-----END PGP MESSAGE-----
")
;; A signed message suffixed with an unsigned literal packet.
;; (fols = faked-literal-data, one-pass, literal-data, signature)
;; This should throw an error because running gpg to extract the
;; signed data will return both literal data packets
(define bad_olsf_asc "
-----BEGIN PGP MESSAGE-----
kA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGluayB0aGF0IGFsbCByaWdo
dC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5IGFyZSBzaWNrIGFuZAp0
aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkgZGVjZW50IHBlb3BsZSBh
cmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJlaW5nIHNpY2sgYW5kIHRp
cmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdtCnNpY2sgYW5kIHRpcmVk
IG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5IFB5dGhvbgqIPwMFAEQM
UlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk01pbAKCIjkzLOAmkZNm0
D8luT78c/1x45axdYgxtc2cudW5zaWduZWREDGNMdGltZXNoYXJpbmcsIG46CglB
biBhY2Nlc3MgbWV0aG9kIHdoZXJlYnkgb25lIGNvbXB1dGVyIGFidXNlcyBtYW55
IHBlb3BsZS4K
=3gnG
-----END PGP MESSAGE-----
")
;; Two standard signed messages in a row
(define msg_olsols_asc_multiple "
-----BEGIN PGP MESSAGE-----
kA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGluayB0aGF0IGFsbCByaWdo
dC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5IGFyZSBzaWNrIGFuZAp0
aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkgZGVjZW50IHBlb3BsZSBh
cmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJlaW5nIHNpY2sgYW5kIHRp
cmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdtCnNpY2sgYW5kIHRpcmVk
IG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5IFB5dGhvbgqIPwMFAEQM
UlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk01pbAKCIjkzLOAmkZNm0
D8luT78c/1x45ZANAwACES1yfMdoaXc0Aa0BB2IDbXNnRAxSWkkgdGhpbmsgdGhh
dCBhbGwgcmlnaHQtdGhpbmtpbmcgcGVvcGxlIGluIHRoaXMgY291bnRyeSBhcmUg
c2ljayBhbmQKdGlyZWQgb2YgYmVpbmcgdG9sZCB0aGF0IG9yZGluYXJ5IGRlY2Vu
dCBwZW9wbGUgYXJlIGZlZCB1cCBpbiB0aGlzCmNvdW50cnkgd2l0aCBiZWluZyBz
aWNrIGFuZCB0aXJlZC4gIEknbSBjZXJ0YWlubHkgbm90LiAgQnV0IEknbQpzaWNr
IGFuZCB0aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgSSBhbS4KLSBNb250eSBQeXRo
b24KiD8DBQBEDFJaLXJ8x2hpdzQRAkeCAKCZRBk2Pmx4w9h2LgosS0AppNNaWwCg
iI5MyzgJpGTZtA/Jbk+/HP9ceOU=
=8nLN
-----END PGP MESSAGE-----
")
;; A standard message with two signatures (actually the same signature
;; duplicated).
(define msg_oolss_asc "
-----BEGIN PGP MESSAGE-----
kA0DAAIRLXJ8x2hpdzQBkA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGlu
ayB0aGF0IGFsbCByaWdodC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5
IGFyZSBzaWNrIGFuZAp0aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkg
ZGVjZW50IHBlb3BsZSBhcmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJl
aW5nIHNpY2sgYW5kIHRpcmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdt
CnNpY2sgYW5kIHRpcmVkIG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5
IFB5dGhvbgqIPwMFAEQMUlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk
01pbAKCIjkzLOAmkZNm0D8luT78c/1x45Yg/AwUARAxSWi1yfMdoaXc0EQJHggCg
mUQZNj5seMPYdi4KLEtAKaTTWlsAoIiOTMs4CaRk2bQPyW5Pvxz/XHjl
=KVw5
-----END PGP MESSAGE-----
")
;; A standard message with two one-pass packet but only one signature
;; packet
(define bad_ools_asc "
-----BEGIN PGP MESSAGE-----
kA0DAAIRLXJ8x2hpdzQBkA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGlu
ayB0aGF0IGFsbCByaWdodC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5
IGFyZSBzaWNrIGFuZAp0aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkg
ZGVjZW50IHBlb3BsZSBhcmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJl
aW5nIHNpY2sgYW5kIHRpcmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdt
CnNpY2sgYW5kIHRpcmVkIG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5
IFB5dGhvbgqIPwMFAEQMUlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk
01pbAKCIjkzLOAmkZNm0D8luT78c/1x45Q==
=1/ix
-----END PGP MESSAGE-----
")
;; Standard cleartext signature
(define msg_cls_asc "
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
I think that all right-thinking people in this country are sick and
tired of being told that ordinary decent people are fed up in this
country with being sick and tired. I'm certainly not. But I'm
sick and tired of being told that I am.
- - Monty Python
-----BEGIN PGP SIGNATURE-----
iD8DBQFEDVp1LXJ8x2hpdzQRAplUAKCMfpG3GPw/TLN52tosgXP5lNECkwCfQhAa
emmev7IuQjWYrGF9Lxj+zj8=
=qJsY
-----END PGP SIGNATURE-----
")
;; Cleartext signature with two signatures
(define msg_clss_asc "
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
What is the difference between a Turing machine and the modern computer?
It's the same as that between Hillary's ascent of Everest and the
establishment of a Hilton on its peak.
-----BEGIN PGP SIGNATURE-----
iD8DBQFEDVz6LXJ8x2hpdzQRAtkGAKCeMhNbHnh339fpjNj9owsYcC4zBwCfYO5l
2u+KEfXX0FKyk8SMzLjZ536IPwMFAUQNXPr+GAsdqeOwshEC2QYAoPOWAiQm0EF/
FWIAQUplk7JWbyRKAJ92ZJyJpWfzb0yc1s7MY65r2qEHrg==
=1Xvv
-----END PGP SIGNATURE-----
")
;; Two clear text signatures in a row
(define msg_clsclss_asc_multiple (string-append msg_cls_asc msg_clss_asc))
;; An Ed25519 cleartext message with an R parameter of only 247 bits
;; so that the code to re-insert the stripped zero byte kicks in. The
;; S parameter has 253 bits but that does not strip a full byte.
(define msg_ed25519_rshort "
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA256
Dear Emily:
I'm still confused as to what groups articles should be posted
to. How about an example?
-- Still Confused
Dear Still:
Ok. Let's say you want to report that Gretzky has been traded from
the Oilers to the Kings. Now right away you might think rec.sport.hockey
would be enough. WRONG. Many more people might be interested. This is a
big trade! Since it's a NEWS article, it belongs in the news.* hierarchy
as well. If you are a news admin, or there is one on your machine, try
news.admin. If not, use news.misc.
The Oilers are probably interested in geology, so try sci.physics.
He is a big star, so post to sci.astro, and sci.space because they are also
interested in stars. Next, his name is Polish sounding. So post to
soc.culture.polish. But that group doesn't exist, so cross-post to
news.groups suggesting it should be created. With this many groups of
interest, your article will be quite bizarre, so post to talk.bizarre as
well. (And post to comp.std.mumps, since they hardly get any articles
there, and a \"comp\" group will propagate your article further.)
You may also find it is more fun to post the article once in each
group. If you list all the newsgroups in the same article, some newsreaders
will only show the the article to the reader once! Don't tolerate this.
-- Emily Postnews Answers Your Questions on Netiquette
-----BEGIN PGP SIGNATURE-----
iJEEARYIADoWIQSyHeq0+HX7PaQvHR0TlWNoKgINCgUCV772DhwccGF0cmljZS5s
dW11bWJhQGV4YW1wbGUubmV0AAoJEBOVY2gqAg0KMAIA90EtUwAja0iJGpO91wyz
GLh9pS5v495V0r94yU6uUyUA/RT/StyPWe1wbnEZuacZnLbUV6Yy/aTXCVAlxf0r
TusO
=vQ3f
-----END PGP SIGNATURE-----
")
;; An Ed25519 cleartext message with an S parameter of only 248 bits
;; so that the code to re-insert the stripped zero byte kicks in.
(define msg_ed25519_sshort "
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA256
All articles that coruscate with resplendence are not truly auriferous.
-----BEGIN PGP SIGNATURE-----
iJEEARYIADoWIQSyHeq0+HX7PaQvHR0TlWNoKgINCgUCV771QhwccGF0cmljZS5s
dW11bWJhQGV4YW1wbGUubmV0AAoJEBOVY2gqAg0KHVEBAI66OPDYXKWO3r6SaFT+
uxmh8x4ZerW41vMA9gkJ4AEKAPjoe/Z7fDqo1lCptIFutFAGbfNxcm/53prfx2fT
GisM
=L7sk
-----END PGP SIGNATURE-----
")
;; Fixme: We need more tests with manipulated cleartext signatures.
;;
;; Now run the tests.
;;
(for-each-p
"Checking that a valid signature is verified as such"
(lambda (armored-file)
(pipe:do
(pipe:echo (eval armored-file (current-environment)))
(pipe:spawn `(,@GPG --verify))))
'(msg_ols_asc msg_cols_asc msg_sl_asc msg_oolss_asc msg_cls_asc msg_clss_asc))
(for-each-p
"Checking that a valid signature over multiple messages is verified as such"
(lambda (armored-file)
(pipe:do
(pipe:echo (eval armored-file (current-environment)))
(pipe:spawn `(,@GPG --verify --allow-multiple-messages)))
(catch '()
(pipe:do
(pipe:defer (lambda (sink)
(display armored-file (fdopen sink "w"))))
(pipe:spawn `(,@GPG --verify)))
- (error "verification succeeded but should not")))
+ (fail "verification succeeded but should not")))
'(msg_olsols_asc_multiple msg_clsclss_asc_multiple))
(for-each-p
"Checking that an invalid signature is verified as such"
(lambda (armored-file)
(catch '()
(pipe:do
(pipe:echo (eval armored-file (current-environment)))
(pipe:spawn `(,@GPG --verify)))
- (error "verification succeeded but should not")))
+ (fail "verification succeeded but should not")))
'(bad_ls_asc bad_fols_asc bad_olsf_asc bad_ools_asc))
;;; Need to import the ed25519 sample key used for
;;; the next two tests.
(call-check `(,@GPG --quiet --yes --import ,(in-srcdir key-file2)))
(for-each-p
"Checking that a valid Ed25519 signature is verified as such"
(lambda (armored-file)
(pipe:do
(pipe:echo (eval armored-file (current-environment)))
(pipe:spawn `(,@GPG --verify))))
'(msg_ed25519_rshort msg_ed25519_sshort))