isc-bind service draft

[Oleg Pykhalov]

Hello Guix,

I work on isc-bind service.  Currently generation of named.conf is done.
Ideas and suggestions are welcome!  :-)

(define-record-type* <bind-options-configuration>
  bind-options-configuration make-bind-options-configuration
  bind-options-configuration?
  (user             bind-options-configuration-user          ; string
                    (default "bind"))
  (group            bind-options-configuration-group         ; string
                    (default "bind"))
  (run-directory    bind-options-configuration-run-directory ; string
                    (default "/var/run/bind"))
  (pid-file         bind-options-configuration-pid-file      ; string
                    (default "/var/run/bind/named.pid"))
  (listen-v4        bind-options-configuration-listen-v4     ; string
                    (default "0.0.0.0"))
  (listen-v6        bind-options-configuration-listen-v6     ; string
                    (default "::"))
  (listen-port      bind-options-configuration-listen-port   ; integer
                    (default 53))
  (allow-recursion? bind-configuration-allow-recursion?      ; list
                    (default (list "127.0.0.1")))
  (allow-transfer?  bind-configuration-allow-transfer?       ; list
                    (default (list "none")))
  (allow-update?    bind-configuration-allow-update?         ; list
                    (default (list "none")))
  (version          bind-configuration-version               ; string
                    (default "none"))
  (hostname         bind-configuration-hostname              ; string
                    (default "none"))
  (server-id        bind-configuration-server-id             ; string
                    (default "none")))

(define (bind-configuration-statement-string statements)
  (string-join (list "{" (string-join statements ";\n") "}")))

(define-record-type* <bind-zone-configuration>
  bind-zone-configuration make-bind-zone-configuration
  bind-zone-configuration?
  (network bind-zone-configuration-network  ; string
           (default '()))
  (class   bind-zone-configuration-class    ; string
    (default '()))
  (type    bind-zone-configuration-type     ; string
           (default '()))
  (file    bind-zone-configuration-filename ; string
           (default '())))

(define-record-type* <bind-configuration-file>
  bind-configuration-file make-bind-configuration-file
  bind-configuration-file?

  ;; <bind-options-configuration>
  (config-options bind-configuration-file-config-options
                  (default (bind-options-configuration)))

  ;; list of <bind-zone-configuration>
  (config-zones   bind-configuration-file-config-zones
                  (default (list (bind-zone-configuration
                                  (network "localhost")
                                  (class   "IN")
                                  (type    "master")
                                  (file    "localhost.zone"))
                                 (bind-zone-configuration
                                  (network "0.0.127.in-addr.arpa")
                                  (class   "IN")
                                  (type    "master")
                                  (file    "127.0.0.zone"))
                                 (bind-zone-configuration
                                  (network (string-append "1.0.0.0.0.0.0.0.0.0."
                                                          "0.0.0.0.0.0.0.0.0.0."
                                                          "0.0.0.0.0.0.0.0.0.0."
                                                          "0.0.ip6.arpa"))
                                  (class   "IN")
                                  (type    "master")
                                  (file    "localhost.ip6.zone"))
                                 (bind-zone-configuration
                                  (network "255.in-addr.arpa")
                                  (class   "IN")
                                  (type    "master")
                                  (file    "empty.zone"))
                                 (bind-zone-configuration
                                  (network "0.in-addr.arpa")
                                  (class   "IN")
                                  (type    "master")
                                  (file    "empty.zone"))
                                 (bind-zone-configuration
                                  (network ".")
                                  (class   "IN")
                                  (type    "master")
                                  (file    "root.hint"))))))

(define-record-type* <bind-configuration>
  bind-configuration make-bind-configuration
  bind-configuration?
  (config-file bind-configuration-config-file
               (default (bind-configuration-file)))
  (package     bind-configuration-package ; <package>
               (default bind)))

(define-syntax option
  (syntax-rules ()
    ((_ key value) (if value
                       (list "    " (string-join (list key value)) ";" "\n")
                       '()))))

(define-syntax key/value
  (syntax-rules ()
    ((_ (key value) rest ...)
     (append (option key value)
             (key/value rest ...)))
    ((_) '())))

(define (emit-bind-zones-config zone)
  (match zone
    (($ <bind-zone-configuration> network class type file)
     (list (string-join `(,(string-join (list "zone"
                                              (string-append "\""
                                                             network
                                                             "\"")
                                              class "{\n"))
                          ,@(key/value ("type" type)
                                       ("file" file))
                          "};\n")
                        "")))))

(define (emit-bind-options-config options)
  (match options
    (($ <bind-options-configuration> user _ run-directory pid-file
                                     listen-v4 listen-v6 listen-port
                                     allow-recursion? allow-transfer?
                                     allow-update?
                                     version hostname server-id)
     `("options {\n"
       ,@(key/value ("directory" run-directory)
                    ("pid-file" pid-file)
                    ("allow-recursion"
                     (bind-configuration-statement-string allow-recursion?))
                    ("allow-transfer"
                     (bind-configuration-statement-string allow-transfer?))
                    ("allow-update"
                     (bind-configuration-statement-string allow-update?))
                    ("version" version)
                    ("hostname" hostname)
                    ("server-id" server-id))
       "};\n"))))

(define-gexp-compiler (bind-configuration-compiler
                       (file <bind-configuration>) system target)
  (match file
    (($ <bind-configuration> config-file)
     (match config-file
       (($ <bind-configuration-file> config-options config-zones)
        (apply text-file* "named.conf"
               (append (fold append '() (map emit-bind-zones-config 
config-zones))
                       (emit-bind-options-config config-options))))))))

Oleg.

signature.asc
Description: PGP signature