(define-module (gnu services slapd)
  #:use-module (guix gexp)
  #:use-module (gnu packages slapd)
  #:use-module (gnu packages admin)
  #:use-module (gnu system shadow)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services base)
  #:use-module (gnu services)
  #:use-module (srfi srfi-19)
  #:export (slapd-configuration slapd-service-type))

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

(define-configuration/no-serialization slapd-configuration
                                       (openldap (file-like openldap-slapd)
                                                 "openldap package to use")
                                       (home (string "/var/lib/slapd")
                                             "slapd home directory")
                                       (backups (list-of-file-like '())
                                        "alist of databases and their backup ldif files")
                                       (backup-date (date (current-date))
                                        "date that backup(seed) is from, to not use the same/older seed")
                                       (uris (string "ldap:// ldapi://")
                                        "slapd uris to accept connections to"))

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

(define (slapd-activation config)
  (let ((homedir (slapd-configuration-home config))
        (backups (slapd-configuration-backups config))
        (ldapdir (slapd-configuration-openldap config)))
    (with-imported-modules '((srfi srfi-19)
                             (ice-9 textual-ports))
                           #~(begin
                               (use-modules (srfi srfi-19)
                                            (ice-9 textual-ports))
                               (define (range n m)
                                 (if (>= n m)
                                     '()
                                     (cons n
                                           (range (+ n 1) m))))
                               (define (slapadd-seeds e)
                                 (begin
                                   (format (current-error-port)
                                           "SLAPADD Exception: ~s\n" e)
                                   (for-each (lambda (ldif dbno)
                                               (begin
                                                 (invoke (string-append #$sudo
                                                          "/bin/sudo")
                                                         "-u"
                                                         "slapd"
                                                         "-g"
                                                         "slapd"
                                                         (string-append #$ldapdir
                                                          "/sbin/slapadd")
                                                         "-F"
                                                         (string-append #$homedir
                                                          "/slapd.d")
                                                         "-n"
                                                         (number->string dbno)
                                                         "-l"
                                                         ldif)))
                                             '#+backups
                                             (range 0
                                                    (length `#+backups)))
                                   (let ((port (open-output-file (string-append #$homedir
                                                                  "/.last_slapadd_restore")))
                                         (time-str #$(date->string (slapd-configuration-backup-date
                                                                    config)
                                                                   "~4")))
                                     (begin
                                       (put-string port time-str)
                                       (close-port port)))))
                               (define (check-slapadd-seed-date)
                                 (let* ((verfile (string-append #$homedir
                                                  "/.last_slapadd_restore"))
                                        (port (open-input-file verfile))
                                        (date-string (get-string-all port)))
                                   (begin
                                     (display date-string)
                                     (close-port port)
                                     (if (> #$(time-second (date->time-utc (slapd-configuration-backup-date
                                                                            config)))
                                            (time-second (date->time-utc (string->date
                                                                          date-string
                                                                          "~Y-~m-~dT~H:~M:~S~z"))))
                                         (raise-exception (make-message
                                                           "configured backups newer than last restored"))
                                         (display
                                          "database seed older than last used seed")))))
                               (let ((user (getpw "slapd")))
                                 (mkdir-p/perms "/var/run/slapd" user 493)
                                 (mkdir-p/perms #$homedir user 493)
                                 (mkdir-p/perms (string-append #$homedir
                                                               "/slapd.d")
                                                user 488)
                                 (install-file (string-append #$ldapdir
                                                "/libexec/openldap/pw-totp.so")
                                               (string-append #$homedir
                                                              "/modules"))
                                 (mkdir-p/perms (string-append #$homedir
                                                               "/modules")
                                                user 488)
                                 (mkdir-p/perms (string-append #$homedir
                                                               "/data") user
                                                488))
                               (with-exception-handler slapadd-seeds
                                check-slapadd-seed-date
                                #:unwind? #t)))))

(define (slapd-shepherd-service config)
  (list (shepherd-service (documentation "")
                          (provision '(slapd))
                          (requirement '(networking user-processes))
                          (start #~(make-forkexec-constructor (list (string-append #$
                                                                     (slapd-configuration-openldap
                                                                      config)
                                                                     "/libexec/slapd")
                                                               "-h"
                                                               #$(slapd-configuration-uris config)
                                                               "-F"
                                                               "/var/lib/slapd/slapd.d"
                                                               "-u"
                                                               "slapd"
                                                               "-g"
                                                               "slapd")
                                                              #:environment-variables
                                                              (list (string-append
                                                                     "LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:"
                                                                     #$(slapd-configuration-home
                                                                        config)
                                                                     "/modules"))
                                                              #:user "root"
                                                              #:group "root"))
                          (stop #~(make-kill-destructor)))))

(define slapd-service-type
  (service-type (name 'slapd)
                (description "openldap slapd service")
                (extensions (list (service-extension account-service-type
                                                     slapd-accounts)
                                  (service-extension activation-service-type
                                                     slapd-activation)
                                  (service-extension
                                   shepherd-root-service-type
                                   slapd-shepherd-service)))
                (default-value (slapd-configuration))))