From e31f17c66a0ec6205f2b58cdc2f8da9f48449286 Mon Sep 17 00:00:00 2001 From: Jean-Francois GUILLAUME Date: Mon, 26 Jun 2023 15:00:31 +0000 Subject: [PATCH] Upgrade cuirasse service --- glicid/services/cuirass.scm | 282 +++++++++++++----------------------- 1 file changed, 102 insertions(+), 180 deletions(-) diff --git a/glicid/services/cuirass.scm b/glicid/services/cuirass.scm index f2a22ec..c7ed21d 100644 --- a/glicid/services/cuirass.scm +++ b/glicid/services/cuirass.scm @@ -18,81 +18,47 @@ #:use-module (ice-9 match) #:export (cuirass-remote-server-configuration cuirass-remote-server-configuration? - cuirass-configuration cuirass-configuration? cuirass-service-type - cuirass-remote-worker-configuration cuirass-remote-worker-configuration? cuirass-remote-worker-service-type)) -(define %cuirass-default-database - "dbname=cuirass") -(define-record-type* - cuirass-remote-server-configuration make-cuirass-remote-server-configuration - cuirass-remote-server-configuration? - (backend-port cuirass-remote-server-configuration-backend-port ;int - (default 5555)) - (log-port cuirass-remote-server-configuration-log-port ;int - (default 5556)) - (publish-port cuirass-remote-server-configuration-publish-port ;int - (default 5557)) - (log-file cuirass-remote-server-log-file ;string - (default "/var/log/cuirass-remote-server.log")) - (cache cuirass-remote-server-configuration-cache ;string - (default "/var/cache/cuirass/remote/")) - (publish? cuirass-remote-server-configuration-publish? ;boolean - (default #t)) - (trigger-url cuirass-remote-server-trigger-url ;string - (default #f)) - (public-key cuirass-remote-server-configuration-public-key ;string - (default #f)) - (private-key cuirass-remote-server-configuration-private-key ;string - (default #f))) +(define %cuirass-default-database "dbname=cuirass") -(define-record-type* - cuirass-configuration make-cuirass-configuration - cuirass-configuration? - (cuirass cuirass-configuration-cuirass ;file-like - (default cuirass)) - (log-file cuirass-configuration-log-file ;string - (default "/var/log/cuirass.log")) - (web-log-file cuirass-configuration-web-log-file ;string - (default "/var/log/cuirass-web.log")) - (cache-directory cuirass-configuration-cache-directory ;string (dir-name) - (default "/var/cache/cuirass")) - (user cuirass-configuration-user ;string - (default "cuirass")) - (group cuirass-configuration-group ;string - (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 - (default %cuirass-default-database)) - (port cuirass-configuration-port ;integer (port) - (default 8081)) - (host cuirass-configuration-host ;string - (default "localhost")) - (specifications cuirass-configuration-specifications) - ;gexp that evaluates to specification-alist - (use-substitutes? cuirass-configuration-use-substitutes? ;boolean - (default #f)) - (one-shot? cuirass-configuration-one-shot? ;boolean - (default #f)) - (fallback? cuirass-configuration-fallback? ;boolean - (default #f)) - (extra-options cuirass-configuration-extra-options - (default '())) - (http-proxy cuirass-configuration-http-proxy ;string - (default "")) - (https-proxy cuirass-configuration-https-proxy ;string - (default ""))) +(define-record-type* cuirass-remote-server-configuration make-cuirass-remote-server-configuration cuirass-remote-server-configuration? + (backend-port cuirass-remote-server-configuration-backend-port (default 5555)) + (log-port cuirass-remote-server-configuration-log-port (default 5556)) + (publish-port cuirass-remote-server-configuration-publish-port (default 5557)) + (log-file cuirass-remote-server-log-file (default "/var/log/cuirass-remote-server.log")) + (cache cuirass-remote-server-configuration-cache (default "/var/cache/cuirass/remote/")) + (publish? cuirass-remote-server-configuration-publish? (default #t)) + (trigger-url cuirass-remote-server-trigger-url (default #f)) + (public-key cuirass-remote-server-configuration-public-key (default #f)) + (private-key cuirass-remote-server-configuration-private-key (default #f))) + +(define-record-type* cuirass-configuration make-cuirass-configuration cuirass-configuration? + (cuirass cuirass-configuration-cuirass (default cuirass)) + (log-file cuirass-configuration-log-file (default "/var/log/cuirass.log")) + (web-log-file cuirass-configuration-web-log-file (default "/var/log/cuirass-web.log")) + (cache-directory cuirass-configuration-cache-directory (default "/var/cache/cuirass")) + (user cuirass-configuration-user (default "cuirass")) + (group cuirass-configuration-group (default "cuirass")) + (interval cuirass-configuration-interval (default 60)) + (parameters cuirass-configuration-parameters (default #f)) + (remote-server cuirass-configuration-remote-server (default #f)) + (database cuirass-configuration-database (default %cuirass-default-database)) + (port cuirass-configuration-port (default 8081)) + (host cuirass-configuration-host (default "localhost")) + (specifications cuirass-configuration-specifications) + (use-substitutes? cuirass-configuration-use-substitutes? (default #f)) + (one-shot? cuirass-configuration-one-shot? (default #f)) + (fallback? cuirass-configuration-fallback? (default #f)) + (extra-options cuirass-configuration-extra-options (default '())) + (http-proxy cuirass-configuration-http-proxy (default "")) + (https-proxy cuirass-configuration-https-proxy (default ""))) (define (cuirass-shepherd-service config) "Return a for the Cuirass service with CONFIG." @@ -114,7 +80,8 @@ (fallback? (cuirass-configuration-fallback? config)) (extra-options (cuirass-configuration-extra-options config)) (http-proxy (cuirass-configuration-http-proxy config)) - (https-proxy (cuirass-configuration-https-proxy config))) + (https-proxy (cuirass-configuration-https-proxy config)) + ) `(,(shepherd-service (documentation "Run Cuirass.") (provision '(cuirass)) @@ -128,22 +95,17 @@ "--database" #$database "--interval" #$(number->string interval) #$@(if parameters - (list (string-append - "--parameters=" - parameters)) + (list (string-append "--parameters=" parameters)) '()) #$@(if remote-server '("--build-remote") '()) #$@(if use-substitutes? '("--use-substitutes") '()) #$@(if one-shot? '("--one-shot") '()) #$@(if fallback? '("--fallback") '()) #$@extra-options) - - #:environment-variables - (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" - (string-append "GIT_EXEC_PATH=" #$git "/libexec/git-core") - (string-append "http_proxy=" #$http-proxy) - (string-append "https_proxy=" #$http-proxy)) - + #:environment-variables (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" + (string-append "GIT_EXEC_PATH=" #$git "/libexec/git-core") + (string-append "http_proxy=" #$http-proxy) + (string-append "https_proxy=" #$http-proxy)) #:user #$user #:group #$group #:log-file #$main-log-file)) @@ -159,20 +121,15 @@ "--listen" #$host "--port" #$(number->string port) #$@(if parameters - (list (string-append - "--parameters=" - parameters)) + (list (string-append "--parameters=" parameters)) '()) #$@extra-options) - #:user #$user #:group #$group #:log-file #$web-log-file)) (stop #~(make-kill-destructor))) ,@(if remote-server - (match-record remote-server - (backend-port publish-port log-file cache publish? - trigger-url public-key private-key) + (match-record remote-server (backend-port publish-port log-file cache publish? trigger-url public-key private-key) (list (shepherd-service (documentation "Run Cuirass remote build server.") @@ -185,44 +142,30 @@ (string-append "--cache=" #$cache) (string-append "--user=" #$user) #$@(if backend-port - (list (string-append - "--backend-port=" - (number->string backend-port))) + (list (string-append "--backend-port=" (number->string backend-port))) '()) #$@(if publish-port - (list (string-append - "--publish-port=" - (number->string publish-port))) + (list (string-append "--publish-port=" (number->string publish-port))) '()) #$@(if parameters - (list (string-append - "--parameters=" - parameters)) + (list (string-append "--parameters=" parameters)) '()) #$@(if trigger-url - (list - (string-append - "--trigger-substitute-url=" - trigger-url)) + (list (string-append "--trigger-substitute-url=" trigger-url)) '()) #$@(if publish? '() (list "--no-publish")) #$@(if public-key - (list - (string-append "--public-key=" - public-key)) + (list (string-append "--public-key=" public-key)) '()) #$@(if private-key - (list - (string-append "--private-key=" - private-key)) + (list (string-append "--private-key=" private-key)) '())) - #:environment-variables - (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" - (string-append "GIT_EXEC_PATH=" #$git "/libexec/git-core") - (string-append "http_proxy=" #$http-proxy) - (string-append "https_proxy=" #$http-proxy)) + #:environment-variables (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" + (string-append "GIT_EXEC_PATH=" #$git "/libexec/git-core") + (string-append "http_proxy=" #$http-proxy) + (string-append "https_proxy=" #$http-proxy)) #:log-file #$log-file)) (stop #~(make-kill-destructor))))) '())))) @@ -252,9 +195,7 @@ "Return the activation code for CONFIG." (let* ((cache (cuirass-configuration-cache-directory config)) (remote-server (cuirass-configuration-remote-server config)) - (remote-cache (and remote-server - (cuirass-remote-server-configuration-cache - remote-server))) + (remote-cache (and remote-server (cuirass-remote-server-configuration-cache remote-server))) (user (cuirass-configuration-user config)) (log "/var/log/cuirass") (profile (string-append "/var/guix/profiles/per-user/" user)) @@ -263,79 +204,67 @@ (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils)) - (mkdir-p #$cache) (mkdir-p #$log) (mkdir-p #$roots) - (when #$remote-cache (mkdir-p #$remote-cache)) - (let ((uid (passwd:uid (getpw #$user))) (gid (group:gid (getgr #$group)))) (chown #$cache uid gid) (chown #$log uid gid) (chown #$roots uid gid) (chown #$profile uid gid) - (when #$remote-cache (chown #$remote-cache uid gid))))))) (define (cuirass-log-rotations config) "Return the list of log rotations that corresponds to CONFIG." (list (log-rotation - (files (list (cuirass-configuration-log-file config) - (cuirass-configuration-web-log-file config))) + (files (append (list (cuirass-configuration-log-file config) + (cuirass-configuration-web-log-file config)) + (let ((server + (cuirass-configuration-remote-server config))) + (if server + (list (cuirass-remote-server-log-file server)) + '())))) (frequency 'weekly) - (options `("rotate 40" ;worth keeping - ,@%default-log-rotation-options))))) + (options `("rotate 40" ,@%default-log-rotation-options))))) (define cuirass-service-type (service-type (name 'cuirass) (extensions (list - (service-extension profile-service-type ;for 'info cuirass' - (compose list cuirass-configuration-cuirass)) + (service-extension profile-service-type (compose list cuirass-configuration-cuirass)) (service-extension rottlog-service-type cuirass-log-rotations) (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 - "Run the Cuirass continuous integration service."))) + ; we don't need the following as we use a remote database + ;(service-extension postgresql-service-type (const #t)) + ;(service-extension postgresql-role-service-type cuirass-postgresql-role) + )) + (description "Run the Cuirass continuous integration service."))) -(define-record-type* - cuirass-remote-worker-configuration make-cuirass-remote-worker-configuration - cuirass-remote-worker-configuration? - (cuirass cuirass-remote-worker-configuration-cuirass ;file-like - (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 - (default "/var/log/cuirass-remote-worker.log")) - (publish-port cuirass-remote-worker-configuration-publish-port ;int - (default 5558)) - (substitute-urls cuirass-remote-worker-configuration-substitute-urls - (default %default-substitute-urls)) ;list of strings - (public-key cuirass-remote-worker-configuration-public-key ;string - (default #f)) - (private-key cuirass-remote-worker-configuration-private-key ;string - (default #f))) + +(define-record-type* cuirass-remote-worker-configuration make-cuirass-remote-worker-configuration cuirass-remote-worker-configuration? + (cuirass cuirass-remote-worker-configuration-cuirass (default cuirass)) + (workers cuirass-remote-worker-workers (default 1)) + (server cuirass-remote-worker-server (default #f)) + (systems cuirass-remote-worker-systems (default (list (%current-system)))) + (log-file cuirass-remote-worker-log-file (default "/var/log/cuirass-remote-worker.log")) + (publish-port cuirass-remote-worker-configuration-publish-port (default 5558)) + (substitute-urls cuirass-remote-worker-configuration-substitute-urls (default %default-substitute-urls)) + (public-key cuirass-remote-worker-configuration-public-key (default #f)) + (private-key cuirass-remote-worker-configuration-private-key (default #f)) + (http-proxy cuirass-configuration-http-proxy (default "")) + (https-proxy cuirass-configuration-https-proxy (default "")) + ) (define (cuirass-remote-worker-shepherd-service config) - "Return a for the Cuirass remote worker service with - CONFIG." - (match-record config - (cuirass workers server systems log-file publish-port - substitute-urls public-key private-key) + "Return a for the Cuirass remote worker service with CONFIG." + (match-record config (cuirass workers server systems log-file publish-port substitute-urls public-key private-key http-proxy https-proxy) (list (shepherd-service (documentation "Run Cuirass remote build worker.") (provision '(cuirass-remote-worker)) @@ -343,50 +272,43 @@ (start #~(make-forkexec-constructor (list (string-append #$cuirass "/bin/cuirass") "remote-worker" - (string-append "--workers=" - #$(number->string workers)) + (string-append "--workers=" #$(number->string workers)) #$@(if server (list (string-append "--server=" server)) '()) #$@(if systems - (list (string-append - "--systems=" - (string-join systems ","))) + (list (string-append "--systems=" (string-join systems ","))) '()) #$@(if publish-port - (list (string-append - "--publish-port=" - (number->string publish-port))) + (list (string-append "--publish-port=" (number->string publish-port))) '()) #$@(if substitute-urls - (list (string-append - "--substitute-urls=" - (string-join substitute-urls))) + (list (string-append "--substitute-urls=" (string-join substitute-urls))) '()) #$@(if public-key - (list - (string-append "--public-key=" - public-key)) + (list (string-append "--public-key=" public-key)) '()) #$@(if private-key - (list - (string-append "--private-key=" - private-key)) + (list (string-append "--private-key=" private-key)) '())) - #:environment-variables - (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" - (string-append "GIT_EXEC_PATH=" #$git "/libexec/git-core") - (string-append "http_proxy=" #$http-proxy) - (string-append "https_proxy=" #$http-proxy)) + #:environment-variables (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" + (string-append "GIT_EXEC_PATH=" #$git "/libexec/git-core") + (string-append "http_proxy=" #$http-proxy) + (string-append "https_proxy=" #$http-proxy)) #:log-file #$log-file)) (stop #~(make-kill-destructor)))))) +(define (cuirass-remote-worker-log-rotations config) + "Return the list of log rotations that corresponds to CONFIG." + (list (log-rotation + (files (list (cuirass-remote-worker-log-file config))) + (frequency 'weekly) + (options `("rotate 4" ,@%default-log-rotation-options))))) + (define cuirass-remote-worker-service-type (service-type (name 'cuirass-remote-worker) (extensions - (list - (service-extension shepherd-root-service-type - cuirass-remote-worker-shepherd-service))) - (description - "Run the Cuirass remote build worker service."))) + (list (service-extension shepherd-root-service-type cuirass-remote-worker-shepherd-service) + (service-extension rottlog-service-type cuirass-remote-worker-log-rotations))) + (description "Run the Cuirass remote build worker service.")))