(define-module (metznet machines kerberos)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-1)
  #:use-module (gnu system)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix utils)
  #:use-module (guix build-system gnu)
  #:use-module ((guix licenses)
                #:prefix license:)
  #:use-module (metznet system base-system)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages)
  #:use-module (gnu packages kerberos)
  #:use-module (gnu packages base)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages bison)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages tcl)
  #:use-module (gnu packages readline)
  #:use-module (gnu packages slapd)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services configuration)
  #:use-module (gnu services certbot)

  #:export (kerberos.metznet.ca kerberos-services))

(define-public mit-krb5-ldap
  (package
    (name "mit-krb5-ldap")
    (version "1.20")
    (source
     (origin
       (method url-fetch)
       (uri (list (string-append "https://web.mit.edu/kerberos/dist/krb5/"
                                 (version-major+minor version) "/krb5-"
                                 version ".tar.gz")
                  (string-append "https://kerberos.org/dist/krb5/"
                                 (version-major+minor version) "/krb5-"
                                 version ".tar.gz")))
       (patches (search-patches "mit-krb5-hurd.patch"))
       (sha256
        (base32 "0bz16sh0vgzlpy2kx5acmpyy181hl83a1alz7wbk06457kfjn0ky"))))
    (build-system gnu-build-system)
    (native-inputs (list bison perl tcl openldap-slapd)) ;required for some tests
    (inputs (list openssl readline))
    (arguments
     `( ;XXX: On 32-bit systems, 'kdb5_util' hangs on an fcntl/F_SETLKW call
       ;; while running the tests in 'src/tests'. Also disable tests when
       ;; cross-compiling.
       #:tests? ,(and (not (%current-target-system))
                      (string=? (%current-system) "x86_64-linux"))

       ,@(if (%current-target-system)
             '(#:configure-flags (list "--localstatedir=/var"
                                  "--with-readline"
                                  "--with-ldap"
                                  "krb5_cv_attr_constructor_destructor=yes"
                                  "ac_cv_func_regcomp=yes"
                                  "ac_cv_printf_positional=yes"
                                  "ac_cv_file__etc_environment=yes"
                                  "ac_cv_file__etc_TIMEZONE=no")
               #:make-flags (list "CFLAGS+=-DDESTRUCTOR_ATTR_WORKS=1"))
             '(#:configure-flags (list "--with-tls-impl=openssl"
                                       "--with-readline" "--with-ldap"
                                       "--localstatedir=/var")))
       #:phases (modify-phases %standard-phases
                  (add-after 'unpack 'enter-source-directory
                    (lambda _
                      (chdir "src")))
                  (add-before 'check 'pre-check
                    (lambda* (#:key inputs native-inputs #:allow-other-keys)
                      (let ((perl (search-input-file (or native-inputs inputs)
                                                     "bin/perl")))
                        (substitute* "plugins/kdb/db2/libdb2/test/run.test"
                          (("/bin/cat")
                           perl)
                          (("D/bin/sh")
                           (string-append "D"
                                          (which "sh")))
                          (("bindir=/bin/.")
                           (string-append "bindir="
                                          (dirname perl))))))))))
    (synopsis "MIT Kerberos 5")
    (description
     "Massachusetts Institute of Technology implementation of Kerberos.
                   Kerberos is a network authentication protocol designed to provide strong
                   authentication for client/server applications by using secret-key
                   cryptography.")
    (license (license:non-copyleft "file://NOTICE"
                                   "See NOTICE in the distribution."))
    (home-page "https://web.mit.edu/kerberos/")
    (properties '((cpe-name . "kerberos")))))

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

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

(define-maybe string)

(define list-of-ports?
  (list-of integer?))

(define serialize-list-of-ports
  (serialize-field (lambda (val)
                     (string-join (map number->string val) ",")) "  "))
(define realm-serialize-list-of-ports
  (serialize-field (lambda (val)
                     (string-join (map number->string val) ",")) "    "))

(define-maybe list-of-ports)
(define-maybe file-like)

(define serialize-file-like
  (serialize-field (lambda (val)
                     val) "    "))

(define (serialize-none field-name value)
  "")

(define-configuration kdc-realm-configuration
  (name (string "EXAMPLE.COM") "realm name" serialize-none)
  (database_module maybe-string "database module")
  (acl_file maybe-file-like "acl file")
  (key_stash_file (string "/var/lib/kerberos/stash") "key stash file")
  (kdc_ports (list-of-ports '(750 88)) "list of ports to listen on"
             realm-serialize-list-of-ports)
  (kadmind_ports (list-of-ports '(749))
                 "list of ports to listen on for kadmin connections"
                 realm-serialize-list-of-ports)
  (max_life (string "10h 0m 0s") "maximum life of granted tickets")
  (max_renewable_type (string "7d 0h 0m 0s") "maximum time to renew ticket")
  (master_key_type (string "des3-hmac-sha1") "master key type")
  (supported_enctypes maybe-string "supported encryption types")
  (default_principal_flags maybe-string "default flag for new principals"))

(define list-of-kdc-realm-configuration?
  (list-of kdc-realm-configuration?))

(define (serialize-kdc-realm-configuration realm)
  #~(string-append "  "
                   #$(kdc-realm-configuration-name realm) " = {\n"
                   #$(serialize-configuration realm
                                              kdc-realm-configuration-fields)
                   "  }\n"))

(define serialize-boolean
  (serialize-field (lambda (val)
                     (if val "true" "false")) "    "))
(define serialize-number
  (serialize-field number->string "    "))

(define-configuration kldap-configuration
  (db_library (string "kldap") "db library to use")
  (disable_last_success (boolean #f) "disable last success field")
  (disable_lockout (boolean #f) "disable lockout field")
  (ldap_kdc_dn (string "uid=kdc,dc=example,dc=com")
               "dn to bind for kdc operations")
  (ldap_kadmind_dn (string "uid=kadmind,dc=example,dc=com")
                   "dn to bind for kadmin operations")
  (ldap_service_password_file maybe-string
   "file that stores the passwords for the ldap bind dns")
  (ldap_servers (string "ldap://example.com") "ldap server url")
  (ldap_conns_per_server (number 5) "number of connections per ldap server"))

(define (serialize-list-of-kdc-realm-configuration field-name value)
  #~(string-join (list "[realms]"
                       #$@(map (lambda (realm)
                                 (serialize-kdc-realm-configuration realm))
                               value)) "\n"))

(define (dbmodule? val)
  (if (list? val)
      (let ((name (car val))
            (config (cdr val)))
        (if (string? name)
            (or (kldap-configuration? config)) #f))))

(define list-of-dbmodules?
  (list-of dbmodule?))

(define (serialize-dbmodule dbmodule)
  (let ((name (car dbmodule))
        (config (cdr dbmodule)))
    #~(string-append "  "
                     #$name " = {\n"
                     #$(or (if (kldap-configuration? config)
                               (serialize-configuration config
                                kldap-configuration-fields) #f) "") "  }\n")))

(define (serialize-list-of-dbmodules field-name value)
  #~(string-join (list "[dbmodules]"
                       #$@(map (lambda (dbmodule)
                                 (serialize-dbmodule dbmodule)) value)) "\n"))

(define list-of-strings?
  (list-of string?))

(define (serialize-list-of-strings field-name value)
  #~(string-append "["
                   #$(symbol->string field-name) "]\n"
                   #$(string-join (map (cut string-append "  " <>) value) "\n")
                   "\n"))

(define-maybe list-of-strings)

(define-configuration kdc-configuration
  (krb5 (file-like mit-krb5-ldap) "krb5 package to use" serialize-none)
  (pkinit_anchors (string "DIR:/run/current-system/profile/etc/ssl/certs/")
                  "CA certificate directory/file"
                  (serialize-field (lambda (x)
                                     x) "  "))
  (kdc_ports (list-of-ports '(750 88)) "list of ports to listen on")
  (realms (list-of-kdc-realm-configuration '())
          "Realms to configure the KDC with")
  (logging maybe-list-of-strings "extra logging lines")
  (dbdefaults maybe-list-of-strings "extra dbdefault lines")
  (dbmodules (list-of-dbmodules '()) "dbmodules to configure"))

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

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

(define (kdc-activation configuration)
  #~(begin
      (let ((user (getpw "kerberos"))
            (group (getgr "kerberos")))
        (mkdir-p/perms "/var/lib/kerberos" user 488))))

(define (kdc-etc configuration)
  `(("kdc.conf" ,(serialize-kdc-configuration configuration))))

; TODO: have to stash the KDC master key with `KRB5_KDC_PROFILE=/etc/kdc.conf kdb5_util stash` on first boot
(define (kdc-shepherd configuration)
  (list (shepherd-service (documentation "")
                          (provision '(kdc))
                          (requirement '(networking user-processes))
                          (start #~(make-forkexec-constructor (list #$(file-append
                                                                       (kdc-configuration-krb5
                                                                        configuration)
                                                                       "/sbin/krb5kdc")
                                                               "-n" "-P"
                                                               "/run/krb5kdc.pid")
                                                              #:environment-variables
                                                              (list (string-append
                                                                     "LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:"
                                                                     #$(kdc-configuration-krb5
                                                                        configuration)
                                                                     "/lib/krb5/plugins/kdb")
                                                               "SSL_CERT_DIR=/etc/ssl/certs"
                                                               "KRB5_KDC_PROFILE=/etc/kdc.conf")
                                                              #:user "root"
                                                              #:group "root"))
                          (stop #~(make-kill-destructor)))
        (shepherd-service (documentation "")
                          (provision '(kadmind))
                          (requirement '(networking user-processes))
                          (start #~(make-forkexec-constructor (list #$(file-append
                                                                       (kdc-configuration-krb5
                                                                        configuration)
                                                                       "/sbin/kadmind")
                                                               "-nofork" "-P"
                                                               "/run/kadmind.pid")
                                                              #:environment-variables
                                                              (list (string-append
                                                                     "LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:"
                                                                     #$(kdc-configuration-krb5
                                                                        configuration)
                                                                     "/lib/krb5/plugins/kdb")
                                                               "SSL_CERT_DIR=/etc/ssl/certs"
                                                               "KRB5_KDC_PROFILE=/etc/kdc.conf")
                                                              #:user "root"
                                                              #:group "root"))
                          (stop #~(make-kill-destructor)))))

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

(define %kerberos-dn
  "uid=kerberos,ou=system,ou=accounts,dc=metznet,dc=ca")

(define-public kerberos-services
  (append (list (service kdc-service-type
                         (kdc-configuration (dbdefaults '("ldap_kerberos_container_dn = cn=kerberos,dc=metznet,dc=ca"))
                                            (logging '("kdc = SYSLOG:DEBUG:DAEMON"))
                                            (dbmodules (list (cons
                                                              "openldap_ldapconf"
                                                              (kldap-configuration
                                                               (ldap_kdc_dn
                                                                %kerberos-dn)
                                                               (ldap_kadmind_dn
                                                                %kerberos-dn)
                                                               (ldap_servers
                                                                "ldaps://ldap.metznet.ca")
                                                               (ldap_service_password_file
                                                                "/var/lib/kerberos/service.keyfile")))))
                                            (realms (list (kdc-realm-configuration
                                                           (name "METZNET.CA")
                                                           (database_module
                                                            "openldap_ldapconf")
                                                           (default_principal_flags
                                                            "+preauth")
                                                           (acl_file (plain-file
                                                                      "kadm5.acl"
                                                                      "*/admin@METZNET.CA    *\n")))))))
                (service certbot-service-type
                         (certbot-configuration (email "admin@metznet.ca")
                                                (certificates (list (certificate-configuration
                                                                     (domains '
                                                                              ("kerberos.metznet.ca"))))))))
          %metznet-server-services))

(define-public kerberos.metznet.ca
  (operating-system
    (inherit %metznet-base-server-system)
    (host-name "kerberos.metznet.ca")
    (services
     kerberos-services)))