diff options
Diffstat (limited to 'guix/forge')
| -rw-r--r-- | guix/forge/forge.scm | 61 |
1 files changed, 59 insertions, 2 deletions
diff --git a/guix/forge/forge.scm b/guix/forge/forge.scm index f7b60d7..d60298f 100644 --- a/guix/forge/forge.scm +++ b/guix/forge/forge.scm @@ -26,6 +26,7 @@ #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) #:use-module ((gnu packages guile) #:select (guile-3.0 guile-bytestructures guile-zlib)) #:use-module ((gnu packages guile-xyz) #:select (guile-lib)) + #:use-module ((gnu packages mail) #:select (msmtp)) #:use-module ((gnu packages nss) #:select (nss-certs)) #:use-module ((gnu packages package-management) #:select (guix)) #:use-module ((gnu packages version-control) #:select (git-minimal)) @@ -54,6 +55,7 @@ forge-configuration-tissue-web-domain forge-configuration-websites-directory forge-configuration-web-root + forge-configuration-mailer-address forge-configuration-projects forge-project forge-project? @@ -67,6 +69,7 @@ forge-project-website-ci-job forge-project-ci-jobs forge-project-ci-jobs-trigger + forge-project-ci-notify-addresses forge-project-parallel-ci-job-runs derivation-job-gexp variable-specification @@ -106,6 +109,8 @@ ;; 'cron for remote repositories (else 'cron))) (thunked)) + (ci-notify-addresses forge-project-ci-notify-addresses + (default '())) (parallel-ci-job-runs forge-project-parallel-ci-job-runs (default 1))) @@ -122,6 +127,10 @@ (default (computed-file "forge-web-root" (forge-web-root-gexp this-forge-configuration))) (thunked)) + (mailer-address forge-configuration-mailer-address + (default (string-append "mail@" + (forge-configuration-web-domain this-forge-configuration))) + (thunked)) (projects forge-configuration-projects (default '()))) @@ -567,15 +576,63 @@ forge configuration @var{config}." projects)))) (list)))) +(define (ci-notify-by-email from to) + "Return a G-expression that emails @var{to} addresses from @var{from} address +about the status of a laminar CI job. The returned G-expression is intended to +be used as the @code{after} field of a @code{<forge-laminar-job>} object." + #~(begin + (use-modules (ice-9 popen) + (srfi srfi-26)) + + (define (call-with-output-pipe command proc) + (let ((port #f)) + (dynamic-wind + (cut set! port (apply open-pipe* OPEN_WRITE command)) + (cut proc port) + (lambda () + (unless (zero? (status:exit-val (close-pipe port))) + (error "Command invocation failed" command)))))) + + (let ((job (getenv "JOB")) + (run (getenv "RUN")) + (result (getenv "RESULT")) + (last-result (getenv "LAST_RESULT"))) + (unless (string=? result last-result) + (call-with-output-pipe (list #$(file-append msmtp "/bin/msmtp") + "--host=localhost" + "--port=587" + "--read-recipients") + (cut format + <> + "From: ~a +To: ~a +Subject: Laminar ~a #~a: ~a + +See https://ci.systemreboot.net/jobs/~a/~a for details. +" + #$from + #$(string-join to ",") + job run result job run)))))) + (define (forge-project-all-ci-jobs project config) "Return list of all CI jobs for @var{project} in forge configuration @var{config}." - ;; Add project context to CI jobs. (map (lambda (job) (forge-laminar-job (inherit job) + ;; Add project context to job. (contexts (cons (forge-project-name project) - (forge-laminar-job-contexts job))))) + (forge-laminar-job-contexts job))) + ;; Add CI email notification to job. + (after #~(begin + #$@(cond + ((forge-laminar-job-after job) => list) + (else (list))) + #$(match (forge-project-ci-notify-addresses project) + (() #f) + (addresses + (ci-notify-by-email (forge-configuration-mailer-address config) + addresses))))))) ;; Prepend website CI job to the other CI jobs. (if (forge-project-website-ci-job project) (cons (forge-laminar-job |