diff --git a/Makefile.am b/Makefile.am
index 0a22eae8f810bdc1bf7bb9785b898fbc7a64b695..8d071cb8446864f06db66e8150ac8faea5fc3981 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -57,6 +57,7 @@ dist_pkgmodule_DATA = \
src/cuirass/mastodon.scm \
src/cuirass/metrics.scm \
src/cuirass/notification.scm \
+ src/cuirass/parameters.scm \
src/cuirass/remote.scm \
src/cuirass/remote-server.scm \
src/cuirass/remote-worker.scm \
diff --git a/bin/cuirass.in b/bin/cuirass.in
index e5b7ff9126cfdd4e06088b25d8a9be6b5d7ce764..8dbb14f4a9ddac1b105d8152b592b8e449df4f23 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -53,6 +53,8 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
--fallback Fall back to building when the substituter fails.
-S --specifications=SPECFILE
Add specifications from SPECFILE to database.
+ -P --parameters=PARAMFILE
+ Read parameters for PARAMFILE.
-D --database=DB Use DB to store build results.
--ttl=DURATION Keep build results live for at least DURATION.
--web Start the web interface
@@ -63,7 +65,6 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
--use-substitutes Allow usage of pre-built substitutes
--record-events Record events for distribution
--threads=N Use up to N kernel threads
- -z, --zabbix-uri=URI Use Zabbix server at URI
-V, --version Display version
-h, --help Display this help message")
(newline)
@@ -74,6 +75,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(web (value #f))
(cache-directory (value #t))
(specifications (single-char #\S) (value #t))
+ (parameters (single-char #\P) (value #t))
(database (single-char #\D) (value #t))
(port (single-char #\p) (value #t))
(listen (value #t))
@@ -81,7 +83,6 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(build-remote (value #f))
(use-substitutes (value #f))
(threads (value #t))
- (zabbix-uri (single-char #\z) (value #t))
(fallback (value #f))
(record-events (value #f))
(ttl (value #t))
@@ -110,7 +111,6 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(%package-cachedir
(option-ref opts 'cache-directory (%package-cachedir)))
(%build-remote? (option-ref opts 'build-remote #f))
- (%zabbix-uri (option-ref opts 'zabbix-uri #f))
(%use-substitutes? (option-ref opts 'use-substitutes #f))
(%fallback? (option-ref opts 'fallback #f))
(%record-events? (option-ref opts 'record-events #f))
@@ -132,6 +132,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(host (option-ref opts 'listen "localhost"))
(interval (string->number (option-ref opts 'interval "300")))
(specfile (option-ref opts 'specifications #f))
+ (paramfile (option-ref opts 'parameters #f))
;; Since our work is mostly I/O-bound, default to a maximum of 4
;; kernel threads. Going beyond that can increase overhead (GC
@@ -155,6 +156,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(primitive-load specfile)))))
(for-each db-add-specification new-specs)))
+ (and paramfile (read-parameters paramfile))
(if one-shot?
(process-specs (db-get-specifications))
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index d74a807108dfba78bf69c5edfd81749269228568..8528409d88ac77c5102e59c18679e09923d55c2b 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -32,6 +32,7 @@
#:use-module (guix build utils)
#:use-module (guix derivations)
#:use-module (guix store)
+ #:use-module (guix ui)
#:use-module (guix git)
#:use-module (guix cache)
#:use-module (zlib)
@@ -60,6 +61,7 @@
#:use-module (rnrs bytevectors)
#:export (;; Procedures.
call-with-time-display
+ read-parameters
fetch-input
fetch-inputs
compile
@@ -376,6 +378,15 @@ Return a list of jobs that are associated to EVAL-ID."
(log-message "evaluation ~a for '~a' completed" eval-id spec-name)
jobs)))))
+
+;;;
+;;; Read parameters.
+;;;
+
+(define (read-parameters file)
+ (let ((modules (make-user-module '((cuirass parameters)))))
+ (load* file modules)))
+
;;;
;;; Build status.
diff --git a/src/cuirass/notification.scm b/src/cuirass/notification.scm
index 358005ef6fa0d1449115eb7285a599c37243e889..262b90dc5c56ade00c4f873a1fcc5f1f29ce059d 100644
--- a/src/cuirass/notification.scm
+++ b/src/cuirass/notification.scm
@@ -17,10 +17,10 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (cuirass notification)
- #:use-module (cuirass database)
#:use-module (cuirass logging)
#:use-module (cuirass mail)
#:use-module (cuirass mastodon)
+ #:use-module (cuirass parameters)
#:use-module (cuirass utils)
#:export (notification-type
notification-event
@@ -72,6 +72,12 @@ interfering with fibers."
((= weather weather-failure)
"broken"))))
+(define (build-details-url build)
+ "Return the build details URL for BUILD."
+ (let ((id (assq-ref build #:id))
+ (url (or (%cuirass-url) "")))
+ (string-append url "/build/" (number->string id) "/details")))
+
(define (notification-subject notification)
"Return the subject for the given NOTIFICATION."
(let* ((build (assq-ref notification #:build))
@@ -84,14 +90,13 @@ interfering with fibers."
(define (notification-text notification)
"Return the text for the given NOTIFICATION."
(let* ((build (assq-ref notification #:build))
- (id (assq-ref build #:id))
+ (url (build-details-url build))
(job-name (assq-ref build #:job-name))
(specification (assq-ref build #:specification))
(weather-text (build-weather-text build)))
(format #f "The build ~a for specification ~a is ~a. You can find
the detailed information about this build here: ~a."
- job-name specification weather-text
- (string-append "build/" (number->string id) "/details"))))
+ job-name specification weather-text url)))
(define (notification-email notification)
"Send an email for the given NOTIFICATION."
diff --git a/src/cuirass/parameters.scm b/src/cuirass/parameters.scm
new file mode 100644
index 0000000000000000000000000000000000000000..e9be8a37c3b58790fc4a65f2ec1d81dba3cba726
--- /dev/null
+++ b/src/cuirass/parameters.scm
@@ -0,0 +1,41 @@
+;;; parameters.scm -- Cuirass parameters.
+;;; Copyright 漏 2021 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; This file is part of Cuirass.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (cuirass parameters)
+ #:export (%cuirass-url
+ %zabbix-url
+ %zabbix-user
+ %zabbix-password))
+
+;; The URL of the Cuirass web server. This is useful to send absolute links
+;; within notifications.
+(define %cuirass-url
+ (make-parameter #f))
+
+;; The URL of the Zabbix monitoring server providing the workers status,
+;; if supported.
+(define %zabbix-url
+ (make-parameter #f))
+
+ ;; The user for Zabbix API authentication.
+(define %zabbix-user
+ (make-parameter "Admin"))
+
+;; The password for Zabbix API authentication.
+(define %zabbix-password
+ (make-parameter "zabbix"))
diff --git a/src/cuirass/remote-server.scm b/src/cuirass/remote-server.scm
index 404ed0218271e53840e079d2cd999aa83c11c4f3..5850e0c3f4ecdb805bdcbda2a317a0718fc6a2b6 100644
--- a/src/cuirass/remote-server.scm
+++ b/src/cuirass/remote-server.scm
@@ -97,6 +97,8 @@ Start a remote build server.\n"))
(display (G_ "
-p, --publish-port=PORT publish substitutes on PORT"))
(display (G_ "
+ -P, --parameters=FILE Read parameters from FILE"))
+ (display (G_ "
-D, --database=DB Use DB to read and store build results"))
(display (G_ "
-c, --cache=DIRECTORY cache built items to DIRECTORY"))
@@ -134,6 +136,9 @@ Start a remote build server.\n"))
(option '(#\p "publish-port") #t #f
(lambda (opt name arg result)
(alist-cons 'publish-port (string->number* arg) result)))
+ (option '(#\P "parameters") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'parameters arg result)))
(option '(#\D "database") #t #f
(lambda (opt name arg result)
(alist-cons 'database arg result)))
@@ -438,6 +443,7 @@ exiting."
(log-port (assoc-ref opts 'log-port))
(publish-port (assoc-ref opts 'publish-port))
(cache (assoc-ref opts 'cache))
+ (parameters (assoc-ref opts 'parameters))
(database (assoc-ref opts 'database))
(trigger-substitute-url (assoc-ref opts 'trigger-substitute-url))
(user (assoc-ref opts 'user))
@@ -458,6 +464,9 @@ exiting."
(when user
(gather-user-privileges user))
+ (and parameters
+ (read-parameters parameters))
+
(atomic-box-set!
%publish-pid
(publish-server publish-port
diff --git a/src/cuirass/rss.scm b/src/cuirass/rss.scm
index 20fa7ba371233b6709a0f10c359635f8ca7aa1ec..1be3d37c3fb06a7e1f57642440df98679faa2c09 100644
--- a/src/cuirass/rss.scm
+++ b/src/cuirass/rss.scm
@@ -18,6 +18,7 @@
(define-module (cuirass rss)
#:use-module (cuirass database)
+ #:use-module (cuirass parameters)
#:use-module (cuirass utils)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
@@ -127,9 +128,15 @@ list ATTRS and the child nodes in BODY."
(lambda (port)
(sxml->html sxml port))))
+(define (build-details-url build)
+ "Return the build details URL for BUILD."
+ (let ((id (assq-ref build #:id))
+ (url (or (%cuirass-url) "")))
+ (string-append url "/build/" (number->string id) "/details")))
+
(define* (build->rss-item build)
"Convert BUILD into an RSS <item> node."
- (let* ((id (assq-ref build #:id))
+ (let* ((url (build-details-url build))
(job-name (assq-ref build #:job-name))
(specification (assq-ref build #:specification))
(weather (assq-ref build #:weather))
@@ -147,19 +154,17 @@ list ATTRS and the child nodes in BODY."
(pubDate ,(date->rfc822-str
(time-utc->date
(make-time time-utc 0 stoptime))))
- (link "../../build/" ,id "/details")
+ (link ,url)
(description
,(sxml->html-string
`(p "The build " (b ,job-name) " for specification "
(b ,specification) " is " ,weather-text ".
You can find the detailed information about this build "
- (a (@ (href ,(string-append "../../build/"
- (number->string id)
- "/details")))
+ (a (@ (href ,url))
"here")
"."))))))
-(define* (rss-feed builds #:key base-url params)
+(define* (rss-feed builds #:key params)
(let ((specification (and params
(assq-ref params 'specification))))
`(rss (@ (version "2.0"))
diff --git a/src/cuirass/zabbix.scm b/src/cuirass/zabbix.scm
index adc51cb1a43fc6e8e6d797da0db347faea36399e..90c7665f05a32dc58e586bb1b130345ccf0536a0 100644
--- a/src/cuirass/zabbix.scm
+++ b/src/cuirass/zabbix.scm
@@ -17,6 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (cuirass zabbix)
+ #:use-module (cuirass parameters)
#:use-module (guix import json)
#:use-module (web uri)
#:use-module (web client)
@@ -40,24 +41,12 @@
(define %zabbix-auth
(make-parameter #f))
-(define %zabbix-uri
- (make-parameter
- (getenv "CUIRASS_ZABBIX_URI")))
-
-(define %zabbix-user
- (make-parameter
- (or (getenv "CUIRASS_ZABBIX_USER") "Admin")))
-
-(define %zabbix-password
- (make-parameter
- (or (getenv "CUIRASS_ZABBIX_PASSWORD") "zabbix")))
-
(define* (zabbix-request params)
(let ((headers `((User-Agent . "Cuirass")
(Accept . "application/json")
(Content-Type . "application/json"))))
(let-values (((response port)
- (http-post (%zabbix-uri)
+ (http-post (%zabbix-url)
#:headers headers
#:body (string->utf8
(scm->json-string params))
@@ -98,9 +87,11 @@
(string? (zabbix-api-version))))
(define (zabbix-login)
- (let* ((params (zabbix-params "user.login"
- `(("user" . ,(%zabbix-user))
- ("password" . ,(%zabbix-password)))))
+ (let* ((user (%zabbix-user))
+ (password (%zabbix-password))
+ (params (zabbix-params "user.login"
+ `(("user" . ,user)
+ ("password" . ,password))))
(result (zabbix-request params)))
(%zabbix-auth result)
result))