[bug#43340] [PATCH 4/5] daemon: Spawn 'guix authenticate' once for all.

["Ludovic Courtès" <ludo@gnu.org>]

Previously, we'd spawn 'guix authenticate' once for each item that has
to be signed (when exporting) or authenticated (when importing).  Now,
we spawn it once for all and then follow a request/reply protocol.  This
reduces the wall-clock time of:

  guix archive --export -r $(guix build coreutils -d)

from 30s to 2s.

* guix/scripts/authenticate.scm (sign-with-key): Return the signature
instead of displaying it.  Raise a &formatted-message instead of calling
'leave'.
(validate-signature): Likewise.
(read-command): New procedure.
(guix-authenticate)[send-reply]: New procedure.
Change to read commands from current-input-port.
* nix/libstore/local-store.cc (runAuthenticationProgram): Remove.
(authenticationAgent, readInteger, readAuthenticateReply): New
functions.
(signHash, verifySignature): Rewrite in terms of the agent.
* tests/store.scm ("import not signed"): Remove 'pk' call.
("import signed by unauthorized key"): Check the error message of C.
* tests/guix-authenticate.sh: Rewrite using the new protocol.
---
 guix/scripts/authenticate.scm | 119 ++++++++++++++++++++++++++--------
 nix/libstore/local-store.cc   |  86 +++++++++++++++++++-----
 tests/guix-authenticate.sh    |  45 +++++++------
 tests/store.scm               |   8 +--
 4 files changed, 190 insertions(+), 68 deletions(-)

diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm
index fceac13a84..34737481d5 100644
--- a/guix/scripts/authenticate.scm
+++ b/guix/scripts/authenticate.scm
@@ -21,6 +21,10 @@
   #:use-module (gcrypt pk-crypto)
   #:use-module (guix pki)
   #:use-module (guix ui)
+  #:use-module (guix diagnostics)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
@@ -39,41 +43,77 @@
   (compose string->canonical-sexp read-string))
 
 (define (sign-with-key key-file sha256)
-  "Sign the hash SHA256 (a bytevector) with KEY-FILE, and write an sexp that
-includes both the hash and the actual signature."
+  "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
                              (string-append (string-drop-right key-file 4)
                                             ".pub")
                            read-canonical-sexp)
-                         (leave
-                          (G_ "cannot find public key for secret key '~a'~%")
-                          key-file)))
+                         (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)))
-    (display (canonical-sexp->string signature))
-    #t))
+    signature))
 
 (define (validate-signature signature)
   "Validate SIGNATURE, a canonical sexp.  Check whether its public key is
-authorized, verify the signature, and print the signed data to stdout upon
-success."
+authorized, 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 (valid-signature? signature)
-                (let ((hash (hash-data->bytevector data)))
-                  (display (bytevector->base16-string hash))
-                  #t)                              ; success
-                (leave (G_ "error: invalid signature: ~a~%")
-                       (canonical-sexp->string signature)))
-            (leave (G_ "error: unauthorized public key: ~a~%")
-                   (canonical-sexp->string subject)))
-        (leave (G_ "error: corrupt signature data: ~a~%")
-               (canonical-sexp->string signature)))))
+                (hash-data->bytevector data)      ; success
+                (raise
+                 (formatted-message (G_ "invalid signature: ~a")
+                                    (canonical-sexp->string signature))))
+            (raise
+             (formatted-message (G_ "unauthorized public key: ~a")
+                                (canonical-sexp->string subject))))
+        (raise
+         (formatted-message (G_ "corrupt signature data: ~a")
+                            (canonical-sexp->string signature))))))
+
+(define (read-command port)
+  "Read a command from PORT and return the command and arguments as a list of
+strings.  Return the empty list when the end-of-file is reached.
+
+Commands are newline-terminated and must look something like this:
+
+  COMMAND 3:abc 5:abcde 1:x
+
+where COMMAND is an alphanumeric sequence and the remainder is the command
+arguments.  Each argument is written as its length (in characters), followed
+by colon, followed by the given number of characters."
+  (define (consume-whitespace port)
+    (let ((chr (lookahead-u8 port)))
+      (when (eqv? chr (char->integer #\space))
+        (get-u8 port)
+        (consume-whitespace port))))
+
+  (match (read-delimited " \t\n\r" port)
+    ((? eof-object?)
+     '())
+    (command
+     (let loop ((result (list command)))
+       (consume-whitespace port)
+       (let ((next (lookahead-u8 port)))
+         (cond ((eqv? next (char->integer #\newline))
+                (get-u8 port)
+                (reverse result))
+               ((eof-object? next)
+                (reverse result))
+               (else
+                (let* ((len (string->number (read-delimited ":" port)))
+                       (str (utf8->string
+                             (get-bytevector-n port len))))
+                  (loop (cons str result))))))))))
 
 \f
 ;;;
@@ -81,6 +121,13 @@ success."
 ;;;
 
 (define (guix-authenticate . args)
+  (define (send-reply code str)
+    ;; Send CODE and STR as a reply to our client.
+    (let ((bv (string->utf8 str)))
+      (format #t "~a ~a:" code (bytevector-length bv))
+      (put-bytevector (current-output-port) bv)
+      (force-output (current-output-port))))
+
   ;; Signature sexps written to stdout may contain binary data, so force
   ;; ISO-8859-1 encoding so that things are not mangled.  See
   ;; <http://bugs.gnu.org/17312> for details.
@@ -91,21 +138,37 @@ success."
   (with-fluids ((%default-port-encoding "ISO-8859-1")
                 (%default-port-conversion-strategy 'error))
     (match args
-      (("sign" key-file hash)
-       (sign-with-key key-file (base16-string->bytevector hash)))
-      (("verify" signature-file)
-       (call-with-input-file signature-file
-         (lambda (port)
-           (validate-signature (string->canonical-sexp
-                                (read-string port))))))
-
       (("--help")
        (display (G_ "Usage: guix authenticate OPTION...
 Sign or verify the signature on the given file.  This tool is meant to
 be used internally by 'guix-daemon'.\n")))
       (("--version")
        (show-version-and-exit "guix authenticate"))
-      (else
-       (leave (G_ "wrong arguments"))))))
+      (()
+       (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)))
+      (_
+       (leave (G_ "wrong arguments~%"))))))
 
 ;;; authenticate.scm ends here
diff --git a/nix/libstore/local-store.cc b/nix/libstore/local-store.cc
index cbbd8e901d..9bc7a0bc4f 100644
--- a/nix/libstore/local-store.cc
+++ b/nix/libstore/local-store.cc
@@ -1231,39 +1231,91 @@ static void checkSecrecy(const Path & path)
 }
 
 
-static std::string runAuthenticationProgram(const Strings & args)
+/* Return the authentication agent, a "guix authenticate" process started
+   lazily.  */
+static std::shared_ptr<Agent> authenticationAgent()
 {
-    Strings fullArgs = { "authenticate" };
-    fullArgs.insert(fullArgs.end(), args.begin(), args.end()); // append
-    return runProgram(settings.guixProgram, false, fullArgs);
+    static std::shared_ptr<Agent> agent;
+
+    if (!agent) {
+	Strings args = { "authenticate" };
+	agent = std::shared_ptr<Agent>(new Agent(settings.guixProgram, args));
+    }
+
+    return agent;
+}
+
+/* Read an integer and the byte that immediately follows it from FD.  Return
+   the integer.  */
+static int readInteger(int fd)
+{
+    string str;
+
+    while (1) {
+        char ch;
+        ssize_t rd = read(fd, &ch, 1);
+        if (rd == -1) {
+            if (errno != EINTR)
+                throw SysError("reading an integer");
+        } else if (rd == 0)
+            throw EndOfFile("unexpected EOF reading an integer");
+        else {
+	    if (strchr("0123456789", ch)) {
+		str += ch;
+	    } else {
+		break;
+	    }
+        }
+    }
+
+    return stoi(str);
+}
+
+/* Read from FD a reply coming from 'guix authenticate'.  The reply has the
+   form "CODE LEN:STR".  CODE is an integer, where zero indicates success.
+   LEN specifies the length in bytes of the string that immediately
+   follows.  */
+static std::string readAuthenticateReply(int fd)
+{
+    int code = readInteger(fd);
+    int len = readInteger(fd);
+
+    string str;
+    str.resize(len);
+    readFull(fd, (unsigned char *) &str[0], len);
+
+    if (code == 0)
+	return str;
+    else
+	throw Error(str);
 }
 
 /* Sign HASH with the key stored in file SECRETKEY.  Return the signature as a
    string, or raise an exception upon error.  */
 static std::string signHash(const string &secretKey, const Hash &hash)
 {
-    Strings args;
-    args.push_back("sign");
-    args.push_back(secretKey);
-    args.push_back(printHash(hash));
+    auto agent = authenticationAgent();
+    auto hexHash = printHash(hash);
 
-    return runAuthenticationProgram(args);
+    writeLine(agent->toAgent.writeSide,
+	      (format("sign %1%:%2% %3%:%4%")
+	       % secretKey.size() % secretKey
+	       % hexHash.size() % hexHash).str());
+
+    return readAuthenticateReply(agent->fromAgent.readSide);
 }
 
 /* Verify SIGNATURE and return the base16-encoded hash over which it was
    computed.  */
 static std::string verifySignature(const string &signature)
 {
-    Path tmpDir = createTempDir("", "guix", true, true, 0700);
-    AutoDelete delTmp(tmpDir);
+    auto agent = authenticationAgent();
 
-    Path sigFile = tmpDir + "/sig";
-    writeFile(sigFile, signature);
+    writeLine(agent->toAgent.writeSide,
+	      (format("verify %1%:%2%")
+	       % signature.size() % signature).str());
 
-    Strings args;
-    args.push_back("verify");
-    args.push_back(sigFile);
-    return runAuthenticationProgram(args);
+    return readAuthenticateReply(agent->fromAgent.readSide);
 }
 
 void LocalStore::exportPath(const Path & path, bool sign,
diff --git a/tests/guix-authenticate.sh b/tests/guix-authenticate.sh
index 773443453d..f3b36ee41d 100644
--- a/tests/guix-authenticate.sh
+++ b/tests/guix-authenticate.sh
@@ -28,33 +28,38 @@ rm -f "$sig" "$hash"
 
 trap 'rm -f "$sig" "$hash"' EXIT
 
+key="$abs_top_srcdir/tests/signing-key.sec"
+key_len="`echo -n $key | wc -c`"
+
 # A hexadecimal string as long as a sha256 hash.
 hash="2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb"
+hash_len="`echo -n $hash | wc -c`"
 
-guix authenticate sign				\
-    "$abs_top_srcdir/tests/signing-key.sec"	\
-    "$hash" > "$sig"
+echo "sign $key_len:$key $hash_len:$hash" | guix authenticate > "$sig"
 test -f "$sig"
+case "$(cat $sig)" in
+    "0 "*) ;;
+    *)     echo "broken signature: $(cat $sig)"
+	   exit 42;;
+esac
 
-hash2="`guix authenticate verify "$sig"`"
-test "$hash2" = "$hash"
+# Remove the leading "0".
+sed -i "$sig" -e's/^0 //g'
+
+hash2="$(echo verify $(cat "$sig") | guix authenticate)"
+test "$(echo $hash2 | cut -d : -f 2)" = "$hash"
 
 # Detect corrupt signatures.
-if guix authenticate verify /dev/null
-then false
-else true
-fi
+code="$(echo "verify 5:wrong" | guix authenticate | cut -f1 -d ' ')"
+test "$code" -ne 0
 
 # Detect invalid signatures.
 # The signature has (payload (data ... (hash sha256 #...#))).  We proceed by
 # modifying this hash.
 sed -i "$sig"											\
     -e's|#[A-Z0-9]\{64\}#|#0000000000000000000000000000000000000000000000000000000000000000#|g'
-if guix authenticate verify "$sig"
-then false
-else true
-fi
-
+code="$(echo "verify $(cat $sig)" | guix authenticate | cut -f1 -d ' ')"
+test "$code" -ne 0
 
 # Test for <http://bugs.gnu.org/17312>: make sure 'guix authenticate' produces
 # valid signatures when run in the C locale.
@@ -63,9 +68,11 @@ hash="5eff0b55c9c5f5e87b4e34cd60a2d5654ca1eb78c7b3c67c3179fed1cff07b4c"
 LC_ALL=C
 export LC_ALL
 
-guix authenticate sign "$abs_top_srcdir/tests/signing-key.sec" "$hash" \
-     > "$sig"
+echo "sign $key_len:$key $hash_len:$hash" | guix authenticate > "$sig"
 
-guix authenticate verify "$sig"
-hash2="`guix authenticate verify "$sig"`"
-test "$hash2" = "$hash"
+# Remove the leading "0".
+sed -i "$sig" -e's/^0 //g'
+
+echo "verify $(cat $sig)" | guix authenticate
+hash2="$(echo "verify $(cat $sig)" | guix authenticate | cut -f2 -d ' ')"
+test "$(echo $hash2 | cut -d : -f 2)" = "$hash"
diff --git a/tests/store.scm b/tests/store.scm
index 8ff76e8f98..3a2a21a250 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -990,7 +990,7 @@
 
     ;; Ensure 'import-paths' raises an exception.
     (guard (c ((store-protocol-error? c)
-               (and (not (zero? (store-protocol-error-status (pk 'C c))))
+               (and (not (zero? (store-protocol-error-status c)))
                     (string-contains (store-protocol-error-message c)
                                      "lacks a signature"))))
       (let* ((source   (open-bytevector-input-port dump))
@@ -1030,9 +1030,9 @@
 
     ;; Ensure 'import-paths' raises an exception.
     (guard (c ((store-protocol-error? c)
-               ;; XXX: The daemon-provided error message currently doesn't
-               ;; mention the reason of the failure.
-               (not (zero? (store-protocol-error-status c)))))
+               (and (not (zero? (store-protocol-error-status c)))
+                    (string-contains (store-protocol-error-message c)
+                                     "unauthorized public key"))))
       (let* ((source   (open-bytevector-input-port dump))
              (imported (import-paths %store source)))
         (pk 'unauthorized-imported imported)
-- 
2.28.0