[bug#41720] [PATCH] store: Use buffered I/O for all protocol writes

[Lars-Dominik Braun <ldb@leibniz-psychology.org>]

[-- Attachment #1.1: Type: text/plain, Size: 925 bytes --]

Hi,

I did some digging to investigate why SSH-based guix operations are currently
so slow. One of the reasons seems to be that some operations write single words
to the socket and due to NOWAIT these result in a lot of small packets.

The attached patch modifies store.scm to buffer all writes, so that won’t happen
any more. I’m seeing about ~40% speedup (6.194s vs 10.075s for the best out of
five runs) for `GUIX_DAEMON_SOCKET=ssh://localhost guix environment guix --
true`, but it also seems to have a negative impact on UNIX domain socket
communication by ~10% (1.561s vs 1.385s). For the notorious r-learnr package
it’s still ~20% better (ssh, 16.620/21.418) and only ~3% worse (unix,
11.489/11.199). Keep in mind localhost has a much larger MTU and much lower
latency than usual networks though. It might benefit from having an even bigger
write buffer (64k vs. currently 8k).

Cheers,
Lars


[-- Attachment #1.2: 0001-store-Use-buffered-I-O-for-all-protocol-writes.patch --]
[-- Type: text/x-diff, Size: 7020 bytes --]

From eb38dc246e5dd33f8a48a99aded8b8dc0c378376 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <ldb@leibniz-psychology.org>
Date: Fri, 5 Jun 2020 10:38:32 +0200
Subject: [PATCH] store: Use buffered I/O for all protocol writes

* guix/store.scm (run-gc) Use buffered output port.
(export-path) Same.
(add-file-tree-to-store) Same.
(set-build-options): Same. Add explicit flush.
---
 guix/store.scm | 70 ++++++++++++++++++++++++++++----------------------
 1 file changed, 39 insertions(+), 31 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index 014d08aaec..9b3879b4a7 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -821,8 +822,8 @@ encoding conversion errors."
                             (locale (false-if-exception (setlocale LC_ALL))))
   ;; Must be called after `open-connection'.
 
-  (define socket
-    (store-connection-socket server))
+  (define buffered
+    (store-connection-output-port server))
 
   (unless (unspecified? use-build-hook?)
     (warn-about-deprecation #:use-build-hook? #f
@@ -831,9 +832,9 @@ encoding conversion errors."
   (let-syntax ((send (syntax-rules ()
                        ((_ (type option) ...)
                         (begin
-                          (write-arg type option socket)
+                          (write-arg type option buffered)
                           ...)))))
-    (write-int (operation-id set-options) socket)
+    (write-int (operation-id set-options) buffered)
     (send (boolean keep-failed?) (boolean keep-going?)
           (boolean fallback?) (integer verbosity))
     (when (< (store-connection-minor-version server) #x61)
@@ -896,6 +897,7 @@ encoding conversion errors."
                            `(("locale" . ,locale))
                            '()))))
         (send (string-pairs pairs))))
+    (write-buffered-output server)
     (let loop ((done? (process-stderr server)))
       (or done? (process-stderr server)))))
 
@@ -1108,13 +1110,14 @@ path."
            ;; We don't use the 'operation' macro so we can pass SELECT? to
            ;; 'write-file'.
            (record-operation 'add-to-store)
-           (let ((port (store-connection-socket server)))
-             (write-int (operation-id add-to-store) port)
-             (write-string basename port)
-             (write-int 1 port)                   ;obsolete, must be #t
-             (write-int (if recursive? 1 0) port)
-             (write-string hash-algo port)
-             (write-file file-name port #:select? select?)
+           (let ((port (store-connection-socket server))
+                 (buffered (store-connection-output-port server)))
+             (write-int (operation-id add-to-store) buffered)
+             (write-string basename buffered)
+             (write-int 1 buffered)                   ;obsolete, must be #t
+             (write-int (if recursive? 1 0) buffered)
+             (write-string hash-algo buffered)
+             (write-file file-name buffered #:select? select?)
              (write-buffered-output server)
              (let loop ((done? (process-stderr server)))
                (or done? (loop (process-stderr server))))
@@ -1220,13 +1223,14 @@ an arbitrary directory layout in the store without creating a derivation."
         ;; We don't use the 'operation' macro so we can use 'write-file-tree'
         ;; instead of 'write-file'.
         (record-operation 'add-to-store/tree)
-        (let ((port (store-connection-socket server)))
-          (write-int (operation-id add-to-store) port)
-          (write-string basename port)
-          (write-int 1 port)                      ;obsolete, must be #t
-          (write-int (if recursive? 1 0) port)
-          (write-string hash-algo port)
-          (write-file-tree basename port
+        (let ((port (store-connection-socket server))
+              (buffered (store-connection-output-port server)))
+          (write-int (operation-id add-to-store) buffered)
+          (write-string basename buffered)
+          (write-int 1 buffered)                      ;obsolete, must be #t
+          (write-int (if recursive? 1 0) buffered)
+          (write-string hash-algo buffered)
+          (write-file-tree basename buffered
                            #:file-type+size file-type+size
                            #:file-port file-port
                            #:symlink-target symlink-target
@@ -1644,17 +1648,19 @@ the list of store paths to delete.  IGNORE-LIVENESS? should always be
 #f.  MIN-FREED is the minimum amount of disk space to be freed, in
 bytes, before the GC can stop.  Return the list of store paths delete,
 and the number of bytes freed."
-  (let ((s (store-connection-socket server)))
-    (write-int (operation-id collect-garbage) s)
-    (write-int action s)
-    (write-store-path-list to-delete s)
-    (write-arg boolean #f s)                      ; ignore-liveness?
-    (write-long-long min-freed s)
-    (write-int 0 s)                               ; obsolete
+  (let ((s (store-connection-socket server))
+        (buffered (store-connection-output-port server)))
+    (write-int (operation-id collect-garbage) buffered)
+    (write-int action buffered)
+    (write-store-path-list to-delete buffered)
+    (write-arg boolean #f buffered)                      ; ignore-liveness?
+    (write-long-long min-freed buffered)
+    (write-int 0 buffered)                               ; obsolete
     (when (>= (store-connection-minor-version server) 5)
       ;; Obsolete `use-atime' and `max-atime' parameters.
-      (write-int 0 s)
-      (write-int 0 s))
+      (write-int 0 buffered)
+      (write-int 0 buffered))
+    (write-buffered-output server)
 
     ;; Loop until the server is done sending error output.
     (let loop ((done? (process-stderr server)))
@@ -1711,10 +1717,12 @@ is raised if the set of paths read from PORT is not signed (as per
 
 (define* (export-path server path port #:key (sign? #t))
   "Export PATH to PORT.  When SIGN? is true, sign it."
-  (let ((s (store-connection-socket server)))
-    (write-int (operation-id export-path) s)
-    (write-store-path path s)
-    (write-arg boolean sign? s)
+  (let ((s (store-connection-socket server))
+        (buffered (store-connection-output-port server)))
+    (write-int (operation-id export-path) buffered)
+    (write-store-path path buffered)
+    (write-arg boolean sign? buffered)
+    (write-buffered-output server)
     (let loop ((done? (process-stderr server port)))
       (or done? (loop (process-stderr server port))))
     (= 1 (read-int s))))
-- 
2.20.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 659 bytes --]