[bug#75407] [PATCH Cuirass] base: Add support for disabling channel authentication.

[Romain GARBAGE <romain.garbage@inria.fr>]

* src/cuirass/base.scm (channel-update-service, jobset-monitor): Add support
for disabling Guix channel authentication.
* doc/cuirass.texi (Specifications): Add documentation.
---
 doc/cuirass.texi     |  4 ++++
 src/cuirass/base.scm | 19 ++++++++++++++-----
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 4c160c3..b3ab4c5 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -248,6 +248,10 @@ You can store any information you like in properties, but you must make
 sure that this is serializable.  For example, the properties alist
 cannot contain records.
 
+The special @code{authenticate-channels?} property, when set to
+@code{#f}, disables authentication of @emph{all} the channels declared in the
+specification, including the Guix channel.
+
 @end table
 @end deftp
 
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 837de51..89fff82 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -507,7 +507,7 @@ to update Git checkouts, effectively serializing all Git operations."
   ;; Note: All Git operations are serialized when in fact it would be enough
   ;; to serialize operations with the same URL (because they are cached in the
   ;; same directory).
-  (define (fetch store channels)
+  (define (fetch store channels authenticate?)
     (let/ec return
       (with-exception-handler
           (lambda (exception)
@@ -533,16 +533,17 @@ to update Git checkouts, effectively serializing all Git operations."
         (lambda ()
           (non-blocking
            (set-thread-name "git-checkout")
-           (latest-channel-instances* store channels))))))
+           (latest-channel-instances* store channels
+                                      #:authenticate? authenticate?))))))
 
   (lambda ()
     (with-store store
       (let loop ()
         (match (get-message channel)
-          (`(fetch ,channels ,reply)
+          (`(fetch ,channels ,authenticate? ,reply)
            (log-info "fetching channels:~{ '~a'~}"
                      (map channel-name channels))
-           (let ((result (fetch store channels)))
+           (let ((result (fetch store channels authenticate?)))
              (if result
                  (log-info "pulled commits~{ ~a~}"
                            (zip (map (compose channel-name
@@ -741,6 +742,14 @@ concurrently; it sends derivation build requests to BUILDER."
       (define channels
         (specification-channels spec))
 
+      (define authenticate?
+        (match (assq 'authenticate-channels?
+                     (specification-properties spec))
+          (#f #t) ; Authenticate by default.
+          ((_ . authenticate?)
+           ;; Ensure the return value is a boolean.
+           (->bool authenticate?))))
+
       (define (perform-update)
         (let* ((timestamp (time-second (current-time time-utc)))
                (recent? (lambda (time)
@@ -762,7 +771,7 @@ concurrently; it sends derivation build requests to BUILDER."
                    (match (let ((reply (make-channel)))
                             (log-info "fetching channels for spec '~a'" name)
                             (put-message update-service
-                                         `(fetch ,channels ,reply))
+                                         `(fetch ,channels ,authenticate? ,reply))
                             (get-message reply))
                      (#f
                       ;; TODO: Send the error to CHANNEL so the web interface

base-commit: e1a4675ec417db3e7f97c05c3f2642ab8acb9210
-- 
2.46.0