From: Oleg Pykhalov <go.wigust@gmail.com>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: guix-devel@gnu.org
Subject: Re: isc-bind service draft
Date: Fri, 24 Nov 2017 11:31:10 +0300 [thread overview]
Message-ID: <87h8tkm629.fsf@gmail.com> (raw)
In-Reply-To: <87fu9eci4n.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Thu, 16 Nov 2017 17:18:00 +0100")
[-- 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 --]
next prev parent reply other threads:[~2017-11-24 8:31 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
2017-11-30 17:03 ` Ludovic Courtès
2017-11-16 16:19 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87h8tkm629.fsf@gmail.com \
--to=go.wigust@gmail.com \
--cc=guix-devel@gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.