(address . guix-patches@gnu.org)
20250106145937.17780-1-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(-)
Toggle diff (77 lines)
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