services: Add smartdns-service-type. smartdns

* gnu/services/dns.scm (smartdns-service-type): New variable.
  (<smartdns-configuration>): New record type.
  (smartdns-shepherd-service): New procedure.
* doc/guix.texi (DNS Services): Document it.

Change-Id: Ief41a4f3a7d01e8e789159491e66fdbd5b1ccc1d

1 files changed, 158 insertions, 1 deletions

diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 6608046909..dd76f0a618 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -52,7 +52,11 @@
             knot-resolver-configuration
 
             dnsmasq-service-type
-            dnsmasq-configuration))
+            dnsmasq-configuration
+
+            smartdns-service-type
+            smartdns-configuration
+            smartdns-server-configuration))
 
 ;;;
 ;;; Knot DNS.
@@ -897,3 +901,156 @@ cache.size = 100 * MB
                              dnsmasq-activation)))
    (default-value (dnsmasq-configuration))
    (description "Run the dnsmasq DNS server.")))
+
+
+;;;
+;;; SmartDNS.
+;;;
+
+(define (smartdns-activation config)
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/var/log/smartdns")))
+
+(define (port-number? value)
+  (and (integer? value)
+       (> value 0)
+       (< value (expt 2 16))))
+
+(define-maybe port-number)
+
+(define (smartdns-serialize-port-number field-name value)
+  #~(format #f ":~a" #$value))
+
+(define (smartdns-server-serialize-boolean field-name value)
+  #~(if #$value
+      (string-append " -" (string-delete #\? (symbol->string '#$field-name)))
+      ""))
+
+(define (mark? value)
+  (and (integer? value)
+       (>= value 0)
+       (< value (expt 2 32))))
+
+(define-maybe mark (prefix smartdns-server-))
+
+(define (smartdns-server-serialize-mark field-name value)
+  #~(format #f "-~a ~a" '#$field-name #$value))
+
+(define-maybe string (prefix smartdns-server-))
+
+(define (smartdns-server-serialize-string field-name value)
+  #~(string-append " -" '#$field-name " " #$value "\n"))
+
+(define-configuration smartdns-server-configuration
+  (ip
+   string
+   "Server IP address."
+   (serializer (lambda (field-name value) value)))
+  (port
+   maybe-port-number
+   "Port number."
+   (serializer smartdns-serialize-port-number))
+  (blacklist-ip?
+   (boolean #f)
+   "Whether to discards results
+in @code{smartdns-configuration-blacklist-ips}.")
+  (whitelist-ip?
+   (boolean #f)
+   "Whether to accept only results
+in @code{smartdns-configuration-whitelist-ips}.")
+  (exclude-default-group?
+   (boolean #f)
+   "Whether to exclude this server from the default group.")
+  (set-mark
+   maybe-mark
+   "Mark to be set on packets")
+  (proxy
+   maybe-string
+   "Name of the @code{smartdns-configuration-edns-proxy-server} to use.")
+  (bootstrap-dns?
+   (boolean #f)
+   "Whether to set this server as the bootstrap.")
+  (subnet?
+   (boolean #f)
+   "Whether to set @code{smartdns-configuration-edns-client-subnet}
+as the server's EDNS client subnet.")
+  (prefix smartdns-server-))
+
+(define (smartdns-serialize-string field-name value)
+  #~(string-append '#$field-name " " #$value "\n"))
+
+(define-maybe string (prefix smartdns-))
+
+(define (smartdns-server-list? lst)
+  (every smartdns-server-configuration? lst))
+
+(define (smartdns-serialize-smartdns-server-list field-name value)
+  (let ((parameter (case field-name
+                     ((servers) "server")
+                     ((servers-tcp) "server-tcp")
+                     ((servers-tls) "server-tls")
+                     ((servers-https) "server-https"))))
+    #~(string-append
+        #$@(map (lambda (server)
+                  #~(string-append
+                      #$parameter
+                      " "
+                      #$(serialize-configuration server
+                          smartdns-server-configuration-fields)
+                      "\n"))
+                value))))
+
+(define-configuration smartdns-configuration
+  (package
+   (file-like smartdns)
+   "The SmartDNS package to use."
+   empty-serializer)
+  (server-name
+   maybe-string
+   "DNS name, like a hostname.")
+  (servers
+   (smartdns-server-list '())
+   "List of upstream UDP DNS servers.")
+  (servers-tcp
+   (smartdns-server-list '())
+   "List of upstream TCP DNS servers.")
+  (servers-tls
+   (smartdns-server-list '())
+   "List of upstream TLS DNS servers.")
+  (servers-https
+   (smartdns-server-list '())
+   "List of upstream HTTPS DNS servers.")
+  (prefix smartdns-))
+
+(define (smartdns-shepherd-service config)
+  (let ((prog-file (file-append (smartdns-configuration-package config)
+                                "/sbin/smartdns"))
+        (conf-file (mixed-text-file "smartdns.conf"
+                     (serialize-configuration
+                       config smartdns-configuration-fields)))
+        (pid-file "/run/smartdns.pid"))
+    (shepherd-service
+      (provision '(smartdns))
+      (requirement '(networking))
+      (documentation "Run the SmartDNS DNS server.")
+      (start #~(make-forkexec-constructor
+                 (list #$prog-file "-f" "-c" #$conf-file "-p" #$pid-file)
+                 #:pid-file #$pid-file))
+      (stop #~(make-kill-destructor)))))
+
+(define smartdns-service-type
+  (service-type
+    (name 'smartdns)
+    (extensions
+      (list (service-extension activation-service-type
+                               smartdns-activation)
+            (service-extension shepherd-root-service-type
+                               (compose list smartdns-shepherd-service))))
+    (default-value (smartdns-configuration))
+    (description "Run the SmartDNS DNS server.")))
+
+(define (generate-smartdns-documentation)
+  (generate-documentation `((smartdns-configuration
+                             ,smartdns-configuration-fields))
+                          'smartdns-configuration))