~ruther/guix-local

13d5e8dae5f1282eac630dea428c5fe3dc073fb4 — Ludovic Courtès 9 years ago 0c69a17
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.
2 files changed, 39 insertions(+), 23 deletions(-)

M guix/store.scm
M tests/store.scm
M guix/store.scm => guix/store.scm +30 -23
@@ 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."

M tests/store.scm => tests/store.scm +9 -0
@@ 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