;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson ;;; Copyright © 2015, 2016 Ludovic Courtès ;;; Copyright © 2016 ng0 ;;; Copyright © 2016 Julien Lepiller ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu services web) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:use-module (gnu packages admin) #:use-module (gnu packages web) #:use-module (guix records) #:use-module (guix gexp) #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:export (nginx-configuration nginx-configuration? nginx-block-server nginx-access nginx-option nginx-listen nginx-service nginx-service-type)) ;;; Commentary: ;;; ;;; Web services. ;;; ;;; Code: (define-record-type* nginx-configuration make-nginx-configuration nginx-configuration? (nginx nginx-configuration-nginx) ; (log-directory nginx-configuration-log-directory) ;string (run-directory nginx-configuration-run-directory) ;string (http-configs nginx-configuration-http-configs) (events-configs nginx-configuration-events-configs) (blocks nginx-configuration-blocks) (file nginx-configuration-file)) ;string | file-like (define-record-type* nginx-option make-nginx-option nginx-option? (type nginx-option-type) (value nginx-option-value)) (define-record-type* nginx-block-server make-nginx-block-server nginx-block-server? (blocks nginx-block-server-blocks) (configs nginx-block-server-configs)) (define-record-type* nginx-listen make-nginx-listen nginx-listen? (port nginx-listen-port (default 80)) (address nginx-listen-address (default #f)) (socket nginx-listen-socket (default #f)) (ssl? nginx-listen-ssl? (default #f)) (http2? nginx-listen-http2? (default #f)) (spdy? nginx-listen-spdy? (default #f)) (proxy? nginx-listen-proxy? (default #f))) (define-record-type* nginx-error-page make-nginx-error-page nginx-error-page? (codes nginx-error-page-codes (default (list 404))) (response nginx-error-page-response (default #f)) (uri nginx-error-page-uri (default "/404.html"))) (define-record-type* nginx-access make-nginx-access nginx-access? (deny? nginx-access-restriction (default #t)) (to nginx-access-to (default 'all)) (except nginx-access-except (default '()))) (define (config-domain-strings names) "Return a string denoting the nginx config representation of NAMES, a list of domain names." (string-concatenate (map (match-lambda ('default "_ ") ((? string? str) (string-append str " "))) names))) (define (config-index-strings names) "Return a string denoting the nginx config representation of NAMES, a list of index files." (string-concatenate (map (match-lambda ((? string? str) (string-append str " "))) names))) (define (config-code-strings codes) "Return a string denoting the nginx config representation of CODES, a list of HTTP response code." (string-concatenate (map (match-lambda ((? number? n) (string-append (number->string n) " "))) codes))) (define (nginx-listen-config listen) (match listen (($ port address socket ssl? http2? spdy? proxy?) #~(string-append "listen " #$(if address (if port (string-append address ":" (number->string port)) address) (if port (number->string port) (string-append "unix:" socket))) #$(if ssl? "http2 " (if spdy? "spdy " " ")) #$(if proxy? "proxy_protocol" "") ";")))) (define (nginx-error-page-config error) (match error (($ codes response uri) #~(string-append "error_page " #$(config-code-strings codes) #$(match response (#f "") ('proxy "=") ((? number? n) (string-append "=" (number->string n)))) #$uri ";")))) (define (nginx-access-config access) (match access (($ deny? to except) #~(string-append #$(let ((except-list (map nginx-access-config except))) (do ((except-list except-list (cdr except-list)) (block "" #~(string-append #$(car except-list) "\n" #$block ))) ((null? except-list) block))) #$(if deny? "deny " "allow ") #$(match to ('all "all") ('unix "unix:") (_ to)) ";")))) (define (authorized-option-type type) (match type ('http (list 'access 'error_page 'etag 'index 'if_modified_since 'ignore_invalid_headers 'log_not_found 'log_subrequest 'merge_slashes 'port_in_redirect 'recursive_error_pages 'root 'server_name_in_redirect 'server_tokens)) ('server (list 'access 'error_page 'etag 'index 'if_modified_since 'ignore_invalid_headers 'listen 'log_not_found 'log_subrequest 'merge_slashes 'port_in_redirect 'recursive_error_pages 'root 'server_name 'server_name_in_redirect 'server_tokens 'try_files)) ('location (list 'access 'alias 'error_page 'etag 'if_modified_since 'index 'internal 'log_not_found 'log_subrequest 'port_in_redirect 'recursive_error_pages 'root 'server_name_in_redirect 'server_tokens 'try_files)) ('if (list 'error_page 'root)) ('limit_except (list 'access)) ('events (list)))) (define (assert-good-type conf-type block-type) (if (not (memq conf-type (authorized-option-type block-type))) (throw 'bad-conf-type (string-append (symbol->string conf-type) " is not allowed in a " (symbol->string block-type) " block.")))) (define (default-nginx-option-config name value) #~(string-append #$(symbol->string name) " " #$value ";")) (define (nginx-option-config option parent-block-type) (assert-good-type (nginx-option-type option) parent-block-type) (match option (($ type value) (match type ('access (nginx-access-config value)) ('error_page (nginx-error-page-config value)) ('if_modified_since (match value (#f "if_modified_since off;") ('exact "if_modified_since exact;") ('before "if_modified_since before;"))) ('internal (if value "internal;" "")) ('listen (nginx-listen-config value)) ('server_name #~(string-append "server_name " #$(config-domain-strings value) ";")) ('index #~(string-append "index " #$(config-index-strings value) ";")) ('try_files #~(string-append "try_files " #$(config-index-strings value)) ";") (_ (match value ((? number? n) (default-nginx-option-config type (number->string n))) (#t default-nginx-option-config type "on") (#f default-nginx-option-config type "off") (_ (default-nginx-option-config type value)))))))) (define (authorized-block-type type) (match type ('http (list 'server 'types)) ('location (list 'if 'limit_except 'location 'types)) ('server (list 'location 'types)))) (define (assert-good-block-type block-type parent-type) (if (not (memq block-type (authorized-block-type parent-type))) (throw 'bad-block-type (string-append (symbol->string block-type) " is not allowed in a " (symbol->string parent-type) " block.")))) (define (nginx-block-server-config blocks options parent-type) (assert-good-block-type 'server parent-type) #~(string-append " server {\n" #$(let ((config-list (map (lambda (option) (nginx-option-config option 'server)) options))) (do ((config-list config-list (cdr config-list)) (block "" #~(string-append #$(car config-list) "\n" #$block ))) ((null? config-list) block))) #$(let ((block-list (map (lambda (block) (nginx-block-config block 'server)) blocks))) (do ((block-list block-list (cdr block-list)) (block "" #~(string-append #$(car block-list) "\n" #$block ))) ((null? block-list) block))) ; #$(if (eq? options '()) ; "" ; #~(string-concatenate ; #$(map (lambda (option) ; (nginx-option-config option 'server)) ; options))) ; #$(if (eq? blocks '()) ; "" ; (string-concatenate ; (map (lambda (block) ; (nginx-block-config block 'server)) ; blocks))) " }\n")) (define (nginx-block-config block parent-type) (match block (($ blocks options) (nginx-block-server-config blocks options parent-type)) (_ ""))) (define (default-nginx-config log-directory run-directory http-configs events-configs blocks) (computed-file "nginx.conf" #~(call-with-output-file #$output (lambda (port) (format port (string-append "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" #$(let ((config-list (map (lambda (option) (nginx-option-config option 'http)) http-configs))) (do ((config-list config-list (cdr config-list)) (block "" #~(string-append #$(car config-list) "\n" #$block ))) ((null? config-list) block))) #$(let ((block-list (map (lambda (block) (nginx-block-config block 'http)) blocks))) (do ((block-list block-list (cdr block-list)) (block "" #~(string-append #$(car block-list) "\n" #$block ))) ((null? block-list) block))) "}\n" "events {\n" #$(let ((config-list (map (lambda (option) (nginx-option-config option 'http)) events-configs))) (do ((config-list config-list (cdr config-list)) (block "" #~(string-append #$(car config-list) "\n" #$block ))) ((null? config-list) block))) "}\n")))))) (define %nginx-accounts (list (user-group (name "nginx") (system? #t)) (user-account (name "nginx") (group "nginx") (system? #t) (comment "nginx server user") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) (define nginx-activation (match-lambda (($ nginx log-directory run-directory http-configs events-configs blocks file) #~(begin (use-modules (guix build utils)) (format #t "creating nginx log directory '~a'~%" #$log-directory) (mkdir-p #$log-directory) (format #t "creating nginx run directory '~a'~%" #$run-directory) (mkdir-p #$run-directory) (format #t "creating nginx temp directories '~a/{client_body,proxy,fastcgi,uwsgi,scgi}_temp'~%" #$run-directory) (mkdir-p (string-append #$run-directory "/client_body_temp")) (mkdir-p (string-append #$run-directory "/proxy_temp")) (mkdir-p (string-append #$run-directory "/fastcgi_temp")) (mkdir-p (string-append #$run-directory "/uwsgi_temp")) (mkdir-p (string-append #$run-directory "/scgi_temp")) ;; Check configuration file syntax. (system* (string-append #$nginx "/sbin/nginx") "-t" "-c" #$(or file (default-nginx-config log-directory run-directory http-configs events-configs blocks))))))) (define nginx-shepherd-service (match-lambda (($ nginx log-directory run-directory http-configs events-configs blocks file) (let* ((nginx-binary (file-append nginx "/sbin/nginx")) (nginx-action (lambda args #~(lambda _ (zero? (system* #$nginx-binary "-c" #$(or file (default-nginx-config log-directory run-directory http-configs events-configs blocks)) address@hidden)))))) ;; TODO: Add 'reload' action. (list (shepherd-service (provision '(nginx)) (documentation "Run the nginx daemon.") (requirement '(user-processes loopback)) (start (nginx-action "-p" run-directory)) (stop (nginx-action "-s" "stop")))))))) (define nginx-service-type (service-type (name 'nginx) (extensions (list (service-extension shepherd-root-service-type nginx-shepherd-service) (service-extension activation-service-type nginx-activation) (service-extension account-service-type (const %nginx-accounts)))) (compose concatenate) (extend (lambda (config blocks) (nginx-configuration (inherit config) (blocks (append (nginx-configuration-blocks config) blocks))))))) (define* (nginx-service #:key (nginx nginx) (log-directory "/var/log/nginx") (run-directory "/var/run/nginx") (http-configs '()) (events-configs '()) (blocks '()) (config-file #f)) "Return a service that runs NGINX, the nginx web server. The nginx daemon loads its runtime configuration from CONFIG-FILE, stores log files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY." (service nginx-service-type (nginx-configuration (nginx nginx) (log-directory log-directory) (run-directory run-directory) (http-configs http-configs) (events-configs events-configs) (blocks blocks) (file config-file))))