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 }