(use-modules (base-system)
             (gnu build activation)
             (gnu services authentication)
             (gnu packages openldap)
             (gnu system shadow)
             (gnu system pam)
             (gnu services)
             (gnu services shepherd)
             (gnu packages admin)
             (gnu packages autotools)
             (gnu packages databases)
             (gnu packages linux)
             (gnu packages pkg-config)
             (gnu packages compression)
             (gnu packages perl)
             (guix packages)
             (guix gexp)
             (guix utils)
             (guix records)
             (ice-9 match)
             (ice-9 format)
             (ice-9 popen)
             (ice-9 textual-ports)
             (srfi srfi-1))

(define domain-to-dc
  (lambda (domain)
    (string-drop-right (apply string-append (map (lambda (component) (string-append "dc=" component ",")) (string-split domain #\.))) 1)))

(define %domain-dc (domain-to-dc %domain-name))

(define slapd-rootpw
  (get-env-default "SLAPD_ROOTPW" "root"))

(define %slapd-accounts
  (list (user-group (name "slapd") (system? #t))
        (user-account (name "slapd")
                      (group "slapd")
                      (system? #t)
                      (comment "OpenLDAP server user")
                      (home-directory "/var/lib/slapd")
                      (shell (file-append shadow "/sbin/nologin")))))

(define openldap-2.6-slapd
  (package
    (inherit openldap-2.6)
    (name "openldap-2.6-slapd")
    (native-inputs (modify-inputs (package-native-inputs openldap-2.6)
                                  (append libltdl unixodbc pkg-config wiredtiger perl lz4 snappy)))
    (arguments
      (substitute-keyword-arguments (package-arguments openldap-2.6)
        ((#:configure-flags flags)
          `(append '("--enable-modules" "--enable-backends" "--sharedstatedir=/var/lib/slapd" "--localstatedir=/var/lib/slapd" "--runstatedir=/var/run/slapd") ,flags ))))))

(define %slapd-package openldap-2.6-slapd)
(define %ldap-prefix #~(file-append  #$%slapd-package "/etc/openldap/schema/"))

(define-record-type* <slapd-config-ldif>
  slapd-config-ldif make-slapd-config-ldif
  slapd-config-ldif?
  (package slapd-config-ldif-package
           (default %slapd-package))
  (argsfile slapd-config-ldif-argsfile
            (default "/var/run/slapd/args"))
  (pidfile slapd-config-ldif-pidfile
           (default "/var/run/slapd/pid"))
  (schema-prefix slapd-config-ldif-schema-prefix
                 (default "/var/lib/slapd/schema"))
  (schemas slapd-config-ldif-schemas
           (default '("core.ldif")))
  (basedn slapd-config-ldif-basedn
          (default %domain-dc))
  (rootdn slapd-config-ldif-rootdn
          (default "admin"))
  (rootpw slapd-config-ldif-rootpw
          (default "password"))
  (rootpwhash slapd-config-ldif-rootpwhash
              (default "secret"))
  (data-directory slapd-config-ldif-data-directory
                  (default "/var/lib/slapd/data"))
  (conf-directory slapd-config-ldif-conf-directory
                  (default "/var/lib/slapd/config"))
  (indices slapd-config-ldif-indices
           (default '("objectClass eq")))
  (extra-config slapd-config-ldif-extra-config
              (default '())))

(define-gexp-compiler (slapd-config-ldif-compiler
                       (file <slapd-config-ldif>) system target)

  (match file
    (($ <slapd-config-ldif> package argsfile pidfile schema-prefix schemas basedn rootdn rootpw rootpwhash data-directory conf-directory indices extra-config)
       (gexp->derivation
         "cn=config.ldif"
         #~(call-with-output-file (ungexp output "out")
           (lambda (port)
             (display (string-append
               (ungexp-splicing `(
                   ,@`("dn: cn=config\n")
                   ,@`("objectClass: olcGlobal\n")
                   ,@`("cn: config\n")
                   ,@`("olcArgsFile: " ,argsfile "\n")
                   ,@`("olcPidFile: " ,pidfile "\n\n")
                   ,@`("dn: cn=schema,cn=config\n")
                   ,@`("objectClass: olcSchemaConfig\n")
                   ,@`("cn: schema\n\n")
                   ,@(append-map
                       (lambda (schema)
                         `("include: file://" ,schema-prefix ,schema "\n"))
                       schemas)
                   ,@`("\ndn: olcDatabase=config,cn=config\n")
                   ,@`("objectClass: olcDatabaseConfig\n")
                   ,@`("olcDatabase: config\n")
                   ,@`("olcRootDN: cn=" ,rootdn "," ,basedn "\n\n")
                   ,@`("dn: olcDatabase=mdb,cn=config\n")
                   ,@`("objectClass: olcDatabaseConfig\n")
                   ,@`("objectClass: olcMdbConfig\n")
                   ,@`("olcDatabase: mdb\n")
                   ,@`("olcSuffix: " ,basedn "\n")
                   ,@`("olcRootDN: cn=" ,rootdn "," ,basedn "\n")
                   ,@`("olcRootPW: " ,rootpwhash "\n")
                   ,@`("olcDbDirectory: " ,data-directory "\n")
                   ,@(append-map
                       (lambda (index)
                         `("olcDbIndex: " ,index "\n"))
                       indices)
                   ,@`("\n")
                   ,@extra-config)))

               port)))
         #:local-build? #t))))

(define-record-type* <slapd-configuration>
  slapd-configuration make-slapd-configuration
  slapd-configuration?
  (pidfile slapd-configuration-pidfile
           (default "/var/run/slapd.pid"))
  (urls slapd-configuration-urls
        (default "ldap:/// ldapi:///"))
  (config slapd-configuration-config
          (default (slapd-config-ldif)))
  (extra-slapadd slapd-configuration-extra-slapadd
              (default ""))
  (extra-ldapadd slapd-configuration-extra-ldapadd
                 (default "")))

(define slapd-shepherd-service
  (match-lambda
    (($ <slapd-configuration> pidfile urls config extra-slapadd extra-ldapadd)
     (match-record
       config
       <slapd-config-ldif>
       (package conf-directory rootdn rootpw basedn)
           (list (shepherd-service
             (documentation "Run the slapd daemon")
             (provision '(slapd))
             (requirement '(networking user-processes syslogd))
             (start #~(lambda ()
                        (if (directory-exists? (string-append #$conf-directory "/cn=config"))
                          (display "slapd already configured, skipping...")
                          (begin
                            (system (string-join (list
                                                #$(file-append sudo "/bin/sudo")
                                                "--user=slapd"
                                                #$(file-append package "/sbin/slapadd")
                                                "-n" "0"
                                                "-F" #$conf-directory
                                                "-l" #$config)))
                            (system (string-join (list
                                                 #$(file-append sudo "/bin/sudo")
                                                 "--user=slapd"
                                                 #$(file-append package "/sbin/slapadd")
                                                 "-n" "1"
                                                 "-F" #$conf-directory
                                                 "-l" #$(plain-file "base-slap.ldif" extra-slapadd))))))
                        (fork+exec-command (list #$(file-append package "/libexec/slapd")
                          "-d" "-1"
                          "-F" #$conf-directory
                          "-u" "slapd"
                          "-g" "slapd"))
                        ; TODO figure out how to make it wait for slapd to be ready
                        (if (file-exists? (string-append #$conf-directory "/.initialized"))
                          (display "slapd already initialzed, skipping...")
                          (begin
                            (system (string-join (list
                                                 #$(file-append sudo "/bin/sudo")
                                                 "--user=slapd"
                                                 #$(file-append package "/bin/ldapadd")
                                                 "-D" (string-append "cn=" #$rootdn "," #$basedn)
                                                 "-w" #$rootpw
                                                 "-f" #$(plain-file "base-ldap.ldif" extra-ldapadd))))
                            (mknod (string-append #$conf-directory "/.initialized") 'regular #o400 0)))))
             (stop #~(make-kill-destructor))))))))

(define slapd-activation
  (match-lambda
    (($ <slapd-configuration> pidfile urls config extra-slapadd)
     (match-record
       config
       <slapd-config-ldif>
       (package conf-directory data-directory)
       #~(begin
           (use-modules (guix build utils))
           (let* ((user (getpw "slapd")))
             (mkdir-p/perms "/var/run/slapd" user #o700)
             (mkdir-p/perms #$data-directory user #o700)
             (mkdir-p/perms #$conf-directory user #o700)))))))


(define slapd-service-type
  (service-type
    (name 'slapd)
    (description "OpenLDAP server daemon")
    (extensions
      (list (service-extension shepherd-root-service-type slapd-shepherd-service)
            (service-extension activation-service-type slapd-activation)
            (service-extension account-service-type (const %slapd-accounts))))
    (default-value
      (slapd-configuration))))

(define (shell% proc fmt . args)
  (let* ((port (open-input-pipe (format #f "~?" fmt args)))
         (output (proc port)))
    (close-pipe port)
    output))

(define-public (shell . args)
  (apply shell% (cons get-string-all args)))

(define-public (shell$ . args)
  (apply shell% (cons get-line args)))

(define %slapd-conf
  (slapd-configuration
    (extra-ldapadd
      (string-join (list
          "dn: olcDatabase={1}mdb,cn=config"
          "changetype: modify"
          "replace: olcAccess"
          (string-append "olcAccess: {0}to attrs=cn,givenName,sn,userPassword,shadowLastChange,mail,loginShell,photo"
                         "by self write by anonymous auth by dn.base=\"cn=admin,"
                         %domain-dc
                         "\" write by * none")
          (string-append "olcAccess: {1}to * by self read by dn.base=\"cn=admin,"
                         %domain-dc
                         "\" write by * read")
          "")))
    (extra-slapadd
        (string-join (list
          "dn: dc=metznet,dc=ca"
          "dc: metznet"
          "o: Organization"
          "objectClass: dcObject"
          "objectClass: organization"
          ""
          "dn: cn=admin,dc=metznet,dc=ca"
          "cn: admin"
          "description: LDAP Administrator"
          "objectClass: organizationalRole"
          "objectClass: top"
          "roleOccupant: dc=metznet,dc=ca"
          ""
          "dn: ou=user,dc=metznet,dc=ca"
          "ou: user"
          "description: LDAP User"
          "objectClass: top"
          "objectClass: organizationalUnit"
          ""
          "dn: ou=group,dc=metznet,dc=ca"
          "ou: group"
          "description: LDAP Group"
          "objectClass: top"
          "objectClass: organizationalUnit"
          "") "\n"))
    (config
      (slapd-config-ldif
        (rootpw "password")
        (rootpwhash "{SSHA}620erGNXKg4D67G1xS0hNhr7h75VaIJl")
        (indices '("objectClass eq" "uid pres,eq" "mail pres,sub,eq" "cn,sn pres,sub,eq" "dc eq"))
        (schemas '("core.ldif" "cosine.ldif" "inetorgperson.ldif" "nis.ldif"))
        (schema-prefix #~(string-append #$%slapd-package "/etc/openldap/schema/"))))))


(operating-system
  (inherit base-server-system)
  (host-name (string-append "ldap." %domain-name))
  (packages (append (list strace %slapd-package) %my-server-packages))
  (services (append (list
                      (service slapd-service-type %slapd-conf))
                    %my-server-services)))