Subject: [bug#76938] [PATCH Cuirass 02/13] forges: Add support for token storage.

From: Romain GARBAGE <[email-masked]>
Date: Tue, 11 Mar 2025 11:34:27 +0100

* src/cuirass/forges.scm (%forge-token-directory, forge-get-token): New variables.
---
 src/cuirass/forges.scm | 47 ++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 45 insertions(+), 2 deletions(-)

diff --git a/src/cuirass/forges.scm b/src/cuirass/forges.scm
index 540315b..3f6a818 100644
--- a/src/cuirass/forges.scm
+++ b/src/cuirass/forges.scm
@@ -1,5 +1,5 @@
 ;;; forges.scm -- Common forges utilities
-;;; Copyright © 2024 Romain Garbage <[email-masked]>
+;;; Copyright © 2024-2025 Romain Garbage <[email-masked]>
 ;;;
 ;;; This file is part of Cuirass.
 ;;;
@@ -18,9 +18,12 @@
 
 (define-module (cuirass forges)
   #:use-module ((guix utils) #:select (%current-system))
+  #:use-module (cuirass config)
   #:use-module (cuirass specification)
+  #:use-module (cuirass logging)
   #:use-module (json)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
   #:export (%default-jobset-options-period
             %default-jobset-options-priority
             %default-jobset-options-systems
@@ -32,7 +35,10 @@
             jobset-options-build
             jobset-options-period
             jobset-options-priority
-            jobset-options-systems))
+            jobset-options-systems
+
+            forge-get-token
+            %forge-token-directory))
 
 ;;; Commentary:
 ;;;
@@ -51,6 +57,43 @@
 (define %default-jobset-options-systems
   (list (%current-system)))
 
+;; Path to the base directory containing the tokens. Each file inside that
+;; directory should be named after the host-name of the forge and should
+;; contain one token definition per line. A token definition consists of a
+;; namespace (e.g org/project) and a token.
+(define %forge-token-directory
+  (make-parameter (in-vicinity %sysconfdir "cuirass/forge-tokens")))
+
+(define (forge-get-token host-name namespace)
+  "Return a token as a string for the requested couple HOST-NAME and NAMESPACE,
+both strings. As an exemple, a token for a Git repository located at
+\"https://codeberg.org/owner/repo\" could be retrieved by setting HOST-NAME to
+\"codeberg.org\" and NAMESPACE to \"owner/repo\"."
+  (let ((file-name (string-append (%forge-token-directory)
+                                  "/"
+                                  host-name)))
+    (call-with-input-file file-name
+      (lambda (port)
+        (let loop ()
+          (match (read-line port)
+            ((? eof-object?) #f)
+            (str
+             (let ((str (string-trim-both str)))
+               (if (or (string-null? str)
+                       (string-prefix? "#" str))
+                   (loop)
+                   (match (string-tokenize str)
+                     (`(,ns ,token)
+                      (if (string=? ns namespace)
+                          token
+                          (loop)))
+                     (_
+                      (log-warning "Malformed line ~a in file ~a.~%"
+                                   (port-line port)
+                                   file-name)
+                      (loop)))))))))
+      #:encoding "utf-8")))
+
 ;; This mapping defines a specific JSON dictionary used for tweaking Cuirass
 ;; options. It is not included in the JSON data sent by default by Gitlab and
 ;; must be used through the custom template mechanism (see documentation).
-- 
2.48.1