Updated Gaim plugin info.
[doldaconnect.git] / lib / guile / hubmgr
CommitLineData
6b081952 1#!/usr/bin/guile -s
2!#
3
4(use-modules (dolcon ui) (dolcon util))
5(use-modules (ice-9 format))
6
7(define max-hubs 6)
8(define hub-list '())
9(define hl-file (string-append (getenv "HOME") "/.hublist"))
10(define hublist '())
11(define connlist '())
12(define statelist '())
13
14(define (logf . args)
15 (let ((fmt (car args)) (args (cdr args)))
16 (apply format (cons* #t (string-append fmt "~%") args))))
17
18(define (list-delta l1 l2)
19 (let ((r1 '()) (r2 '()))
20 (for-each (lambda (o1)
21 (catch 'found
22 (lambda ()
23 (for-each (lambda (o2)
24 (if (equal? o1 o2) (throw 'found o2)))
25 l2)
26 (set! r2 (cons o1 r2)))
27 (lambda (sig ret)
28 (set! r1 (cons (cons o1 ret) r1))
29 (set! l2 (delq ret l2)))))
30 l1)
31 (list r1 r2 l2)))
32
33(define (read-hl)
34 (catch 'system-error
35 (lambda ()
36 (let ((p (open-input-file hl-file)))
37 (catch 'eof
38 (lambda ()
39 (let ((lines '()))
40 (while #t
41 (let ((line (read-line p)))
42 (if (eof-object? line)
43 (throw 'eof lines)
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))))
48 (lambda (key . args)
49 '())))
50
51(define (cklist)
52 (set! statelist (let ((nl '()) (ct (current-time)))
53 (for-each (lambda (o)
54 (if (< ct (+ (cadr o) (caddr o)))
55 (set! nl (cons o nl))))
56 statelist)
57 nl))
58 (for-each (lambda (o)
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)
64 (let ((hub o))
65 (lambda (resp)
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))
4024acee 71 (set! statelist (cons (list hub (current-time) 10) statelist))
6b081952 72 (logf "~a failed (~a)" (cadr hub) (cdr (assq 'code er))))))))))))
73 hublist))
74
75(define (hubmgr-main args)
76 (let ((dc-server #f))
77 (if (not dc-server) (set! dc-server (getenv "DCSERVER")))
78 (if (not dc-server) (set! dc-server "localhost"))
79
80 (set! hublist (read-hl))
81 (logf "read ~a hubs" (length hublist))
82 (dc-c&l #t dc-server #t)
83 (dc-ecmd-assert 200 "notify" "fn:act" "on")
84 (dc-handle-fn)
85 (dc-fnproc-reg 'state (lambda (fn)
2a156d4f 86 (if (and (eq? (cdr (assq 'state fn)) 'dead)
87 (assq (cdr (assq 'id fn)) (map (lambda (o) (cons (cdr o) (car o))) connlist)))
6b081952 88 (begin (logf "~a died" (cdr (assq 'id fn)))
89 (dc-qcmd (list "dcnct" (cdr (assq 'id fn))))))
90 (cklist)))
91 (dc-fnproc-reg 'dstr (lambda (fn)
92 (let ((clf (assq (cdr (assq 'id fn)) (map (lambda (o) (cons (cdr o) (car o))) connlist))))
93 (if clf
94 (let ((hlf (cdr clf)))
95 (logf "~a disappeared" (cadr hlf))
96 (set! connlist (delq (assq hlf connlist) connlist))
97 (set! statelist (cons (list hlf (current-time) 10) statelist)))))
98 (cklist)))
99 (dc-loop-reg ".periodic" #f cklist)
100
101 (cklist)
102 (dc-loop)))
103
104(setlocale LC_ALL "")
105(hubmgr-main (command-line))