major refactoring of virtualhost definitions

1 files changed, 116 insertions, 104 deletions

diff --git a/container.scm b/container.scm
index 39163d9..32b403e 100644
--- a/container.scm
+++ b/container.scm
@@ -9,6 +9,7 @@
              (hydrilla-website)
              (hydrilla-json-schemas)
              (hydrilla)
+             (ice-9 match)
              ;; The following 4 are needed to construct GUIX_PYTHONPATH for
              ;; Hydrilla WSGI scripts.
              (guix build-system python)
@@ -23,96 +24,116 @@
 (define %here
   (getcwd))
 
-(define* (simple-wsgi-alias-gexp package wsgi-path #:key (aliased-path "/"))
-  #~(let* ((wsgi-file (string-append #$package #$wsgi-path)))
-      (format #f
-              "\
-              <Files ~s>
-                  Require all granted
-              </Files>
-              WSGIScriptAlias ~a ~a
-              "
-              wsgi-file #$aliased-path wsgi-file)))
+(define* (g-string-join elements #:optional (joiner " "))
+  #~(string-join (list #$@elements) #$joiner))
+
+(define* (g-string-append #:rest args)
+  #~(string-append #$@args))
+
+(define (g-package-file package file)
+  (g-string-append package "/" file))
+
+(define (httpd-conf-token arg)
+  (match arg
+    ((? string?)
+     (if (or-map (lambda (substr) (string-contains arg substr)) '(" " "\""))
+         (format #f "~s" arg)
+         arg))
+    ((? symbol?)
+     (httpd-conf-token (symbol->string arg)))
+    ((? gexp?)
+     #~(let ((gexp-value #$arg))
+         (if (string-contains gexp-value " ")
+             (format #f "~s" gexp-value)
+             gexp-value)))))
+
+(define* (httpd-directive name #:rest args)
+  #~(format #f "~a~%"
+            #$(g-string-join (map httpd-conf-token (cons name args)))))
+
+(define* (httpd-tag name args #:rest body)
+  (let ((tag-name (httpd-conf-token name)))
+    #~(format #f "<~a ~a>~%~a</~a>~%"
+              #$tag-name
+              #$(g-string-join (map httpd-conf-token args))
+              #$(apply g-string-append body)
+              #$tag-name)))
+
+(define* (httpd-simple-wsgi-alias package wsgi-path #:key (aliased-path "/"))
+  (let ((wsgi-file (g-package-file package wsgi-path)))
+    (g-string-append
+     (httpd-tag 'Files (list wsgi-file)
+                (httpd-directive 'Require 'all 'granted))
+     (httpd-directive 'WSGIScriptAlias aliased-path wsgi-file))))
+
+(define (koszko-httpd-server-meta server-name)
+  (list (httpd-directive 'ServerName server-name)
+        (httpd-directive 'ServerAlias (string-append "www." server-name))
+        (httpd-directive 'ServerAdmin "koszko@koszko.org")))
+
+(define (koszko-httpd-redirect-if-other-host host-name)
+  (httpd-tag 'If (list (format #f "%{HTTP_HOST} != '~a'" host-name))
+             (httpd-directive
+              'Redirect 'permanent "/" (format #f "http://~a/" host-name))))
+
+(define (koszko-httpd-virtualhost-redirect from to)
+  (httpd-virtualhost
+   "*:80"
+   `(,@(koszko-httpd-server-meta from)
+     ,(httpd-directive 'Redirect 'permanent "/" (format #f "http://~a" to)))))
 
 (define %koszko-org-virtualhost
   (httpd-virtualhost
    "*:80"
-   (list "\
-         ServerName koszko.org
-         ServerAlias www.koszko.org
-         DocumentRoot /srv/http/koszko.org
-         ServerAdmin koszko@koszko.org
+   `(,@(koszko-httpd-server-meta "koszko.org")
+     ,(httpd-directive 'DocumentRoot "/srv/http/koszko.org")
 
-         <If \"%{HTTP_HOST} != 'koszko.org'\">
-             Redirect permanent / http://koszko.org/
-         </If>
+     ,(koszko-httpd-redirect-if-other-host "koszko.org")
 
-         Alias /sideload /srv/http/koszko.org
+     ,(httpd-directive 'Alias "/sideload" "/srv/http/koszko.org")
 
-         WSGIScriptReloading On
-         "
-         (simple-wsgi-alias-gexp koszko-org-website
-                                 "/share/koszko-org-website/wsgi.py"))))
+     ,(httpd-simple-wsgi-alias
+       koszko-org-website "/share/koszko-org-website/wsgi.py"))))
 
 (define %koszkonutek-tmp-virtualhost
-  (httpd-virtualhost
-   "*:80"
-   '("\
-     ServerName koszkonutek-tmp.pl.eu.org
-     ServerAlias www.koszkonutek-tmp.pl.eu.org
-
-     Redirect permanent / http://koszko.org/
-     ")))
+  (koszko-httpd-virtualhost-redirect "koszkonutek-tmp.pl.eu.org" "koszko.org"))
 
 (define %hydrillabugs-virtualhost
   (httpd-virtualhost
    "*:80"
-   '("\
-    ServerName hydrillabugs.koszko.org
-    ServerAlias www.hydrillabugs.koszko.org
-    ServerAdmin koszko@koszko.org
-
-    <Proxy *>
-        Redirect permanent /projects/hachette /projects/haketilo
-
-        # I don't remember why I added the following line so I'm keeping it just
-        # in case.
-        RequestHeader unset Accept-Encoding
-    </Proxy>
-
-    ProxyPass /projects/haketilo http://10.207.87.1:21011/projects/hachette
-    ProxyPassReverse /projects/haketilo http://10.207.87.1:21011/projects/hachette
-
-    ProxyPass / http://10.207.87.1:21011/
-    ProxyPassReverse / http://10.207.87.1:21011/
-    ")))
+   `(,@(koszko-httpd-server-meta "hydrillabugs.koszko.org")
+
+     ,(httpd-tag 'Proxy '("*")
+                 (httpd-directive
+                  'Redirect 'permanent
+                  "/projects/hachette" "/projects/haketilo")
+                 ;; I don't remember why I added the following line so I'm
+                 ;; keeping it just in case.
+                 (httpd-directive 'RequestHeader 'unset 'Accept-Encoding))
+
+     ,(httpd-directive
+       'ProxyPass "/projects/haketilo"
+       "http://10.207.87.1:21011/projects/hachette")
+     ,(httpd-directive
+       'ProxyPassReverse "/projects/haketilo"
+       "http://10.207.87.1:21011/projects/hachette")
+
+     ,(httpd-directive 'ProxyPass "/" "http://10.207.87.1:21011/")
+     ,(httpd-directive 'ProxyPassReverse "/" "http://10.207.87.1:21011/"))))
 
 (define %hachettebugs-virtualhost
-  (httpd-virtualhost
-   "*:80"
-   '("\
-     ServerName hachettebugs.koszko.org
-     ServerAlias www.hachettebugs.koszko.org
-
-     Redirect permanent / http://hydrillabugs.org/
-     ")))
+  (koszko-httpd-virtualhost-redirect
+   "hachettebugs.koszko.org" "hydrillabugs.koszko.org"))
 
 (define %haketilo-virtualhost
   (httpd-virtualhost
    "*:80"
-   (list "\
-         ServerName haketilo.koszko.org
-         ServerAlias www.haketilo.koszko.org
-         ServerAdmin koszko@koszko.org
+   `(,@(koszko-httpd-server-meta "haketilo.koszko.org")
 
-         <If \"%{HTTP_HOST} != 'haketilo.koszko.org'\">
-             Redirect permanent / http://haketilo.koszko.org/
-         </If>
+     ,(koszko-httpd-redirect-if-other-host "haketilo.koszko.org")
 
-         WSGIScriptReloading On
-         "
-         (simple-wsgi-alias-gexp hydrilla-website
-                                 "/share/hydrilla-website/wsgi.py"))))
+     ,(httpd-simple-wsgi-alias
+       hydrilla-website "/share/hydrilla-website/wsgi.py"))))
 
 (define %python-path-spec-sexp
    (search-path-specification->sexp
@@ -131,44 +152,35 @@
                       '#$%hydrilla-pythonpath-inputs)))
           (cdar evaluated-list)))))
 
-(define %hydrilla-wsgi-regex
-  "^/api_v[^/]+/((resource|mapping)/[^/]+[.]json|query|list_all)$")
-
 (define %hydrilla-virtualhost
   (httpd-virtualhost
    "*:80"
-   (list "\
-         ServerName hydrilla.koszko.org
-         ServerAlias www.hydrilla.koszko.org
-         ServerAdmin koszko@koszko.org
-
-         <If \"%{HTTP_HOST} != 'hydrilla.koszko.org'\">
-             Redirect permanent / http://hydrilla.koszko.org/
-         </If>
-         "
-         #~(format #f "Alias /schemas ~a\n"
-                   (string-append #$hydrilla-json-schemas
-                                  "/share/hydrilla-json-schemas"))
-         "\
-
-         DocumentRoot /var/lib/hydrilla/malcontent_dirs
-         <Location ~ \"^/api_v[^/]+/(resource|mapping)/\">
-             ForceType application/json
-         </Location>
-
-         WSGIScriptReloading On
-         "
-         (format #f "SetEnvIf Request_URI ~s MALCONENT_DIR=~a\n"
-                 "^/(api_v[0-9]+)/"
-                 "/var/lib/hydrilla/malcontent_dirs/$1")
-         #~(format #f "SetEnvIf Request_URI ~s HYDRILLA_GUIX_PYTHONPATH=~a\n"
-                   "^/api_v[0-9]+/"
-                   #$%hydrilla-pythonpath-gexp)
-         #~(format #f "WSGIScriptAliasMatch ~s ~a\n"
-                   #$%hydrilla-wsgi-regex
-                   (string-append
-                    #$(local-file (string-append %here "/hydrilla-wsgi.py"))
-                    "/$1")))))
+   `(,@(koszko-httpd-server-meta "hydrilla.koszko.org")
+
+     ,(koszko-httpd-redirect-if-other-host "hydrilla.koszko.org")
+
+     ,(httpd-directive
+       'Alias "/schemas"
+       (g-package-file hydrilla-json-schemas "/share/hydrilla-json-schemas"))
+
+     ,(httpd-directive 'DocumentRoot "/var/lib/hydrilla/malcontent_dirs")
+
+     ,(httpd-tag 'Location '("~" "^/api_v[^/]+/(resource|mapping)/")
+                 (httpd-directive 'ForceType 'application/json))
+
+     ,(httpd-directive
+       'SetEnvIf 'Request_URI "^/(api_v[0-9]+)/"
+       "MALCONENT_DIR=/var/lib/hydrilla/malcontent_dirs/$1")
+
+     ,(httpd-directive
+       'SetEnvIf 'Request_URI "^/api_v[0-9]+/"
+       (g-string-append "HYDRILLA_GUIX_PYTHONPATH=" %hydrilla-pythonpath-gexp))
+
+     ,(httpd-directive
+       'WSGIScriptAliasMatch
+       "^/api_v[^/]+/((resource|mapping)/[^/]+[.]json|query|list_all)$"
+       (g-string-append (local-file (string-append %here "/hydrilla-wsgi.py"))
+                        "/$1")))))
 
 (define %wsgi-module
   (httpd-module