(define-module (metznet system base-system)
  #:use-module (guix gexp)

  #:use-module (metznet golang)

  #:use-module (gnu bootloader)
  #:use-module (gnu bootloader grub)
  #:use-module (gnu system accounts)
  #:use-module (gnu system shadow)
  #:use-module (gnu system setuid)
  #:use-module (gnu services configuration)
  #:use-module (gnu system file-systems)
  #:use-module (gnu system)
  #:use-module (gnu system nss)
  #:use-module (gnu services kerberos)
  #:use-module (metznet services sssd)
  #:use-module (gnu services base)
  #:use-module (gnu services sddm)
  #:use-module (gnu services xorg)
  #:use-module (gnu services)
  #:use-module (gnu services desktop)
  #:use-module (gnu services networking)
  #:use-module (gnu services ssh)
  #:use-module (gnu services vpn)
  #:use-module (gnu system pam)
  #:use-module (gnu services dbus)
  #:use-module (gnu system keyboard)
  #:use-module (gnu packages admin)

  #:use-module (metznet packages slapd)
  #:use-module (gnu packages linux)

  #:use-module (gnu packages shells)
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages ssh)
  #:use-module (gnu packages dns)
  #:use-module (gnu packages version-control)
  #:use-module (gnu packages vim)
  #:use-module (gnu packages certs)
  #:use-module (gnu packages kerberos)
  #:use-module (gnu packages vpn)
  #:use-module (gnu packages wm)
  #:use-module (gnu packages suckless)
  #:use-module (gnu packages terminals)
  #:use-module (gnu packages gnuzilla)

  #:export (%metznet-base-user-accounts)
  #:export (%metznet-base-groups)

  #:export (%metznet-desktop-packages)
  #:export (%metznet-base-packages)

  #:export (%kvm-udev-rule)
  #:export (%usb-udev-rule)
  #:export (%tun-udev-rule)

  #:export (%metznet-desktop-services)
  #:export (%metznet-server-services)

  #:export (metznet-service-type)
  #:export (metznet-system-configuration)

  #:export (%metznet-base-server-system)
  #:export (%metznet-base-desktop-system))

(define %domain-realm
  "METZNET.CA")

(define %domain-name
  "metznet.ca")

(define %domain-kadmin
  (string-append "kerberos." %domain-name))

(define %domain-kdc
  (string-append "kerberos." %domain-name))

(define %metznet-base-user-accounts
  (append (list (user-account
                  (name "root")
                  (group "root")
                  (uid 0)
                  (password (let ((env-pw (getenv "GUIX_ROOT_PW")))
                              (if env-pw
                                  (crypt env-pw "$6$salt") "!")))
                  (shell (file-append zsh "/bin/zsh")))) %base-user-accounts))

(define %metznet-base-groups
  (append (list (user-group
                  (system? #t)
                  (name "realtime"))
                (user-group
                  (system? #t)
                  (name "usb"))) %base-groups))

(define %metznet-base-packages
  (append (list openssh

                openldap-slapd
                strace

                git
                neovim
                zsh
                le-certs
                nss-certs
                mit-krb5) %base-packages))

(define %metznet-desktop-packages
  (append (list i3-wm i3status dmenu kitty icecat) %metznet-base-packages))

(define %desktop-setuid-programs
  (append (list (setuid-program
                  (program #~(string-append #$openvpn "/sbin/openvpn")))
                (setuid-program
                  (program #~(string-append #$openresolv "/sbin/resolvconf"))))
          %setuid-programs))

(define %metznet-krb5-config
  (krb5-configuration (default-realm %domain-realm)
                      (allow-weak-crypto? #t)
                      (rdns? #f)
                      (realms (list (krb5-realm (name %domain-realm)
                                                (admin-server %domain-kadmin)
                                                (kdc %domain-kdc))))))

(define %default-keyboard-layout
  (keyboard-layout "us"))

(define %kvm-udev-rule
  (udev-rule "65-kvm.rules"
             "KERNEL==\"KVM\", GROUP=\"libvirt\", MODE=\"0660\""))

(define %usb-udev-rule
  (udev-rule "51-usb.rules"
             (string-append "SUBSYSTEM==\"usb\", GROUP=\"usb\"\n"
                            "SUBSYSTEM==\"usbmisc\", GROUP=\"usb\"")))

(define %tun-udev-rule
  (udev-rule "90-tun.rules"
   "KERNEL==\"tun\", GROUP=\"netdev\", MODE=\"0660\", OPTIONS+=\"static_node=net/tun\""))

(define %backlight-udev-rule
  (udev-rule "55-backlight.rules"
   "RUN+=\"/bin/chgrp video /sys/class/backlight/intel_backlight/brightness\""))

(define %metznet-name-service-switch
  (let ((services (list (name-service (name "sss"))
                        (name-service (name "files")))))
    (name-service-switch (password services)
                         (shadow services)
                         (group services))))

(define list-of-strings?
  (list-of string?))

(define-maybe/no-serialization string)

(define (file-like-pair? val)
  (let ((name (car val))
        (file (cdr val)))
    (and (string? name)
         (file-like? file))))

(define alist-of-file-like?
  (list-of file-like-pair?))

(define-maybe file-like)

(define-configuration/no-serialization metznet-system-configuration
                                       (certs (file-like le-certs)
                                              "certificate package")
                                       (user-shells (alist-of-file-like (list (cons
                                                                               "/bin/zsh"
                                                                               zsh)))
                                                    "user shells to link")
                                       (pam-services (list-of-strings (list
                                                                       "su"
                                                                       "sddm"
                                                                       "login"
                                                                       "sshd"
                                                                       "passwd"))
                                        "list of pam services to configure"))

(define (pam-mkhomedir-service configuration)
  (pam-extension (transformer (lambda (pam)
                                (if (member (pam-service-name pam)
                                            (metznet-system-configuration-pam-services
                                             configuration))
                                    (let ((required (pam-entry (control
                                                                "required")
                                                               (module
                                                                "pam_mkhomedir.so"))))
                                      (pam-service (inherit pam)
                                                   (session (cons required
                                                                  (pam-service-account
                                                                   pam)))))
                                    pam)))))

(define (pam-mkhomedir-services configuration)
  (list (pam-mkhomedir-service configuration)))

(define (shell-paths configuration)
  (map car
       (metznet-system-configuration-user-shells configuration)))

(define (shell-packages configuration)
  (map cdr
       (metznet-system-configuration-user-shells configuration)))

(define (metznet-activation configuration)
  #~(begin
      (let ((root (getpw "root")))
        (mkdir-p/perms "/var/lib/openvpn" root 448))
      (for-each (lambda (path package)
                  (unless (access? path F_OK)
                    (symlink (string-append package path) path)))
                (list #$@(shell-paths configuration))
                (list #$@(shell-packages configuration)))))

(define-public metznet-service-type
  (service-type (name 'metznet-service)
                (description "MetzNet Services")
                (extensions (list (service-extension activation-service-type
                                                     metznet-activation)
                                  (service-extension profile-service-type
                                                     (compose list
                                                      metznet-system-configuration-certs))
                                  (service-extension pam-root-service-type
                                                     pam-mkhomedir-services)))
                (default-value (metznet-system-configuration))))

(define %metznet-sssd-configuration
  (sssd-configuration (domains (list (cons "metznet.ca"
                                           (sssd-domain-configuration (id_provider
                                                                       "ldap")
                                                                      (debug_level "10")
                                                                      (auth_provider
                                                                       "ldap")
                                                                      (cache_credentials
                                                                       #t)
                                                                      (ldap_schema "rfc2307bis")
                                                                      (ldap_group_member
                                                                        "member")
                                                                      (ldap_group_object_class
                                                                        "posixGroupAux")
                                                                      (ldap_uri
                                                                       "ldaps://ldap.metznet.ca")
                                                                      (ldap_tls_reqcert
                                                                       "never")
                                                                      (ldap_tls_cacertdir
                                                                       "/etc/ssl/certs")
                                                                      (ldap_search_base
                                                                       "dc=metznet,dc=ca")
                                                                      (ldap_default_bind_dn
                                                                       (or (getenv
                                                                            "LDAP_BIND_DN")
                                                                        "uid=guix,ou=system,ou=accounts,dc=metznet,dc=ca"))
                                                                      (ldap_default_authtok_type
                                                                       (or (getenv
                                                                            "LDAP_AUTHTOK_TYPE")
                                                                        "password"))
                                                                      (ldap_default_authtok
                                                                       (or (getenv
                                                                            "LDAP_AUTHTOK")
                                                                        %unset-value))))))))

(define pubkey-command
  (program-file "pubkey-command"
                (with-imported-modules '((guix build utils))
                                       #~(begin
                                           (use-modules (guix build utils)
                                                        (ice-9 format)
                                                        (ice-9 popen)
                                                        (ice-9 textual-ports))
                                           (define* (shell-command-to-string
                                                     cmd)
                                             (catch 'shell-command-error
                                                    (lambda ()
                                                      (let* ((port (open-pipe
                                                                    cmd
                                                                    OPEN_READ))
                                                             (str (get-string-all
                                                                   port))
                                                             (wtpd (close-pipe
                                                                    port))
                                                             (xval (status:exit-val
                                                                    wtpd)))
                                                        (if (or (eqv? xval #f)
                                                                (> xval 0))
                                                            (throw 'shell-command-error
                                                                   cmd str))
                                                        str))
                                                    (lambda (key cmd str)
                                                      (simple-format #t
                                                       "ERROR: in command ~a\nstring: ~a\n"
                                                       cmd str)
                                                      (throw 'error-in-shell-command-to-string
                                                             cmd str))))

                                           (display (shell-command-to-string (string-join
                                                                              (list #$
                                                                               (file-append
                                                                                metznet-pubkey
                                                                                "/bin/pubkey")
                                                                               "ldaps://ldap.metznet.ca"
                                                                               "uid=guix,ou=system,ou=accounts,dc=metznet,dc=ca"
                                                                               #$
                                                                               (or
                                                                                (getenv
                                                                                 "LDAP_AUTHTOK")
                                                                                "")
                                                                               "dc=metznet,dc=ca"
                                                                               
                                                                               (list-ref
                                                                                (command-line)
                                                                                1))
                                                                              " ")))))))

(define %metznet-services
  (list (service openssh-service-type
                 (openssh-configuration (password-authentication? #f)
                                        (extra-content #~(string-join (list
                                                                       "AuthorizedKeysCommandUser root"
                                                                       (string-append
                                                                        "AuthorizedKeysCommand "
                                                                        #$pubkey-command)
                                                                       "KerberosAuthentication yes")
                                                                      "\n"))))
        (service krb5-service-type %metznet-krb5-config)
        (service pam-krb5-service-type
                 (pam-krb5-configuration (pam-krb5 pam-krb5)
                                         (minimum-uid 1000)))
        (service sssd-service-type %metznet-sssd-configuration)
        (service metznet-service-type)))

(define %metznet-nscd-configuration
  (nscd-configuration (caches (append (list (nscd-cache (database 'passwd)
                                                        (positive-time-to-live
                                                         (* 3600 12))
                                                        (negative-time-to-live
                                                         20)
                                                        (persistent? #t))
                                            (nscd-cache (database 'group)
                                                        (positive-time-to-live
                                                         (* 3600 12))
                                                        (negative-time-to-live
                                                         20)
                                                        (persistent? #t)))
                                      %nscd-default-caches))))

(define %metznet-desktop-services
  (append %metznet-services (list (service sddm-service-type (sddm-configuration)))
          (modify-services %desktop-services
            (delete gdm-service-type)
            (nscd-service-type config => %metznet-nscd-configuration)
            (network-manager-service-type config =>
                                          (network-manager-configuration (inherit
                                                                          config)
                                                                         (vpn-plugins
                                                                          (list
                                                                           network-manager-openvpn)))))))

(define %base-services-nscd
  (modify-services %base-services
    (nscd-service-type config => %metznet-nscd-configuration)))

(define %server-services
  (append %metznet-services
          (list (service dbus-root-service-type)
                (service dhcp-client-service-type)
                (service openvpn-client-service-type
                         (openvpn-client-configuration (ca
                                                        "/var/lib/openvpn/ca.crt")
                                                       (cert
                                                        "/var/lib/openvpn/client.crt")
                                                       (key
                                                        "/var/lib/openvpn/client.key")
                                                       (tls-auth
                                                        "/var/lib/openvpn/ta.key")
                                                       (persist-key? #f)
                                                       (remote (list (openvpn-remote-configuration
                                                                      (name
                                                                       "vpn.metznet.ca")))))))))

(define %metznet-server-services
  (append %server-services %base-services-nscd))

(define %metznet-base-server-system
  (operating-system
    (host-name "metznet-base-server")
    (timezone "America/Edmonton")
    (locale "en_CA.utf8")
    (keyboard-layout %default-keyboard-layout)
    (name-service-switch %metznet-name-service-switch)
    (kernel-arguments (append '("console=ttyS0") %default-kernel-arguments))
    (bootloader (bootloader-configuration
                  (bootloader grub-efi-bootloader)
                  (targets '("/boot/efi"))
                  (keyboard-layout keyboard-layout)))
    (file-systems (cons* (file-system
                           (mount-point "/")
                           (device (file-system-label "guix-data"))
                           (type "ext4")
                           (check? #f))
                         (file-system
                           (mount-point "/boot/efi")
                           (device (file-system-label "guix-boot"))
                           (type "fat32")
                           (check? #f)) %base-file-systems))
    (users %metznet-base-user-accounts)
    (groups %metznet-base-groups)
    (packages %metznet-base-packages)
    (services
     %metznet-server-services)))

(define %metznet-base-desktop-system
  (operating-system
    (inherit %metznet-base-server-system)
    (host-name "metznet-base-desktop")
    (setuid-programs %desktop-setuid-programs)
    (packages %metznet-desktop-packages)
    (services
     %metznet-desktop-services)))