Initial checkin.

git-svn-id: svn+ssh://svn.dolda2000.com/srv/svn/repos/src/doldaconnect@725 959494ce-11ee-0310-bf91-de5d638817bd

diff --git a/lib/guile/hubmgr b/lib/guile/hubmgr
new file mode 100755 (executable)
index 0000000..daa5482
--- /dev/null
+++ b/lib/guile/hubmgr
@@ -0,0 +1,103 @@
+#!/usr/bin/guile -s
+!#
+
+(use-modules (dolcon ui) (dolcon util))
+(use-modules (ice-9 format))
+
+(define max-hubs 6)
+(define hub-list '())
+(define hl-file (string-append (getenv "HOME") "/.hublist"))
+(define hublist '())
+(define connlist '())
+(define statelist '())
+
+(define (logf . args)
+  (let ((fmt (car args)) (args (cdr args)))
+    (apply format (cons* #t (string-append fmt "~%") args))))
+
+(define (list-delta l1 l2)
+  (let ((r1 '()) (r2 '()))
+    (for-each (lambda (o1)
+               (catch 'found
+                      (lambda ()
+                        (for-each (lambda (o2)
+                                    (if (equal? o1 o2) (throw 'found o2)))
+                                  l2)
+                        (set! r2 (cons o1 r2)))
+                      (lambda (sig ret)
+                        (set! r1 (cons (cons o1 ret) r1))
+                        (set! l2 (delq ret l2)))))
+             l1)
+    (list r1 r2 l2)))
+
+(define (read-hl)
+  (catch 'system-error
+        (lambda () 
+          (let ((p (open-input-file hl-file)))
+            (catch 'eof
+                   (lambda ()
+                     (let ((lines '()))
+                       (while #t
+                              (let ((line (read-line p)))
+                                (if (eof-object? line)
+                                    (throw 'eof lines)
+                                    (let ((lexed (dc-lexsexpr line)))
+                                      (if (> (length lexed) 0)
+                                          (set! lines (append lines (list lexed))))))))))
+                   (lambda (s a) (close-port p) a))))
+        (lambda (key . args)
+          '())))
+
+(define (cklist)
+  (set! statelist (let ((nl '()) (ct (current-time)))
+                   (for-each (lambda (o)
+                               (if (< ct (+ (cadr o) (caddr o)))
+                                   (set! nl (cons o nl))))
+                             statelist)
+                   nl))
+  (for-each (lambda (o)
+             (if (and (not (assq o connlist))
+                      (not (assq o statelist)))
+                 (begin (logf "connecting to ~a" (cadr o))
+                        (set! connlist (cons (cons o 'pend) connlist))
+                        (dc-qcmd (list* "cnct" o)
+                                 (let ((hub o))
+                                   (lambda (resp)
+                                     (let ((er (dc-extract resp)) (ir (dc-intresp resp)))
+                                       (if (= (cdr (assq 'code er)) 200)
+                                           (begin (set-cdr! (assq hub connlist) (car ir))
+                                                  (logf "~a state syn (~a)" (cadr hub) (car ir)))
+                                           (begin (set! connlist (delq (assq hub connlist) connlist))
+                                                  (logf "~a failed (~a)" (cadr hub) (cdr (assq 'code er))))))))))))
+           hublist))
+
+(define (hubmgr-main args)
+  (let ((dc-server #f))
+    (if (not dc-server) (set! dc-server (getenv "DCSERVER")))
+    (if (not dc-server) (set! dc-server "localhost"))
+    
+    (set! hublist (read-hl))
+    (logf "read ~a hubs" (length hublist))
+    (dc-c&l #t dc-server #t)
+    (dc-ecmd-assert 200 "notify" "fn:act" "on")
+    (dc-handle-fn)
+    (dc-fnproc-reg 'state (lambda (fn)
+                           (if (eq? (cdr (assq 'state fn)) 'dead)
+                               (begin (logf "~a died" (cdr (assq 'id fn)))
+                                      (dc-qcmd (list "dcnct" (cdr (assq 'id fn))))))
+                           (cklist)))
+    (dc-fnproc-reg 'dstr (lambda (fn)
+                          (let ((clf (assq (cdr (assq 'id fn)) (map (lambda (o) (cons (cdr o) (car o))) connlist))))
+                            (if clf
+                                (let ((hlf (cdr clf)))
+                                  (logf "~a disappeared" (cadr hlf))
+                                  (set! connlist (delq (assq hlf connlist) connlist))
+                                  (set! statelist (cons (list hlf (current-time) 10) statelist)))))
+                          (cklist)))
+    (dc-loop-reg ".periodic" #f cklist)
+    
+    (cklist)
+    (dc-loop)))
+
+(setlocale LC_ALL "")
+(hubmgr-main (command-line))