;;; 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</td></tr></table>
<table class='tabs'><tr><td>
<a class='active' href='/guix/about/'>about</a><a href='/guix/'>summary</a><a href='/guix/refs/?id=704128d4ed316140eede55c492d2fa3b6d7a63a0'>refs</a><a href='/guix/log/'>log</a><a href='/guix/tree/?id=704128d4ed316140eede55c492d2fa3b6d7a63a0'>tree</a><a href='/guix/commit/?id=704128d4ed316140eede55c492d2fa3b6d7a63a0'>commit</a><a href='/guix/diff/?id=704128d4ed316140eede55c492d2fa3b6d7a63a0'>diff</a></td><td class='form'><form class='right' method='get' action='/guix/log/'>
<input type='hidden' name='id' value='704128d4ed316140eede55c492d2fa3b6d7a63a0'/><select name='qt'>
<option value='grep'>log msg</option>
<option value='author'>author</option>
<option value='committer'>committer</option>
<option value='range'>range</option>
</select>
<input class='txt' type='search' size='10' name='q' value=''/>
<input type='submit' value='search'/>
</form>
</td></tr></table>
<div class='content'><div id='summary'><pre>
# This is a &quot;service unit file&quot; for the systemd init system to launch
# &apos;guix-daemon&apos;.  Drop it in /etc/systemd/system or similar to have
# &apos;guix-daemon&apos; automatically started.

[Unit]
Description=Build daemon for GNU Guix

[Service]
ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon \
    --build-users-group=guixbuild --discover=no \
    --substitute-urls=&apos;@GUIX_SUBSTITUTE_URLS@&apos;
Environment=&apos;GUIX_LOCPATH=@localstatedir@/guix/profiles/per-user/root/guix-profile/lib/locale&apos; LC_ALL=en_US.utf8
StandardOutput=journal
StandardError=journal

# Work around a nasty systemd ‘feature’ that kills the entire process tree
# (including the daemon!) if any child, such as cc1plus, runs out of memory.
OOMPolicy=continue

# Despite the name, this is rate-limited: a broken daemon will eventually fail.
Restart=always

# See &lt;https://lists.gnu.org/archive/html/guix-devel/2016-04/msg00608.html&gt;.
# Some package builds (for example, go@1.8.1) may require even more than
# 1024 tasks.
TasksMax=8192

[Install]
WantedBy=multi-user.target
</pre>
</div></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
F+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 "port-ascii-armored?, #t"
  (call-with-input-string %radix-64-sample port-ascii-armored?))

(test-assert "port-ascii-armored?, #f"
  (not (port-ascii-armored? (open-bytevector-input-port %binary-sample))))

(test-assert "get-openpgp-keyring"
  (let* ((key (search-path %load-path "tests/keys/civodul.pub"))
         (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/keys/rsa.pub" "tests/keys/dsa.pub"
             "tests/keys/ed25519.pub"
             "tests/keys/ed25519.pub"
             "tests/keys/ed25519.pub")
       (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/keys/rsa.pub" "tests/keys/dsa.pub"
                         "tests/keys/ed25519.pub" "tests/keys/ed25519.pub"
                         "tests/keys/ed25519.pub"))))
    (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")