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