guix-channel

  1(define-module (nmeum services networking)
  2  #:use-module (nmeum packages networking)
  3  #:use-module (guix gexp)
  4  #:use-module (gnu packages dns)
  5  #:use-module (gnu services)
  6  #:use-module (gnu system shadow)
  7  #:use-module (gnu system accounts)
  8  #:use-module (gnu services configuration)
  9  #:use-module (gnu services shepherd)
 10  #:use-module ((srfi srfi-1) #:select (concatenate))
 11  #:use-module ((srfi srfi-13) #:select (string-join))
 12
 13  #:export (unbound-service-type
 14            unbound-configuration
 15            unbound-configuration?
 16            unbound-configuration-server
 17            unbound-configuration-remote-control
 18            unbound-configuration-forward-zone
 19            unbound-configuration-stub-zone
 20            unbound-configuration-auth-zone
 21            unbound-configuration-view
 22            unbound-configuration-python
 23            unbound-configuration-dynlib
 24
 25            dhcpcd-service-type
 26            dhcpcd-configuration
 27            dhcpcd-configuration?
 28            dhcpcd-configuration-interfaces
 29            dhcpcd-configuration-options))
 30
 31;; Ensure that strings within the unbound configuration
 32;; are not enclosed in double quotes by the serialization.
 33(define (->string obj)
 34  (if (string? obj)
 35    obj
 36    (object->string obj)))
 37
 38;;
 39;; Unbound
 40;;
 41
 42(define-maybe list)
 43
 44(define (serialize-list field-name lst)
 45  #~(string-append
 46      #$(string-append (symbol->string field-name) ":\n")
 47      #$(apply string-append
 48          (map
 49            (lambda (pair)
 50              (string-append "\t"
 51                             (symbol->string (car pair))
 52                             ": "
 53                             (->string (cdr pair))
 54                             "\n"))
 55            lst))))
 56
 57(define-configuration unbound-configuration
 58  (server
 59    (maybe-list '((interface . "127.0.0.1")
 60                  (interface . "::1")
 61
 62                  ;; TLS certificate bundle for DNS over TLS.
 63                  (tls-cert-bundle . "/etc/ssl/certs/ca-certificates.crt")
 64
 65                  (hide-identity . yes)
 66                  (hide-version . yes)))
 67    "The server section of the configuration.")
 68  (remote-control
 69    (maybe-list '((control-enable . yes)
 70                  (control-interface . "/run/unbound.sock")))
 71    "Configuration of the remote control facility.")
 72  (forward-zone
 73    maybe-list
 74    "Configuration of nameservers to forward queries to.")
 75  (stub-zone
 76    maybe-list
 77    "Configuration of stub zones.")
 78  (auth-zone
 79    maybe-list
 80    "Zones for which unbound should response as an authority server.")
 81  (view
 82    maybe-list
 83    "Configuration of view clauses.")
 84  (python
 85    maybe-list
 86    "Configuration of the Python module.")
 87  (dynlib
 88    maybe-list
 89    "Dynamic library module configuration."))
 90
 91(define (unbound-config-file config)
 92  (mixed-text-file "unbound.conf"
 93    (serialize-configuration
 94      config
 95      unbound-configuration-fields)))
 96
 97(define (unbound-shepherd-service config)
 98  (let ((config-file (unbound-config-file config)))
 99    (list (shepherd-service
100            (documentation "Unbound daemon.")
101            (provision '(unbound dns))
102            (requirement '(networking))
103            (actions (list (shepherd-configuration-action config-file)))
104            (start #~(make-forkexec-constructor
105                       (list (string-append #$unbound "/sbin/unbound")
106                             "-d" "-p" "-c" #$config-file)))
107            (stop #~(make-kill-destructor))))))
108
109(define unbound-account-service
110  (list (user-group (name "unbound") (system? #t))
111        (user-account
112         (name "unbound")
113         (group "unbound")
114         (system? #t)
115         (comment "Unbound daemon user")
116         (home-directory "/var/empty")
117         (shell "/run/current-system/profile/sbin/nologin"))))
118
119(define unbound-service-type
120  (service-type (name 'unbound)
121                (description "Run the unbound DNS resolver.")
122                (extensions
123                  (list (service-extension account-service-type
124                                           (const unbound-account-service))
125                        (service-extension shepherd-root-service-type
126                                           unbound-shepherd-service)))
127                (compose concatenate)
128                (default-value (unbound-configuration))))
129
130;;
131;; dhcpcd
132;;
133
134(define (serialize-list-of-opts field-name lst)
135  #~(string-append
136      (string-join
137        (list
138          #$@(map
139               (lambda (lst)
140                 (string-join (map ->string lst) " "))
141               lst)) "\n") "\n"))
142
143(define (list-of-opts? lst)
144  (list? lst))
145
146(define-configuration dhcpcd-configuration
147  (interfaces
148    maybe-list
149    "List of interfaces to start a DHCP client for."
150    empty-serializer)
151  (options
152    ;; Replicate the default dhcpcd configuration file.
153    ;; See: https://github.com/NetworkConfiguration/dhcpcd#configuration
154    (list-of-opts '((hostname)
155                    (duid)
156                    (persistent)
157                    (option rapid_commit)
158                    (option interface_mtu)
159                    (require dhcp_server_identifier)
160                    (slaac private)))
161    "List of configuration options for dhcpcd."))
162
163(define (dhcpcd-config-file config)
164  (mixed-text-file "dhcpcd.conf"
165    (serialize-configuration
166      config
167      dhcpcd-configuration-fields)))
168
169(define dhcpcd-account-service
170  (list (user-group (name "dhcpcd") (system? #t))
171        (user-account
172          (name "dhcpcd")
173          (group "dhcpcd")
174          (system? #t)
175          (comment "dhcpcd daemon user")
176          (home-directory "/var/empty")
177          (shell "/run/current-system/profile/sbin/nologin"))))
178
179(define (dhcpcd-shepherd-service config)
180  (let* ((config-file (dhcpcd-config-file config))
181         (interfaces (dhcpcd-configuration-interfaces config)))
182    (list (shepherd-service
183            (documentation "dhcp daemon.")
184            (provision '(networking))
185            (requirement '(user-processes udev))
186            (actions (list (shepherd-configuration-action config-file)))
187            (start #~(lambda _
188                       ;; When invoked without any arguments, the client discovers all
189                       ;; non-loopback interfaces *that are up*.  However, the relevant
190                       ;; interfaces are typically down at this point.  Thus we perform
191                       ;; our own interface discovery here.
192                       ;;
193                       ;; Taken from the `dhcp-client-shepherd-service`.
194                       (define valid?
195                         (lambda (interface)
196                           (and (arp-network-interface? interface)
197                                (not (loopback-network-interface? interface))
198                                ;; XXX: Make sure the interfaces are up so that
199                                ;; 'dhclient' can actually send/receive over them.
200                                ;; Ignore those that cannot be activated.
201                                (false-if-exception
202                                  (set-network-interface-up interface)))))
203                       (define ifaces
204                         (filter valid?
205                                 #$(if (maybe-value-set? interfaces)
206                                     #~'#$interfaces
207                                     #~(all-network-interface-names))))
208
209                       (fork+exec-command
210                         (cons* (string-append #$dhcpcd "/sbin/dhcpcd")
211                                "-q" "-q" "-B" "-f" #$config-file ifaces))))
212            (stop #~(make-kill-destructor))))))
213
214(define dhcpcd-service-type
215  (service-type (name 'dhcpcd)
216                (description "Run the dhcpcd daemon.")
217                (extensions
218                 (list (service-extension account-service-type
219                                          (const dhcpcd-account-service))
220                       (service-extension shepherd-root-service-type
221                                          dhcpcd-shepherd-service)))
222                (compose concatenate)
223                (default-value (dhcpcd-configuration))))