Continued data model docs.
[doldaconnect.git] / lib / guile / dolcon-guile.c
CommitLineData
d3372da9 1#include <stdlib.h>
2#include <stdio.h>
3#include <sys/poll.h>
4#include <errno.h>
5#include <libguile.h>
6
7#ifdef HAVE_CONFIG_H
8#include <config.h>
9#endif
10#include <doldaconnect/uilib.h>
11#include <doldaconnect/uimisc.h>
12#include <doldaconnect/utils.h>
13
14struct respsmob
15{
16 struct dc_response *resp;
17};
18
19struct scmcb
20{
21 SCM subr;
22};
23
24static int fd = -1;
dda84ebc 25static scm_t_bits resptype;
d3372da9 26
12383d48 27static SCM scm_dc_connect(SCM host)
d3372da9 28{
12383d48 29 char *chost;
d3372da9 30
12383d48 31 if(fd >= 0)
32 dc_disconnect();
0b8b2b53 33 if((host == SCM_UNDEFINED) || (host == SCM_BOOL_F))
d3372da9 34 {
12383d48 35 chost = NULL;
d3372da9 36 } else {
12383d48 37 SCM_ASSERT(SCM_STRINGP(host), host, SCM_ARG1, "dc-connect");
38 chost = SCM_STRING_CHARS(host);
d3372da9 39 }
12383d48 40 if((fd = dc_connect(chost)) < 0)
d3372da9 41 scm_syserror("dc-connect");
42 return(SCM_MAKINUM(fd));
43}
44
45static SCM scm_dc_disconnect(void)
46{
47 dc_disconnect();
48 return(SCM_MAKINUM(0));
49}
50
51static SCM scm_dc_connected(void)
52{
53 return((fd == -1)?SCM_BOOL_F:SCM_BOOL_T);
54}
55
56static SCM scm_dc_select(SCM timeout)
57{
58 struct pollfd pfd;
59 int cto, ret, enob;
60
61 if(timeout == SCM_UNDEFINED)
62 {
63 cto = -1;
64 } else {
65 SCM_ASSERT(SCM_INUMP(timeout), timeout, SCM_ARG1, "dc-select");
66 cto = SCM_INUM(timeout);
67 }
68 if(fd < 0)
69 scm_syserror_msg("dc-select", "Not connected", SCM_EOL, ENOTCONN);
70 pfd.fd = fd;
71 pfd.events = POLLIN;
72 if(dc_wantwrite())
73 pfd.events |= POLLOUT;
74 if((ret = poll(&pfd, 1, cto)) < 0)
75 {
76 if(errno == EINTR)
77 return(SCM_BOOL_F);
78 enob = errno;
79 dc_disconnect();
80 errno = enob;
81 scm_syserror("dc-select");
82 }
83 if(((pfd.revents & POLLIN) && dc_handleread()) || ((pfd.revents & POLLOUT) && dc_handlewrite()))
84 {
85 if(errno == 0)
86 {
87 fd = -1;
88 return(SCM_BOOL_F);
89 }
90 scm_syserror("dc-select");
91 }
92 return(ret?SCM_BOOL_T:SCM_BOOL_F);
93}
94
95static SCM makerespsmob(struct dc_response *resp)
96{
97 struct respsmob *data;
98
99 data = scm_must_malloc(sizeof(*data), "respsmob");
100 data->resp = resp;
101 SCM_RETURN_NEWSMOB(resptype, data);
102}
103
104static SCM scm_dc_getresp(SCM tag)
105{
106 struct dc_response *resp;
107 SCM ret;
108
109 if(tag == SCM_UNDEFINED)
110 {
111 if((resp = dc_getresp()) == NULL)
112 return(SCM_BOOL_F);
113 } else {
114 SCM_ASSERT(SCM_INUMP(tag), tag, SCM_ARG1, "dc-getresp");
115 if((resp = dc_gettaggedresp(SCM_INUM(tag))) == NULL)
116 return(SCM_BOOL_F);
117 }
118 ret = makerespsmob(resp);
119 return(ret);
120}
121
122static SCM scm_dc_extract(SCM scm_resp)
123{
124 int i, o;
125 struct dc_response *resp;
126 SCM ret, l, w;
127
128 SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-extract");
129 resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
130 ret = SCM_EOL;
131 ret = scm_cons(scm_cons(scm_str2symbol("cmd"), scm_makfrom0str(icswcstombs(resp->cmdname, "UTF-8", NULL))), ret);
132 ret = scm_cons(scm_cons(scm_str2symbol("code"), SCM_MAKINUM(resp->code)), ret);
133 ret = scm_cons(scm_cons(scm_str2symbol("tag"), SCM_MAKINUM(resp->tag)), ret);
134 l = SCM_EOL;
135 for(i = resp->numlines - 1; i >= 0; i--)
136 {
137 w = SCM_EOL;
138 for(o = resp->rlines[i].argc - 1; o >= 0; o--)
139 w = scm_cons(scm_makfrom0str(icswcstombs(resp->rlines[i].argv[o], "UTF-8", NULL)), w);
140 l = scm_cons(w, l);
141 }
142 ret = scm_cons(scm_cons(scm_str2symbol("resp"), l), ret);
143 return(ret);
144}
145
146static SCM scm_dc_intresp(SCM scm_resp)
147{
148 int i;
149 struct dc_response *resp;
150 struct dc_intresp *ires;
151 SCM ret;
152
153 SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-intresp");
154 resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
155 if((ires = dc_interpret(resp)) == NULL)
156 return(SCM_BOOL_F);
157 ret = SCM_EOL;
158 for(i = ires->argc - 1; i >= 0; i--)
159 {
160 switch(ires->argv[i].type)
161 {
162 case 1:
163 ret = scm_cons(scm_makfrom0str(icswcstombs(ires->argv[i].val.str, "UTF-8", NULL)), ret);
164 break;
165 case 2:
166 ret = scm_cons(scm_int2num(ires->argv[i].val.num), ret);
167 break;
168 case 3:
169 ret = scm_cons(scm_double2num(ires->argv[i].val.flnum), ret);
170 break;
171 }
172 }
173 dc_freeires(ires);
174 return(ret);
175}
176
177static int qcmd_scmcb(struct dc_response *resp)
178{
179 struct scmcb *scmcb;
180
181 scmcb = resp->data;
182 scm_apply(scmcb->subr, scm_cons(makerespsmob(resp), SCM_EOL), SCM_EOL);
183 scm_gc_unprotect_object(scmcb->subr);
184 free(scmcb);
185 return(2);
186}
187
188static SCM scm_dc_qcmd(SCM argv, SCM callback)
189{
190 int tag, enob;
191 wchar_t **toks, *tok, *cmd;
192 size_t tokssize, toksdata;
193 SCM port;
194 struct scmcb *scmcb;
195
196 SCM_ASSERT(SCM_CONSP(argv), argv, SCM_ARG1, "dc-qcmd");
197 if(callback != SCM_UNDEFINED)
198 SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG2, "dc-qcmd");
199 cmd = NULL;
200 toks = NULL;
201 tokssize = toksdata = 0;
202 for(; argv != SCM_EOL; argv = SCM_CDR(argv))
203 {
204 port = scm_open_output_string();
205 scm_display(SCM_CAR(argv), port);
206 if((tok = icmbstowcs(SCM_STRING_CHARS(scm_get_output_string(port)), "UTF-8")) == NULL)
207 {
208 enob = errno;
209 addtobuf(toks, NULL);
210 dc_freewcsarr(toks);
211 if(cmd != NULL)
212 free(cmd);
213 errno = enob;
214 scm_syserror("dc-qcmd");
215 }
216 if(cmd == NULL)
217 cmd = tok;
218 else
219 addtobuf(toks, tok);
220 }
221 addtobuf(toks, NULL);
222 if(callback == SCM_UNDEFINED)
223 {
0931eb36 224 tag = dc_queuecmd(NULL, NULL, cmd, L"%a", toks, NULL);
d3372da9 225 } else {
226 scmcb = scm_must_malloc(sizeof(*scmcb), "scmcb");
227 scm_gc_protect_object(scmcb->subr = callback);
0931eb36 228 tag = dc_queuecmd(qcmd_scmcb, scmcb, cmd, L"%a", toks, NULL);
d3372da9 229 }
230 dc_freewcsarr(toks);
231 if(cmd != NULL)
232 free(cmd);
233 return(SCM_MAKINUM(tag));
234}
235
236static void login_scmcb(int err, wchar_t *reason, struct scmcb *scmcb)
237{
238 SCM errsym;
239
240 switch(err)
241 {
242 case DC_LOGIN_ERR_SUCCESS:
243 errsym = scm_str2symbol("success");
244 break;
245 case DC_LOGIN_ERR_NOLOGIN:
246 errsym = scm_str2symbol("nologin");
247 break;
248 case DC_LOGIN_ERR_SERVER:
249 errsym = scm_str2symbol("server");
250 break;
251 case DC_LOGIN_ERR_USER:
252 errsym = scm_str2symbol("user");
253 break;
254 case DC_LOGIN_ERR_CONV:
255 errsym = scm_str2symbol("conv");
256 break;
257 case DC_LOGIN_ERR_AUTHFAIL:
258 errsym = scm_str2symbol("authfail");
259 break;
260 }
261 scm_apply(scmcb->subr, scm_cons(errsym, scm_cons((reason == NULL)?SCM_BOOL_F:scm_makfrom0str(icswcstombs(reason, "UTF-8", NULL)), SCM_EOL)), SCM_EOL);
262 scm_gc_unprotect_object(scmcb->subr);
263 free(scmcb);
264}
265
266static SCM scm_dc_loginasync(SCM callback, SCM useauthless, SCM username)
267{
268 struct scmcb *scmcb;
269
270 SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
271 scmcb = scm_must_malloc(sizeof(*scmcb), "scmcb");
272 scm_gc_protect_object(scmcb->subr = callback);
273 dc_loginasync(SCM_STRINGP(username)?SCM_STRING_CHARS(username):NULL, SCM_NFALSEP(useauthless), NULL, (void (*)(int, wchar_t *, void *))login_scmcb, scmcb);
274 return(SCM_BOOL_T);
275}
276
277static SCM scm_dc_lexsexpr(SCM sexpr)
278{
279 SCM ret;
280 wchar_t **arr, **ap, *buf;
281
282 SCM_ASSERT(SCM_STRINGP(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
283 if((buf = icmbstowcs(SCM_STRING_CHARS(sexpr), NULL)) == NULL)
284 scm_syserror("dc-lexsexpr");
285 arr = dc_lexsexpr(buf);
286 free(buf);
287 ret = SCM_EOL;
288 if(arr != NULL)
289 {
290 for(ap = arr; *ap != NULL; ap++)
291 ret = scm_cons(scm_makfrom0str(icswcstombs(*ap, "UTF-8", NULL)), ret);
292 dc_freewcsarr(arr);
293 }
294 return(scm_reverse(ret));
295}
296
9cbeb60c 297static SCM scm_dc_checkproto(SCM resp, SCM version)
298{
299 int ver;
300
301 SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, resp), resp, SCM_ARG1, "dc-checkproto");
302 if(version == SCM_UNDEFINED)
303 {
304 ver = DC_LATEST;
305 } else {
306 SCM_ASSERT(SCM_INUMP(version), version, SCM_ARG2, "dc-checkproto");
307 ver = SCM_INUM(version);
308 }
309 if(dc_checkprotocol(((struct respsmob *)SCM_SMOB_DATA(resp))->resp, ver))
310 return(SCM_BOOL_F);
311 else
312 return(SCM_BOOL_T);
313}
314
d3372da9 315static size_t resp_free(SCM respsmob)
316{
317 struct respsmob *data;
318
319 data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
320 dc_freeresp(data->resp);
321 free(data);
322 return(sizeof(*data));
323}
324
325static int resp_print(SCM respsmob, SCM port, scm_print_state *pstate)
326{
327 struct respsmob *data;
328
329 data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
330 scm_puts("#<dc-response ", port);
331 scm_display(SCM_MAKINUM(data->resp->tag), port);
332 scm_puts(" ", port);
333 scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
334 scm_puts(" ", port);
335 scm_display(SCM_MAKINUM(data->resp->code), port);
336 scm_puts(">", port);
337 return(1);
338}
339
340void init_guiledc(void)
341{
12383d48 342 scm_c_define_gsubr("dc-connect", 0, 1, 0, scm_dc_connect);
d3372da9 343 scm_c_define_gsubr("dc-disconnect", 0, 0, 0, scm_dc_disconnect);
344 scm_c_define_gsubr("dc-connected", 0, 0, 0, scm_dc_connected);
345 scm_c_define_gsubr("dc-select", 0, 1, 0, scm_dc_select);
346 scm_c_define_gsubr("dc-getresp", 0, 1, 0, scm_dc_getresp);
347 scm_c_define_gsubr("dc-extract", 1, 0, 0, scm_dc_extract);
348 scm_c_define_gsubr("dc-intresp", 1, 0, 0, scm_dc_intresp);
349 scm_c_define_gsubr("dc-qcmd", 1, 1, 0, scm_dc_qcmd);
350 scm_c_define_gsubr("dc-loginasync", 2, 1, 0, scm_dc_loginasync);
351 scm_c_define_gsubr("dc-lexsexpr", 1, 0, 0, scm_dc_lexsexpr);
9cbeb60c 352 scm_c_define_gsubr("dc-checkproto", 1, 1, 0, scm_dc_checkproto);
353 scm_c_define("dc-latest", SCM_MAKINUM(DC_LATEST));
d3372da9 354 resptype = scm_make_smob_type("dc-resp", sizeof(struct respsmob));
355 scm_set_smob_free(resptype, resp_free);
356 scm_set_smob_print(resptype, resp_print);
357 dc_init();
358}