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: I61cd99920df91baba95567d670bec6fa94043875master
parent
56770f7d59
commit
ffdbf1f11e
|
@ -524,50 +524,45 @@ non-blocking."
|
||||||
(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
|
||||||
|
|
Reference in New Issue