From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id QGDwLX2PW1/yXAAA0tVLHw (envelope-from ) for ; Fri, 11 Sep 2020 14:53:49 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id QBE2KH2PW1/5OQAAB5/wlQ (envelope-from ) for ; Fri, 11 Sep 2020 14:53:49 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 4D718940224 for ; Fri, 11 Sep 2020 14:53:49 +0000 (UTC) Received: from localhost ([::1]:57892 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kGkQu-0002uA-4t for larch@yhetil.org; Fri, 11 Sep 2020 10:53:48 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:33546) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kGkQB-0001rI-Ld for guix-patches@gnu.org; Fri, 11 Sep 2020 10:53:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:33571) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kGkQB-0007zN-Af for guix-patches@gnu.org; Fri, 11 Sep 2020 10:53:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kGkQB-0006dv-9Y for guix-patches@gnu.org; Fri, 11 Sep 2020 10:53:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#43340] [PATCH 5/5] authenticate: Cache the ACL and key pairs. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 11 Sep 2020 14:53:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 43340 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 43340@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= Received: via spool by 43340-submit@debbugs.gnu.org id=B43340.159983595125448 (code B ref 43340); Fri, 11 Sep 2020 14:53:03 +0000 Received: (at 43340) by debbugs.gnu.org; 11 Sep 2020 14:52:31 +0000 Received: from localhost ([127.0.0.1]:45112 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kGkPe-0006cJ-K1 for submit@debbugs.gnu.org; Fri, 11 Sep 2020 10:52:31 -0400 Received: from eggs.gnu.org ([209.51.188.92]:57696) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kGkPa-0006bc-I9 for 43340@debbugs.gnu.org; Fri, 11 Sep 2020 10:52:27 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:40479) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kGkPV-0007we-87; Fri, 11 Sep 2020 10:52:21 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=39314 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1kGkPU-0004Uo-MB; Fri, 11 Sep 2020 10:52:21 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Fri, 11 Sep 2020 16:51:54 +0200 Message-Id: <20200911145154.15057-5-ludo@gnu.org> X-Mailer: git-send-email 2.28.0 In-Reply-To: <20200911145154.15057-1-ludo@gnu.org> References: <20200911145154.15057-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -3.3 (---) X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Spam-Score: 3.99 X-TUID: YvD+cYA77KGO In practice we're always using the same key pair, /etc/guix/signing-key.{pub,sec}. Keeping them in cache allows us to avoid redundant I/O and parsing when signing multiple store items in a row. * guix/scripts/authenticate.scm (load-key-pair): New procedure. (sign-with-key): Remove 'key-file' parameter and add 'public-key' and 'secret-key'. Adjust accordingly. (validate-signature): Add 'acl' parameter and pass it to 'authorized-key?'. (guix-authenticate): Call 'current-acl' upfront and cache its result. Add 'key-pairs' as an argument to 'loop' and use it as a cache of key pairs. --- guix/scripts/authenticate.scm | 108 +++++++++++++++++++++------------- 1 file changed, 66 insertions(+), 42 deletions(-) diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm index 34737481d5..95005641c4 100644 --- a/guix/scripts/authenticate.scm +++ b/guix/scripts/authenticate.scm @@ -24,10 +24,12 @@ #:use-module (guix diagnostics) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) #:use-module (ice-9 rdelim) #:use-module (ice-9 match) + #:use-module (ice-9 vlist) #:export (guix-authenticate)) ;;; Commentary: @@ -42,32 +44,40 @@ ;; Read a gcrypt sexp from a port and return it. (compose string->canonical-sexp read-string)) -(define (sign-with-key key-file sha256) - "Sign the hash SHA256 (a bytevector) with KEY-FILE, and return the signature -as a canonical sexp that includes both the hash and the actual signature." - (let* ((secret-key (call-with-input-file key-file read-canonical-sexp)) - (public-key (if (string-suffix? ".sec" key-file) - (call-with-input-file +(define (load-key-pair key-file) + "Load the key pair whose secret key lives at KEY-FILE. Return a pair of +canonical sexps representing those keys." + (catch 'system-error + (lambda () + (let* ((secret-key (call-with-input-file key-file read-canonical-sexp)) + (public-key (call-with-input-file (string-append (string-drop-right key-file 4) ".pub") - read-canonical-sexp) - (raise - (formatted-message - (G_ "cannot find public key for secret key '~a'~%") - key-file)))) - (data (bytevector->hash-data sha256 - #:key-type (key-type public-key))) - (signature (signature-sexp data secret-key public-key))) - signature)) + read-canonical-sexp))) + (cons public-key secret-key))) + (lambda args + (let ((errno (system-error-errno args))) + (raise + (formatted-message + (G_ "failed to load key pair at '~a': ~a~%") + key-file (strerror errno))))))) -(define (validate-signature signature) +(define (sign-with-key public-key secret-key sha256) + "Sign the hash SHA256 (a bytevector) with SECRET-KEY (a canonical sexp), and +return the signature as a canonical sexp that includes SHA256, PUBLIC-KEY, and +the actual signature." + (let ((data (bytevector->hash-data sha256 + #:key-type (key-type public-key)))) + (signature-sexp data secret-key public-key))) + +(define (validate-signature signature acl) "Validate SIGNATURE, a canonical sexp. Check whether its public key is -authorized, verify the signature, and return the signed data (a bytevector) -upon success." +authorized in ACL, verify the signature, and return the signed data (a +bytevector) upon success." (let* ((subject (signature-subject signature)) (data (signature-signed-data signature))) (if (and data subject) - (if (authorized-key? subject) + (if (authorized-key? subject acl) (if (valid-signature? signature) (hash-data->bytevector data) ; success (raise @@ -145,29 +155,43 @@ be used internally by 'guix-daemon'.\n"))) (("--version") (show-version-and-exit "guix authenticate")) (() - (let loop () - (guard (c ((formatted-message? c) - (send-reply 500 - (apply format #f - (G_ (formatted-message-string c)) - (formatted-message-arguments c))))) - ;; Read a request on standard input and reply. - (match (read-command (current-input-port)) - (("sign" signing-key (= base16-string->bytevector hash)) - (let ((signature (sign-with-key signing-key hash))) - (send-reply 0 (canonical-sexp->string signature)))) - (("verify" signature) - (send-reply 0 - (bytevector->base16-string - (validate-signature - (string->canonical-sexp signature))))) - (() - (exit 0)) - (commands - (warning (G_ "~s: invalid command; ignoring~%") commands) - (send-reply 404 "invalid command")))) - - (loop))) + (let ((acl (current-acl))) + (let loop ((key-pairs vlist-null)) + (guard (c ((formatted-message? c) + (send-reply 500 + (apply format #f + (G_ (formatted-message-string c)) + (formatted-message-arguments c))))) + ;; Read a request on standard input and reply. + (match (read-command (current-input-port)) + (("sign" signing-key (= base16-string->bytevector hash)) + (let* ((key-pairs keys + (match (vhash-assoc signing-key key-pairs) + ((_ . keys) + (values key-pairs keys)) + (#f + (let ((keys (load-key-pair signing-key))) + (values (vhash-cons signing-key keys + key-pairs) + keys))))) + (signature (match keys + ((public . secret) + (sign-with-key public secret hash))))) + (send-reply 0 (canonical-sexp->string signature)) + (loop key-pairs))) + (("verify" signature) + (send-reply 0 + (bytevector->base16-string + (validate-signature + (string->canonical-sexp signature) + acl))) + (loop key-pairs)) + (() + (exit 0)) + (commands + (warning (G_ "~s: invalid command; ignoring~%") commands) + (send-reply 404 "invalid command") + (loop key-pairs))))))) (_ (leave (G_ "wrong arguments~%")))))) -- 2.28.0