1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
|
;;; 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 base16)
#: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 %binary-sample
;; Same message as %radix-64-sample, decoded into bytevector.
(base16-string->bytevector
"c838013b6d96c411efecef17ecefe3ca0004ce8979ea250a897995f979a9\
0ad9a9a9050a890ac5a9c945a940c1a2fcd2bc14858cd4a2547b2e00"))
(define %civodul-fingerprint
"3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5")
(define %civodul-key-id #x090B11993D9AEBB5) ;civodul.pub
#|
Test keys in ./tests/keys. They were generated in a container along these lines:
guix environment -CP --ad-hoc gnupg pinentry coreutils
then, within the container:
mkdir ~/.gnupg && chmod -R og-rwx ~/.gnupg
gpg --batch --passphrase '' --quick-gen-key '<example@example.com>' ed25519
gpg --armor --export example@example.com
gpg --armor --export-secret-key example@example.com
# echo pinentry-program ~/.guix-profile/bin/pinentry-curses > ~/.gnupg/gpg-agent.conf
or similar.
|#
(define %rsa-key-id #xAE25DA2A70DEED59) ;rsa.pub
(define %dsa-key-id #x587918047BE8BD2C) ;dsa.pub
(define %ed25519-key-id #x771F49CBFAAE072D) ;ed25519.pub
(define %rsa-key-fingerprint
(base16-string->bytevector
(string-downcase "385F86CFC86B665A5C165E6BAE25DA2A70DEED59")))
(define %dsa-key-fingerprint
(base16-string->bytevector
(string-downcase "2884A980422330A4F33DD97F587918047BE8BD2C")))
(define %ed25519-key-fingerprint
(base16-string->bytevector
(string-downcase "44D31E21AF7138F9B632280A771F49CBFAAE072D")))
;;; 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-----")
(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 "port-ascii-armored?, #t"
(call-with-input-string %radix-64-sample port-ascii-armored?))
(test-assert "port-ascii-armored?, #f"
(not (port-ascii-armored? (open-bytevector-input-port %binary-sample))))
(test-assert "get-openpgp-keyring"
(let* ((key (search-path %load-path "tests/keys/civodul.pub"))
(keyring (get-openpgp-keyring
(open-bytevector-input-port
(call-with-input-file key read-radix-64)))))
(let-values (((primary packets)
(lookup-key-by-id keyring %civodul-key-id)))
(let ((fingerprint (openpgp-public-key-fingerprint primary)))
(and (= (openpgp-public-key-id primary) %civodul-key-id)
(not (openpgp-public-key-subkey? primary))
(string=? (openpgp-format-fingerprint fingerprint)
%civodul-fingerprint)
(string=? (openpgp-user-id-value (find openpgp-user-id? packets))
"Ludovic Courtès <ludo@gnu.org>")
(eq? (lookup-key-by-fingerprint keyring fingerprint)
primary))))))
(test-equal "get-openpgp-detached-signature/ascii"
(list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256)
`(,%rsa-key-id ,%rsa-key-fingerprint rsa sha256)
`(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha256)
`(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha512)
`(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha1))
(map (lambda (str)
(let ((signature (get-openpgp-detached-signature/ascii
(open-input-string str))))
(list (openpgp-signature-issuer-key-id signature)
(openpgp-signature-issuer-fingerprint 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-fingerprint)
(let* ((keyring (get-openpgp-keyring (%make-void-port "r")))
(signature (string->openpgp-packet %hello-signature/rsa)))
(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 (string->openpgp-packet signature)))
(let-values (((status key)
(verify-openpgp-signature signature keyring
(open-input-string "Hello!\n"))))
(list status (openpgp-public-key-id key)))))
(list "tests/keys/rsa.pub" "tests/keys/dsa.pub"
"tests/keys/ed25519.pub"
"tests/keys/ed25519.pub"
"tests/keys/ed25519.pub")
(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/keys/rsa.pub" "tests/keys/dsa.pub"
"tests/keys/ed25519.pub" "tests/keys/ed25519.pub"
"tests/keys/ed25519.pub"))))
(map (lambda (signature)
(let ((signature (string->openpgp-packet signature)))
(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")
|
