From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Sassmannshausen Subject: dmd: Unload one or all services at runtime. Date: Tue, 25 Feb 2014 09:22:54 +0100 Message-ID: <87d2ib1u01.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:56719) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WIDIZ-0007AH-HR for guix-devel@gnu.org; Tue, 25 Feb 2014 03:23:39 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1WIDIR-00033m-2R for guix-devel@gnu.org; Tue, 25 Feb 2014 03:23:31 -0500 Received: from mail-ea0-x22a.google.com ([2a00:1450:4013:c01::22a]:44660) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WIDIQ-00033V-Le for guix-devel@gnu.org; Tue, 25 Feb 2014 03:23:22 -0500 Received: by mail-ea0-f170.google.com with SMTP id g15so17678eak.15 for ; Tue, 25 Feb 2014 00:23:21 -0800 (PST) Received: from user-ThinkPad-X60 ([91.178.33.113]) by mx.google.com with ESMTPSA id m1sm73705560een.7.2014.02.25.00.23.18 for (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Tue, 25 Feb 2014 00:23:19 -0800 (PST) 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-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel --=-=-= Content-Type: text/plain Hello, Currently dmd allows you to dynamically load new services into a running instance. Unfortunately, currently dmd will not allow you to carry out corrections to a running service by reloading its definition. The attached patch is a first step towards this aim. It allows you to unload individual services (by their name) or all known user services. It even allows you to unload the special service dmd itself, which is the same as sending the stop command to dmd. For example: $: dmd rm dmd apache // Unload the apache server $: dmd rm dmd web-server // Unload the service providing // a web server if there is only one. $: dmd rm dmd all // Unload all user services. You can then reload the relevant service's definition (or, if you ran 'dmd rm dmd all', you can reload your dmd.d/init.scm). In future this might provide the foundation for a 'reload' action for dmd. Feedback welcome. Best wishes, Alex --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=0001-dmd-Add-dmd-action-rm-remove-known-services.patch Content-Transfer-Encoding: 8bit Content-Description: dmd: unload patch >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 --=-=-=--