4 (use-modules (dolcon ui) (dolcon util))
5 (use-modules (ice-9 format))
9 (define hl-file (string-append (getenv "HOME") "/.hublist"))
12 (define statelist '())
15 (let ((fmt (car args)) (args (cdr args)))
16 (apply format (cons* #t (string-append fmt "~%") args))))
18 (define (list-delta l1 l2)
19 (let ((r1 '()) (r2 '()))
20 (for-each (lambda (o1)
23 (for-each (lambda (o2)
24 (if (equal? o1 o2) (throw 'found o2)))
26 (set! r2 (cons o1 r2)))
28 (set! r1 (cons (cons o1 ret) r1))
29 (set! l2 (delq ret l2)))))
36 (let ((p (open-input-file hl-file)))
41 (let ((line (read-line p)))
42 (if (eof-object? line)
44 (let ((lexed (dc-lexsexpr line)))
45 (if (> (length lexed) 0)
46 (set! lines (append lines (list lexed))))))))))
47 (lambda (s a) (close-port p) a))))
52 (set! statelist (let ((nl '()) (ct (current-time)))
54 (if (< ct (+ (cadr o) (caddr o)))
55 (set! nl (cons o nl))))
59 (if (and (not (assq o connlist))
60 (not (assq o statelist)))
61 (begin (logf "connecting to ~a" (cadr o))
62 (set! connlist (cons (cons o 'pend) connlist))
63 (dc-qcmd (list* "cnct" o)
66 (let ((er (dc-extract resp)) (ir (dc-intresp resp)))
67 (if (= (cdr (assq 'code er)) 200)
68 (begin (set-cdr! (assq hub connlist) (car ir))
69 (logf "~a state syn (~a)" (cadr hub) (car ir)))
70 (begin (set! connlist (delq (assq hub connlist) connlist))
71 (logf "~a failed (~a)" (cadr hub) (cdr (assq 'code er))))))))))))
74 (define (hubmgr-main args)
76 (if (not dc-server) (set! dc-server (getenv "DCSERVER")))
77 (if (not dc-server) (set! dc-server "localhost"))
79 (set! hublist (read-hl))
80 (logf "read ~a hubs" (length hublist))
81 (dc-c&l #t dc-server #t)
82 (dc-ecmd-assert 200 "notify" "fn:act" "on")
84 (dc-fnproc-reg 'state (lambda (fn)
85 (if (eq? (cdr (assq 'state fn)) 'dead)
86 (begin (logf "~a died" (cdr (assq 'id fn)))
87 (dc-qcmd (list "dcnct" (cdr (assq 'id fn))))))
89 (dc-fnproc-reg 'dstr (lambda (fn)
90 (let ((clf (assq (cdr (assq 'id fn)) (map (lambda (o) (cons (cdr o) (car o))) connlist))))
92 (let ((hlf (cdr clf)))
93 (logf "~a disappeared" (cadr hlf))
94 (set! connlist (delq (assq hlf connlist) connlist))
95 (set! statelist (cons (list hlf (current-time) 10) statelist)))))
97 (dc-loop-reg ".periodic" #f cklist)
102 (setlocale LC_ALL "")
103 (hubmgr-main (command-line))