[bug#33185] [PATCH 0/7] Add patchwork package and service.

[bug#33185] [PATCH 0/7] Add patchwork package and service.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 868 bytes --]

These patches add a package for patchwork, a web-based patch tracking
system, along with some missing dependencies and the beginnings of a
system service and test.

Everything up to the patchwork package should be ready to merge, but the
patchwork package, service and system test is currently very rough and
unready.


Christopher Baines (7):
  gnu: Add python-jsmin.
  gnu: Add python-slimit.
  gnu: Add python-django-pipeline.
  gnu: Add python-django-jinja.
  gnu: Add python-django-debug-toolbar.
  gnu: Add patchwork.
  services: Add patchwork.

 gnu/packages/django.scm     | 130 ++++++++++++++++
 gnu/packages/patchutils.scm |  95 ++++++++++++
 gnu/packages/python-web.scm |  50 +++++++
 gnu/services/web.scm        | 291 +++++++++++++++++++++++++++++++++++-
 gnu/tests/web.scm           | 104 ++++++++++++-
 5 files changed, 668 insertions(+), 2 deletions(-)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH 1/7] gnu: Add python-jsmin.

[Christopher Baines]

* gnu/packages/python-web.scm (python-jsmin, python2-jsmin): New variables.
---
 gnu/packages/python-web.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm
index f8052458a..c00992c71 100644
--- a/gnu/packages/python-web.scm
+++ b/gnu/packages/python-web.scm
@@ -2130,6 +2130,28 @@ It comes with safe defaults and easily configurable options.")
 (define-public python2-flask-htmlmin
   (package-with-python2 python-flask-htmlmin))
 
+(define-public python-jsmin
+  (package
+    (name "python-jsmin")
+    (version "2.2.2")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (pypi-uri "jsmin" version))
+       (sha256
+        (base32
+         "0fsmqbjvpxvff0984x7c0y8xmf49ax9mncz48b9xjx8wrnr9kpxn"))))
+    (build-system python-build-system)
+    (home-page "https://github.com/tikitu/jsmin/")
+    (synopsis "Python JavaScript minifier")
+    (description
+     "@code{jsmin} is a JavaScript minifier, usable from both Python code and
+on the command line.")
+    (license license:expat)))
+
+(define-public python2-jsmin
+  (package-with-python2 python-jsmin))
+
 (define-public python-flask-login
   (package
     (name "python-flask-login")
-- 
2.18.0

[bug#33185] [PATCH 2/7] gnu: Add python-slimit.

[Christopher Baines]

* gnu/packages/python-web.scm (python-slimit, python2-slimit): New variables.
---
 gnu/packages/python-web.scm | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm
index c00992c71..a7af71bd5 100644
--- a/gnu/packages/python-web.scm
+++ b/gnu/packages/python-web.scm
@@ -1945,6 +1945,34 @@ transfers.")
        `(("python2-futures" ,python2-futures)
          ,@(package-native-inputs base))))))
 
+(define-public python-slimit
+  (package
+    (name "python-slimit")
+    (version "0.8.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (pypi-uri "slimit" version ".zip"))
+       (sha256
+        (base32
+         "02vj2x728rs1127q2nc27frrqra4fczivnb7gch6n5lzi7pxqczl"))))
+    (build-system python-build-system)
+    (native-inputs
+     `(("unzip" ,unzip)))
+    (propagated-inputs
+     `(("python-ply" ,python-ply)))
+    (home-page "https://slimit.readthedocs.io/")
+    (synopsis "JavaScript minifier, parser and lexer written in Python")
+    (description
+     "@code{SlimIt} is a JavaScript minifier written in Python.  It compiles
+JavaScript into more compact code so that it downloads and runs faster.
+SlimIt also provides a library that includes a JavaScript parser, lexer,
+pretty printer and a tree visitor.")
+    (license license:expat)))
+
+(define-public python2-slimit
+  (package-with-python2 python-slimit))
+
 (define-public python-flask-restful
   (package
     (name "python-flask-restful")
-- 
2.18.0

[bug#33185] [PATCH 2/7] gnu: Add python-slimit.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> * gnu/packages/python-web.scm (python-slimit, python2-slimit): New variables.

[...]

> +    (synopsis "JavaScript minifier, parser and lexer written in Python")
> +    (description
> +     "@code{SlimIt} is a JavaScript minifier written in Python.  It compiles

I think you can avoid @code here.  Otherwise LGTM!

[bug#33185] [PATCH 2/7] gnu: Add python-slimit.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 480 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> * gnu/packages/python-web.scm (python-slimit, python2-slimit): New variables.
>
> [...]
>
>> +    (synopsis "JavaScript minifier, parser and lexer written in Python")
>> +    (description
>> +     "@code{SlimIt} is a JavaScript minifier written in Python.  It compiles
>
> I think you can avoid @code here.  Otherwise LGTM!

Great, I've pushed now with this change :)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH 3/7] gnu: Add python-django-pipeline.

[Christopher Baines]

* gnu/packages/django.scm (python-django-pipeline, python2-django-pipeline):
New variables.
---
 gnu/packages/django.scm | 43 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)

diff --git a/gnu/packages/django.scm b/gnu/packages/django.scm
index dea925e56..589ba282e 100644
--- a/gnu/packages/django.scm
+++ b/gnu/packages/django.scm
@@ -518,6 +518,49 @@ project.")
 (define-public python2-django-overextends
   (package-with-python2 python-django-overextends))
 
+(define-public python-django-pipeline
+  (package
+    (name "python-django-pipeline")
+    (version "1.6.14")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (pypi-uri "django-pipeline" version))
+       (sha256
+        (base32
+         "1a207y71r7za033ira0qmh2yrgp5rq0l04gw2fg9b8jri7sslrzg"))))
+    (build-system python-build-system)
+    (arguments
+     '(#:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'patch-source
+           (lambda _
+             (substitute* "tests/tests/test_compiler.py"
+               (("\\/usr\\/bin\\/env")
+                (which "env")))))
+         (replace 'check
+           (lambda*(#:key tests? #:allow-other-keys)
+             (or
+              (not tests?)
+              (begin
+                (setenv "DJANGO_SETTINGS_MODULE" "tests.settings")
+                (invoke "django-admin" "test" "tests"))))))))
+    (propagated-inputs
+     `(("python-django" ,python-django)
+       ("python-slimit" ,python-slimit)
+       ("python-jsmin" ,python-jsmin)))
+    (home-page
+     "https://github.com/jazzband/django-pipeline")
+    (synopsis "Asset packaging library for Django")
+    (description
+     "Pipeline is an asset packaging library for Django, providing both CSS
+and JavaScript concatenation and compression, built-in JavaScript template
+support, and optional data-URI image and font embedding.")
+    (license license:expat)))
+
+(define-public python2-django-pipeline
+  (package-with-python2 python-django-pipeline))
+
 (define-public python-django-redis
   (package
     (name "python-django-redis")
-- 
2.18.0

[bug#33185] [PATCH 3/7] gnu: Add python-django-pipeline.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> * gnu/packages/django.scm (python-django-pipeline, python2-django-pipeline):
> New variables.

LGTM!

[bug#33185] [PATCH 4/7] gnu: Add python-django-jinja.

[Christopher Baines]

* gnu/packages/django.scm (python-django-jinja, python2-django-jinja): New
variables.
---
 gnu/packages/django.scm | 49 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)

diff --git a/gnu/packages/django.scm b/gnu/packages/django.scm
index 589ba282e..48f36835d 100644
--- a/gnu/packages/django.scm
+++ b/gnu/packages/django.scm
@@ -338,6 +338,55 @@ merging, minifying and compiling CSS and Javascript files.")
 (define-public python2-django-assets
   (package-with-python2 python-django-assets))
 
+(define-public python-django-jinja
+  (package
+    (name "python-django-jinja")
+    (version "2.4.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "https://github.com/niwinz/django-jinja/archive/"
+             version ".tar.gz"))
+       (file-name (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0bzrb4m6wx9ph5cpvz7wpvg5k6ksvj0dnxlg0nhhqskhvp46brs1"))))
+    (build-system python-build-system)
+    (propagated-inputs
+     `(("python-django" ,python-django)
+       ("python-jinja2" ,python-jinja2)
+       ("python-pytz" ,python-pytz)
+       ("python-django-pipeline" ,python-django-pipeline)))
+    (arguments
+     '(;; TODO Tests currently fail due to issues with the configuration for
+       ;; django-pipeline
+       #:tests? #f
+       #:phases
+       (modify-phases %standard-phases
+         (replace 'check
+           (lambda* (#:key tests? #:allow-other-keys)
+             (or
+              (not tests?)
+              (with-directory-excursion "testing"
+                (invoke "python" "runtests.py"))))))))
+    (home-page
+     "https://niwinz.github.io/django-jinja/latest/")
+    (synopsis "Simple and nonobstructive jinja2 backend for Django")
+    (description
+     "Jinja2 provides certain advantages over the native system of Django, for
+example, explicit calls to callable from templates and better performance.
+@code{django-jinja} is a alternative to the jinja2 backend built in to Django.")
+    (license license:bsd-3)))
+
+(define-public python2-django-jinja
+  (let ((base (package-with-python2 (strip-python2-variant python-django-jinja))))
+    (package
+      (inherit base)
+      (native-inputs
+       `(("python2-mock" ,python2-mock)
+         ,@(package-native-inputs base))))))
+
 (define-public python-django-jsonfield
   (package
     (name "python-django-jsonfield")
-- 
2.18.0

[bug#33185] [PATCH 5/7] gnu: Add python-django-debug-toolbar.

[Christopher Baines]

* gnu/packages/django.scm (python-django-debug-toolbar,
python2-django-debug-toolbar): New variables.
---
 gnu/packages/django.scm | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/gnu/packages/django.scm b/gnu/packages/django.scm
index 48f36835d..3a761bf60 100644
--- a/gnu/packages/django.scm
+++ b/gnu/packages/django.scm
@@ -265,6 +265,44 @@ account authentication.")
 (define-public python2-django-allauth
   (package-with-python2 python-django-allauth))
 
+(define-public python-django-debug-toolbar
+  (package
+    (name "python-django-debug-toolbar")
+    (version "1.10.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "https://github.com/jazzband/django-debug-toolbar/archive/"
+             version ".tar.gz"))
+       (file-name (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "1rww056hyzks8spbgf4h7kf6ybxlc5p08a2b6gn1nqrrzs4yx9sy"))))
+    (build-system python-build-system)
+    (propagated-inputs
+     `(("python-sqlparse" ,python-sqlparse)
+       ("python-django" ,python-django)))
+    (native-inputs
+     `(("python-django-jinja" ,python-django-jinja)
+       ("python-html5lib" ,python-html5lib)))
+    (arguments
+     '(#:phases
+       (modify-phases %standard-phases
+         (replace 'check
+           (lambda _
+             (invoke "make" "test"))))))
+    (home-page
+     "https://github.com/jazzband/django-debug-toolbar")
+    (synopsis "Toolbar to help with developing Django applications")
+    (description
+     "A configurable set of panels that display various debug information
+about the current request/response.")
+    (license license:bsd-3)))
+
+(define-public python2-django-debug-toolbar
+  (package-with-python2 python-django-debug-toolbar))
+
 (define-public python-django-gravatar2
   (package
     (name "python-django-gravatar2")
-- 
2.18.0

[bug#33185] [PATCH 6/7] gnu: Add patchwork.

[Christopher Baines]

---
 gnu/packages/patchutils.scm | 95 +++++++++++++++++++++++++++++++++++++
 1 file changed, 95 insertions(+)

diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm
index 688e62cdc..7dabda9ee 100644
--- a/gnu/packages/patchutils.scm
+++ b/gnu/packages/patchutils.scm
@@ -29,6 +29,8 @@
   #:use-module (gnu packages ed)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages databases)
+  #:use-module (gnu packages django)
   #:use-module (gnu packages file)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
@@ -240,3 +242,96 @@ hexadecimal and ASCII (or EBCDIC).  It can also display two files at once, and
 highlight the differences between them.  It works well with large files (up to 4
 GiB).")
     (license gpl2+)))
+
+(define-public patchwork
+  (package
+    (name "patchwork")
+    (version "2.1.1")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "https://github.com/getpatchwork/patchwork/archive/v"
+                    version ".tar.gz"))
+              (sha256
+               (base32
+                "1q4i46gwwxvr8gjj983r8aacfsssp062dzi29ha7zba380fsxayy"))
+              (file-name (string-append name "-" version))))
+    (build-system python-build-system)
+    (arguments
+     `(;; TODO: Tests require a running database
+       #:tests? #f
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (delete 'build)
+         (add-after 'unpack 'patch-wsgi.py
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (substitute* "patchwork/wsgi.py"
+               (("import os")
+                (string-append
+                 "import os, sys
+
+sys.path.extend('" (string-append (getenv "PYTHONPATH") ":" (site-packages inputs outputs)) "'.split(':'))"))
+               (("'patchwork\\.settings\\.production'")
+                "os.getenv('DJANGO_SETTINGS_MODULE', 'guix.patchwork.settings')"))))
+         (replace 'check
+           (lambda* (#:key tests? #:allow-other-keys)
+             (or (not tests?)
+                 (begin
+                   (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
+                   (invoke
+                    "python" "-Wonce" "./manage.py" "test" "--noinput")
+                   #t))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (for-each (lambda (directory)
+                           (copy-recursively
+                            directory
+                            (string-append (site-packages inputs outputs)
+                                           "/" directory)))
+                         '("patchwork"
+                           "templates"))
+               (delete-file-recursively (string-append
+                                    (site-packages inputs outputs)
+                                    "patchwork/tests"))
+               (copy-recursively "htdocs"
+                                 (string-append
+                                  out "/share/patchwork/htdocs"))
+               (copy-recursively "lib"
+                                 (string-append
+                                  out "/share/doc/" ,name "-" ,version)))
+             #t))
+         (add-after 'install 'install-patchwork-admin
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out")))
+               (mkdir-p (string-append out "/bin"))
+               (call-with-output-file (string-append out "/bin/patchwork-admin")
+                 (lambda (port)
+                   (display "#!/usr/bin/env python3
+import os, sys
+
+if __name__ == \"__main__\":
+    os.environ.setdefault(
+      \"DJANGO_SETTINGS_MODULE\",
+      \"guix.patchwork.settings\"
+    )
+
+    from django.core.management import execute_from_command_line
+
+    execute_from_command_line(sys.argv)" port)))
+               (chmod (string-append out "/bin/patchwork-admin") #o555))
+             #t)))))
+    (inputs
+     `(("python-wrapper" ,python-wrapper)))
+    (propagated-inputs
+     `(("python-django" ,python-django)
+       ;; TODO: Make this configurable
+       ("python-psycopg2" ,python-psycopg2)
+       ("python-django-filter" ,python-django-filter)
+       ("python-djangorestframework" ,python-djangorestframework)
+       ("python-django-debug-toolbar" ,python-django-debug-toolbar)))
+    (synopsis "")
+    (description "")
+    (home-page "")
+    (license "")))
-- 
2.18.0

[bug#33185] [PATCH 7/7] services: Add patchwork.

[Christopher Baines]

---
 gnu/services/web.scm | 291 ++++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/web.scm    | 104 +++++++++++++++-
 2 files changed, 393 insertions(+), 2 deletions(-)

diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 1edb1f4d3..6d0bfee94 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -32,12 +32,16 @@
   #: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 guile)
   #:use-module (gnu packages logging)
   #: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))
@@ -205,7 +209,41 @@
             varnish-configuration-parameters
             varnish-configuration-extra-options
 
-            varnish-service-type))
+            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-service-type))
 
 ;;; Commentary:
 ;;;
@@ -1256,3 +1294,254 @@ files.")
                              varnish-shepherd-service)))
    (default-value
      (varnish-configuration))))
+
+\f
+;;;
+;;; 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 ""))
+  (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                patchwork-settings-module-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
+  patckwork-configuration?
+  (patchwork            patchwork-configuration-patchwork
+                        (default patchwork))
+  (settings-module      patchwork-configuration-settings-module)
+  (domain               patchwork-configuration-domain))
+
+(define-gexp-compiler (patchwork-settings-module-compiler
+                       (file <patchwork-settings-module>) system target)
+  (match file
+    (($ <patchwork-settings-module> database-configuration secret-key
+                                    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
+SECRET_KEY = '" #$secret-key "'
+
+ALLOWED_HOSTS = [
+" #$(string-concatenate
+     (map (lambda (allowed-host)
+            (string-append "  '" allowed-host "'\n"))
+          allowed-hosts))
+"]
+
+DEBUG = " #$(if debug? "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-wsgi-wrapper patchwork)
+  (define patchwork-wsgi.py
+    (file-append patchwork
+                 (string-append
+                  "/lib/python"
+                  (version-major+minor
+                   (package-version python))
+                  "/site-packages/patchwork/wsgi.py")))
+
+  (mixed-text-file
+   "patchwork-wsgi.py"
+   "import os\n"
+   "\n"
+   "exec(open(\"" patchwork-wsgi.py "\").read())\n"))
+
+(define patchwork-httpd-configuration
+  (match-lambda
+    (($ <patchwork-configuration> patchwork settings-module
+                                  domain)
+
+     (define wsgi.py (patchwork-wsgi-wrapper patchwork))
+
+     (list "WSGISocketPrefix /var/run/mod_wsgi"
+           (list "LoadModule wsgi_module "
+                 (file-append mod-wsgi "/modules/mod_wsgi.so"))
+           (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 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 patchwork
+
+<Files " ,wsgi.py ">
+  Require all granted
+</Files>
+
+Alias /static " ,patchwork "/share/patchwork/htdocs
+<Directory \"/srv/http/" ,domain "/\">
+    AllowOverride None
+    Options MultiViews Indexes SymlinksIfOwnerMatch IncludesNoExec
+    Require method GET POST OPTIONS
+</Directory>"))))))
+
+(define (patchwork-setup-gexp settings-module)
+  (with-imported-modules (source-module-closure
+                          '((guix build utils)))
+    #~(lambda ()
+        (catch #t
+          (lambda ()
+            (let ((pid (primitive-fork))
+                  (user (getpwnam "postgres")))
+              (if (eq? pid 0)
+                  (dynamic-wind
+                    (const #t)
+                    (lambda ()
+                      (setgid (passwd:gid user))
+                      (setuid (passwd:uid user))
+                      (primitive-exit
+                       (if (and
+                            (zero?
+                             (system* #$(file-append postgresql "/bin/createuser")
+                                      "httpd"))
+                            (zero?
+                             (system* #$(file-append postgresql "/bin/createdb")
+                                      "-O" "httpd" "patchwork")))
+                           0
+                           1)))
+                    (lambda ()
+                      (primitive-exit 1)))
+                  (zero? (cdr (waitpid pid)))))
+            (let ((pid (primitive-fork))
+                  (user (getpwnam "httpd")))
+              (if (eq? pid 0)
+                  (dynamic-wind
+                    (const #t)
+                    (lambda ()
+                      (setgid (passwd:gid user))
+                      (setuid (passwd:uid user))
+                      ;; TODO Extract
+                      (setenv "DJANGO_SECRET_KEY" "testsecretkey")
+                      (setenv "DATABASE_NAME" "patchwork")
+                      (setenv "PYTHONPATH" #$settings-module)
+                      (primitive-exit
+                       (if (and
+                            (zero?
+                             (system* #$(file-append patchwork
+                                                     "/bin/patchwork-admin")
+                                      "migrate")))
+                           0
+                           1)))
+                    (lambda ()
+                      (primitive-exit 1)))
+                  (zero? (cdr (waitpid pid))))))
+          (lambda (key . parameters)
+            (format (current-error-port)
+                    "Uncaught throw to '~a: ~a\n" key parameters)
+            #f)))))
+
+(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
+           (match-lambda
+             (($ <patchwork-configuration> patchwork settings-module
+                                           domain)
+              (list (shepherd-service
+                     (requirement '(postgres))
+                     (provision '(patchwork-setup))
+                     (start (patchwork-setup-gexp settings-module))
+                     (stop #~(const #f))
+                     (respawn? #f)
+                     (documentation "Setup patchwork."))))))))
+   (description
+    "patchwork")))
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 319655396..fbdf78a03 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -28,15 +28,27 @@
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services web)
+  #:use-module (gnu services databases)
   #:use-module (gnu services networking)
+  #:use-module (gnu services shepherd)
+  #: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 +510,93 @@ HTTP-PORT."
    (name "tailon")
    (description "Connect to a running Tailon server.")
    (value (run-tailon-test))))
+
+\f
+;;;
+;;; Patchwork
+;;;
+
+(define %patchwork-os
+  (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
+             (settings-module
+              (patchwork-settings-module
+               (secret-key "00000")
+               (allowed-hosts '("*"))
+               (default-from-email "")
+               (debug? #t)))
+             (domain "localhost")))))
+
+(define* (run-patchwork-test)
+  "Run tests in %NGINX-OS, which has nginx running and listening on
+HTTP-PORT."
+  (define os
+    (marionette-operating-system
+     %patchwork-os
+     #: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 "httpd service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (match (start-service 'httpd)
+                  (#f #f)
+                  (('service response-parts ...)
+                   (match (assq-ref response-parts 'running)
+                     ((#t) #t)
+                     ((pid) (number? pid))))))
+             marionette))
+
+          ;; Retrieve the index.html file we put in /srv.
+          (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 "")
+   (value (run-patchwork-test))))
-- 
2.18.0

[bug#33185] [PATCH 1/7] gnu: Add python-jsmin.

[Ludovic Courtès]

Hello,

Christopher Baines <mail@cbaines.net> skribis:

> * gnu/packages/python-web.scm (python-jsmin, python2-jsmin): New variables.

LGTM!

For the record, if the ‘python2-’ version is not strictly needed, you
should omit it.

Thanks,
Ludo’.

[bug#33185] [PATCH 1/7] gnu: Add python-jsmin.

[Christopher Baines]

* gnu/packages/python-web.scm (python-jsmin, python2-jsmin): New variables.
---
 gnu/packages/python-web.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm
index eda796e01..3671454c2 100644
--- a/gnu/packages/python-web.scm
+++ b/gnu/packages/python-web.scm
@@ -2168,6 +2168,28 @@ It comes with safe defaults and easily configurable options.")
 (define-public python2-flask-htmlmin
   (package-with-python2 python-flask-htmlmin))
 
+(define-public python-jsmin
+  (package
+    (name "python-jsmin")
+    (version "2.2.2")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (pypi-uri "jsmin" version))
+       (sha256
+        (base32
+         "0fsmqbjvpxvff0984x7c0y8xmf49ax9mncz48b9xjx8wrnr9kpxn"))))
+    (build-system python-build-system)
+    (home-page "https://github.com/tikitu/jsmin/")
+    (synopsis "Python JavaScript minifier")
+    (description
+     "@code{jsmin} is a JavaScript minifier, usable from both Python code and
+on the command line.")
+    (license license:expat)))
+
+(define-public python2-jsmin
+  (package-with-python2 python-jsmin))
+
 (define-public python-flask-login
   (package
     (name "python-flask-login")
-- 
2.18.0

[bug#33185] [PATCH 2/7] gnu: Add python-slimit.

[Christopher Baines]

* gnu/packages/python-web.scm (python-slimit, python2-slimit): New variables.
---
 gnu/packages/python-web.scm | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm
index 3671454c2..26134e808 100644
--- a/gnu/packages/python-web.scm
+++ b/gnu/packages/python-web.scm
@@ -1983,6 +1983,34 @@ transfers.")
        `(("python2-futures" ,python2-futures)
          ,@(package-native-inputs base))))))
 
+(define-public python-slimit
+  (package
+    (name "python-slimit")
+    (version "0.8.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (pypi-uri "slimit" version ".zip"))
+       (sha256
+        (base32
+         "02vj2x728rs1127q2nc27frrqra4fczivnb7gch6n5lzi7pxqczl"))))
+    (build-system python-build-system)
+    (native-inputs
+     `(("unzip" ,unzip)))
+    (propagated-inputs
+     `(("python-ply" ,python-ply)))
+    (home-page "https://slimit.readthedocs.io/")
+    (synopsis "JavaScript minifier, parser and lexer written in Python")
+    (description
+     "@code{SlimIt} is a JavaScript minifier written in Python.  It compiles
+JavaScript into more compact code so that it downloads and runs faster.
+SlimIt also provides a library that includes a JavaScript parser, lexer,
+pretty printer and a tree visitor.")
+    (license license:expat)))
+
+(define-public python2-slimit
+  (package-with-python2 python-slimit))
+
 (define-public python-flask-restful
   (package
     (name "python-flask-restful")
-- 
2.18.0

[bug#33185] [PATCH 3/7] gnu: Add python-django-pipeline.

[Christopher Baines]

* gnu/packages/django.scm (python-django-pipeline, python2-django-pipeline):
New variables.
---
 gnu/packages/django.scm | 43 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)

diff --git a/gnu/packages/django.scm b/gnu/packages/django.scm
index dea925e56..589ba282e 100644
--- a/gnu/packages/django.scm
+++ b/gnu/packages/django.scm
@@ -518,6 +518,49 @@ project.")
 (define-public python2-django-overextends
   (package-with-python2 python-django-overextends))
 
+(define-public python-django-pipeline
+  (package
+    (name "python-django-pipeline")
+    (version "1.6.14")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (pypi-uri "django-pipeline" version))
+       (sha256
+        (base32
+         "1a207y71r7za033ira0qmh2yrgp5rq0l04gw2fg9b8jri7sslrzg"))))
+    (build-system python-build-system)
+    (arguments
+     '(#:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'patch-source
+           (lambda _
+             (substitute* "tests/tests/test_compiler.py"
+               (("\\/usr\\/bin\\/env")
+                (which "env")))))
+         (replace 'check
+           (lambda*(#:key tests? #:allow-other-keys)
+             (or
+              (not tests?)
+              (begin
+                (setenv "DJANGO_SETTINGS_MODULE" "tests.settings")
+                (invoke "django-admin" "test" "tests"))))))))
+    (propagated-inputs
+     `(("python-django" ,python-django)
+       ("python-slimit" ,python-slimit)
+       ("python-jsmin" ,python-jsmin)))
+    (home-page
+     "https://github.com/jazzband/django-pipeline")
+    (synopsis "Asset packaging library for Django")
+    (description
+     "Pipeline is an asset packaging library for Django, providing both CSS
+and JavaScript concatenation and compression, built-in JavaScript template
+support, and optional data-URI image and font embedding.")
+    (license license:expat)))
+
+(define-public python2-django-pipeline
+  (package-with-python2 python-django-pipeline))
+
 (define-public python-django-redis
   (package
     (name "python-django-redis")
-- 
2.18.0

[bug#33185] [PATCH 4/7] gnu: Add python-django-jinja.

[Christopher Baines]

* gnu/packages/django.scm (python-django-jinja, python2-django-jinja): New
variables.
---
 gnu/packages/django.scm | 49 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)

diff --git a/gnu/packages/django.scm b/gnu/packages/django.scm
index 589ba282e..48f36835d 100644
--- a/gnu/packages/django.scm
+++ b/gnu/packages/django.scm
@@ -338,6 +338,55 @@ merging, minifying and compiling CSS and Javascript files.")
 (define-public python2-django-assets
   (package-with-python2 python-django-assets))
 
+(define-public python-django-jinja
+  (package
+    (name "python-django-jinja")
+    (version "2.4.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "https://github.com/niwinz/django-jinja/archive/"
+             version ".tar.gz"))
+       (file-name (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0bzrb4m6wx9ph5cpvz7wpvg5k6ksvj0dnxlg0nhhqskhvp46brs1"))))
+    (build-system python-build-system)
+    (propagated-inputs
+     `(("python-django" ,python-django)
+       ("python-jinja2" ,python-jinja2)
+       ("python-pytz" ,python-pytz)
+       ("python-django-pipeline" ,python-django-pipeline)))
+    (arguments
+     '(;; TODO Tests currently fail due to issues with the configuration for
+       ;; django-pipeline
+       #:tests? #f
+       #:phases
+       (modify-phases %standard-phases
+         (replace 'check
+           (lambda* (#:key tests? #:allow-other-keys)
+             (or
+              (not tests?)
+              (with-directory-excursion "testing"
+                (invoke "python" "runtests.py"))))))))
+    (home-page
+     "https://niwinz.github.io/django-jinja/latest/")
+    (synopsis "Simple and nonobstructive jinja2 backend for Django")
+    (description
+     "Jinja2 provides certain advantages over the native system of Django, for
+example, explicit calls to callable from templates and better performance.
+@code{django-jinja} is a alternative to the jinja2 backend built in to Django.")
+    (license license:bsd-3)))
+
+(define-public python2-django-jinja
+  (let ((base (package-with-python2 (strip-python2-variant python-django-jinja))))
+    (package
+      (inherit base)
+      (native-inputs
+       `(("python2-mock" ,python2-mock)
+         ,@(package-native-inputs base))))))
+
 (define-public python-django-jsonfield
   (package
     (name "python-django-jsonfield")
-- 
2.18.0

[bug#33185] [PATCH 4/7] gnu: Add python-django-jinja.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> * gnu/packages/django.scm (python-django-jinja, python2-django-jinja): New
> variables.

[...]

> +    (home-page
> +     "https://niwinz.github.io/django-jinja/latest/")
> +    (synopsis "Simple and nonobstructive jinja2 backend for Django")
> +    (description
> +     "Jinja2 provides certain advantages over the native system of Django, for
> +example, explicit calls to callable from templates and better performance.
> +@code{django-jinja} is a alternative to the jinja2 backend built in to Django.")

This is not crystal-clear to someone unfamiliar with Django and Jinja,
so bonus points if you can come up with a clearer synopsis and
description.  Otherwise LGTM!

[bug#33185] [PATCH 4/7] gnu: Add python-django-jinja.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 993 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> * gnu/packages/django.scm (python-django-jinja, python2-django-jinja): New
>> variables.
>
> [...]
>
>> +    (home-page
>> +     "https://niwinz.github.io/django-jinja/latest/")
>> +    (synopsis "Simple and nonobstructive jinja2 backend for Django")
>> +    (description
>> +     "Jinja2 provides certain advantages over the native system of Django, for
>> +example, explicit calls to callable from templates and better performance.
>> +@code{django-jinja} is a alternative to the jinja2 backend built in to Django.")
>
> This is not crystal-clear to someone unfamiliar with Django and Jinja,
> so bonus points if you can come up with a clearer synopsis and
> description.  Otherwise LGTM!

Yep, I've made another pass at the synopsis and description, which is
hopefully much clearer now, and pushed this. Somehow I'd neglected to
mention that this related to templates!

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH 5/7] gnu: Add python-django-debug-toolbar.

[Christopher Baines]

* gnu/packages/django.scm (python-django-debug-toolbar,
python2-django-debug-toolbar): New variables.
---
 gnu/packages/django.scm | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/gnu/packages/django.scm b/gnu/packages/django.scm
index 48f36835d..3a761bf60 100644
--- a/gnu/packages/django.scm
+++ b/gnu/packages/django.scm
@@ -265,6 +265,44 @@ account authentication.")
 (define-public python2-django-allauth
   (package-with-python2 python-django-allauth))
 
+(define-public python-django-debug-toolbar
+  (package
+    (name "python-django-debug-toolbar")
+    (version "1.10.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "https://github.com/jazzband/django-debug-toolbar/archive/"
+             version ".tar.gz"))
+       (file-name (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "1rww056hyzks8spbgf4h7kf6ybxlc5p08a2b6gn1nqrrzs4yx9sy"))))
+    (build-system python-build-system)
+    (propagated-inputs
+     `(("python-sqlparse" ,python-sqlparse)
+       ("python-django" ,python-django)))
+    (native-inputs
+     `(("python-django-jinja" ,python-django-jinja)
+       ("python-html5lib" ,python-html5lib)))
+    (arguments
+     '(#:phases
+       (modify-phases %standard-phases
+         (replace 'check
+           (lambda _
+             (invoke "make" "test"))))))
+    (home-page
+     "https://github.com/jazzband/django-debug-toolbar")
+    (synopsis "Toolbar to help with developing Django applications")
+    (description
+     "A configurable set of panels that display various debug information
+about the current request/response.")
+    (license license:bsd-3)))
+
+(define-public python2-django-debug-toolbar
+  (package-with-python2 python-django-debug-toolbar))
+
 (define-public python-django-gravatar2
   (package
     (name "python-django-gravatar2")
-- 
2.18.0

[bug#33185] [PATCH 5/7] gnu: Add python-django-debug-toolbar.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> * gnu/packages/django.scm (python-django-debug-toolbar,
> python2-django-debug-toolbar): New variables.

[...]

> +    (synopsis "Toolbar to help with developing Django applications")
> +    (description
> +     "A configurable set of panels that display various debug information
> +about the current request/response.")

Please make a full sentence.  Otherwise LGTM.

[bug#33185] [PATCH 5/7] gnu: Add python-django-debug-toolbar.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 571 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> * gnu/packages/django.scm (python-django-debug-toolbar,
>> python2-django-debug-toolbar): New variables.
>
> [...]
>
>> +    (synopsis "Toolbar to help with developing Django applications")
>> +    (description
>> +     "A configurable set of panels that display various debug information
>> +about the current request/response.")
>
> Please make a full sentence.  Otherwise LGTM.

Sure, I've expanded this a bit now and pushed. Thanks for taking a look :)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH 6/7] gnu: Add patchwork.

[Christopher Baines]

---
 gnu/packages/patchutils.scm | 103 ++++++++++++++++++++++++++++++++++++
 1 file changed, 103 insertions(+)

diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm
index 688e62cdc..0981cbc08 100644
--- a/gnu/packages/patchutils.scm
+++ b/gnu/packages/patchutils.scm
@@ -29,6 +29,8 @@
   #:use-module (gnu packages ed)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages databases)
+  #:use-module (gnu packages django)
   #:use-module (gnu packages file)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
@@ -240,3 +242,104 @@ hexadecimal and ASCII (or EBCDIC).  It can also display two files at once, and
 highlight the differences between them.  It works well with large files (up to 4
 GiB).")
     (license gpl2+)))
+
+(define-public patchwork
+  (package
+    (name "patchwork")
+    (version "2.1.1")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "https://github.com/getpatchwork/patchwork/archive/v"
+                    version ".tar.gz"))
+              (sha256
+               (base32
+                "1q4i46gwwxvr8gjj983r8aacfsssp062dzi29ha7zba380fsxayy"))
+              (file-name (string-append name "-" version))))
+    (build-system python-build-system)
+    (arguments
+     `(;; TODO: Tests require a running database
+       #:tests? #f
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (delete 'build)
+         (add-after 'unpack 'patch-wsgi.py
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (substitute* "patchwork/wsgi.py"
+               (("import os")
+                (string-append
+                 "import os, sys
+
+sys.path.extend('" (string-append (getenv "PYTHONPATH") ":" (site-packages inputs outputs)) "'.split(':'))"))
+               (("'patchwork\\.settings\\.production'")
+                "os.getenv('DJANGO_SETTINGS_MODULE', 'guix.patchwork.settings')"))))
+         (replace 'check
+           (lambda* (#:key tests? #:allow-other-keys)
+             (or (not tests?)
+                 (begin
+                   (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
+                   (invoke
+                    "python" "-Wonce" "./manage.py" "test" "--noinput")
+                   #t))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (for-each (lambda (directory)
+                           (copy-recursively
+                            directory
+                            (string-append (site-packages inputs outputs)
+                                           "/" directory)))
+                         '("patchwork"
+                           "templates"))
+               (delete-file-recursively (string-append
+                                    (site-packages inputs outputs)
+                                    "patchwork/tests"))
+               (let ((static-root
+                      (string-append out "/share/patchwork/htdocs")))
+                 (mkdir-p static-root)
+                 (copy-file "patchwork/settings/production.example.py"
+                            "patchwork/settings/assets.py")
+                 (setenv "DJANGO_SECRET_KEY" "dummyvalue")
+                 (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.assets")
+                 (setenv "STATIC_ROOT" static-root)
+                 (invoke "./manage.py" "collectstatic" "--no-input"))
+
+               (copy-recursively "lib"
+                                 (string-append
+                                  out "/share/doc/" ,name "-" ,version)))
+             #t))
+         (add-after 'install 'install-patchwork-admin
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out")))
+               (mkdir-p (string-append out "/bin"))
+               (call-with-output-file (string-append out "/bin/patchwork-admin")
+                 (lambda (port)
+                   (display "#!/usr/bin/env python3
+import os, sys
+
+if __name__ == \"__main__\":
+    os.environ.setdefault(
+      \"DJANGO_SETTINGS_MODULE\",
+      \"guix.patchwork.settings\"
+    )
+
+    from django.core.management import execute_from_command_line
+
+    execute_from_command_line(sys.argv)" port)))
+               (chmod (string-append out "/bin/patchwork-admin") #o555))
+             #t)))))
+    (inputs
+     `(("python-wrapper" ,python-wrapper)))
+    (propagated-inputs
+     `(("python-django" ,python-django)
+       ;; TODO: Make this configurable
+       ("python-psycopg2" ,python-psycopg2)
+       ("python-mysqlclient" ,python-mysqlclient)
+       ("python-django-filter" ,python-django-filter)
+       ("python-djangorestframework" ,python-djangorestframework)
+       ("python-django-debug-toolbar" ,python-django-debug-toolbar)))
+    (synopsis "")
+    (description "")
+    (home-page "")
+    (license "")))
-- 
2.18.0

[bug#33185] [PATCH 6/7] gnu: Add patchwork.

[swedebugia]

Hi

I did not run the code. See question below.

On 2018-11-04 11:44, Christopher Baines wrote:
> ---
>   gnu/packages/patchutils.scm | 103 ++++++++++++++++++++++++++++++++++++
>   1 file changed, 103 insertions(+)
>
> diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm
snip
> +
> +(define-public patchwork
> +
snip
> +    (synopsis "")
> +    (description "")
> +    (home-page "")
> +    (license "")))
Perhaps you forgot to populate these 4 fields?

-- 
Cheers
Swedebugia

[bug#33185] [PATCH 6/7] gnu: Add patchwork.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 783 bytes --]


swedebugia <swedebugia@riseup.net> writes:

> Hi
>
> I did not run the code. See question below.
>
> On 2018-11-04 11:44, Christopher Baines wrote:
>> ---
>>   gnu/packages/patchutils.scm | 103 ++++++++++++++++++++++++++++++++++++
>>   1 file changed, 103 insertions(+)
>>
>> diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm
> snip
>> +
>> +(define-public patchwork
>> +
> snip
>> +    (synopsis "")
>> +    (description "")
>> +    (home-page "")
>> +    (license "")))
> Perhaps you forgot to populate these 4 fields?

These patches for patchwork were just functional, not ready for
merging. However, I've now got around to sending some more polished
patches, not quite ready for merging yet still, but at least with values
for these fields.

Thanks,

Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH 6/7] gnu: Add patchwork.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> ---
>  gnu/packages/patchutils.scm | 103 ++++++++++++++++++++++++++++++++++++
>  1 file changed, 103 insertions(+)

[...]

> +         (add-after 'unpack 'patch-wsgi.py
> +           (lambda* (#:key inputs outputs #:allow-other-keys)
> +             (substitute* "patchwork/wsgi.py"
> +               (("import os")
> +                (string-append
> +                 "import os, sys
> +
> +sys.path.extend('" (string-append (getenv "PYTHONPATH") ":" (site-packages inputs outputs)) "'.split(':'))"))
> +               (("'patchwork\\.settings\\.production'")
> +                "os.getenv('DJANGO_SETTINGS_MODULE', 'guix.patchwork.settings')"))))
> +         (replace 'check
> +           (lambda* (#:key tests? #:allow-other-keys)
> +             (or (not tests?)
> +                 (begin
> +                   (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
> +                   (invoke
> +                    "python" "-Wonce" "./manage.py" "test" "--noinput")
> +                   #t))))
> +         (replace 'install
> +           (lambda* (#:key inputs outputs #:allow-other-keys)
> +             (let ((out (assoc-ref outputs "out")))
> +               (for-each (lambda (directory)
> +                           (copy-recursively
> +                            directory
> +                            (string-append (site-packages inputs outputs)
> +                                           "/" directory)))
> +                         '("patchwork"
> +                           "templates"))
> +               (delete-file-recursively (string-append
> +                                    (site-packages inputs outputs)
> +                                    "patchwork/tests"))
> +               (let ((static-root
> +                      (string-append out "/share/patchwork/htdocs")))
> +                 (mkdir-p static-root)
> +                 (copy-file "patchwork/settings/production.example.py"
> +                            "patchwork/settings/assets.py")
> +                 (setenv "DJANGO_SECRET_KEY" "dummyvalue")
> +                 (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.assets")
> +                 (setenv "STATIC_ROOT" static-root)
> +                 (invoke "./manage.py" "collectstatic" "--no-input"))
> +
> +               (copy-recursively "lib"
> +                                 (string-append
> +                                  out "/share/doc/" ,name "-" ,version)))
> +             #t))
> +         (add-after 'install 'install-patchwork-admin
> +           (lambda* (#:key inputs outputs #:allow-other-keys)
> +             (let* ((out (assoc-ref outputs "out")))
> +               (mkdir-p (string-append out "/bin"))
> +               (call-with-output-file (string-append out "/bin/patchwork-admin")
> +                 (lambda (port)
> +                   (display "#!/usr/bin/env python3
> +import os, sys
> +
> +if __name__ == \"__main__\":
> +    os.environ.setdefault(
> +      \"DJANGO_SETTINGS_MODULE\",
> +      \"guix.patchwork.settings\"
> +    )
> +
> +    from django.core.management import execute_from_command_line
> +
> +    execute_from_command_line(sys.argv)" port)))
> +               (chmod (string-append out "/bin/patchwork-admin") #o555))
> +             #t)))))

IMO these phases would be less intimidating with a few comments
explaining what’s going on.  :-)

> +    (synopsis "")
> +    (description "")
> +    (home-page "")
> +    (license "")))

As swedebugia noted, you’re missing a few things here and in the commit
log. :-)

With these things fixed it should be good!

Thanks,
Ludo’.

[bug#33185] [PATCH 6/7] gnu: Add patchwork.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 1723 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> ---
>>  gnu/packages/patchutils.scm | 103 ++++++++++++++++++++++++++++++++++++
>>  1 file changed, 103 insertions(+)
>
> [...]
>
>> +         (add-after 'install 'install-patchwork-admin
>> +           (lambda* (#:key inputs outputs #:allow-other-keys)
>> +             (let* ((out (assoc-ref outputs "out")))
>> +               (mkdir-p (string-append out "/bin"))
>> +               (call-with-output-file (string-append out "/bin/patchwork-admin")
>> +                 (lambda (port)
>> +                   (display "#!/usr/bin/env python3
>> +import os, sys
>> +
>> +if __name__ == \"__main__\":
>> +    os.environ.setdefault(
>> +      \"DJANGO_SETTINGS_MODULE\",
>> +      \"guix.patchwork.settings\"
>> +    )
>> +
>> +    from django.core.management import execute_from_command_line
>> +
>> +    execute_from_command_line(sys.argv)" port)))
>> +               (chmod (string-append out "/bin/patchwork-admin") #o555))
>> +             #t)))))
>
> IMO these phases would be less intimidating with a few comments
> explaining what’s going on.  :-)
>
>> +    (synopsis "")
>> +    (description "")
>> +    (home-page "")
>> +    (license "")))
>
> As swedebugia noted, you’re missing a few things here and in the commit
> log. :-)
>
> With these things fixed it should be good!

Thanks for taking a look. I've finally got around to taking another look
at these patches, and sent updated patches for the package, service and
system test.

I think it's a lot further forward, but there are still a few bits to
sort out. I'll send some comments in reply to the patches.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH 7/7] services: Add patchwork.

[Christopher Baines]

---
 gnu/services/web.scm | 297 ++++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/web.scm    | 104 ++++++++++++++-
 2 files changed, 399 insertions(+), 2 deletions(-)

diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index fcf453c24..41db75153 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -32,12 +32,16 @@
   #: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 guile)
   #:use-module (gnu packages logging)
   #: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 +214,41 @@
             varnish-configuration-parameters
             varnish-configuration-extra-options
 
-            varnish-service-type))
+            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-service-type))
 
 ;;; Commentary:
 ;;;
@@ -1261,3 +1299,260 @@ files.")
                              varnish-shepherd-service)))
    (default-value
      (varnish-configuration))))
+
+\f
+;;;
+;;; 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 ""))
+  (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                patchwork-settings-module-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
+  patckwork-configuration?
+  (patchwork            patchwork-configuration-patchwork
+                        (default patchwork))
+  (settings-module      patchwork-configuration-settings-module)
+  (domain               patchwork-configuration-domain))
+
+(define-gexp-compiler (patchwork-settings-module-compiler
+                       (file <patchwork-settings-module>) system target)
+  (match file
+    (($ <patchwork-settings-module> database-configuration secret-key
+                                    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
+SECRET_KEY = '" #$secret-key "'
+
+ALLOWED_HOSTS = [
+" #$(string-concatenate
+     (map (lambda (allowed-host)
+            (string-append "  '" allowed-host "'\n"))
+          allowed-hosts))
+"]
+
+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
+      (($ <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-wsgi-wrapper patchwork)
+  (define patchwork-wsgi.py
+    (file-append patchwork
+                 (string-append
+                  "/lib/python"
+                  (version-major+minor
+                   (package-version python))
+                  "/site-packages/patchwork/wsgi.py")))
+
+  (mixed-text-file
+   "patchwork-wsgi.py"
+   "import os\n"
+   "\n"
+   "exec(open(\"" patchwork-wsgi.py "\").read())\n"))
+
+(define patchwork-httpd-configuration
+  (match-lambda
+    (($ <patchwork-configuration> patchwork settings-module
+                                  domain)
+
+     (define wsgi.py (patchwork-wsgi-wrapper patchwork))
+
+     (list "WSGISocketPrefix /var/run/mod_wsgi"
+           (list "LoadModule wsgi_module "
+                 (file-append mod-wsgi "/modules/mod_wsgi.so"))
+           (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 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 patchwork
+WSGIPassAuthorization On
+
+<Files " ,wsgi.py ">
+  Require all granted
+</Files>
+
+Alias /static " ,patchwork "/share/patchwork/htdocs
+<Directory \"/srv/http/" ,domain "/\">
+    AllowOverride None
+    Options MultiViews Indexes SymlinksIfOwnerMatch IncludesNoExec
+    Require method GET POST OPTIONS
+</Directory>"))))))
+
+(define (patchwork-setup-gexp settings-module)
+  (with-imported-modules (source-module-closure
+                          '((guix build utils)))
+    #~(lambda ()
+        (catch #t
+          (lambda ()
+            (let ((pid (primitive-fork))
+                  (user (getpwnam "postgres")))
+              (if (eq? pid 0)
+                  (dynamic-wind
+                    (const #t)
+                    (lambda ()
+                      (setgid (passwd:gid user))
+                      (setuid (passwd:uid user))
+                      (primitive-exit
+                       (if (and
+                            (zero?
+                             (system* #$(file-append postgresql "/bin/createuser")
+                                      "httpd"))
+                            (zero?
+                             (system* #$(file-append postgresql "/bin/createdb")
+                                      "-O" "httpd" "patchwork")))
+                           0
+                           1)))
+                    (lambda ()
+                      (primitive-exit 1)))
+                  (zero? (cdr (waitpid pid)))))
+            (let ((pid (primitive-fork))
+                  (user (getpwnam "httpd")))
+              (if (eq? pid 0)
+                  (dynamic-wind
+                    (const #t)
+                    (lambda ()
+                      (setgid (passwd:gid user))
+                      (setuid (passwd:uid user))
+                      ;; TODO Extract
+                      (setenv "DJANGO_SECRET_KEY" "testsecretkey")
+                      (setenv "DATABASE_NAME" "patchwork")
+                      (setenv "PYTHONPATH" #$settings-module)
+                      (primitive-exit
+                       (if (and
+                            (zero?
+                             (system* #$(file-append patchwork
+                                                     "/bin/patchwork-admin")
+                                      "migrate")))
+                           0
+                           1)))
+                    (lambda ()
+                      (primitive-exit 1)))
+                  (zero? (cdr (waitpid pid))))))
+          (lambda (key . parameters)
+            (format (current-error-port)
+                    "Uncaught throw to '~a: ~a\n" key parameters)
+            #f)))))
+
+(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
+           (match-lambda
+             (($ <patchwork-configuration> patchwork settings-module
+                                           domain)
+              (list (shepherd-service
+                     (requirement '(postgres))
+                     (provision '(patchwork-setup))
+                     (start (patchwork-setup-gexp settings-module))
+                     (stop #~(const #f))
+                     (respawn? #f)
+                     (documentation "Setup patchwork."))))))))
+   (description
+    "patchwork")))
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 319655396..fbdf78a03 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -28,15 +28,27 @@
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services web)
+  #:use-module (gnu services databases)
   #:use-module (gnu services networking)
+  #:use-module (gnu services shepherd)
+  #: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 +510,93 @@ HTTP-PORT."
    (name "tailon")
    (description "Connect to a running Tailon server.")
    (value (run-tailon-test))))
+
+\f
+;;;
+;;; Patchwork
+;;;
+
+(define %patchwork-os
+  (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
+             (settings-module
+              (patchwork-settings-module
+               (secret-key "00000")
+               (allowed-hosts '("*"))
+               (default-from-email "")
+               (debug? #t)))
+             (domain "localhost")))))
+
+(define* (run-patchwork-test)
+  "Run tests in %NGINX-OS, which has nginx running and listening on
+HTTP-PORT."
+  (define os
+    (marionette-operating-system
+     %patchwork-os
+     #: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 "httpd service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (match (start-service 'httpd)
+                  (#f #f)
+                  (('service response-parts ...)
+                   (match (assq-ref response-parts 'running)
+                     ((#t) #t)
+                     ((pid) (number? pid))))))
+             marionette))
+
+          ;; Retrieve the index.html file we put in /srv.
+          (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 "")
+   (value (run-patchwork-test))))
-- 
2.18.0

[bug#33185] [PATCH 7/7] services: Add patchwork.

[swedebugia]

Hi

On 2018-11-04 11:44, Christopher Baines wrote:
> ---
>   gnu/services/web.scm | 297 ++++++++++++++++++++++++++++++++++++++++++-
>   gnu/tests/web.scm    | 104 ++++++++++++++-
>   2 files changed, 399 insertions(+), 2 deletions(-)

Nice work with the service-declaration. :) (untested)

Would you be willing to update the patch with documentation also?

-- 
Cheers
Swedebugia

[bug#33185] [PATCH 7/7] services: Add patchwork.

[Ludovic Courtès]

Hello,

swedebugia <swedebugia@riseup.net> skribis:

> On 2018-11-04 11:44, Christopher Baines wrote:
>> ---
>>   gnu/services/web.scm | 297 ++++++++++++++++++++++++++++++++++++++++++-
>>   gnu/tests/web.scm    | 104 ++++++++++++++-
>>   2 files changed, 399 insertions(+), 2 deletions(-)
>
> Nice work with the service-declaration. :) (untested)

+1!

> Would you be willing to update the patch with documentation also?

Yes, also with ‘documentation’ fields.  :-)

I spotted a typo here:

+(define-record-type* <patchwork-configuration>
+  patchwork-configuration make-patchwork-configuration
+  patckwork-configuration?
      ^^

Regarding ‘patchwork-setup-gexp’, I wonder if you could use
‘make-forkexec-constructor’ with the appropriate environment variables
and move the “createuser” bit to an activation snippet.

Hmm maybe the activation snippet would run too early, right?  In that
case, perhaps you could create another Shepherd service,
‘patchwork-initialization’, that would do the createuser stuff, and have
‘patchwork’ depend on it.

Thoughts?

Thanks, Chris!

Ludo’.

[bug#33185] [PATCH 7/7] services: Add patchwork.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 1942 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> Hello,
>
> swedebugia <swedebugia@riseup.net> skribis:
>
>> On 2018-11-04 11:44, Christopher Baines wrote:
>>> ---
>>>   gnu/services/web.scm | 297 ++++++++++++++++++++++++++++++++++++++++++-
>>>   gnu/tests/web.scm    | 104 ++++++++++++++-
>>>   2 files changed, 399 insertions(+), 2 deletions(-)
>>
>> Nice work with the service-declaration. :) (untested)
>
> +1!
>
>> Would you be willing to update the patch with documentation also?
>
> Yes, also with ‘documentation’ fields.  :-)
>
> I spotted a typo here:
>
> +(define-record-type* <patchwork-configuration>
> +  patchwork-configuration make-patchwork-configuration
> +  patckwork-configuration?
>       ^^

Good spot!

> Regarding ‘patchwork-setup-gexp’, I wonder if you could use
> ‘make-forkexec-constructor’ with the appropriate environment variables
> and move the “createuser” bit to an activation snippet.
>
> Hmm maybe the activation snippet would run too early, right?  In that
> case, perhaps you could create another Shepherd service,
> ‘patchwork-initialization’, that would do the createuser stuff, and have
> ‘patchwork’ depend on it.

So, I've made some changes since I last sent this patch, the biggest
being splitting the database creation out from running of the database
migrations.

Assuming that the shepherd service defined as part of the
patchwork-service-type just runs the migrations, yes, it needs
PostgreSQL (or whatever database you're using) to be available.

At the moment, the service is hardcoded to use mod_wsgi, so it runs
through the httpd-service, no shepherd service for running patchwork is
needed in the service-type at least.

It would be good to try and make it more flexible in the future, at
least so that you can pick and choose a bit more (and instead use uwsgi,
gunicorn, ...).

Thanks for taking a look :)

Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH 7/7] services: Add patchwork.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 468 bytes --]


swedebugia <swedebugia@riseup.net> writes:

> Hi
>
> On 2018-11-04 11:44, Christopher Baines wrote:
>> ---
>>   gnu/services/web.scm | 297 ++++++++++++++++++++++++++++++++++++++++++-
>>   gnu/tests/web.scm    | 104 ++++++++++++++-
>>   2 files changed, 399 insertions(+), 2 deletions(-)
>
> Nice work with the service-declaration. :) (untested)

Thanks :)

> Would you be willing to update the patch with documentation also?

Yep, I hope to get to this eventually :)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH v2 1/2] gnu: Add patchwork.

[Christopher Baines]

* gnu/packages/patchutils.scm (patchwork): New variable.
---
 gnu/packages/patchutils.scm | 154 ++++++++++++++++++++++++++++++++++++
 1 file changed, 154 insertions(+)

diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm
index 09f5afbb28..cba2076175 100644
--- a/gnu/packages/patchutils.scm
+++ b/gnu/packages/patchutils.scm
@@ -31,6 +31,8 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages check)
+  #:use-module (gnu packages databases)
+  #:use-module (gnu packages django)
   #:use-module (gnu packages file)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
@@ -305,3 +307,155 @@ directories, and has support for many popular version control systems.
 Meld helps you review code changes and understand patches.  It might even help
 you to figure out what is going on in that merge you keep avoiding.")
     (license gpl2)))
+
+(define-public patchwork
+  (package
+    (name "patchwork")
+    (version "2.1.1")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/getpatchwork/patchwork.git")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "1wpcgkji9cb50lyv12ifgk08sjn7dkqkzis9qjwhx6y855dfdfn1"))))
+    (build-system python-build-system)
+    (arguments
+     `(;; TODO: Tests require a running database
+       #:tests? #f
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (delete 'build)
+         (add-after 'unpack 'replace-wsgi.py
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (delete-file "patchwork/wsgi.py")
+             (call-with-output-file "patchwork/wsgi.py"
+               (lambda (port)
+                 ;; Embed the PYTHONPATH containing the dependencies, as well
+                 ;; as the python modules in this package in the wsgi.py file,
+                 ;; as this will ensure they are available at runtime.
+                 (define pythonpath
+                   (string-append (getenv "PYTHONPATH")
+                                  ":"
+                                  (site-packages inputs outputs)))
+                 (display
+                  (string-append "
+import os, sys
+
+sys.path.extend('" pythonpath "'.split(':'))
+
+from django.core.wsgi import get_wsgi_application
+
+# By default, assume that patchwork is running as a Guix service, which
+# provides the settings as the 'guix.patchwork.settings' Python module.
+#
+# When using httpd, it's hard to set environment variables, so rely on the
+# default set here.
+os.environ['DJANGO_SETTINGS_MODULE'] = os.getenv(
+  'DJANGO_SETTINGS_MODULE',
+  'guix.patchwork.settings' # default
+)
+
+application = get_wsgi_application()\n") port)))))
+         (replace 'check
+           (lambda* (#:key tests? #:allow-other-keys)
+             (or (not tests?)
+                 (begin
+                   (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
+                   (invoke
+                    "python" "-Wonce" "./manage.py" "test" "--noinput")
+                   #t))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (for-each (lambda (directory)
+                           (copy-recursively
+                            directory
+                            (string-append (site-packages inputs outputs)
+                                           "/" directory)))
+                         '("patchwork"
+                           "templates"))
+               (delete-file-recursively (string-append
+                                    (site-packages inputs outputs)
+                                    "patchwork/tests"))
+               ;; pwclient
+               (for-each (lambda (file)
+                           (install-file file (string-append out "/bin")))
+                         (list
+                          (string-append (site-packages inputs outputs)
+                                         "/patchwork/bin/pwclient")
+                          (string-append (site-packages inputs outputs)
+                                         "/patchwork/bin/parsemail.sh")
+                          (string-append (site-packages inputs outputs)
+                                         "patchwork/bin/parsemail-batch.sh")))
+
+               (simple-format #t "replacing template pwclient symlink")
+               (let ((template-pwclient (string-append
+                                         (site-packages inputs outputs)
+                                         "/patchwork/templates/patchwork/pwclient")))
+                 (delete-file template-pwclient)
+                 (copy-file (string-append (site-packages inputs outputs)
+                                           "/patchwork/bin/pwclient")
+                            template-pwclient))
+
+               (let ((static-root
+                      (string-append out "/share/patchwork/htdocs")))
+                 (mkdir-p static-root)
+                 (copy-file "patchwork/settings/production.example.py"
+                            "patchwork/settings/assets.py")
+                 (setenv "DJANGO_SECRET_KEY" "dummyvalue")
+                 (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.assets")
+                 (setenv "STATIC_ROOT" static-root)
+                 (invoke "./manage.py" "collectstatic" "--no-input"))
+
+               (copy-recursively "lib"
+                                 (string-append
+                                  out "/share/doc/" ,name "-" ,version)))
+             #t))
+         (add-after 'install 'install-hasher
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out")))
+               (chmod (string-append (site-packages inputs outputs)
+                                     "/patchwork/hasher.py")
+                      #o555)
+               (symlink (string-append (site-packages inputs outputs)
+                                       "/patchwork/hasher.py")
+                        (string-append out "/bin/hasher")))
+             #t))
+         ;; Create a patchwork specific version of Django's command line admin
+         ;; utility.
+         (add-after 'install 'install-patchwork-admin
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out")))
+               (mkdir-p (string-append out "/bin"))
+               (call-with-output-file (string-append out "/bin/patchwork-admin")
+                 (lambda (port)
+                   (display "#!/usr/bin/env python3
+import os, sys
+
+if __name__ == \"__main__\":
+    from django.core.management import execute_from_command_line
+
+    execute_from_command_line(sys.argv)" port)))
+               (chmod (string-append out "/bin/patchwork-admin") #o555))
+             #t)))))
+    (inputs
+     `(("python-wrapper" ,python-wrapper)))
+    (propagated-inputs
+     `(("python-django" ,python-django)
+       ;; TODO: Make this configurable
+       ("python-psycopg2" ,python-psycopg2)
+       ("python-mysqlclient" ,python-mysqlclient)
+       ("python-django-filter" ,python-django-filter)
+       ("python-djangorestframework" ,python-djangorestframework)
+       ("python-django-debug-toolbar" ,python-django-debug-toolbar)))
+    (synopsis "Web based patch tracking system")
+    (description
+     "Patchwork is a patch tracking system.  It takes in emails containing
+patches, and displays the patches along with comments and state information.
+Users can login allowing them to change the state of patches.")
+    (home-page "http://jk.ozlabs.org/projects/patchwork/")
+    (license gpl2+)))
-- 
2.20.1

[bug#33185] [PATCH v2 2/2] services: Add patchwork.

[Christopher Baines]

* gnu/service/web.scm (<patchwork-database-configuration>
<patchwork-settings-module>, <patchwork-configuration>): New record types.
(patchwork-virtualhost): New procedure.
(patchwork-service-type): New variable.
* gnu/tests/web.scm (%test-patchwork): New variable.
---
 gnu/services/web.scm | 284 ++++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/web.scm    | 160 +++++++++++++++++++++++-
 2 files changed, 442 insertions(+), 2 deletions(-)

diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index d71fed20ed..1986c2095c 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -32,12 +32,17 @@
   #: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 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))
@@ -211,7 +216,42 @@
             varnish-configuration-parameters
             varnish-configuration-extra-options
 
-            varnish-service-type))
+            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))
 
 ;;; Commentary:
 ;;;
@@ -1269,3 +1309,245 @@ files.")
                              varnish-shepherd-service)))
    (default-value
      (varnish-configuration))))
+
+\f
+;;;
+;;; 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))
+  (settings-module      patchwork-configuration-settings-module)
+  (domain               patchwork-configuration-domain))
+
+;; 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))
+"]
+
+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
+      (($ <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 settings-module
+                                  domain)
+
+     (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>
+
+Alias /static " ,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-service-type
+  (service-type
+   (name 'patchwork-setup)
+   (extensions
+    (list (service-extension httpd-service-type
+                             patchwork-httpd-configuration)
+          (service-extension
+           shepherd-root-service-type
+           (match-lambda
+             (($ <patchwork-configuration> patchwork settings-module
+                                           domain)
+              (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))
+
+                          (run-django-admin-command "migrate")))
+                     (stop #~(const #f))
+                     (actions
+                      (list (patchwork-django-admin-action patchwork
+                                                           settings-module)))
+                     (respawn? #f)
+                     (documentation "Setup patchwork."))))))))
+   (description
+    "Patchwork patch tracking system.")))
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 319655396a..0b109c0ed7 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -28,15 +28,27 @@
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services web)
+  #:use-module (gnu services databases)
   #:use-module (gnu services networking)
+  #:use-module (gnu services shepherd)
+  #: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 +510,149 @@ HTTP-PORT."
    (name "tailon")
    (description "Connect to a running Tailon server.")
    (value (run-tailon-test))))
+
+\f
+;;;
+;;; Patchwork
+;;;
+
+(define patchwork-initial-database-setup-service
+  (match-lambda
+    (($ <patchwork-database-configuration>
+        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)
+   (simple-service 'patchwork-create-django-secret-key
+                   activation-service-type
+                   #~(begin
+                       (mkdir "/etc/patchwork")
+                       (call-with-output-file "/etc/patchwork/django-secret-key"
+                         (lambda (p)
+                           (display "000000\n" p)))
+                       #t))
+   (service patchwork-service-type
+            (patchwork-configuration
+             (patchwork patchwork)
+             (settings-module
+              (patchwork-settings-module
+               (allowed-hosts '("*"))
+               (default-from-email "")
+               (debug? #t)))
+             (domain "localhost")))
+   (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))))
-- 
2.20.1

[bug#33185] [PATCH v2 2/2] services: Add patchwork.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 1524 bytes --]


Christopher Baines <mail@cbaines.net> writes:

> +(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))))

It would be really useful to provide an easy way of accessing the Django
admin utilities. I think Shepherd actions might be a good way of doing
this, but I haven't got it working yet... I think something goes wrong
when it forks, so I might need to try different approaches to change
user.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH v2 1/2] gnu: Add patchwork.

[Ricardo Wurmus]

Hi Chris,

thanks for the patch!

> * gnu/packages/patchutils.scm (patchwork): New variable.
[…]
> +         (replace 'check
> +           (lambda* (#:key tests? #:allow-other-keys)
> +             (or (not tests?)
> +                 (begin
> +                   (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
> +                   (invoke
> +                    "python" "-Wonce" "./manage.py" "test" "--noinput")
> +                   #t))))

Maybe write this as

         (replace 'check
           (lambda* (#:key tests? #:allow-other-keys)
             (when tests?
               (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
               (invoke
                "python" "-Wonce" "./manage.py" "test" "--noinput"))
             #t))

> +         (replace 'install
> +           (lambda* (#:key inputs outputs #:allow-other-keys)
> +             (let ((out (assoc-ref outputs "out"))) […]

This phase might be less verbose if you let-bound the result of
(site-packages inputs outputs) at the beginning.  It would also be good
if there were more comments about what’s going on.  It’s not all obvious
(e.g. why “lib” is copied to “docs”).

> +               (simple-format #t "replacing template pwclient symlink")

Use “display” instead of “simple-format #t”?

> +         (add-after 'install 'install-hasher
> +           (lambda* (#:key inputs outputs #:allow-other-keys)
> +             (let* ((out (assoc-ref outputs "out")))
> +               (chmod (string-append (site-packages inputs outputs)
> +                                     "/patchwork/hasher.py")
> +                      #o555)
> +               (symlink (string-append (site-packages inputs outputs)
> +                                       "/patchwork/hasher.py")
> +                        (string-append out "/bin/hasher")))
> +             #t))

Here also consider simplifying with let.

> +         ;; Create a patchwork specific version of Django's command line admin
> +         ;; utility.
> +         (add-after 'install 'install-patchwork-admin
> +           (lambda* (#:key inputs outputs #:allow-other-keys)
> +             (let* ((out (assoc-ref outputs "out")))
> +               (mkdir-p (string-append out "/bin"))
> +               (call-with-output-file (string-append out "/bin/patchwork-admin")
> +                 (lambda (port)
> +                   (display "#!/usr/bin/env python3

Should this really say “#!/usr/bin/env python3”?

--
Ricardo

[bug#33185] [PATCH v2 1/2] gnu: Add patchwork.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 3322 bytes --]


Ricardo Wurmus <rekado@elephly.net> writes:

> Hi Chris,
>
> thanks for the patch!

And thanks for your feedback :) I've sent some updated patches.

>> * gnu/packages/patchutils.scm (patchwork): New variable.
> […]
>> +         (replace 'check
>> +           (lambda* (#:key tests? #:allow-other-keys)
>> +             (or (not tests?)
>> +                 (begin
>> +                   (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
>> +                   (invoke
>> +                    "python" "-Wonce" "./manage.py" "test" "--noinput")
>> +                   #t))))
>
> Maybe write this as
>
>          (replace 'check
>            (lambda* (#:key tests? #:allow-other-keys)
>              (when tests?
>                (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
>                (invoke
>                 "python" "-Wonce" "./manage.py" "test" "--noinput"))
>              #t))

Yep, I've updated it to use when now.

>> +         (replace 'install
>> +           (lambda* (#:key inputs outputs #:allow-other-keys)
>> +             (let ((out (assoc-ref outputs "out"))) […]
>
> This phase might be less verbose if you let-bound the result of
> (site-packages inputs outputs) at the beginning.  It would also be good
> if there were more comments about what’s going on.  It’s not all obvious
> (e.g. why “lib” is copied to “docs”).

I've used let more now, and tried to be a bit more descriptive in the
comments. I'll reconfigure the patchwork instances I host at some point
and hopefully add more detail then.

>> +               (simple-format #t "replacing template pwclient symlink")
>
> Use “display” instead of “simple-format #t”?

That was just a debugging thing, I've removed it.

>> +         (add-after 'install 'install-hasher
>> +           (lambda* (#:key inputs outputs #:allow-other-keys)
>> +             (let* ((out (assoc-ref outputs "out")))
>> +               (chmod (string-append (site-packages inputs outputs)
>> +                                     "/patchwork/hasher.py")
>> +                      #o555)
>> +               (symlink (string-append (site-packages inputs outputs)
>> +                                       "/patchwork/hasher.py")
>> +                        (string-append out "/bin/hasher")))
>> +             #t))
>
> Here also consider simplifying with let.

Yep, I've used let here more now.

>> +         ;; Create a patchwork specific version of Django's command line admin
>> +         ;; utility.
>> +         (add-after 'install 'install-patchwork-admin
>> +           (lambda* (#:key inputs outputs #:allow-other-keys)
>> +             (let* ((out (assoc-ref outputs "out")))
>> +               (mkdir-p (string-append out "/bin"))
>> +               (call-with-output-file (string-append out "/bin/patchwork-admin")
>> +                 (lambda (port)
>> +                   (display "#!/usr/bin/env python3
>
> Should this really say “#!/usr/bin/env python3”?

So this was fine, as it was replaced in a future stage. But yes, it's
probably better to use a more appropriate value that isn't changed later
on. I've updated this now.

So yes, I've sent some updated patches, still a few niggles, but they're
getting better.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH v3 1/2] gnu: Add patchwork.

[Christopher Baines]

* gnu/packages/patchutils.scm (patchwork): New variable.
---
 gnu/packages/patchutils.scm | 165 ++++++++++++++++++++++++++++++++++++
 1 file changed, 165 insertions(+)

diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm
index 09f5afbb28..260bba3d41 100644
--- a/gnu/packages/patchutils.scm
+++ b/gnu/packages/patchutils.scm
@@ -31,6 +31,8 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages check)
+  #:use-module (gnu packages databases)
+  #:use-module (gnu packages django)
   #:use-module (gnu packages file)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
@@ -305,3 +307,166 @@ directories, and has support for many popular version control systems.
 Meld helps you review code changes and understand patches.  It might even help
 you to figure out what is going on in that merge you keep avoiding.")
     (license gpl2)))
+
+(define-public patchwork
+  (package
+    (name "patchwork")
+    (version "2.1.1")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/getpatchwork/patchwork.git")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "1wpcgkji9cb50lyv12ifgk08sjn7dkqkzis9qjwhx6y855dfdfn1"))))
+    (build-system python-build-system)
+    (arguments
+     `(;; TODO: Tests require a running database
+       #:tests? #f
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (delete 'build)
+         (add-after 'unpack 'replace-wsgi.py
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (delete-file "patchwork/wsgi.py")
+             (call-with-output-file "patchwork/wsgi.py"
+               (lambda (port)
+                 ;; Embed the PYTHONPATH containing the dependencies, as well
+                 ;; as the python modules in this package in the wsgi.py file,
+                 ;; as this will ensure they are available at runtime.
+                 (define pythonpath
+                   (string-append (getenv "PYTHONPATH")
+                                  ":"
+                                  (site-packages inputs outputs)))
+                 (display
+                  (string-append "
+import os, sys
+
+sys.path.extend('" pythonpath "'.split(':'))
+
+from django.core.wsgi import get_wsgi_application
+
+# By default, assume that patchwork is running as a Guix service, which
+# provides the settings as the 'guix.patchwork.settings' Python module.
+#
+# When using httpd, it's hard to set environment variables, so rely on the
+# default set here.
+os.environ['DJANGO_SETTINGS_MODULE'] = os.getenv(
+  'DJANGO_SETTINGS_MODULE',
+  'guix.patchwork.settings' # default
+)
+
+application = get_wsgi_application()\n") port)))))
+         (replace 'check
+           (lambda* (#:key tests? #:allow-other-keys)
+             (when tests?
+               (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
+               (invoke "python" "-Wonce" "./manage.py" "test" "--noinput"))
+             #t))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out"))
+                   (out-site-packages (site-packages inputs outputs)))
+               (for-each (lambda (directory)
+                           (copy-recursively
+                            directory
+                            (string-append out-site-packages directory)))
+                         '(;; Contains the python code
+                           "patchwork"
+                           ;; Contains the templates for the generated HTML
+                           "templates"))
+               (delete-file-recursively
+                (string-append out-site-packages "patchwork/tests"))
+
+               ;; Install patchwork related tools
+               (for-each (lambda (file)
+                           (install-file file (string-append out "/bin")))
+                         (list
+                          (string-append out-site-packages
+                                         "patchwork/bin/pwclient")
+                          (string-append out-site-packages
+                                         "patchwork/bin/parsemail.sh")
+                          (string-append out-site-packages
+                                         "patchwork/bin/parsemail-batch.sh")))
+
+               ;; TODO: Can't remembed why this was important... but I think
+               ;; it is.
+               (let ((template-pwclient (string-append
+                                         out-site-packages
+                                         "patchwork/templates/patchwork/pwclient")))
+                 (delete-file template-pwclient)
+                 (copy-file (string-append out-site-packages
+                                           "patchwork/bin/pwclient")
+                            template-pwclient))
+
+               ;; Collect the static assets, this includes JavaScript, CSS and
+               ;; fonts. This is a standard Django process when running a
+               ;; Django application for regular use, and includes assets for
+               ;; dependencies like the admin site from Django.
+               ;;
+               ;; The intent here is that you can serve files from this
+               ;; directory through a webserver, which is recommended when
+               ;; running Django applications.
+               (let ((static-root
+                      (string-append out "/share/patchwork/htdocs")))
+                 (mkdir-p static-root)
+                 (copy-file "patchwork/settings/production.example.py"
+                            "patchwork/settings/assets.py")
+                 (setenv "DJANGO_SECRET_KEY" "dummyvalue")
+                 (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.assets")
+                 (setenv "STATIC_ROOT" static-root)
+                 (invoke "./manage.py" "collectstatic" "--no-input"))
+
+               ;; The lib directory includes example configuration files that
+               ;; may be useful when deploying patchwork.
+               (copy-recursively "lib"
+                                 (string-append
+                                  out "/share/doc/" ,name "-" ,version)))
+             #t))
+         ;; The hasher script is used from the post-receive.hook
+         (add-after 'install 'install-hasher
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (out-site-packages (site-packages inputs outputs))
+                    (out-hasher.py (string-append out-site-packages
+                                                  "/patchwork/hasher.py")))
+               (chmod out-hasher.py #o555)
+               (symlink out-hasher.py (string-append out "/bin/hasher")))
+             #t))
+         ;; Create a patchwork specific version of Django's command line admin
+         ;; utility.
+         (add-after 'install 'install-patchwork-admin
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out")))
+               (mkdir-p (string-append out "/bin"))
+               (call-with-output-file (string-append out "/bin/patchwork-admin")
+                 (lambda (port)
+                   (simple-format port "#!~A
+import os, sys
+
+if __name__ == \"__main__\":
+    from django.core.management import execute_from_command_line
+
+    execute_from_command_line(sys.argv)" (which "python"))))
+               (chmod (string-append out "/bin/patchwork-admin") #o555))
+             #t)))))
+    (inputs
+     `(("python-wrapper" ,python-wrapper)))
+    (propagated-inputs
+     `(("python-django" ,python-django)
+       ;; TODO: Make this configurable
+       ("python-psycopg2" ,python-psycopg2)
+       ("python-mysqlclient" ,python-mysqlclient)
+       ("python-django-filter" ,python-django-filter)
+       ("python-djangorestframework" ,python-djangorestframework)
+       ("python-django-debug-toolbar" ,python-django-debug-toolbar)))
+    (synopsis "Web based patch tracking system")
+    (description
+     "Patchwork is a patch tracking system.  It takes in emails containing
+patches, and displays the patches along with comments and state information.
+Users can login allowing them to change the state of patches.")
+    (home-page "http://jk.ozlabs.org/projects/patchwork/")
+    (license gpl2+)))
-- 
2.20.1

[bug#33185] [PATCH v3 2/2] services: Add patchwork.

[Christopher Baines]

* gnu/service/web.scm (<patchwork-database-configuration>
<patchwork-settings-module>, <patchwork-configuration>): New record types.
(patchwork-virtualhost): New procedure.
(patchwork-service-type): New variable.
* gnu/tests/web.scm (%test-patchwork): New variable.
---
 gnu/services/web.scm | 284 ++++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/web.scm    | 160 +++++++++++++++++++++++-
 2 files changed, 442 insertions(+), 2 deletions(-)

diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index d71fed20ed..1986c2095c 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -32,12 +32,17 @@
   #: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 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))
@@ -211,7 +216,42 @@
             varnish-configuration-parameters
             varnish-configuration-extra-options
 
-            varnish-service-type))
+            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))
 
 ;;; Commentary:
 ;;;
@@ -1269,3 +1309,245 @@ files.")
                              varnish-shepherd-service)))
    (default-value
      (varnish-configuration))))
+
+\f
+;;;
+;;; 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))
+  (settings-module      patchwork-configuration-settings-module)
+  (domain               patchwork-configuration-domain))
+
+;; 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))
+"]
+
+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
+      (($ <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 settings-module
+                                  domain)
+
+     (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>
+
+Alias /static " ,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-service-type
+  (service-type
+   (name 'patchwork-setup)
+   (extensions
+    (list (service-extension httpd-service-type
+                             patchwork-httpd-configuration)
+          (service-extension
+           shepherd-root-service-type
+           (match-lambda
+             (($ <patchwork-configuration> patchwork settings-module
+                                           domain)
+              (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))
+
+                          (run-django-admin-command "migrate")))
+                     (stop #~(const #f))
+                     (actions
+                      (list (patchwork-django-admin-action patchwork
+                                                           settings-module)))
+                     (respawn? #f)
+                     (documentation "Setup patchwork."))))))))
+   (description
+    "Patchwork patch tracking system.")))
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 319655396a..0b109c0ed7 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -28,15 +28,27 @@
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services web)
+  #:use-module (gnu services databases)
   #:use-module (gnu services networking)
+  #:use-module (gnu services shepherd)
+  #: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 +510,149 @@ HTTP-PORT."
    (name "tailon")
    (description "Connect to a running Tailon server.")
    (value (run-tailon-test))))
+
+\f
+;;;
+;;; Patchwork
+;;;
+
+(define patchwork-initial-database-setup-service
+  (match-lambda
+    (($ <patchwork-database-configuration>
+        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)
+   (simple-service 'patchwork-create-django-secret-key
+                   activation-service-type
+                   #~(begin
+                       (mkdir "/etc/patchwork")
+                       (call-with-output-file "/etc/patchwork/django-secret-key"
+                         (lambda (p)
+                           (display "000000\n" p)))
+                       #t))
+   (service patchwork-service-type
+            (patchwork-configuration
+             (patchwork patchwork)
+             (settings-module
+              (patchwork-settings-module
+               (allowed-hosts '("*"))
+               (default-from-email "")
+               (debug? #t)))
+             (domain "localhost")))
+   (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))))
-- 
2.20.1

[bug#33185] [PATCH 0/7] Add patchwork package and service.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 1947 bytes --]


Christopher Baines <mail@cbaines.net> writes:

> These patches add a package for patchwork, a web-based patch tracking
> system, along with some missing dependencies and the beginnings of a
> system service and test.
>
> Everything up to the patchwork package should be ready to merge, but the
> patchwork package, service and system test is currently very rough and
> unready.
>
>
> Christopher Baines (7):
>   gnu: Add python-jsmin.
>   gnu: Add python-slimit.
>   gnu: Add python-django-pipeline.
>   gnu: Add python-django-jinja.
>   gnu: Add python-django-debug-toolbar.
>   gnu: Add patchwork.
>   services: Add patchwork.
>
>  gnu/packages/django.scm     | 130 ++++++++++++++++
>  gnu/packages/patchutils.scm |  95 ++++++++++++
>  gnu/packages/python-web.scm |  50 +++++++
>  gnu/services/web.scm        | 291 +++++++++++++++++++++++++++++++++++-
>  gnu/tests/web.scm           | 104 ++++++++++++-
>  5 files changed, 668 insertions(+), 2 deletions(-)

Following on from this, I believe the first 5 patches adding the
prerequisite packages for patchwork have now been added.

The initial package and service for Patchwork wasn't ready to add to
Guix, but I now believe it is at least ready to review.

In addition to Patchwork, this patch series also includes a service for
Getmail. I believe this is the simplest way of getting patches in to
Patchwork.


Christopher Baines (3):
  services: Add getmail.
  gnu: Add patchwork.
  services: Add patchwork.

 doc/guix.texi               | 464 ++++++++++++++++++++++++++++++++++++
 gnu/local.mk                |   1 +
 gnu/packages/patchutils.scm | 166 +++++++++++++
 gnu/services/getmail.scm    | 380 +++++++++++++++++++++++++++++
 gnu/services/web.scm        | 366 +++++++++++++++++++++++++++-
 gnu/tests/mail.scm          | 177 +++++++++++++-
 gnu/tests/web.scm           | 162 ++++++++++++-
 7 files changed, 1713 insertions(+), 3 deletions(-)
 create mode 100644 gnu/services/getmail.scm

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#33185] [PATCH 1/3] services: Add getmail.

[Christopher Baines]

Getmail is a mail retriever written in Python, this commit adds a service-type
to run getmail. I'm looking at this, as it's a convinient way of getting
mailing list messages in to Patchwork.

I initially tried putting this in the (gnu services mail) module, but due to
also trying to use the define-configuration pattern, it conflicted with the
dovecot service.

* gnu/services/getmail.scm: New file.
* gnu/local.mk: Add it.
* gnu/tests/mail.scm (%getmail-os, %test-getmail): New variables.
(run-getmail-test): New procedure.
---
 doc/guix.texi            | 290 ++++++++++++++++++++++++++++++
 gnu/local.mk             |   1 +
 gnu/services/getmail.scm | 380 +++++++++++++++++++++++++++++++++++++++
 gnu/tests/mail.scm       | 178 +++++++++++++++++-
 4 files changed, 848 insertions(+), 1 deletion(-)
 create mode 100644 gnu/services/getmail.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 7cda06de5c..e23d178697 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -16651,6 +16651,296 @@ variables.
 @end table
 @end deftp
 
+@subsubheading Getmail service
+
+@cindex IMAP
+@cindex POP
+
+@deffn {Scheme Variable} getmail-service-type
+This is the type of the @uref{http://pyropus.ca/software/getmail/, Getmail}
+mail retriever, whose value should be an @code{getmail-configuration}.
+
+Available @code{getmail-configuration} fields are:
+
+@deftypevr {@code{getmail-configuration} parameter} symbol name
+A symbol to identify the getmail service.
+
+Defaults to @samp{"unset"}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-configuration} parameter} package package
+The getmail package to use.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-configuration} parameter} string user
+The user to run getmail as.
+
+Defaults to @samp{"getmail"}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-configuration} parameter} string group
+The group to run getmail as.
+
+Defaults to @samp{"getmail"}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-configuration} parameter} string directory
+The getmail directory to use.
+
+Defaults to @samp{"/var/lib/getmail/default"}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-configuration} parameter} getmail-configuration-file rcfile
+The getmail configuration file to use.
+
+Available @code{getmail-configuration-file} fields are:
+
+@deftypevr {@code{getmail-configuration-file} parameter} getmail-retriever-configuration retriever
+What mail account to retrieve mail from, and how to access that account.
+
+Available @code{getmail-retriever-configuration} fields are:
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} string type
+The type of mail retriever to use.  Valid values include @samp{passwd}
+and @samp{static}.
+
+Defaults to @samp{"SimpleIMAPSSLRetriever"}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} string server
+Space separated list of arguments to the userdb driver.
+
+Defaults to @samp{unset}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} string username
+Space separated list of arguments to the userdb driver.
+
+Defaults to @samp{unset}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} non-negative-integer port
+Space separated list of arguments to the userdb driver.
+
+Defaults to @samp{#f}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} string password
+Override fields from passwd.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} list password-command
+Override fields from passwd.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} string keyfile
+PEM-formatted key file to use for the TLS negotiation
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} string certfile
+PEM-formatted certificate file to use for the TLS negotiation
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} string ca-certs
+CA certificates to use
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-retriever-configuration} parameter} parameter-alist extra-parameters
+Extra retriever parameters
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
+@end deftypevr
+
+@deftypevr {@code{getmail-configuration-file} parameter} getmail-destination-configuration destination
+What to do with retrieved messages.
+
+Available @code{getmail-destination-configuration} fields are:
+
+@deftypevr {@code{getmail-destination-configuration} parameter} string type
+The type of mail destination.  Valid values include @samp{Maildir},
+@samp{Mboxrd} and @samp{MDA_external}.
+
+Defaults to @samp{unset}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-destination-configuration} parameter} string-or-filelike path
+The path option for the mail destination.  The behaviour depends on the
+chosen type.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-destination-configuration} parameter} parameter-alist extra-parameters
+Extra destination parameters
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
+@end deftypevr
+
+@deftypevr {@code{getmail-configuration-file} parameter} getmail-options-configuration options
+Configure getmail.
+
+Available @code{getmail-options-configuration} fields are:
+
+@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer verbose
+If set to @samp{0}, getmail will only print warnings and errors.  A
+value of @samp{1} means that messages will be printed about retrieving
+and deleting messages.  If set to @samp{2}, getmail will print messages
+about each of it's actions.
+
+Defaults to @samp{1}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} boolean read-all
+If true, getmail will retrieve all available messages.  Otherwise it
+will only retrieve messages it hasn't seen previously.
+
+Defaults to @samp{#t}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} boolean delete
+If set to true, messages will be deleted from the server after
+retrieving and successfully delivering them.  Otherwise, messages will
+be left on the server.
+
+Defaults to @samp{#f}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer delete-after
+Getmail will delete messages this number of days after seeing them, if
+they have not been delivered.  This means messages will be left on the
+server this number of days after delivering them.  A value of @samp{0}
+disabled this feature.
+
+Defaults to @samp{0}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer delete-bigger-than
+Delete messages larger than this of bytes after retrieving them, even if
+the delete and delete-after options are disabled.  A value of @samp{0}
+disables this feature.
+
+Defaults to @samp{0}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer max-bytes-per-session
+Retrieve messages totalling up to this number of bytes before closing
+the session with the server.  A value of @samp{0} disables this feature.
+
+Defaults to @samp{0}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer max-message-size
+Don't retrieve messages larger than this number of bytes.  A value of
+@samp{0} disables this feature.
+
+Defaults to @samp{0}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} boolean delivered-to
+If true, getmail will add a Delivered-To header to messages.
+
+Defaults to @samp{#t}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} boolean received
+If set, getmail adds a Received header to the messages.
+
+Defaults to @samp{#t}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} string message-log
+Getmail will record a log of its actions to the named file.  A value of
+@samp{""} disables this feature.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} boolean message-log-syslog
+If true, getmail will record a log of its actions using the system
+logger.
+
+Defaults to @samp{#t}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} boolean message-log-verbose
+If true, getmail will log information about messages not retrieved and
+the reason for not retrieving them, as well as starting and ending
+information lines.
+
+Defaults to @samp{#t}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-options-configuration} parameter} parameter-alist extra-parameters
+Extra options to include.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
+@end deftypevr
+
+@end deftypevr
+
+@deftypevr {@code{getmail-configuration} parameter} list idle
+A list of mailboxes that getmail should wait on the server for new mail
+notifications.  This depends on the server supporting the IDLE
+extension.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
+@deftypevr {@code{getmail-configuration} parameter} list environment-variables
+Environment variables to set for getmail.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
 @subsubheading Mail Aliases Service
 
 @cindex email aliases
diff --git a/gnu/local.mk b/gnu/local.mk
index a0f40d13ae..f7dbf5d919 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -513,6 +513,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/services/docker.scm			\
   %D%/services/authentication.scm		\
   %D%/services/games.scm			\
+  %D%/services/getmail.scm				\
   %D%/services/kerberos.scm			\
   %D%/services/lirc.scm				\
   %D%/services/virtualization.scm		\
diff --git a/gnu/services/getmail.scm b/gnu/services/getmail.scm
new file mode 100644
index 0000000000..b807bb3a5d
--- /dev/null
+++ b/gnu/services/getmail.scm
@@ -0,0 +1,380 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; 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 getmail)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu system pam)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu packages mail)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu packages tls)
+  #:use-module (guix records)
+  #:use-module (guix store)
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:export (getmail-retriever-configuration
+            getmail-retriever-configuration-extra-parameters
+            getmail-destination-configuration
+            getmail-options-configuration
+            getmail-configuration-file
+            getmail-configuration
+            getmail-service-type))
+
+;;; Commentary:
+;;;
+;;; Service for the getmail mail retriever.
+;;;
+;;; Code:
+
+(define (uglify-field-name field-name)
+  (let ((str (symbol->string field-name)))
+    (string-join (string-split (if (string-suffix? "?" str)
+                                   (substring str 0 (1- (string-length str)))
+                                   str)
+                               #\-)
+                 "_")))
+
+(define (serialize-field field-name val)
+  #~(let ((val '#$val))
+      (format #f "~a = ~a\n"
+              #$(uglify-field-name field-name)
+              (cond
+               ((list? val)
+                (string-append
+                 "("
+                 (string-concatenate
+                  (map (lambda (list-val)
+                         (format #f "\"~a\", " list-val))
+                       val))
+                 ")"))
+               (else
+                val)))))
+
+(define (serialize-string field-name val)
+  (if (string=? val "")
+      ""
+      (serialize-field field-name val)))
+
+(define (string-or-filelike? val)
+  (or (string? val)
+      (file-like? val)))
+(define (serialize-string-or-filelike field-name val)
+  (if (equal? val "")
+      ""
+      (serialize-field field-name val)))
+
+(define (serialize-boolean field-name val)
+  (serialize-field field-name (if val "true" "false")))
+
+(define (non-negative-integer? val)
+  (and (exact-integer? val) (not (negative? val))))
+(define (serialize-non-negative-integer field-name val)
+  (serialize-field field-name val))
+
+(define serialize-list serialize-field)
+
+(define parameter-alist? list?)
+(define (serialize-parameter-alist field-name val)
+  #~(string-append
+     #$@(map (match-lambda
+               ((key . value)
+                (serialize-field key value)))
+             val)))
+
+(define (serialize-getmail-retriever-configuration field-name val)
+  (serialize-configuration val getmail-retriever-configuration-fields))
+
+(define-configuration getmail-retriever-configuration
+  (type
+   (string "SimpleIMAPSSLRetriever")
+   "The type of mail retriever to use.  Valid values include
+@samp{passwd} and @samp{static}.")
+  (server
+   (string 'unset)
+   "Space separated list of arguments to the userdb driver.")
+  (username
+   (string 'unset)
+   "Space separated list of arguments to the userdb driver.")
+  (port
+   (non-negative-integer #f)
+   "Space separated list of arguments to the userdb driver.")
+  (password
+   (string "")
+   "Override fields from passwd.")
+  (password-command
+   (list '())
+   "Override fields from passwd.")
+  (keyfile
+   (string "")
+   "PEM-formatted key file to use for the TLS negotiation")
+  (certfile
+   (string "")
+   "PEM-formatted certificate file to use for the TLS negotiation")
+  (ca-certs
+   (string "")
+   "CA certificates to use")
+  (extra-parameters
+   (parameter-alist '())
+   "Extra retriever parameters"))
+
+(define (serialize-getmail-destination-configuration field-name val)
+  (serialize-configuration val getmail-destination-configuration-fields))
+
+(define-configuration getmail-destination-configuration
+  (type
+   (string 'unset)
+   "The type of mail destination.  Valid values include @samp{Maildir},
+@samp{Mboxrd} and @samp{MDA_external}.")
+  (path
+   (string-or-filelike "")
+   "The path option for the mail destination.  The behaviour depends on the
+chosen type.")
+  (extra-parameters
+   (parameter-alist '())
+   "Extra destination parameters"))
+
+(define (serialize-getmail-options-configuration field-name val)
+  (serialize-configuration val getmail-options-configuration-fields))
+
+(define-configuration getmail-options-configuration
+  (verbose
+   (non-negative-integer 1)
+   "If set to @samp{0}, getmail will only print warnings and errors.  A value
+of @samp{1} means that messages will be printed about retrieving and deleting
+messages. If set to @samp{2}, getmail will print messages about each of it's
+actions.")
+  (read-all
+   (boolean #t)
+   "If true, getmail will retrieve all available messages.  Otherwise it will
+only retrieve messages it hasn't seen previously.")
+  (delete
+   (boolean #f)
+   "If set to true, messages will be deleted from the server after retrieving
+and successfully delivering them.  Otherwise, messages will be left on the
+server.")
+  (delete-after
+   (non-negative-integer 0)
+   "Getmail will delete messages this number of days after seeing them, if
+they have not been delivered.  This means messages will be left on the server
+this number of days after delivering them.  A value of @samp{0} disabled this
+feature.")
+  (delete-bigger-than
+   (non-negative-integer 0)
+   "Delete messages larger than this of bytes after retrieving them, even if
+the delete and delete-after options are disabled.  A value of @samp{0}
+disables this feature.")
+  (max-bytes-per-session
+   (non-negative-integer 0)
+   "Retrieve messages totalling up to this number of bytes before closing the
+session with the server.  A value of @samp{0} disables this feature.")
+  (max-message-size
+   (non-negative-integer 0)
+   "Don't retrieve messages larger than this number of bytes.  A value of
+@samp{0} disables this feature.")
+  (delivered-to
+   (boolean #t)
+   "If true, getmail will add a Delivered-To header to messages.")
+  (received
+   (boolean #t)
+   "If set, getmail adds a Received header to the messages.")
+  (message-log
+   (string "")
+   "Getmail will record a log of its actions to the named file.  A value of
+@samp{\"\"} disables this feature.")
+  (message-log-syslog
+   (boolean #t)
+   "If true, getmail will record a log of its actions using the system
+logger.")
+  (message-log-verbose
+   (boolean #t)
+   "If true, getmail will log information about messages not retrieved and the
+reason for not retrieving them, as well as starting and ending information
+lines.")
+  (extra-parameters
+   (parameter-alist '())
+   "Extra options to include."))
+
+(define (serialize-getmail-configuration-file field-name val)
+  (match val
+    (($ <getmail-configuration-file> location
+                                     retriever destination options)
+     #~(string-append
+        "[retriever]\n"
+        #$(serialize-getmail-retriever-configuration #f retriever)
+        "\n[destination]\n"
+        #$(serialize-getmail-destination-configuration #f destination)
+        "\n[options]\n"
+        #$(serialize-getmail-options-configuration #f options)))))
+
+(define-configuration getmail-configuration-file
+  (retriever
+   (getmail-retriever-configuration (getmail-retriever-configuration))
+   "What mail account to retrieve mail from, and how to access that account.")
+  (destination
+   (getmail-destination-configuration (getmail-destination-configuration))
+   "What to do with retrieved messages.")
+  (options
+   (getmail-options-configuration (getmail-options-configuration))
+   "Configure getmail."))
+
+(define (serialize-symbol field-name val) "")
+(define (serialize-getmail-configuration field-name val) "")
+
+(define-configuration getmail-configuration
+  (name
+   (symbol "unset")
+   "A symbol to identify the getmail service.")
+  (package
+   (package getmail)
+   "The getmail package to use.")
+  (user
+   (string "getmail")
+   "The user to run getmail as.")
+  (group
+   (string "getmail")
+   "The group to run getmail as.")
+  (directory
+   (string "/var/lib/getmail/default")
+   "The getmail directory to use.")
+  (rcfile
+   (getmail-configuration-file (getmail-configuration-file))
+   "The getmail configuration file to use.")
+  (idle
+   (list '())
+   "A list of mailboxes that getmail should wait on the server for new mail
+notifications.  This depends on the server supporting the IDLE extension.")
+  (environment-variables
+   (list '())
+   "Environment variables to set for getmail."))
+
+(define (generate-getmail-documentation)
+  (generate-documentation
+   `((getmail-configuration
+      ,getmail-configuration-fields
+      (rcfile getmail-configuration-file))
+     (getmail-configuration-file
+      ,getmail-configuration-file-fields
+      (retriever getmail-retriever-configuration)
+      (destination getmail-destination-configuration)
+      (options getmail-options-configuration))
+     (getmail-retriever-configuration ,getmail-retriever-configuration-fields)
+     (getmail-destination-configuration ,getmail-destination-configuration-fields)
+     (getmail-options-configuration ,getmail-options-configuration-fields))
+   'getmail-configuration))
+
+(define-gexp-compiler (getmail-configuration-file-compiler
+                       (rcfile <getmail-configuration-file>) system target)
+  (gexp->derivation
+   "getmailrc"
+   #~(call-with-output-file #$output
+       (lambda (port)
+         (display #$(serialize-getmail-configuration-file #f rcfile)
+                  port)))
+   #:system system
+   #:target target))
+
+(define (getmail-accounts configs)
+  (let ((users (delete-duplicates
+                (map getmail-configuration-user
+                     configs)))
+        (groups (delete-duplicates
+                 (map getmail-configuration-group
+                      configs))))
+    (append
+     (map (lambda (group)
+            (user-group
+             (name group)
+             (system? #t)))
+          groups)
+     (map (lambda (user)
+            (user-account
+             (name user)
+             (group (getmail-configuration-group
+                     (find (lambda (config)
+                             (and
+                              (string=? user (getmail-configuration-user config))
+                              (getmail-configuration-group config)))
+                           configs)))
+             (system? #t)
+             (comment "Getmail user")
+             (home-directory "/var/empty")
+             (shell (file-append shadow "/sbin/nologin"))))
+          users))))
+
+(define (getmail-activation configs)
+  "Return the activation GEXP for CONFIGS."
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+        #$@(map
+            (lambda (config)
+              #~(let* ((pw (getpw #$(getmail-configuration-user config)))
+                       (uid (passwd:uid pw))
+                       (gid (passwd:gid pw))
+                       (getmaildir #$(getmail-configuration-directory config)))
+                  (mkdir-p getmaildir)
+                  (chown getmaildir uid gid)))
+            configs))))
+
+(define (getmail-shepherd-services configs)
+  "Return a list of <shepherd-service> for CONFIGS."
+  (map (match-lambda
+         (($ <getmail-configuration> location name package
+                                     user group directory rcfile idle
+                                     environment-variables)
+          (shepherd-service
+           (documentation "Run getmail.")
+           (provision (list (symbol-append 'getmail- name)))
+           (requirement '(networking))
+           (start #~(make-forkexec-constructor
+                     `(#$(file-append package "/bin/getmail")
+                       ,(string-append "--getmaildir=" #$directory)
+                       #$@(map (lambda (idle)
+                                 (string-append "--idle=" idle))
+                               idle)
+                       ,(string-append "--rcfile=" #$rcfile))
+                     #:user #$user
+                     #:group #$group
+                     #:environment-variables
+                     (list #$@environment-variables)
+                     #:log-file
+                     #$(string-append "/var/log/getmail-"
+                                      (symbol->string name)))))))
+       configs))
+
+(define getmail-service-type
+  (service-type
+   (name 'getmail)
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             getmail-shepherd-services)
+          (service-extension activation-service-type
+                             getmail-activation)
+          (service-extension account-service-type
+                             getmail-accounts)))
+   (description
+    "Run @command{getmail}, a mail retriever program.")
+   (default-value '())
+   (compose concatenate)
+   (extend append)))
diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index 33aa4d3437..10e5be71d8 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +26,7 @@
   #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
+  #:use-module (gnu services getmail)
   #:use-module (gnu services mail)
   #:use-module (gnu services networking)
   #:use-module (guix gexp)
@@ -32,7 +34,8 @@
   #:use-module (ice-9 ftw)
   #:export (%test-opensmtpd
             %test-exim
-            %test-dovecot))
+            %test-dovecot
+            %test-getmail))
 
 (define %opensmtpd-os
   (simple-operating-system
@@ -394,3 +397,176 @@ Subject: Hello Nice to meet you!")
    (name "dovecot")
    (description "Connect to a running Dovecot server.")
    (value (run-dovecot-test))))
+
+(define %getmail-os
+  (simple-operating-system
+   (service dhcp-client-service-type)
+   (service dovecot-service-type
+            (dovecot-configuration
+             (disable-plaintext-auth? #f)
+             (ssl? "no")
+             (auth-mechanisms '("anonymous" "plain"))
+             (auth-anonymous-username "alice")
+             (mail-location
+              (string-append "maildir:~/Maildir"
+                             ":INBOX=~/Maildir/INBOX"
+                             ":LAYOUT=fs"))))
+   (service getmail-service-type
+            (list
+             (getmail-configuration
+              (name 'test)
+              (user "alice")
+              (directory "/var/lib/getmail/alice")
+              (idle '("TESTBOX"))
+              (rcfile
+               (getmail-configuration-file
+                (retriever
+                 (getmail-retriever-configuration
+                  (type "SimpleIMAPRetriever")
+                  (server "localhost")
+                  (username "alice")
+                  (port 143)
+                  (extra-parameters
+                   '((password . "testpass")
+                     (mailboxes . ("TESTBOX"))))))
+                (destination
+                 (getmail-destination-configuration
+                  (type "Maildir")
+                  (path "/home/alice/TestMaildir/")))
+                (options
+                 (getmail-options-configuration
+                  (read-all #f))))))))))
+
+(define (run-getmail-test)
+  "Return a test of an OS running Getmail service."
+  (define vm
+    (virtual-machine
+     (operating-system (marionette-operating-system
+                        %getmail-os
+                        #:imported-modules '((gnu services herd))))
+     (port-forwardings '((8143 . 143)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (ice-9 iconv)
+                       (ice-9 rdelim)
+                       (rnrs base)
+                       (rnrs bytevectors)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette '(#$vm)))
+
+          (define* (message-length message #:key (encoding "iso-8859-1"))
+            (bytevector-length (string->bytevector message encoding)))
+
+          (define message "From: test@example.com\n\
+Subject: Hello Nice to meet you!")
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "getmail")
+
+          ;; Wait for dovecot to be up and running.
+          (test-assert "dovecot running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'dovecot))
+             marionette))
+
+          (test-assert "set password for alice"
+            (marionette-eval
+             '(system "echo -e \"testpass\ntestpass\" | passwd alice")
+             marionette))
+
+          ;; Wait for getmail to be up and running.
+          (test-assert "getmail-test running"
+            (marionette-eval
+             '(let* ((pw (getpw "alice"))
+                     (uid (passwd:uid pw))
+                     (gid (passwd:gid pw)))
+                (use-modules (gnu services herd))
+
+                (for-each
+                 (lambda (dir)
+                   (mkdir dir)
+                   (chown dir uid gid))
+                 '("/home/alice/TestMaildir"
+                   "/home/alice/TestMaildir/cur"
+                   "/home/alice/TestMaildir/new"
+                   "/home/alice/TestMaildir/tmp"
+                   "/home/alice/TestMaildir/TESTBOX"
+                   "/home/alice/TestMaildir/TESTBOX/cur"
+                   "/home/alice/TestMaildir/TESTBOX/new"
+                   "/home/alice/TestMaildir/TESTBOX/tmp"))
+
+                (start-service 'getmail-test))
+             marionette))
+
+          ;; Check Dovecot service's PID.
+          (test-assert "service process id"
+            (let ((pid
+                   (number->string (wait-for-file "/var/run/dovecot/master.pid"
+                                                  marionette))))
+              (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
+                               marionette)))
+
+          (test-assert "accept an email"
+            (let ((imap (socket AF_INET SOCK_STREAM 0))
+                  (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143)))
+              (connect imap addr)
+              ;; Be greeted.
+              (read-line imap) ;OK
+              ;; Authenticate
+              (write-line "a AUTHENTICATE ANONYMOUS" imap)
+              (read-line imap) ;+
+              (write-line "c2lyaGM=" imap)
+              (read-line imap) ;OK
+              ;; Create a TESTBOX mailbox
+              (write-line "a CREATE TESTBOX" imap)
+              (read-line imap) ;OK
+              ;; Append a message to a TESTBOX mailbox
+              (write-line (format #f "a APPEND TESTBOX {~a}"
+                                  (number->string (message-length message)))
+                          imap)
+              (read-line imap) ;+
+              (write-line message imap)
+              (read-line imap) ;OK
+              ;; Logout
+              (write-line "a LOGOUT" imap)
+              (close imap)
+              #t))
+
+          (sleep 1)
+
+          (test-assert "mail arrived"
+            (string-contains
+             (marionette-eval
+              '(begin
+                 (use-modules (ice-9 ftw)
+                              (ice-9 match))
+                 (let ((TESTBOX/new "/home/alice/TestMaildir/new/"))
+                   (match (scandir TESTBOX/new)
+                     (("." ".." message-file)
+                      (call-with-input-file
+                          (string-append TESTBOX/new message-file)
+                        get-string-all)))))
+              marionette)
+             message))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "getmail-test" test))
+
+(define %test-getmail
+  (system-test
+   (name "getmail")
+   (description "Connect to a running Getmail server.")
+   (value (run-getmail-test))))
+
+%getmail-os
-- 
2.21.0

[bug#33185] [PATCH 2/3] gnu: Add patchwork.

[Christopher Baines]

* gnu/packages/patchutils.scm (patchwork): New variable.
---
 gnu/packages/patchutils.scm | 167 ++++++++++++++++++++++++++++++++++++
 1 file changed, 167 insertions(+)

diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm
index f6197b98ee..687864c008 100644
--- a/gnu/packages/patchutils.scm
+++ b/gnu/packages/patchutils.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014, 2018 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2015, 2018 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,6 +32,8 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages check)
+  #:use-module (gnu packages databases)
+  #:use-module (gnu packages django)
   #:use-module (gnu packages file)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
@@ -300,3 +303,167 @@ directories, and has support for many popular version control systems.
 Meld helps you review code changes and understand patches.  It might even help
 you to figure out what is going on in that merge you keep avoiding.")
     (license gpl2)))
+
+(define-public patchwork
+  (package
+    (name "patchwork")
+    (version "2.1.2")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/getpatchwork/patchwork.git")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "06ng5pv6744w98zkyfm0ldkmpdgnsql3gbbbh6awq61sr2ndr3qw"))))
+    (build-system python-build-system)
+    (arguments
+     `(;; TODO: Tests require a running database
+       #:tests? #f
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (delete 'build)
+         (add-after 'unpack 'replace-wsgi.py
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (delete-file "patchwork/wsgi.py")
+             (call-with-output-file "patchwork/wsgi.py"
+               (lambda (port)
+                 ;; Embed the PYTHONPATH containing the dependencies, as well
+                 ;; as the python modules in this package in the wsgi.py file,
+                 ;; as this will ensure they are available at runtime.
+                 (define pythonpath
+                   (string-append (getenv "PYTHONPATH")
+                                  ":"
+                                  (site-packages inputs outputs)))
+                 (display
+                  (string-append "
+import os, sys
+
+sys.path.extend('" pythonpath "'.split(':'))
+
+from django.core.wsgi import get_wsgi_application
+
+# By default, assume that patchwork is running as a Guix service, which
+# provides the settings as the 'guix.patchwork.settings' Python module.
+#
+# When using httpd, it's hard to set environment variables, so rely on the
+# default set here.
+os.environ['DJANGO_SETTINGS_MODULE'] = os.getenv(
+  'DJANGO_SETTINGS_MODULE',
+  'guix.patchwork.settings' # default
+)
+
+application = get_wsgi_application()\n") port)))))
+         (replace 'check
+           (lambda* (#:key tests? #:allow-other-keys)
+             (when tests?
+               (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.dev")
+               (invoke "python" "-Wonce" "./manage.py" "test" "--noinput"))
+             #t))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out"))
+                   (out-site-packages (site-packages inputs outputs)))
+               (for-each (lambda (directory)
+                           (copy-recursively
+                            directory
+                            (string-append out-site-packages directory)))
+                         '(;; Contains the python code
+                           "patchwork"
+                           ;; Contains the templates for the generated HTML
+                           "templates"))
+               (delete-file-recursively
+                (string-append out-site-packages "patchwork/tests"))
+
+               ;; Install patchwork related tools
+               (for-each (lambda (file)
+                           (install-file file (string-append out "/bin")))
+                         (list
+                          (string-append out-site-packages
+                                         "patchwork/bin/pwclient")
+                          (string-append out-site-packages
+                                         "patchwork/bin/parsemail.sh")
+                          (string-append out-site-packages
+                                         "patchwork/bin/parsemail-batch.sh")))
+
+               ;; Delete the symlink to pwclient, and replace it with the
+               ;; actual file, as this can cause issues when serving the file
+               ;; from a webserver.
+               (let ((template-pwclient (string-append
+                                         out-site-packages
+                                         "patchwork/templates/patchwork/pwclient")))
+                 (delete-file template-pwclient)
+                 (copy-file (string-append out-site-packages
+                                           "patchwork/bin/pwclient")
+                            template-pwclient))
+
+               ;; Collect the static assets, this includes JavaScript, CSS and
+               ;; fonts. This is a standard Django process when running a
+               ;; Django application for regular use, and includes assets for
+               ;; dependencies like the admin site from Django.
+               ;;
+               ;; The intent here is that you can serve files from this
+               ;; directory through a webserver, which is recommended when
+               ;; running Django applications.
+               (let ((static-root
+                      (string-append out "/share/patchwork/htdocs")))
+                 (mkdir-p static-root)
+                 (copy-file "patchwork/settings/production.example.py"
+                            "patchwork/settings/assets.py")
+                 (setenv "DJANGO_SECRET_KEY" "dummyvalue")
+                 (setenv "DJANGO_SETTINGS_MODULE" "patchwork.settings.assets")
+                 (setenv "STATIC_ROOT" static-root)
+                 (invoke "./manage.py" "collectstatic" "--no-input"))
+
+               ;; The lib directory includes example configuration files that
+               ;; may be useful when deploying patchwork.
+               (copy-recursively "lib"
+                                 (string-append
+                                  out "/share/doc/" ,name "-" ,version)))
+             #t))
+         ;; The hasher script is used from the post-receive.hook
+         (add-after 'install 'install-hasher
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (out-site-packages (site-packages inputs outputs))
+                    (out-hasher.py (string-append out-site-packages
+                                                  "/patchwork/hasher.py")))
+               (chmod out-hasher.py #o555)
+               (symlink out-hasher.py (string-append out "/bin/hasher")))
+             #t))
+         ;; Create a patchwork specific version of Django's command line admin
+         ;; utility.
+         (add-after 'install 'install-patchwork-admin
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out")))
+               (mkdir-p (string-append out "/bin"))
+               (call-with-output-file (string-append out "/bin/patchwork-admin")
+                 (lambda (port)
+                   (simple-format port "#!~A
+import os, sys
+
+if __name__ == \"__main__\":
+    from django.core.management import execute_from_command_line
+
+    execute_from_command_line(sys.argv)" (which "python"))))
+               (chmod (string-append out "/bin/patchwork-admin") #o555))
+             #t)))))
+    (inputs
+     `(("python-wrapper" ,python-wrapper)))
+    (propagated-inputs
+     `(("python-django" ,python-django)
+       ;; TODO: Make this configurable
+       ("python-psycopg2" ,python-psycopg2)
+       ("python-mysqlclient" ,python-mysqlclient)
+       ("python-django-filter" ,python-django-filter)
+       ("python-djangorestframework" ,python-djangorestframework)
+       ("python-django-debug-toolbar" ,python-django-debug-toolbar)))
+    (synopsis "Web based patch tracking system")
+    (description
+     "Patchwork is a patch tracking system.  It takes in emails containing
+patches, and displays the patches along with comments and state information.
+Users can login allowing them to change the state of patches.")
+    (home-page "http://jk.ozlabs.org/projects/patchwork/")
+    (license gpl2+)))
-- 
2.21.0

[bug#33185] [PATCH 3/3] services: Add patchwork.

[Christopher Baines]

* gnu/service/web.scm (<patchwork-database-configuration>
<patchwork-settings-module>, <patchwork-configuration>): 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{<patchwork-configuration>} relates to the configuration for Patchwork
+within the HTTPD service.
+
+The @code{settings-module} field within the @code{<patchwork-configuration>}
+record can be populated with the @code{<patchwork-settings-module>} record,
+which describes a settings module that is generated within the Guix store.
+
+For the @code{database-configuration} field within the
+@code{<patchwork-settings-module>}, the
+@code{<patchwork-database-configuration>} 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{<patchwork-settings-module>} 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{<patchwork-database-configuration>} 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{<patchwork-configuration>} 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{<patchwork-configuration>} 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 <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 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2017, 2018, 2019 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
 ;;;
 ;;; 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?
+            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))
 
 ;;; Commentary:
 ;;;
@@ -1268,3 +1312,323 @@ files.")
                              varnish-shepherd-service)))
    (default-value
      (varnish-configuration))))
+
+\f
+;;;
+;;; 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))
+"]
+
+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
+      (($ <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.")))
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 <ludo@gnu.org>
-;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
 ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
@@ -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))))
+
+\f
+;;;
+;;; Patchwork
+;;;
+
+(define patchwork-initial-database-setup-service
+  (match-lambda
+    (($ <patchwork-database-configuration>
+        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))))
-- 
2.21.0

bug#33185: [PATCH 0/7] Add patchwork package and service.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 2155 bytes --]


Christopher Baines <mail@cbaines.net> writes:

> Christopher Baines <mail@cbaines.net> writes:
>
>> These patches add a package for patchwork, a web-based patch tracking
>> system, along with some missing dependencies and the beginnings of a
>> system service and test.
>>
>> Everything up to the patchwork package should be ready to merge, but the
>> patchwork package, service and system test is currently very rough and
>> unready.
>>
>>
>> Christopher Baines (7):
>>   gnu: Add python-jsmin.
>>   gnu: Add python-slimit.
>>   gnu: Add python-django-pipeline.
>>   gnu: Add python-django-jinja.
>>   gnu: Add python-django-debug-toolbar.
>>   gnu: Add patchwork.
>>   services: Add patchwork.
>>
>>  gnu/packages/django.scm     | 130 ++++++++++++++++
>>  gnu/packages/patchutils.scm |  95 ++++++++++++
>>  gnu/packages/python-web.scm |  50 +++++++
>>  gnu/services/web.scm        | 291 +++++++++++++++++++++++++++++++++++-
>>  gnu/tests/web.scm           | 104 ++++++++++++-
>>  5 files changed, 668 insertions(+), 2 deletions(-)
>
> Following on from this, I believe the first 5 patches adding the
> prerequisite packages for patchwork have now been added.
>
> The initial package and service for Patchwork wasn't ready to add to
> Guix, but I now believe it is at least ready to review.
>
> In addition to Patchwork, this patch series also includes a service for
> Getmail. I believe this is the simplest way of getting patches in to
> Patchwork.
>
>
> Christopher Baines (3):
>   services: Add getmail.
>   gnu: Add patchwork.
>   services: Add patchwork.
>
>  doc/guix.texi               | 464 ++++++++++++++++++++++++++++++++++++
>  gnu/local.mk                |   1 +
>  gnu/packages/patchutils.scm | 166 +++++++++++++
>  gnu/services/getmail.scm    | 380 +++++++++++++++++++++++++++++
>  gnu/services/web.scm        | 366 +++++++++++++++++++++++++++-
>  gnu/tests/mail.scm          | 177 +++++++++++++-
>  gnu/tests/web.scm           | 162 ++++++++++++-
>  7 files changed, 1713 insertions(+), 3 deletions(-)
>  create mode 100644 gnu/services/getmail.scm

I've gone ahead and merged these now [1].

1: 2177d9222f8c228fe5cd4e9c98d96f97e9601b86

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]