From: fredrik <fredrik@959494ce-11ee-0310-bf91-de5d638817bd>
Date: Mon, 30 Oct 2006 05:00:00 +0000 (+0000)
Subject: Initial checkin.
X-Git-Tag: 0.3~198
X-Git-Url: http://dolda2000.com/gitweb/?p=doldaconnect.git;a=commitdiff_plain;h=6b0819527e4ba32b7efc92d291a72db7b986a4b8

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
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))