guix-channel

  1(define-module (nmeum services networking)
  2  #:use-module (nmeum packages networking)
  3  #:use-module (guix gexp)
  4  #:use-module (gnu packages admin)
  5  #:use-module (gnu packages dns)
  6  #:use-module (gnu services)
  7  #:use-module (gnu system shadow)
  8  #:use-module (gnu system accounts)
  9  #:use-module (gnu services configuration)
 10  #:use-module (gnu services shepherd)
 11  #:use-module ((srfi srfi-1) #:select (concatenate))
 12  #:use-module ((srfi srfi-13) #:select (string-join))
 13  #:use-module ((srfi srfi-26) #:select (cut))
 14
 15  #:export (dhcpcd-service-type
 16            dhcpcd-configuration
 17            dhcpcd-configuration?
 18            dhcpcd-configuration-interfaces
 19            dhcpcd-configuration-options))
 20
 21;;
 22;; dhcpcd
 23;;
 24
 25(define-maybe list)
 26
 27;; Ensure that strings within the unbound configuration
 28;; are not enclosed in double quotes by the serialization.
 29(define (->string obj)
 30  (if (string? obj)
 31    obj
 32    (object->string obj)))
 33
 34(define (serialize-list-of-opts field-name lst)
 35  #~(string-append
 36      (string-join
 37        (list
 38          #$@(map
 39               (lambda (lst)
 40                 (string-join (map ->string lst) " "))
 41               lst)) "\n") "\n"))
 42
 43(define (list-of-opts? lst)
 44  (list? lst))
 45
 46(define-configuration dhcpcd-configuration
 47  (interfaces
 48    maybe-list
 49    "List of interfaces to start a DHCP client for."
 50    empty-serializer)
 51  (options
 52    ;; Replicate the default dhcpcd configuration file.
 53    ;; See: https://github.com/NetworkConfiguration/dhcpcd#configuration
 54    (list-of-opts '((hostname)
 55                    (duid)
 56                    (persistent)
 57                    (option rapid_commit)
 58                    (option interface_mtu)
 59                    (require dhcp_server_identifier)
 60                    (slaac private)))
 61    "List of configuration options for dhcpcd."))
 62
 63(define (dhcpcd-config-file config)
 64  (mixed-text-file "dhcpcd.conf"
 65    (serialize-configuration
 66      config
 67      dhcpcd-configuration-fields)))
 68
 69(define dhcpcd-account-service
 70  (list (user-group (name "dhcpcd") (system? #t))
 71        (user-account
 72          (name "dhcpcd")
 73          (group "dhcpcd")
 74          (system? #t)
 75          (comment "dhcpcd daemon user")
 76          (home-directory "/var/empty")
 77          (shell "/run/current-system/profile/sbin/nologin"))))
 78
 79(define (dhcpcd-shepherd-service config)
 80  (let* ((config-file (dhcpcd-config-file config))
 81         (interfaces (dhcpcd-configuration-interfaces config)))
 82    (list (shepherd-service
 83            (documentation "dhcp daemon.")
 84            (provision '(networking))
 85            (requirement '(user-processes udev))
 86            (actions (list (shepherd-configuration-action config-file)))
 87            (start #~(lambda _
 88                       ;; When invoked without any arguments, the client discovers all
 89                       ;; non-loopback interfaces *that are up*.  However, the relevant
 90                       ;; interfaces are typically down at this point.  Thus we perform
 91                       ;; our own interface discovery here.
 92                       ;;
 93                       ;; Taken from the `dhcp-client-shepherd-service`.
 94                       (define valid?
 95                         (lambda (interface)
 96                           (and (arp-network-interface? interface)
 97                                (not (loopback-network-interface? interface))
 98                                ;; XXX: Make sure the interfaces are up so that
 99                                ;; 'dhclient' can actually send/receive over them.
100                                ;; Ignore those that cannot be activated.
101                                (false-if-exception
102                                  (set-network-interface-up interface)))))
103                       (define ifaces
104                         (filter valid?
105                                 #$(if (maybe-value-set? interfaces)
106                                     #~'#$interfaces
107                                     #~(all-network-interface-names))))
108
109                       (fork+exec-command
110                         (cons* (string-append #$dhcpcd "/sbin/dhcpcd")
111                                "-q" "-q" "-B" "-f" #$config-file ifaces))))
112            (stop #~(make-kill-destructor))))))
113
114(define dhcpcd-service-type
115  (service-type (name 'dhcpcd)
116                (description "Run the dhcpcd daemon.")
117                (extensions
118                 (list (service-extension account-service-type
119                                          (const dhcpcd-account-service))
120                       (service-extension shepherd-root-service-type
121                                          dhcpcd-shepherd-service)))
122                (compose concatenate)
123                (default-value (dhcpcd-configuration))))