[jackhill/guix/guix.git] / gnu / services / mcron.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 mcron)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services shepherd)
  #:autoload   (gnu packages guile) (mcron2)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:use-module (ice-9 vlist)
  #:export (mcron-configuration
            mcron-configuration?
            mcron-configuration-mcron
            mcron-configuration-jobs

            mcron-service-type
            mcron-service))

;;; Commentary:
;;;
;;; This module implements a service that to run instances of GNU mcron, a
;;; periodic job execution daemon.  Example of a service:
;;
;;  (service mcron-service-type
;;           (mcron-configuration
;;            (jobs (list #~(job next-second-from
;;                               (lambda ()
;;                                 (call-with-output-file "/dev/console"
;;                                   (lambda (port)
;;                                     (display "hello!\n" port)))))))))
;;;
;;; Code:

(define-record-type* <mcron-configuration> mcron-configuration
  make-mcron-configuration
  mcron-configuration?
  (mcron             mcron-configuration-mcron    ;package
                     (default mcron2))
  (jobs              mcron-configuration-jobs     ;list of <mcron-job>
                     (default '())))

(define (job-file job)
  (scheme-file "mcron-job" job))

(define mcron-shepherd-services
  (match-lambda
    (($ <mcron-configuration> mcron ())           ;nothing to do!
     '())
    (($ <mcron-configuration> mcron jobs)
     (list (shepherd-service
            (provision '(mcron))
            (requirement '(user-processes))
            (modules `((srfi srfi-1)
                       (srfi srfi-26)
                       ,@%default-modules))
            (start #~(make-forkexec-constructor
                      (list (string-append #$mcron "/bin/mcron")
                            #$@(map job-file jobs))

                      ;; Disable auto-compilation of the job files and set a
                      ;; sane value for 'PATH'.
                      #:environment-variables
                      (cons* "GUILE_AUTO_COMPILE=0"
                             "PATH=/run/current-system/profile/bin"
                             (remove (cut string-prefix? "PATH=" <>)
                                     (environ)))))
            (stop #~(make-kill-destructor)))))))

(define mcron-service-type
  (service-type (name 'mcron)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          mcron-shepherd-services)
                       (service-extension profile-service-type
                                          (compose list
                                                   mcron-configuration-mcron))))
                (compose concatenate)
                (extend (lambda (config jobs)
                          (mcron-configuration
                           (inherit config)
                           (jobs (append (mcron-configuration-jobs config)
                                         jobs)))))))

(define* (mcron-service jobs #:optional (mcron mcron2))
  "Return an mcron service running @var{mcron} that schedules @var{jobs}, a
list of gexps denoting mcron job specifications.

This is a shorthand for:
@example
  (service mcron-service-type
           (mcron-configuration (mcron mcron) (jobs jobs)))
@end example
"
  (service mcron-service-type
           (mcron-configuration (mcron mcron) (jobs jobs))))

;;; mcron.scm ends here
Commit	Line	Data
c311089b LC	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