diff options
| -rw-r--r-- | doc/forge.skb | 53 | ||||
| -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 | 5 | ||||
| -rw-r--r-- | guix/forge/forge.scm | 57 | ||||
| -rw-r--r-- | guix/forge/guile-git.scm | 14 | ||||
| -rw-r--r-- | guix/forge/gunicorn.scm | 5 | ||||
| -rw-r--r-- | guix/forge/klaus.scm | 20 | ||||
| -rw-r--r-- | guix/forge/tissue.scm | 138 | ||||
| -rw-r--r-- | tissue.scm | 2 | ||||
| -rw-r--r-- | website/index.skb | 2 |
12 files changed, 278 insertions, 65 deletions
diff --git a/doc/forge.skb b/doc/forge.skb index 4f861dd..2538401 100644 --- a/doc/forge.skb +++ b/doc/forge.skb @@ -1,5 +1,5 @@ ;;; 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. @@ -292,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 @@ -516,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])) @@ -533,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 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 624fa31..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,6 +29,7 @@ #: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) @@ -39,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? @@ -53,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? @@ -77,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 @@ -95,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 '()))) @@ -437,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. @@ -526,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/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 cd9fa5f..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, 2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2024 jgart <jgart@dismail.de> ;;; ;;; This file is part of guix-forge. ;;; @@ -23,6 +24,8 @@ #: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) @@ -39,15 +42,18 @@ (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 @@ -57,13 +63,13 @@ routes using HTTP Digest Authentication.") (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 @@ -88,7 +94,9 @@ routes using HTTP Digest Authentication.") ;; 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.]) |