ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-15 11:25:22 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

store: 'open-connection' can taken an open port.

Browse source 
* guix/store.scm (open-unix-domain-socket): New procedure.
(open-connection): Add #:port parameter and honor it.
This commit is contained in:
Ludovic Courtès 2016-11-02 22:50:31 +01:00
parent 9e76eed37f
commit 6230d6f04f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 33 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

58
guix/store.scm
View file

@ -345,50 +345,58 @@ (define-condition-type &nix-protocol-error &nix-error
(message nix-protocol-error-message) (message nix-protocol-error-message)
(status nix-protocol-error-status)) (status nix-protocol-error-status))
(define* (open-connection #:optional (file (%daemon-socket-file)) (define (open-unix-domain-socket file)
#:key (reserve-space? #t) cpu-affinity) "Connect to the Unix-domain socket at FILE and return it. Raise a
"Connect to the daemon over the Unix-domain socket at FILE. When '&nix-connection-error' upon error."
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, 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 ((s (with-fluids ((%default-port-encoding #f)) (let ((s (with-fluids ((%default-port-encoding #f))
;; This trick allows use of the `scm_c_read' optimization. ;; This trick allows use of the `scm_c_read' optimization.
(socket PF_UNIX SOCK_STREAM 0))) (socket PF_UNIX SOCK_STREAM 0)))
(a (make-socket-address PF_UNIX file))) (a (make-socket-address PF_UNIX file)))
(catch 'system-error (catch 'system-error
(cut connect s a) (lambda ()
(connect s a)
s)
(lambda args (lambda args
;; Translate the error to something user-friendly. ;; Translate the error to something user-friendly.
(let ((errno (system-error-errno args))) (let ((errno (system-error-errno args)))
(raise (condition (&nix-connection-error (raise (condition (&nix-connection-error
(file file) (file file)
(errno errno))))))) (errno errno)))))))))
(write-int %worker-magic-1 s) (define* (open-connection #:optional (file (%daemon-socket-file))
(let ((r (read-int s))) #: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.
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,
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) (and (eqv? r %worker-magic-2)
(let ((v (read-int s))) (let ((v (read-int port)))
(and (eqv? (protocol-major %protocol-version) (and (eqv? (protocol-major %protocol-version)
(protocol-major v)) (protocol-major v))
(begin (begin
(write-int %protocol-version s) (write-int %protocol-version port)
(when (>= (protocol-minor v) 14) (when (>= (protocol-minor v) 14)
(write-int (if cpu-affinity 1 0) s) (write-int (if cpu-affinity 1 0) port)
(when cpu-affinity (when cpu-affinity
(write-int cpu-affinity s))) (write-int cpu-affinity port)))
(when (>= (protocol-minor v) 11) (when (>= (protocol-minor v) 11)
(write-int (if reserve-space? 1 0) s)) (write-int (if reserve-space? 1 0) port))
(let ((s (%make-nix-server s (let ((conn (%make-nix-server port
(protocol-major v) (protocol-major v)
(protocol-minor v) (protocol-minor v)
(make-hash-table 100) (make-hash-table 100)
(make-hash-table 100)))) (make-hash-table 100))))
(let loop ((done? (process-stderr s))) (let loop ((done? (process-stderr conn)))
(or done? (process-stderr s))) (or done? (process-stderr conn)))
s)))))))) conn))))))))
(define (close-connection server) (define (close-connection server)
"Close the connection to SERVER." "Close the connection to SERVER."