(define-module (metznet services sssd)
  #:use-module (guix gexp)
  #:use-module (gnu system pam)
  #:use-module (gnu services dbus)
  #:use-module (gnu services base)
  #:use-module (gnu services shepherd)
  #:use-module (gnu packages sssd)
  #:use-module (gnu services)
  #:use-module (gnu services configuration)
  #:export (sssd-domain-configuration sssd-configuration sssd-service-type))

(define-maybe string)

(define (serialize-field conv)
  (lambda (name value)
    (string-append (symbol->string name) " = "
                   (conv value) "\n")))

(define serialize-string
  (serialize-field (lambda (val)
                     val)))

(define-maybe boolean)
(define serialize-boolean
  (serialize-field (lambda (val)
                     (if val "True" "False"))))

(define-configuration sssd-domain-configuration
  (debug_level maybe-string "debug level")
  (id_provider maybe-string "id provider")
  (auth_provider maybe-string "auth provider")
  (cache_credentials maybe-boolean "cache credentials")
  (ldap_uri maybe-string "ldap server uri")
  (ldap_schema maybe-string "ldap schema to use")
  (ldap_group_member maybe-string "group member attribute")
  (ldap_group_object_class maybe-string "group object class")
  (ldap_tls_reqcert maybe-string "tls_reqcert")
  (ldap_tls_cacertdir maybe-string "ca certificate directory")
  (ldap_search_base maybe-string "base dn for search")
  (ldap_default_bind_dn maybe-string "dn to bind for search")
  (ldap_default_authtok_type maybe-string "ldap auth token type")
  (ldap_default_authtok maybe-string "token to use for ldap bind"))

(define (sssd-domain-configuration-with-name? val)
  (if (pair? val)
      (if (string? (car val))
          (if (sssd-domain-configuration? (cdr val)) #t) #t) #f))

(define list-of-sssd-domain-configurations?
  (list-of sssd-domain-configuration-with-name?))

(define (serialize-sssd-domain-and-name value)
  (let ((name (car value))
        (config (cdr value)))
    #~(string-append "[domain/"
                     #$name "]\n"
                     #$(serialize-configuration config
                        sssd-domain-configuration-fields))))

(define (serialize-list-of-sssd-domain-configurations name value)
  #~(string-append "domains = "
                   (string-join (list #$@(map (lambda (x)
                                                (car x)) value)) ", ") "\n\n"
                   (string-join (list #$@(map serialize-sssd-domain-and-name
                                              value)) "\n")))

(define serialize-list-of-strings
  (serialize-field (lambda (value)
                     (string-join value ", "))))

(define-configuration sssd-configuration
  (sssd (file-like sssd) "sssd package to use")
  (pam-services (list-of-strings (list "chfn" "groupadd" "groupdel" "groupmod" "login" "other" "passwd" "polkit-1" "sddm" "slock" "sshd" "su" "sudo" "useradd" "userdel" "usermod" "xlock"))
                "list of pam services to configure login for"
                (lambda (a b)
                  ""))
  (services (list-of-strings (list "nss" "sudo" "pam" "ssh" "ifp"))
            "list of services")
  (domains (list-of-sssd-domain-configurations '())
           "sssd domains to configure"))

(define (sssd-pam-service config)
  (let ((sufficient (pam-entry (control "sufficient")
                               (module (file-append (sssd-configuration-sssd
                                                     config)
                                        "/lib/security/pam_sss.so")))))
    (pam-extension (transformer (lambda (pam)
                                  (if (member (pam-service-name pam)
                                              (sssd-configuration-pam-services
                                               config))
                                      (pam-service (inherit pam)
                                                   (auth (cons sufficient
                                                               (pam-service-auth
                                                                pam)))
                                                   (account (cons sufficient
                                                                  (pam-service-account
                                                                   pam)))
                                                   (password (cons sufficient
                                                                   (pam-service-password
                                                                    pam)))
                                                   (session (cons sufficient
                                                                  (pam-service-session
                                                                   pam)))) pam))))))

(define (sssd-pam-services config)
  (list (sssd-pam-service config)))

(define (sssd-shepherd-service config)
  (list (shepherd-service (documentation "")
                          (provision '(sssd))
                          (requirement '(networking user-processes))
                          (start #~(make-forkexec-constructor (list (string-append #$
                                                                     (sssd-configuration-sssd
                                                                      config)
                                                                     "/sbin/sssd")
                                                               "-i"
                                                               "-c/var/lib/sss/sssd.conf")
                                                              #:user "root"
                                                              #:group "root"
                                                              #:environment-variables
                                                              (list (string-append
                                                                     "LD_LIBRARY_PATH="
                                                                     #$(sssd-configuration-sssd
                                                                        config)
                                                                     "/lib"))))
                          (stop #~(make-kill-destructor)))))

(define (sssd-configuration-file config)
  (mixed-text-file "sssd.conf"
                   #~(string-append "[sssd]\n"
                                    #$(serialize-configuration config
                                       sssd-configuration-fields))))

(define (sssd-activation config)
  #~(begin
      (let ((dbdir "/var/lib/sss/db")
            (dbusdir "/var/lib/sss/pipes/private")
            (user (getpw "root")))
        (mkdir-p/perms dbusdir user 493)
        (mkdir-p/perms dbdir user 493)
        (unless (file-exists? "/var/lib/sss/sssd.conf")
          (begin
            (copy-file #$(sssd-configuration-file config)
                       "/var/lib/sss/sssd.conf")
            (chmod "/var/lib/sss/sssd.conf" #o600))))))

(define-public sssd-service-type
  (service-type (name 'sssd)
                (description "SSSD Service")
                (extensions (list (service-extension pam-root-service-type
                                                     sssd-pam-services)
                                  (service-extension dbus-root-service-type
                                                     (compose list
                                                      sssd-configuration-sssd))
                                  (service-extension activation-service-type
                                                     sssd-activation)
                                  (service-extension nscd-service-type
                                                     (const (list sssd)))
                                  (service-extension
                                   shepherd-root-service-type
                                   sssd-shepherd-service)))
                (default-value (sssd-configuration))))