dmd: Unload one or all services at runtime.

dmd: Unload one or all services at runtime.

[Alex Sassmannshausen]

[-- Attachment #1: Type: text/plain, Size: 943 bytes --]

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


[-- Attachment #2: dmd: unload patch --]
[-- Type: text/x-diff, Size: 6550 bytes --]

From 1b4ec0f2261e1231ff21c5486dc6e75466c5829e Mon Sep 17 00:00:00 2001
From: Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
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 <service> 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

Re: dmd: Unload one or all services at runtime.

[Ludovic Courtès]

Hi!

Alex Sassmannshausen <alex.sassmannshausen@gmail.com> skribis:

> 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.

What happens here if there’s a service running that depends on
‘web-server’?  I’m guessing it should be stopped.

> $: 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.

Cool!

> From 1b4ec0f2261e1231ff21c5486dc6e75466c5829e Mon Sep 17 00:00:00 2001
> From: Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
> 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'.

There are 3 terms used here: remove, unload, and deregister.  For
consistency, I would stick to just one, perhaps ‘unload’.  WDYT?

> +@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.

Mention what happens to services depending on it.

> +This latter case might occur for instance with the fictional service
> +web-server, which might be provided by both apache and nginx.  If

Should be @code{web-server}, @code{apache}, and @code{nginx}.

> +(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)))

Note that the two arms of ‘if’ should always be aligned.
Also, (ice-9 match) can help here IMO:

  (lambda (key value)
    (match value
      ((service)    ; only one service associated with KEY
       (and (eq? key (canonical-name service))
            (not (eq? key 'dmd))
            (cons key service)))
      (_ #f)))      ; two or more services associated with KEY

> +           ;; 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)))))))))

Likewise:

  (match (lookup-services name)
    (()             ; unknown service
     ...)
    ((service)      ; only SERVICE provides NAME
     ...)
    ((services ...) ; ambiguous NAME
     ...))

What about adding a test case, as a shell script (since that’s what we
have currently)?  I’m thinking of something running dmd with a
configuration file that contains a service definition, then running
‘deco unload foo’, and then making sure that ‘deco status dmd’ doesn’t
list it any longer.

Bonus point if there’s another service depending on the one we’re
unloading.

WDYT?  Could you send an updated patch?

Thanks!

Ludo’.

[PATCH 1/2] dmd: Add dmd action unload: unload known services.

[Alex Sassmannshausen]

* modules/dmd/service.scm (deregister-services): New procedure.
  (dmd-service): Add new action: unload.
* dmd.texi (The 'dmd' and 'unknown' services): Document 'unload'.
* tests/basic.sh: Add 'unload' tests (stop single service  & 'all').
---
 dmd.texi                |   13 ++++++++
 modules/dmd/service.scm |   83 +++++++++++++++++++++++++++++++++++++++++++++--
 tests/basic.sh          |   22 +++++++++++++
 3 files changed, 116 insertions(+), 2 deletions(-)

diff --git a/dmd.texi b/dmd.texi
index f7306db..e31b230 100644
--- a/dmd.texi
+++ b/dmd.texi
@@ -854,6 +854,19 @@ 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 unload @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.  Any services
+depending upon @var{service-name} will be stopped as part of this
+process.  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 @code{web-server}, which
+might be provided by both @code{apache} and @code{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..20a3f52 100644
--- a/modules/dmd/service.scm
+++ b/modules/dmd/service.scm
@@ -761,6 +761,78 @@ 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 identity
+            (hash-map->list
+             (lambda (key value)
+               (match value
+                 ((service)     ; only one service associated with KEY
+                  (and (eq? key (canonical-name service))
+                       (not (eq? key 'dmd))
+                       (cons key service)))
+                 (_ #f)))               ; all other cases: #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.
+           (match (lookup-services name)
+             (()                        ; unknown service
+              (local-output
+               "Not unloading: '~a' is an uknown service." name))
+             ((service)             ; only SERVICE provides NAME
+              ;; Are we removing a user service…
+              (if (eq? (canonical-name service) name)
+                  (local-output "Removing service '~a'..." name)
+                  ;; or a virtual service?
+                  (local-output
+                   "Removing service '~a' providing '~a'..."
+                   (canonical-name service) name))
+              (deregister service)
+              (local-output "Done."))
+             ((services ...)            ; ambiguous NAME
+              (local-output
+               "Not unloading: '~a' names several services: '~a'."
+               name (map canonical-name services))))))))
+
 ;;; Tests for validity of the slots of <service> objects.
 
 ;; Test if OBJ is a list that only contains symbols.
@@ -867,6 +939,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
+     (unload
+      "Unload the service identified by SERVICE-NAME or all services
+except for dmd if SERVICE-NAME is 'all'.  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 +963,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."
diff --git a/tests/basic.sh b/tests/basic.sh
index e9ad970..5f53fe3 100644
--- a/tests/basic.sh
+++ b/tests/basic.sh
@@ -41,6 +41,16 @@ cat > "$conf"<<EOF
              #t)
    #:stop  (lambda _
              (delete-file "$stamp"))
+   #:respawn? #f)
+ (make <service>
+   #:provides '(test-2)
+   #:requires '(test)
+   #:start (lambda _
+             (call-with-output-file "$stamp-2"
+               (cut display "bar" <>))
+             #t)
+   #:stop  (lambda _
+             (delete-file "$stamp-2"))
    #:respawn? #f))
 EOF
 
@@ -65,6 +75,18 @@ $deco stop test
 
 $deco status test | grep stopped
 
+$deco start test-2
+
+$deco status test-2 | grep started
+
+$deco unload dmd test
+
+$deco status dmd | grep "Stopped: (test-2)"
+
+$deco unload dmd all
+
+$deco status dmd | grep "Stopped: ()"
+
 $deco stop dmd
 ! kill -0 $dmd_pid
 
-- 
1.7.9.5

[PATCH 2/2] dmd: Add dmd action 'reload': unload all; load.

[Alex Sassmannshausen]

* modules/dmd/service.scm (runtime-load): New procedure.
  (dmd-service): Re-factor 'load', add new action: 'reload'.
* dmd.texi (The 'dmd' and 'unknown' services): Document 'reload'.
* tests/basic.sh: Add 'reload' test.
---
 dmd.texi                |    8 ++++++++
 modules/dmd/service.scm |   35 ++++++++++++++++++++++-------------
 tests/basic.sh          |    6 +++++-
 3 files changed, 35 insertions(+), 14 deletions(-)

diff --git a/dmd.texi b/dmd.texi
index e31b230..573d7ea 100644
--- a/dmd.texi
+++ b/dmd.texi
@@ -867,6 +867,14 @@ might be provided by both @code{apache} and @code{nginx}.  If
 @var{service-name} is the special string and @code{all}, attempt to
 remove all services except for dmd itself.
 
+@item reload @var{file-name}
+Unload all known optional services using unload's @code{all} option,
+then load @var{file-name} using @code{load} functionality.  If
+file-name does not exist or @code{load}hits an error, you may end up
+with no defined services.  Considering these can be reloaded at a
+later stage this is not considered a problem.  If the @code{unload}
+stage fails, @code{reload} will not attempt to load @var{file-name}.
+
 @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 20a3f52..76c28a7 100644
--- a/modules/dmd/service.scm
+++ b/modules/dmd/service.scm
@@ -833,6 +833,18 @@ requested to be removed."
                "Not unloading: '~a' names several services: '~a'."
                name (map canonical-name services))))))))
 
+(define (runtime-load file-name)
+  (local-output "Loading ~a." file-name)
+  ;; Every action is protected anyway, so no need for a `catch'
+  ;; here.  FIXME: What about `quit'?
+  (catch 'system-error
+    (lambda ()
+      (load-in-user-module file-name))
+    (lambda args
+      (local-output "Failed to load from '~a': ~a."
+                    file-name (strerror (system-error-errno args)))
+      #f)))
+
 ;;; Tests for validity of the slots of <service> objects.
 
 ;; Test if OBJ is a list that only contains symbols.
@@ -929,16 +941,7 @@ which ones are not."
       "Load the Scheme code from FILE into dmd.  This is potentially
 dangerous.  You have been warned."
       (lambda (running file-name)
-	(local-output "Loading ~a." file-name)
-	;; Every action is protected anyway, so no need for a `catch'
-	;; here.  FIXME: What about `quit'?
-        (catch 'system-error
-          (lambda ()
-            (load-in-user-module file-name))
-          (lambda args
-            (local-output "Failed to load from '~a': ~a."
-                          file-name (strerror (system-error-errno args)))
-            #f))))
+        (runtime-load file-name)))
      ;; Unload a service
      (unload
       "Unload the service identified by SERVICE-NAME or all services
@@ -946,6 +949,12 @@ except for dmd if SERVICE-NAME is 'all'.  Stop services before
 removing them if needed."
       (lambda (running service-name)
         (deregister-service service-name)))
+     (reload
+      "Unload all services, then load from FILE-NAME into dmd.  This
+is potentialy dangerous.  You have been warned."
+      (lambda (running file-name)
+        (and (deregister-service "all")  ; unload all services
+             (runtime-load file-name)))) ; reload from FILE-NAME
      ;; Go into the background.
      (daemonize
       "Go into the background.  Be careful, this means that a new
@@ -963,9 +972,9 @@ 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-state-file file))))
+               (set! persistency #t)
+               (when file
+                 (set! persistency-state-file file))))
      (no-persistency
       "Don't safe state in a file on exit."
       (lambda (running)
diff --git a/tests/basic.sh b/tests/basic.sh
index 5f53fe3..294ce80 100644
--- a/tests/basic.sh
+++ b/tests/basic.sh
@@ -64,7 +64,8 @@ dmd_pid="`cat $pid`"
 
 kill -0 $dmd_pid
 test -S "$socket"
-$deco status dmd | grep -E '(Start.*dmd|Stop.*test)'
+pristineStatus=$($deco status dmd) # Prep for 'reload' test.
+echo $pristineStatus | grep -E '(Start.*dmd|Stop.*test)'
 
 $deco start test
 test -f "$stamp"
@@ -83,6 +84,9 @@ $deco unload dmd test
 
 $deco status dmd | grep "Stopped: (test-2)"
 
+$deco reload dmd "$conf"
+[ "$($deco status dmd)" == "$pristineStatus" ]
+
 $deco unload dmd all
 
 $deco status dmd | grep "Stopped: ()"
-- 
1.7.9.5

Re: [PATCH 1/2] dmd: Add dmd action unload: unload known services.

[Ludovic Courtès]

Alex Sassmannshausen <alex.sassmannshausen@gmail.com> skribis:

> * modules/dmd/service.scm (deregister-services): New procedure.
>   (dmd-service): Add new action: unload.
> * dmd.texi (The 'dmd' and 'unknown' services): Document 'unload'.
> * tests/basic.sh: Add 'unload' tests (stop single service  & 'all').

Applied with minor changes.

> +@item unload @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.  Any services
> +depending upon @var{service-name} will be stopped as part of this
> +process.  If @var{service-name} simply does not exist, output a

I added a newline before “If” so that the main info is more easily
visible, and the paragraph is less intimidating.  ;-)

> +$deco unload dmd test
> +
> +$deco status dmd | grep "Stopped: (test-2)"
> +
> +$deco unload dmd all
> +
> +$deco status dmd | grep "Stopped: ()"

I added a test to make sure we get “Started: (dmd)”.

Thanks!

Ludo’.

Re: [PATCH 2/2] dmd: Add dmd action 'reload': unload all; load.

[Ludovic Courtès]

Alex Sassmannshausen <alex.sassmannshausen@gmail.com> skribis:

> * modules/dmd/service.scm (runtime-load): New procedure.
>   (dmd-service): Re-factor 'load', add new action: 'reload'.
> * dmd.texi (The 'dmd' and 'unknown' services): Document 'reload'.
> * tests/basic.sh: Add 'reload' test.

Again I would call everything ‘reload’, for instance.  ‘runtime-load’
sounds like a pleonasm to me.

WDYT?

> --- a/tests/basic.sh
> +++ b/tests/basic.sh
> @@ -64,7 +64,8 @@ dmd_pid="`cat $pid`"
>  
>  kill -0 $dmd_pid
>  test -S "$socket"
> -$deco status dmd | grep -E '(Start.*dmd|Stop.*test)'
> +pristineStatus=$($deco status dmd) # Prep for 'reload' test.
> +echo $pristineStatus | grep -E '(Start.*dmd|Stop.*test)'

No camel case, please.  :-)

Also, use backquotes instead of $(...), which is Bash-specific.

>  $deco start test
>  test -f "$stamp"
> @@ -83,6 +84,9 @@ $deco unload dmd test
>  
>  $deco status dmd | grep "Stopped: (test-2)"
>  
> +$deco reload dmd "$conf"
> +[ "$($deco status dmd)" == "$pristineStatus" ]

Rather ‘test’ instead of ‘[’.

Could you post an updated patch?

Thanks!

Ludo’.

Re: dmd: Unload one or all services at runtime.

[Alex Sassmannshausen]

Hello,

Please find an updated second patch which should arrive shortly.

Ludovic Courtès writes:

> Alex Sassmannshausen <alex.sassmannshausen@gmail.com> skribis:
>
>> * modules/dmd/service.scm (runtime-load): New procedure.
>>   (dmd-service): Re-factor 'load', add new action: 'reload'.
>> * dmd.texi (The 'dmd' and 'unknown' services): Document 'reload'.
>> * tests/basic.sh: Add 'reload' test.
>
> Again I would call everything ‘reload’, for instance.  ‘runtime-load’
> sounds like a pleonasm to me.
>
> WDYT?

The procedure in question is now actually used by the 'load' and
'reload' actions, so simply calling it 'reload' would not be correct.

I can see it being a pleonasm, so I've renamed the procedure
'load-config'. To be clear, the new action itself IS called 'reload'
(so you would use it by 'deco reload dmd $file_name').

I've implemented your other suggestions, the tests pass.

Let me know if you have any other comments.

Cheers,

Alex

[PATCH] dmd: Add dmd action 'reload': unload all; load.

[Alex Sassmannshausen]

* modules/dmd/service.scm (load-config): New procedure.
  (dmd-service): Re-factor 'load', add new action: 'reload'.
* dmd.texi (The 'dmd' and 'unknown' services): Document 'reload'.
* tests/basic.sh: Add 'reload' test.
---
 dmd.texi                |    8 ++++++++
 modules/dmd/service.scm |   35 ++++++++++++++++++++++-------------
 tests/basic.sh          |    6 +++++-
 3 files changed, 35 insertions(+), 14 deletions(-)

diff --git a/dmd.texi b/dmd.texi
index 874a0f6..ede2775 100644
--- a/dmd.texi
+++ b/dmd.texi
@@ -869,6 +869,14 @@ the fictional service @code{web-server}, which might be provided by both
 string and @code{all}, attempt to remove all services except for dmd
 itself.
 
+@item reload @var{file-name}
+Unload all known optional services using unload's @code{all} option,
+then load @var{file-name} using @code{load} functionality.  If
+file-name does not exist or @code{load} encounters an error, you may
+end up with no defined services.  As these can be reloaded at a later
+stage this is not considered a problem.  If the @code{unload} stage
+fails, @code{reload} will not attempt to load @var{file-name}.
+
 @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 6edb8a8..1a31392 100644
--- a/modules/dmd/service.scm
+++ b/modules/dmd/service.scm
@@ -834,6 +834,18 @@ requested to be removed."
                "Not unloading: '~a' names several services: '~a'."
                name (map canonical-name services))))))))
 
+(define (load-config file-name)
+  (local-output "Loading ~a." file-name)
+  ;; Every action is protected anyway, so no need for a `catch'
+  ;; here.  FIXME: What about `quit'?
+  (catch 'system-error
+    (lambda ()
+      (load-in-user-module file-name))
+    (lambda args
+      (local-output "Failed to load from '~a': ~a."
+                    file-name (strerror (system-error-errno args)))
+      #f)))
+
 ;;; Tests for validity of the slots of <service> objects.
 
 ;; Test if OBJ is a list that only contains symbols.
@@ -930,16 +942,7 @@ which ones are not."
       "Load the Scheme code from FILE into dmd.  This is potentially
 dangerous.  You have been warned."
       (lambda (running file-name)
-	(local-output "Loading ~a." file-name)
-	;; Every action is protected anyway, so no need for a `catch'
-	;; here.  FIXME: What about `quit'?
-        (catch 'system-error
-          (lambda ()
-            (load-in-user-module file-name))
-          (lambda args
-            (local-output "Failed to load from '~a': ~a."
-                          file-name (strerror (system-error-errno args)))
-            #f))))
+        (load-config file-name)))
      ;; Unload a service
      (unload
       "Unload the service identified by SERVICE-NAME or all services
@@ -947,6 +950,12 @@ except for dmd if SERVICE-NAME is 'all'.  Stop services before
 removing them if needed."
       (lambda (running service-name)
         (deregister-service service-name)))
+     (reload
+      "Unload all services, then load from FILE-NAME into dmd.  This
+is potentialy dangerous.  You have been warned."
+      (lambda (running file-name)
+        (and (deregister-service "all") ; unload all services
+             (load-config file-name)))) ; reload from FILE-NAME
      ;; Go into the background.
      (daemonize
       "Go into the background.  Be careful, this means that a new
@@ -964,9 +973,9 @@ 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-state-file file))))
+               (set! persistency #t)
+               (when file
+                 (set! persistency-state-file file))))
      (no-persistency
       "Don't safe state in a file on exit."
       (lambda (running)
diff --git a/tests/basic.sh b/tests/basic.sh
index d2503b9..a1825de 100644
--- a/tests/basic.sh
+++ b/tests/basic.sh
@@ -65,7 +65,8 @@ dmd_pid="`cat $pid`"
 
 kill -0 $dmd_pid
 test -S "$socket"
-$deco status dmd | grep -E '(Start.*dmd|Stop.*test)'
+pristine_status=`$deco status dmd` # Prep for 'reload' test.
+echo $pristine_status | grep -E '(Start.*dmd|Stop.*test)'
 
 $deco start test
 test -f "$stamp"
@@ -84,6 +85,9 @@ $deco status test-2 | grep started
 $deco unload dmd test
 $deco status dmd | grep "Stopped: (test-2)"
 
+$deco reload dmd "$conf"
+test "`$deco status dmd`" == "$pristine_status"
+
 # Unload everything and make sure only 'dmd' is left.
 $deco unload dmd all
 $deco status dmd | grep "Stopped: ()"
-- 
1.7.10.4

Re: dmd: Unload one or all services at runtime.

[Ludovic Courtès]

Hello!

Alex Sassmannshausen <alex.sassmannshausen@gmail.com> skribis:

> Ludovic Courtès writes:
>
>> Alex Sassmannshausen <alex.sassmannshausen@gmail.com> skribis:
>>
>>> * modules/dmd/service.scm (runtime-load): New procedure.
>>>   (dmd-service): Re-factor 'load', add new action: 'reload'.
>>> * dmd.texi (The 'dmd' and 'unknown' services): Document 'reload'.
>>> * tests/basic.sh: Add 'reload' test.
>>
>> Again I would call everything ‘reload’, for instance.  ‘runtime-load’
>> sounds like a pleonasm to me.
>>
>> WDYT?
>
> The procedure in question is now actually used by the 'load' and
> 'reload' actions, so simply calling it 'reload' would not be correct.
>
> I can see it being a pleonasm, so I've renamed the procedure
> 'load-config'. To be clear, the new action itself IS called 'reload'
> (so you would use it by 'deco reload dmd $file_name').

OK, makes sense to me.

Thanks,
Ludo’.

Re: [PATCH] dmd: Add dmd action 'reload': unload all; load.

[Ludovic Courtès]

Alex Sassmannshausen <alex.sassmannshausen@gmail.com> skribis:

> * modules/dmd/service.scm (load-config): New procedure.
>   (dmd-service): Re-factor 'load', add new action: 'reload'.
> * dmd.texi (The 'dmd' and 'unknown' services): Document 'reload'.
> * tests/basic.sh: Add 'reload' test.

Pushed, thanks!

Ludo’.