diff options
Diffstat (limited to 'guix/store.scm')
| -rw-r--r-- | guix/store.scm | 122 |
1 files changed, 104 insertions, 18 deletions
diff --git a/guix/store.scm b/guix/store.scm index 2f05351767..683f071a83 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -39,7 +39,8 @@ #:use-module (ice-9 regex) #:use-module (ice-9 vlist) #:use-module (ice-9 popen) - #:export (%daemon-socket-file + #:use-module (web uri) + #:export (%daemon-socket-uri %gc-roots-directory %default-substitute-urls @@ -216,8 +217,8 @@ (define %default-socket-path (string-append %state-directory "/daemon-socket/socket")) -(define %daemon-socket-file - ;; File name of the socket the daemon listens too. +(define %daemon-socket-uri + ;; URI or file name of the socket the daemon listens too. (make-parameter (or (getenv "GUIX_DAEMON_SOCKET") %default-socket-path))) @@ -350,6 +351,18 @@ (message nix-protocol-error-message) (status nix-protocol-error-status)) +(define-syntax-rule (system-error-to-connection-error file exp ...) + "Catch 'system-error' exceptions and translate them to +'&nix-connection-error'." + (catch 'system-error + (lambda () + exp ...) + (lambda args + (let ((errno (system-error-errno args))) + (raise (condition (&nix-connection-error + (file file) + (errno errno)))))))) + (define (open-unix-domain-socket file) "Connect to the Unix-domain socket at FILE and return it. Raise a '&nix-connection-error' upon error." @@ -358,21 +371,90 @@ (socket PF_UNIX SOCK_STREAM 0))) (a (make-socket-address PF_UNIX file))) - (catch 'system-error - (lambda () - (connect s a) - s) - (lambda args - ;; Translate the error to something user-friendly. - (let ((errno (system-error-errno args))) - (raise (condition (&nix-connection-error - (file file) - (errno errno))))))))) + (system-error-to-connection-error file + (connect s a) + s))) -(define* (open-connection #:optional (file (%daemon-socket-file)) +(define (open-inet-socket host port) + "Connect to the Unix-domain socket at HOST:PORT and return it. Raise a +'&nix-connection-error' upon error." + (let ((sock (with-fluids ((%default-port-encoding #f)) + ;; This trick allows use of the `scm_c_read' optimization. + (socket PF_UNIX SOCK_STREAM 0)))) + (define addresses + (getaddrinfo host + (if (number? port) (number->string port) port) + (if (number? port) + (logior AI_ADDRCONFIG AI_NUMERICSERV) + AI_ADDRCONFIG))) + + (let loop ((addresses addresses)) + (match addresses + ((ai rest ...) + (let ((s (socket (addrinfo:fam ai) + ;; TCP/IP only + SOCK_STREAM IPPROTO_IP))) + + (catch 'system-error + (lambda () + (connect s (addrinfo:addr ai)) + s) + (lambda args + ;; Connection failed, so try one of the other addresses. + (close s) + (if (null? rest) + (raise (condition (&nix-connection-error + (file host) + (errno (system-error-errno args))))) + (loop rest)))))))))) + +(define (connect-to-daemon uri) + "Connect to the daemon at URI, a string that may be an actual URI or a file +name." + (define (not-supported) + (raise (condition (&nix-connection-error + (file uri) + (errno ENOTSUP))))) + + (define connect + (match (string->uri uri) + (#f ;URI is a file name + open-unix-domain-socket) + ((? uri? uri) + (match (uri-scheme uri) + ((or #f 'file 'unix) + (lambda (_) + (open-unix-domain-socket (uri-path uri)))) + ('guix + (lambda (_) + (unless (uri-port uri) + (raise (condition (&nix-connection-error + (file (uri->string uri)) + (errno EBADR))))) ;bah! + + (open-inet-socket (uri-host uri) (uri-port uri)))) + ((? symbol? scheme) + ;; Try to dynamically load a module for SCHEME. + ;; XXX: Errors are swallowed. + (match (false-if-exception + (resolve-interface `(guix store ,scheme))) + ((? module? module) + (match (false-if-exception + (module-ref module 'connect-to-daemon)) + ((? procedure? connect) + (lambda (_) + (connect uri))) + (x (not-supported)))) + (#f (not-supported)))) + (x + (not-supported)))))) + + (connect uri)) + +(define* (open-connection #:optional (uri (%daemon-socket-uri)) #:key port (reserve-space? #t) cpu-affinity) - "Connect to the daemon over the Unix-domain socket at FILE, or, if PORT is -not #f, use it as the I/O port over which to communicate to a build daemon. + "Connect to the daemon at URI (a string), or, if PORT is not #f, use it as +the I/O port over which to communicate to a build daemon. When RESERVE-SPACE? is true, instruct it to reserve a little bit of extra space on the file system so that the garbage collector can still operate, @@ -383,10 +465,10 @@ for this connection will be pinned. Return a server object." ;; 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)) + (&nix-connection-error (file (or port uri)) (errno EPROTO)) (&message (message "build daemon handshake failed")))))) - (let ((port (or port (open-unix-domain-socket file)))) + (let ((port (or port (connect-to-daemon uri)))) (write-int %worker-magic-1 port) (let ((r (read-int port))) (and (eqv? r %worker-magic-2) @@ -1330,3 +1412,7 @@ must be an absolute store file name, or a derivation file name." ;; Return the first that works. (any (cut log-file store <>) derivers)) (_ #f))))) + +;;; Local Variables: +;;; eval: (put 'system-error-to-connection-error 'scheme-indent-function 1) +;;; End: |