SummaryRefsLogTreeCommitDiffStats
path: root/src/mcron/scripts/crontab.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/mcron/scripts/crontab.scm')
-rw-r--r--src/mcron/scripts/crontab.scm69
1 files changed, 34 insertions, 35 deletions
diff --git a/src/mcron/scripts/crontab.scm b/src/mcron/scripts/crontab.scm
index 502fec6..abc3d7b 100644
--- a/src/mcron/scripts/crontab.scm
+++ b/src/mcron/scripts/crontab.scm
@@ -42,6 +42,36 @@
(version (single-char #\v) (value #f))
(help (single-char #\h) (value #f))))
+(define (hit-server user-name)
+ "Tell the running cron daemon that the user corresponding to
+USER-NAME has modified his crontab. USER-NAME is written to the
+'/var/cron/socket' UNIX socket."
+ (catch #t
+ (lambda ()
+ (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+ (connect socket AF_UNIX config-socket-file)
+ (display user-name socket)
+ (close socket)))
+ (lambda (key . args)
+ (display "Warning: a cron daemon is not running.\n"))))
+
+(define (in-access-file? file name)
+ "Scan FILE which should contain one user name per line (such as
+'/var/cron/allow' and '/var/cron/deny'). Return #t if NAME is in there, and
+#f otherwise. if FILE cannot be opened, a error is signaled."
+ (catch #t
+ (lambda ()
+ (with-input-from-file file
+ (lambda ()
+ (let loop ((input (read-line)))
+ (cond ((eof-object? input)
+ #f)
+ ((string=? input name)
+ #t)
+ (else
+ (loop (read-line))))))))
+ (const '())))
+
;;;
;;; Entry point.
@@ -57,41 +87,10 @@
((option-ref opts 'version #f)
(show-version "crontab")
(exit 0)))
- (let ((hit-server
- (λ (user-name)
- ;; Procedure to communicate with running cron daemon that a user
- ;; has modified his crontab. The user name is written to the
- ;; /var/cron/socket UNIX socket.
- (catch #t
- (λ ()
- (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
- (connect socket AF_UNIX config-socket-file)
- (display user-name socket)
- (close socket)))
- (λ (key . args)
- (display "Warning: a cron daemon is not running.\n")))))
-
- ;; Procedure to scan a file containing one user name per line (such
- ;; as /var/cron/allow and /var/cron/deny), and determine if the
- ;; given name is in there. The procedure returns #t, #f, or '() if
- ;; the file does not exist.
- (in-access-file?
- (λ (file name)
- (catch #t
- (λ ()
- (with-input-from-file file
- (λ ()
- (let loop ((input (read-line)))
- (if (eof-object? input)
- #f
- (if (string=? input name)
- #t
- (loop (read-line))))))))
- (λ (key . args) '()))))
-
- ;; This program should have been installed SUID root. Here we get
- ;; the passwd entry for the real user who is running this program.
- (crontab-real-user (passwd:name (getpw (getuid)))))
+ (let ((crontab-real-user
+ ;; This program should have been installed SUID root. Here we get
+ ;; the passwd entry for the real user who is running this program.
+ (passwd:name (getpw (getuid)))))
;; If the real user is not allowed to use crontab due to the
;; /var/cron/allow and/or /var/cron/deny files, bomb out now.