From cd260ae65056b53749e7c03f2498a28af2525934 Mon Sep 17 00:00:00 2001 From: Ioannis Panagiotis Koutsidis
Date: Tue, 10 Jul 2018 20:03:21 +0300 Subject: [PATCH] .socket units --- modules/shepherd.scm | 44 +++-- modules/shepherd/service.scm | 170 ++++++++++------- modules/shepherd/systemd.scm | 354 ++++++++++++++++++++++++----------- 3 files changed, 368 insertions(+), 200 deletions(-) diff --git a/modules/shepherd.scm b/modules/shepherd.scm index 5d97598..45fcb23 100644 --- a/modules/shepherd.scm +++ b/modules/shepherd.scm @@ -31,6 +31,7 @@ #:use-module (shepherd config) #:use-module (shepherd support) #:use-module (shepherd service) + #:use-module (shepherd systemd) #:use-module (shepherd system) #:use-module (shepherd runlevel) #:use-module (shepherd args) @@ -259,9 +260,18 @@ (setvbuf command-source _IOFBF 1024) (process-connection command-source)) (_ #f))) - (match (select (list sock) (list) (list) (if poll-services? 0.5 #f)) - (((sock) _ _) - (read-from sock)) + + (match (select (cons* sock unit-sockets-list) (list) (list) + (if poll-services? 0.5 #f)) + (((rsock _ ...) _ _) + (let* ((sockserv1 (find (lambda (x) + (eq? (slot-ref x 'running) rsock)) + (service-list))) + (sockserv (if sockserv1 (before sockserv1) #f)) + (res (if sockserv (car (lookup-services (string->symbol (car sockserv)))) #f))) + (if res + (start res (accept rsock)) + (read-from sock)))) (_ #f)) (when poll-services? diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm index 5b0d72d..ceba004 100644 --- a/modules/shepherd/service.scm +++ b/modules/shepherd/service.scm @@ -74,6 +74,7 @@ make-forkexec-constructor make-kill-destructor exec-command + exec-command2 fork+exec-command read-pid-file make-system-constructor @@ -102,7 +103,10 @@ action-runtime-error-key action-runtime-error-arguments - condition->sexp)) + condition->sexp + + before + service-list)) ;; Keep track of lazy initialization of SIGCHLD handler (define %sigchld-handler-installed? #f) @@ -161,16 +165,12 @@ respawned, shows that it has been respawned more than TIMES in SECONDS." (requires #:init-keyword #:requires #:init-value '() #:getter required-by) - ;; If `#t', then assume the `running' slot specifies a PID and - ;; respawn it if that process terminates. Otherwise `#f'. + ;; If not #f, then assume the `running' slot specifies a PID and + ;; respawn it if that process terminates. Otherwise it can be + ;; 'on-success, 'on-failure, 'on-abnormal, 'on-watchdog, 'on-abort, or 'always (respawn? #:init-keyword #:respawn? - #:init-value #f + #:init-value 'no #:getter respawn?) - ;; For the systemd restart values. Can be 'no (when respawn? is #f), - ;; 'on-success, 'on-failure, 'on-abnormal, 'on-watchdog, 'on-abort, or 'always - (respawn-systemd #:init-keyword #:respawn-systemd - #:init-value 'always - #:getter respawn-systemd) ;; The action to perform to start the service. This must be a ;; procedure and may take an arbitrary amount of arguments, but it ;; must be possible to call it without any argument. If the @@ -211,7 +211,11 @@ respawned, shows that it has been respawned more than TIMES in SECONDS." (stop-delay? #:init-keyword #:stop-delay? #:init-value #f) ;; The times of the last respawns, most recent first. - (last-respawns #:init-form '())) + (last-respawns #:init-form '()) + ;; if it is a socket unit file, it contains all services that depend on it + (before #:init-keyword #:before + #:init-value '() + #:getter before)) (define (service? obj) "Return true if OBJ is a service." @@ -331,7 +335,7 @@ wire." ;; Start the service itself. Asyncs are blocked so that if ;; the newly-started process dies immediately, the SIGCHLD ;; handler is invoked later, once we have set the 'running' - ;; field. + ;; field . (slot-set! obj 'running (catch #t (lambda () (apply (slot-ref obj 'start) @@ -693,25 +697,17 @@ otherwise return the number that was read (a PID)." (loop))) (apply throw args))))))) -(define* (exec-command command - #:key - (user #f) - (group #f) - (log-file #f) - (directory (default-service-directory)) - (environment-variables (default-environment-variables))) - "Run COMMAND as the current process from DIRECTORY, and with -ENVIRONMENT-VARIABLES (a list of strings like \"PATH=/bin\".) File -descriptors 1 and 2 are kept as is or redirected to LOG-FILE if it's true, -whereas file descriptor 0 (standard input) points to /dev/null; all other file -descriptors are closed prior to yielding control to COMMAND. - -By default, COMMAND is run as the current user. If the USER keyword -argument is present and not false, change to USER immediately before -invoking COMMAND. USER may be a string, indicating a user name, or a -number, indicating a user ID. Likewise, COMMAND will be run under the -current group, unless the GROUP keyword argument is present and not -false." +(define* (exec-command2 command + #:key + (user #f) + (group #f) + (stdin #f) + (stderr #f) + (stdout #f) + (directory (default-service-directory)) + (rdir "/") + (environment-variables (default-environment-variables))) + "Like exec-command but extended" (match command ((program args ...) ;; Become the leader of a new session and session group. @@ -719,30 +715,23 @@ false." (setsid) (chdir directory) + (chroot rdir) (environ environment-variables) - ;; Close all the file descriptors except stdout and stderr. - (let ((max-fd (max-file-descriptors))) - + (unless stdin ;; Redirect stdin to use /dev/null (catch-system-error (close-fdes 0)) ;; Make sure file descriptor zero is used, so we don't end up reusing ;; it for something unrelated, which can confuse some packages. - (dup2 (open-fdes "/dev/null" O_RDONLY) 0) - - (when log-file - (catch #t - (lambda () - ;; Redirect stout and stderr to use LOG-FILE. - (catch-system-error (close-fdes 1)) - (catch-system-error (close-fdes 2)) - (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND)) 1) - (dup2 1 2)) - (lambda (key . args) - (format (current-error-port) - "failed to open log-file ~s:~%" log-file) - (print-exception (current-error-port) #f key args) - (primitive-exit 1)))) + (dup2 (open-fdes "/dev/null" O_RDONLY) 0)) + + (when stdin + (dup2 stdin 0)) + + (when stdout + (dup2 stdout 1)) + (when stderr + (dup2 stderr 2)) ;; setgid must be done *before* setuid, otherwise the user will ;; likely no longer have permissions to setgid. @@ -784,14 +773,54 @@ false." (catch-system-error (close-fdes i)) (loop (+ i 1))))) - (catch 'system-error - (lambda () - (apply execlp program program args)) - (lambda args - (format (current-error-port) - "exec of ~s failed: ~a~%" - program (strerror (system-error-errno args))) - (primitive-exit 1)))))) + (catch 'system-error + (lambda () + (apply execlp program program args)) + (lambda args + (format (current-error-port) + "exec of ~s failed: ~a~%" + program (strerror (system-error-errno args))) + (primitive-exit 1))))) + +(define* (exec-command command + #:key + (user #f) + (group #f) + (log-file #f) + (directory (default-service-directory)) + (environment-variables (default-environment-variables))) + "Run COMMAND as the current process from DIRECTORY, and with +ENVIRONMENT-VARIABLES (a list of strings like \"PATH=/bin\".) File +descriptors 1 and 2 are kept as is or redirected to LOG-FILE if it's true, +whereas file descriptor 0 (standard input) points to /dev/null; all other file +descriptors are closed prior to yielding control to COMMAND. + +By default, COMMAND is run as the current user. If the USER keyword +argument is present and not false, change to USER immediately before +invoking COMMAND. USER may be a string, indicating a user name, or a +number, indicating a user ID. Likewise, COMMAND will be run under the +current group, unless the GROUP keyword argument is present and not +false." + (let ((fd (if log-file + (catch #t + (lambda () + ;; Redirect stout and stderr to use LOG-FILE. + (catch-system-error (close-fdes 1)) + (catch-system-error (close-fdes 2)) + (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND))) + (lambda (key . args) + (format (current-error-port) + "failed to open log-file ~s:~%" log-file) + (print-exception (current-error-port) #f key args) + (primitive-exit 1))) + #f))) + (exec-command command + #:user user + #:group group + #:stdout fd + #:stderr fd + #:directory directory + #:environment-variables environment-variables))) (define* (fork+exec-command command #:key @@ -1031,20 +1060,20 @@ then disable it." (not (respawn-limit-hit? (slot-ref serv 'last-respawns) (car respawn-limit) (cdr respawn-limit)))) - (let* ([e (status:exit-val status)] - [t (status:term-sig status)] - [r (respawn-systemd serv)] - [clean (or (zero? e) - (equal? t SIGHUP) - (equal? t SIGINT) - (equal? t SIGTERM) - (equal? t SIGPIPE))]) - (if (or (equal? r 'always) - (equal? r 'on-watchdog) ;; not implemented yet - (and (equal? r 'on-success) clean) - (and (equal? r 'on-abnormal) (not clean) (equal? e #f)) - (and (equal? r 'on-failure) (not clean)) - (and (equal? r 'on-abort) (equal? t SIGABRT))) + (let* ((e (status:exit-val status)) + (t (status:term-sig status)) + (r (respawn? serv)) + (clean (or (eq? e 0) + (eq? t SIGHUP) + (eq? t SIGINT) + (eq? t SIGTERM) + (eq? t SIGPIPE)))) + (if (or (eq? r 'always) + (eq? r 'on-watchdog) ;; not implemented yet + (and (eq? r 'on-success) clean) + (and (eq? r 'on-abnormal) (not clean) (equal? e #f)) + (and (eq? r 'on-failure) (not clean)) + (and (eq? r 'on-abort) (= t SIGABRT))) (if (not (slot-ref serv 'waiting-for-termination?)) (begin ;; Everything is okay, start it. @@ -1075,7 +1104,6 @@ then disable it." ;; Sanity-checks first. (assert (list-of-symbols? (provided-by new))) (assert (list-of-symbols? (required-by new))) - (assert (boolean? (respawn? new))) ;; Canonical name actually must be canonical. (FIXME: This test ;; is incomplete, since we may add a service later that makes it ;; non-cannonical.) diff --git a/modules/shepherd/systemd.scm b/modules/shepherd/systemd.scm index 77679fa..1dee888 100644 --- a/modules/shepherd/systemd.scm +++ b/modules/shepherd/systemd.scm @@ -17,127 +17,257 @@ ;; along with the GNU Shepherd. If not, see