Merge branch 'rpm'
[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     return(scm_from_int(tag));
266 }
267
268 static void login_scmcb(int err, wchar_t *reason, struct scmcb *scmcb)
269 {
270     SCM errsym;
271     
272     switch(err)
273     {
274     case DC_LOGIN_ERR_SUCCESS:
275         errsym = scm_str2symbol("success");
276         break;
277     case DC_LOGIN_ERR_NOLOGIN:
278         errsym = scm_str2symbol("nologin");
279         break;
280     case DC_LOGIN_ERR_SERVER:
281         errsym = scm_str2symbol("server");
282         break;
283     case DC_LOGIN_ERR_USER:
284         errsym = scm_str2symbol("user");
285         break;
286     case DC_LOGIN_ERR_CONV:
287         errsym = scm_str2symbol("conv");
288         break;
289     case DC_LOGIN_ERR_AUTHFAIL:
290         errsym = scm_str2symbol("authfail");
291         break;
292     }
293     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);
294     scm_gc_unprotect_object(scmcb->subr);
295     free(scmcb);
296 }
297
298 static SCM scm_dc_loginasync(SCM callback, SCM useauthless, SCM username)
299 {
300     struct scmcb *scmcb;
301     char *un;
302     
303     SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
304     scmcb = scm_malloc(sizeof(*scmcb));
305     scm_gc_protect_object(scmcb->subr = callback);
306     if(scm_is_string(username))
307         un = scm_to_locale_string(username);
308     else
309         un = NULL;
310     dc_loginasync(un, SCM_NFALSEP(useauthless), NULL, (void (*)(int, wchar_t *, void *))login_scmcb, scmcb);
311     if(un != NULL)
312         free(un);
313     return(SCM_BOOL_T);
314 }
315
316 static SCM scm_dc_lexsexpr(SCM sexpr)
317 {
318     SCM ret;
319     wchar_t **arr, **ap, *buf;
320     
321     SCM_ASSERT(scm_is_string(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
322     if((buf = scm_string_to_wcs(sexpr)) == NULL)
323         scm_syserror("dc-lexsexpr");
324     arr = dc_lexsexpr(buf);
325     free(buf);
326     ret = SCM_EOL;
327     if(arr != NULL)
328     {
329         for(ap = arr; *ap != NULL; ap++)
330             ret = scm_cons(scm_makfrom0str(icswcstombs(*ap, "UTF-8", NULL)), ret);
331         dc_freewcsarr(arr);
332     }
333     return(scm_reverse(ret));
334 }
335
336 static SCM scm_dc_checkproto(SCM resp, SCM version)
337 {
338     int ver;
339     
340     SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, resp), resp, SCM_ARG1, "dc-checkproto");
341     if(version == SCM_UNDEFINED)
342     {
343         ver = DC_LATEST;
344     } else {
345         SCM_ASSERT(scm_is_integer(version), version, SCM_ARG2, "dc-checkproto");
346         ver = scm_to_int(version);
347     }
348     if(dc_checkprotocol(((struct respsmob *)SCM_SMOB_DATA(resp))->resp, ver))
349         return(SCM_BOOL_F);
350     else
351         return(SCM_BOOL_T);
352 }
353
354 static size_t resp_free(SCM respsmob)
355 {
356     struct respsmob *data;
357     
358     data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
359     dc_freeresp(data->resp);
360     scm_gc_free(data, sizeof(*data), "respsmob");
361     return(0);
362 }
363
364 static int resp_print(SCM respsmob, SCM port, scm_print_state *pstate)
365 {
366     struct respsmob *data;
367     
368     data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
369     scm_puts("#<dc-response ", port);
370     scm_display(scm_from_int(data->resp->tag), port);
371     scm_puts(" ", port);
372     scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
373     scm_puts(" ", port);
374     scm_display(scm_from_int(data->resp->code), port);
375     scm_puts(">", port);
376     return(1);
377 }
378
379 void init_guiledc(void)
380 {
381     scm_c_define_gsubr("dc-connect", 0, 1, 0, scm_dc_connect);
382     scm_c_define_gsubr("dc-disconnect", 0, 0, 0, scm_dc_disconnect);
383     scm_c_define_gsubr("dc-connected", 0, 0, 0, scm_dc_connected);
384     scm_c_define_gsubr("dc-select", 0, 1, 0, scm_dc_select);
385     scm_c_define_gsubr("dc-getresp", 0, 1, 0, scm_dc_getresp);
386     scm_c_define_gsubr("dc-extract", 1, 0, 0, scm_dc_extract);
387     scm_c_define_gsubr("dc-intresp", 1, 0, 0, scm_dc_intresp);
388     scm_c_define_gsubr("dc-qcmd", 1, 1, 0, scm_dc_qcmd);
389     scm_c_define_gsubr("dc-loginasync", 2, 1, 0, scm_dc_loginasync);
390     scm_c_define_gsubr("dc-lexsexpr", 1, 0, 0, scm_dc_lexsexpr);
391     scm_c_define_gsubr("dc-checkproto", 1, 1, 0, scm_dc_checkproto);
392     scm_c_define("dc-latest", scm_from_int(DC_LATEST));
393     resptype = scm_make_smob_type("dc-resp", sizeof(struct respsmob));
394     scm_set_smob_free(resptype, resp_free);
395     scm_set_smob_print(resptype, resp_print);
396     dc_init();
397 }