service modules: rework desktop base not to include gdm

1 files changed, 177 insertions, 2 deletions

diff --git a/px/services/desktop.scm b/px/services/desktop.scm
index 2ce403d..73ebdfd 100644
--- a/px/services/desktop.scm
+++ b/px/services/desktop.scm
@@ -9,6 +9,8 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages xdisorg)
+  #:use-module (gnu packages libusb)
+  #:use-module (gnu packages nfs)
   #:use-module (gnu services)
   #:use-module (gnu services avahi)
   #:use-module (gnu services base)
@@ -17,11 +19,14 @@
   #:use-module (gnu services desktop)
   #:use-module (gnu packages gnome)
   #:use-module (gnu packages lxqt)
+  #:use-module (gnu packages security-token)
   #:use-module (gnu services networking)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services sddm)
   #:use-module (gnu services ssh)
   #:use-module (gnu services xorg)
+  #:use-module (gnu services sound)
+  #:use-module (gnu services pm)
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
   #:use-module (guix build utils)
@@ -29,7 +34,9 @@
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (px packages desktop)
+  #:use-module (px services security-token)
   #:use-module (srfi srfi-1)
+  #:use-module (guix utils)
   #:use-module (ice-9 match)
   #:export (px-desktop-configuration
             px-desktop-configuration?
@@ -38,7 +45,9 @@
             polkit-network-manager-service
             polkit-elogind-service
 
-            create-swap-space-service))
+            create-swap-space-service
+            
+            %px-desktop-services-base))
 
 ;;
 ;; PantherX desktop service type
@@ -121,4 +130,170 @@ rules."
 ")))))
 
 (define polkit-elogind-service
-  (simple-service 'polkit-login polkit-service-type (list polkit-loginctl)))
\ No newline at end of file
+  (simple-service 'polkit-login polkit-service-type (list polkit-loginctl)))
+
+(define (make-firewall-rules open-ports)
+
+  (define (make-port-rules open-ports status)
+    "Generate list of strings each is a port/service rule for nftables"
+    (reduce-right append '()
+                  (map (match-lambda
+                         ((protocol ports ...)
+                          (map (lambda (port)
+                                 (string-append "    " protocol " dport " port " " status))
+                               ports)))
+                       open-ports)))
+
+  (let ((port-rules (make-port-rules open-ports "accept")))
+    (plain-file "nftables"
+                (string-append "#PantherX firewall rules\n"
+                               "table inet filter {\n"
+                               "  chain input {\n"
+                               "    type filter hook input priority 0; policy drop;\n"
+                               "    # early drop of invalid connections\n"
+                               "    ct state invalid drop\n"
+                               "    # allow established/related connections\n"
+                               "    ct state { established, related } accept\n"
+                               "    # allow from loopback\n"
+                               "    iifname lo accept\n"
+                               "    # allow icmp\n"
+                               "    ip protocol icmp accept\n"
+                               "    ip6 nexthdr icmpv6 accept\n"
+                               (string-join port-rules "\n" 'suffix)
+                               "    # reject everything else\n"
+                               "    reject with icmpx type port-unreachable\n"
+                               "  }\n"
+                               "  chain forward {\n"
+                               "    type filter hook forward priority 0; policy drop;\n"
+                               "  }\n"
+                               "  chain output {\n"
+                               "    type filter hook output priority 0; policy accept;\n"
+                               "  }\n"
+                               "}\n"))))
+
+
+(define* (desktop-services-for-system #:optional
+                                      (system (or (%current-target-system)
+                                                  (%current-system))))
+  ;; List of services typically useful for a "desktop" use case.
+
+  ;; Since GDM depends on Rust (gdm -> gnome-shell -> gjs -> mozjs -> rust)
+  ;; and Rust is currently unavailable on non-x86_64 platforms, default to
+  ;; SDDM there (FIXME).
+  (cons*  (service sddm-service-type)
+
+          ;; Screen lockers are a pretty useful thing and these are small.
+          (service screen-locker-service-type
+            (screen-locker-configuration
+              (name "xlock")
+              (program (file-append xlockmore "/bin/xlock"))))
+
+          ;; Add udev rules for MTP devices so that non-root users can access
+          ;; them.
+          (simple-service 'mtp udev-service-type (list libmtp))
+          ;; Add udev rules for scanners.
+          (service sane-service-type)
+          ;; Add polkit rules, so that non-root users in the wheel group can
+          ;; perform administrative tasks (similar to "sudo").
+          polkit-wheel-service
+
+          ;; Allow desktop users to also mount NTFS and NFS file systems
+          ;; without root.
+          (simple-service 'mount-setuid-helpers setuid-program-service-type
+                          (map (lambda (program)
+                                  (setuid-program
+                                  (program program)))
+                                (list (file-append nfs-utils "/sbin/mount.nfs")
+                                (file-append ntfs-3g "/sbin/mount.ntfs-3g"))))
+
+          ;; This is a volatile read-write file system mounted at /var/lib/gdm,
+          ;; to avoid GDM stale cache and permission issues.
+          gdm-file-system-service
+
+          ;; The global fontconfig cache directory can sometimes contain
+          ;; stale entries, possibly referencing fonts that have been GC'd,
+          ;; so mount it read-only.
+          fontconfig-file-system-service
+
+          ;; NetworkManager and its applet.
+          (service network-manager-service-type)
+          (service wpa-supplicant-service-type)    ;needed by NetworkManager
+          (simple-service 'network-manager-applet
+                          profile-service-type
+                          (list network-manager-applet))
+          (service modem-manager-service-type)
+          (service usb-modeswitch-service-type)
+
+          ;; The D-Bus clique.
+          (service avahi-service-type)
+          (service udisks-service-type)
+          (service upower-service-type)
+          (service accountsservice-service-type)
+          (service cups-pk-helper-service-type)
+          (service colord-service-type)
+          (service geoclue-service-type)
+          (service polkit-service-type)
+          (service elogind-service-type)
+          (service dbus-root-service-type)
+
+          (service ntp-service-type)
+
+          (service x11-socket-directory-service-type)
+
+          (service pulseaudio-service-type)
+          (service alsa-service-type)
+
+          ;; PantherX Specific
+          (simple-service 'custom-udev-rules
+                      udev-service-type
+                      (list libu2f-host))
+
+          (ledger-wallet-service)
+          (nitro-key-service)
+
+          ;; Power savings
+          (service tlp-service-type)
+
+          ;; Bluetooth service
+          ;; (bluetooth-service #:auto-enable? #t)
+          (service bluetooth-service-type
+                  (bluetooth-configuration
+                    (auto-enable? #t)))
+
+          ;; Prevent overheating
+          ;; TLP does not conflict with thermald.
+          (service thermald-service-type)
+
+          ; Display manager
+          (service sddm-service-type
+                  (sddm-configuration
+                    (minimum-uid 1000)
+                    (theme "px-sddm-theme")))
+
+          ;; Printing
+          (service cups-service-type
+                  (cups-configuration
+                    (web-interface? #t)
+                    (browsing? #t)
+                    (default-paper-size "a4")))
+
+          ;; Keychain
+          (service gnome-keyring-service-type
+                  (gnome-keyring-configuration
+                    (pam-services '(("passwd" . passwd)
+                                    ("sddm" . login)))))
+
+          ;; SSH is enabled by default but only with SSH key
+          (service openssh-service-type
+                  (openssh-configuration
+                    (permit-root-login 'prohibit-password)))
+
+          ;; Firewall
+          (service nftables-service-type
+                  (nftables-configuration
+                    (ruleset (make-firewall-rules '()))))
+
+         %base-services))
+
+(define-syntax %px-desktop-services-base
+  (identifier-syntax (desktop-services-for-system)))
\ No newline at end of file