diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/databases.scm | 17 | ||||
| -rw-r--r-- | gnu/services/web.scm | 164 |
2 files changed, 99 insertions, 82 deletions
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index 3b64d0e075..de1f6b8411 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -216,6 +216,14 @@ and stores the database cluster in @var{data-directory}." (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) +(define memcached-activation + #~(begin + (use-modules (guix build utils)) + (let ((user (getpwnam "memcached"))) + (mkdir-p "/var/run/memcached") + (chown "/var/run/memcached" + (passwd:uid user) (passwd:gid user))))) + (define memcached-shepherd-service (match-lambda (($ <memcached-configuration> memcached interfaces tcp-port udp-port @@ -233,11 +241,14 @@ and stores the database cluster in @var{data-directory}." "-p" #$(number->string tcp-port) "-U" #$(number->string udp-port) "--daemon" - "-P" "/var/run/memcached.pid" + ;; Memcached changes to the memcached user prior to + ;; writing the pid file, so write it to a directory + ;; that memcached owns. + "-P" "/var/run/memcached/pid" "-u" "memcached" ,#$@additional-options) #:log-file "/var/log/memcached" - #:pid-file "/var/run/memcached.pid")) + #:pid-file "/var/run/memcached/pid")) (stop #~(make-kill-destructor)))))))) (define memcached-service-type @@ -245,6 +256,8 @@ and stores the database cluster in @var{data-directory}." (extensions (list (service-extension shepherd-root-service-type memcached-shepherd-service) + (service-extension activation-service-type + (const memcached-activation)) (service-extension account-service-type (const %memcached-accounts)))) (default-value (memcached-configuration)))) diff --git a/gnu/services/web.scm b/gnu/services/web.scm index c605d76866..cc7adeb5e4 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -114,105 +114,109 @@ (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 + (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") + (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)) |