[bug#72083] j

[B. Wilson]

* gnu/services/admin.scm (resolvconf-service-type,
resolvconf-configuration): New variables.
* doc/guix.texi (DNS Services): Document resolvconf-service-type.
---
 doc/guix.texi          | 138 +++++++++++++++++++++++++++++++
 gnu/services/admin.scm | 179 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 317 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5b77c84b4a..926c9e7bb9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -33838,6 +33838,144 @@ command-line arguments to @command{dnsmasq} as a list 
of strings.
 @end table
 @end deftp
 
+@subsubheading Resolvconf
+
+Resolvconf acts as a mediary between supplying and consuming programs of name
+server information, allowing the contents of @code{/etc/resolv.conf} to be
+multiplexed between supporting programs.
+
+A typical use case is running a local DNS server such as @code{dnsmasq} on a
+laptop.  In this case, both the DNS server and the DHCP client content for
+control of @code{/etc/resolv.conf}.  Resolvconf allows these programs to
+cooperate together.
+
+In the parlance of resolvconf, programs which write resolver information are
+clients and programs which read said information are subscribers.  Resolvconf
+has built-in support for auto-configuring a handful of subscribers, including
+@code{dnsmasq}, @code{named}, @code{pdnsd}, and @code{unbound}.
+
+@defvar resolvconf-service-type
+
+The @code{resolvconf-service-type} can be configured via the
+@code{resolvconf-configuration} record, documented below.
+@end defvar
+
+@deftp {Data Type} resolvconf-configuration
+Available @code{resolvconf-configuration} fields are:
+
+@table @asis
+@item @code{display-number} (default: @code{0}) (type: number)
+The display number used by Xvnc.  You should set this to a number not
+already used a Xorg server.
+
+@item @code{package} (default: @code{openresolv}) (type: file-like)
+The implementing package.
+
+@item @code{resolvconf?} (default: @code{#t}) (type: boolean)
+Wether to run subscribers or not.
+
+@item @code{allow-interfaces} (default: @code{'()}) (type: list)
+Whitelist of configurable interfaces.
+
+@item @code{deny-interfaces} (default: @code{'()}) (type: list)
+Blacklist of non-configurable interfaces.
+
+@item @code{interface-order} (default: @code{'()}) (type: list)
+Interfaces to process first, in th prescribed order.  When unset, the loopback
+interfaces are assumed.
+
+@item @code{dynamic-order} (default: @code{'()}) (type: list)
+These interfaces are processed after those of @code{interface-order}, unless
+they possess a metric.
+
+@item @code{inclusive-interfaces} (default: @code{'()}) (type: list)
+Ignore any exclusive marking on these interfaces.  This can be useful when
+third-party client integrations force the exclusive option on interfaces.
+
+@item @code{local-nameservers} (default: @code{'()}) (type: list)
+Explicitly configured nameservers for this machine.
+
+@item @code{search-domains} (default: @code{'()}) (type: list)
+Search domains to prepend to the dynamically generated list.
+
+@item @code{search-domains-append} (default: @code{'()}) (type: list)
+Search domains to append to the dynamically generated list.
+
+@item @code{domain-blacklist} (default: @code{'()}) (type: list)
+Domains to completely ignore.  Accepts wildcards, e.g. @code{foo.*} blacklists
+a domain and @code{*.bar} subdomains.
+
+@item @code{name-servers} (default: @code{'()}) (type: list)
+Nameservers to prepend to the dynamically generated list.  This should be set
+to something like @code{'("::1" "127.0.0.1")} when running a local nameserver.
+
+@item @code{name-servers-append} (default: @code{'()}) (type: list)
+Nameservers to append to the dynamically generated list.
+
+@item @code{name-server-blacklist} (default: @code{'()}) (type: list)
+Nameservers to completely remove from consideration. Accepts wildcards.
+
+@item @code{private-interfaces} (default: @code{'()}) (type: list)
+These name servers will only be queried for the domains listed in the
+resolv.conf of their corresponding interface.  This is useful for VPN devices
+and domains.
+
+@item @code{public-interfaces} (default: @code{'()}) (type: list)
+Override the private designation.  This is useful in cases where third-party
+client integrations force the private option.
+
+@item @code{replace} (default: @code{'()}) (type: list)
+This is a space-separated list of replacement keywords. The syntax is
+@code{<keyword>/<match>/<replacement>}, where @code{<match>} may contain
+wildcards.
+
+@item @code{replace-sub} (default: @code{'()}) (type: list)
+This functions the same as @code{replace}, except it operates over individual
+values instead of the entire field.
+
+@item @code{enabled-subscribers} (default: @code{'()}) (type: list)
+The subscribers which should be configured.
+
+@item @code{resolv-conf} (default: @code{"/etc/resolv.conf"}) (type: string)
+Location of @code{resolv.conf}.
+
+@item @code{dnsmasq-conf} (default: 
@code{"/run/resolvconf/dnsmasq/dnsmasq.conf"}) (type: string)
+Location of configuration for @code{dnsmasq}'s domain-specific nameservers.
+
+@item @code{dnsmasq-resolv} (default: 
@code{"/run/resolvconf/dnsmasq/resolv.conf"}) (type: string)
+Global nameserver configuration for @code{dnsmasq}.
+
+@item @code{dnsmasq-pid} (default: @code{"/run/dnsmasq.pid"}) (type: string)
+Location of @code{dnsmasq} process PID file.
+
+@item @code{named-options} (default: 
@code{"/run/resolvconf/named/options.conf"}) (type: string)
+Location of @code{named} configuration file for global lookups.
+
+@item @code{named-zones} (default: @code{"/run/resolvconf/named/zones.conf"}) 
(type: string)
+Location of @code{named} configuration file for domain-specific lookups.
+
+@item @code{pdnsd-conf} (default: @code{"/run/resolvconf/pdnsd/pdnsd.conf"}) 
(type: string)
+Location of @code{pdnsd} configuration for adding forward domanis.
+
+@item @code{pdnsd-resolv} (default: 
@code{"/run/resolvconf/pdnsd/resolv.conf"}) (type: string)
+Location of @code{pdnsd} configuration for global name lookups.
+
+@item @code{pdnsd-zones} (default: @code{"/run/resolvconf/pdnsd/zones.conf"}) 
(type: string)
+Location of @code{pdnsd} configuration for specific and global name servers.
+
+@item @code{unbound-conf} (default: 
@code{"/run/resolvconf/unbound/unbound.conf"}) (type: string)
+Location of @code{unbound} nameserver configuration.
+
+@item @code{unbound-pid} (default: @code{"/run/unbound.pid"}) (type: string)
+PID file location for @code{unbound}.
+
+@item @code{extra-options} (default: @code{'()}) (type: list)
+Escape hatch for any other options.
+
+@end table
+@end deftp
+
+
 @node VNC Services
 @subsection VNC Services
 @cindex VNC (virtual network computing)
diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index 0b325fddb1..b3db44ee02 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -24,6 +24,7 @@ (define-module (gnu services admin)
   #:use-module ((gnu packages base)
                 #:select (canonical-package findutils coreutils sed))
   #:use-module (gnu packages certs)
+  #:use-module (gnu packages dns)
   #:use-module (gnu packages package-management)
   #:use-module (gnu services)
   #:use-module (gnu services configuration)
@@ -38,6 +39,7 @@ (define-module (gnu services admin)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
   #:use-module (ice-9 vlist)
   #:export (%default-rotations
             %rotated-files
@@ -537,4 +539,181 @@ (define unattended-upgrade-service-type
     "Periodically upgrade the system from the current configuration.")
    (default-value (unattended-upgrade-configuration))))
 
+
+;;;
+;;; Managing /etc/resolv.conf
+;;;
+
+(define-record-type* <resolvconf-configuration>
+  resolvconf-configuration make-resolvconf-configuration
+  resolvconf-configuration?
+  (package               resolvconf-configuration-package
+                         (default openresolv))
+  (resolvconf?           resolvconf-configuration-resolvconf?
+                         (default #t))
+  (allow-interfaces      resolvconf-configuration-allow-interfaces
+                         (default '()))
+  (deny-interfaces       resolvconf-configuration-deny-interfaces
+                         (default '()))
+  (interface-order       resolvconf-configuration-interface-order
+                         (default '()))
+  (dynamic-order         resolvconf-configuration-dynamic-order
+                         (default '()))
+  (inclusive-interfaces  resolvconf-configuration-inclusive-interfaces
+                         (default '()))
+  (local-nameservers     resolvconf-configuration-local-nameservers
+                         (default '()))
+  (search-domains        resolvconf-configuration-search-domains
+                         (default '()))
+  (search-domains-append resolvconf-configuration-search-domains-append
+                         (default '()))
+  (domain-blacklist      resolvconf-configuration-domain-blacklist
+                         (default '()))
+  (name-servers          resolvconf-configuration-name-servers
+                         (default '()))
+  (name-servers-append   resolvconf-configuration-name-servers-append
+                         (default '()))
+  (name-server-blacklist resolvconf-configuration-name-server-blacklist
+                         (default '()))
+  (private-interfaces    resolvconf-configuration-private-interfaces
+                         (default '()))
+  (public-interfaces     resolvconf-configuration-public-interfaces
+                         (default '()))
+  (replace               resolvconf-configuration-replace
+                         (default '()))
+  (replace-sub           resolvconf-configuration-replace-sub
+                         (default '()))
+  (enabled-subscribers   resolvconf-configuration-enabled-subscribers
+                         (default '()))
+  (resolv-conf           resolvconf-configuration-resolv-conf
+                         (default "/etc/resolv.conf"))
+  (dnsmasq-conf          resolvconf-configuration-dnsmasq-conf
+                         (default "/run/resolvconf/dnsmasq/dnsmasq.conf"))
+  (dnsmasq-resolv        resolvconf-configuration-dnsmasq-resolv
+                         (default "/run/resolvconf/dnsmasq/resolv.conf"))
+  (dnsmasq-pid           resolvconf-configuration-dnsmasq-pid
+                         (default "/run/dnsmasq.pid"))
+  (named-options         resolvconf-configuration-named-options
+                         (default "/run/resolvconf/named/options.conf"))
+  (named-zones           resolvconf-configuration-named-zones
+                         (default "/run/resolvconf/named/zones.conf"))
+  (pdnsd-conf            resolvconf-configuration-pdnsd-conf
+                         (default "/run/resolvconf/pdnsd/pdnsd.conf"))
+  (pdnsd-resolv          resolvconf-configuration-pdnsd-resolv
+                         (default "/run/resolvconf/pdnsd/resolv.conf"))
+  (pdnsd-zones           resolvconf-configuration-pdnsd-zones
+                         (default "/run/resolvconf/pdnsd/zones.conf"))
+  (unbound-conf          resolvconf-configuration-unbound-conf
+                         (default "/run/resolvconf/unbound/unbound.conf"))
+  (unbound-pid           resolvconf-configuration-unbound-pid
+                         (default "/run/unbound.pid"))
+  (extra-options         resolvconf-configuration-extra-options
+                         (default '())))
+
+(define (resolvconf-conf-service config)
+  (match-record config <resolvconf-configuration>
+    (package resolvconf?
+     allow-interfaces deny-interfaces
+     interface-order dynamic-order
+     inclusive-interfaces
+     local-nameservers search-domains search-domains-append
+     domain-blacklist
+     name-servers name-servers-append
+     name-server-blacklist
+     private-interfaces public-interfaces
+     replace replace-sub
+     enabled-subscribers
+     resolv-conf
+     dnsmasq-conf dnsmasq-resolv dnsmasq-pid
+     named-options named-zones
+     pdnsd-conf pdnsd-resolv pdnsd-zones
+     unbound-conf unbound-pid
+     extra-options)
+    `(("resolvconf.conf"
+       ,(plain-file "resolvconf.conf"
+           (string-join
+             (filter identity
+               (append
+                 (list
+                   (if resolvconf? #f "resolvconf=NO")
+                   (format #f "resolv_conf=~s" resolv-conf))
+                 (if (memq 'dnsmasq enabled-subscribers)
+                   (list
+                     (format #f "dnsmasq_conf=~s" dnsmasq-conf)
+                     (format #f "dnsmasq_resolv=~s" dnsmasq-resolv)
+                     (format #f "dnsmasq_pid=~s" dnsmasq-pid))
+                   '())
+                 (if (memq 'named enabled-subscribers)
+                   (list
+                     (format #f "named_options=~s" named-options)
+                     (format #f "named_zones=~s" named-zones))
+                   '())
+                 (if (memq 'pdnsd enabled-subscribers)
+                   (list
+                     (format #f "pdnsd_conf=~s" pdnsd-conf)
+                     (format #f "pdnsd_resolv=~s" pdnsd-resolv)
+                     (format #f "pdnsd_zones=~s" pdnsd-zones))
+                   '())
+                 (if (memq 'unbound enabled-subscribers)
+                   (list
+                     (format #f "unbound_conf=~s" unbound-conf)
+                     (format #f "unbound_pid=~s" unbound-pid))
+                   '())
+                 (receive (vars vals)
+                   (unzip2
+                     (list
+                      `("allow_interfaces" ,allow-interfaces)
+                      `("deny_interfaces" ,deny-interfaces)
+                      `("interface_order" ,interface-order)
+                      `("dynamic_order" ,dynamic-order)
+                      `("inclusive_interfaces" ,inclusive-interfaces)
+                      `("local_nameservers" ,local-nameservers)
+                      `("search_domains" ,search-domains)
+                      `("search_domains_append" ,search-domains-append)
+                      `("domain_blacklist" ,domain-blacklist)
+                      `("name_servers" ,name-servers)
+                      `("name_servers_append" ,name-servers-append)
+                      `("name_server_blacklist" ,name-server-blacklist)
+                      `("private_interfaces" ,private-interfaces)
+                      `("public_interfaces" ,public-interfaces)
+                      `("replace" ,replace)
+                      `("replace_sub" ,replace-sub)))
+                   (map
+                     (lambda (var val)
+                       (if (nil? val) #f
+                         (format #f "~a=~s" var (string-join val))))
+                     vars vals))
+                 extra-options))
+             "\n" 'suffix))))))
+
+(define (resolvconf-subscriber-setup package)
+  #~(lambda _
+      (let ((resolvconf #$(file-append package "/sbin/resolvconf")))
+        (case (status:exit-val (system* resolvconf "-u"))
+          ((0) #t)
+          (else #f)))))
+
+(define (resolvconf-subscriber-service conf)
+  (let ((package (resolvconf-configuration-package conf))
+        (subscribers (resolvconf-configuration-enabled-subscribers conf)))
+    (shepherd-service
+      (provision '(resolvconf))
+      (documentation "Setup resolvconf subscribers.")
+      (start (resolvconf-subscriber-setup package))
+      (stop #~(const #f))
+      (respawn? #f))))
+
+(define resolvconf-service-type
+  (service-type
+    (name 'resolvconf)
+    (extensions
+      (list (service-extension etc-service-type
+                               resolvconf-conf-service)
+            (service-extension shepherd-root-service-type
+                               (compose list resolvconf-subscriber-service))))
+    (default-value (resolvconf-configuration))
+    (compose concatenate)
+    (description "Setup resolvconf.")))
+
+
 ;;; admin.scm ends here
-- 
2.45.2