nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.

Signed-off-by: Christopher Baines <mail@cbaines.net>
This commit is contained in:
Andy Wingo 2017-04-27 19:49:02 +02:00 committed by Christopher Baines
parent e9a599cdce
commit c9aa261be4
No known key found for this signature in database
GPG Key ID: 5E28A33B0B84F577
1 changed files with 75 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

156
gnu/services/web.scm
View File

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