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