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