ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-14 10:55:23 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions
guix/gnu/services/web.scm
nikita 3c986a7dc2
mailmap: Update entries for Nikita. 
* .mailmap: change email and name for Nikita.
* Makefile.am, doc/guix.texi, etc/completion/fish/guix.fish,
gnu/packages/accessibility.scm, gnu/packages/admin.scm,
gnu/packages/audio.scm, gnu/packages/autotools.scm, gnu/packages/cdrom.scm,
gnu/packages/check.scm, gnu/packages/cinnamon.scm,
gnu/packages/compression.scm, gnu/packages/crypto.scm,
gnu/packages/databases.scm, gnu/packages/django.scm, gnu/packages/dns.scm,
gnu/packages/elixir.scm, gnu/packages/emacs-xyz.scm, gnu/packages/emacs.scm,
gnu/packages/enlightenment.scm, gnu/packages/erlang.scm,
gnu/packages/fonts.scm, gnu/packages/fontutils.scm, gnu/packages/forth.scm,
gnu/packages/fvwm.scm, gnu/packages/games.scm, gnu/packages/gl.scm,
gnu/packages/gnome.scm, gnu/packages/gnunet.scm, gnu/packages/gnupg.scm,
gnu/packages/gtk.scm, gnu/packages/guile-wm.scm, gnu/packages/guile-xyz.scm,
gnu/packages/haskell-apps.scm, gnu/packages/haskell-check.scm,
gnu/packages/haskell-crypto.scm, gnu/packages/haskell-xyz.scm,
gnu/packages/haskell.scm, gnu/packages/image-viewers.scm,
gnu/packages/image.scm, gnu/packages/irc.scm, gnu/packages/language.scm,
gnu/packages/libcanberra.scm, gnu/packages/linux.scm,
gnu/packages/lisp-xyz.scm, gnu/packages/lisp.scm, gnu/packages/lolcode.scm,
gnu/packages/lxde.scm, gnu/packages/lxqt.scm, gnu/packages/mail.scm,
gnu/packages/markup.scm, gnu/packages/mate.scm, gnu/packages/maths.scm,
gnu/packages/mc.scm, gnu/packages/messaging.scm, gnu/packages/music.scm,
gnu/packages/ncurses.scm, gnu/packages/networking.scm,
gnu/packages/nickle.scm, gnu/packages/openbox.scm, gnu/packages/pdf.scm,
gnu/packages/perl-check.scm, gnu/packages/perl.scm,
gnu/packages/python-compression.scm, gnu/packages/python-crypto.scm,
gnu/packages/python-web.scm, gnu/packages/python-xyz.scm,
gnu/packages/python.scm, gnu/packages/qt.scm, gnu/packages/ruby.scm,
gnu/packages/rust.scm, gnu/packages/scheme.scm,
gnu/packages/serialization.scm, gnu/packages/shells.scm,
gnu/packages/ssh.scm, gnu/packages/suckless.scm, gnu/packages/tbb.scm,
gnu/packages/telephony.scm, gnu/packages/text-editors.scm,
gnu/packages/textutils.scm, gnu/packages/time.scm, gnu/packages/tls.scm,
gnu/packages/tor.scm, gnu/packages/version-control.scm,
gnu/packages/video.scm, gnu/packages/vim.scm, gnu/packages/web.scm,
gnu/packages/wm.scm, gnu/packages/xdisorg.scm, gnu/packages/xfce.scm,
gnu/packages/xml.scm, gnu/packages/xorg.scm, gnu/services/certbot.scm,
gnu/services/desktop.scm, gnu/services/version-control.scm,
gnu/services/web.scm, guix/import/hackage.scm, guix/licenses.scm: Likewise.

Signed-off-by: Efraim Flashner <efraim@flashner.co.il>
2020-05-13 09:30:26 +03:00

1772 lines
70 KiB
Scheme
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Nikita <nikita@n0.is>
;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2017 nee <nee-git@hidamari.blue>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;; Copyright © 2017, 2018, 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2019, 2020 Florian Pelz <pelzflorian@pelzflorian.de>
;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(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?
httpd-configuration-package
httpd-configuration-pid-file
httpd-configuration-config
<httpd-virtualhost>
httpd-virtualhost
httpd-virtualhost?
httpd-virtualhost-addresses-and-ports
httpd-virtualhost-contents
<httpd-config-file>
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
httpd-module?
%default-httpd-modules
httpd-service-type
<nginx-configuration>
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-global-directives
nginx-configuration-extra-content
nginx-configuration-file
<nginx-server-configuration>
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?
nginx-upstream-configuration-name
nginx-upstream-configuration-servers
<nginx-location-configuration>
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?
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>
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>
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>
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>
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?
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?
tailon-configuration-config-file
tailon-configuration-package
tailon-service-type
<varnish-configuration>
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?
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?
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-configuration-patchwork
patchwork-configuration-settings-module
patchwork-configuration-domain
patchwork-virtualhost
patchwork-service-type
<mumi-configuration>
mumi-configuration
mumi-configuration?
mumi-configuration-mumi
mumi-configuration-mailer?
mumi-configuration-sender
mumi-configuration-smtp
mumi-service-type))
;;; Commentary:
;;;
;;; Web services.
;;;
;;; Code:
(define-record-type* <httpd-module>
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>
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 <httpd-config-file>) system target)
(match file
(($ <httpd-config-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
(($ <httpd-module> 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>
(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>
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
(($ <httpd-configuration> 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
(($ <httpd-configuration> package pid-file config)
(match-record
config
<httpd-config-file>
(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
(($ <httpd-virtualhost>
addresses-and-ports
contents)
`(,(string-append
"\n<VirtualHost " addresses-and-ports ">\n")
,@contents
"\n</VirtualHost>\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>
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>
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>
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>
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>
nginx-configuration make-nginx-configuration
nginx-configuration?
(nginx nginx-configuration-nginx ;<package>
(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 <nginx-server-configuration>
(upstream-blocks nginx-configuration-upstream-blocks
(default '())) ;list of <nginx-upstream-configuration>
(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 '((events . ()))))
(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
(($ <nginx-location-configuration> uri body)
(list
" location " uri " {\n"
(map (lambda (x) (list " " x "\n")) body)
" }\n"))
(($ <nginx-named-location-configuration> 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-configuration>
(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-load-module modules)
(map emit-global-directive global-directives)
"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-configuration>
(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-configuration>
(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> fcgiwrap-configuration
make-fcgiwrap-configuration
fcgiwrap-configuration?
(package fcgiwrap-configuration-package ;<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
(($ <fcgiwrap-configuration> 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
(($ <fcgiwrap-configuration> 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> php-fpm-configuration
make-php-fpm-configuration
php-fpm-configuration?
(php php-fpm-configuration-php ;<package>
(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>
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>
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>
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-fpm-configuration> 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
(($ <php-fpm-dynamic-process-manager-configuration>
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"))
(($ <php-fpm-static-process-manager-configuration>
pm.max-children)
(list
"pm = static\n"
"pm.max_children =" (number->string pm.max-children) "\n"))
(($ <php-fpm-on-demand-process-manager-configuration>
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-fpm-configuration> 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>
hpcguix-web-configuration make-hpcguix-web-configuration
hpcguix-web-configuration?
(package hpcguix-web-package (default hpcguix-web)) ;<package>
;; 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>
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 <tailon-configuration-file>) system target)
(match file
(($ <tailon-configuration-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>
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
(($ <tailon-configuration> 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>
varnish-configuration make-varnish-configuration
varnish-configuration?
(package varnish-configuration-package ;<package>
(default varnish))
(name varnish-configuration-name ;string
(default "default"))
(backend varnish-configuration-backend ;string
(default "localhost:8080"))
(vcl varnish-configuration-vcl ;#f | <file-like>
(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
(($ <varnish-configuration> 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>
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>
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>
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 <patchwork-settings-module>) system target)
(match file
(($ <patchwork-settings-module> 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
(($ <patchwork-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-configuration> 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
<Files " ,wsgi.py ">
Require all granted
</Files>
" ,@(if static-path
`("Alias " ,static-path " " ,patchwork "/share/patchwork/htdocs/")
'())
"
<Directory \"/srv/http/" ,domain "/\">
AllowOverride None
Options MultiViews Indexes SymlinksIfOwnerMatch IncludesNoExec
Require method GET POST OPTIONS
</Directory>")))))
(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-configuration> 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-configuration> 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-record-type* <mumi-configuration>
mumi-configuration make-mumi-configuration
mumi-configuration?
(mumi mumi-configuration-mumi (default mumi))
(mailer? mumi-configuration-mailer? (default #t))
(sender mumi-configuration-sender (default #f))
(smtp mumi-configuration-smtp (default #f)))
(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 config)
(match config
(($ <mumi-configuration> mumi mailer? sender smtp)
(list (shepherd-service
(provision '(mumi))
(documentation "Mumi bug-tracking web interface.")
(requirement '(networking))
(start #~(make-forkexec-constructor
`(#$(file-append mumi "/bin/mumi") "web"
,@(if #$mailer? '() '("--disable-mailer")))
#: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 database worker.")
(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)))
(shepherd-service
(provision '(mumi-mailer))
(documentation "Mumi bug-tracking web interface mailer.")
(requirement '(networking))
(start #~(make-forkexec-constructor
`(#$(file-append mumi "/bin/mumi") "mailer"
,@(if #$sender
(list (string-append "--sender=" #$sender))
'())
,@(if #$smtp
(list (string-append "--smtp=" #$smtp))
'()))
#:user "mumi" #:group "mumi"
#:log-file "/var/log/mumi.mailer.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-configuration))))
Reference in a new issue View git blame Copy permalink