01/01: store: 'open-connection' no longer raises '&nar-error' for protocol errors.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 13d5e8dae5f1282eac630dea428c5fe3dc073fb4
Author: Ludovic Courtès <address@hidden>
Date:   Thu Dec 8 14:03:33 2016 +0100

    store: 'open-connection' no longer raises '&nar-error' for protocol errors.
    
    * guix/store.scm (open-connection): Guard body against 'nar-error?' and
    re-raise as '&nix-connection-error'.
    * tests/store.scm ("connection handshake error"): New test.
---
 guix/store.scm  |   53 ++++++++++++++++++++++++++++++-----------------------
 tests/store.scm |    9 +++++++++
 2 files changed, 39 insertions(+), 23 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index a669011..49549d0 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -374,29 +374,36 @@ space on the file system so that the garbage collector 
can still operate,
 should the disk become full.  When CPU-AFFINITY is true, it must be an integer
 corresponding to an OS-level CPU number to which the daemon's worker process
 for this connection will be pinned.  Return a server object."
-  (let ((port (or port (open-unix-domain-socket file))))
-    (write-int %worker-magic-1 port)
-    (let ((r (read-int port)))
-      (and (eqv? r %worker-magic-2)
-           (let ((v (read-int port)))
-             (and (eqv? (protocol-major %protocol-version)
-                        (protocol-major v))
-                  (begin
-                    (write-int %protocol-version port)
-                    (when (>= (protocol-minor v) 14)
-                      (write-int (if cpu-affinity 1 0) port)
-                      (when cpu-affinity
-                        (write-int cpu-affinity port)))
-                    (when (>= (protocol-minor v) 11)
-                      (write-int (if reserve-space? 1 0) port))
-                    (let ((conn (%make-nix-server port
-                                                  (protocol-major v)
-                                                  (protocol-minor v)
-                                                  (make-hash-table 100)
-                                                  (make-hash-table 100))))
-                      (let loop ((done? (process-stderr conn)))
-                        (or done? (process-stderr conn)))
-                      conn))))))))
+  (guard (c ((nar-error? c)
+             ;; One of the 'write-' or 'read-' calls below failed, but this is
+             ;; really a connection error.
+             (raise (condition
+                     (&nix-connection-error (file (or port file))
+                                            (errno EPROTO))
+                     (&message (message "build daemon handshake failed"))))))
+    (let ((port (or port (open-unix-domain-socket file))))
+      (write-int %worker-magic-1 port)
+      (let ((r (read-int port)))
+        (and (eqv? r %worker-magic-2)
+             (let ((v (read-int port)))
+               (and (eqv? (protocol-major %protocol-version)
+                          (protocol-major v))
+                    (begin
+                      (write-int %protocol-version port)
+                      (when (>= (protocol-minor v) 14)
+                        (write-int (if cpu-affinity 1 0) port)
+                        (when cpu-affinity
+                          (write-int cpu-affinity port)))
+                      (when (>= (protocol-minor v) 11)
+                        (write-int (if reserve-space? 1 0) port))
+                      (let ((conn (%make-nix-server port
+                                                    (protocol-major v)
+                                                    (protocol-minor v)
+                                                    (make-hash-table 100)
+                                                    (make-hash-table 100))))
+                        (let loop ((done? (process-stderr conn)))
+                          (or done? (process-stderr conn)))
+                        conn)))))))))
 
 (define (close-connection server)
   "Close the connection to SERVER."
diff --git a/tests/store.scm b/tests/store.scm
index 38b8efc..123ea8a 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -48,6 +48,15 @@
 
 (test-begin "store")
 
+(test-equal "connection handshake error"
+  EPROTO
+  (let ((port (%make-void-port "rw")))
+    (guard (c ((nix-connection-error? c)
+               (and (eq? port (nix-connection-error-file c))
+                    (nix-connection-error-code c))))
+      (open-connection #f #:port port)
+      'broken)))
+
 (test-equal "store-path-hash-part"
   "283gqy39v3g9dxjy26rynl0zls82fmcg"
   (store-path-hash-part