#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module ((guix diagnostics)
+ #:select (source-properties->location))
#:use-module ((guix utils)
#:select (%current-system
- source-properties->location
call-with-temporary-directory
version>? version-prefix?
cache-directory))
inferior-exception?
inferior-exception-arguments
inferior-exception-inferior
+ inferior-exception-stack
read-repl-response
inferior-packages
(letrec ((result (inferior 'pipe pipe close (cons 0 rest)
(delay (%inferior-packages result))
(delay (%inferior-package-table result)))))
+
+ ;; For protocol (0 1) and later, send the protocol version we support.
+ (match rest
+ ((n _ ...)
+ (when (>= n 1)
+ (send-inferior-request '(() repl-version 0 1 1) result)))
+ (_
+ #t))
+
(inferior-eval '(use-modules (guix)) result)
(inferior-eval '(use-modules (gnu)) result)
(inferior-eval '(use-modules (ice-9 match)) result)
(define-condition-type &inferior-exception &error
inferior-exception?
(arguments inferior-exception-arguments) ;key + arguments
- (inferior inferior-exception-inferior)) ;<inferior> | #f
+ (inferior inferior-exception-inferior) ;<inferior> | #f
+ (stack inferior-exception-stack)) ;list of (FILE COLUMN LINE)
(define* (read-repl-response port #:optional inferior)
"Read a (guix repl) response from PORT and return it as a Scheme object.
(match (read port)
(('values objects ...)
(apply values (map sexp->object objects)))
+ (('exception ('arguments key objects ...)
+ ('stack frames ...))
+ ;; Protocol (0 1 1) and later.
+ (raise (condition (&inferior-exception
+ (arguments (cons key (map sexp->object objects)))
+ (inferior inferior)
+ (stack frames)))))
(('exception key objects ...)
+ ;; Protocol (0 0).
(raise (condition (&inferior-exception
(arguments (cons key (map sexp->object objects)))
- (inferior inferior)))))))
+ (inferior inferior)
+ (stack '())))))))
(define (read-inferior-response inferior)
(read-repl-response (inferior-socket inferior)
(define* (cached-channel-instance store
channels
#:key
+ (authenticate? #t)
(cache-directory (%inferior-cache-directory))
(ttl (* 3600 24 30)))
"Return a directory containing a guix filetree defined by CHANNELS, a list of channels.
The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds.
-This procedure opens a new connection to the build daemon."
+This procedure opens a new connection to the build daemon. AUTHENTICATE?
+determines whether CHANNELS are authenticated."
(define instances
- (latest-channel-instances store channels))
+ (latest-channel-instances store channels
+ #:authenticate? authenticate?))
(define key
(bytevector->base32-string
(mbegin %store-monad
(show-what-to-build* (list profile))
(built-derivations (list profile))
+ ;; Note: Caching is fine even when AUTHENTICATE? is false because
+ ;; we always call 'latest-channel-instances?'.
(symlink* (derivation->output-path profile) cached)
(add-indirect-root* cached)
(return cached))))))