diff options
| -rw-r--r-- | doc/forge.skb | 58 | ||||
| -rw-r--r-- | doc/skribilo.scm | 28 | ||||
| -rw-r--r-- | guix/forge/acme.scm | 14 | ||||
| -rw-r--r-- | guix/forge/cgit.scm | 5 | ||||
| -rw-r--r-- | guix/forge/fcgiwrap.scm | 8 | ||||
| -rw-r--r-- | guix/forge/forge.scm | 63 | ||||
| -rw-r--r-- | guix/forge/git.scm | 43 | ||||
| -rw-r--r-- | guix/forge/guile-git.scm | 14 | ||||
| -rw-r--r-- | guix/forge/gunicorn.scm | 10 | ||||
| -rw-r--r-- | guix/forge/klaus.scm | 52 | ||||
| -rw-r--r-- | guix/forge/tissue.scm | 138 | ||||
| -rw-r--r-- | tissue.scm | 2 | ||||
| -rw-r--r-- | website/index.skb | 2 |
13 files changed, 344 insertions, 93 deletions
diff --git a/doc/forge.skb b/doc/forge.skb index 99d1b86..2538401 100644 --- a/doc/forge.skb +++ b/doc/forge.skb @@ -1,5 +1,6 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2022–2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022–2025 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2024 Frederick M. Muriithi <fredmanglis@protonmail.com> ;;; ;;; This file is part of guix-forge. ;;; @@ -291,6 +292,46 @@ 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]))))) + (section :title [tissue service] + :ident "section-tissue-service" + (p [tissue is an issue tracker built on plain text files and +git. In addition, it features a static site generator tuned to +building project websites.]) + (description + (record-documentation "guix/forge/tissue.scm" '<tissue-configuration> + (record-field "package" + [,(code [tissue]) package to use]) + (record-field "socket" + [Socket to listen on. Socket may be a ,(record-ref +"<forge-ip-socket>"), or ,(record-ref "<forge-unix-socket>") +object.]) + (record-field "state-directory" + [Directory in which tissue maintains its state]) + (record-field "hosts" + [List of ,(record-ref "<tissue-host>") objects describing +configured hosts. A single tissue instance may serve several +hosts—this is often called ,(ref :url +"https://en.wikipedia.org/wiki/Virtual_hosting" :text "virtual +hosting").])) + (record-documentation "guix/forge/tissue.scm" '<tissue-host> + (record-field "name" + [HTTP host name to listen on]) + (record-field "projects" + [List of ,(record-ref "<tissue-project>") objects +describing configured projects])) + (record-documentation "guix/forge/tissue.scm" '<tissue-project> + (record-field "name" + [Name of the project]) + (record-field "user" + [Name of user who owns the project directory in the tissue +,(record-field-ref "<tissue-configuration>" "state-directory")]) + (record-field "base-path" + [Base web path at which the project is served. Several +projects may be served on the same host at ,(samp "/project1/"), +,(samp "/project2/") and so on.] + :default [,(samp "\"/<name>/\"")]) + (record-field "upstream-repository" + [Path to git repository of project])))) (section :title [forge nginx service] :ident "section-forge-nginx-service" (p [The forge nginx service is a wrapper around the nginx web @@ -467,6 +508,7 @@ environment]) describing additional directories that should be shared with the container fcgiwrap is run in])))) (subsection :title [gunicorn service] + :ident "subsection-gunicorn-service" (p [gunicorn is a specialized web server for Python ,(ref :url "https://en.wikipedia.org/wiki/Web_Server_Gateway_Interface" :text "WSGI") applications. We run separate containerized instances of @@ -494,6 +536,9 @@ describing sockets to listen on]) (record-field "timeout" [Workers silent for more than this many seconds are killed and restarted.]) + (record-field "extra-cli-arguments" + [List of strings to pass as additional command-line +arguments to gunicorn]) (record-field "environment-variables" [List of ,(record-ref "<environment-variable>") objects describing environment variables that should be set in the execution @@ -511,6 +556,9 @@ gunicorn is run in])))))) (record-field "value" [Its value])) (record-documentation "guix/forge/forge.scm" '<forge-configuration> + (record-field "web-domain" + [Optional domain name on which to serve project listing and +tissue-powered websites]) (record-field "projects" [List of ,(record-ref "<forge-project>") objects describing projects managed by guix-forge])) @@ -528,12 +576,20 @@ disregarded if the repository is remote.]) the ,(file "description") file in the repository and will appear in 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 "ci-jobs" [List of ,(record-ref "<forge-laminar-job>") objects describing ,(abbr :short "CI" :long "continuous integration") jobs to diff --git a/doc/skribilo.scm b/doc/skribilo.scm index 972b626..dc1bc15 100644 --- a/doc/skribilo.scm +++ b/doc/skribilo.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2022–2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022–2023, 2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -45,6 +45,7 @@ record-documentation record-field record-ref + record-field-ref docstring-function-documentation)) ;; Constants @@ -268,24 +269,27 @@ are a list of <record-field> objects." (code identifier)))) (apply description (map (lambda (documented-field) - (let* ((identifier (record-field-identifier documented-field)) + (let* ((field-identifier (record-field-identifier documented-field)) (record-field (find (lambda (field) (eq? (record-field-identifier field) - (string->symbol identifier))) + (string->symbol field-identifier))) (record-fields record)))) - (item #:key + (item #:ident (string-append identifier + "-" + field-identifier) + #:key (cond ;; No default value ((no-default? (record-field-default record-field)) - (code identifier)) + (code field-identifier)) ;; Default value in documentation ((record-field-default documented-field) => (lambda (default) - (list (append (list (code identifier) " (Default: ") + (list (append (list (code field-identifier) " (Default: ") default (list ")"))))) ;; Default value from the source - (else (list (list (code identifier) " (Default: " + (else (list (list (code field-identifier) " (Default: " (code (expression->string (record-field-default record-field))) ")")))) @@ -293,11 +297,17 @@ are a list of <record-field> objects." fields)))))) (define (record-ref identifier) - "Link to record documentation of record identified by + "Link to documentation of record identified by @var{identifier}." (ref #:ident identifier #:text (code identifier))) +(define (record-field-ref record-identifier field-identifier) + "Link to documentation of field identified by @var{field-identifier} in +record identified by @var{record-identifier}." + (ref #:ident (string-append record-identifier "-" field-identifier) + #:text (code field-identifier))) + (define-record-type <function> (function name arguments docstring) function? @@ -364,7 +374,7 @@ are a list of <record-field> objects." ;; HTML engine customizations (let ((html-engine (find-engine 'html))) - (engine-custom-set! html-engine 'css "/style.css") + (engine-custom-set! html-engine 'css "/guix-forge/style.css") (engine-custom-set! html-engine 'charset "UTF-8") (markup-writer 'abbr html-engine #:options '(#:short #:long) diff --git a/guix/forge/acme.scm b/guix/forge/acme.scm index 5ec27bb..231608e 100644 --- a/guix/forge/acme.scm +++ b/guix/forge/acme.scm @@ -1,5 +1,6 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023, 2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2024 jgart <jgart@dismail.de> ;;; ;;; This file is part of guix-forge. ;;; @@ -73,7 +74,7 @@ (define-public uacme (package (name "uacme") - (version "1.7.4") + (version "1.7.5") (source (origin ;; TODO: Unbundle libev. (method git-fetch) @@ -83,7 +84,7 @@ (file-name (git-file-name name version)) (sha256 (base32 - "1jhjyjnrfq07qgslmz1qpka1ahnmpya2garbxldkh2fr0bmsn26b")))) + "1br374d0lnn422rvg2g4m69vhdck8aihdsjydr064hif0lscr8ri")))) (build-system gnu-build-system) (arguments (list #:phases @@ -332,9 +333,10 @@ tls_www_server ;; exists. (unless (file-exists? #$(string-append state-directory "/private/key.pem")) (display " -If this is the first time you are using the acme service, please -register by running `/usr/bin/acme register' and initialize your -certificates by running `/usr/bin/acme renew' +This seems to be the first time you are using the acme service. The +acme service starts out with self-signed certificates. Please run +`/usr/bin/acme renew' to get CA-issued certificates. Thereafter, +certificates will auto-renew via a cron job. ")))))) diff --git a/guix/forge/cgit.scm b/guix/forge/cgit.scm index 805f47f..0f3aaf2 100644 --- a/guix/forge/cgit.scm +++ b/guix/forge/cgit.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023, 2024 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -20,6 +20,7 @@ (define-module (forge cgit) #:use-module (forge environment) #:use-module (forge fcgiwrap) + #:use-module ((forge git) #:select (git-without-safe-directory-check)) #:use-module (forge nginx) #:use-module (forge socket) #:use-module ((gnu packages emacs) #:select (emacs-minimal)) @@ -73,7 +74,7 @@ (cgit cgit-configuration-cgit (default cgit)) (git cgit-configuration-git - (default git-minimal)) + (default git-without-safe-directory-check)) (server-name cgit-configuration-server-name) (repository-directory cgit-configuration-repository-directory (default "/srv/git")) diff --git a/guix/forge/fcgiwrap.scm b/guix/forge/fcgiwrap.scm index f699480..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 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 @@ -137,7 +138,8 @@ ;; https://yhetil.org/guix/m1ilknoi5r.fsf@fastmail.net/ #:namespaces (delq 'net %namespaces)) "-s" #$(socket->fcgiwrap-socket-url socket) - "-c" #$(number->string processes)) + "-c" #$(number->string processes) + "-f") #:user #$user #:group #$group #:environment-variables diff --git a/guix/forge/forge.scm b/guix/forge/forge.scm index 1871a12..cfe8337 100644 --- a/guix/forge/forge.scm +++ b/guix/forge/forge.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2021–2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2021–2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -29,7 +29,9 @@ #:use-module ((gnu packages version-control) #:select (git-minimal)) #:use-module (gnu services) #:use-module (gnu services mcron) + #:use-module (gnu services web) #:use-module (guix channels) + #:use-module (guix deprecation) #:use-module (guix gexp) #:use-module (guix modules) #:use-module (guix packages) @@ -38,12 +40,14 @@ #:use-module (guix store) #:use-module ((forge guile-git) #:select (guile-git)) #:use-module (forge laminar) + #:use-module (forge nginx) #:use-module (forge tissue) #:use-module (forge utils) #:use-module (forge webhook) #:export (forge-service-type forge-configuration forge-configuration? + forge-configuration-web-domain forge-configuration-projects forge-project forge-project? @@ -52,9 +56,12 @@ forge-project-user forge-project-repository forge-project-repository-branch + forge-project-web-domain forge-project-website-directory + forge-project-tissue? forge-project-ci-jobs forge-project-ci-jobs-trigger + forge-project-parallel-ci-job-runs derivation-job-gexp variable-specification variable-specification? @@ -76,8 +83,12 @@ (default "main")) (description forge-project-description (default #f)) + (web-domain forge-project-web-domain + (default #f)) (website-directory forge-project-website-directory (default #f)) + (tissue? forge-project-tissue? + (default #f)) (ci-jobs forge-project-ci-jobs (default '()) (thunked)) (ci-jobs-trigger forge-project-ci-jobs-trigger ; one of 'post-receive-hook, 'cron, 'webhook @@ -94,6 +105,8 @@ (define-record-type* <forge-configuration> forge-configuration make-forge-configuration forge-configuration? + (web-domain forge-configuration-web-domain + (default #f)) (projects forge-configuration-projects (default '()))) @@ -193,8 +206,9 @@ (('forge _ ...) #t) (name (guix-module-name? name)))) -(define* (derivation-job-gexp project job gexp-producer - #:key (guix-daemon-uri (%daemon-socket-uri)) deep-clone?) +(define-deprecated (derivation-job-gexp project job gexp-producer + #:key (guix-daemon-uri (%daemon-socket-uri)) deep-clone?) + guix-channel-job-gexp "Return a G-expression that builds another G-expression as a derivation and returns its output path. GEXP-PRODUCER is a G-expression that expands to a lambda function. The lambda function @@ -435,8 +449,45 @@ that were built." (package-channels pkg)))))))) inferior)))))))) +(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))) + +(define (forge-tissue-hosts config) + "Return list of @code{<tissue-host>} objects for forge configuration +@var{config}." + (match-record config <forge-configuration> + (web-domain projects) + (if web-domain + (list (tissue-host + (name 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 (forge-ci-jobs config) - "Return list of CI jobs for forge configuraion @var{config}. Each + "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. @@ -524,6 +575,10 @@ value is a list of @code{<webhook-hook>} objects." (description "Run guix-forge.") (extensions (list (service-extension activation-service-type forge-activation) + (service-extension forge-nginx-service-type + forge-nginx-server-blocks) + (service-extension tissue-service-type + 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/git.scm b/guix/forge/git.scm new file mode 100644 index 0000000..cd6fedc --- /dev/null +++ b/guix/forge/git.scm @@ -0,0 +1,43 @@ +;;; guix-forge --- Guix software forge meta-service +;;; Copyright © 2024 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 (forge git) + #:use-module ((gnu packages version-control) #:select (git-minimal)) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix utils)) + +;; We serve shared repositories. But, git's safe directory check does +;; not permit us to use shared repositories. Disable it. +(define-public git-without-safe-directory-check + (package + (inherit git-minimal) + (name "git-without-safe-directory-check") + (arguments + (substitute-keyword-arguments (package-arguments git-minimal) + ((#:phases phases #~%standard-phases) + #~(modify-phases #$phases + (add-after 'unpack 'disable-safe-directory-check + (lambda _ + ;; Disable the safe directory check. + (substitute* "setup.c" + (("return data\\.is_safe;") + "return 1;")) + ;; Disable tests broken by this change. + (setenv "GIT_SKIP_TESTS" "t0033 t0411 t9700"))))))))) 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 148bd53..6fcbd72 100644 --- a/guix/forge/gunicorn.scm +++ b/guix/forge/gunicorn.scm @@ -1,5 +1,6 @@ ;;; 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. ;;; @@ -51,6 +52,7 @@ gunicorn-app-sockets gunicorn-app-workers gunicorn-app-timeout + gunicorn-app-extra-cli-arguments gunicorn-app-environment-variables gunicorn-app-mappings)) @@ -77,6 +79,8 @@ (thunked)) (workers gunicorn-app-workers (default 1)) + (extra-cli-arguments gunicorn-app-extra-cli-arguments + (default '())) (environment-variables gunicorn-app-environment-variables (default '())) (timeout gunicorn-app-timeout @@ -107,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 @@ -197,6 +202,7 @@ "=" #$(environment-variable-value variable)))) (gunicorn-app-environment-variables app)) + (gunicorn-app-extra-cli-arguments app) (list (gunicorn-app-wsgi-app-module app))))) #:user #$name #:group #$name diff --git a/guix/forge/klaus.scm b/guix/forge/klaus.scm index b6222c3..6ffb23c 100644 --- a/guix/forge/klaus.scm +++ b/guix/forge/klaus.scm @@ -1,5 +1,6 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023, 2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2024 jgart <jgart@dismail.de> ;;; ;;; This file is part of guix-forge. ;;; @@ -19,14 +20,16 @@ (define-module (forge klaus) #:use-module (forge environment) + #:use-module ((forge git) #:select (git-without-safe-directory-check)) #:use-module (forge gunicorn) #: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)) - #:use-module ((gnu packages version-control) #:select (git-minimal)) #:use-module (gnu system file-systems) #:use-module (guix build-system pyproject) #:use-module (guix build-system python) @@ -34,59 +37,39 @@ #:use-module (guix gexp) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) - #:use-module (guix utils) #:export (klaus-gunicorn-app)) (define-public python-httpauth (package (name "python-httpauth") - (version "0.3") + (version "0.4.1") (source (origin (method url-fetch) (uri (pypi-uri "httpauth" version)) (sha256 (base32 - "0qas7876igyz978pgldp5r7n7pis8n4vf0v87gxr9l7p7if5lr3l")))) + "1m6rwvivg61l3h34hf6p6gkqmr69sb1c4k5ha379nxq0p8bfgahb")))) (build-system pyproject-build-system) - (native-inputs (list python-nose)) + (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))) -;; 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 -(define-public git-without-safe-directory-check - (package - (inherit git-minimal) - (name "git-without-safe-directory-check") - (arguments - (substitute-keyword-arguments (package-arguments git-minimal) - ((#:phases phases #~%standard-phases) - #~(modify-phases #$phases - (add-after 'unpack 'disable-safe-directory-check - (lambda _ - ;; Disable the safe directory check. - (substitute* "setup.c" - (("return data\\.is_safe;") - "return 1;")) - ;; Disable tests broken by this change. - (setenv "GIT_SKIP_TESTS" "t0033 t9700"))))))))) - (define-public python-klaus (package (name "python-klaus") - (version "2.0.3") + (version "3.0.1") (source (origin (method url-fetch) (uri (pypi-uri "klaus" version)) (sha256 (base32 - "1y06xnynfah5d4zif2fc0n83zdr0d1vkh0rwcinsi6wjxalvnhjw")))) + "1w6sl15llnkcg7kmnpn64awdiis061q2gijnhdx0ng7z4p1glapl")))) (build-system pyproject-build-system) (arguments (list #:tests? #f ; tests fail @@ -104,9 +87,16 @@ routes using HTTP Digest Authentication.") "tests/test_contrib.py" "tests/test_make_app.py"))))))) (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)) + (list python-pytest + python-setuptools + python-wheel)) (propagated-inputs (list python-dulwich python-flask python-httpauth python-humanize python-pygments python-werkzeug)) diff --git a/guix/forge/tissue.scm b/guix/forge/tissue.scm index 4ece204..1608728 100644 --- a/guix/forge/tissue.scm +++ b/guix/forge/tissue.scm @@ -1,5 +1,5 @@ ;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023, 2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -19,13 +19,16 @@ (define-module (forge tissue) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module ((forge guile-git) #:select (guile-git)) + #:use-module (forge nginx) #:use-module (forge socket) #:use-module (gnu build linux-container) #:use-module ((gnu packages admin) #:select (shadow)) #:use-module ((gnu packages web) #:select (tissue) #:prefix guix:) #:use-module (gnu services) #:use-module (gnu services shepherd) + #:use-module (gnu services web) #:use-module (gnu system file-systems) #:use-module (gnu system shadow) #:use-module (guix gexp) @@ -34,6 +37,7 @@ #:use-module (guix modules) #:use-module (guix packages) #:use-module (guix records) + #:use-module (ice-9 match) #:export (tissue-service-type <tissue-configuration> tissue-configuration @@ -46,14 +50,19 @@ tissue-host tissue-host? tissue-host-name - tissue-host-user - tissue-host-upstream-repository)) + tissue-host-projects + <tissue-project> + tissue-project + tissue-project-name + tissue-project-user + tissue-project-base-path + tissue-project-upstream-repository)) ;; Run an updated version of tissue until the the 0.1.1 release is ;; out. (define-public tissue - (let ((commit "0c3d6cb7d781fbc0c12eba1563cc7b7ebb370ba9") - (revision "1")) + (let ((commit "a9187595cccca4954c7d4920b93b922ea190e179") + (revision "2")) (package (inherit guix:tissue) (name "tissue") @@ -66,7 +75,7 @@ (file-name (git-file-name name version)) (sha256 (base32 - "0hdqa5n8dm2nc4ccx39xclgajv3ivwpb1hbz9kpbbv25iizqhnv2")))) + "0pgdznck8vwmbccmpcqd3xnikbgzb2phxik7bcm80dls6g4n3py2")))) (inputs (modify-inputs (package-inputs guix:tissue) (replace "guile-git" guile-git)))))) @@ -88,9 +97,22 @@ tissue-host make-tissue-host tissue-host? (name tissue-host-name) - (user tissue-host-user + (projects tissue-host-projects + (default '()))) + +(define-record-type* <tissue-project> + tissue-project make-tissue-project + tissue-project? + this-tissue-project + (name tissue-project-name) + (user tissue-project-user (default "tissue")) - (upstream-repository tissue-host-upstream-repository)) + (base-path tissue-project-base-path + (default (string-append "/" + (tissue-project-name this-tissue-project) + "/")) + (thunked)) + (upstream-repository tissue-project-upstream-repository)) (define %tissue-accounts (list (user-account @@ -105,6 +127,19 @@ (system? #t)))) (define (tissue-conf-gexp config) + (define project->alist + (match-record-lambda <tissue-project> + (name base-path upstream-repository) + `(,name + (base-path . ,base-path) + (upstream-repository . ,upstream-repository)))) + + (define host->alist + (match-record-lambda <tissue-host> + (name projects) + `(,name + (projects . ,(map project->alist projects))))) + (match-record config <tissue-configuration> (socket state-directory hosts) #~(begin @@ -129,11 +164,7 @@ "Socket must be a <forge-ip-socket> or <forge-unix-socket> record") (make-irritants-condition socket)))))) (state-directory . #$state-directory) - (hosts . #$(map (lambda (host) - (match-record host <tissue-host> - (name upstream-repository) - `(,name (upstream-repository . ,upstream-repository)))) - hosts))) + (hosts . #$(map host->alist hosts))) port)))))) ;; We cannot just pass the configuration file on the command-line @@ -162,22 +193,23 @@ ;; the tissue user. (mkdir-p #$state-directory) (chown #$state-directory (passwd:uid user) (passwd:gid user))) - ;; Create host directories if they don't exist, and set - ;; permissions. Each host directory may be owned by its own - ;; user. + ;; Create project directories if they don't exist, and set + ;; permissions. Each project directory may be owned by its + ;; own user. (for-each (match-lambda - ((hostname username) - (let ((host-directory (string-append #$state-directory "/" hostname)) + ((project-name username) + (let ((project-directory (string-append #$state-directory "/" project-name)) (user (getpw username))) - (mkdir-p host-directory) + (mkdir-p project-directory) (for-each (lambda (file) (chown file (passwd:uid user) (passwd:gid user))) - (find-files host-directory #:directories? #t))))) - '#$(map (lambda (host) - (match-record host <tissue-host> - (name user) - (list name user))) - hosts)))))) + (find-files project-directory #:directories? #t))))) + '#$(append-map (lambda (host) + (map (match-record-lambda <tissue-project> + (name user) + (list name user)) + (tissue-host-projects host))) + hosts)))))) (define (tissue-shepherd-service config) (match-record config <tissue-configuration> @@ -216,6 +248,58 @@ #: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}." + (define (project->location state-directory project) + (nginx-location-configuration + (uri (tissue-project-base-path project)) + (body (list (string-append "alias " + state-directory + "/" + (tissue-project-name project) + "/website/;") + "try_files $uri $uri.html $uri/ @tissue-search;")))) + + (match-record config <tissue-configuration> + (socket state-directory hosts) + (map (match-record-lambda <tissue-host> + (name projects) + (nginx-server-configuration + (server-name (list name)) + (locations + (cons (nginx-location-configuration + (uri "@tissue-search") + (body (list (socket->proxy-pass socket) + "proxy_set_header Host $host;"))) + (append (map (cut project->location state-directory <>) + projects) + ;; Reject all other locations, unless there + ;; is a project with / as its base path. + (if (member "/" (map tissue-project-base-path + projects)) + (list) + (list (nginx-location-configuration + (uri "/") + (body (list "return 404;")))))))))) + hosts))) + (define tissue-service-type (service-type (name 'tissue) @@ -228,7 +312,9 @@ (service-extension activation-service-type tissue-activation) (service-extension shepherd-root-service-type - (compose list tissue-shepherd-service)))) + (compose list tissue-shepherd-service)) + (service-extension forge-nginx-service-type + tissue-nginx-server-blocks))) (compose concatenate) (extend (lambda (config host-extensions) (tissue-configuration @@ -27,7 +27,7 @@ #:indexed-documents (append (map (lambda (filename) (slot-set (read-gemtext-issue filename) 'web-uri - (string-append "/" (string-remove-suffix ".gmi" filename)))) + (string-append "/guix-forge/" (string-remove-suffix ".gmi" filename)))) (gemtext-files-in-directory "issues")) (map (lambda (identifier) (slot-set (document-fragment "doc/forge.skb" identifier) diff --git a/website/index.skb b/website/index.skb index e92fa65..aeaaafa 100644 --- a/website/index.skb +++ b/website/index.skb @@ -45,7 +45,7 @@ :line #f)) (section :title "Documentation" :number #f - (p [The ,(ref :url "/manual/dev/en/" :text "guix-forge manual") is available online.])) + (p [The ,(ref :url "/guix-forge/manual/dev/en/" :text "guix-forge manual") is available online.])) (section :title "Philosophy" :number #f (p [In order to empower ordinary users, software should not just be free (as in freedom), but also be simple and easy to deploy, especially for small-scale deployments. ,(emph [guix-forge]) is therefore minimalistic, and does not require running large database servers such as MariaDB and PostgreSQL.]) |