;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2016 ng0 ;;; Copyright © 2016, 2017, 2018 Julien Lepiller ;;; Copyright © 2017 Christopher Baines ;;; Copyright © 2017 nee ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2018 Pierre-Antoine Rouby ;;; Copyright © 2017, 2018, 2019 Christopher Baines ;;; Copyright © 2018 Marius Bakke ;;; Copyright © 2019 Florian Pelz ;;; Copyright © 2020 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix 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. ;;; ;;; GNU Guix 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 GNU Guix. If not, see . (define-module (gnu services web) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services admin) #:use-module (gnu services getmail) #:use-module (gnu services mail) #:use-module (gnu system pam) #:use-module (gnu system shadow) #:use-module (gnu packages admin) #:use-module (gnu packages databases) #:use-module (gnu packages web) #:use-module (gnu packages patchutils) #:use-module (gnu packages php) #:use-module (gnu packages python) #:use-module (gnu packages gnupg) #:use-module (gnu packages guile) #:use-module (gnu packages logging) #:use-module (gnu packages mail) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix modules) #:use-module (guix utils) #:use-module (guix gexp) #:use-module ((guix store) #:select (text-file)) #:use-module ((guix utils) #:select (version-major)) #:use-module ((guix packages) #:select (package-version)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (ice-9 match) #:export ( httpd-configuration httpd-configuration? httpd-configuration-package httpd-configuration-pid-file httpd-configuration-config httpd-virtualhost httpd-virtualhost? httpd-virtualhost-addresses-and-ports httpd-virtualhost-contents httpd-config-file httpd-config-file? httpd-config-file-modules httpd-config-file-server-root httpd-config-file-server-name httpd-config-file-listen httpd-config-file-pid-file httpd-config-file-error-log httpd-config-file-user httpd-config-file-group httpd-module httpd-module? %default-httpd-modules httpd-service-type nginx-configuration nginx-configuration? nginx-configuartion-nginx nginx-configuration-log-directory nginx-configuration-run-directory nginx-configuration-server-blocks nginx-configuration-upstream-blocks nginx-configuration-server-names-hash-bucket-size nginx-configuration-server-names-hash-bucket-max-size nginx-configuration-modules nginx-configuration-extra-content nginx-configuration-file nginx-server-configuration nginx-server-configuration? nginx-server-configuration-listen nginx-server-configuration-server-name nginx-server-configuration-root nginx-server-configuration-locations nginx-server-configuration-index nginx-server-configuration-ssl-certificate nginx-server-configuration-ssl-certificate-key nginx-server-configuration-server-tokens? nginx-server-configuration-raw-content nginx-upstream-configuration nginx-upstream-configuration? nginx-upstream-configuration-name nginx-upstream-configuration-servers nginx-location-configuration nginx-location-configuration? nginx-location-configuration-uri nginx-location-configuration-body nginx-named-location-configuration nginx-named-location-configuration? nginx-named-location-configuration-name nginx-named-location-configuration-body nginx-service nginx-service-type fcgiwrap-configuration fcgiwrap-configuration? fcgiwrap-service-type php-fpm-configuration make-php-fpm-configuration php-fpm-configuration? php-fpm-configuration-php php-fpm-configuration-socket php-fpm-configuration-user php-fpm-configuration-group php-fpm-configuration-socket-user php-fpm-configuration-socket-group php-fpm-configuration-pid-file php-fpm-configuration-log-file php-fpm-configuration-process-manager php-fpm-configuration-display-errors php-fpm-configuration-timezone php-fpm-configuration-workers-log-file php-fpm-configuration-file php-fpm-dynamic-process-manager-configuration make-php-fpm-dynamic-process-manager-configuration php-fpm-dynamic-process-manager-configuration? php-fpm-dynamic-process-manager-configuration-max-children php-fpm-dynamic-process-manager-configuration-start-servers php-fpm-dynamic-process-manager-configuration-min-spare-servers php-fpm-dynamic-process-manager-configuration-max-spare-servers php-fpm-static-process-manager-configuration make-php-fpm-static-process-manager-configuration php-fpm-static-process-manager-configuration? php-fpm-static-process-manager-configuration-max-children php-fpm-on-demand-process-manager-configuration make-php-fpm-on-demand-process-manager-configuration php-fpm-on-demand-process-manager-configuration? php-fpm-on-demand-process-manager-configuration-max-children php-fpm-on-demand-process-manager-configuration-process-idle-timeout php-fpm-service-type nginx-php-location cat-avatar-generator-service hpcguix-web-configuration hpcguix-web-configuration? hpcguix-web-service-type tailon-configuration-file tailon-configuration-file? tailon-configuration-file-files tailon-configuration-file-bind tailon-configuration-file-relative-root tailon-configuration-file-allow-transfers? tailon-configuration-file-follow-names? tailon-configuration-file-tail-lines tailon-configuration-file-allowed-commands tailon-configuration-file-debug? tailon-configuration-file-http-auth tailon-configuration-file-users tailon-configuration tailon-configuration? tailon-configuration-config-file tailon-configuration-package tailon-service-type varnish-configuration varnish-configuration? varnish-configuration-package varnish-configuration-name varnish-configuration-backend varnish-configuration-vcl varnish-configuration-listen varnish-configuration-storage varnish-configuration-parameters varnish-configuration-extra-options varnish-service-type patchwork-database-configuration patchwork-database-configuration? patchwork-database-configuration-engine patchwork-database-configuration-name patchwork-database-configuration-user patchwork-database-configuration-password patchwork-database-configuration-host patchwork-database-configuration-port patchwork-settings-module patchwork-settings-module? patchwork-settings-module-database-configuration patchwork-settings-module-secret-key patchwork-settings-module-allowed-hosts patchwork-settings-module-default-from-email patchwork-settings-module-static-url patchwork-settings-module-admins patchwork-settings-module-debug? patchwork-settings-module-enable-rest-api? patchwork-settings-module-enable-xmlrpc? patchwork-settings-module-force-https-links? patchwork-settings-module-extra-settings patchwork-configuration patchwork-configuration? patchwork-configuration-patchwork patchwork-configuration-settings-module patchwork-configuration-domain patchwork-virtualhost patchwork-service-type mumi-service-type)) ;;; Commentary: ;;; ;;; Web services. ;;; ;;; Code: (define-record-type* httpd-module make-httpd-module httpd-module? (name httpd-load-module-name) (file httpd-load-module-file)) ;; Default modules for the httpd-service-type, taken from etc/httpd/httpd.conf ;; file in the httpd package. (define %default-httpd-modules (map (match-lambda ((name file) (httpd-module (name name) (file file)))) '(("authn_file_module" "modules/mod_authn_file.so") ("authn_core_module" "modules/mod_authn_core.so") ("authz_host_module" "modules/mod_authz_host.so") ("authz_groupfile_module" "modules/mod_authz_groupfile.so") ("authz_user_module" "modules/mod_authz_user.so") ("authz_core_module" "modules/mod_authz_core.so") ("access_compat_module" "modules/mod_access_compat.so") ("auth_basic_module" "modules/mod_auth_basic.so") ("reqtimeout_module" "modules/mod_reqtimeout.so") ("filter_module" "modules/mod_filter.so") ("mime_module" "modules/mod_mime.so") ("log_config_module" "modules/mod_log_config.so") ("env_module" "modules/mod_env.so") ("headers_module" "modules/mod_headers.so") ("setenvif_module" "modules/mod_setenvif.so") ("version_module" "modules/mod_version.so") ("unixd_module" "modules/mod_unixd.so") ("status_module" "modules/mod_status.so") ("autoindex_module" "modules/mod_autoindex.so") ("dir_module" "modules/mod_dir.so") ("alias_module" "modules/mod_alias.so")))) (define-record-type* httpd-config-file make-httpd-config-file httpd-config-file? (modules httpd-config-file-modules (default %default-httpd-modules)) (server-root httpd-config-file-server-root (default httpd)) (server-name httpd-config-file-server-name (default #f)) (document-root httpd-config-file-document-root (default "/srv/http")) (listen httpd-config-file-listen (default '("80"))) (pid-file httpd-config-file-pid-file (default "/var/run/httpd")) (error-log httpd-config-file-error-log (default "/var/log/httpd/error_log")) (user httpd-config-file-user (default "httpd")) (group httpd-config-file-group (default "httpd")) (extra-config httpd-config-file-extra-config (default (list "TypesConfig etc/httpd/mime.types")))) (define-gexp-compiler (httpd-config-file-compiler (file ) system target) (match file (($ load-modules server-root server-name document-root listen pid-file error-log user group extra-config) (gexp->derivation "httpd.conf" #~(call-with-output-file (ungexp output "out") (lambda (port) (display (string-append (ungexp-splicing `(,@(append-map (match-lambda (($ name module) `("LoadModule " ,name " " ,module "\n"))) load-modules) ,@`("ServerRoot " ,server-root "\n") ,@(if server-name `("ServerName " ,server-name "\n") '()) ,@`("DocumentRoot " ,document-root "\n") ,@(append-map (lambda (listen-value) `("Listen " ,listen-value "\n")) listen) ,@(if pid-file `("Pidfile " ,pid-file "\n") '()) ,@(if error-log `("ErrorLog " ,error-log "\n") '()) ,@(if user `("User " ,user "\n") '()) ,@(if group `("Group " ,group "\n") '()) "\n\n" ,@extra-config))) port))) #:local-build? #t)))) (define-record-type (httpd-virtualhost addresses-and-ports contents) httpd-virtualhost? (addresses-and-ports httpd-virtualhost-addresses-and-ports) (contents httpd-virtualhost-contents)) (define-record-type* httpd-configuration make-httpd-configuration httpd-configuration? (package httpd-configuration-package (default httpd)) (pid-file httpd-configuration-pid-file (default "/var/run/httpd")) (config httpd-configuration-config (default (httpd-config-file)))) (define %httpd-accounts (list (user-group (name "httpd") (system? #t)) (user-account (name "httpd") (group "httpd") (system? #t) (comment "Apache HTTPD server user") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) (define httpd-shepherd-services (match-lambda (($ package pid-file config) (list (shepherd-service (provision '(httpd)) (documentation "The Apache HTTP Server") (requirement '(networking)) (start #~(make-forkexec-constructor `(#$(file-append package "/bin/httpd") #$@(if config (list "-f" config) '())) #:pid-file #$pid-file)) (stop #~(make-kill-destructor))))))) (define httpd-activation (match-lambda (($ package pid-file config) (match-record config (error-log document-root) #~(begin (use-modules (guix build utils)) (mkdir-p #$(dirname error-log)) (mkdir-p #$document-root)))))) (define (httpd-process-extensions original-config extension-configs) (let ((config (httpd-configuration-config original-config))) (if (httpd-config-file? config) (httpd-configuration (inherit original-config) (config (httpd-config-file (inherit config) (extra-config (append (httpd-config-file-extra-config config) (append-map (match-lambda (($ addresses-and-ports contents) `(,(string-append "\n\n") ,@contents "\n\n")) ((? string? x) `("\n" ,x "\n")) ((? list? x) `("\n" ,@x "\n"))) extension-configs))))))))) (define httpd-service-type (service-type (name 'httpd) (extensions (list (service-extension shepherd-root-service-type httpd-shepherd-services) (service-extension activation-service-type httpd-activation) (service-extension account-service-type (const %httpd-accounts)))) (compose concatenate) (extend httpd-process-extensions) (default-value (httpd-configuration)))) (define-record-type* nginx-server-configuration make-nginx-server-configuration nginx-server-configuration? (listen nginx-server-configuration-listen (default '("80" "443 ssl"))) (server-name nginx-server-configuration-server-name (default (list 'default))) (root nginx-server-configuration-root (default "/srv/http")) (locations nginx-server-configuration-locations (default '())) (index nginx-server-configuration-index (default (list "index.html"))) (try-files nginx-server-configuration-try-files (default '())) (ssl-certificate nginx-server-configuration-ssl-certificate (default #f)) (ssl-certificate-key nginx-server-configuration-ssl-certificate-key (default #f)) (server-tokens? nginx-server-configuration-server-tokens? (default #f)) (raw-content nginx-server-configuration-raw-content (default '()))) (define-record-type* nginx-upstream-configuration make-nginx-upstream-configuration nginx-upstream-configuration? (name nginx-upstream-configuration-name) (servers nginx-upstream-configuration-servers)) (define-record-type* nginx-location-configuration make-nginx-location-configuration nginx-location-configuration? (uri nginx-location-configuration-uri (default #f)) (body nginx-location-configuration-body)) (define-record-type* nginx-named-location-configuration make-nginx-named-location-configuration nginx-named-location-configuration? (name nginx-named-location-configuration-name (default #f)) (body nginx-named-location-configuration-body)) (define-record-type* nginx-configuration make-nginx-configuration nginx-configuration? (nginx nginx-configuration-nginx ; (default nginx)) (log-directory nginx-configuration-log-directory ;string (default "/var/log/nginx")) (run-directory nginx-configuration-run-directory ;string (default "/var/run/nginx")) (server-blocks nginx-configuration-server-blocks (default '())) ;list of (upstream-blocks nginx-configuration-upstream-blocks (default '())) ;list of (server-names-hash-bucket-size nginx-configuration-server-names-hash-bucket-size (default #f)) (server-names-hash-bucket-max-size nginx-configuration-server-names-hash-bucket-max-size (default #f)) (modules nginx-configuration-modules (default '())) (global-directives nginx-configuration-global-directives (default '())) (extra-content nginx-configuration-extra-content (default "")) (file nginx-configuration-file ;#f | string | file-like (default #f))) (define (config-domain-strings names) "Return a string denoting the nginx config representation of NAMES, a list of domain names." (map (match-lambda ('default "_ ") ((? string? str) (list str " "))) names)) (define (config-index-strings names) "Return a string denoting the nginx config representation of NAMES, a list of index files." (map (match-lambda ((? string? str) (list str " "))) names)) (define (emit-load-module module) (list "load_module " module ";\n")) (define emit-global-directive (match-lambda ((key . (? list? alist)) (format #f "~a { ~{~a~}}~%" key (map emit-global-directive alist))) ((key . value) (format #f "~a ~a;~%" key value)))) (define emit-nginx-location-config (match-lambda (($ uri body) (list " location " uri " {\n" (map (lambda (x) (list " " x "\n")) body) " }\n")) (($ name body) (list " location @" name " {\n" (map (lambda (x) (list " " x "\n")) body) " }\n")))) (define (emit-nginx-server-config server) (let ((listen (nginx-server-configuration-listen server)) (server-name (nginx-server-configuration-server-name server)) (ssl-certificate (nginx-server-configuration-ssl-certificate server)) (ssl-certificate-key (nginx-server-configuration-ssl-certificate-key server)) (root (nginx-server-configuration-root server)) (index (nginx-server-configuration-index server)) (try-files (nginx-server-configuration-try-files server)) (server-tokens? (nginx-server-configuration-server-tokens? server)) (locations (nginx-server-configuration-locations server)) (raw-content (nginx-server-configuration-raw-content server))) (define-syntax-parameter <> (syntax-rules ())) (define-syntax-rule (and/l x tail ...) (let ((x* x)) (if x* (syntax-parameterize ((<> (identifier-syntax x*))) (list tail ...)) '()))) (list " server {\n" (map (lambda (directive) (list " listen " directive ";\n")) listen) " server_name " (config-domain-strings server-name) ";\n" (and/l ssl-certificate " ssl_certificate " <> ";\n") (and/l ssl-certificate-key " ssl_certificate_key " <> ";\n") " root " root ";\n" " index " (config-index-strings index) ";\n" (if (not (nil? try-files)) (and/l (config-index-strings try-files) " try_files " <> ";\n") "") " server_tokens " (if server-tokens? "on" "off") ";\n" "\n" (map emit-nginx-location-config locations) "\n" (map (lambda (x) (list " " x "\n")) raw-content) " }\n"))) (define (emit-nginx-upstream-config upstream) (list " upstream " (nginx-upstream-configuration-name upstream) " {\n" (map (lambda (server) (simple-format #f " server ~A;\n" server)) (nginx-upstream-configuration-servers upstream)) " }\n")) (define (flatten . lst) "Return a list that recursively concatenates all sub-lists of LST." (define (flatten1 head out) (if (list? head) (fold-right flatten1 out head) (cons head out))) (fold-right flatten1 '() lst)) (define (default-nginx-config config) (match-record config (nginx log-directory run-directory server-blocks upstream-blocks server-names-hash-bucket-size server-names-hash-bucket-max-size modules global-directives extra-content) (apply mixed-text-file "nginx.conf" (flatten "user nginx nginx;\n" "pid " run-directory "/pid;\n" "error_log " log-directory "/error.log info;\n" (map emit-global-directive global-directives) (map emit-load-module modules) "http {\n" " client_body_temp_path " run-directory "/client_body_temp;\n" " proxy_temp_path " run-directory "/proxy_temp;\n" " fastcgi_temp_path " run-directory "/fastcgi_temp;\n" " uwsgi_temp_path " run-directory "/uwsgi_temp;\n" " scgi_temp_path " run-directory "/scgi_temp;\n" " access_log " log-directory "/access.log;\n" " include " nginx "/share/nginx/conf/mime.types;\n" (if server-names-hash-bucket-size (string-append " server_names_hash_bucket_size " (number->string server-names-hash-bucket-size) ";\n") "") (if server-names-hash-bucket-max-size (string-append " server_names_hash_bucket_max_size " (number->string server-names-hash-bucket-max-size) ";\n") "") "\n" (map emit-nginx-upstream-config upstream-blocks) (map emit-nginx-server-config server-blocks) extra-content "\n}\n")))) (define %nginx-accounts (list (user-group (name "nginx") (system? #t)) (user-account (name "nginx") (group "nginx") (system? #t) (comment "nginx server user") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) (define (nginx-activation config) (match-record config (nginx log-directory run-directory file) #~(begin (use-modules (guix build utils)) (format #t "creating nginx log directory '~a'~%" #$log-directory) (mkdir-p #$log-directory) (format #t "creating nginx run directory '~a'~%" #$run-directory) (mkdir-p #$run-directory) (format #t "creating nginx temp directories '~a/{client_body,proxy,fastcgi,uwsgi,scgi}_temp'~%" #$run-directory) (mkdir-p (string-append #$run-directory "/client_body_temp")) (mkdir-p (string-append #$run-directory "/proxy_temp")) (mkdir-p (string-append #$run-directory "/fastcgi_temp")) (mkdir-p (string-append #$run-directory "/uwsgi_temp")) (mkdir-p (string-append #$run-directory "/scgi_temp")) ;; Start-up logs. Once configuration is loaded, nginx switches to ;; log-directory. (mkdir-p (string-append #$run-directory "/logs")) ;; Check configuration file syntax. (system* (string-append #$nginx "/sbin/nginx") "-c" #$(or file (default-nginx-config config)) "-p" #$run-directory "-t")))) (define (nginx-shepherd-service config) (match-record config (nginx file run-directory) (let* ((nginx-binary (file-append nginx "/sbin/nginx")) (pid-file (in-vicinity run-directory "pid")) (nginx-action (lambda args #~(lambda _ (invoke #$nginx-binary "-c" #$(or file (default-nginx-config config)) #$@args) (match '#$args (("-s" . _) #f) (_ ;; When FILE is true, we cannot be sure that PID-FILE will ;; be created, so assume it won't show up. When FILE is ;; false, read PID-FILE. #$(if file #~#t #~(read-pid-file #$pid-file)))))))) ;; TODO: Add 'reload' action. (list (shepherd-service (provision '(nginx)) (documentation "Run the nginx daemon.") (requirement '(user-processes loopback)) (modules `((ice-9 match) ,@%default-modules)) (start (nginx-action "-p" run-directory)) (stop (nginx-action "-s" "stop"))))))) (define nginx-service-type (service-type (name 'nginx) (extensions (list (service-extension shepherd-root-service-type nginx-shepherd-service) (service-extension activation-service-type nginx-activation) (service-extension account-service-type (const %nginx-accounts)))) (compose concatenate) (extend (lambda (config servers) (nginx-configuration (inherit config) (server-blocks (append (nginx-configuration-server-blocks config) servers))))) (default-value (nginx-configuration)) (description "Run the nginx Web server."))) (define-record-type* fcgiwrap-configuration make-fcgiwrap-configuration fcgiwrap-configuration? (package fcgiwrap-configuration-package ; (default fcgiwrap)) (socket fcgiwrap-configuration-socket (default "tcp:127.0.0.1:9000")) (user fcgiwrap-configuration-user (default "fcgiwrap")) (group fcgiwrap-configuration-group (default "fcgiwrap"))) (define fcgiwrap-accounts (match-lambda (($ package socket user group) (filter identity (list (and (equal? group "fcgiwrap") (user-group (name "fcgiwrap") (system? #t))) (and (equal? user "fcgiwrap") (user-account (name "fcgiwrap") (group group) (system? #t) (comment "Fcgiwrap Daemon") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))))))) (define fcgiwrap-shepherd-service (match-lambda (($ package socket user group) (list (shepherd-service (provision '(fcgiwrap)) (documentation "Run the fcgiwrap daemon.") (requirement '(networking)) (start #~(make-forkexec-constructor '(#$(file-append package "/sbin/fcgiwrap") "-s" #$socket) #:user #$user #:group #$group)) (stop #~(make-kill-destructor))))))) (define fcgiwrap-service-type (service-type (name 'fcgiwrap) (extensions (list (service-extension shepherd-root-service-type fcgiwrap-shepherd-service) (service-extension account-service-type fcgiwrap-accounts))) (default-value (fcgiwrap-configuration)))) (define-record-type* php-fpm-configuration make-php-fpm-configuration php-fpm-configuration? (php php-fpm-configuration-php ; (default php)) (socket php-fpm-configuration-socket (default (string-append "/var/run/php" (version-major (package-version php)) "-fpm.sock"))) (user php-fpm-configuration-user (default "php-fpm")) (group php-fpm-configuration-group (default "php-fpm")) (socket-user php-fpm-configuration-socket-user (default "php-fpm")) (socket-group php-fpm-configuration-socket-group (default "nginx")) (pid-file php-fpm-configuration-pid-file (default (string-append "/var/run/php" (version-major (package-version php)) "-fpm.pid"))) (log-file php-fpm-configuration-log-file (default (string-append "/var/log/php" (version-major (package-version php)) "-fpm.log"))) (process-manager php-fpm-configuration-process-manager (default (php-fpm-dynamic-process-manager-configuration))) (display-errors php-fpm-configuration-display-errors (default #f)) (timezone php-fpm-configuration-timezone (default #f)) (workers-log-file php-fpm-configuration-workers-log-file (default (string-append "/var/log/php" (version-major (package-version php)) "-fpm.www.log"))) (file php-fpm-configuration-file ;#f | file-like (default #f))) (define-record-type* php-fpm-dynamic-process-manager-configuration make-php-fpm-dynamic-process-manager-configuration php-fpm-dynamic-process-manager-configuration? (max-children php-fpm-dynamic-process-manager-configuration-max-children (default 5)) (start-servers php-fpm-dynamic-process-manager-configuration-start-servers (default 2)) (min-spare-servers php-fpm-dynamic-process-manager-configuration-min-spare-servers (default 1)) (max-spare-servers php-fpm-dynamic-process-manager-configuration-max-spare-servers (default 3))) (define-record-type* php-fpm-static-process-manager-configuration make-php-fpm-static-process-manager-configuration php-fpm-static-process-manager-configuration? (max-children php-fpm-static-process-manager-configuration-max-children (default 5))) (define-record-type* php-fpm-on-demand-process-manager-configuration make-php-fpm-on-demand-process-manager-configuration php-fpm-on-demand-process-manager-configuration? (max-children php-fpm-on-demand-process-manager-configuration-max-children (default 5)) (process-idle-timeout php-fpm-on-demand-process-manager-configuration-process-idle-timeout (default 10))) (define php-fpm-accounts (match-lambda (($ php socket user group socket-user socket-group _ _ _ _ _ _) (list (user-group (name "php-fpm") (system? #t)) (user-group (name group) (system? #t)) (user-account (name user) (group group) (supplementary-groups '("php-fpm")) (system? #t) (comment "php-fpm daemon user") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))))) (define (default-php-fpm-config socket user group socket-user socket-group pid-file log-file pm display-errors timezone workers-log-file) (apply mixed-text-file "php-fpm.conf" (flatten "[global]\n" "pid =" pid-file "\n" "error_log =" log-file "\n" "[www]\n" "user =" user "\n" "group =" group "\n" "listen =" socket "\n" "listen.owner =" socket-user "\n" "listen.group =" socket-group "\n" (if timezone (string-append "php_admin_value[date.timezone] = \"" timezone "\"\n") "") (match pm (($ pm.max-children pm.start-servers pm.min-spare-servers pm.max-spare-servers) (list "pm = dynamic\n" "pm.max_children =" (number->string pm.max-children) "\n" "pm.start_servers =" (number->string pm.start-servers) "\n" "pm.min_spare_servers =" (number->string pm.min-spare-servers) "\n" "pm.max_spare_servers =" (number->string pm.max-spare-servers) "\n")) (($ pm.max-children) (list "pm = static\n" "pm.max_children =" (number->string pm.max-children) "\n")) (($ pm.max-children pm.process-idle-timeout) (list "pm = ondemand\n" "pm.max_children =" (number->string pm.max-children) "\n" "pm.process_idle_timeout =" (number->string pm.process-idle-timeout) "s\n"))) "php_flag[display_errors] = " (if display-errors "on" "off") "\n" (if workers-log-file (list "catch_workers_output = yes\n" "php_admin_value[error_log] =" workers-log-file "\n" "php_admin_flag[log_errors] = on\n") (list "catch_workers_output = no\n"))))) (define php-fpm-shepherd-service (match-lambda (($ php socket user group socket-user socket-group pid-file log-file pm display-errors timezone workers-log-file file) (list (shepherd-service (provision '(php-fpm)) (documentation "Run the php-fpm daemon.") (requirement '(networking)) (start #~(make-forkexec-constructor '(#$(file-append php "/sbin/php-fpm") "--fpm-config" #$(or file (default-php-fpm-config socket user group socket-user socket-group pid-file log-file pm display-errors timezone workers-log-file))) #:pid-file #$pid-file)) (stop #~(make-kill-destructor))))))) (define (php-fpm-activation config) #~(begin (use-modules (guix build utils)) (let* ((user (getpwnam #$(php-fpm-configuration-user config))) (touch (lambda (file-name) (call-with-output-file file-name (const #t)))) (workers-log-file #$(php-fpm-configuration-workers-log-file config)) (init-log-file (lambda (file-name) (when workers-log-file (when (not (file-exists? file-name)) (touch file-name)) (chown file-name (passwd:uid user) (passwd:gid user)) (chmod file-name #o660))))) (init-log-file #$(php-fpm-configuration-log-file config)) (init-log-file workers-log-file)))) (define php-fpm-service-type (service-type (name 'php-fpm) (description "Run @command{php-fpm} to provide a fastcgi socket for calling php through a webserver.") (extensions (list (service-extension shepherd-root-service-type php-fpm-shepherd-service) (service-extension activation-service-type php-fpm-activation) (service-extension account-service-type php-fpm-accounts))) (default-value (php-fpm-configuration)))) (define* (nginx-php-location #:key (nginx-package nginx) (socket (string-append "/var/run/php" (version-major (package-version php)) "-fpm.sock"))) "Return a nginx-location-configuration that makes nginx run .php files." (nginx-location-configuration (uri "~ \\.php$") (body (list "fastcgi_split_path_info ^(.+\\.php)(/.+)$;" (string-append "fastcgi_pass unix:" socket ";") "fastcgi_index index.php;" (list "include " nginx-package "/share/nginx/conf/fastcgi.conf;"))))) (define* (cat-avatar-generator-service #:key (cache-dir "/var/cache/cat-avatar-generator") (package cat-avatar-generator) (configuration (nginx-server-configuration))) (simple-service 'cat-http-server nginx-service-type (list (nginx-server-configuration (inherit configuration) (locations (cons (let ((base (nginx-php-location))) (nginx-location-configuration (inherit base) (body (list (string-append "fastcgi_param CACHE_DIR \"" cache-dir "\";") (nginx-location-configuration-body base))))) (nginx-server-configuration-locations configuration))) (root #~(string-append #$package "/share/web/cat-avatar-generator")))))) (define-record-type* hpcguix-web-configuration make-hpcguix-web-configuration hpcguix-web-configuration? (package hpcguix-web-package (default hpcguix-web)) ; ;; Specs is gexp of hpcguix-web configuration file (specs hpcguix-web-configuration-specs)) (define %hpcguix-web-accounts (list (user-group (name "hpcguix-web") (system? #t)) (user-account (name "hpcguix-web") (group "hpcguix-web") (system? #t) (comment "hpcguix-web") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) (define %hpcguix-web-activation (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils) (ice-9 ftw)) (let ((home-dir "/var/cache/guix/web") (user (getpwnam "hpcguix-web"))) (mkdir-p home-dir) (chown home-dir (passwd:uid user) (passwd:gid user)) (chmod home-dir #o755) ;; Remove stale 'packages.json.lock' file (and other lock files, if ;; any) since that would prevent 'packages.json' from being updated. (for-each (lambda (lock) (delete-file (string-append home-dir "/" lock))) (scandir home-dir (lambda (file) (string-suffix? ".lock" file)))))))) (define %hpcguix-web-log-file "/var/log/hpcguix-web.log") (define %hpcguix-web-log-rotations (list (log-rotation (files (list %hpcguix-web-log-file)) (frequency 'weekly)))) (define (hpcguix-web-shepherd-service config) (let ((specs (hpcguix-web-configuration-specs config)) (hpcguix-web (hpcguix-web-package config))) (with-imported-modules (source-module-closure '((gnu build shepherd))) (shepherd-service (documentation "hpcguix-web daemon") (provision '(hpcguix-web)) (requirement '(networking)) (start #~(make-forkexec-constructor (list #$(file-append hpcguix-web "/bin/run") (string-append "--config=" #$(scheme-file "hpcguix-web.scm" specs))) #:user "hpcguix-web" #:group "hpcguix-web" #:environment-variables (list "XDG_CACHE_HOME=/var/cache" "SSL_CERT_DIR=/etc/ssl/certs") #:log-file #$%hpcguix-web-log-file)) (stop #~(make-kill-destructor)))))) (define hpcguix-web-service-type (service-type (name 'hpcguix-web) (description "Run the hpcguix-web server.") (extensions (list (service-extension account-service-type (const %hpcguix-web-accounts)) (service-extension activation-service-type (const %hpcguix-web-activation)) (service-extension rottlog-service-type (const %hpcguix-web-log-rotations)) (service-extension shepherd-root-service-type (compose list hpcguix-web-shepherd-service)))))) ;;; ;;; Tailon ;;; (define-record-type* tailon-configuration-file make-tailon-configuration-file tailon-configuration-file? (files tailon-configuration-file-files (default '("/var/log"))) (bind tailon-configuration-file-bind (default "localhost:8080")) (relative-root tailon-configuration-file-relative-root (default #f)) (allow-transfers? tailon-configuration-file-allow-transfers? (default #t)) (follow-names? tailon-configuration-file-follow-names? (default #t)) (tail-lines tailon-configuration-file-tail-lines (default 200)) (allowed-commands tailon-configuration-file-allowed-commands (default '("tail" "grep" "awk"))) (debug? tailon-configuration-file-debug? (default #f)) (wrap-lines tailon-configuration-file-wrap-lines (default #t)) (http-auth tailon-configuration-file-http-auth (default #f)) (users tailon-configuration-file-users (default #f))) (define (tailon-configuration-files-string files) (string-append "\n" (string-join (map (lambda (x) (string-append " - " (cond ((string? x) (simple-format #f "'~A'" x)) ((list? x) (string-join (cons (simple-format #f "'~A':" (car x)) (map (lambda (x) (simple-format #f " - '~A'" x)) (cdr x))) "\n")) (else (error x))))) files) "\n"))) (define-gexp-compiler (tailon-configuration-file-compiler (file ) system target) (match file (($ files bind relative-root allow-transfers? follow-names? tail-lines allowed-commands debug? wrap-lines http-auth users) (text-file "tailon-config.yaml" (string-concatenate (filter-map (match-lambda ((key . #f) #f) ((key . value) (string-append key ": " value "\n"))) `(("files" . ,(tailon-configuration-files-string files)) ("bind" . ,bind) ("relative-root" . ,relative-root) ("allow-transfers" . ,(if allow-transfers? "true" "false")) ("follow-names" . ,(if follow-names? "true" "false")) ("tail-lines" . ,(number->string tail-lines)) ("commands" . ,(string-append "[" (string-join allowed-commands ", ") "]")) ("debug" . ,(if debug? "true" #f)) ("wrap-lines" . ,(if wrap-lines "true" "false")) ("http-auth" . ,http-auth) ("users" . ,(if users (string-concatenate (cons "\n" (map (match-lambda ((user . pass) (string-append " " user ":" pass))) users))) #f))))))))) (define-record-type* tailon-configuration make-tailon-configuration tailon-configuration? (config-file tailon-configuration-config-file (default (tailon-configuration-file))) (package tailon-configuration-package (default tailon))) (define tailon-shepherd-service (match-lambda (($ config-file package) (list (shepherd-service (provision '(tailon)) (documentation "Run the tailon daemon.") (start #~(make-forkexec-constructor `(,(string-append #$package "/bin/tailon") "-c" ,#$config-file) #:user "tailon" #:group "tailon")) (stop #~(make-kill-destructor))))))) (define %tailon-accounts (list (user-group (name "tailon") (system? #t)) (user-account (name "tailon") (group "tailon") (system? #t) (comment "tailon") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) (define tailon-service-type (service-type (name 'tailon) (description "Run Tailon, a Web application for monitoring, viewing, and searching log files.") (extensions (list (service-extension shepherd-root-service-type tailon-shepherd-service) (service-extension account-service-type (const %tailon-accounts)))) (compose concatenate) (extend (lambda (parameter files) (tailon-configuration (inherit parameter) (config-file (let ((old-config-file (tailon-configuration-config-file parameter))) (tailon-configuration-file (inherit old-config-file) (files (append (tailon-configuration-file-files old-config-file) files)))))))) (default-value (tailon-configuration)))) ;;; ;;; Varnish ;;; (define-record-type* varnish-configuration make-varnish-configuration varnish-configuration? (package varnish-configuration-package ; (default varnish)) (name varnish-configuration-name ;string (default "default")) (backend varnish-configuration-backend ;string (default "localhost:8080")) (vcl varnish-configuration-vcl ;#f | (default #f)) (listen varnish-configuration-listen ;list of strings (default '("localhost:80"))) (storage varnish-configuration-storage ;list of strings (default '("malloc,128m"))) (parameters varnish-configuration-parameters ;list of string pairs (default '())) (extra-options varnish-configuration-extra-options ;list of strings (default '()))) (define %varnish-accounts (list (user-group (name "varnish") (system? #t)) (user-account (name "varnish") (group "varnish") (system? #t) (comment "Varnish Cache User") (home-directory "/var/varnish") (shell (file-append shadow "/sbin/nologin"))))) (define varnish-shepherd-service (match-lambda (($ package name backend vcl listen storage parameters extra-options) (list (shepherd-service (provision (list (symbol-append 'varnish- (string->symbol name)))) (documentation (string-append "The Varnish Web Accelerator" " (" name ")")) (requirement '(networking)) (start #~(make-forkexec-constructor (list #$(file-append package "/sbin/varnishd") "-n" #$name #$@(if vcl #~("-f" #$vcl) #~("-b" #$backend)) #$@(append-map (lambda (a) (list "-a" a)) listen) #$@(append-map (lambda (s) (list "-s" s)) storage) #$@(append-map (lambda (p) (list "-p" (format #f "~a=~a" (car p) (cdr p)))) parameters) #$@extra-options) ;; Varnish will drop privileges to the "varnish" user when ;; it exists. Not passing #:user here allows the service ;; to bind to ports < 1024. #:pid-file (if (string-prefix? "/" #$name) (string-append #$name "/_.pid") (string-append "/var/varnish/" #$name "/_.pid")))) (stop #~(make-kill-destructor))))))) (define varnish-service-type (service-type (name 'varnish) (description "Run the Varnish cache server.") (extensions (list (service-extension account-service-type (const %varnish-accounts)) (service-extension shepherd-root-service-type varnish-shepherd-service))) (default-value (varnish-configuration)))) ;;; ;;; Patchwork ;;; (define-record-type* patchwork-database-configuration make-patchwork-database-configuration patchwork-database-configuration? (engine patchwork-database-configuration-engine (default "django.db.backends.postgresql_psycopg2")) (name patchwork-database-configuration-name (default "patchwork")) (user patchwork-database-configuration-user (default "httpd")) (password patchwork-database-configuration-password (default "")) (host patchwork-database-configuration-host (default "")) (port patchwork-database-configuration-port (default ""))) (define-record-type* patchwork-settings-module make-patchwork-settings-module patchwork-settings-module? (database-configuration patchwork-settings-module-database-configuration (default (patchwork-database-configuration))) (secret-key-file patchwork-settings-module-secret-key-file (default "/etc/patchwork/django-secret-key")) (allowed-hosts patchwork-settings-module-allowed-hosts) (default-from-email patchwork-settings-module-default-from-email) (static-url patchwork-settings-module-static-url (default "/static/")) (admins patchwork-settings-module-admins (default '())) (debug? patchwork-settings-module-debug? (default #f)) (enable-rest-api? patchwork-settings-module-enable-rest-api? (default #t)) (enable-xmlrpc? patchwork-settings-module-enable-xmlrpc? (default #t)) (force-https-links? patchwork-settings-module-force-https-links? (default #t)) (extra-settings patchwork-settings-module-extra-settings (default ""))) (define-record-type* patchwork-configuration make-patchwork-configuration patchwork-configuration? (patchwork patchwork-configuration-patchwork (default patchwork)) (domain patchwork-configuration-domain) (settings-module patchwork-configuration-settings-module) (static-path patchwork-configuration-static-url (default "/static/")) (getmail-retriever-config getmail-retriever-config)) ;; Django uses a Python module for configuration, so this compiler generates a ;; Python module from the configuration record. (define-gexp-compiler (patchwork-settings-module-compiler (file ) system target) (match file (($ database-configuration secret-key-file allowed-hosts default-from-email static-url admins debug? enable-rest-api? enable-xmlrpc? force-https-links? extra-configuration) (gexp->derivation "patchwork-settings" (with-imported-modules '((guix build utils)) #~(let ((output #$output)) (define (create-__init__.py filename) (call-with-output-file filename (lambda (port) (display "" port)))) (use-modules (guix build utils) (srfi srfi-1)) (mkdir-p (string-append output "/guix/patchwork")) (create-__init__.py (string-append output "/guix/__init__.py")) (create-__init__.py (string-append output "/guix/patchwork/__init__.py")) (call-with-output-file (string-append output "/guix/patchwork/settings.py") (lambda (port) (display (string-append "from patchwork.settings.base import * # Configuration from Guix with open('" #$secret-key-file "') as f: SECRET_KEY = f.read().strip() ALLOWED_HOSTS = [ " #$(string-concatenate (map (lambda (allowed-host) (string-append " '" allowed-host "'\n")) allowed-hosts)) "] DEFAULT_FROM_EMAIL = '" #$default-from-email "' SERVER_EMAIL = DEFAULT_FROM_EMAIL NOTIFICATION_FROM_EMAIL = DEFAULT_FROM_EMAIL ADMINS = [ " #$(string-concatenate (map (match-lambda ((name email-address) (string-append "('" name "','" email-address "'),"))) admins)) "] DEBUG = " #$(if debug? "True" "False") " ENABLE_REST_API = " #$(if enable-rest-api? "True" "False") " ENABLE_XMLRPC = " #$(if enable-xmlrpc? "True" "False") " FORCE_HTTPS_LINKS = " #$(if force-https-links? "True" "False") " DATABASES = { 'default': { " #$(match database-configuration (($ engine name user password host port) (string-append " 'ENGINE': '" engine "',\n" " 'NAME': '" name "',\n" " 'USER': '" user "',\n" " 'PASSWORD': '" password "',\n" " 'HOST': '" host "',\n" " 'PORT': '" port "',\n"))) " }, } " #$(if debug? #~(string-append "STATIC_ROOT = '" #$(file-append patchwork "/share/patchwork/htdocs") "'") #~(string-append "STATIC_URL = '" #$static-url "'")) " STATICFILES_STORAGE = ( 'django.contrib.staticfiles.storage.StaticFilesStorage' ) # Guix Extra Configuration " #$extra-configuration " ") port))) #t)) #:local-build? #t)))) (define patchwork-virtualhost (match-lambda (($ patchwork domain settings-module static-path getmail-retriever-config) (define wsgi.py (file-append patchwork (string-append "/lib/python" (version-major+minor (package-version python)) "/site-packages/patchwork/wsgi.py"))) (httpd-virtualhost "*:8080" `("ServerAdmin admin@example.com` ServerName " ,domain " LogFormat \"%v %h %l %u %t \\\"%r\\\" %>s %b \\\"%{Referer}i\\\" \\\"%{User-Agent}i\\\"\" customformat LogLevel info CustomLog \"/var/log/httpd/" ,domain "-access_log\" customformat ErrorLog /var/log/httpd/error.log WSGIScriptAlias / " ,wsgi.py " WSGIDaemonProcess " ,(package-name patchwork) " user=httpd group=httpd processes=1 threads=2 display-name=%{GROUP} lang='en_US.UTF-8' locale='en_US.UTF-8' python-path=" ,settings-module " WSGIProcessGroup " ,(package-name patchwork) " WSGIPassAuthorization On Require all granted " ,@(if static-path `("Alias " ,static-path " " ,patchwork "/share/patchwork/htdocs/") '()) " AllowOverride None Options MultiViews Indexes SymlinksIfOwnerMatch IncludesNoExec Require method GET POST OPTIONS "))))) (define (patchwork-httpd-configuration patchwork-configuration) (list "WSGISocketPrefix /var/run/mod_wsgi" (list "LoadModule wsgi_module " (file-append mod-wsgi "/modules/mod_wsgi.so")) (patchwork-virtualhost patchwork-configuration))) (define (patchwork-django-admin-gexp patchwork settings-module) #~(lambda command (let ((pid (primitive-fork)) (user (getpwnam "httpd"))) (if (eq? pid 0) (dynamic-wind (const #t) (lambda () (setgid (passwd:gid user)) (setuid (passwd:uid user)) (setenv "DJANGO_SETTINGS_MODULE" "guix.patchwork.settings") (setenv "PYTHONPATH" #$settings-module) (primitive-exit (if (zero? (apply system* #$(file-append patchwork "/bin/patchwork-admin") command)) 0 1))) (lambda () (primitive-exit 1))) (zero? (cdr (waitpid pid))))))) (define (patchwork-django-admin-action patchwork settings-module) (shepherd-action (name 'django-admin) (documentation "Run a django admin command for patchwork") (procedure (patchwork-django-admin-gexp patchwork settings-module)))) (define patchwork-shepherd-services (match-lambda (($ patchwork domain settings-module static-path getmail-retriever-config) (define secret-key-file-creation-gexp (if (patchwork-settings-module? settings-module) (with-extensions (list guile-gcrypt) #~(let ((secret-key-file #$(patchwork-settings-module-secret-key-file settings-module))) (use-modules (guix build utils) (gcrypt random)) (unless (file-exists? secret-key-file) (mkdir-p (dirname secret-key-file)) (call-with-output-file secret-key-file (lambda (port) (display (random-token 30 'very-strong) port))) (let* ((pw (getpwnam "httpd")) (uid (passwd:uid pw)) (gid (passwd:gid pw))) (chown secret-key-file uid gid) (chmod secret-key-file #o400))))) #~())) (list (shepherd-service (requirement '(postgres)) (provision (list (string->symbol (string-append (package-name patchwork) "-setup")))) (start #~(lambda () (define run-django-admin-command #$(patchwork-django-admin-gexp patchwork settings-module)) #$secret-key-file-creation-gexp (run-django-admin-command "migrate"))) (stop #~(const #f)) (actions (list (patchwork-django-admin-action patchwork settings-module))) (respawn? #f) (documentation "Setup Patchwork.")))))) (define patchwork-getmail-configs (match-lambda (($ patchwork domain settings-module static-path getmail-retriever-config) (list (getmail-configuration (name (string->symbol (package-name patchwork))) (user "httpd") (directory (string-append "/var/lib/getmail/" (package-name patchwork))) (rcfile (getmail-configuration-file (retriever getmail-retriever-config) (destination (getmail-destination-configuration (type "MDA_external") (path (file-append patchwork "/bin/patchwork-admin")) (extra-parameters '((arguments . ("parsemail")))))) (options (getmail-options-configuration (read-all #f) (delivered-to #f) (received #f))))) (idle (assq-ref (getmail-retriever-configuration-extra-parameters getmail-retriever-config) 'mailboxes)) (environment-variables (list "DJANGO_SETTINGS_MODULE=guix.patchwork.settings" #~(string-append "PYTHONPATH=" #$settings-module)))))))) (define patchwork-service-type (service-type (name 'patchwork-setup) (extensions (list (service-extension httpd-service-type patchwork-httpd-configuration) (service-extension shepherd-root-service-type patchwork-shepherd-services) (service-extension getmail-service-type patchwork-getmail-configs))) (description "Patchwork patch tracking system."))) ;;; ;;; Mumi. ;;; (define %mumi-activation (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils)) (mkdir-p "/var/mumi/db") (mkdir-p "/var/mumi/mails") (let* ((pw (getpwnam "mumi")) (uid (passwd:uid pw)) (gid (passwd:gid pw))) (chown "/var/mumi" uid gid) (chown "/var/mumi/mails" uid gid) (chown "/var/mumi/db" uid gid))))) (define %mumi-accounts (list (user-group (name "mumi") (system? #t)) (user-account (name "mumi") (group "mumi") (system? #t) (comment "Mumi web server") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) (define (mumi-shepherd-services mumi) (list (shepherd-service (provision '(mumi)) (documentation "Mumi bug-tracking web interface.") (requirement '(networking)) (start #~(make-forkexec-constructor '(#$(file-append mumi "/bin/mumi")) #:user "mumi" #:group "mumi" #:log-file "/var/log/mumi.log")) (stop #~(make-kill-destructor))) (shepherd-service (provision '(mumi-worker)) (documentation "Mumi bug-tracking web interface.") (requirement '(networking)) (start #~(make-forkexec-constructor '(#$(file-append mumi "/bin/mumi") "--worker") #:user "mumi" #:group "mumi" #:log-file "/var/log/mumi.worker.log")) (stop #~(make-kill-destructor))))) (define mumi-service-type (service-type (name 'mumi) (extensions (list (service-extension activation-service-type (const %mumi-activation)) (service-extension account-service-type (const %mumi-accounts)) (service-extension shepherd-root-service-type mumi-shepherd-services))) (description "Run Mumi, a Web interface to the Debbugs bug-tracking server.") (default-value mumi)))