home: services: mcron: Define as a mapping of the system service.
* gnu/services/mcron.scm (list-of-gexps?): Remove. (<mcron-configuration>): Rewrite using 'define-record-type*'. [home-service?]: New field. [log-file]: Make thunked and changed default value. (mcron-shepherd-services): Honor 'home-service?' and remove use of 'maybe-value-set?'. (mcron-service-type): Inherit 'home-service?' from CONFIG. (generate-doc): Remove. * gnu/home/services/mcron.scm (list-of-gexp?) (<home-mcron-configuration>, job-files, shepherd-schedule-action) (home-mcron-shepherd-services, home-mcron-profile) (home-mcron-extend, generate-doc): Remove. (home-mcron-configuration): Turn into a macro. (home-mcron-service-type): Define in terms of 'system->home-service-type'. <top level>: Add service type mapping.
parent
161d010d40
commit
1c30d5a6bf
|
@ -2,6 +2,7 @@
|
||||||
;;; Copyright © 2021, 2023 Andrew Tropin <andrew@trop.in>
|
;;; Copyright © 2021, 2023 Andrew Tropin <andrew@trop.in>
|
||||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||||
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||||
|
;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -19,16 +20,9 @@
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (gnu home services mcron)
|
(define-module (gnu home services mcron)
|
||||||
#:use-module (gnu packages guile-xyz)
|
|
||||||
#:use-module (gnu home services)
|
#:use-module (gnu home services)
|
||||||
#:use-module (gnu services configuration)
|
|
||||||
#:use-module (gnu services shepherd)
|
|
||||||
#:use-module (gnu home services shepherd)
|
#:use-module (gnu home services shepherd)
|
||||||
#:use-module (guix records)
|
#:use-module (gnu services mcron) ;for the service mapping
|
||||||
#:use-module (guix gexp)
|
|
||||||
#:use-module (srfi srfi-1)
|
|
||||||
#:use-module (ice-9 match)
|
|
||||||
|
|
||||||
#:export (home-mcron-configuration
|
#:export (home-mcron-configuration
|
||||||
home-mcron-service-type))
|
home-mcron-service-type))
|
||||||
|
|
||||||
|
@ -55,86 +49,16 @@
|
||||||
;;
|
;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define list-of-gexps?
|
(define-syntax-rule (home-mcron-configuration fields ...)
|
||||||
(list-of gexp?))
|
;; Macro provided for backward compatibility.
|
||||||
|
(for-home (mcron-configuration fields ...)))
|
||||||
(define-configuration/no-serialization home-mcron-configuration
|
|
||||||
(mcron (file-like mcron) "The mcron package to use.")
|
|
||||||
(jobs
|
|
||||||
(list-of-gexps '())
|
|
||||||
"This is a list of gexps (@pxref{G-Expressions}), where each gexp
|
|
||||||
corresponds to an mcron job specification (@pxref{Syntax, mcron job
|
|
||||||
specifications,, mcron, GNU@tie{}mcron}).")
|
|
||||||
(log? (boolean #t) "Log messages to standard output.")
|
|
||||||
(log-format
|
|
||||||
(string "~1@*~a ~a: ~a~%")
|
|
||||||
"@code{(ice-9 format)} format string for log messages. The default value
|
|
||||||
produces messages like \"@samp{@var{pid} @var{name}:
|
|
||||||
@var{message}\"} (@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}).
|
|
||||||
Each message is also prefixed by a timestamp by GNU Shepherd."))
|
|
||||||
|
|
||||||
(define job-files (@@ (gnu services mcron) job-files))
|
|
||||||
(define shepherd-schedule-action
|
|
||||||
(@@ (gnu services mcron) shepherd-schedule-action))
|
|
||||||
|
|
||||||
(define (home-mcron-shepherd-services config)
|
|
||||||
(match-record config <home-mcron-configuration>
|
|
||||||
(mcron jobs log? log-format)
|
|
||||||
(if (null? jobs)
|
|
||||||
'() ;no jobs to run
|
|
||||||
(let ((files (job-files mcron jobs)))
|
|
||||||
(list (shepherd-service
|
|
||||||
(documentation "User cron jobs.")
|
|
||||||
(provision '(mcron))
|
|
||||||
(modules `((srfi srfi-1)
|
|
||||||
(srfi srfi-26)
|
|
||||||
(ice-9 popen) ;for the 'schedule' action
|
|
||||||
(ice-9 rdelim)
|
|
||||||
(ice-9 match)
|
|
||||||
,@%default-modules))
|
|
||||||
(start #~(make-forkexec-constructor
|
|
||||||
(list (string-append #$mcron "/bin/mcron")
|
|
||||||
#$@(if log?
|
|
||||||
#~("--log" "--log-format" #$log-format)
|
|
||||||
#~())
|
|
||||||
#$@files)
|
|
||||||
#:log-file (string-append
|
|
||||||
(or (getenv "XDG_STATE_HOME")
|
|
||||||
(format #f "~a/.local/state"
|
|
||||||
(getenv "HOME")))
|
|
||||||
"/log/mcron.log")))
|
|
||||||
(stop #~(make-kill-destructor))
|
|
||||||
(actions
|
|
||||||
(list (shepherd-schedule-action mcron files)))))))))
|
|
||||||
|
|
||||||
(define home-mcron-profile (compose list home-mcron-configuration-mcron))
|
|
||||||
|
|
||||||
(define (home-mcron-extend config jobs)
|
|
||||||
(home-mcron-configuration
|
|
||||||
(inherit config)
|
|
||||||
(jobs (append (home-mcron-configuration-jobs config)
|
|
||||||
jobs))))
|
|
||||||
|
|
||||||
(define home-mcron-service-type
|
(define home-mcron-service-type
|
||||||
(service-type (name 'home-mcron)
|
(service-type
|
||||||
(extensions
|
(inherit (system->home-service-type mcron-service-type))
|
||||||
(list (service-extension
|
(default-value (for-home (mcron-configuration)))))
|
||||||
home-shepherd-service-type
|
|
||||||
home-mcron-shepherd-services)
|
|
||||||
(service-extension
|
|
||||||
home-profile-service-type
|
|
||||||
home-mcron-profile)))
|
|
||||||
(compose concatenate)
|
|
||||||
(extend home-mcron-extend)
|
|
||||||
(default-value (home-mcron-configuration))
|
|
||||||
(description
|
|
||||||
"Install and configure the GNU mcron cron job manager.")))
|
|
||||||
|
|
||||||
|
(define-service-type-mapping
|
||||||
;;;
|
mcron-service-type => home-mcron-service-type)
|
||||||
;;; Generate documentation.
|
|
||||||
;;;
|
|
||||||
(define (generate-doc)
|
|
||||||
(configuration->documentation 'home-mcron-configuration))
|
|
||||||
|
|
||||||
;;; mcron.scm ends here
|
;;; mcron.scm ends here
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2016-2020, 2023 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||||
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
|
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
|
||||||
;;;
|
;;;
|
||||||
|
@ -20,10 +20,8 @@
|
||||||
|
|
||||||
(define-module (gnu services mcron)
|
(define-module (gnu services mcron)
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu services configuration)
|
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
#:use-module (gnu packages guile-xyz)
|
#:use-module (gnu packages guile-xyz)
|
||||||
#:use-module (guix deprecation)
|
|
||||||
#:use-module (guix records)
|
#:use-module (guix records)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -37,6 +35,7 @@
|
||||||
mcron-configuration-log-file
|
mcron-configuration-log-file
|
||||||
mcron-configuration-log-format
|
mcron-configuration-log-format
|
||||||
mcron-configuration-date-format
|
mcron-configuration-date-format
|
||||||
|
mcron-configuration-home-service?
|
||||||
|
|
||||||
mcron-service-type))
|
mcron-service-type))
|
||||||
|
|
||||||
|
@ -55,40 +54,34 @@
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define list-of-gexps?
|
;; Configuration of mcron.
|
||||||
(list-of gexp?))
|
;; XXX: 'define-configuration' cannot be used here due to the need for
|
||||||
|
;; 'thunked' and 'innate' fields as well as 'this-mcron-configuration'.
|
||||||
|
(define-record-type* <mcron-configuration> mcron-configuration
|
||||||
|
make-mcron-configuration
|
||||||
|
mcron-configuration?
|
||||||
|
this-mcron-configuration
|
||||||
|
|
||||||
(define-maybe/no-serialization string)
|
(mcron mcron-configuration-mcron ;file-like
|
||||||
|
(default mcron))
|
||||||
|
(jobs mcron-configuration-jobs ;list of gexps
|
||||||
|
(default '()))
|
||||||
|
(log? mcron-configuration-log? ;Boolean
|
||||||
|
(default #t))
|
||||||
|
(log-file mcron-configuration-log-file ;string | gexp
|
||||||
|
(thunked)
|
||||||
|
(default
|
||||||
|
(if (mcron-configuration-home-service?
|
||||||
|
this-mcron-configuration)
|
||||||
|
#~(string-append %user-log-dir "/mcron.log")
|
||||||
|
"/var/log/mcron.log")))
|
||||||
|
(log-format mcron-configuration-log-format ;string
|
||||||
|
(default "~1@*~a ~a: ~a~%"))
|
||||||
|
(date-format mcron-configuration-date-format ;string | #f
|
||||||
|
(default #f))
|
||||||
|
|
||||||
(define-configuration/no-serialization mcron-configuration
|
(home-service? mcron-configuration-home-service?
|
||||||
(mcron
|
(default for-home?) (innate)))
|
||||||
(file-like mcron)
|
|
||||||
"The mcron package to use.")
|
|
||||||
|
|
||||||
(jobs
|
|
||||||
(list-of-gexps '())
|
|
||||||
"This is a list of gexps (@pxref{G-Expressions}), where each gexp
|
|
||||||
corresponds to an mcron job specification (@pxref{Syntax, mcron job
|
|
||||||
specifications,, mcron, GNU@tie{}mcron}).")
|
|
||||||
|
|
||||||
(log?
|
|
||||||
(boolean #t)
|
|
||||||
"Log messages to standard output.")
|
|
||||||
|
|
||||||
(log-file
|
|
||||||
(string "/var/log/mcron.log")
|
|
||||||
"Log file location.")
|
|
||||||
|
|
||||||
(log-format
|
|
||||||
(string "~1@*~a ~a: ~a~%")
|
|
||||||
"@code{(ice-9 format)} format string for log messages. The default value
|
|
||||||
produces messages like @samp{@var{pid} @var{name}: @var{message}}
|
|
||||||
(@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}).
|
|
||||||
Each message is also prefixed by a timestamp by GNU Shepherd.")
|
|
||||||
|
|
||||||
(date-format
|
|
||||||
maybe-string
|
|
||||||
"@code{(srfi srfi-19)} format string for date."))
|
|
||||||
|
|
||||||
(define (job-files mcron jobs)
|
(define (job-files mcron jobs)
|
||||||
"Return a list of file-like object for JOBS, a list of gexps."
|
"Return a list of file-like object for JOBS, a list of gexps."
|
||||||
|
@ -158,13 +151,15 @@ files."
|
||||||
|
|
||||||
(define (mcron-shepherd-services config)
|
(define (mcron-shepherd-services config)
|
||||||
(match-record config <mcron-configuration>
|
(match-record config <mcron-configuration>
|
||||||
(mcron jobs log? log-file log-format date-format)
|
(mcron jobs log? log-file log-format date-format home-service?)
|
||||||
(if (eq? jobs '())
|
(if (eq? jobs '())
|
||||||
'() ;nothing to do
|
'() ;nothing to do
|
||||||
(let ((files (job-files mcron jobs)))
|
(let ((files (job-files mcron jobs)))
|
||||||
(list (shepherd-service
|
(list (shepherd-service
|
||||||
(provision '(mcron))
|
(provision '(mcron))
|
||||||
(requirement '(user-processes))
|
(requirement (if home-service?
|
||||||
|
'()
|
||||||
|
'(user-processes)))
|
||||||
(modules `((srfi srfi-1)
|
(modules `((srfi srfi-1)
|
||||||
(srfi srfi-26)
|
(srfi srfi-26)
|
||||||
(ice-9 popen) ;for the 'schedule' action
|
(ice-9 popen) ;for the 'schedule' action
|
||||||
|
@ -175,7 +170,7 @@ files."
|
||||||
(list #$(file-append mcron "/bin/mcron")
|
(list #$(file-append mcron "/bin/mcron")
|
||||||
#$@(if log?
|
#$@(if log?
|
||||||
`("--log" "--log-format" ,log-format
|
`("--log" "--log-format" ,log-format
|
||||||
,@(if (maybe-value-set? date-format)
|
,@(if date-format
|
||||||
(list "--date-format"
|
(list "--date-format"
|
||||||
date-format)
|
date-format)
|
||||||
'()))
|
'()))
|
||||||
|
@ -209,15 +204,10 @@ files."
|
||||||
(extend (lambda (config jobs)
|
(extend (lambda (config jobs)
|
||||||
(mcron-configuration
|
(mcron-configuration
|
||||||
(inherit config)
|
(inherit config)
|
||||||
|
(home-service?
|
||||||
|
(mcron-configuration-home-service? config))
|
||||||
(jobs (append (mcron-configuration-jobs config)
|
(jobs (append (mcron-configuration-jobs config)
|
||||||
jobs)))))
|
jobs)))))
|
||||||
(default-value (mcron-configuration)))) ;empty job list
|
(default-value (mcron-configuration)))) ;empty job list
|
||||||
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; Generate documentation.
|
|
||||||
;;;
|
|
||||||
(define (generate-doc)
|
|
||||||
(configuration->documentation 'mcron-configuration))
|
|
||||||
|
|
||||||
;;; mcron.scm ends here
|
;;; mcron.scm ends here
|
||||||
|
|
Reference in New Issue