daemon: Spawn 'guix authenticate' once for all.

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.
(define-enumerate-type, reply-code): New macros.
(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.

fixlet

4 files changed, 208 insertions, 70 deletions

diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm
index 37e6cef53c..dc73981092 100644
--- a/guix/scripts/authenticate.scm
+++ b/guix/scripts/authenticate.scm
@@ -22,6 +22,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)
@@ -40,41 +44,90 @@
   (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))))))))))
+
+(define-syntax define-enumerate-type              ;TODO: factorize
+  (syntax-rules ()
+    ((_ name->int (name id) ...)
+     (define-syntax name->int
+       (syntax-rules (name ...)
+         ((_ name) id) ...)))))
+
+;; Codes used when reply to requests.
+(define-enumerate-type reply-code
+  (success 0)
+  (command-not-found 404)
+  (command-failed 500))
 
 
 ;;;
@@ -85,6 +138,13 @@ success."
   (category internal)
   (synopsis "sign or verify signatures on normalized archives (nars)")
 
+  (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.
@@ -95,21 +155,39 @@ 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")))
+Sign data or verify signatures.  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 (reply-code command-failed)
+                                (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 (reply-code success)
+                            (canonical-sexp->string signature))))
+             (("verify" signature)
+              (send-reply (reply-code success)
+                          (bytevector->base16-string
+                           (validate-signature
+                            (string->canonical-sexp signature)))))
+             (()
+              (exit 0))
+             (commands
+              (warning (G_ "~s: invalid command; ignoring~%") commands)
+              (send-reply (reply-code command-not-found)
+                          "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..8c479002ec 100644
--- a/nix/libstore/local-store.cc
+++ b/nix/libstore/local-store.cc
@@ -21,6 +21,7 @@
 #include <stdio.h>
 #include <time.h>
 #include <grp.h>
+#include <ctype.h>
 
 #if HAVE_UNSHARE && HAVE_STATVFS && HAVE_SYS_MOUNT_H
 #include <sched.h>
@@ -1231,39 +1232,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::make_shared<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 (isdigit(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
+
+# Remove the leading "0".
+sed -i "$sig" -e's/^0 //g'
 
-hash2="`guix authenticate verify "$sig"`"
-test "$hash2" = "$hash"
+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"
+
+# Remove the leading "0".
+sed -i "$sig" -e's/^0 //g'
 
-guix authenticate verify "$sig"
-hash2="`guix authenticate verify "$sig"`"
-test "$hash2" = "$hash"
+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)