Add wpfind.
[doldaconnect.git] / lib / guile / dolcon / ui.scm
CommitLineData
d3372da9 1(define-module (dolcon ui))
2
3(export dc-connect dc-disconnect dc-connected dc-select dc-getresp dc-extract dc-intresp dc-qcmd dc-loginasync dc-lexsexpr)
4
5(load-extension "libdolcon-guile" "init_guiledc")
6
7(define-public dc-login
8 (lambda (useauthless . username)
9 (let ((done #f) (errsym #f))
10 (dc-loginasync
11 (lambda (err reason)
12 (set! errsym err)
13 (set! done #t))
14 useauthless (if (pair? username) (car username) #f))
15 (while (not done) (dc-select))
16 errsym)))
17
18(define-public dc-must-connect
19 (lambda args
20 (let* ((fd (apply dc-connect args)) (resp (dc-extract (do ((resp (dc-getresp) (dc-getresp)))
21 ((and resp
22 (equal? (cdr (assoc 'cmd (dc-extract resp))) ".connect"))
23 resp)
24 (dc-select)))))
25 (if (= (cdr (assoc 'code resp)) 200)
26 fd
27 (throw 'bad-return (cdr (assoc 'code resp)) (cadr (assoc 'resp resp)))
28 )
29 )
30 )
31 )
32
33(define-public dc-c&l
34 (lambda (verbose host useauthless)
35 (let ((fd -1) (print (lambda (obj) (if verbose (display obj (if (port? verbose) verbose (current-error-port)))))))
36 (print "connecting...\n")
37 (set! fd (dc-must-connect host))
38 (print "authenticating...\n")
39 (let ((ret (dc-login useauthless)))
40 (if (not (eq? ret 'success))
41 (throw 'login-failure ret)))
42 (print "authentication success\n")
43 fd)
44 )
45 )
46
47(define-public dc-ecmd
48 (lambda args
49 (let ((tag (dc-qcmd args)))
50 (do ((resp (dc-getresp tag) (dc-getresp tag)))
51 (resp resp)
52 (dc-select))
53 )
54 )
55 )
56
57(define-public dc-ecmd-assert
58 (lambda (code . args)
59 (let* ((resp (apply dc-ecmd args)) (eresp (dc-extract resp)))
60 (if (not (if (list? code)
61 (memq (cdr (assoc 'code eresp)) code)
62 (= (cdr (assoc 'code eresp)) code)))
63 (throw 'bad-return (cdr (assoc 'code eresp)) (cadr (assoc 'resp eresp)))
64 )
65 resp
66 )
67 )
68 )
69
70(define-public dc-intall
71 (lambda (resp)
72 (let ((retlist '()))
73 (do ((ires (dc-intresp resp) (dc-intresp resp))) ((not ires) retlist)
74 (set! retlist (append retlist (list ires)))))))