;;; guix-forge --- Guix software forge meta-service
;;; Copyright © 2023–2025 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2024 Frederick M. Muriithi <fredmanglis@protonmail.com>
;;;
;;; 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 gunicorn)
#:use-module (forge environment)
#:use-module (forge socket)
#:use-module (gnu build linux-container)
#:use-module ((gnu packages admin) #:select (shadow))
#:use-module ((gnu packages python) #:select (python))
#:use-module ((gnu packages python-web) #:select (gunicorn))
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system file-systems)
#:use-module (gnu system shadow)
#:use-module (guix gexp)
#:use-module (guix least-authority)
#:use-module (guix modules)
#:use-module (guix monads)
#:use-module (guix profiles)
#:use-module (guix records)
#:use-module (guix search-paths)
#:use-module (guix store)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (gunicorn-service-type
gunicorn-configuration
gunicorn-configuration?
gunicorn-configuration-package
gunicorn-configuration-apps
gunicorn-app
gunicorn-app?
gunicorn-app-name
gunicorn-app-package
gunicorn-app-wsgi-app-module
gunicorn-app-sockets
gunicorn-app-workers
gunicorn-app-timeout
gunicorn-app-extra-cli-arguments
gunicorn-app-environment-variables
gunicorn-app-mappings))
(define-record-type* <gunicorn-configuration>
gunicorn-configuration make-gunicorn-configuration
gunicorn-configuration?
(package gunicorn-configuration-package
(default gunicorn))
(apps gunicorn-configuration-apps
(default '())))
(define-record-type* <gunicorn-app>
gunicorn-app make-gunicorn-app
gunicorn-app?
this-gunicorn-app
(name gunicorn-app-name)
(package gunicorn-app-package)
(wsgi-app-module gunicorn-app-wsgi-app-module)
(sockets gunicorn-app-sockets
(default (list (forge-unix-socket
(path (string-append "/var/run/gunicorn/"
(gunicorn-app-name this-gunicorn-app)
"/socket")))))
(thunked))
(workers gunicorn-app-workers
(default 1))
(extra-cli-arguments gunicorn-app-extra-cli-arguments
(default '()))
(environment-variables gunicorn-app-environment-variables
(default '()))
(timeout gunicorn-app-timeout
(default 30))
(mappings gunicorn-app-mappings
(default '())))
(define (gunicorn-app-account-name app)
"Return name used for user and group running gunicorn @var{app}."
(string-append "gunicorn-" (gunicorn-app-name app)))
(define (gunicorn-accounts config)
(append-map (lambda (app)
(let ((name (gunicorn-app-account-name app)))
(list (user-account
(name name)
(group name)
(system? #t)
(comment (string-append "gunicorn user for app "
(gunicorn-app-name app)))
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))
(user-group
(name name)
(system? #t)))))
(gunicorn-configuration-apps config)))
(define (gunicorn-activation config)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match))
;; Create socket directories and set ownership.
(for-each (match-lambda
((username socket-directories ...)
(for-each (lambda (socket-directory)
(mkdir-p socket-directory)
(let ((user (getpw username)))
(chown socket-directory (passwd:uid user) (passwd:gid user))))
socket-directories)))
'#$(map (lambda (app)
(cons (gunicorn-app-account-name app)
(filter-map (lambda (socket)
(and (forge-unix-socket? socket)
(dirname (forge-unix-socket-path socket))))
(gunicorn-app-sockets app))))
(gunicorn-configuration-apps config))))))
(define socket->gunicorn-bind
(match-lambda
(($ <forge-host-socket> hostname port)
(string-append hostname ":" port))
(($ <forge-ip-socket> (? ipv4-address? ip) port)
(string-append ip ":" (number->string port)))
(($ <forge-ip-socket> (? ipv6-address? ip) port)
(string-append "[" ip "]:" (number->string port)))
(($ <forge-unix-socket> path)
(string-append "unix:" path))))
(define (gunicorn-shepherd-services config)
(map (lambda (app)
(let ((name (string-append "gunicorn-" (gunicorn-app-name app))))
(shepherd-service
(documentation (string-append "Run gunicorn for app "
(gunicorn-app-name app)
"."))
(provision (list (string->symbol name)))
(requirement '(networking))
(modules '((guix search-paths)
(ice-9 match)))
(start
(let* ((app-manifest (packages->manifest
;; Using python-minimal in the
;; manifest creates collisions with
;; the python in the app package.
(list python
(gunicorn-app-package app))))
(app-profile (profile
(content app-manifest)
(allow-collisions? #t))))
(with-imported-modules (source-module-closure '((guix search-paths)))
#~(make-forkexec-constructor
(cons* #$(least-authority-wrapper
(file-append (gunicorn-configuration-package config)
"/bin/gunicorn")
#:name (string-append name "-pola-wrapper")
#:mappings (cons (file-system-mapping
;; Mapping the app package
(source app-profile)
(target source))
(append
;; Mappings for Unix socket directories
(filter-map (lambda (socket)
(and (forge-unix-socket? socket)
(file-system-mapping
(source (dirname (forge-unix-socket-path socket)))
(target source)
(writable? #t))))
(gunicorn-app-sockets app))
;; Additional mappings
(gunicorn-app-mappings app)))
#:preserved-environment-variables
(map search-path-specification-variable
(manifest-search-paths app-manifest))
;; 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))
"--workers" #$(number->string (gunicorn-app-workers app))
"--timeout" #$(number->string (gunicorn-app-timeout app))
(list #$@(append (append-map (lambda (socket)
(list "--bind"
(socket->gunicorn-bind socket)))
(gunicorn-app-sockets app))
(append-map (lambda (variable)
(list "--env"
#~(string-append #$(environment-variable-name variable)
"="
#$(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
#:environment-variables
(map (match-lambda
((spec . value)
(string-append (search-path-specification-variable spec)
"="
value)))
(evaluate-search-paths
(map sexp->search-path-specification
'#$(map search-path-specification->sexp
(manifest-search-paths app-manifest)))
(list #$app-profile)))
#:log-file #$(string-append "/var/log/" name ".log")))))
(stop #~(make-kill-destructor)))))
(gunicorn-configuration-apps config)))
(define gunicorn-service-type
(service-type
(name 'gunicorn)
(description "Run gunicorn.")
(extensions (list (service-extension account-service-type
gunicorn-accounts)
(service-extension activation-service-type
gunicorn-activation)
(service-extension shepherd-root-service-type
gunicorn-shepherd-services)))
(compose concatenate)
(extend (lambda (config apps)
(gunicorn-configuration
(inherit config)
(apps (append (gunicorn-configuration-apps config)
apps)))))
(default-value (gunicorn-configuration))))
