path: root/tw/system.scm

(define-module (tw system)
  #:use-module (ice-9 string-fun)
  #:use-module (srfi srfi-26)
  #:use-module (gnu)
  #:use-module (gnu services)
  #:use-module (gnu system)
  #:use-module (gnu system keyboard)
  #:use-module (guix gexp)
  #:use-module (tw channels)
  #:use-module (tw packages catppuccin)
  #:use-module (tw packages scanner)
  #:use-module (tw services desktop)
  #:use-module (tw services wireguard))

(use-package-modules acl admin android avahi backup certs cups curl disk
                     docker file-systems gnome golang-crypto guile kerberos
                     linux lsof man moreutils mtools pulseaudio python rsync
                     search shells tls vim version-control vpn wm xorg)
(use-service-modules authentication avahi base cups dbus desktop docker
                     kerberos linux mcron monitoring networking pm shepherd
                     ssh vpn xorg)

(define-public %british-keyboard
  (keyboard-layout
   "gb" #:options '("caps:swapescape"
                    "parens:swap_brackets"
                    "terminate:ctrl_alt_bksp"
                    "compose:rctrl"
                    "keypad:oss"
                    "kpdl:kposs")))

(define-public %server-base-user-accounts
  (cons* (user-account
          (name "timo")
          (comment "Timo Wilken")
          (group "users")
          (home-directory "/home/timo")
          (supplementary-groups '("wheel" "input" "netdev" "audio" "video"))
          (shell (file-append zsh "/bin/zsh")))
         %base-user-accounts))

;; This is used for the servers, and also by (tw home) to generate the
;; appropriate ~/.ssh/config.
(define-public %ssh-ports
  '(("lud.twilken.net" . 22022)
    ("vin.twilken.net" . 22022)
    ("pi3.twilken.net" . 51022)
    ("lap.twilken.net" . 22)
    ("frm.twilken.net" . 22)
    ("btl.twilken.net" . 23022)
    ("twilkenlaptop.cern.ch" . 22022)))

(define* (tw-openssh-service host-name #:optional (work-system? #f))
  "Configure the SSH server for remote login."
  ;; SSH login, allowing access only for me.  To give more public keys
  ;; access, extend `openssh-service-type'.
  (service openssh-service-type
    (openssh-configuration
     (port-number (or (assoc-ref %ssh-ports host-name)
                      (error "No SSH port found for host" host-name)))
     (x11-forwarding? #t)
     (permit-root-login #f)
     (password-authentication? #f)
     (accepted-environment '("LANG" "LC_*"))
     (authorized-keys
      (if work-system?
          `(("twilken"
             ,(local-file "system/files/timo-cern.pub")))
          `(("timo"
             ,(local-file "system/files/timo.pub")
             ,(local-file "system/files/timo-phone-gpg.pub"))))))))

(define-public (tw-login-configuration config)
  "Patch the given `login-configuration' to my liking."
  (login-configuration
   (inherit config)
   ;; Delete the annoying message on SSH login.
   (motd (plain-file "no-motd" ""))
   ;; A blank installation has an empty root password.  Let me log in
   ;; after `guix system init'!
   (allow-empty-passwords? #t)))

(export server-wireguard-address)
(define* (server-wireguard-address host-name #:optional port #:key (ipv6? #f))
  (let ((ip (string-replace-substring
             ((if ipv6? cadr car)
              (wireguard-peer-allowed-ips
               (or (assoc-ref %wireguard-peers host-name)
                   (error "Unknown Wireguard spec for host" host-name))))
             (if ipv6? "/128" "/32") "")))
    (cond
     ((and port ipv6?) (format #f "[~a]:~a" ip port))
     (port (format #f "~a:~a" ip port))
     (else ip))))

(define system-base-packages-service
  (simple-service 'tw-base-packages profile-service-type
    (list acl acpi age btrfs-progs cpupower curl efibootmgr exfat-utils git
          glibc-locales hddtemp htop lshw lsof man-db man-pages man-pages-posix
          mlocate moreutils nss-mdns python restic rsync strace vim wireguard-tools)))

(define-public (server-base-services host-name)
  (cons*
   system-base-packages-service

   (tw-openssh-service host-name)

   ;; Prometheus node exporter
   (service prometheus-node-exporter-service-type
     (prometheus-node-exporter-configuration
      (web-listen-address
       (server-wireguard-address host-name 9100))))

   (simple-service 'guix-gc mcron-service-type
     (list #~(job "0 2 * * *" "guix gc -d 2w")))

   ;; Network setup
   (service dhcp-client-service-type)
   (service ntp-service-type)
   (service tw-wireguard-service-type
     (tw-wireguard-configuration
      (this-host host-name)))

   (modify-services (append %system-channel-services %base-services)
     (guix-service-type
      config =>
      (guix-configuration
       (inherit config)
       (channels %system-channels)))

     (login-service-type config => (tw-login-configuration config)))))

(define set-timezone-script
  ;; Every time we connect to a network, get our timezone from network geolocation.
  ;; https://wiki.archlinux.org/title/System_time
  ;; Wi-Fi regulatory domain is set automatically by NetworkManager when it connects to a network.
  (with-extensions (list guile-json-4 guile-gnutls)  ; guile-gnutls needed by (web client)
    #~(begin
        (use-modules ((srfi srfi-11) #:select (let-values))
                     ((ice-9 ports) #:select (call-with-output-file))
                     ((ice-9 textual-ports) #:select (get-string-all))
                     (ice-9 format)
                     (json)
                     (web client)
                     (web response))
        (define api-url "https://ipapi.co/json")
        (define headers '((user-agent . "tw-dotfiles/0.0 (abuse@twilken.net)")))
        ;; According to the Arch Wiki, when checking for "up" as the second
        ;; argument, VPN connections could cause undesired timezone changes.
        (when (and (string=? "connectivity-change" (caddr (command-line)))
                   (string=? "FULL" (getenv "CONNECTIVITY_STATE")))
          (let-values (((response body-port) (http-get api-url #:headers headers #:streaming? #t)))
            (unless (= 200 (response-code response))
              (error "Got error response to request:"
                     (response-code response) (get-string-all body-port)))
            (let ((json (json->scm body-port)))
              (when (assoc-ref json "error")
                (error "Got error response to request:"
                       (assoc-ref json "reason") (assoc-ref json "message")))
              ;; Set local timezone.
              (let* ((timezone (assoc-ref json "timezone"))
                     (zonefile (string-append #$tzdata "/share/zoneinfo/" timezone)))
                (delete-file "/etc/localtime")
                (symlink zonefile "/etc/localtime")
                (call-with-output-file "/etc/timezone"
                  (lambda (port)
                    (display timezone port)
                    (newline port)))
                (format (current-error-port)
                        "Updated timezone to ~a: success~%" timezone))))))))

;; This text is added verbatim to the Xorg config file.
(define touchpad-xorg-config "\
# see man 4 libinput
Section \"InputClass\"
    Identifier \"touchpad\"
    Driver \"libinput\"
    MatchIsTouchpad \"true\"

    Option \"DisableWhileTyping\" \"true\"
    Option \"MiddleEmulation\" \"true\"
    Option \"NaturalScrolling\" \"true\"
    Option \"HorizontalScrolling\" \"true\"
    Option \"ScrollMethod\" \"twofinger\"
    Option \"ClickMethod\" \"clickfinger\"
    Option \"Tapping\" \"true\"
    Option \"TappingDrag\" \"true\"
    Option \"TappingDragLock\" \"false\"
    Option \"TappingButtonMap\" \"lrm\"
EndSection
")

(define backlight-udev-rules
  ;; The naive approach of GROUP="video", MODE="0664" doesn't seem to work.
  ;; https://github.com/haikarainen/light/blob/master/90-backlight.rules
  ;; https://github.com/Hummer12007/brightnessctl/blob/master/90-brightnessctl.rules
  (udev-rule "90-backlight.rules" "\
ACTION!=\"remove\", SUBSYSTEM==\"backlight\", GROUP=\"video\", MODE=\"0664\"
ACTION!=\"remove\", SUBSYSTEM==\"leds\", GROUP=\"video\", MODE=\"0664\"
"))

(export enduser-system-services)
(define* (enduser-system-services
          #:key
          host-name cores wireless-interface backlight-device
          (wayland? #f)
          (work-system? #f)
          (xorg-extra-modules '())
          (xorg-drivers '())
          (xorg-extra-config '()))

  (unless (and (string? host-name)
               (number? cores)
               (string? wireless-interface)
               (string? backlight-device)
               (list? xorg-extra-modules)
               (list? xorg-drivers)
               (list? xorg-extra-config))
    (error "Invalid argument type"))

  (cons*
   system-base-packages-service
   (simple-service 'tw-enduser-packages profile-service-type
     (list cups docker mit-krb5 pulseaudio dosfstools mtools ntfs-3g
           ;; Install window manager here so gdm can see its xsession file.
           (if wayland? swayfx i3-wm)))

   (simple-service 'screen-locker pam-root-service-type
     (list (pam-service
            (name (if wayland? "swaylock" "i3lock"))
            (auth (list (pam-entry (control "include") (module "login")))))))

   (service docker-service-type)

   (service containerd-service-type)  ; required by `docker-service-type'

   (service krb5-service-type
     (krb5-configuration
      (default-realm "CERN.CH")
      (rdns? #f)
      (realms (list (krb5-realm
                     (name "CERN.CH")
                     (default-domain "cern.ch")
                     (kdc "cerndc.cern.ch"))))))

   (service thermald-service-type
     (thermald-configuration
      (adaptive? #t)))

   (service earlyoom-service-type
     (earlyoom-configuration))  ; TODO: configure at least `avoid-regexp'

   ;; Allow anyone in the "video" group to set the display's brightness.
   ;; Run `udevadm info -q all /sys/class/backlight/*' to see properties.
   (udev-rules-service 'backlight backlight-udev-rules #:groups '("video"))
   ;; According to "info '(guix) Base Services'", the above should
   ;; have a `#:groups '("video")', but that group is already
   ;; declared as a supplementary group for my user and guix warns
   ;; that it's declared twice.

   (simple-service 'xbacklight-services shepherd-root-service-type
     (list
      (shepherd-service
       (documentation "Set laptop screen backlight on boot.")
       (provision '(backlight))
       (one-shot? #t)
       (start #~(make-forkexec-constructor
                 (list #$(program-file "backlight-setter"
                           (let ((sys-directory (string-append "/sys/class/backlight/" backlight-device)))
                             #~(begin
                                 (use-modules ((ice-9 textual-ports) #:select (get-string-all))
                                              ((srfi srfi-26) #:select (cut)))
                                 (define brightness-file #$(string-append sys-directory "/brightness"))
                                 (define max-brightness-file #$(string-append sys-directory "/max_brightness"))
                                 ;; These files don't exist right after startup, so wait for them to appear.
                                 (while (not (and (file-exists? max-brightness-file)
                                                  (file-exists? brightness-file)))
                                   (format (current-error-port) "Waiting for /sys files to appear...~%")
                                   (sleep 1))
                                 (define max-brightness
                                   (call-with-input-file max-brightness-file get-string-all))
                                 (call-with-output-file brightness-file
                                   (cut display max-brightness <>)))))))))))

   ;; gnome-keyring is not in `%desktop-services' by default,
   ;; but needs to be there to add itself to /etc/pam.d/.
   ;; If using a DM other than GDM, add it to `pam-services' in
   ;; `gnome-keyring-configuration' (see its docs).
   (service gnome-keyring-service-type)

   (udev-rules-service 'android android-udev-rules #:groups '("adbusers"))

   (service cups-service-type
     (cups-configuration
      (web-interface? #t)
      (default-shared? #f)
      ;; See info '(guix)Printing Services' for more extensions.
      (extensions
       (list cups-filters foomatic-filters brlaser))))

   (simple-service 'scanning-services shepherd-root-service-type
     (list
      (shepherd-service
       (documentation "Expose USB scanners over IPP.")
       (provision '(ipp-usb))
       (requirement '(networking))   ; only on localhost, though
       (start #~(make-forkexec-constructor
                 (list #$(file-append ipp-usb "/bin/ipp-usb") "standalone")))
       (stop #~(make-kill-destructor)))))

   (extra-special-file "/etc/NetworkManager/dispatcher.d/09-set-timezone"
     (program-file "set-timezone" set-timezone-script))

   (service tw-wireguard-service-type
     (tw-wireguard-configuration
      (this-host host-name)))

   (tw-openssh-service host-name work-system?)

   ;; Since Guix 953c65ffdd4, build-machines can be directly specified in
   ;; `guix-configuration'. However, this doesn't allow the dynamic
   ;; selection of build machines as is done here.
   (extra-special-file "/etc/guix/machines.scm"
     (scheme-file "machines.scm"
       (if work-system?
           #~'()  ; work machine doesn't have the required SSH keys for lud or vin
           #~(let ((lud (build-machine
                         (name "lud.twilken.net")
                         (systems '("x86_64-linux"))
                         (port '#$(assoc-ref %ssh-ports "lud.twilken.net"))
                         (host-key "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIGqXbxv3a2bZyGjnEirVCMtRBeLKW/ha8ULSR9Xye4Z1")
                         (user "timo")
                         (private-key "/home/timo/.local/share/ssh-keys/id_ed25519")
                         (speed '#$(/ 4 cores))))   ; 4 cores, 16 GB RAM
                   (vin (build-machine
                         (name "vin.twilken.net")
                         (systems '("x86_64-linux"))
                         (port '#$(assoc-ref %ssh-ports "vin.twilken.net"))
                         (host-key "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIEEpdfKxzoCwg53TKPF5YxgUwhGF+bELAyBGdxagQroJ")
                         (user "timo")
                         (private-key "/home/timo/.local/share/ssh-keys/id_ed25519")
                         (speed '#$(/ 8 cores)))))  ; 8 cores, 16 GB RAM
               (use-modules (ice-9 popen)
                            (ice-9 textual-ports)
                            (ice-9 regex))
               (let* ((regexp (make-regexp "^GENERAL\\.CONNECTION:[[:space:]]+TLAN$" regexp/newline))
                      (pipe (open-pipe* OPEN_READ #$(file-append network-manager "/bin/nmcli")
                                        "device" "show" #$wireless-interface))
                      (at-home? (regexp-exec regexp (get-string-all pipe))))
                 (close-pipe pipe)
                 ;; Only offload to vin when at home, as the network connection is too bad otherwise.
                 (if at-home?
                     (list vin)
                     (list lud)))))))

   (simple-service 'disk-maintenance mcron-service-type
     ;; I don't think jobs run on boot if they would have run when the
     ;; computer was turned off, so choose a time when the computer is
     ;; probably turned on.
     (list #~(job "45 21 * * *" "guix gc -d 2w -F 25G")  ; after unattended-upgrade
           #~(job "0 22 * * *"  ; after guix gc
                  (string-append #$(file-append util-linux "/sbin/fstrim")
                                 " --fstab --verbose"))))

   (if wayland?
       (wayland-enduser-base-services)
       (x11-enduser-base-services work-system? xorg-extra-modules xorg-drivers xorg-extra-config))))

(define enduser-base-services
  (modify-services (append %system-channel-services %desktop-services)
    (guix-service-type
     config =>
     (guix-configuration
      (inherit config)
      (channels %system-channels)))

    ;; Let sane find the airscan backend. ipp-usb needs to be running separately.
    (sane-service-type _ => sane-backends/airscan)

    (geoclue-service-type
     config =>
     (geoclue-configuration
      (inherit config)
      (applications
       (cons* (geoclue-application "redshift" #:system? #f)
              %standard-geoclue-applications))))

    (login-service-type config => (tw-login-configuration config))))

(define (x11-enduser-base-services work-system? xorg-extra-modules xorg-drivers xorg-extra-config)
  (define xorg-config
    (xorg-configuration
     (keyboard-layout %british-keyboard)
     (extra-config (cons touchpad-xorg-config xorg-extra-config))
     (modules (append xorg-extra-modules %default-xorg-modules))
     (drivers xorg-drivers)))

  (cons*
   (set-xorg-configuration xorg-config)
   (modify-services enduser-base-services
     (gdm-service-type
      config =>
      (gdm-configuration
       (inherit config)
       (auto-login? #f)
       (default-user (if work-system? "twilken" "timo"))
       (xorg-configuration xorg-config))))))

(define (wayland-enduser-base-services)
  (cons*
   (service greetd-service-type
     (greetd-configuration
      (terminals
       (list (greetd-terminal-configuration
              (terminal-switch #t)
              (default-session-command
                (greetd-wlgreet-sway-session
                 (sway swayfx)
                 (sway-configuration %sway-common-configuration)
                 (wlgreet-session
                  (greetd-wlgreet-session
                   (command (file-append swayfx "/bin/sway"))
                   (scale 1)   ; TODO
                   ;; Catppuccin colours.
                   ;; Note: if these are Guile rationals, they will be written
                   ;; to wlgreet.toml in fractional form and wlgreet will crash.
                   (background '(0.12 0.12 0.18 1.0))       ; base
                   (headline '(0.80 0.84 0.95 1.0))         ; text
                   (prompt '(0.80 0.84 0.95 1.0))           ; text
                   (prompt-error '(0.97 0.88 0.68 1.0))     ; yellow
                   (border '(0.35 0.36 0.44 1.0)))))))))))  ; sway window border
   (modify-services enduser-base-services
     ;; Not needed for pure Wayland, but Zoom uses xwayland.
     ;; (delete x11-socket-directory-service-type)
     (delete gdm-service-type))))