Merge branch 'master' of git.dolda2000.com:/srv/git/r/doldaconnect
[doldaconnect.git] / lib / guile / dolcon-guile.c
1 /*
2  *  Dolda Connect - Modular multiuser Direct Connect-style client
3  *  Copyright (C) 2007 Fredrik Tolf <fredrik@dolda2000.com>
4  *  
5  *  This program is free software; you can redistribute it and/or modify
6  *  it under the terms of the GNU General Public License as published by
7  *  the Free Software Foundation; either version 2 of the License, or
8  *  (at your option) any later version.
9  *  
10  *  This program is distributed in the hope that it will be useful,
11  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
12  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13  *  GNU General Public License for more details.
14  *  
15  *  You should have received a copy of the GNU General Public License
16  *  along with this program; if not, write to the Free Software
17  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
18 */
19 #include <stdlib.h>
20 #include <stdio.h>
21 #include <sys/poll.h>
22 #include <errno.h>
23 #include <libguile.h>
24
25 #ifdef HAVE_CONFIG_H
26 #include <config.h>
27 #endif
28 #include <doldaconnect/uilib.h>
29 #include <doldaconnect/uimisc.h>
30 #include <doldaconnect/utils.h>
31
32 struct respsmob
33 {
34     struct dc_response *resp;
35 };
36
37 struct scmcb
38 {
39     SCM subr;
40 };
41
42 static int fd = -1;
43 static scm_t_bits resptype;
44
45 static SCM scm_dc_connect(SCM host)
46 {
47     char *chost;
48     
49     if(fd >= 0)
50         dc_disconnect();
51     if((host == SCM_UNDEFINED) || (host == SCM_BOOL_F))
52     {
53         chost = NULL;
54     } else {
55         SCM_ASSERT(scm_is_string(host), host, SCM_ARG1, "dc-connect");
56         chost = scm_to_locale_string(host);
57     }
58     fd = dc_connect(chost);
59     if(chost != NULL)
60         free(chost);
61     if(fd < 0)
62         scm_syserror("dc-connect");
63     return(scm_from_int(fd));
64 }
65
66 static SCM scm_dc_disconnect(void)
67 {
68     dc_disconnect();
69     return(scm_from_int(0));
70 }
71
72 static SCM scm_dc_connected(void)
73 {
74     return((fd == -1)?SCM_BOOL_F:SCM_BOOL_T);
75 }
76
77 static SCM scm_dc_select(SCM timeout)
78 {
79     struct pollfd pfd;
80     int cto, ret, enob;
81     
82     if(timeout == SCM_UNDEFINED)
83     {
84         cto = -1;
85     } else {
86         SCM_ASSERT(scm_is_integer(timeout), timeout, SCM_ARG1, "dc-select");
87         cto = scm_to_int(timeout);
88     }
89     if(fd < 0)
90         scm_syserror_msg("dc-select", "Not connected", SCM_EOL, ENOTCONN);
91     pfd.fd = fd;
92     pfd.events = POLLIN;
93     if(dc_wantwrite())
94         pfd.events |= POLLOUT;
95     if((ret = poll(&pfd, 1, cto)) < 0)
96     {
97         if(errno == EINTR)
98             return(SCM_BOOL_F);
99         enob = errno;
100         dc_disconnect();
101         errno = enob;
102         scm_syserror("dc-select");
103     }
104     if(((pfd.revents & POLLIN) && dc_handleread()) || ((pfd.revents & POLLOUT) && dc_handlewrite()))
105     {
106         if(errno == 0)
107         {
108             fd = -1;
109             return(SCM_BOOL_F);
110         }
111         scm_syserror("dc-select");
112     }
113     return(ret?SCM_BOOL_T:SCM_BOOL_F);
114 }
115
116 static SCM makerespsmob(struct dc_response *resp)
117 {
118     struct respsmob *data;
119     
120     data = scm_gc_malloc(sizeof(*data), "respsmob");
121     data->resp = resp;
122     SCM_RETURN_NEWSMOB(resptype, data);
123 }
124
125 static SCM scm_dc_getresp(SCM tag)
126 {
127     struct dc_response *resp;
128     SCM ret;
129     
130     if(tag == SCM_UNDEFINED)
131     {
132         if((resp = dc_getresp()) == NULL)
133             return(SCM_BOOL_F);
134     } else {
135         SCM_ASSERT(scm_is_integer(tag), tag, SCM_ARG1, "dc-getresp");
136         if((resp = dc_gettaggedresp(scm_to_int(tag))) == NULL)
137             return(SCM_BOOL_F);
138     }
139     ret = makerespsmob(resp);
140     return(ret);
141 }
142
143 static SCM scm_dc_extract(SCM scm_resp)
144 {
145     int i, o;
146     struct dc_response *resp;
147     SCM ret, l, w;
148     
149     SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-extract");
150     resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
151     ret = SCM_EOL;
152     ret = scm_cons(scm_cons(scm_str2symbol("cmd"), scm_makfrom0str(icswcstombs(resp->cmdname, "UTF-8", NULL))), ret);
153     ret = scm_cons(scm_cons(scm_str2symbol("code"), scm_from_int(resp->code)), ret);
154     ret = scm_cons(scm_cons(scm_str2symbol("tag"), scm_from_int(resp->tag)), ret);
155     l = SCM_EOL;
156     for(i = resp->numlines - 1; i >= 0; i--)
157     {
158         w = SCM_EOL;
159         for(o = resp->rlines[i].argc - 1; o >= 0; o--)
160             w = scm_cons(scm_makfrom0str(icswcstombs(resp->rlines[i].argv[o], "UTF-8", NULL)), w);
161         l = scm_cons(w, l);
162     }
163     ret = scm_cons(scm_cons(scm_str2symbol("resp"), l), ret);
164     return(ret);
165 }
166
167 static SCM scm_dc_intresp(SCM scm_resp)
168 {
169     int i;
170     struct dc_response *resp;
171     struct dc_intresp *ires;
172     SCM ret;
173     
174     SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-intresp");
175     resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
176     if((ires = dc_interpret(resp)) == NULL)
177         return(SCM_BOOL_F);
178     ret = SCM_EOL;
179     for(i = ires->argc - 1; i >= 0; i--)
180     {
181         switch(ires->argv[i].type)
182         {
183         case 1:
184             ret = scm_cons(scm_makfrom0str(icswcstombs(ires->argv[i].val.str, "UTF-8", NULL)), ret);
185             break;
186         case 2:
187             ret = scm_cons(scm_int2num(ires->argv[i].val.num), ret);
188             break;
189         case 3:
190             ret = scm_cons(scm_double2num(ires->argv[i].val.flnum), ret);
191             break;
192         }
193     }
194     dc_freeires(ires);
195     return(ret);
196 }
197
198 static int qcmd_scmcb(struct dc_response *resp)
199 {
200     struct scmcb *scmcb;
201     
202     scmcb = resp->data;
203     scm_apply(scmcb->subr, scm_cons(makerespsmob(resp), SCM_EOL), SCM_EOL);
204     scm_gc_unprotect_object(scmcb->subr);
205     free(scmcb);
206     return(2);
207 }
208
209 static wchar_t *scm_string_to_wcs(SCM str)
210 {
211     char *buf;
212     wchar_t *ret;
213     
214     buf = scm_to_locale_string(str);
215     ret = icmbstowcs(buf, NULL);
216     free(buf);
217     return(ret);
218 }
219
220 static SCM scm_dc_qcmd(SCM argv, SCM callback)
221 {
222     int tag, enob;
223     wchar_t **toks, *tok, *cmd;
224     size_t tokssize, toksdata;
225     SCM port;
226     struct scmcb *scmcb;
227     
228     SCM_ASSERT(SCM_CONSP(argv), argv, SCM_ARG1, "dc-qcmd");
229     if(callback != SCM_UNDEFINED)
230         SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG2, "dc-qcmd");
231     cmd = NULL;
232     toks = NULL;
233     tokssize = toksdata = 0;
234     for(; argv != SCM_EOL; argv = SCM_CDR(argv))
235     {
236         port = scm_open_output_string();
237         scm_display(SCM_CAR(argv), port);
238         if((tok = scm_string_to_wcs(scm_get_output_string(port))) == NULL)
239         {
240             enob = errno;
241             addtobuf(toks, NULL);
242             dc_freewcsarr(toks);
243             if(cmd != NULL)
244                 free(cmd);
245             errno = enob;
246             scm_syserror("dc-qcmd");
247         }
248         if(cmd == NULL)
249             cmd = tok;
250         else
251             addtobuf(toks, tok);
252     }
253     addtobuf(toks, NULL);
254     if(callback == SCM_UNDEFINED)
255     {
256         tag = dc_queuecmd(NULL, NULL, cmd, L"%a", toks, NULL);
257     } else {
258         scmcb = scm_malloc(sizeof(*scmcb));
259         scm_gc_protect_object(scmcb->subr = callback);
260         tag = dc_queuecmd(qcmd_scmcb, scmcb, cmd, L"%a", toks, NULL);
261     }
262     dc_freewcsarr(toks);
263     if(cmd != NULL)
264         free(cmd);
265     if(tag == -1) {
266         if(errno == ENOSYS) {
267             scm_error(scm_str2symbol("no-such-cmd"), "dc-qcmd", "Invalid command name", SCM_EOL, SCM_BOOL_F);
268         } else if(errno == EINVAL) {
269             scm_error(scm_str2symbol("illegal-escape"), "dc-qcmd", "Invalid escape sequence", SCM_EOL, SCM_BOOL_F);
270         } else {
271             scm_syserror("dc-qcmd");
272         }
273     } else {
274         return(scm_from_int(tag));
275     }
276 }
277
278 static void login_scmcb(int err, wchar_t *reason, struct scmcb *scmcb)
279 {
280     SCM errsym;
281     
282     switch(err)
283     {
284     case DC_LOGIN_ERR_SUCCESS:
285         errsym = scm_str2symbol("success");
286         break;
287     case DC_LOGIN_ERR_NOLOGIN:
288         errsym = scm_str2symbol("nologin");
289         break;
290     case DC_LOGIN_ERR_SERVER:
291         errsym = scm_str2symbol("server");
292         break;
293     case DC_LOGIN_ERR_USER:
294         errsym = scm_str2symbol("user");
295         break;
296     case DC_LOGIN_ERR_CONV:
297         errsym = scm_str2symbol("conv");
298         break;
299     case DC_LOGIN_ERR_AUTHFAIL:
300         errsym = scm_str2symbol("authfail");
301         break;
302     }
303     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);
304     scm_gc_unprotect_object(scmcb->subr);
305     free(scmcb);
306 }
307
308 static SCM scm_dc_loginasync(SCM callback, SCM useauthless, SCM username)
309 {
310     struct scmcb *scmcb;
311     char *un;
312     
313     SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
314     scmcb = scm_malloc(sizeof(*scmcb));
315     scm_gc_protect_object(scmcb->subr = callback);
316     if(scm_is_string(username))
317         un = scm_to_locale_string(username);
318     else
319         un = NULL;
320     dc_loginasync(un, SCM_NFALSEP(useauthless), NULL, (void (*)(int, wchar_t *, void *))login_scmcb, scmcb);
321     if(un != NULL)
322         free(un);
323     return(SCM_BOOL_T);
324 }
325
326 static SCM scm_dc_lexsexpr(SCM sexpr)
327 {
328     SCM ret;
329     wchar_t **arr, **ap, *buf;
330     
331     SCM_ASSERT(scm_is_string(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
332     if((buf = scm_string_to_wcs(sexpr)) == NULL)
333         scm_syserror("dc-lexsexpr");
334     arr = dc_lexsexpr(buf);
335     free(buf);
336     ret = SCM_EOL;
337     if(arr != NULL)
338     {
339         for(ap = arr; *ap != NULL; ap++)
340             ret = scm_cons(scm_makfrom0str(icswcstombs(*ap, "UTF-8", NULL)), ret);
341         dc_freewcsarr(arr);
342     }
343     return(scm_reverse(ret));
344 }
345
346 static SCM scm_dc_checkproto(SCM resp, SCM version)
347 {
348     int ver;
349     
350     SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, resp), resp, SCM_ARG1, "dc-checkproto");
351     if(version == SCM_UNDEFINED)
352     {
353         ver = DC_LATEST;
354     } else {
355         SCM_ASSERT(scm_is_integer(version), version, SCM_ARG2, "dc-checkproto");
356         ver = scm_to_int(version);
357     }
358     if(dc_checkprotocol(((struct respsmob *)SCM_SMOB_DATA(resp))->resp, ver))
359         return(SCM_BOOL_F);
360     else
361         return(SCM_BOOL_T);
362 }
363
364 static size_t resp_free(SCM respsmob)
365 {
366     struct respsmob *data;
367     
368     data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
369     dc_freeresp(data->resp);
370     scm_gc_free(data, sizeof(*data), "respsmob");
371     return(0);
372 }
373
374 static int resp_print(SCM respsmob, SCM port, scm_print_state *pstate)
375 {
376     struct respsmob *data;
377     
378     data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
379     scm_puts("#<dc-response ", port);
380     scm_display(scm_from_int(data->resp->tag), port);
381     scm_puts(" ", port);
382     scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
383     scm_puts(" ", port);
384     scm_display(scm_from_int(data->resp->code), port);
385     scm_puts(">", port);
386     return(1);
387 }
388
389 void init_guiledc(void)
390 {
391     scm_c_define_gsubr("dc-connect", 0, 1, 0, scm_dc_connect);
392     scm_c_define_gsubr("dc-disconnect", 0, 0, 0, scm_dc_disconnect);
393     scm_c_define_gsubr("dc-connected", 0, 0, 0, scm_dc_connected);
394     scm_c_define_gsubr("dc-select", 0, 1, 0, scm_dc_select);
395     scm_c_define_gsubr("dc-getresp", 0, 1, 0, scm_dc_getresp);
396     scm_c_define_gsubr("dc-extract", 1, 0, 0, scm_dc_extract);
397     scm_c_define_gsubr("dc-intresp", 1, 0, 0, scm_dc_intresp);
398     scm_c_define_gsubr("dc-qcmd", 1, 1, 0, scm_dc_qcmd);
399     scm_c_define_gsubr("dc-loginasync", 2, 1, 0, scm_dc_loginasync);
400     scm_c_define_gsubr("dc-lexsexpr", 1, 0, 0, scm_dc_lexsexpr);
401     scm_c_define_gsubr("dc-checkproto", 1, 1, 0, scm_dc_checkproto);
402     scm_c_define("dc-latest", scm_from_int(DC_LATEST));
403     resptype = scm_make_smob_type("dc-resp", sizeof(struct respsmob));
404     scm_set_smob_free(resptype, resp_free);
405     scm_set_smob_print(resptype, resp_print);
406     dc_init();
407 }