1 ; Dolda Connect - Modular multiuser Direct Connect-style client
2 ; Copyright (C) 2007 Fredrik Tolf <fredrik@dolda2000.com>
4 ; This program is free software; you can redistribute it and/or modify
5 ; it under the terms of the GNU General Public License as published by
6 ; the Free Software Foundation; either version 2 of the License, or
7 ; (at your option) any later version.
9 ; This program is distributed in the hope that it will be useful,
10 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 ; GNU General Public License for more details.
14 ; You should have received a copy of the GNU General Public License
15 ; along with this program; if not, write to the Free Software
16 ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 (define-module (dolcon util))
19 (use-modules (dolcon ui))
21 (define fnetnodes '())
22 (define loop-procs '())
24 (define msg-procs '())
26 (define-public dc-fn-update
29 (let ((resp (dc-ecmd "lsnodes")) (er #f))
30 (if (and resp (begin (set! er (dc-extract resp)) er) (= (cdr (assq 'code er)) 200))
32 (apply (lambda (id net name users state uid)
38 (cons 'state (list-ref '(syn hs est dead) state))
45 (define-public dc-fn-getattrib
47 (if (not (assq id fnetnodes))
49 (let ((aform (assq id fnetnodes)))
51 (cdr (assq attrib (cdr aform)))
54 (define-public dc-fn-getname
56 (dc-fn-getattrib id 'name)))
58 (define-public dc-getfnetnodes
60 (map (lambda (o) (car o))
65 (let ((aform (assq id fnetnodes)))
67 (set-cdr! (assq attr (cdr aform)) val)
70 (define-public dc-fnproc-reg
72 (set! fn-procs (cons (list event proc)
78 (let* ((notify (lambda (event data) (for-each (lambda (o) (if (eq? event (car o)) ((cadr o) data))) fn-procs)))
79 (ua (lambda (r a) (let* ((ires (dc-intresp r))
80 (hubform (assq (car ires) fnetnodes)))
82 (begin (fn-updattr (car ires) a (cadr ires))
83 (notify a (cdr (assq (car ires) fnetnodes)))))))))
84 (dc-loop-reg ".notify" 601 (lambda (r er) (let* ((ires (dc-intresp r))
85 (hubform (assq (car ires) fnetnodes)))
87 (begin (fn-updattr (car ires) 'state (list-ref '(syn hs est dead) (cadr ires)))
88 (notify 'state (cdr hubform)))))))
89 (dc-loop-reg ".notify" 602 (lambda (r er) (ua r 'name)))
90 (dc-loop-reg ".notify" 605 (lambda (r er) (ua r 'users)))
91 (dc-loop-reg ".notify" 604 (lambda (r er)
92 (let* ((ires (dc-intresp r))
93 (new (list (cons 'id (car ires))
94 (cons 'net (cadr ires))
99 (cons (cons (car ires) new)
101 (notify 'creat new))))
102 (dc-loop-reg ".notify" 603 (lambda (r er)
103 (let* ((ires (dc-intresp r)) (nform (assq (car ires) fnetnodes)))
104 (notify 'dstr (cdr nform))
105 (set! fnetnodes (delq nform fnetnodes))))))))
107 (define-public dc-msgproc-reg
109 (set! msg-procs (cons proc msg-procs))))
111 (define dc-handle-msg
113 (dc-loop-reg ".notify" 640 (lambda (r er)
114 (let ((sender (cadadr (assq 'resp er)))
115 (message (cddadr (assq 'resp er))))
116 (for-each (lambda (o) (o sender message))
119 (define-public dc-util-handle
121 (for-each (lambda (o)
123 ((fn) (dc-handle-fn))
124 ((msg) (dc-handle-msg))))
127 (define-public dc-loop-reg
128 (lambda (cmd code proc)
129 (set! loop-procs (cons (cons (cons cmd code) proc)
132 (define-public dc-loop
136 (while (let ((resp (dc-getresp)))
138 (let* ((er (dc-extract resp)) (code (cdr (assq 'code er))) (cmd (cdr (assq 'cmd er))))
141 (if (and (or (not (caar o)) (equal? cmd (caar o)))
142 (or (not (cdar o)) (equal? code (cdar o))))
147 (for-each (lambda (o)
148 (if (equal? (caar o) ".periodic")