--- Begin Message ---
|
Subject: |
let nginx configs reference the store |
|
Date: |
Thu, 27 Apr 2017 22:08:29 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.1 (gnu/linux) |
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 <address@hidden>
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
--- End Message ---
--- Begin Message ---
|
Subject: |
Re: [bug#26684] let nginx configs reference the store |
|
Date: |
Thu, 17 Aug 2017 18:35:36 +0100 |
On Wed, 2 Aug 2017 16:23:03 +0100
Christopher Baines <address@hidden> wrote:
> On Wed, 02 Aug 2017 11:31:41 +0200
> address@hidden (Ludovic Courtès) wrote:
>
> > Hello,
> >
> > Christopher Baines <address@hidden> skribis:
> >
> > > On Mon, 24 Jul 2017 15:01:42 +0200
> > > address@hidden (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.
pgpNG02QfZoH_.pgp
Description: OpenPGP digital signature
--- End Message ---