guix-channel

  1(define-module (nmeum services networking)
  2  #:use-module (guix gexp)
  3  #:use-module (gnu packages admin)
  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  #:use-module ((srfi srfi-26) #:select (cut))
 13
 14  #:export (dhcpcd-service-type
 15            dhcpcd-configuration
 16            dhcpcd-configuration?
 17            dhcpcd-configuration-interfaces
 18            dhcpcd-configuration-command-args
 19            dhcpcd-configuration-hostname
 20            dhcpcd-configuration-duid
 21            dhcpcd-configuration-persistent
 22            dhcpcd-configuration-option
 23            dhcpcd-configuration-require
 24            dhcpcd-configuration-slaac
 25            dhcpcd-configuration-nooption
 26            dhcpcd-configuration-nohook
 27            dhcpcd-configuration-static
 28            dhcpcd-configuration-vendorclassid
 29            dhcpcd-configuration-clientid
 30            dhcpcd-configuration-extra-content))
 31
 32;;
 33;; DHCPCD.
 34;;
 35
 36(define (dhcpcd-serialize-string field-name value)
 37  (let ((field (object->string field-name)))
 38    (if (string=? field "extra-content")
 39      #~(string-append #$value "\n")
 40      #~(format #f "~a ~a~%" #$field #$value))))
 41
 42(define (dhcpcd-serialize-boolean field-name value)
 43  (if value
 44    #~(format #f "~a~%" #$(object->string field-name))
 45    ""))
 46
 47(define (dhcpcd-serialize-list-of-strings field-name value)
 48  #~(string-append #$@(map (cut dhcpcd-serialize-string field-name <>) value)))
 49
 50;; Some fields (e.g. hostname) can be specified with an empty string argument.
 51;; Therefore, we need a maybe type to differentiate disabled/empty-string.
 52(define-maybe string (prefix dhcpcd-))
 53
 54(define-configuration dhcpcd-configuration
 55  (interfaces
 56    (list '())
 57    "List of interfaces to start a DHCP client for."
 58    empty-serializer)
 59  (command-args
 60    (list '("-q" "-q"))
 61    "List of additional command-line options."
 62    empty-serializer)
 63
 64  ;; The following defaults replicate the default dhcpcd configuration file.
 65  ;;
 66  ;; See https://github.com/NetworkConfiguration/dhcpcd/tree/v10.0.10#configuration
 67  (hostname
 68    (maybe-string "")
 69    "Hostname to send via DHCP, defaults to the current system hostname.")
 70  (duid
 71    (maybe-string "")
 72    "Use and generate a DHCP Unique Identifier.")
 73  (persistent
 74    (boolean #t)
 75    "Do not de-configure on shutdown.")
 76  (option
 77    (list-of-strings
 78      '("rapid_commit"
 79        "domain_name_servers"
 80        "domain_name"
 81        "domain_search"
 82        "host_name"
 83        "classless_static_routes"
 84        "interface_mtu"))
 85    "List of options to request from the server.")
 86  (require
 87    (list-of-strings '("dhcp_server_identifier"))
 88    "List of options to require in responses.")
 89  (slaac
 90    (maybe-string "private")
 91    "Interface identifier used for SLAAC generated IPv6 addresses.")
 92
 93  ;; Common options not set in the default configuration file.
 94  (nooption
 95    (list-of-strings '())
 96    "List of options to remove from the message before it's processed.")
 97  (nohook
 98    (list-of-strings '())
 99    "List of hook script which should not be invoked.")
100  (static
101    (list-of-strings '())
102    "Configure a static value (e.g. ip_address).")
103  (vendorclassid
104    maybe-string
105    "Set the DHCP Vendor Class.")
106  (clientid
107    maybe-string
108    "Use the interface hardware address or the given string as a Client ID.")
109
110  ;; Escape hatch for the generated configuration file.
111  (extra-content
112    maybe-string
113    "Extra content to append to the configuration as-is.")
114
115  (prefix dhcpcd-))
116
117(define (dhcpcd-config-file config)
118  (mixed-text-file "dhcpcd.conf"
119    (serialize-configuration
120      config
121      dhcpcd-configuration-fields)))
122
123(define dhcpcd-account-service
124  (list (user-group (name "dhcpcd") (system? #t))
125        (user-account
126          (name "dhcpcd")
127          (group "dhcpcd")
128          (system? #t)
129          (comment "dhcpcd daemon user")
130          (home-directory "/var/empty")
131          (shell (file-append shadow "/sbin/nologin")))))
132
133(define (dhcpcd-shepherd-service config)
134  (let* ((config-file (dhcpcd-config-file config))
135         (command-args (dhcpcd-configuration-command-args config))
136         (ifaces (dhcpcd-configuration-interfaces config)))
137    (list (shepherd-service
138            (documentation "dhcpcd daemon.")
139            (provision '(networking))
140            (requirement '(user-processes udev))
141            (actions (list (shepherd-configuration-action config-file)))
142            (start
143              #~(lambda _
144                  (fork+exec-command
145                    (list (string-append #$dhcpcd "/sbin/dhcpcd")
146                          #$@command-args "-B" "-f" #$config-file #$@ifaces))))
147            (stop #~(make-kill-destructor))))))
148
149(define dhcpcd-service-type
150  (service-type (name 'dhcpcd)
151                (description "Run the dhcpcd daemon.")
152                (extensions
153                 (list (service-extension account-service-type
154                                          (const dhcpcd-account-service))
155                       (service-extension shepherd-root-service-type
156                                          dhcpcd-shepherd-service)))
157                (compose concatenate)
158                (default-value (dhcpcd-configuration))))