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