diff options
Diffstat (limited to 'gnu/services/cuirass.scm')
| -rw-r--r-- | gnu/services/cuirass.scm | 128 |
1 files changed, 115 insertions, 13 deletions
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 1cebbfcb6e..4d5e3a1041 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -22,11 +22,13 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services cuirass) + #:use-module (guix channels) #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix utils) #:use-module (gnu packages admin) #:use-module (gnu packages ci) + #:use-module (gnu packages databases) #:use-module (gnu packages version-control) #:use-module (gnu services) #:use-module (gnu services base) @@ -34,6 +36,8 @@ #:use-module (gnu services shepherd) #:use-module (gnu services admin) #:use-module (gnu system shadow) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) #:export (<cuirass-remote-server-configuration> cuirass-remote-server-configuration cuirass-remote-server-configuration? @@ -46,7 +50,17 @@ <cuirass-remote-worker-configuration> cuirass-remote-worker-configuration cuirass-remote-worker-configuration? - cuirass-remote-worker-service-type)) + cuirass-remote-worker-service-type + + <build-manifest> + build-manifest + build-manifest? + + <simple-cuirass-configuration> + simple-cuirass-configuration + simple-cuirass-configuration? + + simple-cuirass-configuration->specs)) ;;;; Commentary: ;;; @@ -93,6 +107,8 @@ (default "cuirass")) (interval cuirass-configuration-interval ;integer (seconds) (default 60)) + (parameters cuirass-configuration-parameters ;string + (default #f)) (remote-server cuirass-configuration-remote-server (default #f)) (database cuirass-configuration-database ;string @@ -109,8 +125,6 @@ (default #f)) (fallback? cuirass-configuration-fallback? ;boolean (default #f)) - (zabbix-uri cuirass-configuration-zabbix-uri ;string - (default #f)) (extra-options cuirass-configuration-extra-options (default '()))) @@ -123,6 +137,7 @@ (user (cuirass-configuration-user config)) (group (cuirass-configuration-group config)) (interval (cuirass-configuration-interval config)) + (parameters (cuirass-configuration-parameters config)) (remote-server (cuirass-configuration-remote-server config)) (database (cuirass-configuration-database config)) (port (cuirass-configuration-port config)) @@ -131,12 +146,11 @@ (use-substitutes? (cuirass-configuration-use-substitutes? config)) (one-shot? (cuirass-configuration-one-shot? config)) (fallback? (cuirass-configuration-fallback? config)) - (zabbix-uri (cuirass-configuration-zabbix-uri config)) (extra-options (cuirass-configuration-extra-options config))) `(,(shepherd-service (documentation "Run Cuirass.") (provision '(cuirass)) - (requirement '(guix-daemon postgres networking)) + (requirement '(guix-daemon postgres postgres-roles networking)) (start #~(make-forkexec-constructor (list (string-append #$cuirass "/bin/cuirass") "--cache-directory" #$cache-directory @@ -144,6 +158,11 @@ #$(scheme-file "cuirass-specs.scm" specs) "--database" #$database "--interval" #$(number->string interval) + #$@(if parameters + (list (string-append + "--parameters=" + parameters)) + '()) #$@(if remote-server '("--build-remote") '()) #$@(if use-substitutes? '("--use-substitutes") '()) #$@(if one-shot? '("--one-shot") '()) @@ -162,7 +181,7 @@ ,(shepherd-service (documentation "Run Cuirass web interface.") (provision '(cuirass-web)) - (requirement '(guix-daemon postgres networking)) + (requirement '(cuirass)) (start #~(make-forkexec-constructor (list (string-append #$cuirass "/bin/cuirass") "--cache-directory" #$cache-directory @@ -171,13 +190,13 @@ "--port" #$(number->string port) "--listen" #$host "--interval" #$(number->string interval) - #$@(if use-substitutes? '("--use-substitutes") '()) - #$@(if fallback? '("--fallback") '()) - #$@(if zabbix-uri + #$@(if parameters (list (string-append - "--zabbix-uri=" - zabbix-uri)) + "--parameters=" + parameters)) '()) + #$@(if use-substitutes? '("--use-substitutes") '()) + #$@(if fallback? '("--fallback") '()) #$@extra-options) #:user #$user @@ -192,7 +211,7 @@ (shepherd-service (documentation "Run Cuirass remote build server.") (provision '(cuirass-remote-server)) - (requirement '(avahi-daemon cuirass guix-daemon networking)) + (requirement '(avahi-daemon cuirass)) (start #~(make-forkexec-constructor (list (string-append #$cuirass "/bin/remote-server") (string-append "--database=" #$database) @@ -208,6 +227,11 @@ "--publish-port=" (number->string publish-port))) '()) + #$@(if parameters + (list (string-append + "--parameters=" + parameters)) + '()) #$@(if trigger-url (list (string-append @@ -299,6 +323,8 @@ (service-extension activation-service-type cuirass-activation) (service-extension shepherd-root-service-type cuirass-shepherd-service) (service-extension account-service-type cuirass-account) + ;; Make sure postgresql and postgresql-role are instantiated. + (service-extension postgresql-service-type (const #t)) (service-extension postgresql-role-service-type cuirass-postgresql-role))) (description @@ -311,6 +337,8 @@ (default cuirass)) (workers cuirass-remote-worker-workers ;int (default 1)) + (server cuirass-remote-worker-server ;string + (default #f)) (systems cuirass-remote-worker-systems ;list (default (list (%current-system)))) (log-file cuirass-remote-worker-log-file ;string @@ -326,7 +354,8 @@ "Return a <shepherd-service> for the Cuirass remote worker service with CONFIG." (match-record config <cuirass-remote-worker-configuration> - (cuirass workers systems log-file publish-port public-key private-key) + (cuirass workers server systems log-file publish-port + public-key private-key) (list (shepherd-service (documentation "Run Cuirass remote build worker.") (provision '(cuirass-remote-worker)) @@ -335,6 +364,9 @@ CONFIG." (list (string-append #$cuirass "/bin/remote-worker") (string-append "--workers=" #$(number->string workers)) + #$@(if server + (list (string-append "--server=" server)) + '()) #$@(if systems (list (string-append "--systems=" @@ -367,3 +399,73 @@ CONFIG." cuirass-remote-worker-shepherd-service))) (description "Run the Cuirass remote build worker service."))) + +(define-record-type* <build-manifest> + build-manifest make-build-manifest + build-manifest? + (channel-name build-manifest-channel-name) ;symbol + (manifest build-manifest-manifest)) ;string + +(define-record-type* <simple-cuirass-configuration> + simple-cuirass-configuration make-simple-cuirass-configuration + simple-cuirass-configuration? + (build simple-cuirass-configuration-build + (default 'all)) ;symbol or list of <build-manifest> + (channels simple-cuirass-configuration-channels + (default %default-channels)) ;list of <channel> + (non-package-channels simple-cuirass-configuration-package-channels + (default '())) ;list of channels name + (systems simple-cuirass-configuration-systems + (default (list (%current-system))))) ;list of strings + +(define* (simple-cuirass-configuration->specs config) + (define (format-name name) + (if (string? name) + name + (symbol->string name))) + + (define (format-manifests build-manifests) + (map (lambda (build-manifest) + (match-record build-manifest <build-manifest> + (channel-name manifest) + (cons (format-name channel-name) manifest))) + build-manifests)) + + (define (channel->input channel) + (let ((name (channel-name channel)) + (url (channel-url channel)) + (branch (channel-branch channel))) + `((#:name . ,(format-name name)) + (#:url . ,url) + (#:load-path . ".") + (#:branch . ,branch) + (#:no-compile? #t)))) + + (define (package-path channels non-package-channels) + (filter-map (lambda (channel) + (let ((name (channel-name channel))) + (and (not (member name non-package-channels)) + (not (eq? name 'guix)) + (format-name name)))) + channels)) + + (define (config->spec config) + (match-record config <simple-cuirass-configuration> + (build channels non-package-channels systems) + `((#:name . "simple-config") + (#:load-path-inputs . ("guix")) + (#:package-path-inputs . ,(package-path channels + non-package-channels)) + (#:proc-input . "guix") + (#:proc-file . "build-aux/cuirass/gnu-system.scm") + (#:proc . cuirass-jobs) + (#:proc-args . ((systems . ,systems) + ,@(if (eq? build 'all) + '() + `((subset . "manifests") + (manifests . ,(format-manifests build)))))) + (#:inputs . ,(map channel->input channels)) + (#:build-outputs . ()) + (#:priority . 1)))) + + #~(list '#$(config->spec config))) |