From 1b4ec0f2261e1231ff21c5486dc6e75466c5829e Mon Sep 17 00:00:00 2001 From: Alex Sassmannshausen Date: Sun, 23 Feb 2014 11:06:14 +0100 Subject: [PATCH] dmd: Add dmd action rm: remove known services. * modules/dmd/service.scm (deregister-services): New procedure. (dmd-service): Add new action: rm. * dmd.texi (The 'dmd' and 'unknown' services): Document 'rm'. --- dmd.texi | 11 ++++++ modules/dmd/service.scm | 85 +++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 94 insertions(+), 2 deletions(-) diff --git a/dmd.texi b/dmd.texi index f7306db..8ff0451 100644 --- a/dmd.texi +++ b/dmd.texi @@ -854,6 +854,17 @@ Evaluate the Scheme code in @var{file} in a fresh module that uses the @code{(oop goops)} and @code{(dmd services)} modules---as with the @code{--config} option of @command{dmd} (@pxref{Invoking dmd}). +@item rm @var{service-name} +Attempt to remove the service identified by @var{service-name}. +@command{dmd} will first stop the service, if necessary, and then +remove it from the list of registered services. If @var{service-name} +simply does not exist, output a warning and do nothing. If it exists, +but is provided by several services, output a warning and do nothing. +This latter case might occur for instance with the fictional service +web-server, which might be provided by both apache and nginx. If +@var{service-name} is the special string and @code{all}, attempt to +remove all services except for dmd itself. + @item daemonize Fork and go into the background. This should be called before respawnable services are started, as otherwise we would not get the diff --git a/modules/dmd/service.scm b/modules/dmd/service.scm index 6862775..601b6aa 100644 --- a/modules/dmd/service.scm +++ b/modules/dmd/service.scm @@ -761,6 +761,80 @@ otherwise by updating its state." (for-each register-single-service new-services)) +(define (deregister-service service-name) + "For each string in SERVICE-NAME, stop the associated service if +necessary and remove it from the services table. If SERVICE-NAME is +the special string 'all', remove all services except for dmd. + +This will remove a service either if it is identified by its canonical +name, or if it is the only service providing the service that is +requested to be removed." + (define (deregister service) + (if (running? service) + (stop service)) + ;; Remove services provided by service from the hash table. + (for-each + (lambda (name) + (let ((old (lookup-services name))) + (if (= 1 (length old)) + ;; Only service provides this service, ergo: + (begin + ;; Reduce provided services count + (set! services-cnt (1- services-cnt)) + ;; Remove service entry from services. + (hashq-remove! services name)) + ;; ELSE: remove service from providing services. + (hashq-set! services name + (remove + (lambda (lk-service) + (eq? (canonical-name service) + (canonical-name lk-service))) + old))))) + (provided-by service))) + (define (service-pairs) + "Return '(name . service) of all user-registered services." + (filter (lambda (service-pair) (if service-pair #t #f)) + (hash-map->list + (lambda (key value) + (let ((can-name (canonical-name (car value)))) + (if (and (null? (cdr value)) + (eq? key can-name) + (not (eq? can-name 'dmd))) + (cons key (car value)) #f))) + services))) + + (let ((name (string->symbol service-name))) + (cond ((eq? name 'all) + ;; Special 'remove all' case. + (let ((pairs (service-pairs))) + (local-output "Unloading all optional services: '~a'..." + (map car pairs)) + (for-each deregister (map cdr pairs)) + (local-output "Done."))) + (else + ;; Removing only one service. + (let ((services (lookup-services name))) + (cond ((null? services) + (local-output "'~a' is an uknown service." name)) + ((= 1 (length services)) + ;; Are we removing a user service… + (if (eq? (canonical-name (car services)) name) + (local-output "Removing service '~a'..." + name) + ;; or a virtual service? + (local-output + (string-append "Removing service '~a' " + "providing '~a'...") + (canonical-name (car services)) name)) + (deregister (car services)) + (local-output "Done.")) + (else + ;; Service name to ambiguous + (local-output + (string-append "'~a' identifies more than one " + "service to be stopped: '~a'.") + name (map canonical-name services))))))))) + ;;; Tests for validity of the slots of objects. ;; Test if OBJ is a list that only contains symbols. @@ -867,6 +941,13 @@ dangerous. You have been warned." (local-output "Failed to load from '~a': ~a." file-name (strerror (system-error-errno args))) #f)))) + ;; Unload a service + (rm + "Remove the service identified by SERVICE-NAME or all services +except for dmd if SERVICE-NAME is 'all' from services. Stop services +before removing them if needed." + (lambda (running service-name) + (deregister-service service-name))) ;; Go into the background. (daemonize "Go into the background. Be careful, this means that a new @@ -884,8 +965,8 @@ This status gets written into a file on termination, so that we can restore the status on next startup. Optionally, you can pass a file name as argument that will be used to store the status." (lambda* (running #:optional (file #f)) - (set! persistency #t) - (when file + (set! persistency #t) + (when file (set! persistency-state-file file)))) (no-persistency "Don't safe state in a file on exit." -- 1.7.9.5