[jackhill/guix/guix.git] / tests / openpgp.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (tests-openpgp)
  #:use-module (guix openpgp)
  #:use-module (gcrypt hash)
  #:use-module (gcrypt pk-crypto)
  #:use-module (ice-9 binary-ports)
  #:use-module (ice-9 match)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-64)
  #:use-module (srfi srfi-71))

(define %radix-64-sample
  ;; Example of Radix-64 encoding from Section 6.6 of RFC4880.
  "\
-----BEGIN PGP MESSAGE-----
Version: OpenPrivacy 0.99

yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS
vBSFjNSiVHsuAA==
=njUN
-----END PGP MESSAGE-----\n")

(define %radix-64-sample/crc-mismatch
  ;; This time with a wrong CRC24 value.
  "\
-----BEGIN PGP MESSAGE-----

yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS
vBSFjNSiVHsuAA==
=AAAA
-----END PGP MESSAGE-----\n")

(define %civodul-fingerprint
  "3CE4 6455 8A84 FDC6 9DB4  0CFB 090B 1199 3D9A EBB5")

(define %civodul-key-id #x090B11993D9AEBB5)       ;civodul.key

;; Test keys.  They were generated in a container along these lines:
;;    guix environment -CP --ad-hoc gnupg pinentry
;; then, within the container:
;;    mkdir ~/.gnupg
;;    echo pinentry-program ~/.guix-profile/bin/pinentry-tty > ~/.gnupg/gpg-agent.conf
;;    gpg --quick-gen-key '<ludo+test-rsa@chbouib.org>' rsa
;; or similar.
(define %rsa-key-id      #xAE25DA2A70DEED59)      ;rsa.key
(define %dsa-key-id      #x587918047BE8BD2C)      ;dsa.key
(define %ed25519-key-id  #x771F49CBFAAE072D)      ;ed25519.key

\f
;;; The following are detached signatures created commands like:
;;;    echo 'Hello!' | gpg -sba --digest-algo sha512
;;; They are detached (no PACKET-ONE-PASS-SIGNATURE) and uncompressed.

(define %hello-signature/rsa
  ;; Signature of the ASCII string "Hello!\n".
  "\
-----BEGIN PGP SIGNATURE-----

iQEzBAABCAAdFiEEOF+Gz8hrZlpcFl5rriXaKnDe7VkFAl4SRF0ACgkQriXaKnDe
7VlIyQf/TU5rGUK42/C1ULoWvvm25Mjwh6xxoPPkuBxvos8bE6yKr/vJZePU3aSE
mjbVFcO7DioxHMqLd49j803bUtdllJVU18ex9MkKbKjapkgEGkJsuTTzqyONprgk
7xtZGBWuxkP1M6hJICJkA3Ys+sTdKalux/pzr5OWAe+gxytTF/vr/EyJzdmBxbJv
/fhd1SeVIXSw4c5gf2Wcvcgfy4N5CiLaUb7j4646KBTvDvmUMcDZ+vmKqC/XdQeQ
PrjArGKt40ErVd98fwvNHZnw7VQMx0A3nL3joL5g7/RckDOUb4mqKoqLsLd0wPHP
y32DiDUY9s3sy5OMzX4Y49em8vxvlg==
=ASEm
-----END PGP SIGNATURE-----")


(define %hello-signature/dsa
  "\
-----BEGIN PGP SIGNATURE-----

iHUEABEIAB0WIQQohKmAQiMwpPM92X9YeRgEe+i9LAUCXhJFpQAKCRBYeRgEe+i9
LDAaAQC0lXPQepvZBANAUtRLMZuOwL9NQPkfhIwUXtLEBBzyFQD/So8DcybXpRBi
JKOiyAQQjMs/GJ6qMEQpRAhyyJRAock=
=iAEc
-----END PGP SIGNATURE-----")


(define %hello-signature/ed25519/sha256           ;digest-algo: sha256
  "\
-----BEGIN PGP SIGNATURE-----

iHUEABYIAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRADAAKCRB3H0nL+q4H
LUImAP9/foaSjPFC/MSr52LNV5ROSL9haea4jPpUP+N6ViFGowEA+AE/xpXPIqsz
R6CdxMevURuqUpqQ7rHeiMmdUepeewU=
=tLXy
-----END PGP SIGNATURE-----")

(define %hello-signature/ed25519/sha512           ;digest-algo: sha512
  "\
-----BEGIN PGP SIGNATURE-----

iHUEABYKAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRAGgAKCRB3H0nL+q4H
LTeKAP0S8LiiosJXOARlYNdhfGw9j26lHrbwJh5CORGlaqqIJAEAoMYcmtNa2b6O
inlEwB/KQM88O9RwA8xH7X5a0rodOw4=
=68r/
-----END PGP SIGNATURE-----")

(define %hello-signature/ed25519/sha1             ;digest-algo: sha1
  "\
-----BEGIN PGP SIGNATURE-----

iHUEABYCAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRALQAKCRB3H0nL+q4H
LdhEAQCfkdYhIVRa43oTNw9EL/TDFGQjXSHNRFVU0ktjkWbkQwEAjIXhvj2sqy79
Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
=AE4G
-----END PGP SIGNATURE-----")

\f
(test-begin "openpgp")

(test-equal "read-radix-64"
  '(#t "PGP MESSAGE")
  (let-values (((data type)
                (call-with-input-string %radix-64-sample read-radix-64)))
    (list (bytevector? data) type)))

(test-equal "read-radix-64, CRC mismatch"
  '(#f "PGP MESSAGE")
  (call-with-values
      (lambda ()
        (call-with-input-string %radix-64-sample/crc-mismatch
          read-radix-64))
    list))

(test-assert "get-openpgp-keyring"
  (let* ((key (search-path %load-path "tests/civodul.key"))
         (keyring (get-openpgp-keyring
                   (open-bytevector-input-port
                    (call-with-input-file key read-radix-64)))))
    (match (lookup-key-by-id keyring %civodul-key-id)
      (((? openpgp-public-key? primary) packets ...)
       (and (= (openpgp-public-key-id primary) %civodul-key-id)
            (not (openpgp-public-key-subkey? primary))
            (string=? (openpgp-format-fingerprint
                       (openpgp-public-key-fingerprint primary))
                      %civodul-fingerprint)
            (string=? (openpgp-user-id-value (find openpgp-user-id? packets))
                      "Ludovic Courtès <ludo@gnu.org>"))))))

(test-equal "get-openpgp-detached-signature/ascii"
  (list `(,%dsa-key-id dsa sha256)
        `(,%rsa-key-id rsa sha256)
        `(,%ed25519-key-id eddsa sha256)
        `(,%ed25519-key-id eddsa sha512)
        `(,%ed25519-key-id eddsa sha1))
  (map (lambda (str)
         (let ((signature (get-openpgp-detached-signature/ascii
                           (open-input-string str))))
           (list (openpgp-signature-issuer signature)
                 (openpgp-signature-public-key-algorithm signature)
                 (openpgp-signature-hash-algorithm signature))))
       (list %hello-signature/dsa
             %hello-signature/rsa
             %hello-signature/ed25519/sha256
             %hello-signature/ed25519/sha512
             %hello-signature/ed25519/sha1)))

(test-equal "verify-openpgp-signature, missing key"
  `(missing-key ,%rsa-key-id)
  (let* ((keyring   (get-openpgp-keyring (%make-void-port "r")))
         (signature (get-openpgp-packet
                     (open-bytevector-input-port
                      (call-with-input-string %hello-signature/rsa
                        read-radix-64)))))
    (let-values (((status key)
                  (verify-openpgp-signature signature keyring
                                            (open-input-string "Hello!\n"))))
      (list status key))))

(test-equal "verify-openpgp-signature, good signatures"
  `((good-signature ,%rsa-key-id)
    (good-signature ,%dsa-key-id)
    (good-signature ,%ed25519-key-id)
    (good-signature ,%ed25519-key-id)
    (good-signature ,%ed25519-key-id))
  (map (lambda (key signature)
         (let* ((key       (search-path %load-path key))
                (keyring   (get-openpgp-keyring
                            (open-bytevector-input-port
                             (call-with-input-file key read-radix-64))))
                (signature (get-openpgp-packet
                            (open-bytevector-input-port
                             (call-with-input-string signature
                               read-radix-64)))))
           (let-values (((status key)
                         (verify-openpgp-signature signature keyring
                                                   (open-input-string "Hello!\n"))))
             (list status (openpgp-public-key-id key)))))
       (list "tests/rsa.key" "tests/dsa.key"
             "tests/ed25519.key" "tests/ed25519.key" "tests/ed25519.key")
       (list %hello-signature/rsa %hello-signature/dsa
             %hello-signature/ed25519/sha256
             %hello-signature/ed25519/sha512
             %hello-signature/ed25519/sha1)))

(test-equal "verify-openpgp-signature, bad signature"
  `((bad-signature ,%rsa-key-id)
    (bad-signature ,%dsa-key-id)
    (bad-signature ,%ed25519-key-id)
    (bad-signature ,%ed25519-key-id)
    (bad-signature ,%ed25519-key-id))
  (let ((keyring (fold (lambda (key keyring)
                         (let ((key (search-path %load-path key)))
                           (get-openpgp-keyring
                            (open-bytevector-input-port
                             (call-with-input-file key read-radix-64))
                            keyring)))
                       %empty-keyring
                       '("tests/rsa.key" "tests/dsa.key"
                         "tests/ed25519.key" "tests/ed25519.key"
                         "tests/ed25519.key"))))
    (map (lambda (signature)
           (let ((signature (get-openpgp-packet
                             (open-bytevector-input-port
                              (call-with-input-string signature
                                read-radix-64)))))
             (let-values (((status key)
                           (verify-openpgp-signature signature keyring
                                                     (open-input-string "What?!"))))
               (list status (openpgp-public-key-id key)))))
         (list %hello-signature/rsa %hello-signature/dsa
               %hello-signature/ed25519/sha256
               %hello-signature/ed25519/sha512
               %hello-signature/ed25519/sha1))))

(test-end "openpgp")
Commit	Line	Data
43408e30 LC	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19	(define-module (tests-openpgp)
	20	#:use-module (guix openpgp)
	21	#:use-module (gcrypt hash)
	22	#:use-module (gcrypt pk-crypto)
	23	#:use-module (ice-9 binary-ports)
	24	#:use-module (ice-9 match)
	25	#:use-module (rnrs bytevectors)
	26	#:use-module (srfi srfi-1)
	27	#:use-module (srfi srfi-11)
	28	#:use-module (srfi srfi-64)
	29	#:use-module (srfi srfi-71))
	30
	31	(define %radix-64-sample
	32	;; Example of Radix-64 encoding from Section 6.6 of RFC4880.
	33	"\
	34	-----BEGIN PGP MESSAGE-----
	35	Version: OpenPrivacy 0.99
	36
	37	yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS
	38	vBSFjNSiVHsuAA==
	39	=njUN
	40	-----END PGP MESSAGE-----\n")
	41
	42	(define %radix-64-sample/crc-mismatch
	43	;; This time with a wrong CRC24 value.
	44	"\
	45	-----BEGIN PGP MESSAGE-----
	46
	47	yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS
	48	vBSFjNSiVHsuAA==
	49	=AAAA
	50	-----END PGP MESSAGE-----\n")
	51
	52	(define %civodul-fingerprint
	53	"3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5")
	54
	55	(define %civodul-key-id #x090B11993D9AEBB5) ;civodul.key
	56
	57	;; Test keys. They were generated in a container along these lines:
	58	;; guix environment -CP --ad-hoc gnupg pinentry
	59	;; then, within the container:
	60	;; mkdir ~/.gnupg
	61	;; echo pinentry-program ~/.guix-profile/bin/pinentry-tty > ~/.gnupg/gpg-agent.conf
	62	;; gpg --quick-gen-key '<ludo+test-rsa@chbouib.org>' rsa
	63	;; or similar.
	64	(define %rsa-key-id #xAE25DA2A70DEED59) ;rsa.key
65	(define %dsa-key-id #x587918047BE8BD2C) ;dsa.key
66	(define %ed25519-key-id #x771F49CBFAAE072D) ;ed25519.key
67
68	\f
69	;;; The following are detached signatures created commands like:
70	;;; echo 'Hello!' \| gpg -sba --digest-algo sha512
71	;;; They are detached (no PACKET-ONE-PASS-SIGNATURE) and uncompressed.
72
73	(define %hello-signature/rsa
74	;; Signature of the ASCII string "Hello!\n".
75	"\
76	-----BEGIN PGP SIGNATURE-----
77
78	iQEzBAABCAAdFiEEOF+Gz8hrZlpcFl5rriXaKnDe7VkFAl4SRF0ACgkQriXaKnDe
79	7VlIyQf/TU5rGUK42/C1ULoWvvm25Mjwh6xxoPPkuBxvos8bE6yKr/vJZePU3aSE
80	mjbVFcO7DioxHMqLd49j803bUtdllJVU18ex9MkKbKjapkgEGkJsuTTzqyONprgk
81	7xtZGBWuxkP1M6hJICJkA3Ys+sTdKalux/pzr5OWAe+gxytTF/vr/EyJzdmBxbJv
82	/fhd1SeVIXSw4c5gf2Wcvcgfy4N5CiLaUb7j4646KBTvDvmUMcDZ+vmKqC/XdQeQ
83	PrjArGKt40ErVd98fwvNHZnw7VQMx0A3nL3joL5g7/RckDOUb4mqKoqLsLd0wPHP
84	y32DiDUY9s3sy5OMzX4Y49em8vxvlg==
85	=ASEm
86	-----END PGP SIGNATURE-----")
87
88
89	(define %hello-signature/dsa
90	"\
91	-----BEGIN PGP SIGNATURE-----
92
93	iHUEABEIAB0WIQQohKmAQiMwpPM92X9YeRgEe+i9LAUCXhJFpQAKCRBYeRgEe+i9
94	LDAaAQC0lXPQepvZBANAUtRLMZuOwL9NQPkfhIwUXtLEBBzyFQD/So8DcybXpRBi
95	JKOiyAQQjMs/GJ6qMEQpRAhyyJRAock=
96	=iAEc
97	-----END PGP SIGNATURE-----")
98
99
100	(define %hello-signature/ed25519/sha256 ;digest-algo: sha256
101	"\
102	-----BEGIN PGP SIGNATURE-----
103
104	iHUEABYIAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRADAAKCRB3H0nL+q4H
105	LUImAP9/foaSjPFC/MSr52LNV5ROSL9haea4jPpUP+N6ViFGowEA+AE/xpXPIqsz
106	R6CdxMevURuqUpqQ7rHeiMmdUepeewU=
107	=tLXy
108	-----END PGP SIGNATURE-----")
109
110	(define %hello-signature/ed25519/sha512 ;digest-algo: sha512
111	"\
112	-----BEGIN PGP SIGNATURE-----
113
114	iHUEABYKAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRAGgAKCRB3H0nL+q4H
115	LTeKAP0S8LiiosJXOARlYNdhfGw9j26lHrbwJh5CORGlaqqIJAEAoMYcmtNa2b6O
116	inlEwB/KQM88O9RwA8xH7X5a0rodOw4=
117	=68r/
118	-----END PGP SIGNATURE-----")
119
120	(define %hello-signature/ed25519/sha1 ;digest-algo: sha1
121	"\
122	-----BEGIN PGP SIGNATURE-----
123
124	iHUEABYCAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRALQAKCRB3H0nL+q4H
125	LdhEAQCfkdYhIVRa43oTNw9EL/TDFGQjXSHNRFVU0ktjkWbkQwEAjIXhvj2sqy79
126	Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
127	=AE4G
128	-----END PGP SIGNATURE-----")
129
130	\f
131	(test-begin "openpgp")
132
133	(test-equal "read-radix-64"
134	'(#t "PGP MESSAGE")
135	(let-values (((data type)
136	(call-with-input-string %radix-64-sample read-radix-64)))
137	(list (bytevector? data) type)))
138
139	(test-equal "read-radix-64, CRC mismatch"
140	'(#f "PGP MESSAGE")
141	(call-with-values
142	(lambda ()
143	(call-with-input-string %radix-64-sample/crc-mismatch
144	read-radix-64))
145	list))
146
147	(test-assert "get-openpgp-keyring"
148	(let* ((key (search-path %load-path "tests/civodul.key"))
149	(keyring (get-openpgp-keyring
150	(open-bytevector-input-port
151	(call-with-input-file key read-radix-64)))))
152	(match (lookup-key-by-id keyring %civodul-key-id)
153	(((? openpgp-public-key? primary) packets ...)
154	(and (= (openpgp-public-key-id primary) %civodul-key-id)
155	(not (openpgp-public-key-subkey? primary))
156	(string=? (openpgp-format-fingerprint
157	(openpgp-public-key-fingerprint primary))
158	%civodul-fingerprint)
159	(string=? (openpgp-user-id-value (find openpgp-user-id? packets))
160	"Ludovic Courtès <ludo@gnu.org>"))))))
161
162	(test-equal "get-openpgp-detached-signature/ascii"
163	(list `(,%dsa-key-id dsa sha256)
164	`(,%rsa-key-id rsa sha256)
165	`(,%ed25519-key-id eddsa sha256)
166	`(,%ed25519-key-id eddsa sha512)
167	`(,%ed25519-key-id eddsa sha1))
168	(map (lambda (str)
169	(let ((signature (get-openpgp-detached-signature/ascii
170	(open-input-string str))))
171	(list (openpgp-signature-issuer signature)
172	(openpgp-signature-public-key-algorithm signature)
173	(openpgp-signature-hash-algorithm signature))))
174	(list %hello-signature/dsa
175	%hello-signature/rsa
176	%hello-signature/ed25519/sha256
177	%hello-signature/ed25519/sha512
178	%hello-signature/ed25519/sha1)))
179
180	(test-equal "verify-openpgp-signature, missing key"
181	`(missing-key ,%rsa-key-id)
182	(let* ((keyring (get-openpgp-keyring (%make-void-port "r")))
183	(signature (get-openpgp-packet
184	(open-bytevector-input-port
185	(call-with-input-string %hello-signature/rsa
186	read-radix-64)))))
187	(let-values (((status key)
188	(verify-openpgp-signature signature keyring
189	(open-input-string "Hello!\n"))))
190	(list status key))))
191
192	(test-equal "verify-openpgp-signature, good signatures"
193	`((good-signature ,%rsa-key-id)
194	(good-signature ,%dsa-key-id)
195	(good-signature ,%ed25519-key-id)
196	(good-signature ,%ed25519-key-id)
197	(good-signature ,%ed25519-key-id))
198	(map (lambda (key signature)
199	(let* ((key (search-path %load-path key))
200	(keyring (get-openpgp-keyring
201	(open-bytevector-input-port
202	(call-with-input-file key read-radix-64))))
203	(signature (get-openpgp-packet
204	(open-bytevector-input-port
205	(call-with-input-string signature
206	read-radix-64)))))
207	(let-values (((status key)
208	(verify-openpgp-signature signature keyring
209	(open-input-string "Hello!\n"))))
210	(list status (openpgp-public-key-id key)))))
211	(list "tests/rsa.key" "tests/dsa.key"
212	"tests/ed25519.key" "tests/ed25519.key" "tests/ed25519.key")
213	(list %hello-signature/rsa %hello-signature/dsa
214	%hello-signature/ed25519/sha256
215	%hello-signature/ed25519/sha512
216	%hello-signature/ed25519/sha1)))
217
218	(test-equal "verify-openpgp-signature, bad signature"
219	`((bad-signature ,%rsa-key-id)
220	(bad-signature ,%dsa-key-id)
221	(bad-signature ,%ed25519-key-id)
222	(bad-signature ,%ed25519-key-id)
223	(bad-signature ,%ed25519-key-id))
224	(let ((keyring (fold (lambda (key keyring)
225	(let ((key (search-path %load-path key)))
226	(get-openpgp-keyring
227	(open-bytevector-input-port
228	(call-with-input-file key read-radix-64))
229	keyring)))
230	%empty-keyring
231	'("tests/rsa.key" "tests/dsa.key"
232	"tests/ed25519.key" "tests/ed25519.key"
233	"tests/ed25519.key"))))
234	(map (lambda (signature)
235	(let ((signature (get-openpgp-packet
236	(open-bytevector-input-port
237	(call-with-input-string signature
238	read-radix-64)))))
239	(let-values (((status key)
240	(verify-openpgp-signature signature keyring
241	(open-input-string "What?!"))))
242	(list status (openpgp-public-key-id key)))))
243	(list %hello-signature/rsa %hello-signature/dsa
244	%hello-signature/ed25519/sha256
245	%hello-signature/ed25519/sha512
246	%hello-signature/ed25519/sha1))))
247
248	(test-end "openpgp")