;;; shepherd-package.scm -- Build the Shepherd with GNU Guix.
;;; Copyright © 2023-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/>.

;; This file defines a Guix package.  It can be used to spawn an
;; interactive development environment:
;;
;;   guix shell
;;
;; Or it can be used to build Guile from a checkout in an isolated
;; environment:
;;
;;   guix build -f guix.scm
;;
;; Likewise, you may cross-compile it:
;;
;;   guix build -f guix.scm --target=x86_64-w64-mingw32
;;
;; … or perform a native build for another architecture, assuming
;; either offloading or transparent QEMU emulation is set up:
;;
;;   guix build -f guix.scm -s riscv64-linux

(define-module (shepherd-package)
  #:use-module (guix)
  #:use-module (guix git-download)
  #:use-module (guix build-system gnu)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module ((guix build-system gnu) #:select (dist-package))
  #:use-module (guix modules)
  #:use-module (gnu packages)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages gettext)
  #:use-module (gnu packages guile)
  #:use-module (gnu packages guile-xyz)
  #:use-module (gnu packages libevent)
  #:use-module (gnu packages man)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages texinfo))

(define %shepherd-version "1.0.99")

(define source-checkout
  (let ((vcs-file? (or (git-predicate
                        (string-append (current-source-directory)
                                       "/../.."))
                       (const #t))))
    (local-file "../.." "shepherd-checkout"
                #:recursive? #t
                #:select? vcs-file?)))

(define development-packages
  ;; Packages needed when building from Git.
  '("autoconf" "automake" "gettext-minimal" "texinfo" "help2man"
    "git-minimal"                                 ;for 'make dist'
    "util-linux"))                                ;for ENOSPC test

(define-public guile-fibers-on-libevent
  ;; Fibers running on the libevent backend.
  (package/inherit guile-fibers
    (name "guile-fibers-on-libevent")
    (arguments
     (substitute-keyword-arguments (package-arguments guile-fibers)
       ((#:configure-flags flags #~'())
        ;; Disable native epoll support to force use of the libevent backend.
        #~(cons "ac_cv_func_epoll_wait=no" #$flags))))
    (inputs (modify-inputs (package-inputs guile-fibers)
              (prepend libevent)))))

(define-public shepherd
  (package
    (name "shepherd")
    (version (string-append %shepherd-version "-git"))
    (source source-checkout)
    (build-system gnu-build-system)
    (arguments
     (list #:configure-flags
           #~(list "--localstatedir=/var"
                   (string-append "--with-gzip="
                                  #$(this-package-input "gzip")
                                  "/bin/gzip")
                   (string-append "--with-zstd="
                                  #$(this-package-input "zstd")
                                  "/bin/zstd"))

           #:modules '((guix build gnu-build-system)
                       ((guix build guile-build-system)
                        #:select (target-guile-effective-version))
                       (guix build utils))
           #:imported-modules `((guix build guile-build-system)
                                ,@%default-gnu-imported-modules)
           #:phases
           #~(modify-phases %standard-phases
               (add-before 'configure 'set-fibers-directory
                 (lambda* (#:key inputs target #:allow-other-keys)
                   (when target
                     ;; When cross-compiling, refer to the target
                     ;; Fibers, not the native one.
                     (let ((fibers
                            (search-input-file
                             inputs
                             (string-append "/share/guile/site/"
                                            (target-guile-effective-version)
                                            "/fibers.scm")))
                           (fibers-go
                            (search-input-file
                             inputs
                             (string-append "/lib/guile/"
                                            (target-guile-effective-version)
                                            "/site-ccache/fibers.go"))))
                       (substitute* '("herd.in" "shepherd.in")
                         (("%FIBERS_SOURCE_DIRECTORY%")
                          (dirname fibers))
                         (("%FIBERS_OBJECT_DIRECTORY%")
                          (dirname fibers-go)))))))
               (add-after 'check 'check-without-signalfd
                 (lambda* (#:key target tests? #:allow-other-keys)
                   ;; On Linux, test without 'signalfd' support.
                   (when (and tests? (not target)
                              (string-contains %host-type "linux"))
                     (setenv "SHEPHERD_DISABLE_SIGNALFD" "1")
                     (invoke "make" "check" "-j"
                             (number->string (parallel-job-count)))
                     (unsetenv "SHEPHERD_DISABLE_SIGNALFD")))))))

    (native-inputs
     ;; Use 'specification->package' to get the latest version of those
     ;; development tools.
     (append (map specification->package development-packages)
             (list pkg-config guile-3.0-latest
                   guile-fibers)))            ;for cross-compilation
    (inputs (list guile-3.0-latest guile-fibers gzip zstd))
    (synopsis "System service manager")
    (description
     "The GNU Shepherd is a daemon-managing daemon, meaning that it supervises
the execution of system services, replacing similar functionality found in
typical init systems.  It provides dependency-handling through a convenient
interface and is based on GNU Guile.")
    (license license:gpl3+)
    (home-page "https://www.gnu.org/software/shepherd/")))

(define-public shepherd/libevent
  (package
    (inherit shepherd)
    (name "shepherd-libevent")
    (native-inputs (modify-inputs (package-native-inputs shepherd)
                     (replace "guile-fibers" guile-fibers-on-libevent)))
    (inputs (modify-inputs (package-inputs shepherd)
              (replace "guile-fibers" guile-fibers-on-libevent)))))

(define source-tarball
  ;; Tarball make from the Git checkout.
  (dist-package shepherd source-checkout
                #:phases #~(modify-phases %dist-phases
                             (replace 'build-dist
                               (lambda args
                                 ;; Run "make" before "make distcheck".
                                 (apply (assoc-ref %dist-phases 'build-dist)
                                        #:build-before-dist? #t
                                        #:dist-target "dist"
                                        #:tests? #f
                                        args))))))

(define-public shepherd-from-tarball
  ;; Built from a tarball.  This is useful for two reasons: as some sort of a
  ;; "distcheck" verification, and to support cross-compilation (since
  ;; building man pages with help2man is not supported in a cross-compilation
  ;; context).
  (package
    (inherit shepherd)
    (version (string-append %shepherd-version "-tarball"))
    (source source-tarball)
    (arguments
     (substitute-keyword-arguments (package-arguments shepherd)
       ((#:phases phases #~%standard-phases)
        #~(modify-phases #$phases
            (replace 'unpack
              (lambda _
                (define source
                  #+(package-source this-package))

                ;; Locate a tarball within SOURCE and unpack it.
                (invoke "tar" "xvf"
                        (car (find-files source "\\.tar.gz$")))
                (let ((directory
                       (car (find-files "."
                                        (lambda (file stat)
                                          (and (string-prefix?
                                                "shepherd" (basename file))
                                               (eq? 'directory
                                                    (stat:type stat))))
                                        #:directories? #t))))
                  (format #t "changing directory to '~a'~%" directory)
                  (chdir directory))))))))
    (native-inputs
     (modify-inputs (package-native-inputs shepherd)
       (delete "autoconf" "automake" "gettext-minimal" "texinfo" "help2man")))))

;; Return the Shepherd package that lets you build from Git, for the benefit
;; of 'guix shell'.
shepherd
