diff options
| -rw-r--r-- | .guix-channel | 3 | ||||
| -rw-r--r-- | NEWS | 44 | ||||
| -rw-r--r-- | README.org | 8 | ||||
| -rw-r--r-- | doc/forge.skb | 184 | ||||
| -rw-r--r-- | doc/skribilo.scm | 28 | ||||
| -rw-r--r-- | guix/forge/acme.scm | 17 | ||||
| -rw-r--r-- | guix/forge/anubis.scm | 142 | ||||
| -rw-r--r-- | guix/forge/cgit.scm | 162 | ||||
| -rw-r--r-- | guix/forge/fcgiwrap.scm | 13 | ||||
| -rw-r--r-- | guix/forge/forge.scm | 303 | ||||
| -rw-r--r-- | guix/forge/git.scm | 43 | ||||
| -rw-r--r-- | guix/forge/guile-git.scm | 14 | ||||
| -rw-r--r-- | guix/forge/gunicorn.scm | 17 | ||||
| -rw-r--r-- | guix/forge/klaus.scm | 204 | ||||
| -rw-r--r-- | guix/forge/laminar.scm | 20 | ||||
| -rw-r--r-- | guix/forge/nginx.scm | 223 | ||||
| -rw-r--r-- | guix/forge/tissue.scm | 122 | ||||
| -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-- | issues/automatic-importer-for-github-projects.gmi | 7 | ||||
| -rw-r--r-- | manifest.scm | 92 | ||||
| -rw-r--r-- | tissue.scm | 64 | ||||
| -rw-r--r-- | website/index.skb | 6 | ||||
| -rw-r--r-- | website/style.css | 6 |
25 files changed, 1311 insertions, 564 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..d64f0a1 --- /dev/null +++ b/NEWS @@ -0,0 +1,44 @@ +;;; -*- lisp-data -*- +;;; guix-forge --- Guix software forge meta-service +;;; Copyright © 2025, 2026 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 "இவ்வலைவரிசையில் இப்போது செய்திகள் உள்ளன. வருங்காலத்தில் சொல்வதற்கு ஏதாவது +இருக்கமென நம்புகிறோம்!"))) + (entry (commit "3bf70c5c6d51ecdc9fc3671b483c00cf3a90ceb4") + (title (en "New Anubis service") + (ta "புதிய Anubis பணி")) + (body (en "We have a new Anubis package and service. @code{<forge-nginx-server-configuration>} now comes with a new @code{anubis?} field to enable Anubis protection.") + (ta "அறிமுகம் புதிய Anubis நிரல்பொதியும் பணியும். Anubis பாதுகாப்பை அமைக்க @code{<forge-nginx-server-configuration>} @code{anubis?} என்னும் புதிய களத்தைப் பெற்றது."))) + (entry (commit "321bfd3891c23fceba2660ff68a17febb6083465") + (title (en "cgit now has Anubis protection") + (ta "cgit Anubis பாதுகாப்பு பெற்றது")) + (body (en "cgit now has Anubis protection. Hopefully that will make the onslaught of AI crawlers more bearable.") + (ta "cgit Anubis பாதுகாப்பு பெற்றது. செயற்கை நுண்ணறிவு இயலிகளின் கொடுமைகளைக் கட்டுப்படுத்த உதவுமென நம்புகிறோம்."))) + (entry (commit "685db9d6fd90b76a8314a21328217039932b6070") + (title (en "cgit source filter default switched from Pygments to Chroma") + (ta "cgit source filter இயனிலை Pygments உரைநிரலிலிருந்து Chroma நிரலுக்கு மாறியது")) + (body (en "The default source filter of the cgit service now uses Chroma instead of Pygments. Hopefully, this will improve performance and hold up better under heavy load; a must-have in the age of rampant AI crawlers") + (ta "cgit பணியின் இயனிலை source filter Pygments உரைநிரலிலிருந்து Chroma நிரலுக்கு மாற்றப்பட்டது. இது விரைவாற்றலை மேம்படுத்தி பெருஞ்சுமைகளைத் தாங்க உதவும்; செயற்கை நுண்ணறிவு இயலிகளினால் கண்டிப்பாக இதுத் தேவை.")))) diff --git a/README.org b/README.org index 4e35282..dc89125 100644 --- a/README.org +++ b/README.org @@ -4,10 +4,10 @@ /guix-forge/ integrates the following software components: -- [X] [[https://laminar.ohwg.net][laminar]] for continuous integration -- [ ] web server to serve static project sites -- [ ] [[https://git.zx2c4.com/cgit/][cgit]] to serve project git repositories on the web -- [ ] [[https://public-inbox.org/README.html][public-inbox]] for project discussions +- [[https://laminar.ohwg.net][laminar]] for continuous integration +- web server to serve static project sites +- [[https://git.zx2c4.com/cgit/][cgit]] to serve project git repositories on the web +- [[https://public-inbox.org/README.html][public-inbox]] for project discussions A choice of different software components may be offered provided it does not complicate the interface too much. diff --git a/doc/forge.skb b/doc/forge.skb index 99d1b86..607ef39 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–2026 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2024 Frederick M. Muriithi <fredmanglis@protonmail.com> ;;; ;;; This file is part of guix-forge. ;;; @@ -237,12 +238,14 @@ web. Our cgit service features] (itemize (item [clonable URLs via the smart HTTP protocol through ,(command [git-http-backend])]) - (item [syntax highlighting for a wide variety of -programming languages using ,(ref :url "https://pygments.org/" :text -"Pygments")]) + (item [syntax highlighting for a wide variety of programming +languages using ,(ref :url "https://github.com/alecthomas/chroma" :text +"Chroma")]) (item [rendering markdown, org mode, reStructuredText, man page, HTML or plain text README files in the ,(emph [About]) page]) - (item [hiding full email addresses on cgit web pages])) + (item [hiding full email addresses on cgit web pages]) + (item [,(ref :url "https://anubis.techaro.lol/" :text "Anubis") +protection for expensive endpoints])) [Note that this service is different from the cgit service of the same name in Guix upstream.]) (description @@ -290,7 +293,66 @@ 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]) + (record-field "fcgiwrap-processes" + [Number of fcgiwrap worker processes])))) + (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]) + (record-field "gunicorn-workers" + [Number of gunicorn worker processes]))))) + (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 @@ -322,6 +384,10 @@ with the following in the ,(code [sudoers-file]) field of your ,(code [Socket to listen on for HTTPS requests. Socket may be a ,(record-ref "<forge-host-socket>"), ,(record-ref "<forge-ip-socket>"), or ,(record-ref "<forge-unix-socket>") object.]) + (record-field "proxy-protocol-listen" + [Optional socket to listen on for PROXY protocol requests. Socket may +be a ,(record-ref "<forge-host-socket>"), ,(record-ref "<forge-ip-socket>"), or +,(record-ref "<forge-unix-socket>") object. Disable if ,(code "#f").]) (record-field "acme-state-directory" [State directory of the ,(ref :ident "section-acme-service" :text "ACME service")]) @@ -330,10 +396,45 @@ with the following in the ,(code [sudoers-file]) field of your ,(code [/.well-known/acme-challenge/]) in response to ACME HTTP-01 challenges]) (record-field "server-blocks" - [List of ,(ref :url + [List of ,(ref :ident "<forge-nginx-server-configuration>" :text +"<forge-nginx-server-configuration>") or ,(ref :url "https://guix.gnu.org/manual/en/html_node/Web-Services.html#index-nginx_002dserver_002dconfiguration" -:text "<nginx-server-configuration>") objects describing server blocks -to add to the nginx configuration])))) +:text "<nginx-server-configuration>") objects describing server blocks to add to +the nginx configuration])) + (record-documentation "guix/forge/nginx.scm" '<forge-nginx-server-configuration> + (record-field "server-name" + [List of server names this server represents. ,(code ['default]) +represents the default server for connections matching no other server.]) + (record-field "root" + [Root of the website nginx will serve]) + (record-field "locations" + [List of ,(ref :url +"https://guix.gnu.org/manual/devel/en/html_node/Web-Services.html#index-nginx_002dlocation_002dconfiguration" +:text (code [nginx-location-configuration])) or ,(ref :url +"https://guix.gnu.org/manual/devel/en/html_node/Web-Services.html#index-nginx_002dnamed_002dlocation_002dconfiguration" +:text (code [nginx-named-location-configuration])) records to use within this +server block.]) + (record-field "index" + [List of index files to look for when clients ask for a directory. If it +cannot be found, nginx will send the list of files in the directory.]) + (record-field "try-files" + [List of files whose existence is checked in the specified order. +nginx will use the first file it finds to process the request.]) + (record-field "anubis?" + [If ,(code [#t]), ,(ref :url +"https://anubis.techaro.lol/docs/admin/configuration/subrequest-auth/" :text +"Anubis subrequest authentication") locations are added to the server +configuration. These are namely a ,(samp "/.within.website/") location and a +,(samp "@redirectToAnubis") location. Locations to be protected by Anubis should +specify ,(code "auth_request /.within.website/x/cmd/anubis/api/check; error_page +401 = @redirectToAnubis;"). To use this feature, ,(code [nginx-service-type]) +must be configured with an nginx compiled with ,(samp +[--with-http_auth_request_module]). The ,(code [nginx-with-auth-request]) +package is provided as a convenience for this purpose.]) + (record-field "raw-content" + [List of strings or file-like objects to be appended to the server +block. Each item is prefixed with indentation and suffixed with a new line. +Nested lists are flattened.])))) (section :title [ACME service] :ident "section-acme-service" (p [,(abbr :short "ACME" :long "Automatic Certificate Management @@ -467,6 +568,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 +596,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 @@ -501,7 +606,20 @@ environment]) (record-field "mappings" [List of ,(code [<file-system-mapping>]) objects describing additional directories that should be shared with the container -gunicorn is run in])))))) +gunicorn is run in]))))) + (section :title [Anubis AI firewall service] + :ident "section-anubis-ai-firewall-service" + (p [Anubis is a web AI firewall utility that uses a combination of +heuristics and challenges to identify and block bots before they take your +website down. Anubis is as lightweight as possible and is designed to help +protect the small internet from the endless storm of requests that flood in from +AI companies. This service runs Anubis in ,(ref :url +"https://anubis.techaro.lol/docs/admin/configuration/subrequest-auth/" :text +"subrequest authentication mode").]) + (description + (record-documentation "guix/forge/anubis.scm" '<anubis-configuration> + (record-field "package" + [,(code [anubis]) package to use]))))) (chapter :title [Reference] :ident "chapter-reference" (description @@ -511,6 +629,26 @@ gunicorn is run in])))))) (record-field "value" [Its value])) (record-documentation "guix/forge/forge.scm" '<forge-configuration> + (record-field "web-domain" + [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])) @@ -528,14 +666,19 @@ 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 "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 "web-domain" + [Domain name to serve project website on]) + (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" @@ -555,6 +698,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]) @@ -606,5 +753,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/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..f78eedc 100644 --- a/guix/forge/acme.scm +++ b/guix/forge/acme.scm @@ -1,5 +1,7 @@ ;;; 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> +;;; Copyright © 2025 Frederick M. Muriithi <fredmanglis@protonmail.com> ;;; ;;; This file is part of guix-forge. ;;; @@ -20,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) @@ -73,7 +75,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 +85,7 @@ (file-name (git-file-name name version)) (sha256 (base32 - "1jhjyjnrfq07qgslmz1qpka1ahnmpya2garbxldkh2fr0bmsn26b")))) + "1br374d0lnn422rvg2g4m69vhdck8aihdsjydr064hif0lscr8ri")))) (build-system gnu-build-system) (arguments (list #:phases @@ -332,9 +334,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/anubis.scm b/guix/forge/anubis.scm new file mode 100644 index 0000000..63f7a54 --- /dev/null +++ b/guix/forge/anubis.scm @@ -0,0 +1,142 @@ +;;; guix-forge --- Guix software forge meta-service +;;; Copyright © 2026 Ashish Shukla <ashish.is@lostca.se> +;;; Copyright © 2026 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 anubis) + #:use-module ((gnu packages golang) #:select (go-1.26)) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu system file-systems) + #:use-module (guix build-system gnu) + #:use-module (guix download) + #:use-module (guix gexp) + #:use-module (guix least-authority) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (ice-9 match) + #:export (anubis-configuration + anubis-configuration? + anubis-configuration-package + anubis-service-type + %anubis-unix-socket)) + +;; TODO: Unbundle vendored node and go dependencies. See work in progress at +;; https://codeberg.org/guix/guix/pulls/2572 +;; This package is based on https://codeberg.org/group/guix-modules/src/commit/137fe9d6dcdad1582c64a70c6f8a052c9251a590/guix/abbe/packages/golang.scm#L902 +(define-public anubis-ai-firewall + (package + (name "anubis-ai-firewall") + (version "1.26.2") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/TecharoHQ/anubis/releases/download/v" + version "/anubis-src-vendor-npm-" version ".tar.gz")) + (sha256 + (base32 "1yab3z58vgi16313wmx7g32xk6nv158lqic54qds43l63y6lmf92")))) + (build-system gnu-build-system) + (arguments + (list #:phases + #~(modify-phases %standard-phases + (delete 'configure) + (add-after 'unpack 'patch-Makefile + (lambda _ + (substitute* "Makefile" + (("\\(GO\\) build" all) + (string-append all " -trimpath"))))) + (replace 'build + (lambda _ + (let ((tmpdir "/tmp")) + (setenv "TMPDIR" tmpdir) + (setenv "GOPATH" (string-append tmpdir "/go")) + (setenv "GOCACHE" (string-append tmpdir "/go-cache")) + (invoke "make" "prebaked-build")))) + (replace 'check + (lambda* (#:key tests? #:allow-other-keys) + (when tests? + (invoke "go" "test" "./..." + ;; This test requires network access. + "-skip" "TestLookup")))) + (replace 'install + (lambda _ + (install-file "var/anubis" + (string-append #$output "/bin"))))))) + (native-inputs + (list go-1.26)) + (home-page "https://anubis.techaro.lol/") + (synopsis "Identify and block HTTP requests from AI bots") + (description + "Anubis is a web AI firewall utility that uses a combination of heuristics +and challenges to identify and block bots before they take your website down. +Anubis is as lightweight as possible and is designed to help protect the small +internet from the endless storm of requests that flood in from AI companies.") + (license license:expat))) + +(define-record-type* <anubis-configuration> + anubis-configuration make-anubis-configuration + anubis-configuration? + (package anubis-configuration-package + (default anubis-ai-firewall))) + +;; TODO: Do not hard-code. +(define %anubis-unix-socket + "/var/run/anubis/socket") + +(define (anubis-activation config) + #~(begin + (let ((user (getpw "nginx"))) + (mkdir-p (dirname #$%anubis-unix-socket)) + (chown (dirname #$%anubis-unix-socket) + (passwd:uid user) + (passwd:gid user))))) + +(define anubis-shepherd-service + (match-lambda + (($ <anubis-configuration> package) + (shepherd-service + (documentation "Run the Anubis AI firewall.") + (provision '(anubis)) + (requirement '(networking)) + (start #~(make-forkexec-constructor + (list #$(least-authority-wrapper + (file-append package "/bin/anubis") + #:name "anubis-pola-wrapper" + #:mappings (list (file-system-mapping + (source (dirname %anubis-unix-socket)) + (target source) + (writable? #t)))) + "-bind" #$%anubis-unix-socket + "-bind-network" "unix" + "-target" " ") + #:user "nginx" + #:group "nginx" + #:log-file "/var/log/anubis.log")) + (stop #~(make-kill-destructor)))))) + +(define anubis-service-type + (service-type + (name 'anubis) + (description "Run the Anubis AI firewall.") + (extensions + (list (service-extension activation-service-type + anubis-activation) + (service-extension shepherd-root-service-type + (compose list anubis-shepherd-service)))) + (default-value (anubis-configuration)))) diff --git a/guix/forge/cgit.scm b/guix/forge/cgit.scm index 805f47f..a607f5f 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–2026 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -20,17 +20,23 @@ (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)) #:use-module ((gnu packages mail) #:select (mailcap)) + #:use-module ((gnu packages golang-apps) #:select (go-chroma)) #: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)) + nginx-location-configuration + nginx-named-location-configuration + nginx-named-location-configuration-body)) #:use-module (gnu system file-systems) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (ice-9 match) #:use-module (srfi srfi-26) @@ -53,6 +59,7 @@ cgit-configuration-repository-sort cgit-configuration-plain-email? cgit-configuration-extra-options + cgit-configuration-fcgiwrap-processes cgit-service-type)) (define %cgit-readme @@ -66,14 +73,29 @@ "README.txt" "README"))) +(define %cgit-chroma-syntax-highlight-gexp + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (match (command-line) + ((_ file) + (invoke #$(file-append go-chroma "/bin/chroma") + "--style" "pastie" + "--html" + "--html-only" + "--html-inline-styles" + "--filename" file)))))) + (define-record-type* <cgit-configuration> cgit-configuration make-cgit-configuration cgit-configuration? this-cgit-configuration (cgit cgit-configuration-cgit - (default cgit)) + (default cgit-pink)) (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")) @@ -89,15 +111,18 @@ (about-filter cgit-configuration-about-filter (default (program-file "about-filter" (about-filter-gexp this-cgit-configuration))) + ;; thunked so that value can reference the cgit package in + ;; configuration (thunked)) (commit-filter cgit-configuration-commit-filter (default #f)) (email-filter cgit-configuration-email-filter (default #f)) (source-filter cgit-configuration-source-filter - (default (file-append (cgit-configuration-cgit - this-cgit-configuration) - "/lib/cgit/filters/syntax-highlighting.py")) + (default (program-file "cgit-chroma-syntax-highlight" + %cgit-chroma-syntax-highlight-gexp)) + ;; thunked so that value can reference the cgit package in + ;; configuration (thunked)) (mimetype-file cgit-configuration-mimetype-file (default (file-append mailcap "/etc/mime.types"))) @@ -107,16 +132,18 @@ (plain-email? cgit-configuration-noplainemail? (default #false)) (extra-options cgit-configuration-extra-options - (default '()))) + (default '())) + (fcgiwrap-processes cgit-configuration-fcgiwrap-processes + (default #~(* 2 (total-processor-count))))) (define (sanitize-cgit-snapshots snapshots) (let ((valid-snapshots (list "tar" "tar.gz" "tar.bz2" "tar.lz" "tar.xz" "tar.zst" "zip"))) (for-each (lambda (snapshot) (unless (member snapshot valid-snapshots) - (leave (G_ "Snapshot ~a is not one of ~s.~%" - snapshot - valid-snapshots)))) + (leave (G_ "Snapshot ~a is not one of ~s.~%") + snapshot + valid-snapshots))) snapshots) snapshots)) @@ -221,73 +248,88 @@ configured in @var{config}." (define (cgit-fcgiwrap-instance config) (match-record config <cgit-configuration> - (cgit git repository-directory) + (cgit git repository-directory fcgiwrap-processes) (let ((cgitrc (computed-file "cgitrc" (cgitrc-gexp config)))) (fcgiwrap-instance (name "cgit") (user "nginx") (group "nginx") + (processes fcgiwrap-processes) (environment-variables (list (environment-variable (name "CGIT_CONFIG") (value cgitrc)))) (mappings (list (file-system-mapping - (source repository-directory) - (target source)) + (source repository-directory) + (target source)) (file-system-mapping - (source cgit) - (target source)) + (source cgit) + (target source)) (file-system-mapping - (source cgitrc) - (target source)) + (source cgitrc) + (target source)) (file-system-mapping - (source (file-append git "/libexec/git-core/git-http-backend")) - (target source)))))))) + (source (file-append git "/libexec/git-core/git-http-backend")) + (target source)))))))) (define cgit-nginx-server-block (match-record-lambda <cgit-configuration> - (cgit git server-name socket repository-directory) - (nginx-server-configuration + (cgit git server-name socket repository-directory) + (forge-nginx-server-configuration (server-name (list server-name)) ;; cgit static files (root (file-append cgit "/share/cgit")) - (try-files (list "$uri" "@cgit")) + (anubis? #t) (locations - (list - ;; git-http-backend for the smart HTTP protocol - (nginx-location-configuration - (uri "~ ^/.*/(HEAD|info/refs|git-receive-pack|git-upload-pack).*$") - (body (list "fastcgi_param SCRIPT_FILENAME " - (file-append git "/libexec/git-core/git-http-backend;") - (string-append "fastcgi_param GIT_PROJECT_ROOT " - repository-directory - ";") - "fastcgi_param GIT_HTTP_EXPORT_ALL yes;" - "fastcgi_param PATH_INFO $uri;" - "fastcgi_param QUERY_STRING $query_string;" - "fastcgi_param REQUEST_METHOD $request_method;" - "fastcgi_param CONTENT_TYPE $content_type;" - (string-append "fastcgi_pass " - (nginx-socket->string socket) - ";")))) - ;; cgit web interface - (nginx-location-configuration - (uri "@cgit") - (body (list - #~(string-append "fastcgi_param SCRIPT_FILENAME " - #$(file-append cgit "/lib/cgit/cgit.cgi") - ";") - "fastcgi_param PATH_INFO $uri;" - "fastcgi_param QUERY_STRING $query_string;" - "fastcgi_param HTTP_HOST $server_name;" - (string-append "fastcgi_pass " - (nginx-socket->string socket) - ";"))))))))) + (let ((cgit-location + (nginx-named-location-configuration + (name "cgit") + (body (list + #~(string-append "fastcgi_param SCRIPT_FILENAME " + #$(file-append cgit "/lib/cgit/cgit.cgi") + ";") + "fastcgi_param PATH_INFO $uri;" + "fastcgi_param QUERY_STRING $query_string;" + "fastcgi_param HTTP_HOST $server_name;" + (string-append "fastcgi_pass " + (nginx-socket->string socket) + ";")))))) + (list + ;; git-http-backend for the smart HTTP protocol + (nginx-location-configuration + (uri "~ ^/.*/(HEAD|info/refs|git-receive-pack|git-upload-pack).*$") + (body (list "fastcgi_param SCRIPT_FILENAME " + (file-append git "/libexec/git-core/git-http-backend;") + (string-append "fastcgi_param GIT_PROJECT_ROOT " + repository-directory + ";") + "fastcgi_param GIT_HTTP_EXPORT_ALL yes;" + "fastcgi_param PATH_INFO $uri;" + "fastcgi_param QUERY_STRING $query_string;" + "fastcgi_param REQUEST_METHOD $request_method;" + "fastcgi_param CONTENT_TYPE $content_type;" + (string-append "fastcgi_pass " + (nginx-socket->string socket) + ";")))) + ;; cgit web interface + cgit-location + ;; Protect the commit, diff and tree URIs behind Anubis. + (nginx-location-configuration + (uri "~ ^/.*/(diff|tree)/") + (body (cons* "auth_request /.within.website/x/cmd/anubis/api/check;" + "error_page 401 = @redirectToAnubis;" + (nginx-named-location-configuration-body cgit-location)))) + ;; On other URIs, try a file before falling back to @cgit. This + ;; try_files cannot be in the server context because it would then + ;; apply to git-http-backend, etc. + (nginx-location-configuration + (uri "/") + (body (list "try_files $uri @cgit;"))))))))) (define cgit-service-type (service-type - (name 'cgit) - (description "Run cgit.") - (extensions (list (service-extension fcgiwrap-service-type - (compose list cgit-fcgiwrap-instance)) - (service-extension forge-nginx-service-type - (compose list cgit-nginx-server-block)))))) + (name 'cgit) + (description "Run cgit.") + (extensions (list (service-extension fcgiwrap-service-type + (compose list cgit-fcgiwrap-instance)) + (service-extension forge-nginx-service-type + (compose list cgit-nginx-server-block)))))) diff --git a/guix/forge/fcgiwrap.scm b/guix/forge/fcgiwrap.scm index f699480..8915f66 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–2026 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -65,7 +65,7 @@ (user fcgiwrap-instance-user) (group fcgiwrap-instance-group) (processes fcgiwrap-instance-processes - (default 1)) + (default #~(* 2 (total-processor-count)))) (environment-variables fcgiwrap-instance-environment-variables (default '())) (mappings fcgiwrap-instance-mappings @@ -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 @@ -112,7 +113,8 @@ (documentation (string-append "Run fcgiwrap for " name " script.")) (provision '(fcgiwrap)) (requirement '(networking)) - (modules '((ice-9 match))) + (modules '((ice-9 match) + (ice-9 threads))) ; for total-processor-count and others (start #~(make-forkexec-constructor (list #$(least-authority-wrapper @@ -137,7 +139,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..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–2024 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2021–2025 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2025 Frederick M. Muriithi <fredmanglis@protonmail.com> ;;; ;;; This file is part of guix-forge. ;;; @@ -21,15 +22,19 @@ #: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) #: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 +43,21 @@ #: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? + 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? @@ -52,9 +66,13 @@ forge-project-user forge-project-repository forge-project-repository-branch - forge-project-website-directory + forge-project-web-domain + 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 variable-specification? @@ -76,8 +94,13 @@ (default "main")) (description forge-project-description (default #f)) - (website-directory forge-project-website-directory - (default #f)) + (web-domain forge-project-web-domain + (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 @@ -88,15 +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." @@ -136,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)))) @@ -156,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. @@ -179,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) @@ -193,8 +295,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,17 +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}." + (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-project-all-ci-jobs project config) + "Return list of all CI jobs for @var{project} in forge configuration +@var{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 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. - (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) @@ -463,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 @@ -492,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))) @@ -510,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))) @@ -524,6 +760,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 @@ -537,5 +777,4 @@ value is a list of @code{<webhook-hook>} objects." (forge-configuration (inherit config) (projects (append (forge-configuration-projects config) - projects))))) - (default-value (forge-configuration)))) + projects))))))) 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..1650a4d 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–2026 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)) @@ -76,7 +78,9 @@ "/socket"))))) (thunked)) (workers gunicorn-app-workers - (default 1)) + (default #~(* 2 (total-processor-count)))) + (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 @@ -146,7 +151,8 @@ (provision (list (string->symbol name))) (requirement '(networking)) (modules '((guix search-paths) - (ice-9 match))) + (ice-9 match) + (ice-9 threads))) ; for total-processor-count and others (start (let* ((app-manifest (packages->manifest ;; Using python-minimal in the @@ -185,7 +191,7 @@ ;; network namespace. We can't do this yet due to ;; https://yhetil.org/guix/m1ilknoi5r.fsf@fastmail.net/ #:namespaces (delq 'net %namespaces)) - "--workers" #$(number->string (gunicorn-app-workers app)) + "--workers" (number->string #$(gunicorn-app-workers app)) "--timeout" #$(number->string (gunicorn-app-timeout app)) (list #$@(append (append-map (lambda (socket) (list "--bind" @@ -197,6 +203,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..157a974 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–2026 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2024 jgart <jgart@dismail.de> ;;; ;;; This file is part of guix-forge. ;;; @@ -19,116 +20,123 @@ (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 nginx) #:use-module (forge socket) - #:use-module ((gnu packages check) #:select (python-nose python-pytest)) - #: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)) + #: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 deprecation) #: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") - (source (origin - (method url-fetch) - (uri (pypi-uri "httpauth" version)) - (sha256 - (base32 - "0qas7876igyz978pgldp5r7n7pis8n4vf0v87gxr9l7p7if5lr3l")))) - (build-system pyproject-build-system) - (native-inputs (list python-nose)) - (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"))))))))) + #: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-configuration-gunicorn-workers + klaus-service-type + klaus-gunicorn-app)) (define-public python-klaus (package - (name "python-klaus") - (version "2.0.3") - (source (origin - (method url-fetch) - (uri (pypi-uri "klaus" version)) - (sha256 - (base32 - "1y06xnynfah5d4zif2fc0n83zdr0d1vkh0rwcinsi6wjxalvnhjw")))) - (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 - (list git-without-safe-directory-check)) - (native-inputs - (list python-pytest)) + ;; 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)) + (gunicorn-workers klaus-configuration-gunicorn-workers + (default #~(* 2 (total-processor-count))))) + +(define klaus-gunicorn-apps + (match-record-lambda <klaus-configuration> + (python-klaus socket repository-directory site-name gunicorn-workers) + (list (gunicorn-app + (name "klaus") + (package python-klaus) + (wsgi-app-module "klaus.contrib.wsgi_autoreload") + (sockets (list socket)) + (workers gunicorn-workers) + (environment-variables (cons* (environment-variable + (name "KLAUS_REPOS_ROOT") + (value repository-directory)) + (environment-variable + (name "KLAUS_USE_SMARTHTTP") + (value "1")) + (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 + ;; Based on + ;; https://github.com/jonashaag/klaus/wiki/Klaus-behind-a-reverse-proxy#nginx-example + (list (nginx-location-configuration + (uri "/") + (body (list (socket->nginx-proxy-pass socket) + ;; Pass in the host, scheme and header fields of + ;; the original request. + "proxy_pass_request_headers on;" + "proxy_set_header X-Forwarded-Proto $scheme;" + "proxy_set_header Host $host;"))))))))) -@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..74789be 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–2026 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -21,6 +21,7 @@ #:use-module (gnu) #:use-module (srfi srfi-1) #:use-module (gnu packages ci) + #:use-module ((gnu packages guile) #:select (guile-3.0-latest)) #:use-module (gnu services ci) #:use-module (guix records) #:use-module (ice-9 match) @@ -119,11 +120,14 @@ of @var{<forge-laminar-job>} objects." (let ((name (forge-laminar-job-name job))) `(,(let ((run-name (string-append name ".run"))) `(,run-name ,(program-file run-name - (forge-laminar-job-run job)))) + (forge-laminar-job-run job) + #:guile guile-3.0-latest))) ,@(let ((after (forge-laminar-job-after job)) (after-name (string-append name ".after"))) (if after - `((,after-name ,(program-file after-name after))) + `((,after-name ,(program-file after-name + after + #:guile guile-3.0-latest))) '())) ,@(match (forge-laminar-job-contexts job) (() '()) @@ -164,7 +168,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..87ad222 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–2026 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of guix-forge. ;;; @@ -19,12 +19,16 @@ (define-module (forge nginx) #:use-module (forge acme) + #:use-module (forge anubis) #:use-module (forge socket) #:use-module ((gnu packages admin) #:select (shepherd)) + #:use-module ((gnu packages web) #:select (nginx)) #:use-module (gnu services) #:use-module (gnu services web) + #:use-module (guix packages) #:use-module (guix gexp) #:use-module (guix records) + #:use-module (guix utils) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:export (<forge-nginx-configuration> @@ -32,12 +36,35 @@ forge-nginx-configuration? forge-nginx-configuration-http-listen forge-nginx-configuration-https-listen + forge-nginx-configuration-proxy-protocol-listen forge-nginx-configuration-acme-state-directory forge-nginx-configuration-acme-challenge-directory forge-nginx-configuration-server-blocks + + <forge-nginx-server-configuration> + forge-nginx-server-configuration + forge-nginx-server-configuration? + forge-nginx-server-configuration-server-name + forge-nginx-server-configuration-root + forge-nginx-server-configuration-locations + forge-nginx-server-configuration-index + forge-nginx-server-configuration-try-files + forge-nginx-server-configuration-anubis? + forge-nginx-server-configuration-raw-content + nginx-socket->string + socket->nginx-proxy-pass forge-nginx-service-type)) +(define-public nginx-with-auth-request + (package + (inherit nginx) + (arguments + (substitute-keyword-arguments (package-arguments nginx) + ((#:configure-flags flags '()) + #~(cons "--with-http_auth_request_module" + #$flags)))))) + (define-record-type* <forge-nginx-configuration> forge-nginx-configuration make-forge-nginx-configuration forge-nginx-configuration? @@ -49,6 +76,8 @@ (default (forge-ip-socket (ip "0.0.0.0") (port 443)))) + (proxy-protocol-listen forge-nginx-configuration-proxy-protocol-listen + (default #f)) (acme-state-directory forge-nginx-configuration-acme-state-directory (default "/var/lib/acme")) (acme-challenge-directory forge-nginx-configuration-acme-challenge-directory @@ -56,6 +85,24 @@ (server-blocks forge-nginx-configuration-server-blocks (default '()))) +(define-record-type* <forge-nginx-server-configuration> + forge-nginx-server-configuration make-forge-nginx-server-configuration + forge-nginx-server-configuration? + (server-name forge-nginx-server-configuration-server-name + (default (list 'default))) + (root forge-nginx-server-configuration-root + (default "/srv/http")) + (locations forge-nginx-server-configuration-locations + (default '())) + (index forge-nginx-server-configuration-index + (default (list "index.html"))) + (try-files forge-nginx-server-configuration-try-files + (default '())) + (anubis? forge-nginx-server-configuration-anubis? + (default #f)) + (raw-content forge-nginx-server-configuration-raw-content + (default '()))) + (define (nginx-socket->string socket) "Serialize @var{socket} to a string as expected by nginx configuration (for example, in the @code{listen} and @@ -66,50 +113,116 @@ 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-configuration-coerced-server-blocks config) + "Return server blocks in @code{forge-nginx-configuration} @var{config}, all +coerced into @code{<forge-nginx-server-configuration>} objects." + (map (lambda (server) + (if (nginx-server-configuration? server) + (forge-nginx-server-configuration + (server-name (nginx-server-configuration-server-name server)) + (root (nginx-server-configuration-root server)) + (locations (nginx-server-configuration-locations server)) + (index (nginx-server-configuration-index server)) + (try-files (nginx-server-configuration-try-files server)) + (raw-content (nginx-server-configuration-raw-content server))) + server)) + (forge-nginx-configuration-server-blocks config))) + +(define (anubis-locations anubis-socket) + ;; This configuration is based on + ;; https://anubis.techaro.lol/docs/admin/configuration/subrequest-auth + (list (nginx-location-configuration + ;; Reverse proxy to Anubis for authorization and challenges. This + ;; location cannot be internal because clients need to request + ;; challenge pages. + (uri "/.within.website/") + (body (list (socket->nginx-proxy-pass anubis-socket) + "proxy_set_header X-Real-IP $remote_addr;" + "proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for;" + "proxy_set_header Host $http_host;" + "proxy_pass_request_body off;" + "proxy_set_header Content-Length \"\";"))) + ;; Redirect to Anubis challenge if authorization failed. We may be + ;; listening locally on a non-standard port; do not expose that to the + ;; end user. + (nginx-named-location-configuration + (name "redirectToAnubis") + (body (list "port_in_redirect off;" + "return 307 /.within.website/?redir=$scheme://$host$request_uri;"))))) + (define (forge-nginx-server-blocks config) "Return list of nginx server blocks to provision for forge-web service specified by @var{config}." (match-record config <forge-nginx-configuration> - (http-listen https-listen acme-state-directory acme-challenge-directory server-blocks) + (http-listen https-listen proxy-protocol-listen acme-state-directory acme-challenge-directory) (cons (nginx-server-configuration - (listen (list (nginx-socket->string http-listen))) - (locations - (list (nginx-location-configuration - (uri "/.well-known/acme-challenge/") - ;; Without a trailing slash, a 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 - ;; present. Likewise, the trailing slash in - ;; "/.well-known/acme-challenge/" is also - ;; significant. - (body (list (string-append "alias " - (string-trim-right acme-challenge-directory #\/) - "/;")))) - (nginx-location-configuration - (uri "/") - ;; HTTP Strict Transport Security (HSTS) header as - ;; recommended by https://hstspreload.org - (body (list "add_header Strict-Transport-Security \"max-age=63072000; includeSubdomains; preload\";" - "return 301 https://$host$request_uri;")))))) - (map (lambda (server) - (match (nginx-server-configuration-server-name server) + (listen (list (nginx-socket->string http-listen))) + (locations + (list (nginx-location-configuration + (uri "/.well-known/acme-challenge/") + ;; 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 + ;; present. Likewise, the trailing slash in + ;; "/.well-known/acme-challenge/" is also significant. + (body (list (string-append "alias " + (string-trim-right acme-challenge-directory #\/) + "/;")))) + (nginx-location-configuration + (uri "/") + ;; HTTP Strict Transport Security (HSTS) header as + ;; recommended by https://hstspreload.org + (body (list "add_header Strict-Transport-Security \"max-age=63072000; includeSubdomains; preload\";" + "return 301 https://$host$request_uri;")))))) + (map (match-record-lambda <forge-nginx-server-configuration> + (server-name root locations index try-files anubis? raw-content) + (match server-name ((name _ ...) (nginx-server-configuration - (inherit server) - (listen (list (string-append (nginx-socket->string https-listen) - " ssl"))) - (ssl-certificate (string-append acme-state-directory - "/" name "/cert.pem")) - (ssl-certificate-key (string-append acme-state-directory - "/private/" name "/key.pem")))))) - server-blocks)))) + (listen (cons (string-append (nginx-socket->string https-listen) + " ssl") + (if proxy-protocol-listen + (list (string-append (nginx-socket->string proxy-protocol-listen) + " ssl proxy_protocol")) + (list)))) + (server-name server-name) + (root root) + (locations + (if anubis? + (append (anubis-locations (forge-unix-socket + (path %anubis-unix-socket))) + locations) + locations)) + (index index) + (try-files try-files) + (ssl-certificate (string-append acme-state-directory + "/" name "/cert.pem")) + (ssl-certificate-key (string-append acme-state-directory + "/private/" name "/key.pem")) + (raw-content raw-content))))) + (forge-nginx-configuration-coerced-server-blocks config))))) (define %deploy-hook-gexp (with-imported-modules '((guix build utils)) @@ -127,27 +240,27 @@ specified by @var{config}." (define (forge-nginx-acme-certificates config) "Return list of @code{<acme-certificate>} blocks to provision for forge-nginx service specified by @var{config}." - (match-record config <forge-nginx-configuration> - (server-blocks) - (map (lambda (server) - (acme-certificate - (domains (nginx-server-configuration-server-name server)) - (deploy-hook (program-file "forge-nginx-acme-deploy-hook" - %deploy-hook-gexp)))) - server-blocks))) + (map (lambda (server) + (acme-certificate + (domains (forge-nginx-server-configuration-server-name server)) + (deploy-hook (program-file "forge-nginx-acme-deploy-hook" + %deploy-hook-gexp)))) + (forge-nginx-configuration-coerced-server-blocks config))) (define forge-nginx-service-type (service-type - (name 'forge-nginx) - (description "Run the forge-nginx web server.") - (extensions (list (service-extension nginx-service-type - forge-nginx-server-blocks) - (service-extension acme-service-type - forge-nginx-acme-certificates))) - (compose concatenate) - (extend (lambda (config server-blocks) - (forge-nginx-configuration - (inherit config) - (server-blocks (append (forge-nginx-configuration-server-blocks config) - server-blocks))))) - (default-value (forge-nginx-configuration)))) + (name 'forge-nginx) + (description "Run the forge-nginx web server.") + (extensions (list (service-extension nginx-service-type + forge-nginx-server-blocks) + (service-extension acme-service-type + forge-nginx-acme-certificates) + (service-extension anubis-service-type + (const #t)))) + (compose concatenate) + (extend (lambda (config server-blocks) + (forge-nginx-configuration + (inherit config) + (server-blocks (append (forge-nginx-configuration-server-blocks config) + server-blocks))))) + (default-value (forge-nginx-configuration)))) diff --git a/guix/forge/tissue.scm b/guix/forge/tissue.scm index 4ece204..abf3e39 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,42 @@ #:log-file "/var/log/tissue.log"))) (stop #~(make-kill-destructor))))) +(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->nginx-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 +296,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 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..e4734bb --- /dev/null +++ b/guix/guix-forge-website.scm @@ -0,0 +1,78 @@ +;;; guix-forge --- Guix software forge meta-service +;;; Copyright © 2025, 2026 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/issues/automatic-importer-for-github-projects.gmi b/issues/automatic-importer-for-github-projects.gmi deleted file mode 100644 index 314b321..0000000 --- a/issues/automatic-importer-for-github-projects.gmi +++ /dev/null @@ -1,7 +0,0 @@ -# Automatic importer for GitHub projects - -We need an importer to automagically import projects from GitHub (or from GitLab, SourceHut, etc.) into guix-forge. The user gives their GitHub/GitLab/SourceHut account URL (API token if required) and the importer will generate a guix-forge config with all of the user's repositories ready to be consumed by cgit or klaus, issue tracker is migrated to public-inbox/tissue, continuous integration is converted to something laminar can run, etc. - -This is a very ambitious idea, but extremely useful and will help adoption. - -Thanks to jgart for suggesting this! diff --git a/manifest.scm b/manifest.scm index 4101d1f..af0d73d 100644 --- a/manifest.scm +++ b/manifest.scm @@ -1,90 +1,2 @@ -;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2022, 2023 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/>. - -(use-modules (forge tissue) - (gnu packages autotools) - ((gnu packages fonts) #:prefix guix:) - (gnu packages gettext) - ((gnu packages skribilo) #:prefix guix:) - (guix git-download) - (guix packages) - (guix utils)) - -;; Install web fonts in font-charter and font-fira-code. There is a -;; pending patchset https://issues.guix.gnu.org/54471 to do this in -;; upstream Guix. Use the upstream Guix packages once that patchset -;; lands in the upstream master branch. - -(define font-charter - (package - (inherit guix:font-charter) - (outputs '("out")) - (arguments - `(#:phases - (modify-phases %standard-phases - (add-after 'install 'install-web-fonts - (lambda* (#:key outputs #:allow-other-keys) - (let* ((out (assoc-ref outputs "out")) - (source (getcwd)) - (fonts (string-append out "/share/fonts"))) - (for-each (lambda (file) - (install-file file (string-append fonts "/web"))) - (find-files source "\\.(woff|woff2)$")))))))))) - -(define font-fira-code - (package - (inherit guix:font-fira-code) - (arguments - `(#:phases - (modify-phases %standard-phases - (add-after 'install 'install-web-fonts - (lambda* (#:key outputs #:allow-other-keys) - (let* ((out (assoc-ref outputs "out")) - (source (getcwd)) - (fonts (string-append out "/share/fonts"))) - (for-each (lambda (file) - (install-file file (string-append fonts "/web"))) - (find-files source "\\.(woff|woff2)$")))))))))) - -;; Use a later unreleased version of skribilo since we need certain -;; improvements and bug fixes from it. -(define skribilo - (let ((commit "76136f9e904e8eb17f494d20fa2969ef2d5eb1aa") - (revision "1")) - (package - (inherit guix:skribilo) - (name "skribilo") - (version (git-version "0.9.5" revision commit)) - (source (origin - (method git-fetch) - (uri (git-reference - (url "https://git.savannah.gnu.org/git/skribilo.git") - (commit commit))) - (file-name (git-file-name name version)) - (sha256 - (base32 - "105jlpqs63fa724yldgs36bgnw3h4lq5addhmb9y3nla5a4vn2m2")))) - (native-inputs - `(("autoconf" ,autoconf) - ("automake" ,automake) - ("gettext" ,gnu-gettext) - ,@(package-native-inputs guix:skribilo)))))) - -(packages->manifest - (list font-charter font-fira-code tissue)) +(specifications->manifest + (list "font-charter" "font-fira-code" "git-bug")) diff --git a/tissue.scm b/tissue.scm deleted file mode 100644 index 3717bea..0000000 --- a/tissue.scm +++ /dev/null @@ -1,64 +0,0 @@ -;;; guix-forge --- Guix software forge meta-service -;;; Copyright © 2023 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/>. - -(use-modules (tissue skribilo)) - -;; Add current directory to load path so that (doc skribilo) can be -;; found when indexing doc/forge.skb. -(add-to-load-path (dirname (current-filename))) - -(tissue-configuration - #:indexed-documents (append (map (lambda (filename) - (slot-set (read-gemtext-issue filename) - 'web-uri - (string-append "/" (string-remove-suffix ".gmi" filename)))) - (gemtext-files-in-directory "issues")) - (map (lambda (identifier) - (slot-set (document-fragment "doc/forge.skb" identifier) - 'web-uri - (string-append "/manual/dev/en/#" - identifier))) - (list "chapter-introduction" - "chapter-tutorial" - "chapter-how-to" - "chapter-services" - "chapter-reference")) - (map (lambda (commit) - (slot-set commit - 'web-uri - (string-append "https://git.systemreboot.net/guix-forge/commit/?id=" - (commit-hash commit)))) - (commits-in-current-repository))) - #:web-files (cons* (file "index.html" - (skribe-exporter "website/index.skb")) - (file "style.css" - (copier "website/style.css")) - (file "manual/dev/en/index.html" - (skribe-exporter "doc/forge.skb")) - (append (map (lambda (font-file) - (file (string-append "fonts/" font-file) - (copier (string-append (getenv "GUIX_ENVIRONMENT") - "/share/fonts/web/" font-file)))) - (list "charter_regular.woff2" - "FiraCode-Regular.woff2" - "FiraCode-SemiBold.woff2")) - (map (lambda (filename) - (file (replace-extension filename "html") - (gemtext-exporter filename))) - (gemtext-files-in-directory "issues"))))) diff --git a/website/index.skb b/website/index.skb index e92fa65..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.]) @@ -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.]) diff --git a/website/style.css b/website/style.css index bcd4136..08615ce 100644 --- a/website/style.css +++ b/website/style.css @@ -1,20 +1,20 @@ @font-face { font-family: 'Charter'; - src: url('/fonts/charter_regular.woff2') format('woff2'); + src: url('/guix-forge/fonts/charter_regular.woff2') format('woff2'); font-weight: normal; font-style: normal; } @font-face { font-family: 'Fira Code'; - src: url('/fonts/FiraCode-Regular.woff2') format('woff2'); + src: url('/guix-forge/fonts/FiraCode-Regular.woff2') format('woff2'); font-weight: normal; font-style: normal; } @font-face { font-family: 'Fira Code'; - src: url('/fonts/FiraCode-SemiBold.woff2') format('woff2'); + src: url('/guix-forge/fonts/FiraCode-SemiBold.woff2') format('woff2'); font-weight: 600; font-style: normal; } |