tests/openpgp.scm

   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")