me
/
guix
Archived
1
0
Fork 0
This repository has been archived on 2024-08-07. You can view files and clone it, but cannot push or open issues/pull-requests.
guix/tests/openpgp.scm

254 lines
9.6 KiB
Scheme
Raw Blame History

This file contains invisible Unicode characters!

This file contains invisible Unicode characters that may be processed differently from what appears below. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to reveal hidden characters.

;;; 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 %civodul-fingerprint
"3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5")
(define %civodul-key-id #x090B11993D9AEBB5) ;civodul.key
;; Test keys. They were generated in a container along these lines:
;; guix environment -CP --ad-hoc gnupg pinentry
;; then, within the container:
;; mkdir ~/.gnupg
;; echo pinentry-program ~/.guix-profile/bin/pinentry-tty > ~/.gnupg/gpg-agent.conf
;; gpg --quick-gen-key '<ludo+test-rsa@chbouib.org>' rsa
;; or similar.
(define %rsa-key-id #xAE25DA2A70DEED59) ;rsa.key
(define %dsa-key-id #x587918047BE8BD2C) ;dsa.key
(define %ed25519-key-id #x771F49CBFAAE072D) ;ed25519.key
(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 "get-openpgp-keyring"
(let* ((key (search-path %load-path "tests/civodul.key"))
(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/rsa.key" "tests/dsa.key"
"tests/ed25519.key" "tests/ed25519.key" "tests/ed25519.key")
(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/rsa.key" "tests/dsa.key"
"tests/ed25519.key" "tests/ed25519.key"
"tests/ed25519.key"))))
(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")