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) | |
4459c785 | 21 | #:use-module (gcrypt base16) |
43408e30 LC |
22 | #:use-module (gcrypt hash) |
23 | #:use-module (gcrypt pk-crypto) | |
24 | #:use-module (ice-9 binary-ports) | |
25 | #:use-module (ice-9 match) | |
26 | #:use-module (rnrs bytevectors) | |
27 | #:use-module (srfi srfi-1) | |
28 | #:use-module (srfi srfi-11) | |
29 | #:use-module (srfi srfi-64) | |
30 | #:use-module (srfi srfi-71)) | |
31 | ||
32 | (define %radix-64-sample | |
33 | ;; Example of Radix-64 encoding from Section 6.6 of RFC4880. | |
34 | "\ | |
35 | -----BEGIN PGP MESSAGE----- | |
36 | Version: OpenPrivacy 0.99 | |
37 | ||
38 | yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS | |
39 | vBSFjNSiVHsuAA== | |
40 | =njUN | |
41 | -----END PGP MESSAGE-----\n") | |
42 | ||
43 | (define %radix-64-sample/crc-mismatch | |
44 | ;; This time with a wrong CRC24 value. | |
45 | "\ | |
46 | -----BEGIN PGP MESSAGE----- | |
47 | ||
48 | yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS | |
49 | vBSFjNSiVHsuAA== | |
50 | =AAAA | |
51 | -----END PGP MESSAGE-----\n") | |
52 | ||
680b80e3 LDB |
53 | (define %binary-sample |
54 | ;; Same message as %radix-64-sample, decoded into bytevector. | |
55 | (base16-string->bytevector | |
56 | "c838013b6d96c411efecef17ecefe3ca0004ce8979ea250a897995f979a9\ | |
57 | 0ad9a9a9050a890ac5a9c945a940c1a2fcd2bc14858cd4a2547b2e00")) | |
58 | ||
43408e30 LC |
59 | (define %civodul-fingerprint |
60 | "3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5") | |
61 | ||
62 | (define %civodul-key-id #x090B11993D9AEBB5) ;civodul.key | |
63 | ||
64 | ;; Test keys. They were generated in a container along these lines: | |
65 | ;; guix environment -CP --ad-hoc gnupg pinentry | |
66 | ;; then, within the container: | |
67 | ;; mkdir ~/.gnupg | |
68 | ;; echo pinentry-program ~/.guix-profile/bin/pinentry-tty > ~/.gnupg/gpg-agent.conf | |
69 | ;; gpg --quick-gen-key '<ludo+test-rsa@chbouib.org>' rsa | |
70 | ;; or similar. | |
71 | (define %rsa-key-id #xAE25DA2A70DEED59) ;rsa.key | |
72 | (define %dsa-key-id #x587918047BE8BD2C) ;dsa.key | |
73 | (define %ed25519-key-id #x771F49CBFAAE072D) ;ed25519.key | |
74 | ||
4459c785 LC |
75 | (define %rsa-key-fingerprint |
76 | (base16-string->bytevector | |
77 | (string-downcase "385F86CFC86B665A5C165E6BAE25DA2A70DEED59"))) | |
78 | (define %dsa-key-fingerprint | |
79 | (base16-string->bytevector | |
80 | (string-downcase "2884A980422330A4F33DD97F587918047BE8BD2C"))) | |
81 | (define %ed25519-key-fingerprint | |
82 | (base16-string->bytevector | |
83 | (string-downcase "44D31E21AF7138F9B632280A771F49CBFAAE072D"))) | |
84 | ||
43408e30 LC |
85 | \f |
86 | ;;; The following are detached signatures created commands like: | |
87 | ;;; echo 'Hello!' | gpg -sba --digest-algo sha512 | |
88 | ;;; They are detached (no PACKET-ONE-PASS-SIGNATURE) and uncompressed. | |
89 | ||
90 | (define %hello-signature/rsa | |
91 | ;; Signature of the ASCII string "Hello!\n". | |
92 | "\ | |
93 | -----BEGIN PGP SIGNATURE----- | |
94 | ||
95 | iQEzBAABCAAdFiEEOF+Gz8hrZlpcFl5rriXaKnDe7VkFAl4SRF0ACgkQriXaKnDe | |
96 | 7VlIyQf/TU5rGUK42/C1ULoWvvm25Mjwh6xxoPPkuBxvos8bE6yKr/vJZePU3aSE | |
97 | mjbVFcO7DioxHMqLd49j803bUtdllJVU18ex9MkKbKjapkgEGkJsuTTzqyONprgk | |
98 | 7xtZGBWuxkP1M6hJICJkA3Ys+sTdKalux/pzr5OWAe+gxytTF/vr/EyJzdmBxbJv | |
99 | /fhd1SeVIXSw4c5gf2Wcvcgfy4N5CiLaUb7j4646KBTvDvmUMcDZ+vmKqC/XdQeQ | |
100 | PrjArGKt40ErVd98fwvNHZnw7VQMx0A3nL3joL5g7/RckDOUb4mqKoqLsLd0wPHP | |
101 | y32DiDUY9s3sy5OMzX4Y49em8vxvlg== | |
102 | =ASEm | |
103 | -----END PGP SIGNATURE-----") | |
104 | ||
105 | ||
106 | (define %hello-signature/dsa | |
107 | "\ | |
108 | -----BEGIN PGP SIGNATURE----- | |
109 | ||
110 | iHUEABEIAB0WIQQohKmAQiMwpPM92X9YeRgEe+i9LAUCXhJFpQAKCRBYeRgEe+i9 | |
111 | LDAaAQC0lXPQepvZBANAUtRLMZuOwL9NQPkfhIwUXtLEBBzyFQD/So8DcybXpRBi | |
112 | JKOiyAQQjMs/GJ6qMEQpRAhyyJRAock= | |
113 | =iAEc | |
114 | -----END PGP SIGNATURE-----") | |
115 | ||
116 | ||
117 | (define %hello-signature/ed25519/sha256 ;digest-algo: sha256 | |
118 | "\ | |
119 | -----BEGIN PGP SIGNATURE----- | |
120 | ||
121 | iHUEABYIAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRADAAKCRB3H0nL+q4H | |
122 | LUImAP9/foaSjPFC/MSr52LNV5ROSL9haea4jPpUP+N6ViFGowEA+AE/xpXPIqsz | |
123 | R6CdxMevURuqUpqQ7rHeiMmdUepeewU= | |
124 | =tLXy | |
125 | -----END PGP SIGNATURE-----") | |
126 | ||
127 | (define %hello-signature/ed25519/sha512 ;digest-algo: sha512 | |
128 | "\ | |
129 | -----BEGIN PGP SIGNATURE----- | |
130 | ||
131 | iHUEABYKAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRAGgAKCRB3H0nL+q4H | |
132 | LTeKAP0S8LiiosJXOARlYNdhfGw9j26lHrbwJh5CORGlaqqIJAEAoMYcmtNa2b6O | |
133 | inlEwB/KQM88O9RwA8xH7X5a0rodOw4= | |
134 | =68r/ | |
135 | -----END PGP SIGNATURE-----") | |
136 | ||
137 | (define %hello-signature/ed25519/sha1 ;digest-algo: sha1 | |
138 | "\ | |
139 | -----BEGIN PGP SIGNATURE----- | |
140 | ||
141 | iHUEABYCAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRALQAKCRB3H0nL+q4H | |
142 | LdhEAQCfkdYhIVRa43oTNw9EL/TDFGQjXSHNRFVU0ktjkWbkQwEAjIXhvj2sqy79 | |
143 | Pz7oopeN72xgggYUNT37ezqN3MeCqw0= | |
144 | =AE4G | |
145 | -----END PGP SIGNATURE-----") | |
146 | ||
147 | \f | |
148 | (test-begin "openpgp") | |
149 | ||
150 | (test-equal "read-radix-64" | |
151 | '(#t "PGP MESSAGE") | |
152 | (let-values (((data type) | |
153 | (call-with-input-string %radix-64-sample read-radix-64))) | |
154 | (list (bytevector? data) type))) | |
155 | ||
156 | (test-equal "read-radix-64, CRC mismatch" | |
157 | '(#f "PGP MESSAGE") | |
158 | (call-with-values | |
159 | (lambda () | |
160 | (call-with-input-string %radix-64-sample/crc-mismatch | |
161 | read-radix-64)) | |
162 | list)) | |
163 | ||
680b80e3 LDB |
164 | (test-assert "port-ascii-armored?, #t" |
165 | (call-with-input-string %radix-64-sample port-ascii-armored?)) | |
166 | ||
167 | (test-assert "port-ascii-armored?, #f" | |
168 | (not (port-ascii-armored? (open-bytevector-input-port %binary-sample)))) | |
169 | ||
43408e30 LC |
170 | (test-assert "get-openpgp-keyring" |
171 | (let* ((key (search-path %load-path "tests/civodul.key")) | |
172 | (keyring (get-openpgp-keyring | |
173 | (open-bytevector-input-port | |
174 | (call-with-input-file key read-radix-64))))) | |
bd812655 LC |
175 | (let-values (((primary packets) |
176 | (lookup-key-by-id keyring %civodul-key-id))) | |
177 | (let ((fingerprint (openpgp-public-key-fingerprint primary))) | |
178 | (and (= (openpgp-public-key-id primary) %civodul-key-id) | |
179 | (not (openpgp-public-key-subkey? primary)) | |
180 | (string=? (openpgp-format-fingerprint fingerprint) | |
181 | %civodul-fingerprint) | |
182 | (string=? (openpgp-user-id-value (find openpgp-user-id? packets)) | |
183 | "Ludovic Courtès <ludo@gnu.org>") | |
184 | (eq? (lookup-key-by-fingerprint keyring fingerprint) | |
185 | primary)))))) | |
43408e30 LC |
186 | |
187 | (test-equal "get-openpgp-detached-signature/ascii" | |
4459c785 LC |
188 | (list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256) |
189 | `(,%rsa-key-id ,%rsa-key-fingerprint rsa sha256) | |
190 | `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha256) | |
191 | `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha512) | |
192 | `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha1)) | |
43408e30 LC |
193 | (map (lambda (str) |
194 | (let ((signature (get-openpgp-detached-signature/ascii | |
195 | (open-input-string str)))) | |
7b2b3a13 | 196 | (list (openpgp-signature-issuer-key-id signature) |
4459c785 | 197 | (openpgp-signature-issuer-fingerprint signature) |
43408e30 LC |
198 | (openpgp-signature-public-key-algorithm signature) |
199 | (openpgp-signature-hash-algorithm signature)))) | |
200 | (list %hello-signature/dsa | |
201 | %hello-signature/rsa | |
202 | %hello-signature/ed25519/sha256 | |
203 | %hello-signature/ed25519/sha512 | |
204 | %hello-signature/ed25519/sha1))) | |
205 | ||
206 | (test-equal "verify-openpgp-signature, missing key" | |
b45fa0a1 | 207 | `(missing-key ,%rsa-key-fingerprint) |
43408e30 | 208 | (let* ((keyring (get-openpgp-keyring (%make-void-port "r"))) |
b835e158 | 209 | (signature (string->openpgp-packet %hello-signature/rsa))) |
43408e30 LC |
210 | (let-values (((status key) |
211 | (verify-openpgp-signature signature keyring | |
212 | (open-input-string "Hello!\n")))) | |
213 | (list status key)))) | |
214 | ||
215 | (test-equal "verify-openpgp-signature, good signatures" | |
216 | `((good-signature ,%rsa-key-id) | |
217 | (good-signature ,%dsa-key-id) | |
218 | (good-signature ,%ed25519-key-id) | |
219 | (good-signature ,%ed25519-key-id) | |
220 | (good-signature ,%ed25519-key-id)) | |
221 | (map (lambda (key signature) | |
222 | (let* ((key (search-path %load-path key)) | |
223 | (keyring (get-openpgp-keyring | |
224 | (open-bytevector-input-port | |
225 | (call-with-input-file key read-radix-64)))) | |
b835e158 | 226 | (signature (string->openpgp-packet signature))) |
43408e30 LC |
227 | (let-values (((status key) |
228 | (verify-openpgp-signature signature keyring | |
229 | (open-input-string "Hello!\n")))) | |
230 | (list status (openpgp-public-key-id key))))) | |
231 | (list "tests/rsa.key" "tests/dsa.key" | |
232 | "tests/ed25519.key" "tests/ed25519.key" "tests/ed25519.key") | |
233 | (list %hello-signature/rsa %hello-signature/dsa | |
234 | %hello-signature/ed25519/sha256 | |
235 | %hello-signature/ed25519/sha512 | |
236 | %hello-signature/ed25519/sha1))) | |
237 | ||
238 | (test-equal "verify-openpgp-signature, bad signature" | |
239 | `((bad-signature ,%rsa-key-id) | |
240 | (bad-signature ,%dsa-key-id) | |
241 | (bad-signature ,%ed25519-key-id) | |
242 | (bad-signature ,%ed25519-key-id) | |
243 | (bad-signature ,%ed25519-key-id)) | |
244 | (let ((keyring (fold (lambda (key keyring) | |
245 | (let ((key (search-path %load-path key))) | |
246 | (get-openpgp-keyring | |
247 | (open-bytevector-input-port | |
248 | (call-with-input-file key read-radix-64)) | |
249 | keyring))) | |
250 | %empty-keyring | |
251 | '("tests/rsa.key" "tests/dsa.key" | |
252 | "tests/ed25519.key" "tests/ed25519.key" | |
253 | "tests/ed25519.key")))) | |
254 | (map (lambda (signature) | |
b835e158 | 255 | (let ((signature (string->openpgp-packet signature))) |
43408e30 LC |
256 | (let-values (((status key) |
257 | (verify-openpgp-signature signature keyring | |
258 | (open-input-string "What?!")))) | |
259 | (list status (openpgp-public-key-id key))))) | |
260 | (list %hello-signature/rsa %hello-signature/dsa | |
261 | %hello-signature/ed25519/sha256 | |
262 | %hello-signature/ed25519/sha512 | |
263 | %hello-signature/ed25519/sha1)))) | |
264 | ||
265 | (test-end "openpgp") |