;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 David Craven <david@craven.ch>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services sddm)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages freedesktop)
  #:use-module (gnu packages hawaii)
  #:use-module (gnu packages xorg)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services xorg)
  #:use-module (gnu system pam)
  #:use-module (gnu system shadow)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:export (sddm-configuration
            sddm-confiugration?
            sddm-service-type
            sddm-service))

(define-record-type* <sddm-configuration>
  sddm-configuration      make-sddm-configuration
  sddm-configuration?
  (sddm                   sddm-configuration-sddm
                          (default sddm))
  (allow-empty-passwords? sddm-configuration-allow-empty-passwords?
                          (default #t))

  ;; [General]
  ;; valid values are x11 and wayland
  ;; currently doesn't do anything is enabled by wayland greeter PR
  (display-server         sddm-configuration-display-server
                          (default "x11"))
  ;; valid values are on, off or none
  (numlock                sddm-configuration-numlock
                          (default "on"))
  (halt-command           sddm-configuration-halt-command
                          (default #~(string-append #$shepherd "/sbin/halt")))
  (reboot-command         sddm-configuration-reboot-command
                          (default #~(string-append #$shepherd "/sbin/reboot")))

  ;; [Theme]
  ;; valid values are elarun or maldives
  (theme                  sddm-configuration-theme
                          (default "maldives"))
  (themes-directory       sddm-configuration-themes-directory
                          (default #~(string-append #$sddm "/share/sddm/themes")))
  (faces-directory        sddm-configuration-faces-directory
                          (default #~(string-append #$sddm "/share/sddm/faces")))

  ;; [Users]
  (default-path           sddm-configuration-default-path
                          (default "/run/current-system/profile/bin"))
  (minimum-uid            sddm-configuration-minimum-uid
                          (default 1000))
  (maximum-uid            sddm-configuration-maximum-uid
                          (default 2000))
  (remember-last-user?    sddm-configuration-remember-last-user?
                          (default #t))
  (remember-last-session? sddm-configuration-remember-last-session?
                          (default #t))
  (hide-users             sddm-configuration-hide-users
                          (default ""))
  (hide-shells            sddm-configuration-hide-shells
                          (default #~(string-append #$shadow "/sbin/nologin")))

  ;; [Wayland]
  (session-command        sddm-configuration-session-command
                          (default #~(string-append #$sddm "/share/sddm/scripts/wayland-session")))
  (sessions-directory     sddm-configuration-sessions-directory
                          (default "/run/current-system/profile/share/wayland-sessions"))
  ;; [X11]
  (xorg-server-path       sddm-configuration-xorg-server-path
                          (default (xorg-start-command)))
  (xauth-path             sddm-configuration-xauth-path
                          (default #~(string-append #$xauth "/bin/xauth")))
  (xephyr-path            sddm-configuration-xephyr-path
                          (default #~(string-append #$xorg-server "/bin/Xephyr")))
  (xdisplay-start         sddm-configuration-xdisplay-start
                          (default #~(string-append #$sddm "/share/sddm/scripts/Xsetup")))
  (xdisplay-stop          sddm-configuration-xdisplay-stop
                          (default #~(string-append #$sddm "/share/sddm/scripts/Xstop")))
  (xsession-command       sddm-configuration-xsession-command
                          (default (xinitrc)))
  (xsessions-directory    sddm-configuration-xsessions-directory
                          (default "/run/current-system/profile/share/xsessions"))
  (minimum-vt             sddm-configuration-minimum-vt
                          (default 7))
  (xserver-arguments      sddm-configuration-xserver-arguments
                          (default "-nolisten tcp"))

  ;; [Autologin]
  (auto-login-user        sddm-configuration-auto-login-user
                          (default ""))
  (auto-login-session     sddm-configuration-auto-login-session
                          (default ""))
  (relogin?               sddm-configuration-relogin?
                          (default #f)))

(define (sddm-configuration-file config)
  ;; [XDisplay] -> [X11] in sddm 0.14.0
  ;; [WaylandDisplay] -> [Wayland] in sddm 0.14.0
  (mixed-text-file "sddm.conf" "
[General]
DisplayServer="        (sddm-configuration-display-server config)              "
Numlock="              (sddm-configuration-numlock config)                     "
HaltCommand="          (sddm-configuration-halt-command config)                "
RebootCommand="        (sddm-configuration-reboot-command config)              "

[Users]
DefaultPath="          (sddm-configuration-default-path config)                "
MinimumUid="           (number->string (sddm-configuration-minimum-uid config))"
MaximumUid="           (number->string (sddm-configuration-maximum-uid config))"
RememberLastUser="     (if (sddm-configuration-remember-last-user? config)
                           "true" "false")                                     "
RememberLastSession="  (if (sddm-configuration-remember-last-session? config)
                           "true" "false")                                     "
HideUsers="            (sddm-configuration-hide-users config)                  "
Hideshells="           (sddm-configuration-hide-shells config)                 "

[Theme]
Current="              (sddm-configuration-theme config)                       "
ThemeDir="             (sddm-configuration-themes-directory config)            "
FacesDir="             (sddm-configuration-faces-directory config)             "

[WaylandDisplay]
SessionCommand="       (sddm-configuration-session-command config)             "
SessionDir="           (sddm-configuration-sessions-directory config)          "

[XDisplay]
ServerPath="           (sddm-configuration-xorg-server-path config)            "
XauthPath="            (sddm-configuration-xauth-path config)                  "
XephyrPath="           (sddm-configuration-xephyr-path config)                 "
DisplayCommand="       (sddm-configuration-xdisplay-start config)              "
DisplayStopCommand="   (sddm-configuration-xdisplay-stop config)               "
SessionCommand="       (sddm-configuration-xsession-command config)            "
SessionDir="           (sddm-configuration-xsessions-directory config)         "
MinimumVT="            (number->string (sddm-configuration-minimum-vt config)) "
ServerArguments="      (sddm-configuration-xserver-arguments config)           "

[Autologin]
User="                 (sddm-configuration-auto-login-user config)             "
Session="              (sddm-configuration-auto-login-session config)          "
Relogin="              (if (sddm-configuration-relogin? config)
                           "true" "false")                                     "
"))

(define (sddm-activation config)
  "Return the activation gexp for CONFIG."
  #~(begin
      (open-output-file "/etc/pam_debug")
      (symlink #$(sddm-configuration-file config) "/etc/sddm.conf")))

(define (sddm-shepherd-service config)
  "Return a <shepherd-service> for sddm with CONFIG."

  (define sddm-command
    #~(list (string-append #$(sddm-configuration-sddm config) "/bin/sddm")))

  (list (shepherd-service
         (documentation "SDDM display manager.")
         (requirement '(user-processes))
         (provision '(display-manager))
         (start #~(make-forkexec-constructor #$sddm-command))
         (stop #~(make-kill-destructor)))))

(define (sddm-pam-service)
  "Return a PAM service for @command{sddm}."
  (pam-service
   (name "sddm")
   (auth
    (list
     (pam-entry
      (control "include")
      (module "other"))))
   (account
    (list
     (pam-entry
      (control "include")
      (module "other"))))
   (password
    (list
     (pam-entry
      (control "include")
      (module "other"))))
   (session
    (list
     (pam-entry
      (control "include")
      (module "other"))))))

(define (sddm-greeter-pam-service)
  "Return a PAM service for @command{sddm-greeter}."
  (pam-service
   (name "sddm-greeter")
   (auth
    (list
     ;; Load environment form /etc/environment and ~/.pam_environment
     (pam-entry
      (control "required")
      (module "pam_env.so"))
     ;; Always let the greeter start without authentication
     (pam-entry
      (control "required")
      (module "pam_permit.so"))))
   (account
    (list
     ;; No action required for account management
     (pam-entry
      (control "required")
      (module "pam_permit.so"))))
   (password
    (list
     ;; Can't change password
     (pam-entry
      (control "required")
      (module "pam_deny.so"))))
   (session
    (list
     ;; Setup session
     (pam-entry
      (control "required")
      (module "pam_unix.so"))
     (pam-entry
      (control "optional")
      (module #~(string-append #$elogind "/lib/security/pam_elogind.so")))))))

(define (sddm-autologin-pam-service)
  "Return a PAM service for @command{sddm-autologin}"
  (pam-service
   (name "sddm-autologin")
   (auth
    (list
     (pam-entry
      (control "requisite")
      (module "pam_nologin.so"))
     (pam-entry
      (control "required")
      (module "pam_succeed_if.so")
      (arguments (list "uid >= 1000 quiet")))
     (pam-entry
      (control "required")
      (module "pam_permit.so"))))
   (account
    (list
     (pam-entry
      (control "include")
      (module "sddm"))))
   (password
    (list
     (pam-entry
      (control "include")
      (module "sddm"))))
   (session
    (list
     (pam-entry
      (control "include")
      (module "sddm"))))))

(define (startxfce4-pam-service)
  (unix-pam-service "startxfce4" #:allow-empty-passwords? #t))

(define (weston-pam-service)
  (unix-pam-service "weston" #:allow-empty-passwords? #t))

(define (sddm-pam-services config)
  (list (sddm-pam-service)
        (sddm-greeter-pam-service)
        (sddm-autologin-pam-service)
        (startxfce4-pam-service)))

(define %sddm-accounts
  (list (user-group (name "sddm") (system? #t))
        (user-account
         (name "sddm")
         (group "sddm")
         (system? #t)
         (comment "SDDM user")
         (home-directory "/var/lib/sddm")
         (shell #~(string-append #$shadow "/sbin/nologin")))))

(define sddm-service-type
  (service-type (name 'sddm)
                (extensions
                  (list (service-extension shepherd-root-service-type
                                           sddm-shepherd-service)
                        (service-extension activation-service-type
                                           sddm-activation)
                        (service-extension pam-root-service-type
                                           sddm-pam-services)
                        (service-extension account-service-type
                                           (const %sddm-accounts))))))

(define* (sddm-service #:optional (config (sddm-configuration)))
  "Run the @uref{https://github.com/sddm/sddm,SSDM display manager}
with the given @var{config}, a @code{<sddm-configuration>} object."
  (service sddm-service-type config))