Use hosts-service-type instead of deprecated hosts-file

Also, take the opportunity to make a proper service-type for my
WireGuard setup.

1 files changed, 68 insertions, 50 deletions

diff --git a/tw/system.scm b/tw/system.scm
index 28561fdf..92eadeba 100644
--- a/tw/system.scm
+++ b/tw/system.scm
@@ -2,8 +2,8 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 string-fun)
-  #:use-module ((srfi srfi-1)
-                #:select (fold fold-right))
+  #:use-module ((srfi srfi-1) #:select (append-map every))
+  #:use-module ((srfi srfi-26) #:select (cut))
   #:use-module (gnu)
   #:use-module (gnu services)
   #:use-module (gnu system)
@@ -12,7 +12,7 @@
 
 (use-package-modules admin avahi certs curl disk file-systems linux lsof man
                      moreutils python rsync search shells version-control vpn)
-(use-service-modules mcron monitoring networking ssh vpn)
+(use-service-modules configuration mcron monitoring networking ssh vpn)
 
 (define-public %base-system-packages
   (cons* acpi btrfs-progs cpupower curl efibootmgr exfat-utils git glibc-locales
@@ -69,7 +69,9 @@
    ;; Network setup
    (service dhcp-client-service-type)
    (service ntp-service-type)
-   (wireguard-service host-name)
+   (service tw-wireguard-service-type
+     (tw-wireguard-configuration
+      (this-host host-name)))
 
    ;; Delete the annoying message on SSH login.  Beware when setting up a new
    ;; host, as `allow-empty-passwords' will block login and sudo execution for
@@ -92,7 +94,7 @@
           (shell (file-append zsh "/bin/zsh")))
          %base-user-accounts))
 
-(define %wireguard-peers
+(define-public %wireguard-peers
   `(("lap.twilken.net" .
      ,(wireguard-peer
        (name "lap.wg")
@@ -127,48 +129,64 @@
        (preshared-key "/etc/wireguard/pi3.psk")
        (allowed-ips '("10.0.0.5/32" "fc00::5/128"))))))
 
-(define-public %wireguard-etc-hosts
-  (let ((basic-hosts-file "\
-# This file was generated from your Guix configuration.
-# Any changes will be lost upon reboot or reconfiguration.
-127.0.0.1       localhost
-255.255.255.255 broadcasthost
-::1             localhost ip6-localhost ip6-loopback
-fe00::0         ip6-localnet
-ff00::0         ip6-mcastprefix
-ff02::1         ip6-allnodes
-ff02::2         ip6-allrouters
-ff02::3         ip6-allhosts
-"))
-    (plain-file
-     "hosts"
-     (fold (lambda (peer hosts-file)
-             (apply string-append hosts-file
-                    (map (lambda (allowed-ip-cidr)
-                           (format #f "~16a~a~%"
-                                   (car (string-split allowed-ip-cidr #\/))
-                                   (wireguard-peer-name peer)))
-                         (wireguard-peer-allowed-ips peer))))
-           basic-hosts-file
-           (map cdr %wireguard-peers)))))
-
-(define-public (wireguard-service host-name)
-  (let ((own-peer (assoc-ref %wireguard-peers host-name)))
-    (service wireguard-service-type
-      (wireguard-configuration
-       (addresses
-        (map (lambda (cidr)
-               (let ((ipv4 (string-match "/32$" cidr))
-                     (ipv6 (string-match "/128$" cidr)))
-                 (cond
-                  (ipv4 (regexp-substitute #f ipv4 'pre "/24"))
-                  (ipv6 (regexp-substitute #f ipv6 'pre "/64"))
-                  (#t cidr))))
-             (wireguard-peer-allowed-ips own-peer)))
-       (port
-        (let ((endpoint (wireguard-peer-endpoint own-peer)))
-          (if endpoint
-              (string->number (cadr (string-split endpoint #\:)))
-              58921)))
-       (private-key "/etc/wireguard/private.key")
-       (peers (delq own-peer (map cdr %wireguard-peers)))))))
+(define (wireguard-peers-list? object)
+  (and (list? object)
+       (every (compose string? car) object)
+       (every (compose wireguard-peer? cdr) object)))
+
+(export tw-wireguard-configuration)
+(define-configuration/no-serialization tw-wireguard-configuration
+  (this-host
+   (string)
+   "The host name of the machine being configured.")
+  (peers
+   (wireguard-peers-list %wireguard-peers)
+   "An alist of WireGuard peers to install."))
+
+(define (tw-wireguard-service config)
+  "Create a full WireGuard config from the personal network CONFIG."
+  (let ((own-peer (assoc-ref (tw-wireguard-configuration-peers config)
+                             (tw-wireguard-configuration-this-host config))))
+    (wireguard-configuration
+     (addresses
+      (map (lambda (cidr)
+             (let ((ipv4 (string-match "/32$" cidr))
+                   (ipv6 (string-match "/128$" cidr)))
+               (cond
+                (ipv4 (regexp-substitute #f ipv4 'pre "/24"))
+                (ipv6 (regexp-substitute #f ipv6 'pre "/64"))
+                (#t cidr))))
+           (wireguard-peer-allowed-ips own-peer)))
+     (port
+      (let ((endpoint (wireguard-peer-endpoint own-peer)))
+        (if endpoint
+            (string->number (cadr (string-split endpoint #\:)))
+            58921)))
+     (private-key "/etc/wireguard/private.key")
+     (peers (delq own-peer (map cdr (tw-wireguard-configuration-peers config)))))))
+
+(define (peer->ips peer)
+  "Extract IP addresses assigned to the given `wireguard-peer' PEER."
+  (map (compose car (cut string-split <> #\/))
+       (wireguard-peer-allowed-ips peer)))
+
+(define (tw-wireguard-hosts config)
+  "Generate a hosts file entries from the personal WireGuard network CONFIG."
+  (append-map (lambda (peer)
+                (map (cut host <> (wireguard-peer-name peer))
+                     (peer->ips peer)))
+              (map cdr (tw-wireguard-configuration-peers config))))
+
+(define-public tw-wireguard-service-type
+  (service-type
+   (name 'tw-wireguard)
+   (description "Set up my personal WireGuard network.")
+   (extensions
+    (cons* (service-extension hosts-service-type tw-wireguard-hosts)
+           ;; FIXME: `wireguard-service-type' cannot be extended, so copy its
+           ;; service-extensions directly.
+           (map (lambda (ext)
+                  (service-extension (service-extension-target ext)
+                                     (compose (service-extension-compute ext)
+                                              tw-wireguard-service)))
+                (service-type-extensions wireguard-service-type))))))