bug#26684: let nginx configs reference the store

bug#26684: let nginx configs reference the store

[Andy Wingo]

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

Hi,

Is this the right way to do things?  Passing lists around seems to be an
intermediate point between strings and proper configuration values -- as
such it seems like a useful intermediate step.  The context is that I
need to be able to extend the nginx configuration with a server config
that references a store path.

Andy


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

From b56b797e2ca26619485d874110d3f1f0ae96fba4 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@igalia.com>
Date: Thu, 27 Apr 2017 19:49:02 +0200
Subject: [PATCH 1/5] 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 | 150 +++++++++++++++++++++++++--------------------------
 1 file changed, 74 insertions(+), 76 deletions(-)

diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index b7b2f67f1..e8769522a 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -110,101 +110,99 @@
 (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)
-       (string-append "      ssl_certificate "
-                      (nginx-server-configuration-ssl-certificate server) ";\n")
-       "")
-   (if (nginx-server-configuration-ssl-certificate-key server)
-       (string-append "      ssl_certificate_key "
-                      (nginx-server-configuration-ssl-certificate-key server) ";\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 ...))
+            '())))
+    (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.12.2

bug#26684: let nginx configs reference the store

[Ludovic Courtès]

Andy Wingo <wingo@igalia.com> skribis:

> Is this the right way to do things?  Passing lists around seems to be an
> intermediate point between strings and proper configuration values -- as
> such it seems like a useful intermediate step.  The context is that I
> need to be able to extend the nginx configuration with a server config
> that references a store path.

I don’t know if it’s ideal but it’s definitely an improvement!

What I had in mind when I thought about fixing the very same issue was
to generate a gexp as the IR of the configuration file, something like:

  #~(nginx
      (server bar
        (location #$foo)))

and then have a build-side ‘sexp->nginx-config-file’ procedure that
would convert it.

That’s nicer in theory but probably more tricky than what you propose
here.

In the short term I think applying the patch you posted is probably the
right thing.

Thoughts?

Thanks,
Ludo’.

bug#26684: let nginx configs reference the store

[Clément Lassieur]

Andy Wingo <wingo@igalia.com> writes:

> Hi,
>
> Is this the right way to do things?  Passing lists around seems to be an
> intermediate point between strings and proper configuration values -- as
> such it seems like a useful intermediate step.  The context is that I
> need to be able to extend the nginx configuration with a server config
> that references a store path.
>
> Andy
>
> From b56b797e2ca26619485d874110d3f1f0ae96fba4 Mon Sep 17 00:00:00 2001
> From: Andy Wingo <wingo@igalia.com>
> Date: Thu, 27 Apr 2017 19:49:02 +0200
> Subject: [PATCH 1/5] 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 | 150 +++++++++++++++++++++++++--------------------------
>  1 file changed, 74 insertions(+), 76 deletions(-)

Hi Andy,

I tested it successfully (with a reference to the store), and it looks
good to me as well.  Thanks you!  You'll have some rebasing work to do
though with (lstat ssl-cert...).

Clément

[bug#26684] let nginx configs reference the store

[Ludovic Courtès]

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

Thanks,
Ludo’.

[bug#26684] let nginx configs reference the store

[Clément Lassieur]

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

> 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

Hi Ludo,

Sure, I'll have a look at it, probably this week-end.  I remember I
fixed the conflict on my local branch.

I haven't been very active those last weeks, but I hope to be back soon.
:)

Clément

[bug#26684] let nginx configs reference the store

[Christopher Baines]

[-- 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 --]

[bug#26684] let nginx configs reference the store

[Ludovic Courtès]

Hello,

Christopher Baines <mail@cbaines.net> skribis:

> 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.

As long as “make check-system TESTS=nginx” doesn’t catch obvious errors,
it’s probably fine.

Thank you!

Ludo’.

[bug#26684] [PATCH 1/2] gnu: services: Nginx configs can reference store

[Christopher Baines]

From: Andy Wingo <wingo@igalia.com>

* 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 | 154 +++++++++++++++++++++++++--------------------------
 1 file changed, 74 insertions(+), 80 deletions(-)

diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index c605d7686..97318ecb1 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -114,105 +114,99 @@
 (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 ...))
+            '())))
+    (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

[bug#26684] [PATCH 2/2] web: Check for the existance of SSL related files.

[Christopher Baines]

This adds back the previous behaviour of the nginx-service-type, where the
service would check at the time when the configuration is generated if the SSL
certificate and certificate key file exists.

* gnu/services/web.scm (emit-nginx-server-config): Add back check for SSL
  related files.
---
 gnu/services/web.scm | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 97318ecb1..cc7adeb5e 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -157,6 +157,16 @@ of index files."
             (syntax-parameterize ((<> (identifier-syntax x*)))
               (list tail ...))
             '())))
+    (for-each
+     (match-lambda
+      ((record-key . file)
+       (if (and file (not (file-exists? file)))
+           (error
+            (simple-format
+             #f
+             "~A in the nginx configuration for the server with name \"~A\" does not exist" record-key server-name)))))
+     `(("ssl-certificate"     . ,ssl-certificate)
+       ("ssl-certificate-key" . ,ssl-certificate-key)))
     (list
      "    server {\n"
      (and/l http-port  "      listen " (number->string <>) ";\n")
-- 
2.13.1

[bug#26684] let nginx configs reference the store

[Christopher Baines]

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

On Wed, 02 Aug 2017 11:31:41 +0200
ludo@gnu.org (Ludovic Courtès) wrote:

> Hello,
> 
> Christopher Baines <mail@cbaines.net> skribis:
> 
> > 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.  
> 
> As long as “make check-system TESTS=nginx” doesn’t catch obvious
> errors, it’s probably fine.
> 
> Thank you!

Yep, that test passes fine.

I've send a couple of updated patches, the first is just the one from
Andy, modified to apply, with the additional validation being re-added
in the second, as I didn't like the idea of just modifying the patch
from Andy with my own additions.

I've also improved the error message since the first patch, so it will
say something like:

  ERROR: ssl-certificate in the nginx configuration for the server with
name "(default)" does not exist



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

bug#26684: let nginx configs reference the store

[Christopher Baines]

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

On Wed, 2 Aug 2017 16:23:03 +0100
Christopher Baines <mail@cbaines.net> wrote:

> On Wed, 02 Aug 2017 11:31:41 +0200
> ludo@gnu.org (Ludovic Courtès) wrote:
> 
> > Hello,
> > 
> > Christopher Baines <mail@cbaines.net> skribis:
> >   
> > > 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.    
> > 
> > As long as “make check-system TESTS=nginx” doesn’t catch obvious
> > errors, it’s probably fine.
> > 
> > Thank you!  
> 
> Yep, that test passes fine.
> 
> I've send a couple of updated patches, the first is just the one from
> Andy, modified to apply, with the additional validation being re-added
> in the second, as I didn't like the idea of just modifying the patch
> from Andy with my own additions.
> 
> I've also improved the error message since the first patch, so it will
> say something like:
> 
>   ERROR: ssl-certificate in the nginx configuration for the server
> with name "(default)" does not exist

I've got some more improvements I'd like to make to the NGinx service,
so to keep things progressing on this, I've merged my adjusted version
of the change from Andy, and my additional patch that adds back in the
validation.

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

[bug#26684] let nginx configs reference the store

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> On Wed, 2 Aug 2017 16:23:03 +0100
> Christopher Baines <mail@cbaines.net> wrote:
>
>> On Wed, 02 Aug 2017 11:31:41 +0200
>> ludo@gnu.org (Ludovic Courtès) wrote:
>> 
>> > Hello,
>> > 
>> > Christopher Baines <mail@cbaines.net> skribis:
>> >   
>> > > 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.    
>> > 
>> > As long as “make check-system TESTS=nginx” doesn’t catch obvious
>> > errors, it’s probably fine.
>> > 
>> > Thank you!  
>> 
>> Yep, that test passes fine.
>> 
>> I've send a couple of updated patches, the first is just the one from
>> Andy, modified to apply, with the additional validation being re-added
>> in the second, as I didn't like the idea of just modifying the patch
>> from Andy with my own additions.
>> 
>> I've also improved the error message since the first patch, so it will
>> say something like:
>> 
>>   ERROR: ssl-certificate in the nginx configuration for the server
>> with name "(default)" does not exist
>
> I've got some more improvements I'd like to make to the NGinx service,
> so to keep things progressing on this, I've merged my adjusted version
> of the change from Andy, and my additional patch that adds back in the
> validation.

Awesome, thank you!

Ludo’.