unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* isc-bind service draft
@ 2017-11-09 20:11 Oleg Pykhalov
  2017-11-15  4:48 ` Chris Marusich
  2017-11-16 16:19 ` Ludovic Courtès
  0 siblings, 2 replies; 7+ messages in thread
From: Oleg Pykhalov @ 2017-11-09 20:11 UTC (permalink / raw)
  To: guix-devel

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

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.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: isc-bind service draft
  2017-11-09 20:11 isc-bind service draft Oleg Pykhalov
@ 2017-11-15  4:48 ` Chris Marusich
  2017-11-16  3:21   ` Chris Marusich
  2017-11-16 16:19 ` Ludovic Courtès
  1 sibling, 1 reply; 7+ messages in thread
From: Chris Marusich @ 2017-11-15  4:48 UTC (permalink / raw)
  To: Oleg Pykhalov; +Cc: guix-devel

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

Hi Oleg,

Oleg Pykhalov <go.wigust@gmail.com> writes:

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

Awesome!  Thank you for working on this.  I'm not familiar with BIND
configuration, so I can't really comment much on the particular fields
you've chosen to include in the various configuration objects you've
created.  It'd be nice if someone more familiar with BIND could give it
a look.

> (define-record-type* <bind-options-configuration>

Are these options intended to be used when invoking bind?  If so, maybe
a name like "bind-options" is probably good enough.

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

For what it's worth, nowadays some distros use /run as the "run
directory" [1].  I don't know if GuixSD has adopted any particular
policy about whether to use /var/run or /run for the default "run
directory".  I don't currently know of any reason why it matters much,
so I think it's fine to use /var/run here.

>   (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"))

Why not use the system's host name by default?  For example:

   (hostname         bind-configuration-hostname              ; string
                     (default (gethostname)))

>   
>   (server-id bind-configuration-server-id ; string (default "none")))
>
> (define (bind-configuration-statement-string statements)
>   (string-join (list "{" (string-join statements ";\n") "}")))
>

You could also write it like this:

 (define (bind-configuration-statement-string statements)
   (string-append "{" (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"))))))

What is the intended behavior of these defaults?  In what situations
will they work, and in what situations will they not?  It might be good
to put a comment in that explains the intended default behavior and why
it is reasonable.

> (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")
>                        '()))))

Does this need to be a macro?  By the way, you could use string-append
here, too, to make it simpler.

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

Does this need to be a macro?

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

Some of these slots (e.g., listen-v4) appear to be un-used.  Instead of
listing positional slots by name, maybe it would be better to bind the
entire <bind-options-configuration> to a variable, and then use the
accessor procedures (e.g., bind-options-configuration-listen-v4) to get
just the attributes you need.  This has the benefit of being more
resilient to refactorings which change the order of fields in the
record, also.  I realize that a lot of the code in Guix relies on
positional matching of slots like this, so I don't mind if you keep it
as-is, but consider my suggestion as food for thought.

>      `("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))))))))
>

Is it necessary to define a gexp compiler here?  I would have thought we
could just invoke plain-file or text-file instead (see (guix)
G-Expressions in the Guix manual).  Why can't we?  Other services do
this; for example, see the service definitions in gnu/services/mail.scm.

Also, is it possible for a user to pass in an existing configuration
file to be used verbatim, or included somewhere in the config?  Having
an "escape hatch" like that seems useful for most services; perhaps it
could be useful here, too.

Footnotes: 
[1]  https://unix.stackexchange.com/questions/13972/what-is-this-new-run-filesystem

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: isc-bind service draft
  2017-11-15  4:48 ` Chris Marusich
@ 2017-11-16  3:21   ` Chris Marusich
  2017-11-16 16:18     ` Ludovic Courtès
  0 siblings, 1 reply; 7+ messages in thread
From: Chris Marusich @ 2017-11-16  3:21 UTC (permalink / raw)
  To: Oleg Pykhalov; +Cc: guix-devel

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

Hi Oleg,

Chris Marusich <cmmarusich@gmail.com> writes:

>>
>> (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)
>
> Some of these slots (e.g., listen-v4) appear to be un-used.  Instead of
> listing positional slots by name, maybe it would be better to bind the
> entire <bind-options-configuration> to a variable, and then use the
> accessor procedures (e.g., bind-options-configuration-listen-v4) to get
> just the attributes you need.  This has the benefit of being more
> resilient to refactorings which change the order of fields in the
> record, also.  I realize that a lot of the code in Guix relies on
> positional matching of slots like this, so I don't mind if you keep it
> as-is, but consider my suggestion as food for thought.

FYI, I just learned that there is a way to do this with pattern matching
in Guile.  You can write something like the following:

(match options
  ((? bind-options-configuration? (= bind-options-configuration-listen-v4 listen-v4))
   ;; Do something with listen-v4
   (foo listen-v4)))

As far as I know, this is the same as writing something like:

(match options
  ((? bind-options-configuration? opts)
   (let ((listen-v4 (bind-options-configuration-listen-v4 opts)))
     ;; Do something with listen-v4
     (foo listen-v4))))

-- 
Chris

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: isc-bind service draft
  2017-11-16  3:21   ` Chris Marusich
@ 2017-11-16 16:18     ` Ludovic Courtès
  2017-11-24  8:31       ` Oleg Pykhalov
  0 siblings, 1 reply; 7+ messages in thread
From: Ludovic Courtès @ 2017-11-16 16:18 UTC (permalink / raw)
  To: Chris Marusich; +Cc: guix-devel

Chris Marusich <cmmarusich@gmail.com> skribis:

> Chris Marusich <cmmarusich@gmail.com> writes:
>
>>>
>>> (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)
>>
>> Some of these slots (e.g., listen-v4) appear to be un-used.  Instead of
>> listing positional slots by name, maybe it would be better to bind the
>> entire <bind-options-configuration> to a variable, and then use the
>> accessor procedures (e.g., bind-options-configuration-listen-v4) to get
>> just the attributes you need.  This has the benefit of being more
>> resilient to refactorings which change the order of fields in the
>> record, also.  I realize that a lot of the code in Guix relies on
>> positional matching of slots like this, so I don't mind if you keep it
>> as-is, but consider my suggestion as food for thought.
>
> FYI, I just learned that there is a way to do this with pattern matching
> in Guile.  You can write something like the following:
>
> (match options
>   ((? bind-options-configuration? (= bind-options-configuration-listen-v4 listen-v4))
>    ;; Do something with listen-v4
>    (foo listen-v4)))
>
> As far as I know, this is the same as writing something like:
>
> (match options
>   ((? bind-options-configuration? opts)
>    (let ((listen-v4 (bind-options-configuration-listen-v4 opts)))
>      ;; Do something with listen-v4
>      (foo listen-v4))))

In this particular case I would argue that the second version is more
readable.

Ludo’.

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: isc-bind service draft
  2017-11-09 20:11 isc-bind service draft Oleg Pykhalov
  2017-11-15  4:48 ` Chris Marusich
@ 2017-11-16 16:19 ` Ludovic Courtès
  1 sibling, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2017-11-16 16:19 UTC (permalink / raw)
  To: Oleg Pykhalov; +Cc: guix-devel

Oleg Pykhalov <go.wigust@gmail.com> skribis:

>     (($ <bind-options-configuration> user _ run-directory pid-file
>                                      listen-v4 listen-v6 listen-port
>                                      allow-recursion? allow-transfer?
>                                      allow-update?
>                                      version hostname server-id)

Given that there are many fields, it’s safer to use the new
‘match-record’ macro from (guix records) in this case.

Ludo’.

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: isc-bind service draft
  2017-11-16 16:18     ` Ludovic Courtès
@ 2017-11-24  8:31       ` Oleg Pykhalov
  2017-11-30 17:03         ` Ludovic Courtès
  0 siblings, 1 reply; 7+ messages in thread
From: Oleg Pykhalov @ 2017-11-24  8:31 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guix-devel


[-- Attachment #1.1: Type: text/plain, Size: 207 bytes --]

Hello,

Thank you for suggestions!

Here is a new working in vm version.  There is still a lot work to do:

- More apropriate for everyone default config.
- Writing tests.

More suggestions are welcome :-)


[-- Attachment #1.2: vm isc-bind system definition --]
[-- Type: text/plain, Size: 687 bytes --]

(use-modules (gnu))
(use-service-modules networking dns)

(operating-system
  (host-name "gnu")
  (timezone "Etc/UTC")
  (locale "en_US.utf8")
  (bootloader (grub-configuration (target "/dev/sda")
                                  (terminal-outputs '(console))))
  (file-systems (cons (file-system
                        (device "my-root")
                        (title 'label)
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))
  (users %base-user-accounts)
  (packages %base-packages)
  (services (cons* (dhcp-client-service)
                   (service bind-service-type)
                   %base-services)))

[-- Attachment #1.3: Type: text/plain, Size: 176 bytes --]


--8<---------------cut here---------------start------------->8---
./pre-inst-env guix system vm VM_FILE_SCM
--8<---------------cut here---------------end--------------->8---


[-- Attachment #1.4: isc-bind service --]
[-- Type: text/plain, Size: 8758 bytes --]

(define-record-type* <bind-options-configuration>
  bind-options-configuration make-bind-options-configuration
  bind-options-configuration?
  (user             bind-options-configuration-user             ; string
                    (default "named"))
  (group            bind-options-configuration-group            ; string
                    (default "named"))
  (run-directory    bind-options-configuration-run-directory    ; string
                    (default "/var/run/named"))
  (pid-file         bind-options-configuration-pid-file         ; string
                    (default "/var/run/named/named.pid"))
  (log-file         bind-options-configuration-log-file         ; string
                    (default "/var/log/named.log"))
  (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-options-configuration-allow-recursion? ; list
                    (default (list "127.0.0.1")))
  (allow-transfer?  bind-options-configuration-allow-transfer?  ; list
                    (default (list "none")))
  (allow-update?    bind-options-configuration-allow-update?    ; list
                    (default (list "none")))
  (version          bind-options-configuration-version          ; string
                    (default "none"))
  (hostname         bind-options-configuration-hostname         ; string
                    (default (gethostname)))
  (server-id        bind-options-configuration-server-id        ; string
                    (default "none")))

(define-record-type* <bind-zone-configuration>
  bind-zone-configuration make-bind-zone-configuration
  bind-zone-configuration?
  (network bind-zone-configuration-network ; string
           (default "localhost"))
  (class   bind-zone-configuration-class   ; string
           (default "IN"))
  (type    bind-zone-configuration-type    ; string
           (default "master"))
  (file    bind-zone-configuration-file    ; <zone-file>
           (default (zone-file (origin "@")
                               (ns "localhost.")
                               (mail "root.localhost.")
                               (entries (list (zone-entry
                                               (name "")
                                               (ttl  "1D")
                                               (type "NS")
                                               (data "localhost."))
                                              (zone-entry
                                               (name "localhost.")
                                               (ttl  "1D")
                                               (data "127.0.0.1"))))))))

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

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

(define-gexp-compiler (zone-file-compiler
                       (file <zone-file>) system target)
  (match-record
   file <zone-file>
   (entries origin ns mail serial refresh retry expiry nx)
   (apply text-file* (string-append ns "zone")
          (format #f  "@ IN SOA ~a ~a (~a ~a ~a ~a ~a)\n"
                  ns mail serial refresh retry expiry nx)
          (map (lambda (zone-entry)
                 (match-record
                  zone-entry <zone-entry> (name ttl class type data)
                  (format #f "~a ~a ~a ~a ~a\n" name class type ttl data)))
               entries))))

(define-gexp-compiler (bind-configuration-file-compiler
                       (file <bind-configuration-file>) system target)
  (match-record
   file <bind-configuration-file> (config-options config-zones)
   (define options-config
      (match-record
       config-options <bind-options-configuration>
       (user group run-directory pid-file log-file listen-v4 listen-v6
        listen-port allow-recursion? allow-transfer? allow-update?
        version hostname server-id)
       (letrec ((block (lambda (statements)
                         (format #f "{ ~a ;}" (string-join statements "; ")))))
         (list "options {\n"
               "    directory \"" run-directory "\";\n"
               "    pid-file \"" pid-file "\";\n"
               "    allow-recursion " (block allow-recursion?) ";\n"
               "    allow-transfer " (block allow-transfer?) ";\n"
               "    allow-update " (block allow-update?) ";\n"
               "    version " version ";\n"
               "    hostname \"" hostname "\";\n"
               "    server-id " server-id ";\n"
               "};\n"))))

   (define zones-config
     (map (lambda (config)
            (match-record
             config <bind-zone-configuration> (network class type file)
             (list "zone \"" network "\" " class " {\n"
                   "    type " type ";\n"
                   "    file \"" file "\";\n"
                   "};\n")))
          config-zones))

   (apply text-file* "named.conf"
          (apply string-append options-config)
          (fold append '() zones-config))))

(define (match-bind-options-configuration bind-configuration-file)
  "Return `<bind-options-configuration>' from `<bind-configuration-file>'."
  (match-record
   bind-configuration-file <bind-configuration-file> (config-options)
   config-options))

(define (match-bind-configuration-config-file bind-configuration)
  "Return a `bind-configuration-config-file' from `<bind-configuration>'."
  (match-record
   bind-configuration <bind-configuration> (config-file)
   config-file))

(define (bind-account config)
  "Return a `<user-group>' from `<bind-configuration>'."
  (match-record
   ((compose match-bind-options-configuration
                   match-bind-configuration-config-file)
    config)
   <bind-options-configuration> (user group run-directory)
   (let ((bind-group group))
     (list (user-group
            (name bind-group)
            (system? #t))
           (user-account
            (name user)
            (group bind-group)
            (system? #t)
            (comment "Bind dns server user")
            (home-directory run-directory)
            (shell (file-append shadow "/sbin/nologin")))))))

(define (bind-activation config)
  "Return the activation GEXP for CONFIG."
  (match-record
   ((compose match-bind-options-configuration
             match-bind-configuration-config-file)
    config)
   <bind-options-configuration> (user group run-directory)
   (with-imported-modules '((guix build utils))
     #~(begin
         (mkdir-p #$run-directory)
         (chown #$run-directory
                (passwd:uid (getpw #$user))
                (group:gid (getpw #$group)))))))

(define (bind-shepherd-service config)
  (match-record
   config
   <bind-configuration> (config-file package)
   (match-record
    (match-bind-options-configuration config-file)
    <bind-options-configuration> (user group pid-file)
    (list (shepherd-service
           (documentation "Run the Bind DNS daemon.")
           (provision '(bind dns))
           (requirement '(networking))
           (start #~(make-forkexec-constructor
                     (list (string-append #$package "/sbin/named")
                           "-c" #$config-file)
                     #:user #$user
                     #:group #$group
                     #:pid-file #$pid-file))
           (stop #~(make-kill-destructor)))))))

(define bind-service-type
  (service-type (name 'bind)
                (description "Run the Bind DNS server.")
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          bind-shepherd-service)
                       (service-extension account-service-type
                                          bind-account)
                       (service-extension activation-service-type
                                          bind-activation)))
                (default-value (bind-configuration))))

[-- Attachment #1.5: Type: text/plain, Size: 7 bytes --]


Oleg.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: isc-bind service draft
  2017-11-24  8:31       ` Oleg Pykhalov
@ 2017-11-30 17:03         ` Ludovic Courtès
  0 siblings, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2017-11-30 17:03 UTC (permalink / raw)
  To: Oleg Pykhalov; +Cc: guix-devel

Hi Oleg,

Oleg Pykhalov <go.wigust@gmail.com> skribis:

> Here is a new working in vm version.  There is still a lot work to do:
>
> - More apropriate for everyone default config.
> - Writing tests.
>
> More suggestions are welcome :-)

That looks neat!  With doc and a couple of examples, and indeed a test,
it would be perfect.  But you’re almost there, no?

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

[...]

>   (allow-recursion? bind-options-configuration-allow-recursion? ; list
>                     (default (list "127.0.0.1")))
>   (allow-transfer?  bind-options-configuration-allow-transfer?  ; list
>                     (default (list "none")))
>   (allow-update?    bind-options-configuration-allow-update?    ; list
>                     (default (list "none")))
>   (version          bind-options-configuration-version          ; string
>                     (default "none"))

As a matter of style, I would use question marks only for Booleans.
Here these appear to be enumerations and strings, no?

>   (hostname         bind-options-configuration-hostname         ; string
>                     (default (gethostname)))

Not a great default (for instance if you’re configuring a remote
machine).  Should we just not provide a default?

Thank you!

Ludo’.

^ permalink raw reply	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2017-11-30 17:03 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-11-09 20:11 isc-bind service draft Oleg Pykhalov
2017-11-15  4:48 ` Chris Marusich
2017-11-16  3:21   ` Chris Marusich
2017-11-16 16:18     ` Ludovic Courtès
2017-11-24  8:31       ` Oleg Pykhalov
2017-11-30 17:03         ` Ludovic Courtès
2017-11-16 16:19 ` Ludovic Courtès

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).