Improvements to hubmgr.
authorFredrik Tolf <fredrik@dolda2000.com>
Tue, 13 Nov 2007 16:12:34 +0000 (17:12 +0100)
committerFredrik Tolf <fredrik@dolda2000.com>
Tue, 13 Nov 2007 16:12:34 +0000 (17:12 +0100)
* It will daemonize by default.
* It will disconnect managed hubs on exit
* It exits on a c-c "exit" message.
* Deprecated Guile functions have been replaced.

lib/guile/hubmgr

index dd15213..5d8de74 100755 (executable)
@@ -79,7 +79,7 @@
                       (not (assq o statelist)))
                  (begin (logf "connecting to ~a" (cadr o))
                         (set! connlist (cons (cons o 'pend) connlist))
-                        (dc-qcmd (list* "cnct" o)
+                        (dc-qcmd (cons* "cnct" o)
                                  (let ((hub o))
                                    (lambda (resp)
                                      (let ((er (dc-extract resp)) (ir (dc-intresp resp)))
            hublist))
 
 (define (hubmgr-main args)
-  (let ((opts (getopt-long args '((daemon (single-char #\d) (value #f))
-                                 (server (single-char #\s) (value #t))))))
-    
+  (let ((opts (getopt-long args '((nodaemon (single-char #\d) (value #f))
+                                 (server (single-char #\s) (value #t))
+                                 (quiet (single-char #\q) (value #f))))))
+    (if (option-ref opts 'quiet #f) (set! logdest #f))
     (set! hublist (read-hl))
     (logf "read ~a hubs" (length hublist))
-    (dc-c&l #t (option-ref opts 'server #f) #t)
-    (dc-ecmd-assert 200 "notify" "fn:act" "on")
+    (dc-c&l (not (option-ref opts 'quiet #f)) (option-ref opts 'server #f) #t)
+    (dc-ecmd-assert 200 "notify" "fn:act" "on" "msg" "on")
     (dc-ecmd-assert 200 "register" "hubmgr")
-    (dc-handle-fn)
+    (dc-util-handle 'fn 'msg)
     (dc-fnproc-reg 'state (lambda (fn)
                            (if (and (eq? (cdr (assq 'state fn)) 'dead)
                                     (assq (cdr (assq 'id fn)) (map (lambda (o) (cons (cdr o) (car o))) connlist)))
                                   (set! connlist (delq (assq hlf connlist) connlist))
                                   (set! statelist (cons (list hlf (current-time) 10) statelist)))))
                           (cklist)))
+    (dc-msgproc-reg (lambda (sender msg)
+                     (if (equal? (car msg) "exit")
+                         (throw 'quit 0))))
     (dc-loop-reg ".periodic" #f cklist)
     
-    (if (and (option-ref opts 'daemon #f)
-            (not (= (primitive-fork) 0)))
-       (primitive-exit 0)
-       (set! logdest #f))
+    (if (not (option-ref opts 'nodaemon #f))
+       (begin (logf "daemonizing...")
+              (if (= (primitive-fork) 0)
+                  (set! logdest #f)
+                  (primitive-exit 0))))
     
+    (for-each (lambda (sig) (sigaction sig (lambda (sig) (throw 'quit 0)))) (list SIGINT SIGTERM SIGHUP))
     (cklist)
-    (dc-loop)))
+    (catch 'quit dc-loop
+          (lambda (sig ret)
+            (catch 'quit
+                   (lambda ()
+                     (for-each (lambda (o)
+                                 (if (not (eq? (cdr o) 'pend))
+                                     (dc-ecmd "dcnct" (cdr o))))
+                               connlist)
+                     )
+                   (lambda (sig ret) ret))
+            ret))))
 
 (setlocale LC_ALL "")
 (hubmgr-main (command-line))