| 1 | |
| 2 | |
| 3 | |
| 4 | |
| 5 | |
| 6 | |
| 7 | |
| 8 | |
| 9 | |
| 10 | |
| 11 | |
| 12 | |
| 13 | |
| 14 | |
| 15 | |
| 16 | |
| 17 | |
| 18 |
|
| 19 | (define-module (tests-openpgp)
|
| 20 | #:use-module (guix openpgp)
|
| 21 | #:use-module (gcrypt base16)
|
| 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-64)
|
| 29 | #:use-module (srfi srfi-71))
|
| 30 |
|
| 31 | (define %radix-64-sample
|
| 32 | |
| 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 | |
| 44 | "\
|
| 45 | -----BEGIN PGP MESSAGE-----
|
| 46 |
|
| 47 | yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS
|
| 48 | vBSFjNSiVHsuAA==
|
| 49 | =AAAA
|
| 50 | -----END PGP MESSAGE-----\n")
|
| 51 |
|
| 52 | (define %binary-sample
|
| 53 | |
| 54 | (base16-string->bytevector
|
| 55 | "c838013b6d96c411efecef17ecefe3ca0004ce8979ea250a897995f979a9\
|
| 56 | 0ad9a9a9050a890ac5a9c945a940c1a2fcd2bc14858cd4a2547b2e00"))
|
| 57 |
|
| 58 | (define %civodul-fingerprint
|
| 59 | "3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5")
|
| 60 |
|
| 61 | (define %civodul-key-id #x090B11993D9AEBB5) |
| 62 |
|
| 63 | |
| 64 | Test keys in ./tests/keys. They were generated in a container along these lines:
|
| 65 | guix environment -CP --ad-hoc gnupg pinentry coreutils
|
| 66 | then, within the container:
|
| 67 | mkdir ~/.gnupg && chmod -R og-rwx ~/.gnupg
|
| 68 | gpg --batch --passphrase '' --quick-gen-key '<[email protected]>' ed25519
|
| 69 | gpg --armor --export [email protected]
|
| 70 | gpg --armor --export-secret-key [email protected]
|
| 71 | # echo pinentry-program ~/.guix-profile/bin/pinentry-curses > ~/.gnupg/gpg-agent.conf
|
| 72 | or similar.
|
| 73 |
|
| 74 | (define %rsa-key-id #xAE25DA2A70DEED59) |
| 75 | (define %dsa-key-id #x587918047BE8BD2C) |
| 76 | (define %ed25519-key-id #x771F49CBFAAE072D) |
| 77 |
|
| 78 | (define %rsa-key-fingerprint
|
| 79 | (base16-string->bytevector
|
| 80 | (string-downcase "385F86CFC86B665A5C165E6BAE25DA2A70DEED59")))
|
| 81 | (define %dsa-key-fingerprint
|
| 82 | (base16-string->bytevector
|
| 83 | (string-downcase "2884A980422330A4F33DD97F587918047BE8BD2C")))
|
| 84 | (define %ed25519-key-fingerprint
|
| 85 | (base16-string->bytevector
|
| 86 | (string-downcase "44D31E21AF7138F9B632280A771F49CBFAAE072D")))
|
| 87 |
|
| 88 |
|
| 89 | |
| 90 | |
| 91 | |
| 92 |
|
| 93 | (define %hello-signature/rsa
|
| 94 | |
| 95 | "\
|
| 96 | -----BEGIN PGP SIGNATURE-----
|
| 97 |
|
| 98 | iQEzBAABCAAdFiEEOF+Gz8hrZlpcFl5rriXaKnDe7VkFAl4SRF0ACgkQriXaKnDe
|
| 99 | 7VlIyQf/TU5rGUK42/C1ULoWvvm25Mjwh6xxoPPkuBxvos8bE6yKr/vJZePU3aSE
|
| 100 | mjbVFcO7DioxHMqLd49j803bUtdllJVU18ex9MkKbKjapkgEGkJsuTTzqyONprgk
|
| 101 | 7xtZGBWuxkP1M6hJICJkA3Ys+sTdKalux/pzr5OWAe+gxytTF/vr/EyJzdmBxbJv
|
| 102 | /fhd1SeVIXSw4c5gf2Wcvcgfy4N5CiLaUb7j4646KBTvDvmUMcDZ+vmKqC/XdQeQ
|
| 103 | PrjArGKt40ErVd98fwvNHZnw7VQMx0A3nL3joL5g7/RckDOUb4mqKoqLsLd0wPHP
|
| 104 | y32DiDUY9s3sy5OMzX4Y49em8vxvlg==
|
| 105 | =ASEm
|
| 106 | -----END PGP SIGNATURE-----")
|
| 107 |
|
| 108 |
|
| 109 | (define %hello-signature/dsa
|
| 110 | "\
|
| 111 | -----BEGIN PGP SIGNATURE-----
|
| 112 |
|
| 113 | iHUEABEIAB0WIQQohKmAQiMwpPM92X9YeRgEe+i9LAUCXhJFpQAKCRBYeRgEe+i9
|
| 114 | LDAaAQC0lXPQepvZBANAUtRLMZuOwL9NQPkfhIwUXtLEBBzyFQD/So8DcybXpRBi
|
| 115 | JKOiyAQQjMs/GJ6qMEQpRAhyyJRAock=
|
| 116 | =iAEc
|
| 117 | -----END PGP SIGNATURE-----")
|
| 118 |
|
| 119 |
|
| 120 | (define %hello-signature/ed25519/sha256 |
| 121 | "\
|
| 122 | -----BEGIN PGP SIGNATURE-----
|
| 123 |
|
| 124 | iHUEABYIAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRADAAKCRB3H0nL+q4H
|
| 125 | LUImAP9/foaSjPFC/MSr52LNV5ROSL9haea4jPpUP+N6ViFGowEA+AE/xpXPIqsz
|
| 126 | R6CdxMevURuqUpqQ7rHeiMmdUepeewU=
|
| 127 | =tLXy
|
| 128 | -----END PGP SIGNATURE-----")
|
| 129 |
|
| 130 | (define %hello-signature/ed25519/sha512 |
| 131 | "\
|
| 132 | -----BEGIN PGP SIGNATURE-----
|
| 133 |
|
| 134 | iHUEABYKAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRAGgAKCRB3H0nL+q4H
|
| 135 | LTeKAP0S8LiiosJXOARlYNdhfGw9j26lHrbwJh5CORGlaqqIJAEAoMYcmtNa2b6O
|
| 136 | inlEwB/KQM88O9RwA8xH7X5a0rodOw4=
|
| 137 | =68r/
|
| 138 | -----END PGP SIGNATURE-----")
|
| 139 |
|
| 140 | (define %hello-signature/ed25519/sha1 |
| 141 | "\
|
| 142 | -----BEGIN PGP SIGNATURE-----
|
| 143 |
|
| 144 | iHUEABYCAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRALQAKCRB3H0nL+q4H
|
| 145 | LdhEAQCfkdYhIVRa43oTNw9EL/TDFGQjXSHNRFVU0ktjkWbkQwEAjIXhvj2sqy79
|
| 146 | Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
|
| 147 | =AE4G
|
| 148 | -----END PGP SIGNATURE-----")
|
| 149 |
|
| 150 | (define %short-hello-signature/ed25519/sha512 |
| 151 | |
| 152 | |
| 153 | "\
|
| 154 | -----BEGIN PGP SIGNATURE-----
|
| 155 |
|
| 156 | iLUEABYKAF8WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCapd8RxsUgAAAAAAEAA5t
|
| 157 | YW51MiwyLjUrMS4xMiwyLDIlFIAAAAAAFwAFcmVwcm9kdWNlckBndWl4LmludmFs
|
| 158 | aWQxMjA4MgAKCRB3H0nL+q4HLQe5AQCCMx+0Vdp+A85KVcMnfsy4SQG66XN6MPom
|
| 159 | CMNP2EAK9ADwt+637LJ7W2tILiBnaYLncs9n6D7qoXWHMgyWzZsE
|
| 160 | =9a6K
|
| 161 | -----END PGP SIGNATURE-----")
|
| 162 |
|
| 163 |
|
| 164 | (test-begin "openpgp")
|
| 165 |
|
| 166 | (test-equal "read-radix-64"
|
| 167 | '(#t "PGP MESSAGE")
|
| 168 | (let ((data type (call-with-input-string %radix-64-sample read-radix-64)))
|
| 169 | (list (bytevector? data) type)))
|
| 170 |
|
| 171 | (test-equal "read-radix-64, CRC mismatch"
|
| 172 | '(#f "PGP MESSAGE")
|
| 173 | (call-with-values
|
| 174 | (lambda ()
|
| 175 | (call-with-input-string %radix-64-sample/crc-mismatch
|
| 176 | read-radix-64))
|
| 177 | list))
|
| 178 |
|
| 179 | (test-assert "port-ascii-armored?, #t"
|
| 180 | (call-with-input-string %radix-64-sample port-ascii-armored?))
|
| 181 |
|
| 182 | (test-assert "port-ascii-armored?, #f"
|
| 183 | (not (port-ascii-armored? (open-bytevector-input-port %binary-sample))))
|
| 184 |
|
| 185 | (test-assert "get-openpgp-keyring"
|
| 186 | (let* ((key (search-path %load-path "tests/keys/openpgp/civodul.pub"))
|
| 187 | (keyring (get-openpgp-keyring
|
| 188 | (open-bytevector-input-port
|
| 189 | (call-with-input-file key read-radix-64))))
|
| 190 | (primary packets (lookup-key-by-id keyring %civodul-key-id))
|
| 191 | (fingerprint (openpgp-public-key-fingerprint primary)))
|
| 192 | (and (= (openpgp-public-key-id primary) %civodul-key-id)
|
| 193 | (not (openpgp-public-key-subkey? primary))
|
| 194 | (string=? (openpgp-format-fingerprint fingerprint)
|
| 195 | %civodul-fingerprint)
|
| 196 | (string=? (openpgp-user-id-value (find openpgp-user-id? packets))
|
| 197 | "Ludovic Courtès <[email protected]>")
|
| 198 | (eq? primary (lookup-key-by-fingerprint keyring fingerprint)))))
|
| 199 |
|
| 200 | (test-equal "get-openpgp-detached-signature/ascii"
|
| 201 | (list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256)
|
| 202 | `(,%rsa-key-id ,%rsa-key-fingerprint rsa sha256)
|
| 203 | `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha256)
|
| 204 | `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha512)
|
| 205 | `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha1))
|
| 206 | (map (lambda (str)
|
| 207 | (let ((signature (get-openpgp-detached-signature/ascii
|
| 208 | (open-input-string str))))
|
| 209 | (list (openpgp-signature-issuer-key-id signature)
|
| 210 | (openpgp-signature-issuer-fingerprint signature)
|
| 211 | (openpgp-signature-public-key-algorithm signature)
|
| 212 | (openpgp-signature-hash-algorithm signature))))
|
| 213 | (list %hello-signature/dsa
|
| 214 | %hello-signature/rsa
|
| 215 | %hello-signature/ed25519/sha256
|
| 216 | %hello-signature/ed25519/sha512
|
| 217 | %hello-signature/ed25519/sha1)))
|
| 218 |
|
| 219 | (test-equal "verify-openpgp-signature, missing key"
|
| 220 | `(missing-key ,%rsa-key-fingerprint)
|
| 221 | (let* ((keyring (get-openpgp-keyring (%make-void-port "r")))
|
| 222 | (signature (string->openpgp-packet %hello-signature/rsa))
|
| 223 | (port (open-input-string "Hello!\n"))
|
| 224 | (status key (verify-openpgp-signature signature keyring port)))
|
| 225 | (list status key)))
|
| 226 |
|
| 227 | (test-equal "verify-openpgp-signature, good signatures"
|
| 228 | `((good-signature ,%rsa-key-id)
|
| 229 | (good-signature ,%dsa-key-id)
|
| 230 | (good-signature ,%ed25519-key-id)
|
| 231 | (good-signature ,%ed25519-key-id)
|
| 232 | (good-signature ,%ed25519-key-id)
|
| 233 | (good-signature ,%ed25519-key-id))
|
| 234 | (map (lambda (key signature)
|
| 235 | (let* ((key (search-path %load-path key))
|
| 236 | (keyring (get-openpgp-keyring
|
| 237 | (open-bytevector-input-port
|
| 238 | (call-with-input-file key read-radix-64))))
|
| 239 | (signature (string->openpgp-packet signature))
|
| 240 | (port (open-input-string "Hello!\n"))
|
| 241 | (status key (verify-openpgp-signature signature keyring port)))
|
| 242 | (list status (openpgp-public-key-id key))))
|
| 243 | (list "tests/keys/openpgp/rsa.pub"
|
| 244 | "tests/keys/openpgp/dsa.pub"
|
| 245 | "tests/keys/openpgp/ed25519.pub"
|
| 246 | "tests/keys/openpgp/ed25519.pub"
|
| 247 | "tests/keys/openpgp/ed25519.pub"
|
| 248 | "tests/keys/openpgp/ed25519.pub")
|
| 249 | (list %hello-signature/rsa
|
| 250 | %hello-signature/dsa
|
| 251 | %hello-signature/ed25519/sha256
|
| 252 | %hello-signature/ed25519/sha512
|
| 253 | %hello-signature/ed25519/sha1
|
| 254 | %short-hello-signature/ed25519/sha512)))
|
| 255 |
|
| 256 | (test-equal "verify-openpgp-signature, bad signature"
|
| 257 | `((bad-signature ,%rsa-key-id)
|
| 258 | (bad-signature ,%dsa-key-id)
|
| 259 | (bad-signature ,%ed25519-key-id)
|
| 260 | (bad-signature ,%ed25519-key-id)
|
| 261 | (bad-signature ,%ed25519-key-id))
|
| 262 | (let ((keyring (fold (lambda (key keyring)
|
| 263 | (let ((key (search-path %load-path key)))
|
| 264 | (get-openpgp-keyring
|
| 265 | (open-bytevector-input-port
|
| 266 | (call-with-input-file key read-radix-64))
|
| 267 | keyring)))
|
| 268 | %empty-keyring
|
| 269 | '("tests/keys/openpgp/rsa.pub"
|
| 270 | "tests/keys/openpgp/dsa.pub"
|
| 271 | "tests/keys/openpgp/ed25519.pub"
|
| 272 | "tests/keys/openpgp/ed25519.pub"
|
| 273 | "tests/keys/openpgp/ed25519.pub"))))
|
| 274 | (map
|
| 275 | (lambda (signature)
|
| 276 | (let* ((signature (string->openpgp-packet signature))
|
| 277 | (port (open-input-string "What?!"))
|
| 278 | (status key (verify-openpgp-signature signature keyring port)))
|
| 279 | (list status (openpgp-public-key-id key))))
|
| 280 | (list %hello-signature/rsa
|
| 281 | %hello-signature/dsa
|
| 282 | %hello-signature/ed25519/sha256
|
| 283 | %hello-signature/ed25519/sha512
|
| 284 | %hello-signature/ed25519/sha1))))
|
| 285 |
|
| 286 | (test-end "openpgp")
|