Re: [PATCH] improve nginx-service

[Julien Lepiller <julien@lepiller.eu>]

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

On Sun, 06 Nov 2016 18:19:03 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> Hi,
> 
> Tobias Geerinckx-Rice <me@tobias.gr> skribis:
> 
> > However, a web search for ‘vhost site:nginx.org’ returns the
> > following as a first result[0]:
> >
> >    Note: “VirtualHost” is an Apache term. NGINX does not have
> > Virtual hosts, it has “Server Blocks” that use the server_name and
> > listen directives to bind to tcp sockets.
> >
> > I don't use Apache, so that explains that.  
> 
> Oh, good to know.  In general I think it’s best to stick to upstream’s
> terminology.
> 
> Julien, what would you think of changing “virtual host” with “server
> blocks” and “vhost” with “server-block” (?) in the code and
> documentation?
Ok, sorry for the long delay, I was working on php and other things. So
I've been thinking that we should probably stick more to the way you
would write an nginx configuration file, and have an interface to it.
So here is a web.scm file that implements just that. I have a record
type for configuration entries, and record types for complex
configuration types and blocks. Since many blocks can get the same
configuration option (for instance, http, server and location blocks
can get the "root" option), I define a single procedure that returns
the string corresponding to the configuration line. So for instance,
you could write this:

(nginx-service)
(service (service-type
  (name 'foo)
  (extensions
    (list
      (service-extension
        nginx-service-type
         (const (list (nginx-block-server
                        (blocks (list))
                        (configs (list
                                  (nginx-option (type 'server_name)
                                                (value (list 'default)))
                                  (nginx-option (type 'listen)
                                                (value (nginx-listen)))
                                  (nginx-option (type 'root)
                                                (value "/srv/http"))
                                  (nginx-option (type 'index)
                                                (value (list
                                                  "index.html"))))))))))))

As you can see, it's still a bit verbose, but we could provide a few
helper functions for some common cases.

Also, it is now possible to extend the nginx service with other kind of
blocks (although I implemented only the server block, it could be use
to add upstream blocks for instance).

What do you think? should I continue in that direction, or should I go
back to what I was doing before?

> 
> (This is not a fun suggestion to make, but hey!)
> 
> Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: web.scm --]
[-- Type: text/x-scheme, Size: 17063 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(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>
  nginx-configuration make-nginx-configuration
  nginx-configuration?
  (nginx          nginx-configuration-nginx)         ;<package>
  (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>
  nginx-option make-nginx-option
  nginx-option?
  (type  nginx-option-type)
  (value nginx-option-value))

(define-record-type* <nginx-block-server>
  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>
  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>
  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>
  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
   (($ <nginx-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
    (($ <nginx-error-page> 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
    (($ <nginx-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
    (($ <nginx-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
    (($ <nginx-block-server> 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-configuration> 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-configuration> 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))
                      #$@args))))))

       ;; 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))))