utils: Add 'get-user'
* src/mcron/utils.scm (get-user): New procedure. * src/mcron/job-specifier.scm (job): Use it. * src/mcron/base.scm (remove-user-jobs): Likewise.
This commit is contained in:
parent
07017255a1
commit
a1f9e3d7a7
3 changed files with 17 additions and 8 deletions
|
|
@ -28,6 +28,7 @@
|
|||
(define-module (mcron base)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (mcron environment)
|
||||
#:use-module (mcron utils)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-2)
|
||||
#:use-module (srfi srfi-9)
|
||||
|
|
@ -85,9 +86,7 @@ This procedure is deprecated."
|
|||
(define* (remove-user-jobs user #:key (schedule %global-schedule))
|
||||
"Remove user jobs from SCHEDULE belonging to USER. USER must be either a
|
||||
username, a UID, or a passwd entry."
|
||||
(let ((user* (if (or (string? user) (integer? user))
|
||||
(getpw user)
|
||||
user)))
|
||||
(let ((user* (get-user user)))
|
||||
(set-schedule-user! schedule
|
||||
(filter (lambda (job)
|
||||
(not (eqv? (passwd:uid user*)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;;; job-specifier.scm -- public interface for defining jobs
|
||||
;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
|
||||
;;; Copyright © 2016, 2017, 2018 Mathieu Lirzin <mthl@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mcron.
|
||||
;;;
|
||||
|
|
@ -30,6 +30,7 @@
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (mcron base)
|
||||
#:use-module (mcron environment)
|
||||
#:use-module (mcron utils)
|
||||
#:use-module (mcron vixie-time)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:re-export (append-environment-mods)
|
||||
|
|
@ -241,9 +242,7 @@ go into the list. For example, (range 1 6 2) returns '(1 3 5)."
|
|||
((procedure? action) "Lambda function")
|
||||
((string? action) action)
|
||||
((list? action) (simple-format #f "~A" action))))
|
||||
(user* (if (or (string? user) (integer? user))
|
||||
(getpw user)
|
||||
user)))
|
||||
(user* (get-user user)))
|
||||
(add-job (lambda (current-time)
|
||||
(parameterize ((%current-action-time current-time))
|
||||
;; Allow for daylight savings time changes.
|
||||
|
|
|
|||
|
|
@ -29,7 +29,8 @@
|
|||
parse-args
|
||||
show-version
|
||||
show-package-information
|
||||
process-update-request)
|
||||
process-update-request
|
||||
get-user)
|
||||
#:re-export (option-ref
|
||||
read-string))
|
||||
|
||||
|
|
@ -101,3 +102,13 @@ comes in on the above socket."
|
|||
(remove-user-jobs user)
|
||||
(set-configuration-user user)
|
||||
(read-vixie-file (string-append config-spool-dir "/" user-name)))))))
|
||||
|
||||
(define (get-user spec)
|
||||
"Return the passwd entry corresponding to SPEC. If SPEC is passwd entry
|
||||
then return it. If SPEC is not a valid specification throw an exception."
|
||||
(cond ((or (string? spec) (integer? spec))
|
||||
(getpw spec))
|
||||
((vector? spec) ;assume a user passwd entry
|
||||
spec)
|
||||
(else
|
||||
(throw 'invalid-user-specification spec))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue