path: root/tw/system.scm

(define-module (tw system)
  #:use-module (ice-9 string-fun)
  #: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 scanner)
  #:use-module (tw services wireguard))

(use-package-modules acl admin android avahi backup certs cups curl disk
                     docker file-systems gnome golang guile kerberos linux
                     lsof man moreutils mtools pulseaudio python rsync search
                     shells tls 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 %base-system-packages
  (cons* 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-certs nss-mdns python restic rsync strace
         wireguard-tools
         %base-packages))

(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" "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)))

(define (tw-openssh-service host-name)
  "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 (assoc-ref %ssh-ports host-name))
     (x11-forwarding? #t)
     (permit-root-login #f)
     (password-authentication? #f)
     (accepted-environment '("LANG" "LC_*"))
     (authorized-keys
      `(("timo"
         ,(local-file "system/files/timo.pub")
         ,(local-file "system/files/timo-phone-gpg.pub")))))))

(define (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
               (assoc-ref %wireguard-peers 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-public (server-base-services host-name)
  (cons*
   (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)
     (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
  ;; https://wiki.archlinux.org/title/Network_configuration/Wireless#Respecting_the_regulatory_domain
  (with-extensions (list guile-json-4 guile-gnutls)  ; guile-gnutls needed by (web client)
    #~(begin
        (use-modules ((srfi srfi-11) #:select (let-values))
                     (json)
                     (web client)
                     (web response))
        (define api-url "https://ipapi.co/json")
        ;; 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 text) (http-get api-url)))
            (unless (= 200 (response-code response))
              (error "Got error response to request:" response))
            (let* ((json (json-string->scm text))
                   (timezone (assoc-ref json "timezone"))
                   (zonefile (string-append #$tzdata "/share/zoneinfo/" timezone))
                   (regdb-country (assoc-ref json "country_code"))
                   (error-code
                    (status:exit-val
                     ;; Set WiFi regulatory domain to use the correct channels.
                     (system* #$(file-append iw "/bin/iw") "reg" "set" regdb-country))))
              (format (current-error-port) "Updated WiFi regdomain to ~a: ~a~%"
                      regdb-country (if (zero? error-code) "success"
                                        (format #f "error ~d" error-code)))
              ;; Set local timezone.
              (delete-file "/etc/localtime")
              (symlink zonefile "/etc/localtime")
              (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\"
"))

(define-public %enduser-system-packages
  (cons*
   cups docker mit-krb5
   pulseaudio
   dosfstools mtools ntfs-3g
   i3-gaps  ; install i3 here so gdm can see its xsession file
   ;; We need to install gnome-keyring here so its PAM module is
   ;; enabled properly (by its service; see below).
   ;; nheko needs gnome-keyring to store secrets (kwallet doesn't do dbus).
   gnome-keyring
   ;; It's probably easiest to install geoclue system-wide, so it
   ;; gets added to `%desktop-services' and redshift can access the
   ;; location.
   geoclue
   %base-system-packages))

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

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

  (define xorg-config
    (xorg-configuration
     (keyboard-layout %british-keyboard)
     (extra-config (list touchpad-xorg-config))
     (modules (append xorg-extra-modules %default-xorg-modules))
     (drivers xorg-drivers)))

  (cons*
   (service 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'

   (set-xorg-configuration xorg-config)

   ;; Install i3lock as a setuid binary, so it can talk to PAM.
   (service screen-locker-service-type
     (screen-locker-configuration
      (name "i3lock")
      (program (file-append i3lock "/bin/i3lock"))))

   ;; 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)

   ;; 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"
       #~(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"))))

   (modify-services (append %system-channel-services %desktop-services)
     ;; Let sane find the airscan backend. ipp-usb needs to be running separately.
     (sane-service-type _ => sane-backends/airscan)

     (gdm-service-type
      config =>
      (gdm-configuration
       (inherit config)
       (auto-login? #f)
       (default-user "timo")
       (xorg-configuration xorg-config)))

     (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)))))