;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020, 2021 Marius Bakke ;;; Copyright © 2023 Nicolas Graves ;;; Copyright © 2023, 2024 Clément Lassieur ;;; ;;; 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 . (define-module (gnu packages browser-extensions) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix git-download) #:use-module (guix build-system copy) #:use-module (guix build-system gnu) #:use-module ((guix licenses) #:prefix license:) #:use-module (gnu build chromium-extension) #:use-module (gnu build icecat-extension) #:use-module (gnu packages compression) #:use-module (gnu packages password-utils) #:use-module (gnu packages python)) (define play-to-kodi (package (name "play-to-kodi") (version "1.9.1") (home-page "https://github.com/khloke/play-to-xbmc-chrome") (source (origin (method git-fetch) (uri (git-reference (url home-page) (commit version))) (file-name (git-file-name name version)) (sha256 (base32 "01rmcpbkn9vhcd8mrah2jmd2801k2r5fz7aqvp22hbwmh2z5f1ch")))) (build-system copy-build-system) (synopsis "
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013-2016, 2018-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; 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 shepherd)
  #:use-module (guix ui)
  #:use-module (guix sets)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:use-module (guix records)
  #:use-module (guix packages)
  #:use-module (guix utils)
  #:use-module ((guix diagnostics)
                #:select (define-with-syntax-properties formatted-message))
  #:use-module (gnu services)
  #:use-module (gnu services herd)
  #:use-module (gnu packages admin)
  #:use-module (ice-9 match)
  #:use-module (ice-9 vlist)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:export (shepherd-configuration
            shepherd-configuration?
            shepherd-configuration-shepherd
            shepherd-configuration-services

            shepherd-root-service-type
            %shepherd-root-service
            shepherd-service-type

            shepherd-service
            shepherd-service?
            shepherd-service-documentation
            shepherd-service-provision
            shepherd-service-canonical-name
            shepherd-service-requirement
            shepherd-service-one-shot?
            shepherd-service-respawn-limit
            shepherd-service-respawn-delay
            shepherd-service-respawn?
            shepherd-service-start
            shepherd-service-stop
            shepherd-service-free-form
            shepherd-service-auto-start?
            shepherd-service-modules

            shepherd-action
            shepherd-action?
            shepherd-action-name
            shepherd-action-documentation
            shepherd-action-procedure

            shepherd-configuration-action

            %default-modules

            shepherd-service-file

            shepherd-service-lookup-procedure
            shepherd-service-back-edges
            shepherd-service-upgrade

            user-processes-service-type

            assert-valid-graph))

;;; Commentary:
;;;
;;; Instantiating system services as a shepherd configuration file.
;;;
;;; Code:


(define-record-type* <shepherd-configuration>
  shepherd-configuration make-shepherd-configuration
  shepherd-configuration?
  (shepherd shepherd-configuration-shepherd
            (default shepherd-1.0))               ;file-like
  (services shepherd-configuration-services
            (default '()))) ; list of <shepherd-service>

(define (shepherd-boot-gexp config)
  "Return a gexp starting the shepherd service."
  (let ((shepherd (shepherd-configuration-shepherd config))
        (services (shepherd-configuration-services config)))
  #~(begin
      ;; Keep track of the booted system.
      (false-if-exception (delete-file "/run/booted-system"))

      ;; Make /run/booted-system, an indirect GC root, point to the store item
      ;; /run/current-system points to.  Use 'canonicalize-path' rather than
      ;; 'readlink' to make sure we get the store item.
      (symlink (canonicalize-path "/run/current-system")
               "/run/booted-system")

      ;; Ensure open file descriptors are close-on-exec so shepherd doesn't
      ;; inherit them.
      (let loop ((fd 3))
        (when (< fd 1024)
          (false-if-exception
           (let ((flags (fcntl fd F_GETFD)))
             (when (zero? (logand flags FD_CLOEXEC))
               (fcntl fd F_SETFD (logior FD_CLOEXEC flags)))))
          (loop (+ fd 1))))

      ;; Start shepherd.
      (execl #$(file-append shepherd "/bin/shepherd")
             "shepherd" "--config"
             #$(shepherd-configuration-file services shepherd)))))

(define shepherd-packages
  (compose list shepherd-configuration-shepherd))

(define shepherd-root-service-type
  (service-type
   (name 'shepherd-root)
   ;; Extending the root shepherd service (aka. PID 1) happens by
   ;; concatenating the list of services provided by the extensions.
   (compose concatenate)
   (extend (lambda (config extra-services)
             (shepherd-configuration
               (inherit config)
               (services (append (shepherd-configuration-services config)
                                 extra-services)))))
   (extensions (list (service-extension boot-service-type
                                        shepherd-boot-gexp)
                     (service-extension profile-service-type
                                        shepherd-packages)))
   (default-value (shepherd-configuration))
   (description
    "Run the GNU Shepherd as PID 1---i.e., the operating system's first
process.  The Shepherd takes care of managing services such as daemons by
ensuring they are started and stopped in the right order.")))

(define %shepherd-root-service
  ;; The root shepherd service, aka. PID 1.  Its parameter is a
  ;; <shepherd-configuration>.
  (service shepherd-root-service-type))

(define-syntax shepherd-service-type
  (syntax-rules (description)
    "Return a <service-type> denoting a simple shepherd service--i.e., the type
for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else.  When
DEFAULT is given, use it as the service's default value."
    ((_ service-name proc default (description text))
     (service-type
      (name service-name)
      (extensions
       (list (service-extension shepherd-root-service-type
                                (compose list proc))))
      (default-value default)
      (description text)))
    ((_ service-name proc (description text))
     (service-type
      (name service-name)
      (extensions
       (list (service-extension shepherd-root-service-type
                                (compose list proc))))
      (description text)))))

(define %default-imported-modules
  ;; Default set of modules imported for a service's consumption.
  '((guix build utils)
    (guix build syscalls)))

(define %default-modules
  ;; Default set of modules visible in a service's file.
  `((shepherd service)
    ((guix build utils) #:hide (delete))
    (guix build syscalls)))

(define-with-syntax-properties (validate-provision (provision properties))
  (match provision
    (((? symbol?) ..1) provision)
    (_
     (raise
      (make-compound-condition
       (condition
        (&error-location
         (location (source-properties->location properties))))
       (formatted-message
        (G_ "'provision' must be a non-empty list of symbols")))))))

(define-record-type* <shepherd-service>
  shepherd-service make-shepherd-service
  shepherd-service?
  (documentation shepherd-service-documentation        ;string
                 (default "[No documentation.]"))
  (provision     shepherd-service-provision            ;list of symbols
                 (sanitize validate-provision))
  (requirement   shepherd-service-requirement          ;list of symbols
                 (default '()))
  (one-shot?     shepherd-service-one-shot?            ;Boolean
                 (default #f))
  (respawn?      shepherd-service-respawn?             ;Boolean
                 (default #t))
  (respawn-limit shepherd-service-respawn-limit
                 (default #f))
  (respawn-delay shepherd-service-respawn-delay
                 (default #f))
  (free-form     shepherd-service-free-form            ;#f | g-expression (service)
                 (default #f))
  (start         shepherd-service-start                ;g-expression (procedure)
                 (default #~(const #t)))
  (stop          shepherd-service-stop                 ;g-expression (procedure)
                 (default #~(const #f)))
  (actions       shepherd-service-actions              ;list of <shepherd-action>
                 (default '()))
  (auto-start?   shepherd-service-auto-start?          ;Boolean
                 (default #t))
  (modules       shepherd-service-modules              ;list o