From: Fredrik Tolf Date: Tue, 13 Nov 2007 16:12:34 +0000 (+0100) Subject: Improvements to hubmgr. X-Git-Tag: 1.1~39 X-Git-Url: http://git.dolda2000.com/gitweb/?a=commitdiff_plain;h=ae95803603ca867792cbbab6333348cb856fcfe2;p=doldaconnect.git Improvements to hubmgr. * 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. --- diff --git a/lib/guile/hubmgr b/lib/guile/hubmgr index dd15213..5d8de74 100755 --- a/lib/guile/hubmgr +++ b/lib/guile/hubmgr @@ -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))) @@ -92,15 +92,16 @@ 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))) @@ -115,15 +116,30 @@ (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))