store: Rename <nix-server> to <store-connection>.

* guix/store.scm (<nix-server>): Rename to...
(<store-connection>): ... this.  Adjust users accordingly.
(nix-server?, nix-server-major-version)
(nix-server-minor-version, nix-server-socket)
(nix-server-version): Define as deprecated aliases.
* guix/inferior.scm: Adjust accordingly.
* guix/ssh.scm: Likewise.
This commit is contained in:
Ludovic Courtès 2019-01-21 15:32:35 +01:00
parent 3a0b2c6c6e
commit de9fbe9cdc
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 94 additions and 75 deletions

View file

@ -26,9 +26,9 @@ (define-module (guix inferior)
version>? version-prefix? version>? version-prefix?
cache-directory)) cache-directory))
#:use-module ((guix store) #:use-module ((guix store)
#:select (nix-server-socket #:select (store-connection-socket
nix-server-major-version store-connection-major-version
nix-server-minor-version store-connection-minor-version
store-lift)) store-lift))
#:use-module ((guix derivations) #:use-module ((guix derivations)
#:select (read-derivation-from-file)) #:select (read-derivation-from-file))
@ -424,8 +424,8 @@ (define (inferior-eval-with-store inferior store code)
(chmod directory #o700) (chmod directory #o700)
(let* ((name (string-append directory "/inferior")) (let* ((name (string-append directory "/inferior"))
(socket (socket AF_UNIX SOCK_STREAM 0)) (socket (socket AF_UNIX SOCK_STREAM 0))
(major (nix-server-major-version store)) (major (store-connection-major-version store))
(minor (nix-server-minor-version store)) (minor (store-connection-minor-version store))
(proto (logior major minor))) (proto (logior major minor)))
(bind socket AF_UNIX name) (bind socket AF_UNIX name)
(listen socket 1024) (listen socket 1024)
@ -451,7 +451,7 @@ (define (inferior-eval-with-store inferior store code)
inferior) inferior)
(match (accept socket) (match (accept socket)
((client . address) ((client . address)
(proxy client (nix-server-socket store)))) (proxy client (store-connection-socket store))))
(close-port socket) (close-port socket)
(read-inferior-response inferior))))) (read-inferior-response inferior)))))

View file

@ -180,7 +180,7 @@ (define* (connect-to-remote-daemon session
(socket-name (socket-name
"/var/guix/daemon-socket/socket")) "/var/guix/daemon-socket/socket"))
"Connect to the remote build daemon listening on SOCKET-NAME over SESSION, "Connect to the remote build daemon listening on SOCKET-NAME over SESSION,
an SSH session. Return a <nix-server> object." an SSH session. Return a <store-connection> object."
(open-connection #:port (remote-daemon-channel session socket-name))) (open-connection #:port (remote-daemon-channel session socket-name)))
@ -288,7 +288,7 @@ (define* (send-files local files remote
Return the list of store items actually sent." Return the list of store items actually sent."
;; Compute the subset of FILES missing on SESSION and send them. ;; Compute the subset of FILES missing on SESSION and send them.
(let* ((files (if recursive? (requisites local files) files)) (let* ((files (if recursive? (requisites local files) files))
(session (channel-get-session (nix-server-socket remote))) (session (channel-get-session (store-connection-socket remote)))
(missing (inferior-remote-eval (missing (inferior-remote-eval
`(begin `(begin
(use-modules (guix) (use-modules (guix)
@ -345,7 +345,7 @@ (define* (send-files local files remote
(define (remote-store-session remote) (define (remote-store-session remote)
"Return the SSH channel beneath REMOTE, a remote store as returned by "Return the SSH channel beneath REMOTE, a remote store as returned by
'connect-to-remote-daemon', or #f." 'connect-to-remote-daemon', or #f."
(channel-get-session (nix-server-socket remote))) (channel-get-session (store-connection-socket remote)))
(define (remote-store-host remote) (define (remote-store-host remote)
"Return the name of the host REMOTE is connected to, where REMOTE is a "Return the name of the host REMOTE is connected to, where REMOTE is a

View file

@ -20,6 +20,7 @@
(define-module (guix store) (define-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix deprecation)
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix serialization) #:use-module (guix serialization)
#:use-module (guix monads) #:use-module (guix monads)
@ -51,11 +52,19 @@ (define-module (guix store)
%gc-roots-directory %gc-roots-directory
%default-substitute-urls %default-substitute-urls
store-connection?
store-connection-version
store-connection-major-version
store-connection-minor-version
store-connection-socket
;; Deprecated forms for 'store-connection'.
nix-server? nix-server?
nix-server-version nix-server-version
nix-server-major-version nix-server-major-version
nix-server-minor-version nix-server-minor-version
nix-server-socket nix-server-socket
current-store-protocol-version ;for internal use current-store-protocol-version ;for internal use
mcached mcached
@ -335,31 +344,39 @@ (define-syntax read-arg
;; remote-store.cc ;; remote-store.cc
(define-record-type* <nix-server> nix-server %make-nix-server (define-record-type* <store-connection> store-connection %make-store-connection
nix-server? store-connection?
(socket nix-server-socket) (socket store-connection-socket)
(major nix-server-major-version) (major store-connection-major-version)
(minor nix-server-minor-version) (minor store-connection-minor-version)
(buffer nix-server-output-port) ;output port (buffer store-connection-output-port) ;output port
(flush nix-server-flush-output) ;thunk (flush store-connection-flush-output) ;thunk
;; Caches. We keep them per-connection, because store paths build ;; Caches. We keep them per-connection, because store paths build
;; during the session are temporary GC roots kept for the duration of ;; during the session are temporary GC roots kept for the duration of
;; the session. ;; the session.
(ats-cache nix-server-add-to-store-cache) (ats-cache store-connection-add-to-store-cache)
(atts-cache nix-server-add-text-to-store-cache) (atts-cache store-connection-add-text-to-store-cache)
(object-cache nix-server-object-cache (object-cache store-connection-object-cache
(default vlist-null))) ;vhash (default vlist-null))) ;vhash
(set-record-type-printer! <nix-server> (set-record-type-printer! <store-connection>
(lambda (obj port) (lambda (obj port)
(format port "#<build-daemon ~a.~a ~a>" (format port "#<store-connection ~a.~a ~a>"
(nix-server-major-version obj) (store-connection-major-version obj)
(nix-server-minor-version obj) (store-connection-minor-version obj)
(number->string (object-address obj) (number->string (object-address obj)
16)))) 16))))
(define-deprecated/alias nix-server? store-connection?)
(define-deprecated/alias nix-server-major-version
store-connection-major-version)
(define-deprecated/alias nix-server-minor-version
store-connection-minor-version)
(define-deprecated/alias nix-server-socket store-connection-socket)
(define-condition-type &nix-error &error (define-condition-type &nix-error &error
nix-error?) nix-error?)
@ -515,13 +532,13 @@ (define* (open-connection #:optional (uri (%daemon-socket-uri))
(write-int cpu-affinity port))) (write-int cpu-affinity port)))
(when (>= (protocol-minor v) 11) (when (>= (protocol-minor v) 11)
(write-int (if reserve-space? 1 0) port)) (write-int (if reserve-space? 1 0) port))
(let ((conn (%make-nix-server port (let ((conn (%make-store-connection port
(protocol-major v) (protocol-major v)
(protocol-minor v) (protocol-minor v)
output flush output flush
(make-hash-table 100) (make-hash-table 100)
(make-hash-table 100) (make-hash-table 100)
vlist-null))) vlist-null)))
(let loop ((done? (process-stderr conn))) (let loop ((done? (process-stderr conn)))
(or done? (process-stderr conn))) (or done? (process-stderr conn)))
conn))))))))) conn)))))))))
@ -536,27 +553,29 @@ (define* (port->connection port
connection. Use with care." connection. Use with care."
(let-values (((output flush) (let-values (((output flush)
(buffering-output-port port (make-bytevector 8192)))) (buffering-output-port port (make-bytevector 8192))))
(%make-nix-server port (%make-store-connection port
(protocol-major version) (protocol-major version)
(protocol-minor version) (protocol-minor version)
output flush output flush
(make-hash-table 100) (make-hash-table 100)
(make-hash-table 100) (make-hash-table 100)
vlist-null))) vlist-null)))
(define (nix-server-version store) (define (store-connection-version store)
"Return the protocol version of STORE as an integer." "Return the protocol version of STORE as an integer."
(protocol-version (nix-server-major-version store) (protocol-version (store-connection-major-version store)
(nix-server-minor-version store))) (store-connection-minor-version store)))
(define-deprecated/alias nix-server-version store-connection-version)
(define (write-buffered-output server) (define (write-buffered-output server)
"Flush SERVER's output port." "Flush SERVER's output port."
(force-output (nix-server-output-port server)) (force-output (store-connection-output-port server))
((nix-server-flush-output server))) ((store-connection-flush-output server)))
(define (close-connection server) (define (close-connection server)
"Close the connection to SERVER." "Close the connection to SERVER."
(close (nix-server-socket server))) (close (store-connection-socket server)))
(define-syntax-rule (with-store store exp ...) (define-syntax-rule (with-store store exp ...)
"Bind STORE to an open connection to the store and evaluate EXPs; "Bind STORE to an open connection to the store and evaluate EXPs;
@ -566,7 +585,7 @@ (define-syntax-rule (with-store store exp ...)
(const #f) (const #f)
(lambda () (lambda ()
(parameterize ((current-store-protocol-version (parameterize ((current-store-protocol-version
(nix-server-version store))) (store-connection-version store)))
exp) ...) exp) ...)
(lambda () (lambda ()
(false-if-exception (close-connection store)))))) (false-if-exception (close-connection store))))))
@ -622,7 +641,7 @@ (define* (process-stderr server #:optional user-port)
conservatively consider it to be Latin-1, thereby avoiding possible conservatively consider it to be Latin-1, thereby avoiding possible
encoding conversion errors." encoding conversion errors."
(define p (define p
(nix-server-socket server)) (store-connection-socket server))
;; magic cookies from worker-protocol.hh ;; magic cookies from worker-protocol.hh
(define %stderr-next #x6f6c6d67) ; "olmg", build log (define %stderr-next #x6f6c6d67) ; "olmg", build log
@ -666,7 +685,7 @@ (define %stderr-error #x63787470) ; "cxtp", error reporting
(let ((error (read-maybe-utf8-string p)) (let ((error (read-maybe-utf8-string p))
;; Currently the daemon fails to send a status code for early ;; Currently the daemon fails to send a status code for early
;; errors like DB schema version mismatches, so check for EOF. ;; errors like DB schema version mismatches, so check for EOF.
(status (if (and (>= (nix-server-minor-version server) 8) (status (if (and (>= (store-connection-minor-version server) 8)
(not (eof-object? (lookahead-u8 p)))) (not (eof-object? (lookahead-u8 p))))
(read-int p) (read-int p)
1))) 1)))
@ -734,7 +753,7 @@ (define* (set-build-options server
;; Must be called after `open-connection'. ;; Must be called after `open-connection'.
(define socket (define socket
(nix-server-socket server)) (store-connection-socket server))
(let-syntax ((send (syntax-rules () (let-syntax ((send (syntax-rules ()
((_ (type option) ...) ((_ (type option) ...)
@ -744,22 +763,22 @@ (define socket
(write-int (operation-id set-options) socket) (write-int (operation-id set-options) socket)
(send (boolean keep-failed?) (boolean keep-going?) (send (boolean keep-failed?) (boolean keep-going?)
(boolean fallback?) (integer verbosity)) (boolean fallback?) (integer verbosity))
(when (< (nix-server-minor-version server) #x61) (when (< (store-connection-minor-version server) #x61)
(let ((max-build-jobs (or max-build-jobs 1)) (let ((max-build-jobs (or max-build-jobs 1))
(max-silent-time (or max-silent-time 3600))) (max-silent-time (or max-silent-time 3600)))
(send (integer max-build-jobs) (integer max-silent-time)))) (send (integer max-build-jobs) (integer max-silent-time))))
(when (>= (nix-server-minor-version server) 2) (when (>= (store-connection-minor-version server) 2)
(send (boolean use-build-hook?))) (send (boolean use-build-hook?)))
(when (>= (nix-server-minor-version server) 4) (when (>= (store-connection-minor-version server) 4)
(send (integer build-verbosity) (integer log-type) (send (integer build-verbosity) (integer log-type)
(boolean print-build-trace))) (boolean print-build-trace)))
(when (and (>= (nix-server-minor-version server) 6) (when (and (>= (store-connection-minor-version server) 6)
(< (nix-server-minor-version server) #x61)) (< (store-connection-minor-version server) #x61))
(let ((build-cores (or build-cores (current-processor-count)))) (let ((build-cores (or build-cores (current-processor-count))))
(send (integer build-cores)))) (send (integer build-cores))))
(when (>= (nix-server-minor-version server) 10) (when (>= (store-connection-minor-version server) 10)
(send (boolean use-substitutes?))) (send (boolean use-substitutes?)))
(when (>= (nix-server-minor-version server) 12) (when (>= (store-connection-minor-version server) 12)
(let ((pairs `(;; This option is honored by 'guix substitute' et al. (let ((pairs `(;; This option is honored by 'guix substitute' et al.
,@(if print-build-trace ,@(if print-build-trace
`(("print-extended-build-trace" `(("print-extended-build-trace"
@ -884,8 +903,8 @@ (define-syntax operation
((_ (name (type arg) ...) docstring return ...) ((_ (name (type arg) ...) docstring return ...)
(lambda (server arg ...) (lambda (server arg ...)
docstring docstring
(let* ((s (nix-server-socket server)) (let* ((s (store-connection-socket server))
(buffered (nix-server-output-port server))) (buffered (store-connection-output-port server)))
(record-operation 'name) (record-operation 'name)
(write-int (operation-id name) buffered) (write-int (operation-id name) buffered)
(write-arg type arg buffered) (write-arg type arg buffered)
@ -944,7 +963,7 @@ (define add-data-to-store
REFERENCES is the list of store paths referred to by the resulting store REFERENCES is the list of store paths referred to by the resulting store
path." path."
(let* ((args `(,bytes ,name ,references)) (let* ((args `(,bytes ,name ,references))
(cache (nix-server-add-text-to-store-cache server))) (cache (store-connection-add-text-to-store-cache server)))
(or (hash-ref cache args) (or (hash-ref cache args)
(let ((path (add-text-to-store server name bytes references))) (let ((path (add-text-to-store server name bytes references)))
(hash-set! cache args path) (hash-set! cache args path)
@ -973,7 +992,7 @@ (define add-to-store
;; We don't use the 'operation' macro so we can pass SELECT? to ;; We don't use the 'operation' macro so we can pass SELECT? to
;; 'write-file'. ;; 'write-file'.
(record-operation 'add-to-store) (record-operation 'add-to-store)
(let ((port (nix-server-socket server))) (let ((port (store-connection-socket server)))
(write-int (operation-id add-to-store) port) (write-int (operation-id add-to-store) port)
(write-string basename port) (write-string basename port)
(write-int 1 port) ;obsolete, must be #t (write-int 1 port) ;obsolete, must be #t
@ -999,7 +1018,7 @@ (define add-to-store
;; Note: We don't stat FILE-NAME at each call, and thus we assume that ;; Note: We don't stat FILE-NAME at each call, and thus we assume that
;; the file remains unchanged for the lifetime of SERVER. ;; the file remains unchanged for the lifetime of SERVER.
(let* ((args `(,file-name ,basename ,recursive? ,hash-algo ,select?)) (let* ((args `(,file-name ,basename ,recursive? ,hash-algo ,select?))
(cache (nix-server-add-to-store-cache server))) (cache (store-connection-add-to-store-cache server)))
(or (hash-ref cache args) (or (hash-ref cache args)
(let ((path (add-to-store server basename recursive? (let ((path (add-to-store server basename recursive?
hash-algo file-name hash-algo file-name
@ -1078,14 +1097,14 @@ (define (directory-entries directory)
((_ 'directory (names . _) ...) names))) ((_ 'directory (names . _) ...) names)))
(define cache (define cache
(nix-server-add-to-store-cache server)) (store-connection-add-to-store-cache server))
(or (hash-ref cache tree) (or (hash-ref cache tree)
(begin (begin
;; We don't use the 'operation' macro so we can use 'write-file-tree' ;; We don't use the 'operation' macro so we can use 'write-file-tree'
;; instead of 'write-file'. ;; instead of 'write-file'.
(record-operation 'add-to-store/tree) (record-operation 'add-to-store/tree)
(let ((port (nix-server-socket server))) (let ((port (store-connection-socket server)))
(write-int (operation-id add-to-store) port) (write-int (operation-id add-to-store) port)
(write-string basename port) (write-string basename port)
(write-int 1 port) ;obsolete, must be #t (write-int 1 port) ;obsolete, must be #t
@ -1117,8 +1136,8 @@ (define build-things
that are not derivations can only be substituted and not built locally. that are not derivations can only be substituted and not built locally.
Return #t on success." Return #t on success."
(parameterize ((current-store-protocol-version (parameterize ((current-store-protocol-version
(nix-server-version store))) (store-connection-version store)))
(if (>= (nix-server-minor-version store) 15) (if (>= (store-connection-minor-version store) 15)
(build store things mode) (build store things mode)
(if (= mode (build-mode normal)) (if (= mode (build-mode normal))
(build/old store things) (build/old store things)
@ -1334,9 +1353,9 @@ (define built-in-builders
;; derivation builders in general, which appeared in Guix > 0.11.0. ;; derivation builders in general, which appeared in Guix > 0.11.0.
;; Return the empty list if it doesn't. Note that this RPC does not ;; Return the empty list if it doesn't. Note that this RPC does not
;; exist in 'nix-daemon'. ;; exist in 'nix-daemon'.
(if (or (> (nix-server-major-version store) #x100) (if (or (> (store-connection-major-version store) #x100)
(and (= (nix-server-major-version store) #x100) (and (= (store-connection-major-version store) #x100)
(>= (nix-server-minor-version store) #x60))) (>= (store-connection-minor-version store) #x60)))
(builders store) (builders store)
'())))) '()))))
@ -1366,14 +1385,14 @@ (define (run-gc server action to-delete min-freed)
#f. MIN-FREED is the minimum amount of disk space to be freed, in #f. MIN-FREED is the minimum amount of disk space to be freed, in
bytes, before the GC can stop. Return the list of store paths delete, bytes, before the GC can stop. Return the list of store paths delete,
and the number of bytes freed." and the number of bytes freed."
(let ((s (nix-server-socket server))) (let ((s (store-connection-socket server)))
(write-int (operation-id collect-garbage) s) (write-int (operation-id collect-garbage) s)
(write-int action s) (write-int action s)
(write-store-path-list to-delete s) (write-store-path-list to-delete s)
(write-arg boolean #f s) ; ignore-liveness? (write-arg boolean #f s) ; ignore-liveness?
(write-long-long min-freed s) (write-long-long min-freed s)
(write-int 0 s) ; obsolete (write-int 0 s) ; obsolete
(when (>= (nix-server-minor-version server) 5) (when (>= (store-connection-minor-version server) 5)
;; Obsolete `use-atime' and `max-atime' parameters. ;; Obsolete `use-atime' and `max-atime' parameters.
(write-int 0 s) (write-int 0 s)
(write-int 0 s)) (write-int 0 s))
@ -1389,8 +1408,8 @@ (define (run-gc server action to-delete min-freed)
;; To be on the safe side, completely invalidate both caches. ;; To be on the safe side, completely invalidate both caches.
;; Otherwise we could end up returning store paths that are no longer ;; Otherwise we could end up returning store paths that are no longer
;; valid. ;; valid.
(hash-clear! (nix-server-add-to-store-cache server)) (hash-clear! (store-connection-add-to-store-cache server))
(hash-clear! (nix-server-add-text-to-store-cache server))) (hash-clear! (store-connection-add-text-to-store-cache server)))
(values paths freed)))) (values paths freed))))
@ -1425,7 +1444,7 @@ (define (import-paths server port)
"Import the set of store paths read from PORT into SERVER's store. An error "Import the set of store paths read from PORT into SERVER's store. An error
is raised if the set of paths read from PORT is not signed (as per is raised if the set of paths read from PORT is not signed (as per
'export-path #:sign? #t'.) Return the list of store paths imported." 'export-path #:sign? #t'.) Return the list of store paths imported."
(let ((s (nix-server-socket server))) (let ((s (store-connection-socket server)))
(write-int (operation-id import-paths) s) (write-int (operation-id import-paths) s)
(let loop ((done? (process-stderr server port))) (let loop ((done? (process-stderr server port)))
(or done? (loop (process-stderr server port)))) (or done? (loop (process-stderr server port))))
@ -1433,7 +1452,7 @@ (define (import-paths server port)
(define* (export-path server path port #:key (sign? #t)) (define* (export-path server path port #:key (sign? #t))
"Export PATH to PORT. When SIGN? is true, sign it." "Export PATH to PORT. When SIGN? is true, sign it."
(let ((s (nix-server-socket server))) (let ((s (store-connection-socket server)))
(write-int (operation-id export-path) s) (write-int (operation-id export-path) s)
(write-store-path path s) (write-store-path path s)
(write-arg boolean sign? s) (write-arg boolean sign? s)
@ -1502,10 +1521,10 @@ (define* (cache-object-mapping object keys result)
and RESULT is typically its derivation." and RESULT is typically its derivation."
(lambda (store) (lambda (store)
(values result (values result
(nix-server (store-connection
(inherit store) (inherit store)
(object-cache (vhash-consq object (cons result keys) (object-cache (vhash-consq object (cons result keys)
(nix-server-object-cache store))))))) (store-connection-object-cache store)))))))
(define record-cache-lookup! (define record-cache-lookup!
(if (profiled? "object-cache") (if (profiled? "object-cache")
@ -1540,7 +1559,7 @@ (define* (lookup-cached-object object #:optional (keys '()))
compared with 'equal?'. Return #f on failure and the cached result compared with 'equal?'. Return #f on failure and the cached result
otherwise." otherwise."
(lambda (store) (lambda (store)
(let* ((cache (nix-server-object-cache store)) (let* ((cache (store-connection-object-cache store))
;; Escape as soon as we find the result. This avoids traversing ;; Escape as soon as we find the result. This avoids traversing
;; the whole vlist chain and significantly reduces the number of ;; the whole vlist chain and significantly reduces the number of