X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/ec0a8661728f915c21058076327b398ac5c38bbe..66a8e620705d98b6240670f7f5f9441462e8f621:/guix/inferior.scm

diff --git a/guix/inferior.scm b/guix/inferior.scm
index ec8ff8ddbe..77820872b3 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -21,9 +21,10 @@
   #: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))
@@ -66,6 +67,7 @@
             inferior-exception?
             inferior-exception-arguments
             inferior-exception-inferior
+            inferior-exception-stack
             read-repl-response
 
             inferior-packages
@@ -164,7 +166,7 @@ inferior."
        (match rest
          ((n _ ...)
           (when (>= n 1)
-            (send-inferior-request '(() repl-version 0 1) result)))
+            (send-inferior-request '(() repl-version 0 1 1) result)))
          (_
           #t))
 
@@ -211,7 +213,8 @@ equivalent.  Return #f if the inferior could not be launched."
 (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.
@@ -226,10 +229,19 @@ Raise '&inferior-exception' when an exception is read from PORT."
   (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)
@@ -676,13 +688,16 @@ failing when GUIX is too old and lacks the 'guix repl' command."
 (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
@@ -721,6 +736,8 @@ This procedure opens a new connection to the build daemon."
           (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))))))