Improvements to hubmgr.
[doldaconnect.git] / 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))
                       (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)))
                                  (let ((hub o))
                                    (lambda (resp)
                                      (let ((er (dc-extract resp)) (ir (dc-intresp resp)))
            hublist))
 
 (define (hubmgr-main args)
            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))
     (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-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)))
     (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)))
                                   (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)
     
     (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)
     (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))
 
 (setlocale LC_ALL "")
 (hubmgr-main (command-line))