From patchwork Fri May 3 19:30:37 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 13888 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 71FF416F58; Fri, 3 May 2019 20:31:17 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,UNPARSEABLE_RELAY, URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 5ECCA16F4D for ; Fri, 3 May 2019 20:31:14 +0100 (BST) Received: from localhost ([127.0.0.1]:46434 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hMdtp-0007Qg-Tp for patchwork@mira.cbaines.net; Fri, 03 May 2019 15:31:13 -0400 Received: from eggs.gnu.org ([209.51.188.92]:60700) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hMdti-0007P8-UG for guix-patches@gnu.org; Fri, 03 May 2019 15:31:11 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hMdte-0000lR-5w for guix-patches@gnu.org; Fri, 03 May 2019 15:31:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:36164) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hMdte-0000lK-1H for guix-patches@gnu.org; Fri, 03 May 2019 15:31:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hMdtd-0002uk-QR for guix-patches@gnu.org; Fri, 03 May 2019 15:31:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#33185] [PATCH 3/3] services: Add patchwork. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 03 May 2019 19:31:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 33185 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 33185@debbugs.gnu.org Received: via spool by 33185-submit@debbugs.gnu.org id=B33185.155691185111180 (code B ref 33185); Fri, 03 May 2019 19:31:01 +0000 Received: (at 33185) by debbugs.gnu.org; 3 May 2019 19:30:51 +0000 Received: from localhost ([127.0.0.1]:49704 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hMdtK-0002u6-Dv for submit@debbugs.gnu.org; Fri, 03 May 2019 15:30:51 -0400 Received: from mira.cbaines.net ([212.71.252.8]:58912) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hMdtG-0002tj-Q9 for 33185@debbugs.gnu.org; Fri, 03 May 2019 15:30:40 -0400 Received: from localhost (cpc102582-walt20-2-0-cust14.13-2.cable.virginm.net [86.27.34.15]) by mira.cbaines.net (Postfix) with ESMTPSA id 01A9E16F58 for <33185@debbugs.gnu.org>; Fri, 3 May 2019 20:30:37 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 0fac7396 for <33185@debbugs.gnu.org>; Fri, 3 May 2019 19:30:37 +0000 (UTC) From: Christopher Baines Date: Fri, 3 May 2019 20:30:37 +0100 Message-Id: <20190503193037.27035-3-mail@cbaines.net> X-Mailer: git-send-email 2.21.0 In-Reply-To: <20190503193037.27035-1-mail@cbaines.net> References: <87o94jqrff.fsf@cbaines.net> <20190503193037.27035-1-mail@cbaines.net> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/service/web.scm ( , ): New record types. (patchwork-virtualhost): New procedure. (patchwork-service-type): New variable. * gnu/tests/web.scm (%test-patchwork): New variable. * doc/guix.text (Web Services): Document it. --- doc/guix.texi | 174 ++++++++++++++++++++ gnu/services/web.scm | 368 ++++++++++++++++++++++++++++++++++++++++++- gnu/tests/web.scm | 164 ++++++++++++++++++- 3 files changed, 702 insertions(+), 4 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index e23d178697..cd70de5cb5 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -19323,6 +19323,180 @@ Additional arguments to pass to the @command{varnishd} process. @end table @end deftp +@subsubheading Patchwork +@cindex Patchwork +Patchwork is a patch tracking system. It can collect patches sent to a +mailing list, and display them in a web interface. + +@defvr {Scheme Variable} patchwork-service-type +Service type for Patchwork. +@end defvr + +The following example is an example of a minimal service for Patchwork, for +the @code{patchwork.example.com} domain. + +@example +(service patchwork-service-type + (patchwork-configuration + (domain "patchwork.example.com") + (settings-module + (patchwork-settings-module + (allowed-hosts (list domain)) + (default-from-email "patchwork@@patchwork.example.com"))) + (getmail-retriever-config + (getmail-retriever-configuration + (type "SimpleIMAPSSLRetriever") + (server "imap.example.com") + (port 993) + (username "patchwork") + (password-command + (list (file-append coreutils "/bin/cat") + "/etc/getmail-patchwork-imap-password")) + (extra-parameters + '((mailboxes . ("Patches")))))))) + +@end example + +There are three records for configuring the Patchwork service. The +@code{} relates to the configuration for Patchwork +within the HTTPD service. + +The @code{settings-module} field within the @code{} +record can be populated with the @code{} record, +which describes a settings module that is generated within the Guix store. + +For the @code{database-configuration} field within the +@code{}, the +@code{} must be used. + +@deftp {Data Type} patchwork-configuration +Data type representing the Patchwork service configuration. This type has the +following parameters: + +@table @asis +@item @code{patchwork} (default: @code{patchwork}) +The Patchwork package to use. + +@item @code{domain} +The domain to use for Patchwork, this is used in the HTTPD service virtual +host. + +@item @code{settings-module} +The settings module to use for Patchwork. As a Django application, Patchwork +is configured with a Python module containing the settings. This can either be +an instance of the @code{} record, any other record +that represents the settings in the store, or a directory outside of the +store. + +@item @code{static-path} (default: @code{"/static/"}) +The path under which the HTTPD service should serve the static files. + +@item @code{getmail-retriever-config} +The getmail-retriever-configuration record value to use with +Patchwork. Getmail will be configured with this value, the messages will be +delivered to Patchwork. + +@end table +@end deftp + +@deftp {Data Type} patchwork-settings-module +Data type representing a settings module for Patchwork. Some of these +settings relate directly to Patchwork, but others relate to Django, the web +framework used by Patchwork, or the Django Rest Framework library. This type +has the following parameters: + +@table @asis +@item @code{database-configuration} (default: @code{(patchwork-database-configuration)}) +The database connection settings used for Patchwork. See the +@code{} record type for more information. + +@item @code{secret-key-file} (default: @code{"/etc/patchwork/django-secret-key"}) +Patchwork, as a Django web application uses a secret key for cryptographically +signing values. This file should contain a unique unpredictable value. + +If this file does not exist, it will be created and populated with a random +value by the patchwork-setup shepherd service. + +This setting relates to Django. + +@item @code{allowed-hosts} +A list of valid hosts for this Patchwork service. This should at least include +the domain specified in the @code{} record. + +This is a Django setting. + +@item @code{default-from-email} +The email address from which Patchwork should send email by default. + +This is a Patchwork setting. + +@item @code{static-url} (default: @code{#f}) +The URL to use when serving static assets. It can be part of a URL, or a full +URL, but must end in a @code{/}. + +If the default value is used, the @code{static-path} value from the +@code{} record will be used. + +This is a Django setting. + +@item @code{admins} (default: @code{'()}) +Email addresses to send the details of errors that occur. Each value should +be a list containing two elements, the name and then the email address. + +This is a Django setting. + +@item @code{debug?} (default: @code{#f}) +Whether to run Patchwork in debug mode. If set to @code{#t}, detailed error +messages will be shown. + +This is a Django setting. + +@item @code{enable-rest-api?} (default: @code{#t}) +Whether to enable the Patchwork REST API. + +This is a Patchwork setting. + +@item @code{enable-xmlrpc?} (default: @code{#t}) +Whether to enable the XML RPC API. + +This is a Patchwork setting. + +@item @code{force-https-links?} (default: @code{#t}) +Whether to use HTTPS links on Patchwork pages. + +This is a Patchwork setting. + +@item @code{extra-settings} (default: @code{""}) +Extra code to place at the end of the Patchwork settings module. + +@end table +@end deftp + +@deftp {Data Type} patchwork-database-configuration +Data type representing the database configuration for Patchwork. + +@table @asis +@item @code{engine} (default: @code{"django.db.backends.postgresql_psycopg2"}) +The database engine to use. + +@item @code{name} (default: @code{"patchwork"}) +The name of the database to use. + +@item @code{user} (default: @code{"httpd"}) +The user to connect to the database as. + +@item @code{password} (default: @code{""}) +The password to use when connecting to the database. + +@item @code{host} (default: @code{""}) +The host to make the database connection to. + +@item @code{port} (default: @code{""}) +The port on which to connect to the database. + +@end table +@end deftp + @subsubheading FastCGI @cindex fastcgi @cindex fcgiwrap diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 84294db53b..35efddb0ae 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -7,7 +7,7 @@ ;;; Copyright © 2017 nee ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2018 Pierre-Antoine Rouby -;;; Copyright © 2017 Christopher Baines +;;; Copyright © 2017, 2018, 2019 Christopher Baines ;;; Copyright © 2018 Marius Bakke ;;; ;;; This file is part of GNU Guix. @@ -29,14 +29,23 @@ #: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 (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)) @@ -210,7 +219,42 @@ varnish-configuration-parameters varnish-configuration-extra-options - varnish-service-type)) + 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)) ;;; Commentary: ;;; @@ -1268,3 +1312,323 @@ files.") 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)) +"] + +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-xmlrpc? "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."))) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 319655396a..7c1c0aa511 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ludovic Courtès -;;; Copyright © 2017 Christopher Baines +;;; Copyright © 2017, 2019 Christopher Baines ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2018 Pierre-Antoine Rouby ;;; Copyright © 2018 Marius Bakke @@ -28,15 +28,29 @@ #:use-module (gnu system vm) #:use-module (gnu services) #:use-module (gnu services web) + #:use-module (gnu services databases) + #:use-module (gnu services getmail) #:use-module (gnu services networking) + #:use-module (gnu services shepherd) + #:use-module (gnu services mail) + #:use-module (gnu packages databases) + #:use-module (gnu packages patchutils) + #:use-module (gnu packages python) + #:use-module (gnu packages web) + #:use-module (guix packages) + #:use-module (guix modules) + #:use-module (guix records) #:use-module (guix gexp) #:use-module (guix store) + #:use-module (guix utils) + #:use-module (ice-9 match) #:export (%test-httpd %test-nginx %test-varnish %test-php-fpm %test-hpcguix-web - %test-tailon)) + %test-tailon + %test-patchwork)) (define %index.html-contents ;; Contents of the /index.html file. @@ -498,3 +512,149 @@ HTTP-PORT." (name "tailon") (description "Connect to a running Tailon server.") (value (run-tailon-test)))) + + +;;; +;;; Patchwork +;;; + +(define patchwork-initial-database-setup-service + (match-lambda + (($ + engine name user password host port) + + (define start-gexp + #~(lambda () + (let ((pid (primitive-fork)) + (postgres (getpwnam "postgres"))) + (if (eq? pid 0) + (dynamic-wind + (const #t) + (lambda () + (setgid (passwd:gid postgres)) + (setuid (passwd:uid postgres)) + (primitive-exit + (if (and + (zero? + (system* #$(file-append postgresql "/bin/createuser") + #$user)) + (zero? + (system* #$(file-append postgresql "/bin/createdb") + "-O" #$user #$name))) + 0 + 1))) + (lambda () + (primitive-exit 1))) + (zero? (cdr (waitpid pid))))))) + + (shepherd-service + (requirement '(postgres)) + (provision '(patchwork-postgresql-user-and-database)) + (start start-gexp) + (stop #~(const #f)) + (respawn? #f) + (documentation "Setup patchwork database."))))) + +(define (patchwork-os patchwork) + (simple-operating-system + (service dhcp-client-service-type) + (service httpd-service-type + (httpd-configuration + (config + (httpd-config-file + (listen '("8080")))))) + (service postgresql-service-type) + (service patchwork-service-type + (patchwork-configuration + (patchwork patchwork) + (domain "localhost") + (settings-module + (patchwork-settings-module + (allowed-hosts (list domain)) + (default-from-email ""))) + (getmail-retriever-config + (getmail-retriever-configuration + (type "SimpleIMAPSSLRetriever") + (server "imap.example.com") + (port 993) + (username "username") + (password "password") + (extra-parameters + '((mailboxes . ("INBOX")))))))) + (simple-service 'patchwork-database-setup + shepherd-root-service-type + (list + (patchwork-initial-database-setup-service + (patchwork-database-configuration)))))) + +(define (run-patchwork-test patchwork) + "Run tests in %NGINX-OS, which has nginx running and listening on +HTTP-PORT." + (define os + (marionette-operating-system + (patchwork-os patchwork) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define forwarded-port 8080) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((8080 . ,forwarded-port))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette) + (web uri) + (web client) + (web response)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "patchwork") + + (test-assert "patchwork-postgresql-user-and-service started" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service 'patchwork-postgresql-user-and-database) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + ((#t) #t) + ((pid) (number? pid)))))) + marionette)) + + (test-assert "httpd running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'httpd)) + marionette)) + + (test-equal "http-get" + 200 + (let-values + (((response text) + (http-get #$(simple-format + #f "http://localhost:~A/" forwarded-port) + #:decode-body? #t))) + (response-code response))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "patchwork-test" test)) + +(define %test-patchwork + (system-test + (name "patchwork") + (description "Connect to a running Patchwork service.") + (value (run-patchwork-test patchwork))))