me
/
guix
Archived
1
0
Fork 0
Code

Add (guix openpgp). 

* guix/openpgp.scm, tests/openpgp.scm, tests/civodul.key,
tests/dsa.key, tests/ed25519.key, tests/rsa.key,
tests/ed25519.sec: New files.
* Makefile.am (MODULES): Add guix/openpgp.scm.
(SCM_TESTS): Add tests/openpgp.scm.
(EXTRA_DIST): Add tests/*.key and tests/ed25519.sec.
master
Ludovic Courtès 2020-01-02 00:03:58 +01:00
parent c91e27c608
commit 43408e304f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
8 changed files with 2685 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Makefile.am
View File

@ -70,6 +70,7 @@ MODULES = \
guix/docker.scm \
guix/json.scm \
guix/records.scm \
guix/openpgp.scm \
guix/pki.scm \
guix/progress.scm \
guix/combinators.scm \
@ -414,6 +415,7 @@ SCM_TESTS = \
tests/nar.scm \
tests/networking.scm \
tests/opam.scm \
tests/openpgp.scm \
tests/packages.scm \
tests/pack.scm \
tests/pki.scm \
@ -564,6 +566,11 @@ EXTRA_DIST += \
tests/signing-key.pub \
tests/signing-key.sec \
tests/cve-sample.json \
tests/civodul.key \
tests/rsa.key \
tests/dsa.key \
tests/ed25519.key \
tests/ed25519.sec \
build-aux/config.rpath \
bootstrap \
doc/build.scm \

1022
guix/openpgp.scm 100644
View File

File diff suppressed because it is too large Load Diff

1345
tests/civodul.key 100644
View File

File diff suppressed because it is too large Load Diff

25
tests/dsa.key 100644
View File

@ -0,0 +1,25 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
mQMuBF4SQfARCACb/C7qcwKhOdaej1z8dK02iMJlw/C868VEeAuSvXHBE5OULm1+
SlwPCgsLIhe8AIsW0F8zgWlNdOKbcmU1NdzUfo0PIRA8ASerZ3EFd7cloRjk1X3c
XbklFQ8D37thgFXYBOkkjzKwCvc+ebcQQsRSvJLhQODSRzknIQBYLoYjKh8skEwY
uK+rFs7fEHTrCwnriF7QCZnGqoScS56MrgEtHHwBDpKt8CruSekEHAfI5INMhb6R
fdVNTj7TL9gCOlYA6IPK6pfYKjghQ79IGMcGnaEPUdiEuAbc1AVQtfRi4e/IbbN6
/CDmfSQ/fCYm9hQ5sAMzUCqDreqqYrpEYmVHAQC3uXiV7qjDe2vlfz4GNSFOqvHC
xHp9UYWE6IQFzVutMwgAgldl3Ql6zxIoiU76bXRDP+W+g67uW1Fnd6ltOVYb4rxp
wIRlQpwZeNPzFeZHZ1mJA1rvdD3mORnnnIIwW9Cr5Kn/e63PBJJcYJZZ6bnWYh5O
1MDzyn0CYu4btP0tj7PNxKfxvIxDX3sqfkBFsGgquwa/AwWrdWXD99//PK0iNGN4
WewwXmC2S2SmcuHL0nB4eV6uuQZOK6u3/end1/FqAMEJAW4jC7x7UvbeFs1dwiJv
psjluTpP1QDh7ySDfBOANlxOxAM6oCfvUqZ+pifNFw7t3p1eiK3wtjB8fer7bZg3
OT4Pl4gImmCjXs0cse0+FLpUA/gzPHxYR/rUyD/nQwf8CfFRGu+bGFju3YHbZ2T0
cHF/9c3sCdQU7nVnYleySnv1OMDSYoZ7geqgC2q0pnHeezII7hcJB8tKx3BV+J7A
WYUL31K4gybK9VkFQC8h+BzPjnzjXEHgL5GY621cPSLJzOyFhY9lKrWUD/DVGXtu
xFjissXG2h6jgf+BAqDCKFVYyu/7TQuDA/FKPhx/8Hn9LX4A3CTFswnsRtABGt6t
U4yUfQWhnDqLDYWrjvXOEHbMQuBOAU3rPpTLLyQzyKVsQZlMBR5UrSXXY1lN76yl
J0NAyeOmgvDT75QAVHPxp9lidRTQJHXU1Ah+N/fzPYamKmgheCXZE8r5cPY3Mkvp
w7QbPGx1ZG8rdGVzdC1kc2FAY2hib3VpYi5vcmc+iJYEExEIAD4WIQQohKmAQiMw
pPM92X9YeRgEe+i9LAUCXhJB8AIbAwUJA8JnAAULCQgHAgYVCgkICwIEFgIDAQIe
AQIXgAAKCRBYeRgEe+i9LOyvAP0a2DIMruGZSHeWcQaNiRWb2/UEq4ClRw67rA7f
39sD5AD+PKeovYJkTSV+F00QKHibMhoGurxABnEUeqmetGITVSU=
=YZip
-----END PGP PUBLIC KEY BLOCK-----

10
tests/ed25519.key 100644
View File

@ -0,0 +1,10 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
mDMEXqNaoBYJKwYBBAHaRw8BAQdArviKtelb4g0I3zx9xyDS40Oz8i1/LRXqppG6
b23Hdim0KEVkIFR3by1GaWZ0eSA8bHVkbyt0ZXN0LWVjY0BjaGJvdWliLm9yZz6I
lgQTFggAPhYhBETTHiGvcTj5tjIoCncfScv6rgctBQJeo1qgAhsDBQkDwmcABQsJ
CAcCBhUKCQgLAgQWAgMBAh4BAheAAAoJEHcfScv6rgctq4MA/1R9G0roEwrHwmTd
DHxt211eLqupwXE0Z7xY2FH6DHk9AP4owEefBU7jQprSAzBS+c6gdS3SCCKKqAh6
ToZ4LmbKAw==
=FXMK
-----END PGP PUBLIC KEY BLOCK-----

10
tests/ed25519.sec 100644
View File

@ -0,0 +1,10 @@
-----BEGIN PGP PRIVATE KEY BLOCK-----
lFgEXqNaoBYJKwYBBAHaRw8BAQdArviKtelb4g0I3zx9xyDS40Oz8i1/LRXqppG6
b23HdikAAQDGgjcUcvqR+nGYcf5UHzy9xlO/dBZX4f9QV1ILDIGt0hAYtChFZCBU
d28tRmlmdHkgPGx1ZG8rdGVzdC1lY2NAY2hib3VpYi5vcmc+iJYEExYIAD4WIQRE
0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqNaoAIbAwUJA8JnAAULCQgHAgYVCgkICwIE
FgIDAQIeAQIXgAAKCRB3H0nL+q4HLauDAP9UfRtK6BMKx8Jk3Qx8bdtdXi6rqcFx
NGe8WNhR+gx5PQD+KMBHnwVO40Ka0gMwUvnOoHUt0ggiiqgIek6GeC5mygM=
=VjjI
-----END PGP PRIVATE KEY BLOCK-----

248
tests/openpgp.scm 100644
View File

@ -0,0 +1,248 @@
;;; 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 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
;;; 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)))))
(match (lookup-key-by-id keyring %civodul-key-id)
(((? openpgp-public-key? primary) packets ...)
(and (= (openpgp-public-key-id primary) %civodul-key-id)
(not (openpgp-public-key-subkey? primary))
(string=? (openpgp-format-fingerprint
(openpgp-public-key-fingerprint primary))
%civodul-fingerprint)
(string=? (openpgp-user-id-value (find openpgp-user-id? packets))
"Ludovic Courtès <ludo@gnu.org>"))))))
(test-equal "get-openpgp-detached-signature/ascii"
(list `(,%dsa-key-id dsa sha256)
`(,%rsa-key-id rsa sha256)
`(,%ed25519-key-id eddsa sha256)
`(,%ed25519-key-id eddsa sha512)
`(,%ed25519-key-id eddsa sha1))
(map (lambda (str)
(let ((signature (get-openpgp-detached-signature/ascii
(open-input-string str))))
(list (openpgp-signature-issuer 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-id)
(let* ((keyring (get-openpgp-keyring (%make-void-port "r")))
(signature (get-openpgp-packet
(open-bytevector-input-port
(call-with-input-string %hello-signature/rsa
read-radix-64)))))
(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 (get-openpgp-packet
(open-bytevector-input-port
(call-with-input-string signature
read-radix-64)))))
(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 (get-openpgp-packet
(open-bytevector-input-port
(call-with-input-string signature
read-radix-64)))))
(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")

18
tests/rsa.key 100644
View File

@ -0,0 +1,18 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
mQENBF4SRCYBCAC6eVyonmey9Lsa1QpWIcumkExZWmAsTNhNNrdhasU4rC0DGRnw
lJtey4h/5NRcGmur4cwwnHUyh9RhQOZgc4MkWfUECfgY98dhjq6+wSavSMwYJyKM
7yGuJgKQBBhdkfjYONP4eHbucifGNhsNRSURUREVCarOYa1AhmH4cmTPe7cUA8mH
EfQ2SOsmAUBNjn/Ba2Us8ydiZWGpJXYdzsXQ3HZl1vV2UtPEepPjAkJZa/7hm06z
9WrlOUxoro/R2R7COMWpzuhmY1Ak2VB4H6OMqPAEOk+/H5Pda1yCI9oRROawC24h
4yZYTpcRKV0EQ4cd4Z/DKA4gJdjufyRrmk0fABEBAAG0GzxsdWRvK3Rlc3QtcnNh
QGNoYm91aWIub3JnPokBVAQTAQgAPhYhBDhfhs/Ia2ZaXBZea64l2ipw3u1ZBQJe
EkQmAhsDBQkDwmcABQsJCAcCBhUKCQgLAgQWAgMBAh4BAheAAAoJEK4l2ipw3u1Z
c70IAI+eBLJzXGXNlugNE5rl5YplrLQem9otL7OKIpR+ye3Wg/DRZvN9x+lvUftq
rG0+wqxo/WQTy6ZLDUI83OY13zLXDKjRgPdqPYBAYxCY8CMayjDUv8axZVEfC7IX
IYgqzZg0E0dfF3m9S+6WUfOYCS5qR2go7TxbrnDyhDiswd5r3TRX5U+asHm0iXTy
Pmb0WY301mm1UPToOHSpweMuCw/n5as15o9CWeUJa/I0J6puM66ZRqGt8+7BSCu6
ata0BYLBCUD8aqhgNQpcMAkTRUSr8LNgfgdxr2Ozr+FF39NXGfLihL18AQEvh3SI
K/5YAnXV2oMRhOQttDJROOXByoY=
=N6XF
-----END PGP PUBLIC KEY BLOCK-----