;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2023 Felix Lechner <felix.lechner@lease-up.com>
;;;
;;; 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 kerberos heimdal)
  #:use-module (gnu packages kerberos)
  #:use-module (gnu services)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (ice-9 match)
  #:export (heimdal-kdc-configuration
            heimdal-kdc-service-type
            heimdal-kadmind-configuration
            heimdal-kadmind-service-type))


;;;
;;; Heimdal Kdc
;;;

(define-maybe/no-serialization string)

(define (non-negative-integer? val)
  (and (exact-integer? val) (not (negative? val))))

(define-maybe/no-serialization non-negative-integer)

(define-configuration/no-serialization heimdal-kdc-configuration
  (heimdal
   (file-like heimdal)
   "The heimdal package to use.")
  (config-file
   maybe-string
   "Configuration file for Heimdal KDC server.")
  (require-preauth?
   (boolean #t)
   "Require pre-authentication in the initial AS-REQ for all principals.")
  (max-request-size
   maybe-non-negative-integer
   "Maximum size of requests the server is willing to handle.")
  (enable-http?
   (boolean #f)
   "Listen on port 80 and handle requests encapsulated in HTTP.")
  (v4-realm
   maybe-string
   "Realm for version 4 requests.")
  (ports
   (list-of-strings '())
   "Ports to listen on.")
  (addresses
   (list-of-strings '())
   "Addresses to listen on.")
  (disable-des?
   (boolean #f)
   "Disable all DES encryption types."))

(define (heimdal-kdc-shepherd-service config)
  "Return a <shepherd-service> for Heimdal's kdc for CONFIG."
  (match-record config
      <heimdal-kdc-configuration> (heimdal config-file require-preauth?
                                           max-request-size enable-http?
                                           v4-realm ports addresses
                                           disable-des?)
    (shepherd-service
     (documentation "Run the Heimdal Kerberos KDC daemon (heimdal-kdc).")
     (provision '(heimdal-kdc))
     (requirement '(networking))
     (start #~(make-forkexec-constructor
               (list #$(file-append heimdal "/libexec/kdc")
                     #$@(if (maybe-value-set? config-file)
                            `(,(string-append "--config-file=" (maybe-value config-file)))
                            '())
                     #$@(if require-preauth? '() '("--no-require-preauth"))
                     #$@(if (maybe-value-set? max-request-size)
                            `(,(string-append
                                "--max-request-size="
                                (number->string (maybe-value max-request-size))))
                            '())
                     #$@(if enable-http? '("--enable-http") '())
                     #$@(if (maybe-value-set? v4-realm)
                            `(,(string-append "--v4-realm=" (maybe-value v4-realm)))
                            '())
                     ;; ports parameter is white-space separated
                     #$@(if (null? ports)
                            '()
                            `(,(string-append "--ports=" (string-join ports))))
                     ;; addresses parameter is white-space separated
                     #$@(if (null? addresses)
                            '()
                            `(,(string-append "--addresses=" (string-join addresses))))
                     #$@(if disable-des? '("--disable-des") '()))
               #:log-file "/var/log/kdc-shepherd"))
     (stop #~(make-kill-destructor)))))

(define heimdal-kdc-service-type
  (service-type
   (name 'heimdal-kdc)
   (description
    "Run the Heimdal @command{kdc} daemon.")
   (extensions
    (list
     (service-extension shepherd-root-service-type
                        (compose list heimdal-kdc-shepherd-service))))
   (default-value (heimdal-kdc-configuration))))


;;;
;;; Heimdal Kadmind
;;;

(define-configuration/no-serialization heimdal-kadmind-configuration
  (heimdal
   (file-like heimdal)
   "The heimdal package to use.")
  (config-file
   maybe-string
   "Configuration file for Heimdal Kadmind server.")
  (key-file
   maybe-string
   "Location of master key file.")
  (keytab
   maybe-string
   "Kerberos keytab to use.")
  (realm
   maybe-string
   "Kerberos realm to serve.")
  (debug?
   (boolean #f)
   "Enable debugging.")
  (ports
   (list-of-strings '())
   "Ports to listen on."))

(define (heimdal-kadmind-shepherd-service config)
  "Return a <shepherd-service> for Heimdal's kadmind for CONFIG."
  (match-record config
      <heimdal-kadmind-configuration> (heimdal config-file key-file keytab
                                               realm debug? ports)
    (shepherd-service
     (documentation "Run the Heimdal Kerberos admin daemon (heimdal-kadmind).")
     (provision '(heimdal-kadmind))
     (requirement '(networking))
     (start #~(make-forkexec-constructor
               (list #$(file-append heimdal "/libexec/kadmind")
                     #$@(if (maybe-value-set? config-file)
                            `(,(string-append "--config-file=" (maybe-value config-file)))
                            '())
                     #$@(if (maybe-value-set? key-file)
                            `(,(string-append "--key-file=" (maybe-value key-file)))
                            '())
                     #$@(if (maybe-value-set? keytab)
                            `(,(string-append "--keytab=" (maybe-value keytab)))
                            '())
                     #$@(if (maybe-value-set? realm)
                            `(,(string-append "--realm=" (maybe-value realm)))
                            '())
                     #$@(if debug? '("--debug") '())
                     ;; ports parameter is white-space separated
                     #$@(if (null? ports)
                            '()
                            `(,(string-append "--ports=" (string-join ports)))))))
     (stop #~(make-kill-destructor)))))

(define heimdal-kadmind-service-type
  (service-type
   (name 'heimdal-kadmind)
   (description
    "Run the Heimdal @command{kadmind} daemon.")
   (extensions
    (list
     (service-extension shepherd-root-service-type
                        (compose list heimdal-kadmind-shepherd-service))))
   (default-value (heimdal-kadmind-configuration))))