From mboxrd@z Thu Jan 1 00:00:00 1970 From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Subject: Re: cron-service Date: Sun, 01 May 2016 15:14:57 +0200 Message-ID: <871t5lc432.fsf@gnu.org> References: <20160430192744.1fbe081f@scratchpost.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:50841) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1awrDT-0007US-9E for guix-devel@gnu.org; Sun, 01 May 2016 09:15:26 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1awrDG-0001V1-Qn for guix-devel@gnu.org; Sun, 01 May 2016 09:15:13 -0400 In-Reply-To: <20160430192744.1fbe081f@scratchpost.org> (Danny Milosavljevic's message of "Sat, 30 Apr 2016 19:27:44 +0200") List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: Danny Milosavljevic Cc: guix-devel@gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi! Danny Milosavljevic skribis: > I've seen the mcron package but I don't understand how it gets launched. = Should there be a cron-service ? Ah ha! I have a preliminary mcron service (attached). It=E2=80=99s undocumented and subject to change, but feedback is welcome! Currently it=E2=80=99s designed to run on =E2=80=98mcron=E2=80=99 process p= er user/group pair. Eventually, we=E2=80=99ll probably change mcron to allow us to run a single instance as root, and it will automatically setuid/setgid for each job. I told Mathieu Lirzin off-line about a couple of minor issues that would need to be fixed in his mcron branch=C2=B9, after which we can probably commit it (but let=E2=80=99s not put pressure on him!). Thanks, Ludo=E2=80=99. =C2=B9 https://notabug.org/mthl/mcron --=-=-= Content-Type: text/plain; charset=utf-8 Content-Disposition: inline; filename=mcron.scm Content-Transfer-Encoding: quoted-printable Content-Description: mcron service ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2016 Ludovic Court=C3=A8s ;;; ;;; 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 services mcron) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services shepherd) #:autoload (gnu packages guile) (mcron) #: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-job mcron-job? mcron-job-user mcron-job-group mcron-job-specification mcron-job-imported-modules mcron-job-modules 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 (mcron-job ;; (user "alice") ;; (specification ;; #~(job next-second-from ;; (lambda () ;; (call-with-output-file "/dev/console" ;; (lambda (port) ;; (display "hello!\n" port))))))))))) ;;; ;;; Code: (define-record-type* mcron-configuration make-mcron-configuration mcron-configuration? (mcron mcron-configuration-mcron ;package (default mcron)) (jobs mcron-configuration-jobs ;list of (default '()))) (define-record-type* mcron-job make-mcron-job mcron-job? (user mcron-job-user (default "root")) ;string (group mcron-job-group (default #f)) ;string | #f (specification mcron-job-specification) ;gexp (imported-modules mcron-job-imported-modules ;list (default '())) (modules mcron-job-modules ;list (default '()))) (define (job-file job) (scheme-file "mcron-job" (mcron-job-specification job))) (define (mcron-shepherd-service mcron jobs) (match jobs ((($ user group) _ ...) (shepherd-service (provision (list (string->symbol (string-append "mcron-" user (if group (string-append "-" group) ""))))) (requirement '(user-processes)) (start #~(make-forkexec-constructor (list (string-append #$mcron "/bin/mcron") #$@(map job-file jobs)) #:user #$user #:group #$(if user (or group #~(group:name (getgrgid (passwd:gid (getpw #$user)))= )) group))) (stop #~(make-kill-destructor)))))) (define mcron-shepherd-services (match-lambda (($ mcron jobs) (define sorted-jobs (fold (lambda (job result) (match job (($ user group) (vhash-cons (list user group) job result)))) vlist-null jobs)) (define users+groups (delete-duplicates (match jobs ((($ users groups) ...) (zip users groups))))) (map (lambda (key) (mcron-shepherd-service mcron (vhash-fold* cons '() key sorted-= jobs))) users+groups)))) (define mcron-service-type (service-type (name 'mcron) (extensions (list (service-extension shepherd-root-service-type mcron-shepherd-services))) (compose concatenate) (extend (lambda (config jobs) (mcron-configuration (inherit config) (jobs (append (mcron-configuration-jobs config) jobs))))))) (define* (mcron-service #:optional (mcron mcron)) (service mcron-service-type (mcron-configuration (mcron mcron)))) ;;; mcron.scm ends here --=-=-= Content-Type: text/x-patch Content-Disposition: inline modified gnu/packages/guile.scm @@ -41,6 +41,7 @@ #:use-module (gnu packages ed) #:use-module (gnu packages base) #:use-module (gnu packages texinfo) + #:use-module (gnu packages man) #:use-module (gnu packages gettext) #:use-module (gnu packages databases) #:use-module (gnu packages python) @@ -424,6 +425,54 @@ Guile, so its configuration can be written in Scheme; the original cron format is also supported.") (license gpl3+))) +(define-public mcron2 + (let ((commit "573a09a32684c091cb8e8f521946f8bf90a295af")) + (package + (inherit mcron) + (name "mcron2") + (version (string-append (package-version mcron) "-0." + (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://notabug.org/mthl/mcron/") + (commit commit))) + (sha256 + (base32 + "0m4kcpxmcr3rf6l6dd2z0m427gc2y1xx9z361j2zw3jgvamg0yhw")) + (file-name (string-append name "-" version "-checkout")))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config) + ("texinfo" ,texinfo) + ("help2man" ,help2man))) + (arguments + `(#:modules ((ice-9 match) (ice-9 ftw) + ,@%gnu-build-system-modules) + + #:phases (modify-phases %standard-phases + (add-after 'unpack 'bootstrap + (lambda _ + (zero? (system* "autoreconf" "-vfi")))) + (add-after 'install 'wrap-mcron + (lambda* (#:key outputs #:allow-other-keys) + ;; Wrap the 'mcron' command to refer to the right + ;; modules. + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin")) + (site (string-append + out "/share/guile/site"))) + (match (scandir site) + (("." ".." version) + (let ((modules (string-append site "/" version))) + (wrap-program (string-append bin "/mcron") + `("GUILE_LOAD_PATH" ":" prefix + (,modules)) + `("GUILE_LOAD_COMPILED_PATH" ":" prefix + (,modules))) + #t)))))))))))) + (define-public guile-lib (package (name "guile-lib") modified gnu/system/examples/bare-bones.tmpl @@ -2,7 +2,7 @@ ;; for a "bare bones" setup, with no X11 display server. (use-modules (gnu)) -(use-service-modules networking ssh) +(use-service-modules networking ssh mcron) (use-package-modules admin) (operating-system @@ -42,6 +42,15 @@ ;; Add services to the baseline: a DHCP client and ;; an SSH server. - (services (cons* (dhcp-client-service) - (lsh-service #:port-number 2222) + (services (cons* (service mcron-service-type + (mcron-configuration + (jobs (list (mcron-job + (user "alice") + (specification + #~(job next-second-from + (lambda () + (call-with-output-file + "/dev/console" + (lambda (port) + (display "hello!\n" port))))))))))) %base-services))) --=-=-=--