diff options
| -rw-r--r-- | .guix-channel | 3 | ||||
| -rw-r--r-- | NEWS | 29 | ||||
| -rw-r--r-- | doc/forge.skb | 55 | ||||
| -rw-r--r-- | guix/forge/acme.scm | 3 | ||||
| -rw-r--r-- | guix/forge/cgit.scm | 6 | ||||
| -rw-r--r-- | guix/forge/fcgiwrap.scm | 5 | ||||
| -rw-r--r-- | guix/forge/forge.scm | 297 | ||||
| -rw-r--r-- | guix/forge/guile-git.scm | 14 | ||||
| -rw-r--r-- | guix/forge/gunicorn.scm | 5 | ||||
| -rw-r--r-- | guix/forge/klaus.scm | 177 | ||||
| -rw-r--r-- | guix/forge/laminar.scm | 12 | ||||
| -rw-r--r-- | guix/forge/nginx.scm | 25 | ||||
| -rw-r--r-- | guix/forge/tissue.scm | 18 | ||||
| -rw-r--r-- | guix/forge/utils.scm | 10 | ||||
| -rw-r--r-- | guix/forge/webhook.scm | 65 | ||||
| -rw-r--r-- | guix/guix-forge-website.scm | 78 | ||||
| -rw-r--r-- | website/index.skb | 4 |
17 files changed, 549 insertions, 257 deletions
diff --git a/.guix-channel b/.guix-channel index 8cec433..e12672e 100644 --- a/.guix-channel +++ b/.guix-channel @@ -1,3 +1,4 @@ (channel (version 0) - (directory "guix")) + (directory "guix") + (news-file "NEWS")) diff --git a/NEWS b/NEWS new file mode 100644 index 0000000..b0660fc --- /dev/null +++ b/NEWS @@ -0,0 +1,29 @@ +;;; -*- lisp-data -*- +;;; guix-forge --- Guix software forge meta-service +;;; Copyright © 2025 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of guix-forge. +;;; +;;; guix-forge 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. +;;; +;;; guix-forge 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 guix-forge. If not, see +;;; <https://www.gnu.org/licenses/>. + +(channel-news + (version 0) + (entry (commit "3c8dc85a584c98bc90088ec1c85933d4d10e7383") + (title (en "We now have news!") + (ta "அறிமுகம் செய்திகள்!")) + (body (en "We now have news in this channel. Hopefully, there will be something +to say in the future!") + (ta "இவ்வலைவரிசையில் இப்போது செய்திகள் உள்ளன. வருங்காலத்தில் சொல்வதற்கு ஏதாவது +இருக்கமென நம்புகிறோம்!")))) diff --git a/doc/forge.skb b/doc/forge.skb index d62336a..3ea04d3 100644 --- a/doc/forge.skb +++ b/doc/forge.skb @@ -291,7 +291,22 @@ first).]) shown. Else, they won't.]) (record-field "extra-options" [Association list of additional key-value option pairs to -include in the generated ,(file [cgitrc]) configuration file]))))) +include in the generated ,(file [cgitrc]) configuration file])))) + (subsection :title [klaus service] + :ident "subsection-klaus-service" + (p [klaus is a web viewer to serve git repositories on the web.]) + (description + (record-documentation "guix/forge/klaus.scm" '<klaus-configuration> + (record-field "python-klaus" + [,(code [python-klaus]) package to use]) + (record-field "server-name" + [Domain name to serve klaus on]) + (record-field "socket" + [Socket that the internal klaus gunicorn app listens on]) + (record-field "repository-directory" + [Directory containing git repositories to serve]) + (record-field "site-name" + [Title on klaus web pages]))))) (section :title [tissue service] :ident "section-tissue-service" (p [tissue is an issue tracker built on plain text files and @@ -557,7 +572,25 @@ gunicorn is run in])))))) [Its value])) (record-documentation "guix/forge/forge.scm" '<forge-configuration> (record-field "web-domain" - [Domain name to serve forge on]) + [Domain name on which to serve the guix-forge web interface]) + (record-field "cgit-domain" + [Domain name on which cgit is hosted]) + (record-field "laminar-domain" + [Domain name on which laminar is hosted]) + (record-field "tissue-web-domain" + [Optional domain name on which to serve tissue]) + (record-field "web-root" + [File-like object representing directory to serve as the +document root of the guix-forge web interface]) + (record-field "websites-directory" + [Directory containing websites for each project. Each +project's website is put in a subdirectory with the same name as the +project. Project websites are built by the ,(abbr :short "CI" :long +"continuous integration") job configured in its ,(record-field-ref +"<forge-project>" "website-ci-job").]) + (record-field "mailer-address" + [,(samp "From") address from which to send out notification +emails.]) (record-field "projects" [List of ,(record-ref "<forge-project>") objects describing projects managed by guix-forge])) @@ -577,20 +610,17 @@ the cgit web interface. This field is disregarded if the repository is remote.]) (record-field "web-domain" [Domain name to serve project website on]) - (record-field "website-directory" - [Path to the document root of the project website. The -ownership of its parent directory is granted to the ,(code "laminar") -user. The idea is that the website is built by a Guix derivation as a -store item and a symbolic link to that store item is created in the -parent directory.]) (record-field "tissue?" [Does this project use ,(ref :url "https://forge.systemreboot.net/tissue/" :text "tissue")? If so, it will be served at ,(samp "/<name>/") on the ,(record-field-ref "<forge-configuration>" "web-domain") configured in ,(record-ref "<forge-configuration>").]) + (record-field "website-ci-job" + [,(record-ref "<forge-laminar-job>") object describing ,(abbr +:short "CI" :long "continuous integration") job to build website]) (record-field "ci-jobs" - [List of ,(record-ref "<forge-laminar-job>") objects + [List of other ,(record-ref "<forge-laminar-job>") objects describing ,(abbr :short "CI" :long "continuous integration") jobs to configure]) (record-field "ci-jobs-trigger" @@ -610,6 +640,10 @@ jobs when a request is received on ,(samp "http://hostname:port/hooks/<name>") \ specified, a cron job triggers the CI jobs once a day.]))] :default [,(code ['post-receive-hook]) for local repositories and ,(code ['cron]) for remote repositories]) + (record-field "ci-notify-addresses" + [List of email addresses to send CI notification emails to. +This requires an SMTP server listening on ,(samp "localhost") port +,(samp "587").]) (record-field "parallel-ci-job-runs" [Number of CI job runs of this project to run simultaneously]) @@ -661,5 +695,4 @@ hooks to configure])) [Identifier of the webhook. This hook is triggered at ,(ref :url [http://host:port/hooks/<id>]).]) (record-field "run" - [G-expression to run when the webhook is triggered])) - (docstring-function-documentation "guix/forge/klaus.scm" 'klaus-gunicorn-app)))) + [G-expression to run when the webhook is triggered]))))) diff --git a/guix/forge/acme.scm b/guix/forge/acme.scm index 231608e..f78eedc 100644 --- a/guix/forge/acme.scm +++ b/guix/forge/acme.scm @@ -1,6 +1,7 @@ ;;; guix-forge --- Guix software forge meta-service ;;; Copyright © 2023, 2024 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2024 jgart <jgart@dismail.de> +;;; Copyright © 2025 Frederick M. Muriithi <fredmanglis@protonmail.com> ;;; ;;; This file is part of guix-forge. ;;; @@ -21,9 +22,9 @@ (define-module (forge acme) #:use-module ((gnu packages admin) #:select (shadow)) #:use-module ((gnu packages autotools) #:select (autoconf automake)) - #:use-module ((gnu packages certs) #:select (nss-certs)) #:use-module ((gnu packages curl) #:select (curl)) #:use-module ((gnu packages documentation) #:select (asciidoc)) + #:use-module ((gnu packages nss) #:select (nss-certs)) #:use-module ((gnu packages pkg-config) #:select (pkg-config)) #:use-module ((gnu packages tls) #:select (gnutls)) #:use-module (gnu services) diff --git a/guix/forge/cgit.scm b/guix/forge/cgit.scm index 0f3aaf2..2be21cb 100644 --- a/guix/forge/cgit.scm +++ b/guix/forge/cgit.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023, 2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023–2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -26,7 +26,7 @@ #:use-module ((gnu packages emacs) #:select (emacs-minimal)) #:use-module ((gnu packages mail) #:select (mailcap)) #:use-module ((gnu packages version-control) - #:select (cgit git-minimal)) + #:select (cgit-pink git-minimal)) #:use-module (gnu services) #:use-module ((gnu services web) #:select (nginx-server-configuration nginx-location-configuration)) @@ -72,7 +72,7 @@ cgit-configuration? this-cgit-configuration (cgit cgit-configuration-cgit - (default cgit)) + (default cgit-pink)) (git cgit-configuration-git (default git-without-safe-directory-check)) (server-name cgit-configuration-server-name) diff --git a/guix/forge/fcgiwrap.scm b/guix/forge/fcgiwrap.scm index f320223..f75fa5f 100644 --- a/guix/forge/fcgiwrap.scm +++ b/guix/forge/fcgiwrap.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023, 2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023–2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -74,7 +74,8 @@ (define (fcgiwrap-activation config) (with-imported-modules '((guix build utils)) #~(begin - (use-modules (guix build utils)) + (use-modules (guix build utils) + (ice-9 match)) ;; Create socket directories and set ownership. (for-each (match-lambda diff --git a/guix/forge/forge.scm b/guix/forge/forge.scm index 09f92c9..bdadb2b 100644 --- a/guix/forge/forge.scm +++ b/guix/forge/forge.scm @@ -1,5 +1,6 @@ ;;; guix-forge --- Guix software forge meta-service ;;; Copyright © 2021–2025 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2025 Frederick M. Muriithi <fredmanglis@protonmail.com> ;;; ;;; This file is part of guix-forge. ;;; @@ -21,10 +22,12 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) - #:use-module ((gnu packages certs) #:select (nss-certs)) #:use-module ((gnu packages ci) #:select (laminar)) #: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)) #:use-module (gnu services) @@ -47,7 +50,14 @@ #:export (forge-service-type forge-configuration forge-configuration? + this-forge-configuration forge-configuration-web-domain + forge-configuration-cgit-domain + forge-configuration-laminar-domain + forge-configuration-tissue-web-domain + forge-configuration-websites-directory + forge-configuration-web-root + forge-configuration-mailer-address forge-configuration-projects forge-project forge-project? @@ -57,10 +67,11 @@ forge-project-repository forge-project-repository-branch forge-project-web-domain - forge-project-website-directory forge-project-tissue? + 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 @@ -85,10 +96,11 @@ (default #f)) (web-domain forge-project-web-domain (default #f)) - (website-directory forge-project-website-directory - (default #f)) (tissue? forge-project-tissue? (default #f)) + (website-ci-job forge-project-website-ci-job + (default #f) + (thunked)) (ci-jobs forge-project-ci-jobs (default '()) (thunked)) (ci-jobs-trigger forge-project-ci-jobs-trigger ; one of 'post-receive-hook, 'cron, 'webhook @@ -99,16 +111,94 @@ ;; '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))) (define-record-type* <forge-configuration> forge-configuration make-forge-configuration forge-configuration? + this-forge-configuration (web-domain forge-configuration-web-domain) + (cgit-domain forge-configuration-cgit-domain + (default #f)) + (laminar-domain forge-configuration-laminar-domain + (default #f)) + (tissue-web-domain forge-configuration-tissue-web-domain + (default #f)) + (websites-directory forge-configuration-websites-directory + (default "/srv/http/forge")) + (web-root forge-configuration-web-root + (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 '()))) +(define (forge-web-root-gexp config) + (with-extensions (list guile-lib) + #~(begin + (use-modules (rnrs io ports) + (srfi srfi-26) + (ice-9 match) + (htmlprag)) + + (define (laminar-badge job-name) + `(li (a (@ (href ,(string-append "https://" + #$(forge-configuration-laminar-domain config) + "/jobs/" + job-name))) + (img (@ (src ,(string-append "https://" + #$(forge-configuration-laminar-domain config) + "/badge/" + job-name + ".svg"))))))) + + (mkdir #$output) + (let ((html + (sxml->html + `(html + (body + ,@(map (match-lambda + ((name description website-link jobs) + `((h2 ,(if website-link + `(a (@ (href ,website-link)) + ,name) + name)) + ,@(match jobs + (() '()) + (_ + (if #$(forge-configuration-laminar-domain config) + `((ul ,@(map laminar-badge jobs))) + '()))) + ,@(if description + `((p ,description)) + '()) + (ul + ,@(if #$(forge-configuration-cgit-domain config) + `((li (a (@ (href ,(string-append "https://" + #$(forge-configuration-cgit-domain config) + "/" name "/"))) + "cgit"))) + '()))))) + '#$(map (lambda (project) + (list (forge-project-name project) + (forge-project-description project) + (and (forge-project-website-ci-job project) + (if (forge-project-web-domain project) + (string-append "https://" (forge-project-web-domain project)) + (string-append "/" (forge-project-name project) "/"))) + (map forge-laminar-job-name + (forge-project-all-ci-jobs project config)))) + (forge-configuration-projects config)))))))) + (call-with-output-file (string-append #$output "/index.html") + (cut put-string <> html)))))) + (define* (ci-jobs-trigger-gexp ci-jobs #:key reason) "Return a G-expression that triggers CI-JOBS. CI-JOBS is a list of <forge-laminar-job> objects." @@ -148,12 +238,11 @@ (list (forge-project-user project) (forge-project-repository project) (forge-project-description project) - (forge-project-website-directory project) (program-file (string-append (forge-project-name project) "-post-receive-hook") (ci-jobs-trigger-gexp - (forge-project-ci-jobs project) + (forge-project-all-ci-jobs project config) #:reason "post-receive hook")) (forge-project-ci-jobs-trigger project))) (forge-configuration-projects config)))) @@ -168,8 +257,14 @@ '(regular directory))) #:directories? #t)) + ;; Set ownership of forge websites directory. + (let ((user (getpw "laminar"))) + (chown #$(forge-configuration-websites-directory config) + (passwd:uid user) + (passwd:gid user))) + (for-each (match-lambda - ((username repository description website-directory ci-jobs-trigger ci-jobs-trigger-type) + ((username repository description ci-jobs-trigger ci-jobs-trigger-type) ;; For local repositories only (when (string-prefix? "/" repository) ;; Set description. @@ -191,12 +286,7 @@ (let ((hook-link (string-append repository "/hooks/post-receive"))) (when (file-exists? hook-link) (delete-file hook-link)) - (symlink ci-jobs-trigger hook-link))) - ;; Set ownership of website directory. - (when website-directory - (let ((user (getpw "laminar"))) - (chown (dirname website-directory) - (passwd:uid user) (passwd:gid user)))))) + (symlink ci-jobs-trigger hook-link))))) '#$projects)))) (define (import-module? name) @@ -448,49 +538,150 @@ that were built." (package-channels pkg)))))))) inferior)))))))) +(define (switch-symlinks-gexp link target) + "Return a G-expression that links @var{link} to @var{target}. @var{target} is a +singleton list of targets as returned by @code{guix-channel-job-gexp}." + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (switch-symlinks #$link + (match #$target + ((target) target)))))) + (define (forge-nginx-server-blocks config) "Return list of @code{<nginx-server-configuration>} extensions for forge configuration @var{config}." - ;; Configure nginx server blocks for projects that have a web domain - ;; and a website directory, but do not have tissue enabled. - (filter-map (match-record-lambda <forge-project> - (web-domain website-directory tissue?) - (and web-domain - website-directory - (not tissue?) - (nginx-server-configuration - (server-name (list web-domain)) - (root website-directory)))) - (forge-configuration-projects config))) + (cons (nginx-server-configuration + (server-name (list (forge-configuration-web-domain config))) + (root (forge-configuration-web-root config)) + ;; Serve HTML files without extension. + (try-files (list "$uri" "$uri.html" "$uri/index.html" "=404")) + (locations + ;; Configure location blocks for projects that have no web domain. + (filter-map (lambda (project) + (match-record project <forge-project> + (name web-domain) + (and (not web-domain) + (nginx-location-configuration + (uri (string-append "/" name "/")) + (body + (list (string-append "root " + (forge-configuration-websites-directory config) + ";"))))))) + (forge-configuration-projects config)))) + ;; Configure nginx server blocks for projects that have a web domain. + (filter-map (match-record-lambda <forge-project> + (name web-domain) + (and web-domain + (nginx-server-configuration + (server-name (list web-domain)) + (root (string-append (forge-configuration-websites-directory config) + "/" + name)) + ;; Serve HTML files without extension. + (try-files (list "$uri" "$uri.html" + "$uri/index.html" "=404"))))) + (forge-configuration-projects config)))) + +(define (forge-tissue-hosts config) + "Return list of @code{<tissue-host>} objects for forge configuration +@var{config}." + (match-record config <forge-configuration> + (tissue-web-domain projects) + ;; Configure tissue host if a tissue web domain is provided. + (if tissue-web-domain + (list (tissue-host + (name tissue-web-domain) + (projects + (filter-map (lambda (project) + (and (forge-project-tissue? project) + (tissue-project + (name (forge-project-name project)) + ;; The laminar user must own the + ;; host state so that it can run + ;; tissue pull. + (user "laminar") + (upstream-repository + (forge-project-repository project))))) + 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-envelope-from" + "--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-tissue-host config) - "Return @code{<tissue-host>} object for forge configuration +(define (forge-project-all-ci-jobs project config) + "Return list of all CI jobs for @var{project} in forge configuration @var{config}." - (tissue-host - (name (forge-configuration-web-domain config)) - (projects - (filter-map (lambda (project) - (and (forge-project-tissue? project) - (tissue-project - (name (forge-project-name project)) - ;; The laminar user must own the host state so - ;; that it can run tissue pull. - (user "laminar") - (upstream-repository - (forge-project-repository project))))) - (forge-configuration-projects config))))) + (map (lambda (job) + (forge-laminar-job + (inherit job) + ;; Add project context to job. + (contexts (cons (forge-project-name project) + (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 + (inherit (forge-project-website-ci-job project)) + (run (switch-symlinks-gexp + (string-append (forge-configuration-websites-directory config) + "/" + (forge-project-name project)) + (forge-laminar-job-run (forge-project-website-ci-job project))))) + (forge-project-ci-jobs project)) + (forge-project-ci-jobs project)))) (define (forge-ci-jobs config) "Return list of CI jobs for forge configuration @var{config}. Each value of the returned list is a @code{<forge-laminar-job>} object." - (append-map (lambda (project) - ;; Add project context to CI jobs. - (map (lambda (job) - (forge-laminar-job - (inherit job) - (contexts (cons (forge-project-name project) - (forge-laminar-job-contexts job))))) - (forge-project-ci-jobs project))) + (append-map (cut forge-project-all-ci-jobs <> config) (forge-configuration-projects config))) (define (forge-ci-job-contexts config) @@ -508,7 +699,7 @@ value of the returned list is a @code{<forge-laminar-job>} object." @var{config}. Each element of the returned list is a @code{<forge-laminar-group>} object." (filter-map (lambda (project) - (match (forge-project-ci-jobs project) + (match (forge-project-all-ci-jobs project config) (() #f) ((job) #f) (jobs @@ -537,13 +728,13 @@ mcron job specification." (and (eq? (forge-project-ci-jobs-trigger project) 'cron) (any forge-laminar-job-trigger? - (forge-project-ci-jobs project)) + (forge-project-all-ci-jobs project config)) #~(job '(next-day) #$(program-file (string-append (forge-project-name project) "-cron-job") (ci-jobs-trigger-gexp - (forge-project-ci-jobs project) + (forge-project-all-ci-jobs project config) #:reason "Cron job")) #:user "laminar"))) (forge-configuration-projects config))) @@ -555,11 +746,11 @@ value is a list of @code{<webhook-hook>} objects." (and (eq? (forge-project-ci-jobs-trigger project) 'webhook) (any forge-laminar-job-trigger? - (forge-project-ci-jobs project)) + (forge-project-all-ci-jobs project config)) (webhook-hook (id (forge-project-name project)) (run (ci-jobs-trigger-gexp - (forge-project-ci-jobs project) + (forge-project-all-ci-jobs project config) #:reason "Webhook"))))) (forge-configuration-projects config))) @@ -572,7 +763,7 @@ value is a list of @code{<webhook-hook>} objects." (service-extension forge-nginx-service-type forge-nginx-server-blocks) (service-extension tissue-service-type - (compose list forge-tissue-host)) + forge-tissue-hosts) (service-extension forge-laminar-service-type forge-ci-jobs+contexts+groups) ;; TODO: Run CI job only if there are new commits diff --git a/guix/forge/guile-git.scm b/guix/forge/guile-git.scm index f582b7d..9315524 100644 --- a/guix/forge/guile-git.scm +++ b/guix/forge/guile-git.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023, 2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -19,7 +19,7 @@ (define-module (forge guile-git) #:use-module ((gnu packages guile) #:select (guile-git) #:prefix guix:) - #:use-module ((gnu packages version-control) #:select (libgit2-1.3) #:prefix guix:) + #:use-module ((gnu packages version-control) #:select (libgit2-1.9) #:prefix guix:) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix utils)) @@ -27,17 +27,17 @@ ;; Use a patched libgit2 until there is a way to disable repository ;; ownership validation using the API. See ;; https://issues.guix.gnu.org/55399 -(define libgit2-1.3 +(define libgit2-1.9 (package - (inherit guix:libgit2-1.3) + (inherit guix:libgit2-1.9) (name "libgit2") (arguments - (substitute-keyword-arguments (package-arguments guix:libgit2-1.3) + (substitute-keyword-arguments (package-arguments guix:libgit2-1.9) ((#:phases phases #~%standard-phases) #~(modify-phases #$phases (add-after 'unpack 'disable-ownership-validation (lambda _ - (substitute* "src/repository.c" + (substitute* "src/libgit2/repository.c" (("git_repository__validate_ownership = true") "git_repository__validate_ownership = false")))))))))) @@ -46,4 +46,4 @@ (inherit guix:guile-git) (inputs (modify-inputs (package-inputs guix:guile-git) - (replace "libgit2" libgit2-1.3))))) + (replace "libgit2" libgit2-1.9))))) diff --git a/guix/forge/gunicorn.scm b/guix/forge/gunicorn.scm index a86dd7a..6fcbd72 100644 --- a/guix/forge/gunicorn.scm +++ b/guix/forge/gunicorn.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023–2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023–2025 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2024 Frederick M. Muriithi <fredmanglis@protonmail.com> ;;; ;;; This file is part of guix-forge. @@ -111,7 +111,8 @@ (define (gunicorn-activation config) (with-imported-modules '((guix build utils)) #~(begin - (use-modules (guix build utils)) + (use-modules (guix build utils) + (ice-9 match)) ;; Create socket directories and set ownership. (for-each (match-lambda diff --git a/guix/forge/klaus.scm b/guix/forge/klaus.scm index 6ffb23c..23de1db 100644 --- a/guix/forge/klaus.scm +++ b/guix/forge/klaus.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023, 2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023–2025 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2024 jgart <jgart@dismail.de> ;;; ;;; This file is part of guix-forge. @@ -22,103 +22,106 @@ #:use-module (forge environment) #:use-module ((forge git) #:select (git-without-safe-directory-check)) #:use-module (forge gunicorn) + #:use-module (forge nginx) #:use-module (forge socket) - #:use-module ((gnu packages check) #:select (python-nose python-pytest)) - #:use-module ((gnu packages python-build) - #:select (python-setuptools python-wheel)) - #:use-module ((gnu packages python-web) - #:select (python-flask python-werkzeug)) #:use-module ((gnu packages python-xyz) - #:select (python-dulwich python-humanize python-pygments)) + #:select (python-docutils python-markdown)) + #:use-module ((gnu packages version-control) + #:select (python-klaus) + #:prefix guix:) + #:use-module (gnu services) + #:use-module ((gnu services web) #:select (nginx-server-configuration + nginx-location-configuration)) #:use-module (gnu system file-systems) - #:use-module (guix build-system pyproject) - #:use-module (guix build-system python) - #:use-module (guix download) - #:use-module (guix gexp) - #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix deprecation) #:use-module (guix packages) - #:export (klaus-gunicorn-app)) - -(define-public python-httpauth - (package - (name "python-httpauth") - (version "0.4.1") - (source (origin - (method url-fetch) - (uri (pypi-uri "httpauth" version)) - (sha256 - (base32 - "1m6rwvivg61l3h34hf6p6gkqmr69sb1c4k5ha379nxq0p8bfgahb")))) - (build-system pyproject-build-system) - (native-inputs - (list python-pytest - python-setuptools - python-wheel)) - (home-page "https://github.com/jonashaag/httpauth") - (synopsis "WSGI HTTP Digest Authentication middleware") - (description "@code{python-httpauth} is WSGI middleware that secures some/all -routes using HTTP Digest Authentication.") - (license license:bsd-2))) + #:use-module (guix records) + #:export (<klaus-configuration> + klaus-configuration + klaus-configuration? + klaus-configuration-python-klaus + klaus-configuration-server-name + klaus-configuration-socket + klaus-configuration-repository-directory + klaus-configuration-site-name + klaus-service-type + klaus-gunicorn-app)) (define-public python-klaus (package - (name "python-klaus") - (version "3.0.1") - (source (origin - (method url-fetch) - (uri (pypi-uri "klaus" version)) - (sha256 - (base32 - "1w6sl15llnkcg7kmnpn64awdiis061q2gijnhdx0ng7z4p1glapl")))) - (build-system pyproject-build-system) - (arguments - (list #:tests? #f ; tests fail - #:phases - #~(modify-phases %standard-phases - (add-after 'unpack 'configure-git - (lambda* (#:key inputs #:allow-other-keys) - (for-each (lambda (file) - (substitute* file - (("\"git\"") - (string-append "\"" (search-input-file inputs "/bin/git") "\"")))) - (list "klaus/ctagsutils.py" - "klaus/repo.py" - "klaus/utils.py" - "tests/test_contrib.py" - "tests/test_make_app.py"))))))) + (inherit guix:python-klaus) (inputs - ;; We use klaus to serve shared repositories. But, git's safe - ;; directory check does not permit us to use shared - ;; repositories. Disable it. The more long term solution is to rewrite - ;; klaus to not use the git CLI at all. See - ;; https://github.com/jonashaag/klaus/issues/322 - (list git-without-safe-directory-check)) - (native-inputs - (list python-pytest - python-setuptools - python-wheel)) + ;; We use klaus to serve shared repositories. But, git's safe directory + ;; check does not permit us to use shared repositories. Disable it. The + ;; more long term solution is to rewrite klaus to not use the git CLI at + ;; all. See https://github.com/jonashaag/klaus/issues/322 + (modify-inputs (package-inputs guix:python-klaus) + (replace "git-minimal" git-without-safe-directory-check))) (propagated-inputs - (list python-dulwich python-flask python-httpauth - python-humanize python-pygments python-werkzeug)) - (home-page "https://github.com/jonashaag/klaus") - (synopsis "Simple git web viewer") - (description "klaus is a simple, easy-to-set-up git web viewer. It features + (modify-inputs (package-propagated-inputs guix:python-klaus) + ;; Add optional dependencies for markup rendering. + (prepend python-docutils python-markdown))))) + +(define-record-type* <klaus-configuration> + klaus-configuration make-klaus-configuration + klaus-configuration? + (python-klaus klaus-configuration-python-klaus + (default python-klaus)) + (server-name klaus-configuration-server-name) + (socket klaus-configuration-socket + (default (forge-unix-socket + (path "/var/run/gunicorn/klaus/socket")))) + (repository-directory klaus-configuration-repository-directory + (default "/srv/git")) + (site-name klaus-configuration-site-name + (default #f))) + +(define klaus-gunicorn-apps + (match-record-lambda <klaus-configuration> + (python-klaus socket repository-directory site-name) + (list (gunicorn-app + (name "klaus") + (package python-klaus) + (wsgi-app-module "klaus.contrib.wsgi_autoreload") + (sockets (list socket)) + (environment-variables (cons (environment-variable + (name "KLAUS_REPOS_ROOT") + (value repository-directory)) + (if site-name + (list (environment-variable + (name "KLAUS_SITE_NAME") + (value site-name))) + (list)))) + (mappings (list (file-system-mapping + (source repository-directory) + (target source)))))))) + +(define klaus-nginx-server-blocks + (match-record-lambda <klaus-configuration> + (server-name socket) + (list (nginx-server-configuration + (server-name (list server-name)) + (locations + (list (nginx-location-configuration + (uri "/") + (body (list (socket->nginx-proxy-pass socket)))))))))) -@itemize -@item Super easy to set up -- no configuration required -@item Syntax highlighting -@item Markdown + RestructuredText rendering support -@item Pull + push support (Git Smart HTTP) -@item Code navigation using Exuberant ctags -@end itemize") - (license license:isc))) +(define klaus-service-type + (service-type + (name 'klaus) + (description "Run klaus.") + (extensions (list (service-extension gunicorn-service-type + klaus-gunicorn-apps) + (service-extension forge-nginx-service-type + klaus-nginx-server-blocks))))) -(define* (klaus-gunicorn-app repository-directory - #:key - (klaus python-klaus) - (sockets (list (forge-unix-socket - (path "/var/run/gunicorn/klaus/socket")))) - site-name) +(define-deprecated (klaus-gunicorn-app repository-directory + #:key + (klaus python-klaus) + (sockets (list (forge-unix-socket + (path "/var/run/gunicorn/klaus/socket")))) + site-name) + klaus-service-type "Return a @code{<gunicorn-app>} object to deploy klaus. @var{repository-directory} is the path to the directory containing git diff --git a/guix/forge/laminar.scm b/guix/forge/laminar.scm index 16f5de7..dcbc5bf 100644 --- a/guix/forge/laminar.scm +++ b/guix/forge/laminar.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2021–2022, 2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2021–2022, 2024–2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -164,7 +164,15 @@ of @var{<forge-laminar-job>} objects." (lambda (file stat) (memq (stat:type stat) '(regular directory))) - #:directories? #t)))))) + #:directories? #t)) + ;; Ensure the state directory has the right permissions so + ;; that the nginx user can get in and serve files from the + ;; archive directory. The state directory is the home of the + ;; laminar user and is created with more restrictive + ;; permissions. So, the permissions need to be overridden. + ;; The archive directory, however, is always created with + ;; the right permissions. + (chmod #$state-directory #o755))))) (define forge-laminar-service-type (service-type diff --git a/guix/forge/nginx.scm b/guix/forge/nginx.scm index a1f99c2..2e22bd8 100644 --- a/guix/forge/nginx.scm +++ b/guix/forge/nginx.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023, 2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -36,6 +36,7 @@ forge-nginx-configuration-acme-challenge-directory forge-nginx-configuration-server-blocks nginx-socket->string + socket->nginx-proxy-pass forge-nginx-service-type)) (define-record-type* <forge-nginx-configuration> @@ -66,12 +67,28 @@ configuration (for example, in the @code{listen} and (($ <forge-ip-socket> (or "0.0.0.0" "::") port) (number->string port)) (($ <forge-ip-socket> (? ipv4-address? ip) port) - (string-append ip ":" port)) + (string-append ip ":" (number->string port))) (($ <forge-ip-socket> (? ipv6-address? ip) port) - (string-append "[" ip "]" ":" port)) + (string-append "[" ip "]" ":" (number->string port))) (($ <forge-unix-socket> path) (string-append "unix:" path)))) +(define (socket->nginx-proxy-pass socket) + "Serialize @var{socket}, a forge socket, to an nginx @code{proxy_pass} +directive." + (string-append + "proxy_pass " + (match socket + (($ <forge-host-socket> hostname port) + (string-append "http://" hostname ":" (number->string port))) + (($ <forge-ip-socket> (? ipv4-address? ip) port) + (string-append "http://" ip ":" (number->string port))) + (($ <forge-ip-socket> (? ipv6-address? ip) port) + (string-append "http://[" ip "]:" (number->string port))) + (($ <forge-unix-socket> path) + (string-append "http://unix:" path ":"))) + ";")) + (define (forge-nginx-server-blocks config) "Return list of nginx server blocks to provision for forge-web service specified by @var{config}." @@ -82,7 +99,7 @@ specified by @var{config}." (locations (list (nginx-location-configuration (uri "/.well-known/acme-challenge/") - ;; Without a trailing slash, a alias of /var/foo + ;; Without a trailing slash, an alias of /var/foo ;; would lookup /bar at /var/foobar, not ;; /var/foo/bar. So, a trailing slash is ;; significant. Append it if not already diff --git a/guix/forge/tissue.scm b/guix/forge/tissue.scm index 1608728..abf3e39 100644 --- a/guix/forge/tissue.scm +++ b/guix/forge/tissue.scm @@ -248,22 +248,6 @@ #:log-file "/var/log/tissue.log"))) (stop #~(make-kill-destructor))))) -(define (socket->proxy-pass socket) - "Serialize @var{socket}, a forge socket, to an nginx @code{proxy_pass} -directive." - (string-append - "proxy_pass " - (match socket - (($ <forge-host-socket> hostname port) - (string-append "http://" hostname ":" (number->string port))) - (($ <forge-ip-socket> (? ipv4-address? ip) port) - (string-append "http://" ip ":" (number->string port))) - (($ <forge-ip-socket> (? ipv6-address? ip) port) - (string-append "http://[" ip "]:" (number->string port))) - (($ <forge-unix-socket> path) - (string-append "http://unix:" path ":"))) - ";")) - (define (tissue-nginx-server-blocks config) "Return list of @code{<nginx-server-configuration>} extensions for tissue configuration @var{config}." @@ -286,7 +270,7 @@ tissue configuration @var{config}." (locations (cons (nginx-location-configuration (uri "@tissue-search") - (body (list (socket->proxy-pass socket) + (body (list (socket->nginx-proxy-pass socket) "proxy_set_header Host $host;"))) (append (map (cut project->location state-directory <>) projects) diff --git a/guix/forge/utils.scm b/guix/forge/utils.scm index 96d9f51..4b47f3b 100644 --- a/guix/forge/utils.scm +++ b/guix/forge/utils.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -26,9 +26,15 @@ #:use-module (guix profiles) #:use-module (guix search-paths) #:use-module (guix store) - #:export (with-manifest + #:export (file-name-as-directory + with-manifest with-packages)) +(define (file-name-as-directory path) + "Return PATH with a trailing slash." + (string-append (string-trim-right path #\/) + "/")) + (define (with-manifest manifest exp) "Return a gexp executing EXP, another gexp, in a profile defined by MANIFEST." diff --git a/guix/forge/webhook.scm b/guix/forge/webhook.scm index 7915bcb..670adbb 100644 --- a/guix/forge/webhook.scm +++ b/guix/forge/webhook.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -22,19 +22,15 @@ #:use-module (gnu build linux-container) #:use-module ((gnu packages admin) #:select (shadow)) #:use-module ((gnu packages guile) #:select (guile-json-4)) + #:use-module ((gnu packages web) #:select (webhook)) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu system accounts) #:use-module (gnu system file-systems) #:use-module (gnu system shadow) #:use-module (guix gexp) - #:use-module (guix modules) #:use-module (guix records) - #:use-module (guix packages) - #:use-module (guix git-download) #:use-module (guix least-authority) - #:use-module (guix build-system go) - #:use-module ((guix licenses) #:prefix license:) #:use-module (forge socket) #:export (webhook-service-type webhook-configuration @@ -48,63 +44,6 @@ webhook-hook-id webhook-hook-run)) -(define-public webhook - (package - (name "webhook") - (version "2.8.0") - (source (origin - (method git-fetch) - (uri (git-reference - (url "https://github.com/adnanh/webhook") - (commit version))) - (file-name (git-file-name name version)) - (sha256 - (base32 - "0n03xkgwpzans0cymmzb0iiks8mi2c76xxdak780dk0jbv6qgp5i")))) - (build-system go-build-system) - (arguments - `(#:import-path "github.com/adnanh/webhook" - #:phases - (modify-phases %standard-phases - (add-after 'unpack 'configure - (lambda* (#:key inputs #:allow-other-keys) - (substitute* "src/github.com/adnanh/webhook/webhook_test.go" - (("/bin/echo") - (string-append (assoc-ref inputs "coreutils") - "/bin/echo")))))))) - (home-page "https://github.com/adnanh/webhook") - (synopsis "Lightweight incoming webhook server") - (description "webhook is a lightweight configurable tool written -in Go, that allows you to easily create HTTP endpoints (hooks) on your -server, which you can use to execute configured commands. You can also -pass data from the HTTP request (such as headers, payload or query -variables) to your commands. webhook also allows you to specify rules -which have to be satisfied in order for the hook to be triggered. - -For example, if you're using Github or Bitbucket, you can use webhook -to set up a hook that runs a redeploy script for your project on your -staging server, whenever you push changes to the master branch of your -project. - -If you use Mattermost or Slack, you can set up an \"Outgoing webhook -integration\" or \"Slash command\" to run various commands on your -server, which can then report back directly to you or your channels -using the \"Incoming webhook integrations\", or the appropriate -response body. - -webhook aims to do nothing more than it should do, and that is: - -@itemize -@item receive the request, -@item parse the headers, payload and query variables, -@item check if the specified rules for the hook are satisfied, -@item and finally, pass the specified arguments to the specified -command via command line arguments or via environment variables. -@end itemize - -Everything else is the responsibility of the command's author.") - (license license:expat))) - (define-record-type* <webhook-configuration> webhook-configuration make-webhook-configuration webhook-configuration? diff --git a/guix/guix-forge-website.scm b/guix/guix-forge-website.scm new file mode 100644 index 0000000..2b0be61 --- /dev/null +++ b/guix/guix-forge-website.scm @@ -0,0 +1,78 @@ +;;; guix-forge --- Guix software forge meta-service +;;; Copyright © 2025 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of guix-forge. +;;; +;;; guix-forge 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. +;;; +;;; guix-forge 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 guix-forge. If not, see +;;; <https://www.gnu.org/licenses/>. + +(define-module (guix-forge-website) + #:use-module ((gnu packages fonts) #:select (font-charter font-fira-code)) + #:use-module ((gnu packages skribilo) #:select (skribilo)) + #:use-module (guix gexp) + #:use-module (guix git-download) + #:use-module (guix utils)) + +(define-public guix-forge-source + (local-file ".." + "guix-forge-checkout" + #:recursive? #t + #:select? (or (git-predicate (dirname (current-source-directory))) + (const #t)))) + +(define guix-forge-website-home-page-gexp + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (invoke #$(file-append skribilo "/bin/skribilo") + (string-append "--preload=" #$(file-append guix-forge-source "/doc/skribilo.scm")) + (string-append "--output=" #$output) + #$(file-append guix-forge-source "/website/index.skb"))))) + +(define guix-forge-website-manual-en-gexp + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (chdir #$guix-forge-source) + (invoke #$(file-append skribilo "/bin/skribilo") + (string-append "--preload=" + #$(file-append guix-forge-source "/doc/skribilo.scm")) + (string-append "--source-path=" #$guix-forge-source) + (string-append "--output=" #$output) + #$(file-append guix-forge-source "/doc/forge.skb"))))) + +(define-public guix-forge-website + (file-union "guix-forge-website" + `(("index.html" + ,(computed-file "guix-forge-website-home-page" + guix-forge-website-home-page-gexp)) + ("manual/dev/en/index.html" + ,(computed-file "guix-forge-website-manual-en" + guix-forge-website-manual-en-gexp)) + ("style.css" + ,(file-append guix-forge-source + "/website/style.css")) + ("fonts/charter_regular.woff2" + ,(file-append font-charter + "/share/fonts/web/charter_regular.woff2")) + ("fonts/FiraCode-Regular.woff2" + ,(file-append font-fira-code + "/share/fonts/web/FiraCode-Regular.woff2")) + ("fonts/FiraCode-SemiBold.woff2" + ,(file-append font-fira-code + "/share/fonts/web/FiraCode-SemiBold.woff2"))))) + +guix-forge-website diff --git a/website/index.skb b/website/index.skb index aeaaafa..b5f91dc 100644 --- a/website/index.skb +++ b/website/index.skb @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023, 2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -26,7 +26,7 @@ (item [,(code "[X]") ,(ref :url "https://git.zx2c4.com/cgit/" :text "cgit") and ,(ref :url "https://github.com/jonashaag/klaus/" :text "klaus") (pick your favourite) to serve project git repositories on the web]) (item [,(code "[X]") ,(ref :url "https://laminar.ohwg.net" :text "laminar") for continuous integration]) (item [,(code "[X]") ,(ref :url "https://github.com/ndilieto/uacme/" :text "uacme") and ,(ref :url "https://gnutls.org/" :text "gnutls") for automatic provision and renewal of TLS certificates via ACME]) - (item [,(code "[ ]") web server to serve static project sites]) + (item [,(code "[X]") web server to serve static project sites]) (item [,(code "[ ]") ,(ref :url "https://public-inbox.org/README.html" :text "public-inbox") for project discussions])) (p [A choice of different software components may be offered provided it does not complicate the interface too much.]) (p [,(emph [guix-forge]) is provided on a best effort basis. Its design is unstable, and open to change. We will try our best to not break your system configuration often, but it might happen.]) |