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.
This commit is contained in:
Ludovic Courtès 2023-08-06 18:59:15 +02:00
parent 161d010d40
commit 1c30d5a6bf
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 45 additions and 131 deletions

View file

@ -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 @@ (define-module (gnu home services mcron)
;; ;;
;;; 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

View file

@ -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 @@ (define-module (gnu services mcron)
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 @@ (define-module (gnu services mcron)
;;; ;;;
;;; 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 @@ (define (shepherd-schedule-action mcron 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 @@ (define (mcron-shepherd-services config)
(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 @@ (define mcron-service-type
(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