;; transient.scm -- Transient service creation.
;; Copyright (C) 2024-2025 Ludovic Courtès <ludo@gnu.org>
;;
;; This file is part of the GNU Shepherd.
;;
;; The GNU Shepherd 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.
;;
;; The GNU Shepherd 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 the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.

(define-module (shepherd service transient)
  #:use-module (shepherd service)
  #:use-module (shepherd support)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-71)
  #:export (transient-service))

(define* (spawn-transient-service command
                                  #:key
                                  (name (gensym "transient-"))
                                  (requirement '())
                                  (extra-environment-variables '())
                                  (directory (default-service-directory))
                                  log-file
                                  user group)
  "Run @var{command} (a list of strings) as a transient service called
@var{name}."
  (define user-group
    (compose group:name getgrnam passwd:gid getpwnam))

  (define user-home
    (compose passwd:dir getpwnam))

  (local-output (l10n "Spawning transient service for ~s.")
                command)
  (let* ((home (and=> user user-home))
         (service
          (service (list name)
                   #:requirement requirement
                   #:start
                   (make-forkexec-constructor
                    command
                    #:log-file log-file
                    #:user user
                    #:group (or group (and=> user user-group))
                    ;; FIXME: Should set #:supplementary-groups as
                    ;; returned by 'getgrouplist' for USER.
                    #:directory directory
                    #:environment-variables
                    (let ((variables (append
                                      extra-environment-variables
                                      (default-environment-variables))))
                      (if home
                          (append variables
                                  (list (string-append "HOME=" home)))
                          variables)))
                   #:stop (make-kill-destructor)
                   #:transient? #t
                   #:respawn? #f)))
    (register-services (list service))
    (start-service service)

    ;; Return NAME rather than SERVICE: if SERVICE is returned, there's a
    ;; chance it has already completed by the time 'service->sexp' receives it
    ;; to pass it to the client, and in that case 'service->sexp' would hang
    ;; while trying to communicate with SERVICE.
    name))

(define* (transient-service #:optional (provision '(transient))
                            #:key (requirement '()))
  "Return a service with the given @var{provision} and
@var{requirement}.  The service has a @code{spawn} action that lets users run
commands in the background."
  (define spawn-action
    (action 'spawn
            (lambda (_ . args)
              (let ((command options (span string? args)))
                (apply spawn-transient-service command
                       #:requirement (list (first provision))
                       options)))
            (l10n "Spawn the given program as a transient service, running in
the background.")))

  (service provision
           #:requirement requirement
           #:start (const #t)
           #:stop (const #f)
           #:actions (list spawn-action)
           #:documentation
           (l10n "Spawn programs to run as services in the background.")))
