Add AUTOCONF_VERSION variable to bootstrap.
[doldaconnect.git] / lib / guile / dolcon-guile.c
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
14 struct respsmob
15 {
16     struct dc_response *resp;
17 };
18
19 struct scmcb
20 {
21     SCM subr;
22 };
23
24 static int fd = -1;
25 static scm_bits_t resptype;
26
27 static 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
46 static SCM scm_dc_disconnect(void)
47 {
48     dc_disconnect();
49     return(SCM_MAKINUM(0));
50 }
51
52 static SCM scm_dc_connected(void)
53 {
54     return((fd == -1)?SCM_BOOL_F:SCM_BOOL_T);
55 }
56
57 static 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
96 static 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
105 static 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
123 static 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
147 static 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
178 static 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
189 static 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
237 static 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
267 static 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
278 static 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
298 static 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
308 static 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
323 void 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 }