diff options
Diffstat (limited to 'guix/forge/fcgiwrap.scm')
| -rw-r--r-- | guix/forge/fcgiwrap.scm | 169 |
1 files changed, 169 insertions, 0 deletions
diff --git a/guix/forge/fcgiwrap.scm b/guix/forge/fcgiwrap.scm new file mode 100644 index 0000000..b14bb23 --- /dev/null +++ b/guix/forge/fcgiwrap.scm @@ -0,0 +1,169 @@ +;;; 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/>. + +(define-module (forge fcgiwrap) + #:use-module (forge socket) + #:use-module (gnu build linux-container) + #:use-module ((gnu packages web) #:select (fcgiwrap)) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu system file-systems) + #:use-module (guix gexp) + #:use-module (guix least-authority) + #:use-module (guix records) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (fcgiwrap-service-type + fcgiwrap-configuration + fcgiwrap-configuration? + fcgiwrap-configuration-package + fcgiwrap-configuration-instances + fcgiwrap-instance + fcgiwrap-instance? + fcgiwrap-instance-name + fcgiwrap-instance-socket + fcgiwrap-instance-processes + fcgiwrap-instance-environment-variables + fcgiwrap-instance-mappings)) + +(define-record-type* <fcgiwrap-configuration> + fcgiwrap-configuration make-fcgiwrap-configuration + fcgiwrap-configuration? + (package fcgiwrap-configuration-package + (default fcgiwrap)) + (instances fcgiwrap-configuration-instances + (default '()))) + +(define-record-type* <fcgiwrap-instance> + fcgiwrap-instance make-fcgiwrap-instance + fcgiwrap-instance? + this-fcgiwrap-instance + (name fcgiwrap-instance-name) + (socket fcgiwrap-instance-socket + (default (forge-unix-socket + (path (string-append "/var/run/fcgiwrap/" + (fcgiwrap-instance-name this-fcgiwrap-instance) + "/socket")))) + (thunked)) + (user fcgiwrap-instance-user) + (group fcgiwrap-instance-group) + (processes fcgiwrap-instance-processes + (default 1)) + (environment-variables fcgiwrap-instance-environment-variables + (default '())) + (mappings fcgiwrap-instance-mappings + (default '()))) + +(define (fcgiwrap-activation config) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + ;; Create socket directories and set ownership. + (for-each (match-lambda + ((user-name group-name socket-directory) + (mkdir-p socket-directory) + (let ((user (getpw user-name)) + (group (getgr group-name))) + (chown socket-directory (passwd:uid user) (group:gid group))))) + '#$(filter-map (match-record-lambda <fcgiwrap-instance> + (socket user group) + (and (forge-unix-socket? socket) + (list user + group + (dirname (forge-unix-socket-path socket))))) + (fcgiwrap-configuration-instances config)))))) + +(define (socket->fcgiwrap-socket-url socket) + "Serialize @var{socket} to URL as required by fcgiwrap." + (match socket + ;; KLUDGE: When passed a host socket, we assume it resolves to an + ;; IPv4 address, not an IPv6 address. + (($ <forge-host-socket> hostname port) + (string-append "tcp:" hostname ":" (number->string port))) + (($ <forge-ip-socket> (? ipv4-address? ip) port) + (string-append "tcp:" ip ":" (number->string port))) + (($ <forge-ip-socket> (? ipv6-address? ip) port) + (string-append "tcp6:[" ip "]:" (number->string port))) + (($ <forge-unix-socket> path) + (string-append "unix:" path)))) + +(define (fcgiwrap-shepherd-services config) + (map (match-record-lambda <fcgiwrap-instance> + (name socket user group processes environment-variables mappings) + (shepherd-service + (documentation (string-append "Run fcgiwrap for " name " script.")) + (provision '(fcgiwrap)) + (requirement '(networking)) + (modules '((ice-9 match))) + (start + #~(make-forkexec-constructor + (list #$(least-authority-wrapper + (file-append (fcgiwrap-configuration-package config) + "/sbin/fcgiwrap") + #:name (string-append "fcgiwrap-" name "-pola-wrapper") + #:mappings (append + ;; Mappings for Unix socket directories + (if (forge-unix-socket? socket) + (list (file-system-mapping + (source (dirname (forge-unix-socket-path socket))) + (target source) + (writable? #t))) + (list)) + ;; Additional mappings + mappings) + #:preserved-environment-variables + (map (match-lambda + ((variable . value) variable)) + environment-variables) + ;; TODO: If socket is a Unix socket, run in a + ;; network namespace. We can't do this yet due to + ;; https://yhetil.org/guix/m1ilknoi5r.fsf@fastmail.net/ + #:namespaces (delq 'net %namespaces)) + "-s" #$(socket->fcgiwrap-socket-url socket) + "-c" #$(number->string processes)) + #:user #$user + #:group #$group + #:environment-variables + (map (match-lambda + ((variable value) + (string-append variable "=" value))) + '#$(map (match-lambda + ((variable . value) + (list variable value))) + environment-variables)) + #:log-file #$(string-append "/var/log/fcgiwrap/" name ".log"))) + (stop #~(make-kill-destructor)))) + (fcgiwrap-configuration-instances config))) + +(define fcgiwrap-service-type + (service-type + (name 'fcgiwrap) + (description "Run fcgiwrap.") + (extensions (list (service-extension activation-service-type + fcgiwrap-activation) + (service-extension shepherd-root-service-type + fcgiwrap-shepherd-services))) + (compose concatenate) + (extend (lambda (config instances) + (fcgiwrap-configuration + (inherit config) + (instances (append (fcgiwrap-configuration-instances config) + instances))))) + (default-value (fcgiwrap-configuration)))) |