1 files changed, 32 insertions, 25 deletions

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 5dfd30a6c8..fca6fb4b22 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -871,11 +871,15 @@ prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip."
                                   #:key
                                   (authenticate? #t)
                                   (cache-directory (%inferior-cache-directory))
-                                  (ttl (* 3600 24 30)))
+                                  (ttl (* 3600 24 30))
+                                  validate-channels)
   "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.  AUTHENTICATE?
-determines whether CHANNELS are authenticated."
+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.  AUTHENTICATE? determines whether CHANNELS are authenticated.
+VALIDATE-CHANNELS, if specified, must be a one argument procedure accepting a
+list of channels that can be used to validate the channels; it should raise an
+exception in case of problems."
   (define commits
     ;; Since computing the instances of CHANNELS is I/O-intensive, use a
     ;; cheaper way to get the commit list of CHANNELS.  This limits overhead
@@ -923,27 +927,30 @@ determines whether CHANNELS are authenticated."
 
   (if (file-exists? cached)
       cached
-      (run-with-store store
-        (mlet* %store-monad ((instances
-                              -> (latest-channel-instances store channels
-                                                           #:authenticate?
-                                                           authenticate?))
-                             (profile
-                              (channel-instances->derivation instances)))
-          (mbegin %store-monad
-            ;; It's up to the caller to install a build handler to report
-            ;; what's going to be built.
-            (built-derivations (list profile))
-
-            ;; Cache if and only if AUTHENTICATE? is true.
-            (if authenticate?
-                (mbegin %store-monad
-                  (symlink* (derivation->output-path profile) cached)
-                  (add-indirect-root* cached)
-                  (return cached))
-                (mbegin %store-monad
-                  (add-temp-root* (derivation->output-path profile))
-                  (return (derivation->output-path profile)))))))))
+      (begin
+        (when (procedure? validate-channels)
+          (validate-channels channels))
+        (run-with-store store
+          (mlet* %store-monad ((instances
+                                -> (latest-channel-instances store channels
+                                                             #:authenticate?
+                                                             authenticate?))
+                               (profile
+                                (channel-instances->derivation instances)))
+            (mbegin %store-monad
+              ;; It's up to the caller to install a build handler to report
+              ;; what's going to be built.
+              (built-derivations (list profile))
+
+              ;; Cache if and only if AUTHENTICATE? is true.
+              (if authenticate?
+                  (mbegin %store-monad
+                    (symlink* (derivation->output-path profile) cached)
+                    (add-indirect-root* cached)
+                    (return cached))
+                  (mbegin %store-monad
+                    (add-temp-root* (derivation->output-path profile))
+                    (return (derivation->output-path profile))))))))))
 
 (define* (inferior-for-channels channels
                                 #:key