;;; guix-forge --- Guix software forge meta-service ;;; Copyright © 2023 Arun Isaac ;;; ;;; 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 ;;; . (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-environment-variables gunicorn-app-mappings)) (define-record-type* gunicorn-configuration make-gunicorn-configuration gunicorn-configuration? (package gunicorn-configuration-package (default gunicorn)) (apps gunicorn-configuration-apps (default '()))) (define-record-type* 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)) (environment-variables gunicorn-app-environment-variables (default '())) (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)) ;; 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 (($ hostname port) (string-append hostname ":" port)) (($ (? ipv4-address? ip) port) (string-append ip ":" (number->string port))) (($ (? ipv6-address? ip) port) (string-append "[" ip "]:" (number->string port))) (($ 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)) (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)) (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))))