gnu/services/mcron.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu services mcron)
  20   #:use-module (gnu services)
  21   #:use-module (gnu services base)
  22   #:use-module (gnu services shepherd)
  23   #:autoload   (gnu packages guile) (mcron2)
  24   #:use-module (guix records)
  25   #:use-module (guix gexp)
  26   #:use-module (srfi srfi-1)
  27   #:use-module (ice-9 match)
  28   #:use-module (ice-9 vlist)
  29   #:export (mcron-configuration
  30             mcron-configuration?
  31             mcron-configuration-mcron
  32             mcron-configuration-jobs
  33
  34             mcron-service-type
  35             mcron-service))
  36
  37 ;;; Commentary:
  38 ;;;
  39 ;;; This module implements a service that to run instances of GNU mcron, a
  40 ;;; periodic job execution daemon.  Example of a service:
  41 ;;
  42 ;;  (service mcron-service-type
  43 ;;           (mcron-configuration
  44 ;;            (jobs (list #~(job next-second-from
  45 ;;                               (lambda ()
  46 ;;                                 (call-with-output-file "/dev/console"
  47 ;;                                   (lambda (port)
  48 ;;                                     (display "hello!\n" port)))))))))
  49 ;;;
  50 ;;; Code:
  51
  52 (define-record-type* <mcron-configuration> mcron-configuration
  53   make-mcron-configuration
  54   mcron-configuration?
  55   (mcron             mcron-configuration-mcron    ;package
  56                      (default mcron2))
  57   (jobs              mcron-configuration-jobs     ;list of <mcron-job>
  58                      (default '())))
  59
  60 (define (job-file job)
  61   (scheme-file "mcron-job" job))
  62
  63 (define mcron-shepherd-services
  64   (match-lambda
  65     (($ <mcron-configuration> mcron ())           ;nothing to do!
  66      '())
  67     (($ <mcron-configuration> mcron jobs)
  68      (list (shepherd-service
  69             (provision '(mcron))
  70             (requirement '(user-processes))
  71             (modules `((srfi srfi-1)
  72                        (srfi srfi-26)
  73                        ,@%default-modules))
  74             (start #~(make-forkexec-constructor
  75                       (list (string-append #$mcron "/bin/mcron")
  76                             #$@(map job-file jobs))
  77
  78                       ;; Disable auto-compilation of the job files and set a
  79                       ;; sane value for 'PATH'.
  80                       #:environment-variables
  81                       (cons* "GUILE_AUTO_COMPILE=0"
  82                              "PATH=/run/current-system/profile/bin"
  83                              (remove (cut string-prefix? "PATH=" <>)
  84                                      (environ)))))
  85             (stop #~(make-kill-destructor)))))))
  86
  87 (define mcron-service-type
  88   (service-type (name 'mcron)
  89                 (extensions
  90                  (list (service-extension shepherd-root-service-type
  91                                           mcron-shepherd-services)
  92                        (service-extension profile-service-type
  93                                           (compose list
  94                                                    mcron-configuration-mcron))))
  95                 (compose concatenate)
  96                 (extend (lambda (config jobs)
  97                           (mcron-configuration
  98                            (inherit config)
  99                            (jobs (append (mcron-configuration-jobs config)
 100                                          jobs)))))))
 101
 102 (define* (mcron-service jobs #:optional (mcron mcron2))
 103   "Return an mcron service running @var{mcron} that schedules @var{jobs}, a
 104 list of gexps denoting mcron job specifications.
 105
 106 This is a shorthand for:
 107 @example
 108   (service mcron-service-type
 109            (mcron-configuration (mcron mcron) (jobs jobs)))
 110 @end example
 111 "
 112   (service mcron-service-type
 113            (mcron-configuration (mcron mcron) (jobs jobs))))
 114
 115 ;;; mcron.scm ends here