guix/scripts/authenticate.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 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 (guix scripts authenticate)
  20   #:use-module (guix scripts)
  21   #:use-module (guix base16)
  22   #:use-module (gcrypt pk-crypto)
  23   #:use-module (guix pki)
  24   #:use-module (guix ui)
  25   #:use-module (ice-9 binary-ports)
  26   #:use-module (ice-9 rdelim)
  27   #:use-module (ice-9 match)
  28   #:export (guix-authenticate))
  29
  30 ;;; Commentary:
  31 ;;;
  32 ;;; This program is used internally by the daemon to sign exported archive
  33 ;;; (the 'export-paths' RPC), and to authenticate imported archives (the
  34 ;;; 'import-paths' RPC.)
  35 ;;;
  36 ;;; Code:
  37
  38 (define read-canonical-sexp
  39   ;; Read a gcrypt sexp from a port and return it.
  40   (compose string->canonical-sexp read-string))
  41
  42 (define (sign-with-key key-file sha256)
  43   "Sign the hash SHA256 (a bytevector) with KEY-FILE, and write an sexp that
  44 includes both the hash and the actual signature."
  45   (let* ((secret-key (call-with-input-file key-file read-canonical-sexp))
  46          (public-key (if (string-suffix? ".sec" key-file)
  47                          (call-with-input-file
  48                              (string-append (string-drop-right key-file 4)
  49                                             ".pub")
  50                            read-canonical-sexp)
  51                          (leave
  52                           (G_ "cannot find public key for secret key '~a'~%")
  53                           key-file)))
  54          (data       (bytevector->hash-data sha256
  55                                             #:key-type (key-type public-key)))
  56          (signature  (signature-sexp data secret-key public-key)))
  57     (display (canonical-sexp->string signature))
  58     #t))
  59
  60 (define (validate-signature signature)
  61   "Validate SIGNATURE, a canonical sexp.  Check whether its public key is
  62 authorized, verify the signature, and print the signed data to stdout upon
  63 success."
  64   (let* ((subject (signature-subject signature))
  65          (data    (signature-signed-data signature)))
  66     (if (and data subject)
  67         (if (authorized-key? subject)
  68             (if (valid-signature? signature)
  69                 (let ((hash (hash-data->bytevector data)))
  70                   (display (bytevector->base16-string hash))
  71                   #t)                              ; success
  72                 (leave (G_ "error: invalid signature: ~a~%")
  73                        (canonical-sexp->string signature)))
  74             (leave (G_ "error: unauthorized public key: ~a~%")
  75                    (canonical-sexp->string subject)))
  76         (leave (G_ "error: corrupt signature data: ~a~%")
  77                (canonical-sexp->string signature)))))
  78
  79 \f
  80 ;;;
  81 ;;; Entry point.
  82 ;;;
  83
  84 (define-command (guix-authenticate . args)
  85   (category internal)
  86   (synopsis "sign or verify signatures on normalized archives (nars)")
  87
  88   ;; Signature sexps written to stdout may contain binary data, so force
  89   ;; ISO-8859-1 encoding so that things are not mangled.  See
  90   ;; <http://bugs.gnu.org/17312> for details.
  91   (set-port-encoding! (current-output-port) "ISO-8859-1")
  92   (set-port-conversion-strategy! (current-output-port) 'error)
  93
  94   ;; Same goes for input ports.
  95   (with-fluids ((%default-port-encoding "ISO-8859-1")
  96                 (%default-port-conversion-strategy 'error))
  97     (match args
  98       (("sign" key-file hash)
  99        (sign-with-key key-file (base16-string->bytevector hash)))
 100       (("verify" signature-file)
 101        (call-with-input-file signature-file
 102          (lambda (port)
 103            (validate-signature (string->canonical-sexp
 104                                 (read-string port))))))
 105
 106       (("--help")
 107        (display (G_ "Usage: guix authenticate OPTION...
 108 Sign or verify the signature on the given file.  This tool is meant to
 109 be used internally by 'guix-daemon'.\n")))
 110       (("--version")
 111        (show-version-and-exit "guix authenticate"))
 112       (else
 113        (leave (G_ "wrong arguments"))))))
 114
 115 ;;; authenticate.scm ends here