This is an automated email from the git hooks/post-receive script.
civodul pushed a commit to branch main
in repository guix-cuirass.
The following commit(s) were added to refs/heads/main by this push:
new b3fbed9 forges: Handle exception for missing token file.
b3fbed9 is described below
commit b3fbed9d61e22faf76d9b42d4876ed2ac95aec4f
Author: Romain GARBAGE <romain.garb...@inria.fr>
AuthorDate: Thu Mar 27 16:23:35 2025 +0100
forges: Handle exception for missing token file.
* src/cuirass/forges.scm (forge-get-token): Handle exception for missing
token file.
* tests/forges.scm: Add test for missing token file.
Signed-off-by: Ludovic Courtès <l...@gnu.org>
---
src/cuirass/forges.scm | 60 ++++++++++++++++++++++++++++----------------------
tests/forges.scm | 6 ++++-
2 files changed, 39 insertions(+), 27 deletions(-)
diff --git a/src/cuirass/forges.scm b/src/cuirass/forges.scm
index 4cd0e7c..aeebbec 100644
--- a/src/cuirass/forges.scm
+++ b/src/cuirass/forges.scm
@@ -71,34 +71,42 @@ both strings. As an exemple, a token for a Git repository
located at
\"codeberg.org\" and NAMESPACE to \"owner/repo\"."
(log-debug "token lookup for server '~a' (namespace '~a')"
host-name namespace)
- (let* ((file-name (string-append (%forge-token-directory)
+
+ (define file-name (string-append (%forge-token-directory)
"/"
host-name))
- (token (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")))
- (unless token
- (log-error "no token found for ~a/~a"
- host-name namespace))
- token))
+
+ (catch 'system-error
+ (lambda ()
+ (let ((token (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")))
+ (unless token
+ (log-error "no token found for ~a/~a"
+ host-name namespace))
+ token))
+ (lambda args
+ (log-error "failed to open token file '~a': ~a"
+ file-name (strerror (system-error-errno args)))
+ #f)))
;; 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
diff --git a/tests/forges.scm b/tests/forges.scm
index 84b85f2..86556da 100644
--- a/tests/forges.scm
+++ b/tests/forges.scm
@@ -30,4 +30,8 @@
(test-equal "forge-get-token: undefined namespace"
#f
- (forge-get-token "host-name" "non-existing")))
+ (forge-get-token "host-name" "non-existing"))
+
+ (test-equal "forge-get-token: non-existing server file"
+ #f
+ (forge-get-token "non-existing" "namespace")))
