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,50 +524,45 @@ (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 uri-or-filename
open-unix-domain-socket) #: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 (open-inet-socket (uri-host uri)
(lambda (_) (or (uri-port uri) %default-guix-port)
(open-inet-socket (uri-host uri) #:non-blocking? non-blocking?))
(or (uri-port uri) %default-guix-port) ((? symbol? scheme)
#:non-blocking? non-blocking?))) ;; Try to dynamically load a module for SCHEME.
((? symbol? scheme) ;; XXX: Errors are swallowed.
;; Try to dynamically load a module for SCHEME. (match (false-if-exception
;; XXX: Errors are swallowed. (resolve-interface `(guix store ,scheme)))
(match (false-if-exception ((? module? module)
(resolve-interface `(guix store ,scheme))) (match (false-if-exception
((? module? module) (module-ref module 'connect-to-daemon))
(match (false-if-exception ((? procedure? connect)
(module-ref module 'connect-to-daemon)) (connect uri))
((? procedure? connect) (x (not-supported))))
(lambda (_) (#f (not-supported))))
(connect uri))) (x
(x (not-supported)))) (not-supported))))))
(#f (not-supported))))
(x
(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