[bug#26684] let nginx configs reference the store

[Christopher Baines <mail@cbaines.net>]

[-- Attachment #1.1: Type: text/plain, Size: 678 bytes --]

On Mon, 24 Jul 2017 15:01:42 +0200
ludo@gnu.org (Ludovic Courtès) wrote:

> Hello!
> 
> Christopher, Clément: I wanted to apply this patch from Andy but it
> conflicts with recent changes, presumably commit cb341293fa by Chris.
> Could you take a look and apply it, if possible?
> 
>   https://bugs.gnu.org/26684

Hey,

So I've had a look at this, it looks like its just the changes that are
causing the conflict relate to checking that the files related to SSL
exist.

I've adjusted the patch so that it applies, and included my translation
of the changes. I haven't done much testing yet, but the patch, and the
diff with the previous patch is attached.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-gnu-services-Nginx-configs-can-reference-store.patch --]
[-- Type: text/x-patch, Size: 8971 bytes --]

From 247843cb62c36cf0a65064eb0dcf5559dc78a460 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@igalia.com>
Date: Thu, 27 Apr 2017 19:49:02 +0200
Subject: [PATCH] gnu: services: Nginx configs can reference store

* gnu/services/web.scm (config-domain-strings, config-index-strings): Emit
lists instead of strings.
(emit-nginx-location-config, emit-nginx-server-config)
(emit-nginx-upstream-config): Rename from nginx-location-config,
default-nginx-server-config, and nginx-upstream-config.  Emit lists instead of
strings.
(flatten): New helper.
(default-nginx-config): Use flatten helper to write nginx conf.  This allows
location configs to reference store values.
---
 gnu/services/web.scm | 158 +++++++++++++++++++++++++--------------------------
 1 file changed, 78 insertions(+), 80 deletions(-)

diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index c605d7686..6e7ffa787 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -114,105 +114,103 @@
 (define (config-domain-strings names)
  "Return a string denoting the nginx config representation of NAMES, a list
 of domain names."
- (string-join
-  (map (match-lambda
+ (map (match-lambda
         ('default "_ ")
-        ((? string? str) (string-append str " ")))
-       names)))
+        ((? string? str) (list str " ")))
+      names))
 
 (define (config-index-strings names)
  "Return a string denoting the nginx config representation of NAMES, a list
 of index files."
- (string-join
-  (map (match-lambda
-        ((? string? str) (string-append str " ")))
-       names)))
+ (map (match-lambda
+        ((? string? str) (list str " ")))
+      names))
 
-(define nginx-location-config
+(define emit-nginx-location-config
   (match-lambda
     (($ <nginx-location-configuration> uri body)
-     (string-append
+     (list
       "      location " uri " {\n"
-      "        " (string-join body "\n    ") "\n"
+      (map (lambda (x) (list "        " x "\n")) body)
       "      }\n"))
     (($ <nginx-named-location-configuration> name body)
-     (string-append
+     (list
       "      location @" name " {\n"
-      "        " (string-join body "\n    ") "\n"
+      (map (lambda (x) (list "        " x "\n")) body)
       "      }\n"))))
 
-(define (default-nginx-server-config server)
-  (string-append
-   "    server {\n"
-   (if (nginx-server-configuration-http-port server)
-       (string-append "      listen "
-                      (number->string (nginx-server-configuration-http-port server))
-                      ";\n")
-       "")
-   (if (nginx-server-configuration-https-port server)
-       (string-append "      listen "
-                      (number->string (nginx-server-configuration-https-port server))
-                      " ssl;\n")
-       "")
-   "      server_name " (config-domain-strings
-                         (nginx-server-configuration-server-name server))
-                        ";\n"
-   (if (nginx-server-configuration-ssl-certificate server)
-       (let ((certificate (nginx-server-configuration-ssl-certificate server)))
-         ;; lstat fails when the certificate file does not exist: it aborts
-         ;; and lets the user fix their configuration.
-         (lstat certificate)
-         (string-append "      ssl_certificate " certificate ";\n"))
-       "")
-   (if (nginx-server-configuration-ssl-certificate-key server)
-       (let ((key (nginx-server-configuration-ssl-certificate-key server)))
-         (lstat key)
-         (string-append "      ssl_certificate_key " key ";\n"))
-       "")
-   "      root " (nginx-server-configuration-root server) ";\n"
-   "      index " (config-index-strings (nginx-server-configuration-index server)) ";\n"
-   "      server_tokens " (if (nginx-server-configuration-server-tokens? server)
-                              "on" "off") ";\n"
-   "\n"
-   (string-join
-    (map nginx-location-config (nginx-server-configuration-locations server))
-    "\n")
-   "    }\n"))
+(define (emit-nginx-server-config server)
+  (let ((http-port (nginx-server-configuration-http-port server))
+        (https-port (nginx-server-configuration-https-port server))
+        (server-name (nginx-server-configuration-server-name server))
+        (ssl-certificate (nginx-server-configuration-ssl-certificate server))
+        (ssl-certificate-key
+         (nginx-server-configuration-ssl-certificate-key server))
+        (root (nginx-server-configuration-root server))
+        (index (nginx-server-configuration-index server))
+        (server-tokens? (nginx-server-configuration-server-tokens? server))
+        (locations (nginx-server-configuration-locations server)))
+    (define-syntax-parameter <> (syntax-rules ()))
+    (define-syntax-rule (and/l x tail ...)
+      (let ((x* x))
+        (if x*
+            (syntax-parameterize ((<> (identifier-syntax x*)))
+              (list tail ...))
+            '())))
+    (for-each (lambda (file)
+                (if (and file (not (file-exists? file)))
+                    (error "~A does not exist" file)))
+              (list ssl-certificate ssl-certificate-key))
+    (list
+     "    server {\n"
+     (and/l http-port  "      listen " (number->string <>) ";\n")
+     (and/l https-port "      listen " (number->string <>) " ssl;\n")
+     "      server_name " (config-domain-strings server-name) ";\n"
+     (and/l ssl-certificate     "      ssl_certificate " <> ";\n")
+     (and/l ssl-certificate-key "      ssl_certificate_key " <> ";\n")
+     "      root " root ";\n"
+     "      index " (config-index-strings index) ";\n"
+     "      server_tokens " (if server-tokens? "on" "off") ";\n"
+     "\n"
+     (map emit-nginx-location-config locations)
+     "\n"
+     "    }\n")))
 
-(define (nginx-upstream-config upstream)
-  (string-append
+(define (emit-nginx-upstream-config upstream)
+  (list
    "    upstream " (nginx-upstream-configuration-name upstream) " {\n"
-   (string-concatenate
-    (map (lambda (server)
-           (simple-format #f "      server ~A;\n" server))
-         (nginx-upstream-configuration-servers upstream)))
+   (map (lambda (server)
+          (simple-format #f "      server ~A;\n" server))
+        (nginx-upstream-configuration-servers upstream))
    "    }\n"))
 
+(define (flatten . lst)
+  "Return a list that recursively concatenates all sub-lists of LST."
+  (define (flatten1 head out)
+    (if (list? head)
+        (fold-right flatten1 out head)
+        (cons head out)))
+  (fold-right flatten1 '() lst))
+
 (define (default-nginx-config nginx log-directory run-directory server-list upstream-list)
-  (mixed-text-file "nginx.conf"
-               "user nginx nginx;\n"
-               "pid " run-directory "/pid;\n"
-               "error_log " log-directory "/error.log info;\n"
-               "http {\n"
-               "    client_body_temp_path " run-directory "/client_body_temp;\n"
-               "    proxy_temp_path " run-directory "/proxy_temp;\n"
-               "    fastcgi_temp_path " run-directory "/fastcgi_temp;\n"
-               "    uwsgi_temp_path " run-directory "/uwsgi_temp;\n"
-               "    scgi_temp_path " run-directory "/scgi_temp;\n"
-               "    access_log " log-directory "/access.log;\n"
-               "    include " nginx "/share/nginx/conf/mime.types;\n"
-               "\n"
-               (string-join
-                (filter (lambda (section) (not (null? section)))
-                        (map nginx-upstream-config upstream-list))
-                "\n")
-               "\n"
-               (let ((http (map default-nginx-server-config server-list)))
-                 (do ((http http (cdr http))
-                      (block "" (string-append (car http) "\n" block )))
-                     ((null? http) block)))
-               "}\n"
-               "events {}\n"))
+  (apply mixed-text-file "nginx.conf"
+         (flatten
+          "user nginx nginx;\n"
+          "pid " run-directory "/pid;\n"
+          "error_log " log-directory "/error.log info;\n"
+          "http {\n"
+          "    client_body_temp_path " run-directory "/client_body_temp;\n"
+          "    proxy_temp_path " run-directory "/proxy_temp;\n"
+          "    fastcgi_temp_path " run-directory "/fastcgi_temp;\n"
+          "    uwsgi_temp_path " run-directory "/uwsgi_temp;\n"
+          "    scgi_temp_path " run-directory "/scgi_temp;\n"
+          "    access_log " log-directory "/access.log;\n"
+          "    include " nginx "/share/nginx/conf/mime.types;\n"
+          "\n"
+          (map emit-nginx-upstream-config upstream-list)
+          (map emit-nginx-server-config server-list)
+          "}\n"
+          "events {}\n")))
 
 (define %nginx-accounts
   (list (user-group (name "nginx") (system? #t))
-- 
2.13.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0001-gnu-services-Nginx-configs-can-reference-store.patch.diff --]
[-- Type: text/x-patch, Size: 1834 bytes --]

1c1
< From 247843cb62c36cf0a65064eb0dcf5559dc78a460 Mon Sep 17 00:00:00 2001
---
> From b56b797e2ca26619485d874110d3f1f0ae96fba4 Mon Sep 17 00:00:00 2001
4c4
< Subject: [PATCH] gnu: services: Nginx configs can reference store
---
> Subject: [PATCH 1/5] gnu: services: Nginx configs can reference store
16,17c16,17
<  gnu/services/web.scm | 158 +++++++++++++++++++++++++--------------------------
<  1 file changed, 78 insertions(+), 80 deletions(-)
---
>  gnu/services/web.scm | 150 +++++++++++++++++++++++++--------------------------
>  1 file changed, 74 insertions(+), 76 deletions(-)
20c20
< index c605d7686..6e7ffa787 100644
---
> index b7b2f67f1..e8769522a 100644
23c23
< @@ -114,105 +114,103 @@
---
> @@ -110,101 +110,99 @@
82,86c82,83
< -       (let ((certificate (nginx-server-configuration-ssl-certificate server)))
< -         ;; lstat fails when the certificate file does not exist: it aborts
< -         ;; and lets the user fix their configuration.
< -         (lstat certificate)
< -         (string-append "      ssl_certificate " certificate ";\n"))
---
> -       (string-append "      ssl_certificate "
> -                      (nginx-server-configuration-ssl-certificate server) ";\n")
89,91c86,87
< -       (let ((key (nginx-server-configuration-ssl-certificate-key server)))
< -         (lstat key)
< -         (string-append "      ssl_certificate_key " key ";\n"))
---
> -       (string-append "      ssl_certificate_key "
> -                      (nginx-server-configuration-ssl-certificate-key server) ";\n")
120,123d115
< +    (for-each (lambda (file)
< +                (if (and file (not (file-exists? file)))
< +                    (error "~A does not exist" file)))
< +              (list ssl-certificate ssl-certificate-key))
208c200
< 2.13.1
---
> 2.12.2

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]