[bug#45018] [PATCH 0/6] Process and connection reuse for substitutions

[bug#45018] [PATCH 0/6] Process and connection reuse for substitutions

[Ludovic Courtès]

Hi Guix!

The attached patches optimize substitute downloads by: (1) keeping
a single ‘guix substitute’ process for all the substitutes (instead
of respawning a new one each time a store item is substituted), and
(2) reusing connections to substitute servers in between substitutions.

(Note that ‘guix publish’ does not keep connections alive, but
on ci.guix.gnu.org we run nginx in front of ‘guix publish’, and nginx
keeps them alive.)

Anecdotally, the effect is a 10% improvement on the wall-clock time
of ‘guix build --sources=transitive vim’ on my laptop, from 29s to 26s.
Of course it cannot be much better since the rest of the time is spent
actually retrieving bits over the network.

Overall the impact depends on a number of factors.  My laptop has
an SSD and I have fiber-to-the-home (FFTH) with low latency: forking
and initiating a TLS connection to ci.guix.gnu.org are both quite cheap,
so I probably don’t benefit that much.  The impact may be more acute
on a low-end device.

In the ‘guix build --sources=transitive vim’ case, there are a few
large tarballs and several small ones.  The gain is in the lack of
a pause time in between small tarballs.  Also this case is quite
advantageous: there’s no decompression and no unpacking happening.

Anyway, I think it’s a welcome improvement, especially when
downloading lots of stuff such as during the initial system installation.
Plus, there are more deletions than insertions.  :-)

Thoughts?

Ludo’.

Ludovic Courtès (6):
  daemon: 'Agent' constructor takes a list of environment variables.
  daemon: Use 'Agent' to spawn 'guix substitute --query'.
  daemon: Factorize substituter agent spawning.
  daemon: Run 'guix substitute --substitute' as an agent.
  substitute: Cache and reuse connections while substituting.
  daemon: Raise an error if substituter doesn't send the expected hash.

 guix/http-client.scm        |  12 +-
 guix/progress.scm           |   8 +-
 guix/scripts/substitute.scm | 215 +++++++++++++++++++++++-------------
 nix/libstore/build.cc       | 166 ++++++++++++++--------------
 nix/libstore/local-store.cc | 170 +++++++---------------------
 nix/libstore/local-store.hh |  25 +----
 nix/libutil/util.cc         |   6 +-
 nix/libutil/util.hh         |   7 +-
 tests/substitute.scm        |  98 +++++++++-------
 9 files changed, 350 insertions(+), 357 deletions(-)

-- 
2.29.2

[bug#45018] [PATCH 1/6] daemon: 'Agent' constructor takes a list of environment variables.

[Ludovic Courtès]

* nix/libutil/util.hh (struct Agent)[Agent]: Add 'env' parameter.
* nix/libutil/util.cc (Agent::Agent): Honor it.
---
 nix/libutil/util.cc | 6 +++++-
 nix/libutil/util.hh | 7 +++++--
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/nix/libutil/util.cc b/nix/libutil/util.cc
index 59a2981359..69f1c634a9 100644
--- a/nix/libutil/util.cc
+++ b/nix/libutil/util.cc
@@ -1173,7 +1173,7 @@ void commonChildInit(Pipe & logPipe)
 
 //////////////////////////////////////////////////////////////////////
 
-Agent::Agent(const string &command, const Strings &args)
+Agent::Agent(const string &command, const Strings &args, const std::map<string, string> &env)
 {
     debug(format("starting agent '%1%'") % command);
 
@@ -1191,6 +1191,10 @@ Agent::Agent(const string &command, const Strings &args)
 
         commonChildInit(fromAgent);
 
+	for (auto pair: env) {
+	    setenv(pair.first.c_str(), pair.second.c_str(), 1);
+	}
+
         if (chdir("/") == -1) throw SysError("changing into `/");
 
         /* Dup the communication pipes. */
diff --git a/nix/libutil/util.hh b/nix/libutil/util.hh
index 13cff44316..880b0e93b2 100644
--- a/nix/libutil/util.hh
+++ b/nix/libutil/util.hh
@@ -7,6 +7,7 @@
 #include <dirent.h>
 #include <unistd.h>
 #include <signal.h>
+#include <map>
 #include <functional>
 
 #include <cstdio>
@@ -281,8 +282,10 @@ struct Agent
     /* The process ID of the agent. */
     Pid pid;
 
-    /* The command and arguments passed to the agent.  */
-    Agent(const string &command, const Strings &args);
+    /* The command and arguments passed to the agent along with a list of
+       environment variable name/value pairs.  */
+    Agent(const string &command, const Strings &args,
+	  const std::map<string, string> &env = std::map<string, string>());
 
     ~Agent();
 };
-- 
2.29.2

[bug#45018] [PATCH 2/6] daemon: Use 'Agent' to spawn 'guix substitute --query'.

[Ludovic Courtès]

* nix/libstore/local-store.hh (RunningSubstituter): Remove.
(LocalStore)[runningSubstituter]: Change to unique_ptr<Agent>.
[setSubstituterEnv, didSetSubstituterEnv]: Remove.
[getLineFromSubstituter, getIntLineFromSubstituter]: Take an 'Agent'.
* nix/libstore/local-store.cc (LocalStore::~LocalStore): Remove
reference to 'runningSubstituter'.
(LocalStore::setSubstituterEnv, LocalStore::startSubstituter): Remove.
(LocalStore::getLineFromSubstituter): Adjust to 'run' being an 'Agent'.
(LocalStore::querySubstitutablePaths): Spawn substituter agent if
needed.  Adjust to 'Agent' interface.
(LocalStore::querySubstitutablePathInfos): Likewise.
* nix/libstore/build.cc (SubstitutionGoal::tryToRun): Remove call to
'setSubstituterEnv' and add 'setenv' call for "_NIX_OPTIONS" instead.
(SubstitutionGoal::finished): Remove 'readLine' call for 'dummy'.
* guix/scripts/substitute.scm (%allow-unauthenticated-substitutes?):
Remove second argument to 'make-parameter'.
(process-query): Call 'warn-about-missing-authentication'
when (%allow-unauthenticated-substitutes?) is #t.
(guix-substitute): Wrap body in 'parameterize'.  Set 'guix-warning-port'
too.  No longer exit when 'substitute-urls' returns the empty list.  No
longer print newline initially.
* tests/substitute.scm (test-quit): Parameterize 'current-error-port' to
account for the port changes in 'guix-substitute'.
---
 guix/scripts/substitute.scm | 122 ++++++++++++++--------------
 nix/libstore/build.cc       |   6 +-
 nix/libstore/local-store.cc | 157 +++++++++---------------------------
 nix/libstore/local-store.hh |  22 +----
 tests/substitute.scm        |   3 +-
 5 files changed, 104 insertions(+), 206 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index adc6852321..b2ae7bac40 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -124,11 +124,7 @@ disabled!~%"))
   ;; purposes, and should be avoided otherwise.
   (make-parameter
    (and=> (getenv "GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES")
-          (cut string-ci=? <> "yes"))
-   (lambda (value)
-     (when value
-       (warn-about-missing-authentication))
-     value)))
+          (cut string-ci=? <> "yes"))))
 
 (define %narinfo-ttl
   ;; Number of seconds during which cached narinfo lookups are considered
@@ -893,6 +889,9 @@ authorized substitutes."
   (define (valid? obj)
     (valid-narinfo? obj acl))
 
+  (when (%allow-unauthenticated-substitutes?)
+    (warn-about-missing-authentication))
+
   (match (string-tokenize command)
     (("have" paths ..1)
      ;; Return the subset of PATHS available in CACHE-URLS.
@@ -1137,68 +1136,67 @@ default value."
       ((= string->number number) (> number 0))
       (_ #f)))
 
-  (mkdir-p %narinfo-cache-directory)
-  (maybe-remove-expired-cache-entries %narinfo-cache-directory
-                                      cached-narinfo-files
-                                      #:entry-expiration
-                                      cached-narinfo-expiration-time
-                                      #:cleanup-period
-                                      %narinfo-expired-cache-entry-removal-delay)
-  (check-acl-initialized)
+  ;; The daemon's agent code opens file descriptor 4 for us and this is where
+  ;; stderr should go.
+  (parameterize ((current-error-port (match args
+                                       (("--query") (fdopen 4 "wl"))
+                                       (_ (current-error-port)))))
+    ;; Redirect diagnostics to file descriptor 4 as well.
+    (guix-warning-port (current-error-port))
 
-  ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly
-  ;; when we know we cannot substitute, but we must emit a newline on stdout
-  ;; when everything is alright.
-  (when (null? (substitute-urls))
-    (exit 0))
+    (mkdir-p %narinfo-cache-directory)
+    (maybe-remove-expired-cache-entries %narinfo-cache-directory
+                                        cached-narinfo-files
+                                        #:entry-expiration
+                                        cached-narinfo-expiration-time
+                                        #:cleanup-period
+                                        %narinfo-expired-cache-entry-removal-delay)
+    (check-acl-initialized)
 
-  ;; Say hello (see above.)
-  (newline)
-  (force-output (current-output-port))
+    ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error
+    ;; message.
+    (for-each validate-uri (substitute-urls))
 
-  ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error message.
-  (for-each validate-uri (substitute-urls))
+    ;; Attempt to install the client's locale so that messages are suitably
+    ;; translated.  LC_CTYPE must be a UTF-8 locale; it's the case by default
+    ;; so don't change it.
+    (match (or (find-daemon-option "untrusted-locale")
+               (find-daemon-option "locale"))
+      (#f     #f)
+      (locale (false-if-exception (setlocale LC_MESSAGES locale))))
 
-  ;; Attempt to install the client's locale so that messages are suitably
-  ;; translated.  LC_CTYPE must be a UTF-8 locale; it's the case by default so
-  ;; don't change it.
-  (match (or (find-daemon-option "untrusted-locale")
-             (find-daemon-option "locale"))
-    (#f     #f)
-    (locale (false-if-exception (setlocale LC_MESSAGES locale))))
+    (catch 'system-error
+      (lambda ()
+        (set-thread-name "guix substitute"))
+      (const #t))                                 ;GNU/Hurd lacks 'prctl'
 
-  (catch 'system-error
-    (lambda ()
-      (set-thread-name "guix substitute"))
-    (const #t))                                   ;GNU/Hurd lacks 'prctl'
-
-  (with-networking
-   (with-error-handling                           ; for signature errors
-     (match args
-       (("--query")
-        (let ((acl (current-acl)))
-          (let loop ((command (read-line)))
-            (or (eof-object? command)
-                (begin
-                  (process-query command
-                                 #:cache-urls (substitute-urls)
-                                 #:acl acl)
-                  (loop (read-line)))))))
-       (("--substitute" store-path destination)
-        ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
-        ;; Specify the number of columns of the terminal so the progress
-        ;; report displays nicely.
-        (parameterize ((current-terminal-columns (client-terminal-columns)))
-          (process-substitution store-path destination
-                                #:cache-urls (substitute-urls)
-                                #:acl (current-acl)
-                                #:print-build-trace? print-build-trace?)))
-       ((or ("-V") ("--version"))
-        (show-version-and-exit "guix substitute"))
-       (("--help")
-        (show-help))
-       (opts
-        (leave (G_ "~a: unrecognized options~%") opts))))))
+    (with-networking
+     (with-error-handling                         ; for signature errors
+       (match args
+         (("--query")
+          (let ((acl (current-acl)))
+            (let loop ((command (read-line)))
+              (or (eof-object? command)
+                  (begin
+                    (process-query command
+                                   #:cache-urls (substitute-urls)
+                                   #:acl acl)
+                    (loop (read-line)))))))
+         (("--substitute" store-path destination)
+          ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
+          ;; Specify the number of columns of the terminal so the progress
+          ;; report displays nicely.
+          (parameterize ((current-terminal-columns (client-terminal-columns)))
+            (process-substitution store-path destination
+                                  #:cache-urls (substitute-urls)
+                                  #:acl (current-acl)
+                                  #:print-build-trace? print-build-trace?)))
+         ((or ("-V") ("--version"))
+          (show-version-and-exit "guix substitute"))
+         (("--help")
+          (show-help))
+         (opts
+          (leave (G_ "~a: unrecognized options~%") opts)))))))
 
 ;;; Local Variables:
 ;;; eval: (put 'with-timeout 'scheme-indent-function 1)
diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index 8413819114..7e9ab3f39c 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -2986,8 +2986,6 @@ void SubstitutionGoal::tryToRun()
     if (pathExists(destPath))
         deletePath(destPath);
 
-    worker.store.setSubstituterEnv();
-
     /* Fill in the arguments. */
     Strings args;
     args.push_back("guix");
@@ -2999,6 +2997,9 @@ void SubstitutionGoal::tryToRun()
     /* Fork the substitute program. */
     pid = startProcess([&]() {
 
+	/* Communicate substitute-urls & co. to 'guix substitute'.  */
+        setenv("_NIX_OPTIONS", settings.pack().c_str(), 1);
+
         commonChildInit(logPipe);
 
         if (dup2(outPipe.writeSide, STDOUT_FILENO) == -1)
@@ -3041,7 +3042,6 @@ void SubstitutionGoal::finished()
     logPipe.readSide.close();
 
     /* Get the hash info from stdout. */
-    string dummy = readLine(outPipe.readSide);
     string expectedHashStr = statusOk(status) ? readLine(outPipe.readSide) : "";
     outPipe.readSide.close();
 
diff --git a/nix/libstore/local-store.cc b/nix/libstore/local-store.cc
index 8c479002ec..c7df8da085 100644
--- a/nix/libstore/local-store.cc
+++ b/nix/libstore/local-store.cc
@@ -57,7 +57,6 @@ void checkStoreNotSymlink()
 
 
 LocalStore::LocalStore(bool reserveSpace)
-    : didSetSubstituterEnv(false)
 {
     schemaPath = settings.nixDBPath + "/schema";
 
@@ -182,21 +181,6 @@ LocalStore::LocalStore(bool reserveSpace)
 
 LocalStore::~LocalStore()
 {
-    try {
-	if (runningSubstituter) {
-	    RunningSubstituter &i = *runningSubstituter;
-            if (!i.disabled) {
-		i.to.close();
-		i.from.close();
-		i.error.close();
-		if (i.pid != -1)
-		    i.pid.wait(true);
-	    }
-        }
-    } catch (...) {
-        ignoreException();
-    }
-
     try {
         if (fdTempRoots != -1) {
             fdTempRoots.close();
@@ -796,96 +780,31 @@ Path LocalStore::queryPathFromHashPart(const string & hashPart)
     });
 }
 
-
-void LocalStore::setSubstituterEnv()
-{
-    if (didSetSubstituterEnv) return;
-
-    /* Pass configuration options (including those overridden with
-       --option) to substituters. */
-    setenv("_NIX_OPTIONS", settings.pack().c_str(), 1);
-
-    didSetSubstituterEnv = true;
-}
-
-
-void LocalStore::startSubstituter(RunningSubstituter & run)
-{
-    if (run.disabled || run.pid != -1) return;
-
-    debug(format("starting substituter program `%1% substitute'")
-	  % settings.guixProgram);
-
-    Pipe toPipe, fromPipe, errorPipe;
-
-    toPipe.create();
-    fromPipe.create();
-    errorPipe.create();
-
-    setSubstituterEnv();
-
-    run.pid = startProcess([&]() {
-        if (dup2(toPipe.readSide, STDIN_FILENO) == -1)
-            throw SysError("dupping stdin");
-        if (dup2(fromPipe.writeSide, STDOUT_FILENO) == -1)
-            throw SysError("dupping stdout");
-        if (dup2(errorPipe.writeSide, STDERR_FILENO) == -1)
-            throw SysError("dupping stderr");
-        execl(settings.guixProgram.c_str(), "guix", "substitute", "--query", NULL);
-        throw SysError(format("executing `%1%'") % settings.guixProgram);
-    });
-
-    run.to = toPipe.writeSide.borrow();
-    run.from = run.fromBuf.fd = fromPipe.readSide.borrow();
-    run.error = errorPipe.readSide.borrow();
-
-    toPipe.readSide.close();
-    fromPipe.writeSide.close();
-    errorPipe.writeSide.close();
-
-    /* The substituter may exit right away if it's disabled in any way
-       (e.g. copy-from-other-stores.pl will exit if no other stores
-       are configured). */
-    try {
-        getLineFromSubstituter(run);
-    } catch (EndOfFile & e) {
-        run.to.close();
-        run.from.close();
-        run.error.close();
-        run.disabled = true;
-        if (run.pid.wait(true) != 0) throw;
-    }
-}
-
-
 /* Read a line from the substituter's stdout, while also processing
    its stderr. */
-string LocalStore::getLineFromSubstituter(RunningSubstituter & run)
+string LocalStore::getLineFromSubstituter(Agent & run)
 {
     string res, err;
 
-    /* We might have stdout data left over from the last time. */
-    if (run.fromBuf.hasData()) goto haveData;
-
     while (1) {
         checkInterrupt();
 
         fd_set fds;
         FD_ZERO(&fds);
-        FD_SET(run.from, &fds);
-        FD_SET(run.error, &fds);
+        FD_SET(run.fromAgent.readSide, &fds);
+        FD_SET(run.builderOut.readSide, &fds);
 
         /* Wait for data to appear on the substituter's stdout or
            stderr. */
-        if (select(run.from > run.error ? run.from + 1 : run.error + 1, &fds, 0, 0, 0) == -1) {
+        if (select(std::max(run.fromAgent.readSide, run.builderOut.readSide) + 1, &fds, 0, 0, 0) == -1) {
             if (errno == EINTR) continue;
             throw SysError("waiting for input from the substituter");
         }
 
         /* Completely drain stderr before dealing with stdout. */
-        if (FD_ISSET(run.error, &fds)) {
+        if (FD_ISSET(run.builderOut.readSide, &fds)) {
             char buf[4096];
-            ssize_t n = read(run.error, (unsigned char *) buf, sizeof(buf));
+            ssize_t n = read(run.builderOut.readSide, (unsigned char *) buf, sizeof(buf));
             if (n == -1) {
                 if (errno == EINTR) continue;
                 throw SysError("reading from substituter's stderr");
@@ -903,23 +822,20 @@ string LocalStore::getLineFromSubstituter(RunningSubstituter & run)
         }
 
         /* Read from stdout until we get a newline or the buffer is empty. */
-        else if (run.fromBuf.hasData() || FD_ISSET(run.from, &fds)) {
-        haveData:
-            do {
-                unsigned char c;
-                run.fromBuf(&c, 1);
-                if (c == '\n') {
-                    if (!err.empty()) printMsg(lvlError, "substitute: " + err);
-                    return res;
-                }
-                res += c;
-            } while (run.fromBuf.hasData());
+        else if (FD_ISSET(run.fromAgent.readSide, &fds)) {
+	    unsigned char c;
+	    readFull(run.fromAgent.readSide, (unsigned char *) &c, 1);
+	    if (c == '\n') {
+		if (!err.empty()) printMsg(lvlError, "substitute: " + err);
+		return res;
+	    }
+	    res += c;
         }
     }
 }
 
 
-template<class T> T LocalStore::getIntLineFromSubstituter(RunningSubstituter & run)
+template<class T> T LocalStore::getIntLineFromSubstituter(Agent & run)
 {
     string s = getLineFromSubstituter(run);
     T res;
@@ -935,27 +851,26 @@ PathSet LocalStore::querySubstitutablePaths(const PathSet & paths)
     if (!settings.useSubstitutes || paths.empty()) return res;
 
     if (!runningSubstituter) {
-	std::unique_ptr<RunningSubstituter>fresh(new RunningSubstituter);
+	const Strings args = { "substitute", "--query" };
+	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
+	std::unique_ptr<Agent>fresh(new Agent(settings.guixProgram, args, env));
 	runningSubstituter.swap(fresh);
     }
 
-    RunningSubstituter & run = *runningSubstituter;
-    startSubstituter(run);
+    Agent & run = *runningSubstituter;
 
-    if (!run.disabled) {
-	string s = "have ";
-	foreach (PathSet::const_iterator, j, paths)
-	    if (res.find(*j) == res.end()) { s += *j; s += " "; }
-	writeLine(run.to, s);
-	while (true) {
-	    /* FIXME: we only read stderr when an error occurs, so
-	       substituters should only write (short) messages to
-	       stderr when they fail.  I.e. they shouldn't write debug
-	       output. */
-	    Path path = getLineFromSubstituter(run);
-	    if (path == "") break;
-	    res.insert(path);
-	}
+    string s = "have ";
+    foreach (PathSet::const_iterator, j, paths)
+	if (res.find(*j) == res.end()) { s += *j; s += " "; }
+    writeLine(run.toAgent.writeSide, s);
+    while (true) {
+	/* FIXME: we only read stderr when an error occurs, so
+	   substituters should only write (short) messages to
+	   stderr when they fail.  I.e. they shouldn't write debug
+	   output. */
+	Path path = getLineFromSubstituter(run);
+	if (path == "") break;
+	res.insert(path);
     }
 
     return res;
@@ -967,18 +882,18 @@ void LocalStore::querySubstitutablePathInfos(PathSet & paths, SubstitutablePathI
     if (!settings.useSubstitutes) return;
 
     if (!runningSubstituter) {
-	std::unique_ptr<RunningSubstituter>fresh(new RunningSubstituter);
+	const Strings args = { "substitute", "--query" };
+	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
+	std::unique_ptr<Agent>fresh(new Agent(settings.guixProgram, args, env));
 	runningSubstituter.swap(fresh);
     }
 
-    RunningSubstituter & run = *runningSubstituter;
-    startSubstituter(run);
-    if (run.disabled) return;
+    Agent & run = *runningSubstituter;
 
     string s = "info ";
     foreach (PathSet::const_iterator, i, paths)
         if (infos.find(*i) == infos.end()) { s += *i; s += " "; }
-    writeLine(run.to, s);
+    writeLine(run.toAgent.writeSide, s);
 
     while (true) {
         Path path = getLineFromSubstituter(run);
diff --git a/nix/libstore/local-store.hh b/nix/libstore/local-store.hh
index 2e48cf03e6..57d15bac7e 100644
--- a/nix/libstore/local-store.hh
+++ b/nix/libstore/local-store.hh
@@ -38,21 +38,11 @@ struct OptimiseStats
 };
 
 
-struct RunningSubstituter
-{
-    Pid pid;
-    AutoCloseFD to, from, error;
-    FdSource fromBuf;
-    bool disabled;
-    RunningSubstituter() : disabled(false) { };
-};
-
-
 class LocalStore : public StoreAPI
 {
 private:
     /* The currently running substituter or empty.  */
-    std::unique_ptr<RunningSubstituter> runningSubstituter;
+    std::unique_ptr<Agent> runningSubstituter;
 
     Path linksDir;
 
@@ -178,8 +168,6 @@ public:
 
     void markContentsGood(const Path & path);
 
-    void setSubstituterEnv();
-
     void createUser(const std::string & userName, uid_t userId);
 
 private:
@@ -213,8 +201,6 @@ private:
     /* Cache for pathContentsGood(). */
     std::map<Path, bool> pathContentsGoodCache;
 
-    bool didSetSubstituterEnv;
-
     /* The file to which we write our temporary roots. */
     Path fnTempRoots;
     AutoCloseFD fdTempRoots;
@@ -262,11 +248,9 @@ private:
 
     void removeUnusedLinks(const GCState & state);
 
-    void startSubstituter(RunningSubstituter & runningSubstituter);
+    string getLineFromSubstituter(Agent & run);
 
-    string getLineFromSubstituter(RunningSubstituter & run);
-
-    template<class T> T getIntLineFromSubstituter(RunningSubstituter & run);
+    template<class T> T getIntLineFromSubstituter(Agent & run);
 
     Path createTempDirInStore();
 
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 6560612c40..bd5b6305b0 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -47,7 +47,8 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
   (test-equal name
     '(1 #t)
     (let ((error-output (open-output-string)))
-      (parameterize ((guix-warning-port error-output))
+      (parameterize ((current-error-port error-output)
+                     (guix-warning-port error-output))
         (catch 'quit
           (lambda ()
             exp
-- 
2.29.2

[bug#45018] [PATCH 2/6] daemon: Use 'Agent' to spawn 'guix substitute --query'.

[Mathieu Othacehe]

Hey,

> +         (("--substitute" store-path destination)
> +          ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.

add it to store?

> +	const Strings args = { "substitute", "--query" };
> +	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
> +	std::unique_ptr<Agent>fresh(new Agent(settings.guixProgram, args, env));

You should prefer make_unique to "new" calls.

> -	std::unique_ptr<RunningSubstituter>fresh(new RunningSubstituter);
> +	const Strings args = { "substitute", "--query" };
> +	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
> +	std::unique_ptr<Agent>fresh(new Agent(settings.guixProgram, args, env));

Ditto.

Thanks,

Mathieu

[bug#45018] [PATCH 2/6] daemon: Use 'Agent' to spawn 'guix substitute --query'.

[Ludovic Courtès]

Mathieu Othacehe <othacehe@gnu.org> skribis:

>> +         (("--substitute" store-path destination)
>> +          ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
>
> add it to store?

Oops.

>> +	const Strings args = { "substitute", "--query" };
>> +	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
>> +	std::unique_ptr<Agent>fresh(new Agent(settings.guixProgram, args, env));
>
> You should prefer make_unique to "new" calls.

Apparently ‘make_unique’ is a C++14 thing and we don’t build against
that standard (yet), so I left it as is.  The next patch removes this
use of ‘unique_ptr’ anyway.

[bug#45018] [PATCH 3/6] daemon: Factorize substituter agent spawning.

[Ludovic Courtès]

* nix/libstore/local-store.hh (class LocalStore)[substituter]: New
method.
[runningSubstituter]: Turn into a shared_ptr.
* nix/libstore/local-store.cc (LocalStore::querySubstitutablePaths):
Call 'substituter' instead of using inline code.
(LocalStore::querySubstitutablePathInfos): Likewise.
(LocalStore::substituter): New method.
---
 nix/libstore/local-store.cc | 29 +++++++++++++----------------
 nix/libstore/local-store.hh |  5 ++++-
 2 files changed, 17 insertions(+), 17 deletions(-)

diff --git a/nix/libstore/local-store.cc b/nix/libstore/local-store.cc
index c7df8da085..c304e2ddd1 100644
--- a/nix/libstore/local-store.cc
+++ b/nix/libstore/local-store.cc
@@ -850,14 +850,7 @@ PathSet LocalStore::querySubstitutablePaths(const PathSet & paths)
 
     if (!settings.useSubstitutes || paths.empty()) return res;
 
-    if (!runningSubstituter) {
-	const Strings args = { "substitute", "--query" };
-	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
-	std::unique_ptr<Agent>fresh(new Agent(settings.guixProgram, args, env));
-	runningSubstituter.swap(fresh);
-    }
-
-    Agent & run = *runningSubstituter;
+    Agent & run = *substituter();
 
     string s = "have ";
     foreach (PathSet::const_iterator, j, paths)
@@ -877,18 +870,22 @@ PathSet LocalStore::querySubstitutablePaths(const PathSet & paths)
 }
 
 
+std::shared_ptr<Agent> LocalStore::substituter()
+{
+    if (!runningSubstituter) {
+	const Strings args = { "substitute", "--query" };
+	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
+	runningSubstituter = std::make_shared<Agent>(settings.guixProgram, args, env);
+    }
+
+    return runningSubstituter;
+}
+
 void LocalStore::querySubstitutablePathInfos(PathSet & paths, SubstitutablePathInfos & infos)
 {
     if (!settings.useSubstitutes) return;
 
-    if (!runningSubstituter) {
-	const Strings args = { "substitute", "--query" };
-	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
-	std::unique_ptr<Agent>fresh(new Agent(settings.guixProgram, args, env));
-	runningSubstituter.swap(fresh);
-    }
-
-    Agent & run = *runningSubstituter;
+    Agent & run = *substituter();
 
     string s = "info ";
     foreach (PathSet::const_iterator, i, paths)
diff --git a/nix/libstore/local-store.hh b/nix/libstore/local-store.hh
index 57d15bac7e..9ba37219da 100644
--- a/nix/libstore/local-store.hh
+++ b/nix/libstore/local-store.hh
@@ -42,7 +42,10 @@ class LocalStore : public StoreAPI
 {
 private:
     /* The currently running substituter or empty.  */
-    std::unique_ptr<Agent> runningSubstituter;
+    std::shared_ptr<Agent> runningSubstituter;
+
+    /* Ensure the substituter is running and return it.  */
+    std::shared_ptr<Agent> substituter();
 
     Path linksDir;
 
-- 
2.29.2

[bug#45018] [PATCH 3/6] daemon: Factorize substituter agent spawning.

[Mathieu Othacehe]

Hey Ludo,

> +	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
> +	runningSubstituter = std::make_shared<Agent>(settings.guixProgram, args, env);

The only owner of this Agent is LocalStore, so why not using
make_unique? This function could return a const reference to the Agent
instead.

Thanks,

Mathieu

[bug#45018] [PATCH 4/6] daemon: Run 'guix substitute --substitute' as an agent.

[Ludovic Courtès]

This avoids spawning one substitute process per substitution.

* nix/libstore/build.cc (class Worker)[substituter]: New field.
[outPipe, logPipe, pid]: Remove.
(class SubstitutionGoal)[expectedHashStr, status, substituter]: New fields.
(SubstitutionGoal::timedOut): Adjust to check 'substituter'.
(SubstitutionGoal::tryToRun): Remove references to 'outPipe' and
'logPipe'.  Run "guix substitute --substitute" as an 'Agent'.  Send the
request with 'writeLine'.
(SubstitutionGoal::finished): Likewise.
(SubstitutionGoal::handleChildOutput): Change to fill in
'expectedHashStr' and 'status'.
(SubstitutionGoal::handleEOF): Call 'wakeUp' unconditionally.
(SubstitutionGoal::~SubstitutionGoal): Adjust to check 'substituter'.
* guix/scripts/substitute.scm (process-substitution): Write "success\n"
to stdout upon success.
(%error-to-file-descriptor-4?): New variable.
(guix-substitute): Set 'current-error-port' to file descriptor 4
unless (%error-to-file-descriptor-4?) is false.
Remove "--substitute" arguments.  Loop reading line from stdin.
* tests/substitute.scm <top level>: Call '%error-to-file-descriptor-4?'.
(request-substitution): New procedure.
("substitute, no signature")
("substitute, invalid hash")
("substitute, unauthorized key")
("substitute, authorized key")
("substitute, unauthorized narinfo comes first")
("substitute, unsigned narinfo comes first")
("substitute, first narinfo is unsigned and has wrong hash")
("substitute, first narinfo is unsigned and has wrong refs")
("substitute, two invalid narinfos")
("substitute, narinfo with several URLs"): Adjust to new "guix
substitute --substitute" calling convention.
---
 guix/scripts/substitute.scm |  34 +++++++---
 nix/libstore/build.cc       | 129 ++++++++++++++++++------------------
 tests/substitute.scm        |  95 +++++++++++++++-----------
 3 files changed, 145 insertions(+), 113 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index b2ae7bac40..334d3c97f8 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -88,6 +88,7 @@
             write-narinfo
 
             %allow-unauthenticated-substitutes?
+            %error-to-file-descriptor-4?
 
             substitute-urls
             guix-substitute))
@@ -1016,7 +1017,10 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
 
       ;; Skip a line after what 'progress-reporter/file' printed, and another
       ;; one to visually separate substitutions.
-      (display "\n\n" (current-error-port)))))
+      (display "\n\n" (current-error-port))
+
+      ;; Tell the daemon that we're done.
+      (display "success\n" (current-output-port)))))
 
 \f
 ;;;
@@ -1125,6 +1129,11 @@ default value."
   (unless (string->uri uri)
     (leave (G_ "~a: invalid URI~%") uri)))
 
+(define %error-to-file-descriptor-4?
+  ;; Whether to direct 'current-error-port' to file descriptor 4 like
+  ;; 'guix-daemon' expects.
+  (make-parameter #t))
+
 (define-command (guix-substitute . args)
   (category internal)
   (synopsis "implement the build daemon's substituter protocol")
@@ -1138,9 +1147,9 @@ default value."
 
   ;; The daemon's agent code opens file descriptor 4 for us and this is where
   ;; stderr should go.
-  (parameterize ((current-error-port (match args
-                                       (("--query") (fdopen 4 "wl"))
-                                       (_ (current-error-port)))))
+  (parameterize ((current-error-port (if (%error-to-file-descriptor-4?)
+                                         (fdopen 4 "wl")
+                                         (current-error-port))))
     ;; Redirect diagnostics to file descriptor 4 as well.
     (guix-warning-port (current-error-port))
 
@@ -1182,15 +1191,22 @@ default value."
                                    #:cache-urls (substitute-urls)
                                    #:acl acl)
                     (loop (read-line)))))))
-         (("--substitute" store-path destination)
+         (("--substitute")
           ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
           ;; Specify the number of columns of the terminal so the progress
           ;; report displays nicely.
           (parameterize ((current-terminal-columns (client-terminal-columns)))
-            (process-substitution store-path destination
-                                  #:cache-urls (substitute-urls)
-                                  #:acl (current-acl)
-                                  #:print-build-trace? print-build-trace?)))
+            (let loop ()
+              (match (read-line)
+                ((? eof-object?)
+                 #t)
+                ((= string-tokenize ("substitute" store-path destination))
+                 (process-substitution store-path destination
+                                       #:cache-urls (substitute-urls)
+                                       #:acl (current-acl)
+                                       #:print-build-trace?
+                                       print-build-trace?)
+                 (loop))))))
          ((or ("-V") ("--version"))
           (show-version-and-exit "guix substitute"))
          (("--help")
diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index 7e9ab3f39c..50d300253d 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -262,6 +262,7 @@ public:
     LocalStore & store;
 
     std::shared_ptr<Agent> hook;
+    std::shared_ptr<Agent> substituter;
 
     Worker(LocalStore & store);
     ~Worker();
@@ -2773,15 +2774,6 @@ private:
     /* Path info returned by the substituter's query info operation. */
     SubstitutablePathInfo info;
 
-    /* Pipe for the substituter's standard output. */
-    Pipe outPipe;
-
-    /* Pipe for the substituter's standard error. */
-    Pipe logPipe;
-
-    /* The process ID of the builder. */
-    Pid pid;
-
     /* Lock on the store path. */
     std::shared_ptr<PathLocks> outputLock;
 
@@ -2795,6 +2787,17 @@ private:
     typedef void (SubstitutionGoal::*GoalState)();
     GoalState state;
 
+    /* The substituter. */
+    std::shared_ptr<Agent> substituter;
+
+    /* Either the empty string, or the expected hash as returned by the
+       substituter.  */
+    string expectedHashStr;
+
+    /* Either the empty string, or the status phrase returned by the
+       substituter.  */
+    string status;
+
     void tryNext();
 
 public:
@@ -2840,7 +2843,7 @@ SubstitutionGoal::SubstitutionGoal(const Path & storePath, Worker & worker, bool
 
 SubstitutionGoal::~SubstitutionGoal()
 {
-    if (pid != -1) worker.childTerminated(pid);
+    if (substituter) worker.childTerminated(substituter->pid);
 }
 
 
@@ -2848,9 +2851,9 @@ void SubstitutionGoal::timedOut()
 {
     if (settings.printBuildTrace)
         printMsg(lvlError, format("@ substituter-failed %1% timeout") % storePath);
-    if (pid != -1) {
-        pid_t savedPid = pid;
-        pid.kill();
+    if (substituter) {
+        pid_t savedPid = substituter->pid;
+	substituter.reset();
         worker.childTerminated(savedPid);
     }
     amDone(ecFailed);
@@ -2977,45 +2980,29 @@ void SubstitutionGoal::tryToRun()
 
     printMsg(lvlInfo, format("fetching path `%1%'...") % storePath);
 
-    outPipe.create();
-    logPipe.create();
-
     destPath = repair ? storePath + ".tmp" : storePath;
 
     /* Remove the (stale) output path if it exists. */
     if (pathExists(destPath))
         deletePath(destPath);
 
-    /* Fill in the arguments. */
-    Strings args;
-    args.push_back("guix");
-    args.push_back("substitute");
-    args.push_back("--substitute");
-    args.push_back(storePath);
-    args.push_back(destPath);
+    if (!worker.substituter) {
+	const Strings args = { "substitute", "--substitute" };
+	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
+	worker.substituter = std::make_shared<Agent>(settings.guixProgram, args, env);
+    }
 
-    /* Fork the substitute program. */
-    pid = startProcess([&]() {
+    /* Borrow the worker's substituter.  */
+    if (!substituter) substituter.swap(worker.substituter);
 
-	/* Communicate substitute-urls & co. to 'guix substitute'.  */
-        setenv("_NIX_OPTIONS", settings.pack().c_str(), 1);
+    /* Send the request to the substituter.  */
+    writeLine(substituter->toAgent.writeSide,
+	      (format("substitute %1% %2%") % storePath % destPath).str());
 
-        commonChildInit(logPipe);
-
-        if (dup2(outPipe.writeSide, STDOUT_FILENO) == -1)
-            throw SysError("cannot dup output pipe into stdout");
-
-        execv(settings.guixProgram.c_str(), stringsToCharPtrs(args).data());
-
-        throw SysError(format("executing `%1% substitute'") % settings.guixProgram);
-    });
-
-    pid.setSeparatePG(true);
-    pid.setKillSignal(SIGTERM);
-    outPipe.writeSide.close();
-    logPipe.writeSide.close();
-    worker.childStarted(shared_from_this(),
-        pid, singleton<set<int> >(logPipe.readSide), true, true);
+    set<int> fds;
+    fds.insert(substituter->fromAgent.readSide);
+    fds.insert(substituter->builderOut.readSide);
+    worker.childStarted(shared_from_this(), substituter->pid, fds, true, true);
 
     state = &SubstitutionGoal::finished;
 
@@ -3030,28 +3017,25 @@ void SubstitutionGoal::finished()
 {
     trace("substitute finished");
 
-    /* Since we got an EOF on the logger pipe, the substitute is
-       presumed to have terminated.  */
-    pid_t savedPid = pid;
-    int status = pid.wait(true);
+    /* Remove the 'guix substitute' process from the list of children.  */
+    worker.childTerminated(substituter->pid);
 
-    /* So the child is gone now. */
-    worker.childTerminated(savedPid);
-
-    /* Close the read side of the logger pipe. */
-    logPipe.readSide.close();
-
-    /* Get the hash info from stdout. */
-    string expectedHashStr = statusOk(status) ? readLine(outPipe.readSide) : "";
-    outPipe.readSide.close();
+    /* If max-jobs > 1, the worker might have created a new 'substitute'
+       process in the meantime.  If that is the case, terminate ours;
+       otherwise, give it back to the worker.  */
+    if (worker.substituter) {
+	substituter.reset ();
+    } else {
+	worker.substituter.swap(substituter);
+    }
 
     /* Check the exit status and the build result. */
     HashResult hash;
     try {
 
-        if (!statusOk(status))
-            throw SubstError(format("fetching path `%1%' %2%")
-                % storePath % statusToString(status));
+        if (status != "success")
+            throw SubstError(format("fetching path `%1%' (status: '%2%')")
+                % storePath % status);
 
         if (!pathExists(destPath))
             throw SubstError(format("substitute did not produce path `%1%'") % destPath);
@@ -3122,16 +3106,33 @@ void SubstitutionGoal::finished()
 
 void SubstitutionGoal::handleChildOutput(int fd, const string & data)
 {
-    assert(fd == logPipe.readSide);
-    if (verbosity >= settings.buildVerbosity) writeToStderr(data);
-    /* Don't write substitution output to a log file for now.  We
-       probably should, though. */
+    if (verbosity >= settings.buildVerbosity
+	&& fd == substituter->builderOut.readSide) {
+	writeToStderr(data);
+	/* Don't write substitution output to a log file for now.  We
+	   probably should, though. */
+    }
+
+    if (fd == substituter->fromAgent.readSide) {
+	/* Trim whitespace to the right.  */
+	size_t end = data.find_last_not_of(" \t\n");
+	string trimmed = (end != string::npos) ? data.substr(0, end + 1) : data;
+
+	if (expectedHashStr == "") {
+	    expectedHashStr = trimmed;
+	} else if (status == "") {
+	    status = trimmed;
+	    worker.wakeUp(shared_from_this());
+	} else {
+	    printMsg(lvlError, format("unexpected substituter message '%1%'") % data);
+	}
+    }
 }
 
 
 void SubstitutionGoal::handleEOF(int fd)
 {
-    if (fd == logPipe.readSide) worker.wakeUp(shared_from_this());
+    worker.wakeUp(shared_from_this());
 }
 
 
diff --git a/tests/substitute.scm b/tests/substitute.scm
index bd5b6305b0..b86ce09425 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -58,6 +58,14 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
                   (let ((message (get-output-string error-output)))
                     (->bool (string-match error-rx message))))))))))
 
+(define (request-substitution item destination)
+  "Run 'guix substitute --substitute' to fetch ITEM to DESTINATION."
+  (parameterize ((guix-warning-port (current-error-port)))
+    (with-input-from-string (string-append "substitute " item " "
+                                           destination "\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
+
 (define %public-key
   ;; This key is known to be in the ACL by default.
   (call-with-input-file (string-append %config-directory "/signing-key.pub")
@@ -184,6 +192,11 @@ a file for NARINFO."
 ;; Transmit these options to 'guix substitute'.
 (substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
 
+;; Never use file descriptor 4, unlike what happens when invoked by the
+;; daemon.
+(%error-to-file-descriptor-4? #f)
+
+\f
 (test-equal "query narinfo without signature"
   ""                                              ; not substitutable
 
@@ -284,10 +297,12 @@ System: mips64el-linux\n")
 (test-quit "substitute, no signature"
     "no valid substitute"
   (with-narinfo %narinfo
-    (guix-substitute "--substitute"
-                     (string-append (%store-prefix)
-                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                     "foo")))
+    (with-input-from-string (string-append "substitute "
+                                           (%store-prefix)
+                                           "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                           " foo\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
 
 (test-quit "substitute, invalid hash"
     "no valid substitute"
@@ -295,10 +310,12 @@ System: mips64el-linux\n")
   (with-narinfo (string-append %narinfo "Signature: "
                                (signature-field "different body")
                                "\n")
-    (guix-substitute "--substitute"
-                     (string-append (%store-prefix)
-                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                     "foo")))
+    (with-input-from-string (string-append "substitute "
+                                           (%store-prefix)
+                                           "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                           " foo\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
 
 (test-quit "substitute, unauthorized key"
     "no valid substitute"
@@ -307,10 +324,12 @@ System: mips64el-linux\n")
                                 %narinfo
                                 #:public-key %wrong-public-key)
                                "\n")
-    (guix-substitute "--substitute"
-                     (string-append (%store-prefix)
-                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                     "foo")))
+    (with-input-from-string (string-append "substitute "
+                                           (%store-prefix)
+                                           "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                           " foo\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
 
 (test-equal "substitute, authorized key"
   "Substitutable data."
@@ -319,10 +338,9 @@ System: mips64el-linux\n")
     (dynamic-wind
       (const #t)
       (lambda ()
-        (guix-substitute "--substitute"
-                         (string-append (%store-prefix)
-                                        "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                         "substitute-retrieved")
+        (request-substitution (string-append (%store-prefix)
+                                             "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                              "substitute-retrieved")
         (call-with-input-file "substitute-retrieved" get-string-all))
       (lambda ()
         (false-if-exception (delete-file "substitute-retrieved"))))))
@@ -352,10 +370,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
@@ -381,10 +398,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
@@ -417,10 +433,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
@@ -451,10 +466,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
@@ -470,10 +484,12 @@ System: mips64el-linux\n")
                                    #:public-key %wrong-public-key))
         %main-substitute-directory
 
-      (guix-substitute "--substitute"
-                       (string-append (%store-prefix)
-                                      "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                       "substitute-retrieved"))))
+      (with-input-from-string (string-append "substitute "
+                                             (%store-prefix)
+                                             "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                             " substitute-retrieved\n")
+        (lambda ()
+          (guix-substitute "--substitute"))))))
 
 (test-equal "substitute, narinfo with several URLs"
   "Substitutable data."
@@ -513,10 +529,9 @@ System: mips64el-linux\n")))
           (parameterize ((substitute-urls
                           (list (string-append "file://"
                                                %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
-- 
2.29.2

[bug#45018] [PATCH 4/6] daemon: Run 'guix substitute --substitute' as an agent.

[Mathieu Othacehe]

Hey,

> +    /* The substituter. */
> +    std::shared_ptr<Agent> substituter;

There's only one owner at a time, right? Maybe prefer unique_ptr.

Thanks,

Mathieu

[bug#45018] [PATCH 4/6] daemon: Run 'guix substitute --substitute' as an agent.

[Ludovic Courtès]

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

>> +    /* The substituter. */
>> +    std::shared_ptr<Agent> substituter;
>
> There's only one owner at a time, right? Maybe prefer unique_ptr.

I’m not sure I understand the semantics of ‘unique_ptr’.  ‘shared_ptr’
does reference counting, AIUI, and that’s what I want here, no?

Ludo’.

[bug#45018] [PATCH 5/6] substitute: Cache and reuse connections while substituting.

[Ludovic Courtès]

That way, when fetching a series of substitutes from the same server(s),
the connection is reused instead of being closed/opened for each
substitutes, which saves on network round trips and TLS handshakes.

* guix/http-client.scm (http-fetch): Add #:keep-alive? and honor it.
* guix/progress.scm (progress-report-port): Add #:close? parameter and
honor it.
* guix/scripts/substitute.scm (fetch): Add #:port and #:keep-alive? and
honor them.
(open-connection-for-uri/cached, call-with-cached-connection): New
procedures.
(with-cached-connection): New macro.
(process-substitution): Wrap 'fetch' call in 'with-cached-connection'.
Pass #:close? to 'progress-report-port'.
---
 guix/http-client.scm        | 12 +++---
 guix/progress.scm           |  8 ++--
 guix/scripts/substitute.scm | 75 +++++++++++++++++++++++++++++++------
 3 files changed, 75 insertions(+), 20 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index a767175d67..553640fe9e 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
@@ -70,6 +70,7 @@
 
 
 (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
+                     (keep-alive? #f)
                      (verify-certificate? #t)
                      (headers '((user-agent . "GNU Guile")))
                      timeout)
@@ -79,6 +80,9 @@ textual.  Follow any HTTP redirection.  When BUFFERED? is #f, return an
 unbuffered port, suitable for use in `filtered-port'.  HEADERS is an alist of
 extra HTTP headers.
 
+When KEEP-ALIVE? is true, the connection is marked as 'keep-alive' and PORT is
+not closed upon completion.
+
 When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates.
 
 TIMEOUT specifies the timeout in seconds for connection establishment; when
@@ -104,11 +108,7 @@ Raise an '&http-get-error' condition if downloading fails."
         (setvbuf port 'none))
       (let*-values (((resp data)
                      (http-get uri #:streaming? #t #:port port
-                               ;; XXX: When #:keep-alive? is true, if DATA is
-                               ;; a chunked-encoding port, closing DATA won't
-                               ;; close PORT, leading to a file descriptor
-                               ;; leak.
-                               #:keep-alive? #f
+                               #:keep-alive? keep-alive?
                                #:headers headers))
                     ((code)
                      (response-code resp)))
diff --git a/guix/progress.scm b/guix/progress.scm
index fec65b424c..cd80ae620a 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -337,9 +337,10 @@ should be a <progress-reporter> object."
               (report total)
               (loop total (get-bytevector-n! in buffer 0 buffer-size))))))))
 
-(define (progress-report-port reporter port)
+(define* (progress-report-port reporter port #:key (close? #t))
   "Return a port that continuously reports the bytes read from PORT using
-REPORTER, which should be a <progress-reporter> object."
+REPORTER, which should be a <progress-reporter> object.  When CLOSE? is true,
+PORT is closed when the returned port is closed."
   (match reporter
     (($ <progress-reporter> start report stop)
      (let* ((total 0)
@@ -364,5 +365,6 @@ REPORTER, which should be a <progress-reporter> object."
                                         ;; trace.
                                         (unless (zero? total)
                                           (stop))
-                                        (close-port port)))))))
+                                        (when close?
+                                          (close-port port))))))))
 
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 334d3c97f8..d6b2a5884f 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -188,9 +188,14 @@ again."
         (sigaction SIGALRM SIG_DFL)
         (apply values result)))))
 
-(define* (fetch uri #:key (buffered? #t) (timeout? #t))
+(define* (fetch uri #:key (buffered? #t) (timeout? #t)
+                (keep-alive? #f) (port #f))
   "Return a binary input port to URI and the number of bytes it's expected to
-provide."
+provide.
+
+When PORT is true, use it as the underlying I/O port for HTTP transfers; when
+PORT is false, open a new connection for URI.  When KEEP-ALIVE? is true, the
+connection (typically PORT) is kept open once data has been fetched from URI."
   (case (uri-scheme uri)
     ((file)
      (let ((port (open-file (uri-path uri)
@@ -206,7 +211,7 @@ provide."
        ;;   sudo tc qdisc add dev eth0 root netem delay 1500ms
        ;; and then cancel with:
        ;;   sudo tc qdisc del dev eth0 root
-       (let ((port #f))
+       (let ((port port))
          (with-timeout (if timeout?
                            %fetch-timeout
                            0)
@@ -217,10 +222,11 @@ provide."
            (begin
              (when (or (not port) (port-closed? port))
                (set! port (guix:open-connection-for-uri
-                           uri #:verify-certificate? #f))
-               (unless (or buffered? (not (file-port? port)))
-                 (setvbuf port 'none)))
+                           uri #:verify-certificate? #f)))
+             (unless (or buffered? (not (file-port? port)))
+               (setvbuf port 'none))
              (http-fetch uri #:text? #f #:port port
+                         #:keep-alive? keep-alive?
                          #:verify-certificate? #f))))))
     (else
      (leave (G_ "unsupported substitute URI scheme: ~a~%")
@@ -962,6 +968,48 @@ the URI, its compression method (a string), and the compressed file size."
     (((uri compression file-size) _ ...)
      (values uri compression file-size))))
 
+(define open-connection-for-uri/cached
+  (let ((cache (make-hash-table)))
+    (lambda* (uri #:key fresh?)
+      "Return a connection for URI, possibly reusing a cached connection.
+When FRESH? is true, delete any cached connections for URI and open a new
+one.  Return #f if URI's scheme is 'file' or #f."
+      (define host (uri-host uri))
+      (define scheme (uri-scheme uri))
+      (define key (cons host scheme))
+
+      (and (not (memq scheme '(file #f)))
+           (match (hash-ref cache key)
+             (#f
+              (let ((socket (guix:open-connection-for-uri
+                             uri #:verify-certificate? #f)))
+                (hash-set! cache key socket)
+                socket))
+             (socket
+              (if (or fresh? (port-closed? socket))
+                  (begin
+                    (false-if-exception (close-port socket))
+                    (hash-remove! cache key)
+                    (open-connection-for-uri/cached uri))
+                  socket)))))))
+
+(define (call-with-cached-connection uri proc)
+  (let ((port (open-connection-for-uri/cached uri)))
+    (catch 'system-error
+      (lambda ()
+        (proc port))
+      (lambda args
+        ;; If PORT was cached and the server closed the connection in the
+        ;; meantime, we get EPIPE.  In that case, open a fresh connection and
+        ;; retry.
+        (if (= EPIPE (system-error-errno args))
+            (proc (open-connection-for-uri/cached uri #:fresh? #t))
+            (apply throw args))))))
+
+(define-syntax-rule (with-cached-connection uri port exp ...)
+  "Bind PORT with EXP... to a socket connected to URI."
+  (call-with-cached-connection uri (lambda (port) exp ...)))
+
 (define* (process-substitution store-item destination
                                #:key cache-urls acl print-build-trace?)
   "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
@@ -984,10 +1032,12 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
               (G_ "Downloading ~a...~%") (uri->string uri)))
 
     (let*-values (((raw download-size)
-                   ;; Note that Hydra currently generates Nars on the fly
-                   ;; and doesn't specify a Content-Length, so
-                   ;; DOWNLOAD-SIZE is #f in practice.
-                   (fetch uri #:buffered? #f #:timeout? #f))
+                   ;; 'guix publish' without '--cache' doesn't specify a
+                   ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
+                   (with-cached-connection uri port
+                     (fetch uri #:buffered? #f #:timeout? #f
+                            #:port port
+                            #:keep-alive? #t)))
                   ((progress)
                    (let* ((dl-size  (or download-size
                                         (and (equal? compression "none")
@@ -1001,7 +1051,9 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
                                          (uri->string uri) dl-size
                                          (current-error-port)
                                          #:abbreviation nar-uri-abbreviation))))
-                     (progress-report-port reporter raw)))
+                     ;; Keep RAW open upon completion so we can later reuse
+                     ;; the underlying connection.
+                     (progress-report-port reporter raw #:close? #f)))
                   ((input pids)
                    ;; NOTE: This 'progress' port of current process will be
                    ;; closed here, while the child process doing the
@@ -1216,6 +1268,7 @@ default value."
 
 ;;; Local Variables:
 ;;; eval: (put 'with-timeout 'scheme-indent-function 1)
+;;; eval: (put 'with-cached-connection 'scheme-indent-function 2)
 ;;; End:
 
 ;;; substitute.scm ends here
-- 
2.29.2

[bug#45018] [PATCH 6/6] daemon: Raise an error if substituter doesn't send the expected hash.

[Ludovic Courtès]

It was already impossible in practice for 'expectedHashStr' to be empty
if 'status' == "success".

* nix/libstore/build.cc (SubstitutionGoal::finished): Throw 'SubstError'
when 'expectedHashStr' is empty.
---
 nix/libstore/build.cc | 37 +++++++++++++++++++------------------
 1 file changed, 19 insertions(+), 18 deletions(-)

diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index 50d300253d..b19181d51f 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -3040,27 +3040,28 @@ void SubstitutionGoal::finished()
         if (!pathExists(destPath))
             throw SubstError(format("substitute did not produce path `%1%'") % destPath);
 
+	if (expectedHashStr == "")
+	    throw SubstError(format("substituter did not communicate hash for `%1'") % storePath);
+
         hash = hashPath(htSHA256, destPath);
 
         /* Verify the expected hash we got from the substituer. */
-        if (expectedHashStr != "") {
-            size_t n = expectedHashStr.find(':');
-            if (n == string::npos)
-                throw Error(format("bad hash from substituter: %1%") % expectedHashStr);
-            HashType hashType = parseHashType(string(expectedHashStr, 0, n));
-            if (hashType == htUnknown)
-                throw Error(format("unknown hash algorithm in `%1%'") % expectedHashStr);
-            Hash expectedHash = parseHash16or32(hashType, string(expectedHashStr, n + 1));
-            Hash actualHash = hashType == htSHA256 ? hash.first : hashPath(hashType, destPath).first;
-            if (expectedHash != actualHash) {
-		if (settings.printBuildTrace)
-		    printMsg(lvlError, format("@ hash-mismatch %1% %2% %3% %4%")
-			     % storePath % "sha256"
-			     % printHash16or32(expectedHash)
-			     % printHash16or32(actualHash));
-                throw SubstError(format("hash mismatch for substituted item `%1%'") % storePath);
-	    }
-        }
+	size_t n = expectedHashStr.find(':');
+	if (n == string::npos)
+	    throw Error(format("bad hash from substituter: %1%") % expectedHashStr);
+	HashType hashType = parseHashType(string(expectedHashStr, 0, n));
+	if (hashType == htUnknown)
+	    throw Error(format("unknown hash algorithm in `%1%'") % expectedHashStr);
+	Hash expectedHash = parseHash16or32(hashType, string(expectedHashStr, n + 1));
+	Hash actualHash = hashType == htSHA256 ? hash.first : hashPath(hashType, destPath).first;
+	if (expectedHash != actualHash) {
+	    if (settings.printBuildTrace)
+		printMsg(lvlError, format("@ hash-mismatch %1% %2% %3% %4%")
+			 % storePath % "sha256"
+			 % printHash16or32(expectedHash)
+			 % printHash16or32(actualHash));
+	    throw SubstError(format("hash mismatch for substituted item `%1%'") % storePath);
+	}
 
     } catch (SubstError & e) {
 
-- 
2.29.2

[bug#45018] [PATCH 0/6] Process and connection reuse for substitutions

[宋文武]

Ludovic Courtès <ludo@gnu.org> writes:

> Hi Guix!
>
> The attached patches optimize substitute downloads by: (1) keeping
> a single ‘guix substitute’ process for all the substitutes (instead
> of respawning a new one each time a store item is substituted), and
> (2) reusing connections to substitute servers in between substitutions.
> ...
> Anyway, I think it’s a welcome improvement, especially when
> downloading lots of stuff such as during the initial system installation.
> Plus, there are more deletions than insertions.  :-)
>
> Thoughts?

I think this will definitely help my unstable internet connections and
slow hdd, thank you!

[bug#45018] [PATCH 0/6] Process and connection reuse for substitutions

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 452 bytes --]

Ludovic Courtès <ludo@gnu.org> skribis:

> The attached patches optimize substitute downloads by: (1) keeping
> a single ‘guix substitute’ process for all the substitutes (instead
> of respawning a new one each time a store item is substituted), and
> (2) reusing connections to substitute servers in between substitutions.

As an illustration of what happens at the process level, here’s the perf
timechart in the current situation:


[-- Attachment #2: substitute-chart-one-process-per-substitute.png --]
[-- Type: image/png, Size: 101154 bytes --]

[-- Attachment #3: Type: text/plain, Size: 56 bytes --]


Here’s the timeline once we’re using an agent:


[-- Attachment #4: substitute-chart-agent.png --]
[-- Type: image/png, Size: 55081 bytes --]

[-- Attachment #5: Type: text/plain, Size: 399 bytes --]


Blue are periods where the process is running, and grey where it’s
idle—e.g., waiting for data.  After each substitution completion,
guix-daemon becomes busy for a little while (computing the hash of the
store item, adding it to the database).  The startup activity of each
‘guix’ process is visible and in the second case it happens only once
for ‘guix substitute’.

Ludo’.

[bug#45018] [PATCH 0/6] Process and connection reuse for substitutions

[Mathieu Othacehe]

Hey Ludo,

> Blue are periods where the process is running, and grey where it’s
> idle—e.g., waiting for data.  After each substitution completion,
> guix-daemon becomes busy for a little while (computing the hash of the
> store item, adding it to the database).  The startup activity of each
> ‘guix’ process is visible and in the second case it happens only once
> for ‘guix substitute’.

That's a great improvement! Besides a few remarks, it looks good to me!

Thanks,

Mathieu

[bug#45018] [PATCH v2 0/6] Process and connection reuse for substitutions

[Ludovic Courtès]

Hello!

This update fixes issues that Chris uncovered during testing and
addresses comments Mathieu made.  Changes since v1:

  1. The daemon, in ‘SubstitutionGoal::handleChildOutput’, properly
     deal with the case where ‘data’ contains several lines, such as a
     “sha256:…” line and a “success” line.

  2. ‘call-with-cached-connection’ catches exceptions that may be
     raised by (web response) when reusing a stale socket.

  3. The connection cache is now an alist instead of a hash table and
     care is taken to evict old entries once it has reached
     ‘%max-cached-connections’.

  4. Fixed typo in comment in (guix scripts substitute).

I’ll go ahead with this version soonish if there are no objections.

Ludo’.

Ludovic Courtès (6):
  daemon: 'Agent' constructor takes a list of environment variables.
  daemon: Use 'Agent' to spawn 'guix substitute --query'.
  daemon: Factorize substituter agent spawning.
  daemon: Run 'guix substitute --substitute' as an agent.
  substitute: Cache and reuse connections while substituting.
  daemon: Raise an error if substituter doesn't send the expected hash.

 guix/http-client.scm        |  12 +-
 guix/progress.scm           |   8 +-
 guix/scripts/substitute.scm | 243 ++++++++++++++++++++++++------------
 nix/libstore/build.cc       | 173 +++++++++++++------------
 nix/libstore/local-store.cc | 170 ++++++-------------------
 nix/libstore/local-store.hh |  25 +---
 nix/libutil/util.cc         |   6 +-
 nix/libutil/util.hh         |   7 +-
 tests/substitute.scm        |  98 +++++++++------
 9 files changed, 381 insertions(+), 361 deletions(-)

-- 
2.29.2

[bug#45018] [PATCH v2 1/6] daemon: 'Agent' constructor takes a list of environment variables.

[Ludovic Courtès]

* nix/libutil/util.hh (struct Agent)[Agent]: Add 'env' parameter.
* nix/libutil/util.cc (Agent::Agent): Honor it.
---
 nix/libutil/util.cc | 6 +++++-
 nix/libutil/util.hh | 7 +++++--
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/nix/libutil/util.cc b/nix/libutil/util.cc
index 59a2981359..69f1c634a9 100644
--- a/nix/libutil/util.cc
+++ b/nix/libutil/util.cc
@@ -1173,7 +1173,7 @@ void commonChildInit(Pipe & logPipe)
 
 //////////////////////////////////////////////////////////////////////
 
-Agent::Agent(const string &command, const Strings &args)
+Agent::Agent(const string &command, const Strings &args, const std::map<string, string> &env)
 {
     debug(format("starting agent '%1%'") % command);
 
@@ -1191,6 +1191,10 @@ Agent::Agent(const string &command, const Strings &args)
 
         commonChildInit(fromAgent);
 
+	for (auto pair: env) {
+	    setenv(pair.first.c_str(), pair.second.c_str(), 1);
+	}
+
         if (chdir("/") == -1) throw SysError("changing into `/");
 
         /* Dup the communication pipes. */
diff --git a/nix/libutil/util.hh b/nix/libutil/util.hh
index 13cff44316..880b0e93b2 100644
--- a/nix/libutil/util.hh
+++ b/nix/libutil/util.hh
@@ -7,6 +7,7 @@
 #include <dirent.h>
 #include <unistd.h>
 #include <signal.h>
+#include <map>
 #include <functional>
 
 #include <cstdio>
@@ -281,8 +282,10 @@ struct Agent
     /* The process ID of the agent. */
     Pid pid;
 
-    /* The command and arguments passed to the agent.  */
-    Agent(const string &command, const Strings &args);
+    /* The command and arguments passed to the agent along with a list of
+       environment variable name/value pairs.  */
+    Agent(const string &command, const Strings &args,
+	  const std::map<string, string> &env = std::map<string, string>());
 
     ~Agent();
 };
-- 
2.29.2

[bug#45018] [PATCH v2 2/6] daemon: Use 'Agent' to spawn 'guix substitute --query'.

[Ludovic Courtès]

* nix/libstore/local-store.hh (RunningSubstituter): Remove.
(LocalStore)[runningSubstituter]: Change to unique_ptr<Agent>.
[setSubstituterEnv, didSetSubstituterEnv]: Remove.
[getLineFromSubstituter, getIntLineFromSubstituter]: Take an 'Agent'.
* nix/libstore/local-store.cc (LocalStore::~LocalStore): Remove
reference to 'runningSubstituter'.
(LocalStore::setSubstituterEnv, LocalStore::startSubstituter): Remove.
(LocalStore::getLineFromSubstituter): Adjust to 'run' being an 'Agent'.
(LocalStore::querySubstitutablePaths): Spawn substituter agent if
needed.  Adjust to 'Agent' interface.
(LocalStore::querySubstitutablePathInfos): Likewise.
* nix/libstore/build.cc (SubstitutionGoal::tryToRun): Remove call to
'setSubstituterEnv' and add 'setenv' call for "_NIX_OPTIONS" instead.
(SubstitutionGoal::finished): Remove 'readLine' call for 'dummy'.
* guix/scripts/substitute.scm (%allow-unauthenticated-substitutes?):
Remove second argument to 'make-parameter'.
(process-query): Call 'warn-about-missing-authentication'
when (%allow-unauthenticated-substitutes?) is #t.
(guix-substitute): Wrap body in 'parameterize'.  Set 'guix-warning-port'
too.  No longer exit when 'substitute-urls' returns the empty list.  No
longer print newline initially.
* tests/substitute.scm (test-quit): Parameterize 'current-error-port' to
account for the port changes in 'guix-substitute'.
---
 guix/scripts/substitute.scm | 122 ++++++++++++++--------------
 nix/libstore/build.cc       |   6 +-
 nix/libstore/local-store.cc | 157 +++++++++---------------------------
 nix/libstore/local-store.hh |  22 +----
 tests/substitute.scm        |   3 +-
 5 files changed, 104 insertions(+), 206 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index adc6852321..c756b27999 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -124,11 +124,7 @@ disabled!~%"))
   ;; purposes, and should be avoided otherwise.
   (make-parameter
    (and=> (getenv "GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES")
-          (cut string-ci=? <> "yes"))
-   (lambda (value)
-     (when value
-       (warn-about-missing-authentication))
-     value)))
+          (cut string-ci=? <> "yes"))))
 
 (define %narinfo-ttl
   ;; Number of seconds during which cached narinfo lookups are considered
@@ -893,6 +889,9 @@ authorized substitutes."
   (define (valid? obj)
     (valid-narinfo? obj acl))
 
+  (when (%allow-unauthenticated-substitutes?)
+    (warn-about-missing-authentication))
+
   (match (string-tokenize command)
     (("have" paths ..1)
      ;; Return the subset of PATHS available in CACHE-URLS.
@@ -1137,68 +1136,67 @@ default value."
       ((= string->number number) (> number 0))
       (_ #f)))
 
-  (mkdir-p %narinfo-cache-directory)
-  (maybe-remove-expired-cache-entries %narinfo-cache-directory
-                                      cached-narinfo-files
-                                      #:entry-expiration
-                                      cached-narinfo-expiration-time
-                                      #:cleanup-period
-                                      %narinfo-expired-cache-entry-removal-delay)
-  (check-acl-initialized)
+  ;; The daemon's agent code opens file descriptor 4 for us and this is where
+  ;; stderr should go.
+  (parameterize ((current-error-port (match args
+                                       (("--query") (fdopen 4 "wl"))
+                                       (_ (current-error-port)))))
+    ;; Redirect diagnostics to file descriptor 4 as well.
+    (guix-warning-port (current-error-port))
 
-  ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly
-  ;; when we know we cannot substitute, but we must emit a newline on stdout
-  ;; when everything is alright.
-  (when (null? (substitute-urls))
-    (exit 0))
+    (mkdir-p %narinfo-cache-directory)
+    (maybe-remove-expired-cache-entries %narinfo-cache-directory
+                                        cached-narinfo-files
+                                        #:entry-expiration
+                                        cached-narinfo-expiration-time
+                                        #:cleanup-period
+                                        %narinfo-expired-cache-entry-removal-delay)
+    (check-acl-initialized)
 
-  ;; Say hello (see above.)
-  (newline)
-  (force-output (current-output-port))
+    ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error
+    ;; message.
+    (for-each validate-uri (substitute-urls))
 
-  ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error message.
-  (for-each validate-uri (substitute-urls))
+    ;; Attempt to install the client's locale so that messages are suitably
+    ;; translated.  LC_CTYPE must be a UTF-8 locale; it's the case by default
+    ;; so don't change it.
+    (match (or (find-daemon-option "untrusted-locale")
+               (find-daemon-option "locale"))
+      (#f     #f)
+      (locale (false-if-exception (setlocale LC_MESSAGES locale))))
 
-  ;; Attempt to install the client's locale so that messages are suitably
-  ;; translated.  LC_CTYPE must be a UTF-8 locale; it's the case by default so
-  ;; don't change it.
-  (match (or (find-daemon-option "untrusted-locale")
-             (find-daemon-option "locale"))
-    (#f     #f)
-    (locale (false-if-exception (setlocale LC_MESSAGES locale))))
+    (catch 'system-error
+      (lambda ()
+        (set-thread-name "guix substitute"))
+      (const #t))                                 ;GNU/Hurd lacks 'prctl'
 
-  (catch 'system-error
-    (lambda ()
-      (set-thread-name "guix substitute"))
-    (const #t))                                   ;GNU/Hurd lacks 'prctl'
-
-  (with-networking
-   (with-error-handling                           ; for signature errors
-     (match args
-       (("--query")
-        (let ((acl (current-acl)))
-          (let loop ((command (read-line)))
-            (or (eof-object? command)
-                (begin
-                  (process-query command
-                                 #:cache-urls (substitute-urls)
-                                 #:acl acl)
-                  (loop (read-line)))))))
-       (("--substitute" store-path destination)
-        ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
-        ;; Specify the number of columns of the terminal so the progress
-        ;; report displays nicely.
-        (parameterize ((current-terminal-columns (client-terminal-columns)))
-          (process-substitution store-path destination
-                                #:cache-urls (substitute-urls)
-                                #:acl (current-acl)
-                                #:print-build-trace? print-build-trace?)))
-       ((or ("-V") ("--version"))
-        (show-version-and-exit "guix substitute"))
-       (("--help")
-        (show-help))
-       (opts
-        (leave (G_ "~a: unrecognized options~%") opts))))))
+    (with-networking
+     (with-error-handling                         ; for signature errors
+       (match args
+         (("--query")
+          (let ((acl (current-acl)))
+            (let loop ((command (read-line)))
+              (or (eof-object? command)
+                  (begin
+                    (process-query command
+                                   #:cache-urls (substitute-urls)
+                                   #:acl acl)
+                    (loop (read-line)))))))
+         (("--substitute" store-path destination)
+          ;; Download STORE-PATH and store it as a Nar in file DESTINATION.
+          ;; Specify the number of columns of the terminal so the progress
+          ;; report displays nicely.
+          (parameterize ((current-terminal-columns (client-terminal-columns)))
+            (process-substitution store-path destination
+                                  #:cache-urls (substitute-urls)
+                                  #:acl (current-acl)
+                                  #:print-build-trace? print-build-trace?)))
+         ((or ("-V") ("--version"))
+          (show-version-and-exit "guix substitute"))
+         (("--help")
+          (show-help))
+         (opts
+          (leave (G_ "~a: unrecognized options~%") opts)))))))
 
 ;;; Local Variables:
 ;;; eval: (put 'with-timeout 'scheme-indent-function 1)
diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index 8413819114..7e9ab3f39c 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -2986,8 +2986,6 @@ void SubstitutionGoal::tryToRun()
     if (pathExists(destPath))
         deletePath(destPath);
 
-    worker.store.setSubstituterEnv();
-
     /* Fill in the arguments. */
     Strings args;
     args.push_back("guix");
@@ -2999,6 +2997,9 @@ void SubstitutionGoal::tryToRun()
     /* Fork the substitute program. */
     pid = startProcess([&]() {
 
+	/* Communicate substitute-urls & co. to 'guix substitute'.  */
+        setenv("_NIX_OPTIONS", settings.pack().c_str(), 1);
+
         commonChildInit(logPipe);
 
         if (dup2(outPipe.writeSide, STDOUT_FILENO) == -1)
@@ -3041,7 +3042,6 @@ void SubstitutionGoal::finished()
     logPipe.readSide.close();
 
     /* Get the hash info from stdout. */
-    string dummy = readLine(outPipe.readSide);
     string expectedHashStr = statusOk(status) ? readLine(outPipe.readSide) : "";
     outPipe.readSide.close();
 
diff --git a/nix/libstore/local-store.cc b/nix/libstore/local-store.cc
index 8c479002ec..4219573a56 100644
--- a/nix/libstore/local-store.cc
+++ b/nix/libstore/local-store.cc
@@ -57,7 +57,6 @@ void checkStoreNotSymlink()
 
 
 LocalStore::LocalStore(bool reserveSpace)
-    : didSetSubstituterEnv(false)
 {
     schemaPath = settings.nixDBPath + "/schema";
 
@@ -182,21 +181,6 @@ LocalStore::LocalStore(bool reserveSpace)
 
 LocalStore::~LocalStore()
 {
-    try {
-	if (runningSubstituter) {
-	    RunningSubstituter &i = *runningSubstituter;
-            if (!i.disabled) {
-		i.to.close();
-		i.from.close();
-		i.error.close();
-		if (i.pid != -1)
-		    i.pid.wait(true);
-	    }
-        }
-    } catch (...) {
-        ignoreException();
-    }
-
     try {
         if (fdTempRoots != -1) {
             fdTempRoots.close();
@@ -796,96 +780,31 @@ Path LocalStore::queryPathFromHashPart(const string & hashPart)
     });
 }
 
-
-void LocalStore::setSubstituterEnv()
-{
-    if (didSetSubstituterEnv) return;
-
-    /* Pass configuration options (including those overridden with
-       --option) to substituters. */
-    setenv("_NIX_OPTIONS", settings.pack().c_str(), 1);
-
-    didSetSubstituterEnv = true;
-}
-
-
-void LocalStore::startSubstituter(RunningSubstituter & run)
-{
-    if (run.disabled || run.pid != -1) return;
-
-    debug(format("starting substituter program `%1% substitute'")
-	  % settings.guixProgram);
-
-    Pipe toPipe, fromPipe, errorPipe;
-
-    toPipe.create();
-    fromPipe.create();
-    errorPipe.create();
-
-    setSubstituterEnv();
-
-    run.pid = startProcess([&]() {
-        if (dup2(toPipe.readSide, STDIN_FILENO) == -1)
-            throw SysError("dupping stdin");
-        if (dup2(fromPipe.writeSide, STDOUT_FILENO) == -1)
-            throw SysError("dupping stdout");
-        if (dup2(errorPipe.writeSide, STDERR_FILENO) == -1)
-            throw SysError("dupping stderr");
-        execl(settings.guixProgram.c_str(), "guix", "substitute", "--query", NULL);
-        throw SysError(format("executing `%1%'") % settings.guixProgram);
-    });
-
-    run.to = toPipe.writeSide.borrow();
-    run.from = run.fromBuf.fd = fromPipe.readSide.borrow();
-    run.error = errorPipe.readSide.borrow();
-
-    toPipe.readSide.close();
-    fromPipe.writeSide.close();
-    errorPipe.writeSide.close();
-
-    /* The substituter may exit right away if it's disabled in any way
-       (e.g. copy-from-other-stores.pl will exit if no other stores
-       are configured). */
-    try {
-        getLineFromSubstituter(run);
-    } catch (EndOfFile & e) {
-        run.to.close();
-        run.from.close();
-        run.error.close();
-        run.disabled = true;
-        if (run.pid.wait(true) != 0) throw;
-    }
-}
-
-
 /* Read a line from the substituter's stdout, while also processing
    its stderr. */
-string LocalStore::getLineFromSubstituter(RunningSubstituter & run)
+string LocalStore::getLineFromSubstituter(Agent & run)
 {
     string res, err;
 
-    /* We might have stdout data left over from the last time. */
-    if (run.fromBuf.hasData()) goto haveData;
-
     while (1) {
         checkInterrupt();
 
         fd_set fds;
         FD_ZERO(&fds);
-        FD_SET(run.from, &fds);
-        FD_SET(run.error, &fds);
+        FD_SET(run.fromAgent.readSide, &fds);
+        FD_SET(run.builderOut.readSide, &fds);
 
         /* Wait for data to appear on the substituter's stdout or
            stderr. */
-        if (select(run.from > run.error ? run.from + 1 : run.error + 1, &fds, 0, 0, 0) == -1) {
+        if (select(std::max(run.fromAgent.readSide, run.builderOut.readSide) + 1, &fds, 0, 0, 0) == -1) {
             if (errno == EINTR) continue;
             throw SysError("waiting for input from the substituter");
         }
 
         /* Completely drain stderr before dealing with stdout. */
-        if (FD_ISSET(run.error, &fds)) {
+        if (FD_ISSET(run.builderOut.readSide, &fds)) {
             char buf[4096];
-            ssize_t n = read(run.error, (unsigned char *) buf, sizeof(buf));
+            ssize_t n = read(run.builderOut.readSide, (unsigned char *) buf, sizeof(buf));
             if (n == -1) {
                 if (errno == EINTR) continue;
                 throw SysError("reading from substituter's stderr");
@@ -903,23 +822,20 @@ string LocalStore::getLineFromSubstituter(RunningSubstituter & run)
         }
 
         /* Read from stdout until we get a newline or the buffer is empty. */
-        else if (run.fromBuf.hasData() || FD_ISSET(run.from, &fds)) {
-        haveData:
-            do {
-                unsigned char c;
-                run.fromBuf(&c, 1);
-                if (c == '\n') {
-                    if (!err.empty()) printMsg(lvlError, "substitute: " + err);
-                    return res;
-                }
-                res += c;
-            } while (run.fromBuf.hasData());
+        else if (FD_ISSET(run.fromAgent.readSide, &fds)) {
+	    unsigned char c;
+	    readFull(run.fromAgent.readSide, (unsigned char *) &c, 1);
+	    if (c == '\n') {
+		if (!err.empty()) printMsg(lvlError, "substitute: " + err);
+		return res;
+	    }
+	    res += c;
         }
     }
 }
 
 
-template<class T> T LocalStore::getIntLineFromSubstituter(RunningSubstituter & run)
+template<class T> T LocalStore::getIntLineFromSubstituter(Agent & run)
 {
     string s = getLineFromSubstituter(run);
     T res;
@@ -935,27 +851,26 @@ PathSet LocalStore::querySubstitutablePaths(const PathSet & paths)
     if (!settings.useSubstitutes || paths.empty()) return res;
 
     if (!runningSubstituter) {
-	std::unique_ptr<RunningSubstituter>fresh(new RunningSubstituter);
+	const Strings args = { "substitute", "--query" };
+	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
+	std::unique_ptr<Agent> fresh(new Agent(settings.guixProgram, args, env));
 	runningSubstituter.swap(fresh);
     }
 
-    RunningSubstituter & run = *runningSubstituter;
-    startSubstituter(run);
+    Agent & run = *runningSubstituter;
 
-    if (!run.disabled) {
-	string s = "have ";
-	foreach (PathSet::const_iterator, j, paths)
-	    if (res.find(*j) == res.end()) { s += *j; s += " "; }
-	writeLine(run.to, s);
-	while (true) {
-	    /* FIXME: we only read stderr when an error occurs, so
-	       substituters should only write (short) messages to
-	       stderr when they fail.  I.e. they shouldn't write debug
-	       output. */
-	    Path path = getLineFromSubstituter(run);
-	    if (path == "") break;
-	    res.insert(path);
-	}
+    string s = "have ";
+    foreach (PathSet::const_iterator, j, paths)
+	if (res.find(*j) == res.end()) { s += *j; s += " "; }
+    writeLine(run.toAgent.writeSide, s);
+    while (true) {
+	/* FIXME: we only read stderr when an error occurs, so
+	   substituters should only write (short) messages to
+	   stderr when they fail.  I.e. they shouldn't write debug
+	   output. */
+	Path path = getLineFromSubstituter(run);
+	if (path == "") break;
+	res.insert(path);
     }
 
     return res;
@@ -967,18 +882,18 @@ void LocalStore::querySubstitutablePathInfos(PathSet & paths, SubstitutablePathI
     if (!settings.useSubstitutes) return;
 
     if (!runningSubstituter) {
-	std::unique_ptr<RunningSubstituter>fresh(new RunningSubstituter);
+	const Strings args = { "substitute", "--query" };
+	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
+	std::unique_ptr<Agent> fresh(new Agent(settings.guixProgram, args, env));
 	runningSubstituter.swap(fresh);
     }
 
-    RunningSubstituter & run = *runningSubstituter;
-    startSubstituter(run);
-    if (run.disabled) return;
+    Agent & run = *runningSubstituter;
 
     string s = "info ";
     foreach (PathSet::const_iterator, i, paths)
         if (infos.find(*i) == infos.end()) { s += *i; s += " "; }
-    writeLine(run.to, s);
+    writeLine(run.toAgent.writeSide, s);
 
     while (true) {
         Path path = getLineFromSubstituter(run);
diff --git a/nix/libstore/local-store.hh b/nix/libstore/local-store.hh
index 2e48cf03e6..57d15bac7e 100644
--- a/nix/libstore/local-store.hh
+++ b/nix/libstore/local-store.hh
@@ -38,21 +38,11 @@ struct OptimiseStats
 };
 
 
-struct RunningSubstituter
-{
-    Pid pid;
-    AutoCloseFD to, from, error;
-    FdSource fromBuf;
-    bool disabled;
-    RunningSubstituter() : disabled(false) { };
-};
-
-
 class LocalStore : public StoreAPI
 {
 private:
     /* The currently running substituter or empty.  */
-    std::unique_ptr<RunningSubstituter> runningSubstituter;
+    std::unique_ptr<Agent> runningSubstituter;
 
     Path linksDir;
 
@@ -178,8 +168,6 @@ public:
 
     void markContentsGood(const Path & path);
 
-    void setSubstituterEnv();
-
     void createUser(const std::string & userName, uid_t userId);
 
 private:
@@ -213,8 +201,6 @@ private:
     /* Cache for pathContentsGood(). */
     std::map<Path, bool> pathContentsGoodCache;
 
-    bool didSetSubstituterEnv;
-
     /* The file to which we write our temporary roots. */
     Path fnTempRoots;
     AutoCloseFD fdTempRoots;
@@ -262,11 +248,9 @@ private:
 
     void removeUnusedLinks(const GCState & state);
 
-    void startSubstituter(RunningSubstituter & runningSubstituter);
+    string getLineFromSubstituter(Agent & run);
 
-    string getLineFromSubstituter(RunningSubstituter & run);
-
-    template<class T> T getIntLineFromSubstituter(RunningSubstituter & run);
+    template<class T> T getIntLineFromSubstituter(Agent & run);
 
     Path createTempDirInStore();
 
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 6560612c40..bd5b6305b0 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -47,7 +47,8 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
   (test-equal name
     '(1 #t)
     (let ((error-output (open-output-string)))
-      (parameterize ((guix-warning-port error-output))
+      (parameterize ((current-error-port error-output)
+                     (guix-warning-port error-output))
         (catch 'quit
           (lambda ()
             exp
-- 
2.29.2

[bug#45018] [PATCH v2 3/6] daemon: Factorize substituter agent spawning.

[Ludovic Courtès]

* nix/libstore/local-store.hh (class LocalStore)[substituter]: New
method.
[runningSubstituter]: Turn into a shared_ptr.
* nix/libstore/local-store.cc (LocalStore::querySubstitutablePaths):
Call 'substituter' instead of using inline code.
(LocalStore::querySubstitutablePathInfos): Likewise.
(LocalStore::substituter): New method.
---
 nix/libstore/local-store.cc | 29 +++++++++++++----------------
 nix/libstore/local-store.hh |  5 ++++-
 2 files changed, 17 insertions(+), 17 deletions(-)

diff --git a/nix/libstore/local-store.cc b/nix/libstore/local-store.cc
index 4219573a56..c304e2ddd1 100644
--- a/nix/libstore/local-store.cc
+++ b/nix/libstore/local-store.cc
@@ -850,14 +850,7 @@ PathSet LocalStore::querySubstitutablePaths(const PathSet & paths)
 
     if (!settings.useSubstitutes || paths.empty()) return res;
 
-    if (!runningSubstituter) {
-	const Strings args = { "substitute", "--query" };
-	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
-	std::unique_ptr<Agent> fresh(new Agent(settings.guixProgram, args, env));
-	runningSubstituter.swap(fresh);
-    }
-
-    Agent & run = *runningSubstituter;
+    Agent & run = *substituter();
 
     string s = "have ";
     foreach (PathSet::const_iterator, j, paths)
@@ -877,18 +870,22 @@ PathSet LocalStore::querySubstitutablePaths(const PathSet & paths)
 }
 
 
+std::shared_ptr<Agent> LocalStore::substituter()
+{
+    if (!runningSubstituter) {
+	const Strings args = { "substitute", "--query" };
+	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
+	runningSubstituter = std::make_shared<Agent>(settings.guixProgram, args, env);
+    }
+
+    return runningSubstituter;
+}
+
 void LocalStore::querySubstitutablePathInfos(PathSet & paths, SubstitutablePathInfos & infos)
 {
     if (!settings.useSubstitutes) return;
 
-    if (!runningSubstituter) {
-	const Strings args = { "substitute", "--query" };
-	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
-	std::unique_ptr<Agent> fresh(new Agent(settings.guixProgram, args, env));
-	runningSubstituter.swap(fresh);
-    }
-
-    Agent & run = *runningSubstituter;
+    Agent & run = *substituter();
 
     string s = "info ";
     foreach (PathSet::const_iterator, i, paths)
diff --git a/nix/libstore/local-store.hh b/nix/libstore/local-store.hh
index 57d15bac7e..9ba37219da 100644
--- a/nix/libstore/local-store.hh
+++ b/nix/libstore/local-store.hh
@@ -42,7 +42,10 @@ class LocalStore : public StoreAPI
 {
 private:
     /* The currently running substituter or empty.  */
-    std::unique_ptr<Agent> runningSubstituter;
+    std::shared_ptr<Agent> runningSubstituter;
+
+    /* Ensure the substituter is running and return it.  */
+    std::shared_ptr<Agent> substituter();
 
     Path linksDir;
 
-- 
2.29.2

[bug#45018] [PATCH v2 4/6] daemon: Run 'guix substitute --substitute' as an agent.

[Ludovic Courtès]

This avoids spawning one substitute process per substitution.

* nix/libstore/build.cc (class Worker)[substituter]: New field.
[outPipe, logPipe, pid]: Remove.
(class SubstitutionGoal)[expectedHashStr, status, substituter]: New fields.
(SubstitutionGoal::timedOut): Adjust to check 'substituter'.
(SubstitutionGoal::tryToRun): Remove references to 'outPipe' and
'logPipe'.  Run "guix substitute --substitute" as an 'Agent'.  Send the
request with 'writeLine'.
(SubstitutionGoal::finished): Likewise.
(SubstitutionGoal::handleChildOutput): Change to fill in
'expectedHashStr' and 'status'.
(SubstitutionGoal::handleEOF): Call 'wakeUp' unconditionally.
(SubstitutionGoal::~SubstitutionGoal): Adjust to check 'substituter'.
* guix/scripts/substitute.scm (process-substitution): Write "success\n"
to stdout upon success.
(%error-to-file-descriptor-4?): New variable.
(guix-substitute): Set 'current-error-port' to file descriptor 4
unless (%error-to-file-descriptor-4?) is false.
Remove "--substitute" arguments.  Loop reading line from stdin.
* tests/substitute.scm <top level>: Call '%error-to-file-descriptor-4?'.
(request-substitution): New procedure.
("substitute, no signature")
("substitute, invalid hash")
("substitute, unauthorized key")
("substitute, authorized key")
("substitute, unauthorized narinfo comes first")
("substitute, unsigned narinfo comes first")
("substitute, first narinfo is unsigned and has wrong hash")
("substitute, first narinfo is unsigned and has wrong refs")
("substitute, two invalid narinfos")
("substitute, narinfo with several URLs"): Adjust to new "guix
substitute --substitute" calling convention.
---
 guix/scripts/substitute.scm |  34 +++++++---
 nix/libstore/build.cc       | 129 ++++++++++++++++++------------------
 tests/substitute.scm        |  95 +++++++++++++++-----------
 3 files changed, 145 insertions(+), 113 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index c756b27999..4bf496f1bc 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -88,6 +88,7 @@
             write-narinfo
 
             %allow-unauthenticated-substitutes?
+            %error-to-file-descriptor-4?
 
             substitute-urls
             guix-substitute))
@@ -1016,7 +1017,10 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
 
       ;; Skip a line after what 'progress-reporter/file' printed, and another
       ;; one to visually separate substitutions.
-      (display "\n\n" (current-error-port)))))
+      (display "\n\n" (current-error-port))
+
+      ;; Tell the daemon that we're done.
+      (display "success\n" (current-output-port)))))
 
 \f
 ;;;
@@ -1125,6 +1129,11 @@ default value."
   (unless (string->uri uri)
     (leave (G_ "~a: invalid URI~%") uri)))
 
+(define %error-to-file-descriptor-4?
+  ;; Whether to direct 'current-error-port' to file descriptor 4 like
+  ;; 'guix-daemon' expects.
+  (make-parameter #t))
+
 (define-command (guix-substitute . args)
   (category internal)
   (synopsis "implement the build daemon's substituter protocol")
@@ -1138,9 +1147,9 @@ default value."
 
   ;; The daemon's agent code opens file descriptor 4 for us and this is where
   ;; stderr should go.
-  (parameterize ((current-error-port (match args
-                                       (("--query") (fdopen 4 "wl"))
-                                       (_ (current-error-port)))))
+  (parameterize ((current-error-port (if (%error-to-file-descriptor-4?)
+                                         (fdopen 4 "wl")
+                                         (current-error-port))))
     ;; Redirect diagnostics to file descriptor 4 as well.
     (guix-warning-port (current-error-port))
 
@@ -1182,15 +1191,22 @@ default value."
                                    #:cache-urls (substitute-urls)
                                    #:acl acl)
                     (loop (read-line)))))))
-         (("--substitute" store-path destination)
+         (("--substitute")
           ;; Download STORE-PATH and store it as a Nar in file DESTINATION.
           ;; Specify the number of columns of the terminal so the progress
           ;; report displays nicely.
           (parameterize ((current-terminal-columns (client-terminal-columns)))
-            (process-substitution store-path destination
-                                  #:cache-urls (substitute-urls)
-                                  #:acl (current-acl)
-                                  #:print-build-trace? print-build-trace?)))
+            (let loop ()
+              (match (read-line)
+                ((? eof-object?)
+                 #t)
+                ((= string-tokenize ("substitute" store-path destination))
+                 (process-substitution store-path destination
+                                       #:cache-urls (substitute-urls)
+                                       #:acl (current-acl)
+                                       #:print-build-trace?
+                                       print-build-trace?)
+                 (loop))))))
          ((or ("-V") ("--version"))
           (show-version-and-exit "guix substitute"))
          (("--help")
diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index 7e9ab3f39c..50d300253d 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -262,6 +262,7 @@ public:
     LocalStore & store;
 
     std::shared_ptr<Agent> hook;
+    std::shared_ptr<Agent> substituter;
 
     Worker(LocalStore & store);
     ~Worker();
@@ -2773,15 +2774,6 @@ private:
     /* Path info returned by the substituter's query info operation. */
     SubstitutablePathInfo info;
 
-    /* Pipe for the substituter's standard output. */
-    Pipe outPipe;
-
-    /* Pipe for the substituter's standard error. */
-    Pipe logPipe;
-
-    /* The process ID of the builder. */
-    Pid pid;
-
     /* Lock on the store path. */
     std::shared_ptr<PathLocks> outputLock;
 
@@ -2795,6 +2787,17 @@ private:
     typedef void (SubstitutionGoal::*GoalState)();
     GoalState state;
 
+    /* The substituter. */
+    std::shared_ptr<Agent> substituter;
+
+    /* Either the empty string, or the expected hash as returned by the
+       substituter.  */
+    string expectedHashStr;
+
+    /* Either the empty string, or the status phrase returned by the
+       substituter.  */
+    string status;
+
     void tryNext();
 
 public:
@@ -2840,7 +2843,7 @@ SubstitutionGoal::SubstitutionGoal(const Path & storePath, Worker & worker, bool
 
 SubstitutionGoal::~SubstitutionGoal()
 {
-    if (pid != -1) worker.childTerminated(pid);
+    if (substituter) worker.childTerminated(substituter->pid);
 }
 
 
@@ -2848,9 +2851,9 @@ void SubstitutionGoal::timedOut()
 {
     if (settings.printBuildTrace)
         printMsg(lvlError, format("@ substituter-failed %1% timeout") % storePath);
-    if (pid != -1) {
-        pid_t savedPid = pid;
-        pid.kill();
+    if (substituter) {
+        pid_t savedPid = substituter->pid;
+	substituter.reset();
         worker.childTerminated(savedPid);
     }
     amDone(ecFailed);
@@ -2977,45 +2980,29 @@ void SubstitutionGoal::tryToRun()
 
     printMsg(lvlInfo, format("fetching path `%1%'...") % storePath);
 
-    outPipe.create();
-    logPipe.create();
-
     destPath = repair ? storePath + ".tmp" : storePath;
 
     /* Remove the (stale) output path if it exists. */
     if (pathExists(destPath))
         deletePath(destPath);
 
-    /* Fill in the arguments. */
-    Strings args;
-    args.push_back("guix");
-    args.push_back("substitute");
-    args.push_back("--substitute");
-    args.push_back(storePath);
-    args.push_back(destPath);
+    if (!worker.substituter) {
+	const Strings args = { "substitute", "--substitute" };
+	const std::map<string, string> env = { { "_NIX_OPTIONS", settings.pack() } };
+	worker.substituter = std::make_shared<Agent>(settings.guixProgram, args, env);
+    }
 
-    /* Fork the substitute program. */
-    pid = startProcess([&]() {
+    /* Borrow the worker's substituter.  */
+    if (!substituter) substituter.swap(worker.substituter);
 
-	/* Communicate substitute-urls & co. to 'guix substitute'.  */
-        setenv("_NIX_OPTIONS", settings.pack().c_str(), 1);
+    /* Send the request to the substituter.  */
+    writeLine(substituter->toAgent.writeSide,
+	      (format("substitute %1% %2%") % storePath % destPath).str());
 
-        commonChildInit(logPipe);
-
-        if (dup2(outPipe.writeSide, STDOUT_FILENO) == -1)
-            throw SysError("cannot dup output pipe into stdout");
-
-        execv(settings.guixProgram.c_str(), stringsToCharPtrs(args).data());
-
-        throw SysError(format("executing `%1% substitute'") % settings.guixProgram);
-    });
-
-    pid.setSeparatePG(true);
-    pid.setKillSignal(SIGTERM);
-    outPipe.writeSide.close();
-    logPipe.writeSide.close();
-    worker.childStarted(shared_from_this(),
-        pid, singleton<set<int> >(logPipe.readSide), true, true);
+    set<int> fds;
+    fds.insert(substituter->fromAgent.readSide);
+    fds.insert(substituter->builderOut.readSide);
+    worker.childStarted(shared_from_this(), substituter->pid, fds, true, true);
 
     state = &SubstitutionGoal::finished;
 
@@ -3030,28 +3017,25 @@ void SubstitutionGoal::finished()
 {
     trace("substitute finished");
 
-    /* Since we got an EOF on the logger pipe, the substitute is
-       presumed to have terminated.  */
-    pid_t savedPid = pid;
-    int status = pid.wait(true);
+    /* Remove the 'guix substitute' process from the list of children.  */
+    worker.childTerminated(substituter->pid);
 
-    /* So the child is gone now. */
-    worker.childTerminated(savedPid);
-
-    /* Close the read side of the logger pipe. */
-    logPipe.readSide.close();
-
-    /* Get the hash info from stdout. */
-    string expectedHashStr = statusOk(status) ? readLine(outPipe.readSide) : "";
-    outPipe.readSide.close();
+    /* If max-jobs > 1, the worker might have created a new 'substitute'
+       process in the meantime.  If that is the case, terminate ours;
+       otherwise, give it back to the worker.  */
+    if (worker.substituter) {
+	substituter.reset ();
+    } else {
+	worker.substituter.swap(substituter);
+    }
 
     /* Check the exit status and the build result. */
     HashResult hash;
     try {
 
-        if (!statusOk(status))
-            throw SubstError(format("fetching path `%1%' %2%")
-                % storePath % statusToString(status));
+        if (status != "success")
+            throw SubstError(format("fetching path `%1%' (status: '%2%')")
+                % storePath % status);
 
         if (!pathExists(destPath))
             throw SubstError(format("substitute did not produce path `%1%'") % destPath);
@@ -3122,16 +3106,33 @@ void SubstitutionGoal::finished()
 
 void SubstitutionGoal::handleChildOutput(int fd, const string & data)
 {
-    assert(fd == logPipe.readSide);
-    if (verbosity >= settings.buildVerbosity) writeToStderr(data);
-    /* Don't write substitution output to a log file for now.  We
-       probably should, though. */
+    if (verbosity >= settings.buildVerbosity
+	&& fd == substituter->builderOut.readSide) {
+	writeToStderr(data);
+	/* Don't write substitution output to a log file for now.  We
+	   probably should, though. */
+    }
+
+    if (fd == substituter->fromAgent.readSide) {
+	/* Trim whitespace to the right.  */
+	size_t end = data.find_last_not_of(" \t\n");
+	string trimmed = (end != string::npos) ? data.substr(0, end + 1) : data;
+
+	if (expectedHashStr == "") {
+	    expectedHashStr = trimmed;
+	} else if (status == "") {
+	    status = trimmed;
+	    worker.wakeUp(shared_from_this());
+	} else {
+	    printMsg(lvlError, format("unexpected substituter message '%1%'") % data);
+	}
+    }
 }
 
 
 void SubstitutionGoal::handleEOF(int fd)
 {
-    if (fd == logPipe.readSide) worker.wakeUp(shared_from_this());
+    worker.wakeUp(shared_from_this());
 }
 
 
diff --git a/tests/substitute.scm b/tests/substitute.scm
index bd5b6305b0..b86ce09425 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -58,6 +58,14 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
                   (let ((message (get-output-string error-output)))
                     (->bool (string-match error-rx message))))))))))
 
+(define (request-substitution item destination)
+  "Run 'guix substitute --substitute' to fetch ITEM to DESTINATION."
+  (parameterize ((guix-warning-port (current-error-port)))
+    (with-input-from-string (string-append "substitute " item " "
+                                           destination "\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
+
 (define %public-key
   ;; This key is known to be in the ACL by default.
   (call-with-input-file (string-append %config-directory "/signing-key.pub")
@@ -184,6 +192,11 @@ a file for NARINFO."
 ;; Transmit these options to 'guix substitute'.
 (substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
 
+;; Never use file descriptor 4, unlike what happens when invoked by the
+;; daemon.
+(%error-to-file-descriptor-4? #f)
+
+\f
 (test-equal "query narinfo without signature"
   ""                                              ; not substitutable
 
@@ -284,10 +297,12 @@ System: mips64el-linux\n")
 (test-quit "substitute, no signature"
     "no valid substitute"
   (with-narinfo %narinfo
-    (guix-substitute "--substitute"
-                     (string-append (%store-prefix)
-                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                     "foo")))
+    (with-input-from-string (string-append "substitute "
+                                           (%store-prefix)
+                                           "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                           " foo\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
 
 (test-quit "substitute, invalid hash"
     "no valid substitute"
@@ -295,10 +310,12 @@ System: mips64el-linux\n")
   (with-narinfo (string-append %narinfo "Signature: "
                                (signature-field "different body")
                                "\n")
-    (guix-substitute "--substitute"
-                     (string-append (%store-prefix)
-                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                     "foo")))
+    (with-input-from-string (string-append "substitute "
+                                           (%store-prefix)
+                                           "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                           " foo\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
 
 (test-quit "substitute, unauthorized key"
     "no valid substitute"
@@ -307,10 +324,12 @@ System: mips64el-linux\n")
                                 %narinfo
                                 #:public-key %wrong-public-key)
                                "\n")
-    (guix-substitute "--substitute"
-                     (string-append (%store-prefix)
-                                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                     "foo")))
+    (with-input-from-string (string-append "substitute "
+                                           (%store-prefix)
+                                           "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                           " foo\n")
+      (lambda ()
+        (guix-substitute "--substitute")))))
 
 (test-equal "substitute, authorized key"
   "Substitutable data."
@@ -319,10 +338,9 @@ System: mips64el-linux\n")
     (dynamic-wind
       (const #t)
       (lambda ()
-        (guix-substitute "--substitute"
-                         (string-append (%store-prefix)
-                                        "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                         "substitute-retrieved")
+        (request-substitution (string-append (%store-prefix)
+                                             "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                              "substitute-retrieved")
         (call-with-input-file "substitute-retrieved" get-string-all))
       (lambda ()
         (false-if-exception (delete-file "substitute-retrieved"))))))
@@ -352,10 +370,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
@@ -381,10 +398,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
@@ -417,10 +433,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
@@ -451,10 +466,9 @@ System: mips64el-linux\n")
                           (map (cut string-append "file://" <>)
                                (list %alternate-substitute-directory
                                      %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
@@ -470,10 +484,12 @@ System: mips64el-linux\n")
                                    #:public-key %wrong-public-key))
         %main-substitute-directory
 
-      (guix-substitute "--substitute"
-                       (string-append (%store-prefix)
-                                      "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                       "substitute-retrieved"))))
+      (with-input-from-string (string-append "substitute "
+                                             (%store-prefix)
+                                             "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+                                             " substitute-retrieved\n")
+        (lambda ()
+          (guix-substitute "--substitute"))))))
 
 (test-equal "substitute, narinfo with several URLs"
   "Substitutable data."
@@ -513,10 +529,9 @@ System: mips64el-linux\n")))
           (parameterize ((substitute-urls
                           (list (string-append "file://"
                                                %main-substitute-directory))))
-            (guix-substitute "--substitute"
-                             (string-append (%store-prefix)
-                                            "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                             "substitute-retrieved"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
           (call-with-input-file "substitute-retrieved" get-string-all))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
-- 
2.29.2

[bug#45018] [PATCH v2 5/6] substitute: Cache and reuse connections while substituting.

[Ludovic Courtès]

That way, when fetching a series of substitutes from the same server(s),
the connection is reused instead of being closed/opened for each
substitutes, which saves on network round trips and TLS handshakes.

* guix/http-client.scm (http-fetch): Add #:keep-alive? and honor it.
* guix/progress.scm (progress-report-port): Add #:close? parameter and
honor it.
* guix/scripts/substitute.scm (at-most): Return the tail as a second
value.
(fetch): Add #:port and #:keep-alive? and honor them.
(%max-cached-connections): New variable.
(open-connection-for-uri/cached, call-with-cached-connection): New
procedures.
(with-cached-connection): New macro.
(process-substitution): Wrap 'fetch' call in 'with-cached-connection'.
Pass #:close? to 'progress-report-port'.
---
 guix/http-client.scm        |  12 ++---
 guix/progress.scm           |   8 +--
 guix/scripts/substitute.scm | 103 ++++++++++++++++++++++++++++++------
 nix/libstore/build.cc       |  27 ++++++----
 4 files changed, 116 insertions(+), 34 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index a767175d67..553640fe9e 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
@@ -70,6 +70,7 @@
 
 
 (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
+                     (keep-alive? #f)
                      (verify-certificate? #t)
                      (headers '((user-agent . "GNU Guile")))
                      timeout)
@@ -79,6 +80,9 @@ textual.  Follow any HTTP redirection.  When BUFFERED? is #f, return an
 unbuffered port, suitable for use in `filtered-port'.  HEADERS is an alist of
 extra HTTP headers.
 
+When KEEP-ALIVE? is true, the connection is marked as 'keep-alive' and PORT is
+not closed upon completion.
+
 When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates.
 
 TIMEOUT specifies the timeout in seconds for connection establishment; when
@@ -104,11 +108,7 @@ Raise an '&http-get-error' condition if downloading fails."
         (setvbuf port 'none))
       (let*-values (((resp data)
                      (http-get uri #:streaming? #t #:port port
-                               ;; XXX: When #:keep-alive? is true, if DATA is
-                               ;; a chunked-encoding port, closing DATA won't
-                               ;; close PORT, leading to a file descriptor
-                               ;; leak.
-                               #:keep-alive? #f
+                               #:keep-alive? keep-alive?
                                #:headers headers))
                     ((code)
                      (response-code resp)))
diff --git a/guix/progress.scm b/guix/progress.scm
index fec65b424c..cd80ae620a 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -337,9 +337,10 @@ should be a <progress-reporter> object."
               (report total)
               (loop total (get-bytevector-n! in buffer 0 buffer-size))))))))
 
-(define (progress-report-port reporter port)
+(define* (progress-report-port reporter port #:key (close? #t))
   "Return a port that continuously reports the bytes read from PORT using
-REPORTER, which should be a <progress-reporter> object."
+REPORTER, which should be a <progress-reporter> object.  When CLOSE? is true,
+PORT is closed when the returned port is closed."
   (match reporter
     (($ <progress-reporter> start report stop)
      (let* ((total 0)
@@ -364,5 +365,6 @@ REPORTER, which should be a <progress-reporter> object."
                                         ;; trace.
                                         (unless (zero? total)
                                           (stop))
-                                        (close-port port)))))))
+                                        (when close?
+                                          (close-port port))))))))
 
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 4bf496f1bc..732bf073e8 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -188,9 +188,14 @@ again."
         (sigaction SIGALRM SIG_DFL)
         (apply values result)))))
 
-(define* (fetch uri #:key (buffered? #t) (timeout? #t))
+(define* (fetch uri #:key (buffered? #t) (timeout? #t)
+                (keep-alive? #f) (port #f))
   "Return a binary input port to URI and the number of bytes it's expected to
-provide."
+provide.
+
+When PORT is true, use it as the underlying I/O port for HTTP transfers; when
+PORT is false, open a new connection for URI.  When KEEP-ALIVE? is true, the
+connection (typically PORT) is kept open once data has been fetched from URI."
   (case (uri-scheme uri)
     ((file)
      (let ((port (open-file (uri-path uri)
@@ -206,7 +211,7 @@ provide."
        ;;   sudo tc qdisc add dev eth0 root netem delay 1500ms
        ;; and then cancel with:
        ;;   sudo tc qdisc del dev eth0 root
-       (let ((port #f))
+       (let ((port port))
          (with-timeout (if timeout?
                            %fetch-timeout
                            0)
@@ -217,10 +222,11 @@ provide."
            (begin
              (when (or (not port) (port-closed? port))
                (set! port (guix:open-connection-for-uri
-                           uri #:verify-certificate? #f))
-               (unless (or buffered? (not (file-port? port)))
-                 (setvbuf port 'none)))
+                           uri #:verify-certificate? #f)))
+             (unless (or buffered? (not (file-port? port)))
+               (setvbuf port 'none))
              (http-fetch uri #:text? #f #:port port
+                         #:keep-alive? keep-alive?
                          #:verify-certificate? #f))))))
     (else
      (leave (G_ "unsupported substitute URI scheme: ~a~%")
@@ -478,17 +484,17 @@ indicates that PATH is unavailable at CACHE-URL."
     (build-request (string->uri url) #:method 'GET #:headers headers)))
 
 (define (at-most max-length lst)
-  "If LST is shorter than MAX-LENGTH, return it; otherwise return its
-MAX-LENGTH first elements."
+  "If LST is shorter than MAX-LENGTH, return it and the empty list; otherwise
+return its MAX-LENGTH first elements and its tail."
   (let loop ((len 0)
              (lst lst)
              (result '()))
     (match lst
       (()
-       (reverse result))
+       (values (reverse result) '()))
       ((head . tail)
        (if (>= len max-length)
-           (reverse result)
+           (values (reverse result) lst)
            (loop (+ 1 len) tail (cons head result)))))))
 
 (define* (http-multiple-get base-uri proc seed requests
@@ -962,6 +968,68 @@ the URI, its compression method (a string), and the compressed file size."
     (((uri compression file-size) _ ...)
      (values uri compression file-size))))
 
+(define %max-cached-connections
+  ;; Maximum number of connections kept in cache by
+  ;; 'open-connection-for-uri/cached'.
+  16)
+
+(define open-connection-for-uri/cached
+  (let ((cache '()))
+    (lambda* (uri #:key fresh?)
+      "Return a connection for URI, possibly reusing a cached connection.
+When FRESH? is true, delete any cached connections for URI and open a new
+one.  Return #f if URI's scheme is 'file' or #f."
+      (define host (uri-host uri))
+      (define scheme (uri-scheme uri))
+      (define key (list host scheme (uri-port uri)))
+
+      (and (not (memq scheme '(file #f)))
+           (match (assoc-ref cache key)
+             (#f
+              ;; Open a new connection to URI and evict old entries from
+              ;; CACHE, if any.
+              (let-values (((socket)
+                            (guix:open-connection-for-uri
+                             uri #:verify-certificate? #f))
+                           ((new-cache evicted)
+                            (at-most (- %max-cached-connections 1) cache)))
+                (for-each (match-lambda
+                            ((_ . port)
+                             (false-if-exception (close-port port))))
+                          evicted)
+                (set! cache (alist-cons key socket new-cache))
+                socket))
+             (socket
+              (if (or fresh? (port-closed? socket))
+                  (begin
+                    (false-if-exception (close-port socket))
+                    (set! cache (alist-delete key cache))
+                    (open-connection-for-uri/cached uri))
+                  (begin
+                    ;; Drain input left from the previous use.
+                    (drain-input socket)
+                    socket))))))))
+
+(define (call-with-cached-connection uri proc)
+  (let ((port (open-connection-for-uri/cached uri)))
+    (catch #t
+      (lambda ()
+        (proc port))
+      (lambda (key . args)
+        ;; If PORT was cached and the server closed the connection in the
+        ;; meantime, we get EPIPE.  In that case, open a fresh connection and
+        ;; retry.  We might also get 'bad-response or a similar exception from
+        ;; (web response) later on, once we've sent the request.
+        (if (or (and (eq? key 'system-error)
+                     (= EPIPE (system-error-errno `(,key ,@args))))
+                (memq key '(bad-response bad-header bad-header-component)))
+            (proc (open-connection-for-uri/cached uri #:fresh? #t))
+            (apply throw key args))))))
+
+(define-syntax-rule (with-cached-connection uri port exp ...)
+  "Bind PORT with EXP... to a socket connected to URI."
+  (call-with-cached-connection uri (lambda (port) exp ...)))
+
 (define* (process-substitution store-item destination
                                #:key cache-urls acl print-build-trace?)
   "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to
@@ -984,10 +1052,12 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
               (G_ "Downloading ~a...~%") (uri->string uri)))
 
     (let*-values (((raw download-size)
-                   ;; Note that Hydra currently generates Nars on the fly
-                   ;; and doesn't specify a Content-Length, so
-                   ;; DOWNLOAD-SIZE is #f in practice.
-                   (fetch uri #:buffered? #f #:timeout? #f))
+                   ;; 'guix publish' without '--cache' doesn't specify a
+                   ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
+                   (with-cached-connection uri port
+                     (fetch uri #:buffered? #f #:timeout? #f
+                            #:port port
+                            #:keep-alive? #t)))
                   ((progress)
                    (let* ((dl-size  (or download-size
                                         (and (equal? compression "none")
@@ -1001,7 +1071,9 @@ DESTINATION as a nar file.  Verify the substitute against ACL."
                                          (uri->string uri) dl-size
                                          (current-error-port)
                                          #:abbreviation nar-uri-abbreviation))))
-                     (progress-report-port reporter raw)))
+                     ;; Keep RAW open upon completion so we can later reuse
+                     ;; the underlying connection.
+                     (progress-report-port reporter raw #:close? #f)))
                   ((input pids)
                    ;; NOTE: This 'progress' port of current process will be
                    ;; closed here, while the child process doing the
@@ -1216,6 +1288,7 @@ default value."
 
 ;;; Local Variables:
 ;;; eval: (put 'with-timeout 'scheme-indent-function 1)
+;;; eval: (put 'with-cached-connection 'scheme-indent-function 2)
 ;;; End:
 
 ;;; substitute.scm ends here
diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index 50d300253d..6cfe7aba7e 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -3114,17 +3114,24 @@ void SubstitutionGoal::handleChildOutput(int fd, const string & data)
     }
 
     if (fd == substituter->fromAgent.readSide) {
-	/* Trim whitespace to the right.  */
-	size_t end = data.find_last_not_of(" \t\n");
-	string trimmed = (end != string::npos) ? data.substr(0, end + 1) : data;
+	/* DATA may consist of several lines.  Process them one by one.  */
+	string input = data;
+	while (!input.empty()) {
+	    /* Process up to the first newline.  */
+	    size_t end = input.find_first_of("\n");
+	    string trimmed = (end != string::npos) ? input.substr(0, end) : input;
 
-	if (expectedHashStr == "") {
-	    expectedHashStr = trimmed;
-	} else if (status == "") {
-	    status = trimmed;
-	    worker.wakeUp(shared_from_this());
-	} else {
-	    printMsg(lvlError, format("unexpected substituter message '%1%'") % data);
+	    /* Update the goal's state accordingly.  */
+	    if (expectedHashStr == "") {
+		expectedHashStr = trimmed;
+	    } else if (status == "") {
+		status = trimmed;
+		worker.wakeUp(shared_from_this());
+	    } else {
+		printMsg(lvlError, format("unexpected substituter message '%1%'") % input);
+	    }
+
+	    input = (end != string::npos) ? input.substr(end + 1) : "";
 	}
     }
 }
-- 
2.29.2

[bug#45018] [PATCH v2 6/6] daemon: Raise an error if substituter doesn't send the expected hash.

[Ludovic Courtès]

It was already impossible in practice for 'expectedHashStr' to be empty
if 'status' == "success".

* nix/libstore/build.cc (SubstitutionGoal::finished): Throw 'SubstError'
when 'expectedHashStr' is empty.
---
 nix/libstore/build.cc | 37 +++++++++++++++++++------------------
 1 file changed, 19 insertions(+), 18 deletions(-)

diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index 6cfe7aba7e..b5551b87ae 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -3040,27 +3040,28 @@ void SubstitutionGoal::finished()
         if (!pathExists(destPath))
             throw SubstError(format("substitute did not produce path `%1%'") % destPath);
 
+	if (expectedHashStr == "")
+	    throw SubstError(format("substituter did not communicate hash for `%1'") % storePath);
+
         hash = hashPath(htSHA256, destPath);
 
         /* Verify the expected hash we got from the substituer. */
-        if (expectedHashStr != "") {
-            size_t n = expectedHashStr.find(':');
-            if (n == string::npos)
-                throw Error(format("bad hash from substituter: %1%") % expectedHashStr);
-            HashType hashType = parseHashType(string(expectedHashStr, 0, n));
-            if (hashType == htUnknown)
-                throw Error(format("unknown hash algorithm in `%1%'") % expectedHashStr);
-            Hash expectedHash = parseHash16or32(hashType, string(expectedHashStr, n + 1));
-            Hash actualHash = hashType == htSHA256 ? hash.first : hashPath(hashType, destPath).first;
-            if (expectedHash != actualHash) {
-		if (settings.printBuildTrace)
-		    printMsg(lvlError, format("@ hash-mismatch %1% %2% %3% %4%")
-			     % storePath % "sha256"
-			     % printHash16or32(expectedHash)
-			     % printHash16or32(actualHash));
-                throw SubstError(format("hash mismatch for substituted item `%1%'") % storePath);
-	    }
-        }
+	size_t n = expectedHashStr.find(':');
+	if (n == string::npos)
+	    throw Error(format("bad hash from substituter: %1%") % expectedHashStr);
+	HashType hashType = parseHashType(string(expectedHashStr, 0, n));
+	if (hashType == htUnknown)
+	    throw Error(format("unknown hash algorithm in `%1%'") % expectedHashStr);
+	Hash expectedHash = parseHash16or32(hashType, string(expectedHashStr, n + 1));
+	Hash actualHash = hashType == htSHA256 ? hash.first : hashPath(hashType, destPath).first;
+	if (expectedHash != actualHash) {
+	    if (settings.printBuildTrace)
+		printMsg(lvlError, format("@ hash-mismatch %1% %2% %3% %4%")
+			 % storePath % "sha256"
+			 % printHash16or32(expectedHash)
+			 % printHash16or32(actualHash));
+	    throw SubstError(format("hash mismatch for substituted item `%1%'") % storePath);
+	}
 
     } catch (SubstError & e) {
 
-- 
2.29.2

bug#45018: [PATCH v2 0/6] Process and connection reuse for substitutions

[Ludovic Courtès]

Ludovic Courtès <ludo@gnu.org> skribis:

>   daemon: 'Agent' constructor takes a list of environment variables.
>   daemon: Use 'Agent' to spawn 'guix substitute --query'.
>   daemon: Factorize substituter agent spawning.
>   daemon: Run 'guix substitute --substitute' as an agent.
>   substitute: Cache and reuse connections while substituting.
>   daemon: Raise an error if substituter doesn't send the expected hash.

Pushed as bfe4cdf88ee3e88910d22291a4c745462f2d6417, followed by an
update of the ‘guix’ package.

Ludo’.