[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.
 
address@hidden 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