store: Refactor connect-to-daemon.

Remove the inner connect procedure, as now that #:non-blocking? needs passing
on, this just makes things more difficult.  This commit also fixes not passing
 #:non-blocking? on in the case where open-unix-domain-socket is called as
connect.

* guix/store.scm (connect-to-daemon): Refactor and fix non-blocking
connections to sockets with a filename.

Change-Id: I61cd99920df91baba95567d670bec6fa94043875
This commit is contained in:
Christopher Baines 2024-05-14 17:56:05 +01:00
parent 56770f7d59
commit ffdbf1f11e
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577

View file

@ -524,33 +524,31 @@ (define addresses
(errno (system-error-errno args))))) (errno (system-error-errno args)))))
(loop rest))))))))) (loop rest)))))))))
(define* (connect-to-daemon uri #:key non-blocking?) (define* (connect-to-daemon uri-or-filename #:key non-blocking?)
"Connect to the daemon at URI, a string that may be an actual URI or a file "Connect to the daemon at URI-OR-FILENAME and return an input/output port.
name, and return an input/output port. If NON-BLOCKING?, use a non-blocking If NON-BLOCKING?, use a non-blocking socket when using the file, unix or guix
socket when using the file, unix or guix URI schemes. URI schemes.
This is a low-level procedure that does not perform the initial handshake with This is a low-level procedure that does not perform the initial handshake with
the daemon. Use 'open-connection' for that." the daemon. Use 'open-connection' for that."
(define (not-supported) (define (not-supported)
(raise (condition (&store-connection-error (raise (condition (&store-connection-error
(file uri) (file uri-or-filename)
(errno ENOTSUP))))) (errno ENOTSUP)))))
(define connect (match (string->uri uri-or-filename)
(match (string->uri uri)
(#f ;URI is a file name (#f ;URI is a file name
open-unix-domain-socket) (open-unix-domain-socket uri-or-filename
#:non-blocking? non-blocking?))
((? uri? uri) ((? uri? uri)
(match (uri-scheme uri) (match (uri-scheme uri)
((or #f 'file 'unix) ((or #f 'file 'unix)
(lambda (_)
(open-unix-domain-socket (uri-path uri) (open-unix-domain-socket (uri-path uri)
#:non-blocking? non-blocking?))) #:non-blocking? non-blocking?))
('guix ('guix
(lambda (_)
(open-inet-socket (uri-host uri) (open-inet-socket (uri-host uri)
(or (uri-port uri) %default-guix-port) (or (uri-port uri) %default-guix-port)
#:non-blocking? non-blocking?))) #:non-blocking? non-blocking?))
((? symbol? scheme) ((? symbol? scheme)
;; Try to dynamically load a module for SCHEME. ;; Try to dynamically load a module for SCHEME.
;; XXX: Errors are swallowed. ;; XXX: Errors are swallowed.
@ -560,15 +558,12 @@ (define connect
(match (false-if-exception (match (false-if-exception
(module-ref module 'connect-to-daemon)) (module-ref module 'connect-to-daemon))
((? procedure? connect) ((? procedure? connect)
(lambda (_) (connect uri))
(connect uri)))
(x (not-supported)))) (x (not-supported))))
(#f (not-supported)))) (#f (not-supported))))
(x (x
(not-supported)))))) (not-supported))))))
(connect uri))
(define* (open-connection #:optional (uri (%daemon-socket-uri)) (define* (open-connection #:optional (uri (%daemon-socket-uri))
#:key port (reserve-space? #t) cpu-affinity #:key port (reserve-space? #t) cpu-affinity
non-blocking?) non-blocking?)