Mirror of GNU Guix
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1287 lines
48 KiB

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix store)
#:use-module (guix utils)
#:use-module (guix config)
#:use-module (guix combinators)
#:use-module (guix serialization)
monads: Move '%store-monad' and related procedures where they belong. This turns (guix monads) into a generic module for monads, and moves the store monad and related monadic procedures in their corresponding module. * guix/monads.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file, package-file, package->derivation, package->cross-derivation, origin->derivation, imported-modules, compiled, modules, built-derivations, run-with-store): Move to... * guix/store.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file): ... here. (%guile-for-build): New variable. (run-with-store): Moved from monads.scm. Remove default value for #:guile-for-build. * guix/packages.scm (default-guile): Export. (set-guile-for-build): New procedure. (package-file, package->derivation, package->cross-derivation, origin->derivation): Moved from monads.scm. * guix/derivations.scm (%guile-for-build): Remove. (imported-modules): Rename to... (%imported-modules): ... this. (compiled-modules): Rename to... (%compiled-modules): ... this. (built-derivations, imported-modules, compiled-modules): New procedures. * gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/dbus.scm, gnu/services/dmd.scm, gnu/services/networking.scm, gnu/services/ssh.scm, gnu/services/xorg.scm, gnu/system/install.scm, gnu/system/linux-initrd.scm, gnu/system/shadow.scm, guix/download.scm, guix/gexp.scm, guix/git-download.scm, guix/profiles.scm, guix/svn-download.scm, tests/monads.scm: Adjust imports accordingly. * guix/monad-repl.scm (default-guile-derivation): New procedure. (store-monad-language, run-in-store): Use it. * build-aux/hydra/gnu-system.scm (qemu-jobs): Add explicit 'set-guile-for-build' call. * guix/scripts/archive.scm (derivation-from-expression): Likewise. * guix/scripts/build.scm (options/resolve-packages): Likewise. * guix/scripts/environment.scm (guix-environment): Likewise. * guix/scripts/system.scm (guix-system): Likewise. * doc/guix.texi (The Store Monad): Adjust module names accordingly.
8 years ago
#:use-module (guix monads)
#:autoload (guix base32) (bytevector->base32-string)
#:autoload (guix build syscalls) (terminal-columns)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-39)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
#:use-module (ice-9 popen)
#:export (%daemon-socket-file
%gc-roots-directory
%default-substitute-urls
nix-server?
nix-server-major-version
nix-server-minor-version
nix-server-socket
&nix-error nix-error?
&nix-connection-error nix-connection-error?
nix-connection-error-file
nix-connection-error-code
&nix-protocol-error nix-protocol-error?
nix-protocol-error-message
nix-protocol-error-status
hash-algo
build-mode
open-connection
close-connection
with-store
set-build-options
set-build-options*
valid-path?
query-path-hash
hash-part->path
query-path-info
add-text-to-store
add-to-store
build-things
build
query-failed-paths
clear-failed-paths
add-temp-root
add-indirect-root
add-permanent-root
remove-permanent-root
substitutable?
substitutable-path
substitutable-deriver
substitutable-references
substitutable-download-size
substitutable-nar-size
has-substitutes?
substitutable-paths
substitutable-path-info
path-info?
path-info-deriver
path-info-hash
path-info-references
path-info-registration-time
path-info-nar-size
built-in-builders
references
references/substitutes
requisites
referrers
optimize-store
verify-store
topologically-sorted
valid-derivers
query-derivation-outputs
live-paths
dead-paths
collect-garbage
delete-paths
import-paths
export-paths
current-build-output-port
register-path
monads: Move '%store-monad' and related procedures where they belong. This turns (guix monads) into a generic module for monads, and moves the store monad and related monadic procedures in their corresponding module. * guix/monads.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file, package-file, package->derivation, package->cross-derivation, origin->derivation, imported-modules, compiled, modules, built-derivations, run-with-store): Move to... * guix/store.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file): ... here. (%guile-for-build): New variable. (run-with-store): Moved from monads.scm. Remove default value for #:guile-for-build. * guix/packages.scm (default-guile): Export. (set-guile-for-build): New procedure. (package-file, package->derivation, package->cross-derivation, origin->derivation): Moved from monads.scm. * guix/derivations.scm (%guile-for-build): Remove. (imported-modules): Rename to... (%imported-modules): ... this. (compiled-modules): Rename to... (%compiled-modules): ... this. (built-derivations, imported-modules, compiled-modules): New procedures. * gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/dbus.scm, gnu/services/dmd.scm, gnu/services/networking.scm, gnu/services/ssh.scm, gnu/services/xorg.scm, gnu/system/install.scm, gnu/system/linux-initrd.scm, gnu/system/shadow.scm, guix/download.scm, guix/gexp.scm, guix/git-download.scm, guix/profiles.scm, guix/svn-download.scm, tests/monads.scm: Adjust imports accordingly. * guix/monad-repl.scm (default-guile-derivation): New procedure. (store-monad-language, run-in-store): Use it. * build-aux/hydra/gnu-system.scm (qemu-jobs): Add explicit 'set-guile-for-build' call. * guix/scripts/archive.scm (derivation-from-expression): Likewise. * guix/scripts/build.scm (options/resolve-packages): Likewise. * guix/scripts/environment.scm (guix-environment): Likewise. * guix/scripts/system.scm (guix-system): Likewise. * doc/guix.texi (The Store Monad): Adjust module names accordingly.
8 years ago
%store-monad
store-bind
store-return
store-lift
store-lower
monads: Move '%store-monad' and related procedures where they belong. This turns (guix monads) into a generic module for monads, and moves the store monad and related monadic procedures in their corresponding module. * guix/monads.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file, package-file, package->derivation, package->cross-derivation, origin->derivation, imported-modules, compiled, modules, built-derivations, run-with-store): Move to... * guix/store.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file): ... here. (%guile-for-build): New variable. (run-with-store): Moved from monads.scm. Remove default value for #:guile-for-build. * guix/packages.scm (default-guile): Export. (set-guile-for-build): New procedure. (package-file, package->derivation, package->cross-derivation, origin->derivation): Moved from monads.scm. * guix/derivations.scm (%guile-for-build): Remove. (imported-modules): Rename to... (%imported-modules): ... this. (compiled-modules): Rename to... (%compiled-modules): ... this. (built-derivations, imported-modules, compiled-modules): New procedures. * gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/dbus.scm, gnu/services/dmd.scm, gnu/services/networking.scm, gnu/services/ssh.scm, gnu/services/xorg.scm, gnu/system/install.scm, gnu/system/linux-initrd.scm, gnu/system/shadow.scm, guix/download.scm, guix/gexp.scm, guix/git-download.scm, guix/profiles.scm, guix/svn-download.scm, tests/monads.scm: Adjust imports accordingly. * guix/monad-repl.scm (default-guile-derivation): New procedure. (store-monad-language, run-in-store): Use it. * build-aux/hydra/gnu-system.scm (qemu-jobs): Add explicit 'set-guile-for-build' call. * guix/scripts/archive.scm (derivation-from-expression): Likewise. * guix/scripts/build.scm (options/resolve-packages): Likewise. * guix/scripts/environment.scm (guix-environment): Likewise. * guix/scripts/system.scm (guix-system): Likewise. * doc/guix.texi (The Store Monad): Adjust module names accordingly.
8 years ago
run-with-store
%guile-for-build
current-system
set-current-system
monads: Move '%store-monad' and related procedures where they belong. This turns (guix monads) into a generic module for monads, and moves the store monad and related monadic procedures in their corresponding module. * guix/monads.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file, package-file, package->derivation, package->cross-derivation, origin->derivation, imported-modules, compiled, modules, built-derivations, run-with-store): Move to... * guix/store.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file): ... here. (%guile-for-build): New variable. (run-with-store): Moved from monads.scm. Remove default value for #:guile-for-build. * guix/packages.scm (default-guile): Export. (set-guile-for-build): New procedure. (package-file, package->derivation, package->cross-derivation, origin->derivation): Moved from monads.scm. * guix/derivations.scm (%guile-for-build): Remove. (imported-modules): Rename to... (%imported-modules): ... this. (compiled-modules): Rename to... (%compiled-modules): ... this. (built-derivations, imported-modules, compiled-modules): New procedures. * gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/dbus.scm, gnu/services/dmd.scm, gnu/services/networking.scm, gnu/services/ssh.scm, gnu/services/xorg.scm, gnu/system/install.scm, gnu/system/linux-initrd.scm, gnu/system/shadow.scm, guix/download.scm, guix/gexp.scm, guix/git-download.scm, guix/profiles.scm, guix/svn-download.scm, tests/monads.scm: Adjust imports accordingly. * guix/monad-repl.scm (default-guile-derivation): New procedure. (store-monad-language, run-in-store): Use it. * build-aux/hydra/gnu-system.scm (qemu-jobs): Add explicit 'set-guile-for-build' call. * guix/scripts/archive.scm (derivation-from-expression): Likewise. * guix/scripts/build.scm (options/resolve-packages): Likewise. * guix/scripts/environment.scm (guix-environment): Likewise. * guix/scripts/system.scm (guix-system): Likewise. * doc/guix.texi (The Store Monad): Adjust module names accordingly.
8 years ago
text-file
interned-file
%store-prefix
store-path?
direct-store-path?
derivation-path?
store-path-package-name
store-path-hash-part
direct-store-path
log-file))
(define %protocol-version #x10f)
(define %worker-magic-1 #x6e697863) ; "nixc"
(define %worker-magic-2 #x6478696f) ; "dxio"
(define (protocol-major magic)
(logand magic #xff00))
(define (protocol-minor magic)
(logand magic #x00ff))
(define-syntax define-enumerate-type
(syntax-rules ()
((_ name->int (name id) ...)
(define-syntax name->int
(syntax-rules (name ...)
((_ name) id) ...)))))
(define-enumerate-type operation-id
;; operation numbers from worker-protocol.hh
(quit 0)
(valid-path? 1)
(has-substitutes? 3)
(query-path-hash 4)
(query-references 5)
(query-referrers 6)
(add-to-store 7)
(add-text-to-store 8)
(build-things 9)
(ensure-path 10)
(add-temp-root 11)
(add-indirect-root 12)
(sync-with-gc 13)
(find-roots 14)
(export-path 16)
(query-deriver 18)
(set-options 19)
(collect-garbage 20)
;;(query-substitutable-path-info 21) ; obsolete as of #x10c
(query-derivation-outputs 22)
(query-all-valid-paths 23)
(query-failed-paths 24)
(clear-failed-paths 25)
(query-path-info 26)
(import-paths 27)
(query-derivation-output-names 28)
(query-path-from-hash-part 29)
(query-substitutable-path-infos 30)
(query-valid-paths 31)
(query-substitutable-paths 32)
(query-valid-derivers 33)
(optimize-store 34)
(verify-store 35)
(built-in-builders 80))
(define-enumerate-type hash-algo
;; hash.hh
(md5 1)
(sha1 2)
(sha256 3))
(define-enumerate-type build-mode
;; store-api.hh
(normal 0)
(repair 1)
(check 2))
(define-enumerate-type gc-action
;; store-api.hh
(return-live 0)
(return-dead 1)
(delete-dead 2)
(delete-specific 3))
(define %default-socket-path
(string-append %state-directory "/daemon-socket/socket"))
(define %daemon-socket-file
;; File name of the socket the daemon listens too.
(make-parameter (or (getenv "GUIX_DAEMON_SOCKET")
%default-socket-path)))
;; Information about a substitutable store path.
(define-record-type <substitutable>
(substitutable path deriver refs dl-size nar-size)
substitutable?
(path substitutable-path)
(deriver substitutable-deriver)
(refs substitutable-references)
(dl-size substitutable-download-size)
(nar-size substitutable-nar-size))
(define (read-substitutable-path-list p)
(let loop ((len (read-int p))
(result '()))
(if (zero? len)
(reverse result)
(let ((path (read-store-path p))
(deriver (read-store-path p))
(refs (read-store-path-list p))
(dl-size (read-long-long p))
(nar-size (read-long-long p)))
(loop (- len 1)
(cons (substitutable path deriver refs dl-size nar-size)
result))))))
;; Information about a store path.
(define-record-type <path-info>
(path-info deriver hash references registration-time nar-size)
path-info?
(deriver path-info-deriver) ;string | #f
(hash path-info-hash)
(references path-info-references)
(registration-time path-info-registration-time)
(nar-size path-info-nar-size))
(define (read-path-info p)
(let ((deriver (match (read-store-path p)
("" #f)
(x x)))
(hash (base16-string->bytevector (read-string p)))
(refs (read-store-path-list p))
(registration-time (read-int p))
(nar-size (read-long-long p)))
(path-info deriver hash refs registration-time nar-size)))
(define-syntax write-arg
(syntax-rules (integer boolean string string-list string-pairs
store-path store-path-list base16)
((_ integer arg p)
(write-int arg p))
((_ boolean arg p)
(write-int (if arg 1 0) p))
((_ string arg p)
(write-string arg p))
((_ string-list arg p)
(write-string-list arg p))
((_ string-pairs arg p)
(write-string-pairs arg p))
((_ store-path arg p)
(write-store-path arg p))
((_ store-path-list arg p)
(write-store-path-list arg p))
((_ base16 arg p)
(write-string (bytevector->base16-string arg) p))))
(define-syntax read-arg
(syntax-rules (integer boolean string store-path store-path-list string-list
substitutable-path-list path-info base16)
((_ integer p)
(read-int p))
((_ boolean p)
(not (zero? (read-int p))))
((_ string p)
(read-string p))
((_ store-path p)
(read-store-path p))
((_ store-path-list p)
(read-store-path-list p))
((_ string-list p)
(read-string-list p))
((_ substitutable-path-list p)
(read-substitutable-path-list p))
((_ path-info p)
(read-path-info p))
((_ base16 p)
(base16-string->bytevector (read-string p)))))
;; remote-store.cc
(define-record-type <nix-server>
(%make-nix-server socket major minor
ats-cache atts-cache)
nix-server?
(socket nix-server-socket)
(major nix-server-major-version)
(minor nix-server-minor-version)
;; Caches. We keep them per-connection, because store paths build
;; during the session are temporary GC roots kept for the duration of
;; the session.
(ats-cache nix-server-add-to-store-cache)
(atts-cache nix-server-add-text-to-store-cache))
(set-record-type-printer! <nix-server>
(lambda (obj port)
(format port "#<build-daemon ~a.~a ~a>"
(nix-server-major-version obj)
(nix-server-minor-version obj)
(number->string (object-address obj)
16))))
(define-condition-type &nix-error &error
nix-error?)
(define-condition-type &nix-connection-error &nix-error
nix-connection-error?
(file nix-connection-error-file)
(errno nix-connection-error-code))
(define-condition-type &nix-protocol-error &nix-error
nix-protocol-error?
(message nix-protocol-error-message)
(status nix-protocol-error-status))
(define* (open-connection #:optional (file (%daemon-socket-file))
#:key (reserve-space? #t) cpu-affinity)
"Connect to the daemon over the Unix-domain socket at FILE. 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 ((s (with-fluids ((%default-port-encoding #f))
;; This trick allows use of the `scm_c_read' optimization.
(socket PF_UNIX SOCK_STREAM 0)))
(a (make-socket-address PF_UNIX file)))
(catch 'system-error
(cut connect s a)
(lambda args
;; Translate the error to something user-friendly.
(let ((errno (system-error-errno args)))
(raise (condition (&nix-connection-error
(file file)
(errno errno)))))))
(write-int %worker-magic-1 s)
(let ((r (read-int s)))
(and (eqv? r %worker-magic-2)
(let ((v (read-int s)))
(and (eqv? (protocol-major %protocol-version)
(protocol-major v))
(begin
(write-int %protocol-version s)
(when (>= (protocol-minor v) 14)
(write-int (if cpu-affinity 1 0) s)
(when cpu-affinity
(write-int cpu-affinity s)))
(when (>= (protocol-minor v) 11)
(write-int (if reserve-space? 1 0) s))
(let ((s (%make-nix-server s
(protocol-major v)
(protocol-minor v)
(make-hash-table 100)
(make-hash-table 100))))
(let loop ((done? (process-stderr s)))
(or done? (process-stderr s)))
s))))))))
(define (close-connection server)
"Close the connection to SERVER."
(close (nix-server-socket server)))
(define-syntax-rule (with-store store exp ...)
"Bind STORE to an open connection to the store and evaluate EXPs;
automatically close the store when the dynamic extent of EXP is left."
(let ((store (open-connection)))
(dynamic-wind
(const #f)
(lambda ()
exp ...)
(lambda ()
(false-if-exception (close-connection store))))))
(define current-build-output-port
;; The port where build output is sent.
(make-parameter (current-error-port)))
(define* (dump-port in out
#:optional len
#:key (buffer-size 16384))
"Read LEN bytes from IN (or as much as possible if LEN is #f) and write it
to OUT, using chunks of BUFFER-SIZE bytes."
(define buffer
(make-bytevector buffer-size))
(let loop ((total 0)
(bytes (get-bytevector-n! in buffer 0
(if len
(min len buffer-size)
buffer-size))))
(or (eof-object? bytes)
(and len (= total len))
(let ((total (+ total bytes)))
(put-bytevector out buffer 0 bytes)
(loop total
(get-bytevector-n! in buffer 0
(if len
(min (- len total) buffer-size)
buffer-size)))))))
(define %newlines
;; Newline characters triggering a flush of 'current-build-output-port'.
;; Unlike Guile's _IOLBF, we flush upon #\return so that progress reports
;; that use that trick are correctly displayed.
(char-set #\newline #\return))
(define* (process-stderr server #:optional user-port)
"Read standard output and standard error from SERVER, writing it to
CURRENT-BUILD-OUTPUT-PORT. Return #t when SERVER is done sending data, and
#f otherwise; in the latter case, the caller should call `process-stderr'
again until #t is returned or an error is raised.
Since the build process's output cannot be assumed to be UTF-8, we
conservatively consider it to be Latin-1, thereby avoiding possible
encoding conversion errors."
(define p
(nix-server-socket server))
;; magic cookies from worker-protocol.hh
(define %stderr-next #x6f6c6d67) ; "olmg", build log
(define %stderr-read #x64617461) ; "data", data needed from source
(define %stderr-write #x64617416) ; "dat\x16", data for sink
(define %stderr-last #x616c7473) ; "alts", we're done
(define %stderr-error #x63787470) ; "cxtp", error reporting
(let ((k (read-int p)))
(cond ((= k %stderr-write)
;; Write a byte stream to USER-PORT.
(let* ((len (read-int p))
(m (modulo len 8)))
(dump-port p user-port len)
(unless (zero? m)
;; Consume padding, as for strings.
(get-bytevector-n p (- 8 m))))
#f)
((= k %stderr-read)
;; Read a byte stream from USER-PORT.
;; Note: Avoid 'get-bytevector-n' to work around
;; <http://bugs.gnu.org/17591> in Guile up to 2.0.11.
(let* ((max-len (read-int p))
(data (make-bytevector max-len))
(len (get-bytevector-n! user-port data 0 max-len)))
(write-int len p)
(put-bytevector p data 0 len)
(write-padding len p)
#f))
((= k %stderr-next)
;; Log a string. Build logs are usually UTF-8-encoded, but they
;; may also contain arbitrary byte sequences that should not cause
;; this to fail. Thus, use the permissive
;; 'read-maybe-utf8-string'.
(let ((s (read-maybe-utf8-string p)))
(display s (current-build-output-port))
(when (string-any %newlines s)
(force-output (current-build-output-port)))
#f))
((= k %stderr-error)
;; Report an error.
(let ((error (read-maybe-utf8-string p))
;; Currently the daemon fails to send a status code for early
;; errors like DB schema version mismatches, so check for EOF.
(status (if (and (>= (nix-server-minor-version server) 8)
(not (eof-object? (lookahead-u8 p))))
(read-int p)
1)))
(raise (condition (&nix-protocol-error
(message error)
(status status))))))
((= k %stderr-last)
;; The daemon is done (see `stopWork' in `nix-worker.cc'.)
#t)
(else
(raise (condition (&nix-protocol-error
(message "invalid error code")
(status k))))))))
(define %default-substitute-urls
;; Default list of substituters. This is *not* the list baked in
;; 'guix-daemon', but it is used by 'guix-service-type' and and a couple of
;; clients ('guix build --log-file' uses it.)
(map (if (false-if-exception (resolve-interface '(gnutls)))
(cut string-append "https://" <>)
(cut string-append "http://" <>))
'("mirror.hydra.gnu.org")))
(define* (set-build-options server
#:key keep-failed? keep-going? fallback?
(verbosity 0)
rounds ;number of build rounds
(max-build-jobs 1)
timeout
(max-silent-time 3600)
(use-build-hook? #t)
(build-verbosity 0)
(log-type 0)
(print-build-trace #t)
(build-cores (current-processor-count))
(use-substitutes? #t)
;; Client-provided substitute URLs. If it is #f,
;; the daemon's settings are used. Otherwise, it
;; overrides the daemons settings; see 'guix
;; substitute'.
(substitute-urls #f)
;; Number of columns in the client's terminal.
(terminal-columns (terminal-columns))
;; Locale of the client.
(locale (false-if-exception (setlocale LC_ALL))))
;; Must be called after `open-connection'.
(define socket
(nix-server-socket server))
(let-syntax ((send (syntax-rules ()
((_ (type option) ...)
(begin
(write-arg type option socket)
...)))))
(write-int (operation-id set-options) socket)
(send (boolean keep-failed?) (boolean keep-going?)
(boolean fallback?) (integer verbosity)
(integer max-build-jobs) (integer max-silent-time))
(when (>= (nix-server-minor-version server) 2)
(send (boolean use-build-hook?)))
(when (>= (nix-server-minor-version server) 4)
(send (integer build-verbosity) (integer log-type)
(boolean print-build-trace)))
(when (>= (nix-server-minor-version server) 6)
(send (integer build-cores)))
(when (>= (nix-server-minor-version server) 10)
(send (boolean use-substitutes?)))
(when (>= (nix-server-minor-version server) 12)
(let ((pairs `(,@(if timeout
`(("build-timeout" . ,(number->string timeout)))
'())
,@(if substitute-urls
`(("substitute-urls"
. ,(string-join substitute-urls)))
'())
,@(if rounds
`(("build-repeat"
. ,(number->string (max 0 (1- rounds)))))
'())
,@(if terminal-columns
`(("terminal-columns"
. ,(number->string terminal-columns)))
'())
,@(if locale
`(("locale" . ,locale))
'()))))
(send (string-pairs pairs))))
(let loop ((done? (process-stderr server)))
(or done? (process-stderr server)))))
(define-syntax operation
(syntax-rules ()
"Define a client-side RPC stub for the given operation."
((_ (name (type arg) ...) docstring return ...)
(lambda (server arg ...)
docstring
(let ((s (nix-server-socket server)))
(write-int (operation-id name) s)
(write-arg type arg s)
...
;; Loop until the server is done sending error output.
(let loop ((done? (process-stderr server)))
(or done? (loop (process-stderr server))))
(values (read-arg return s) ...))))))
(define-syntax-rule (define-operation (name args ...)
docstring return ...)
(define name
(operation (name args ...) docstring return ...)))
(define-operation (valid-path? (string path))
"Return #t when PATH designates a valid store item and #f otherwise (an
invalid item may exist on disk but still be invalid, for instance because it
is the result of an aborted or failed build.)
A '&nix-protocol-error' condition is raised if PATH is not prefixed by the
store directory (/gnu/store)."
boolean)
(define-operation (query-path-hash (store-path path))
"Return the SHA256 hash of the nar serialization of PATH as a bytevector."
base16)
(define hash-part->path
(let ((query-path-from-hash-part
(operation (query-path-from-hash-part (string hash))
#f
store-path)))
(lambda (server hash-part)
"Return the store path whose hash part is HASH-PART (a nix-base32
string). Raise an error if no such path exists."
;; This RPC is primarily used by Hydra to reply to HTTP GETs of
;; /HASH.narinfo.
(query-path-from-hash-part server hash-part))))
(define-operation (query-path-info (store-path path))
"Return the info (hash, references, etc.) for PATH."
path-info)
(define add-text-to-store
;; A memoizing version of `add-to-store', to avoid repeated RPCs with
;; the very same arguments during a given session.
(let ((add-text-to-store
(operation (add-text-to-store (string name) (string text)
(string-list references))
#f
store-path)))
(lambda* (server name text #:optional (references