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_from_int(ires->argv[i].val.num), ret);
 188             break;
 189         case 3:
 190             ret = scm_cons(scm_from_double(ires->argv[i].val.flnum), ret);
 191             break;
 192         case 4:
 193             ret = scm_cons(scm_from_int64(ires->argv[i].val.lnum), ret);
 194             break;
 195         }
 196     }
 197     dc_freeires(ires);
 198     return(ret);
 199 }
 200
 201 static int qcmd_scmcb(struct dc_response *resp)
 202 {
 203     struct scmcb *scmcb;
 204
 205     scmcb = resp->data;
 206     scm_apply(scmcb->subr, scm_cons(makerespsmob(resp), SCM_EOL), SCM_EOL);
 207     scm_gc_unprotect_object(scmcb->subr);
 208     free(scmcb);
 209     return(2);
 210 }
 211
 212 static wchar_t *scm_string_to_wcs(SCM str)
 213 {
 214     char *buf;
 215     wchar_t *ret;
 216
 217     buf = scm_to_locale_string(str);
 218     ret = icmbstowcs(buf, NULL);
 219     free(buf);
 220     return(ret);
 221 }
 222
 223 static SCM scm_dc_qcmd(SCM argv, SCM callback)
 224 {
 225     int tag, enob;
 226     wchar_t **toks, *tok, *cmd;
 227     size_t tokssize, toksdata;
 228     SCM port;
 229     struct scmcb *scmcb;
 230
 231     SCM_ASSERT(SCM_CONSP(argv), argv, SCM_ARG1, "dc-qcmd");
 232     if(callback != SCM_UNDEFINED)
 233         SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG2, "dc-qcmd");
 234     cmd = NULL;
 235     toks = NULL;
 236     tokssize = toksdata = 0;
 237     for(; argv != SCM_EOL; argv = SCM_CDR(argv))
 238     {
 239         port = scm_open_output_string();
 240         scm_display(SCM_CAR(argv), port);
 241         if((tok = scm_string_to_wcs(scm_get_output_string(port))) == NULL)
 242         {
 243             enob = errno;
 244             addtobuf(toks, NULL);
 245             dc_freewcsarr(toks);
 246             if(cmd != NULL)
 247                 free(cmd);
 248             errno = enob;
 249             scm_syserror("dc-qcmd");
 250         }
 251         if(cmd == NULL)
 252             cmd = tok;
 253         else
 254             addtobuf(toks, tok);
 255     }
 256     addtobuf(toks, NULL);
 257     if(callback == SCM_UNDEFINED)
 258     {
 259         tag = dc_queuecmd(NULL, NULL, cmd, L"%a", toks, NULL);
 260     } else {
 261         scmcb = scm_malloc(sizeof(*scmcb));
 262         scm_gc_protect_object(scmcb->subr = callback);
 263         tag = dc_queuecmd(qcmd_scmcb, scmcb, cmd, L"%a", toks, NULL);
 264     }
 265     dc_freewcsarr(toks);
 266     if(cmd != NULL)
 267         free(cmd);
 268     if(tag == -1) {
 269         if(errno == ENOSYS) {
 270             scm_error(scm_str2symbol("no-such-cmd"), "dc-qcmd", "Invalid command name", SCM_EOL, SCM_BOOL_F);
 271         } else if(errno == EINVAL) {
 272             scm_error(scm_str2symbol("illegal-escape"), "dc-qcmd", "Invalid escape sequence", SCM_EOL, SCM_BOOL_F);
 273         } else {
 274             scm_syserror("dc-qcmd");
 275         }
 276     } else {
 277         return(scm_from_int(tag));
 278     }
 279 }
 280
 281 static void login_scmcb(int err, wchar_t *reason, struct scmcb *scmcb)
 282 {
 283     SCM errsym;
 284
 285     switch(err)
 286     {
 287     case DC_LOGIN_ERR_SUCCESS:
 288         errsym = scm_str2symbol("success");
 289         break;
 290     case DC_LOGIN_ERR_NOLOGIN:
 291         errsym = scm_str2symbol("nologin");
 292         break;
 293     case DC_LOGIN_ERR_SERVER:
 294         errsym = scm_str2symbol("server");
 295         break;
 296     case DC_LOGIN_ERR_USER:
 297         errsym = scm_str2symbol("user");
 298         break;
 299     case DC_LOGIN_ERR_CONV:
 300         errsym = scm_str2symbol("conv");
 301         break;
 302     case DC_LOGIN_ERR_AUTHFAIL:
 303         errsym = scm_str2symbol("authfail");
 304         break;
 305     }
 306     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);
 307     scm_gc_unprotect_object(scmcb->subr);
 308     free(scmcb);
 309 }
 310
 311 static SCM scm_dc_loginasync(SCM callback, SCM useauthless, SCM username)
 312 {
 313     struct scmcb *scmcb;
 314     char *un;
 315
 316     SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
 317     scmcb = scm_malloc(sizeof(*scmcb));
 318     scm_gc_protect_object(scmcb->subr = callback);
 319     if(scm_is_string(username))
 320         un = scm_to_locale_string(username);
 321     else
 322         un = NULL;
 323     dc_loginasync(un, SCM_NFALSEP(useauthless), NULL, (void (*)(int, wchar_t *, void *))login_scmcb, scmcb);
 324     if(un != NULL)
 325         free(un);
 326     return(SCM_BOOL_T);
 327 }
 328
 329 static SCM scm_dc_lexsexpr(SCM sexpr)
 330 {
 331     SCM ret;
 332     wchar_t **arr, **ap, *buf;
 333
 334     SCM_ASSERT(scm_is_string(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
 335     if((buf = scm_string_to_wcs(sexpr)) == NULL)
 336         scm_syserror("dc-lexsexpr");
 337     arr = dc_lexsexpr(buf);
 338     free(buf);
 339     ret = SCM_EOL;
 340     if(arr != NULL)
 341     {
 342         for(ap = arr; *ap != NULL; ap++)
 343             ret = scm_cons(scm_makfrom0str(icswcstombs(*ap, "UTF-8", NULL)), ret);
 344         dc_freewcsarr(arr);
 345     }
 346     return(scm_reverse(ret));
 347 }
 348
 349 static SCM scm_dc_checkproto(SCM resp, SCM version)
 350 {
 351     int ver;
 352
 353     SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, resp), resp, SCM_ARG1, "dc-checkproto");
 354     if(version == SCM_UNDEFINED)
 355     {
 356         ver = DC_LATEST;
 357     } else {
 358         SCM_ASSERT(scm_is_integer(version), version, SCM_ARG2, "dc-checkproto");
 359         ver = scm_to_int(version);
 360     }
 361     if(dc_checkprotocol(((struct respsmob *)SCM_SMOB_DATA(resp))->resp, ver))
 362         return(SCM_BOOL_F);
 363     else
 364         return(SCM_BOOL_T);
 365 }
 366
 367 static size_t resp_free(SCM respsmob)
 368 {
 369     struct respsmob *data;
 370
 371     data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
 372     dc_freeresp(data->resp);
 373     scm_gc_free(data, sizeof(*data), "respsmob");
 374     return(0);
 375 }
 376
 377 static int resp_print(SCM respsmob, SCM port, scm_print_state *pstate)
 378 {
 379     struct respsmob *data;
 380
 381     data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
 382     scm_puts("#<dc-response ", port);
 383     scm_display(scm_from_int(data->resp->tag), port);
 384     scm_puts(" ", port);
 385     scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
 386     scm_puts(" ", port);
 387     scm_display(scm_from_int(data->resp->code), port);
 388     scm_puts(">", port);
 389     return(1);
 390 }
 391
 392 void init_guiledc(void)
 393 {
 394     scm_c_define_gsubr("dc-connect", 0, 1, 0, scm_dc_connect);
 395     scm_c_define_gsubr("dc-disconnect", 0, 0, 0, scm_dc_disconnect);
 396     scm_c_define_gsubr("dc-connected", 0, 0, 0, scm_dc_connected);
 397     scm_c_define_gsubr("dc-select", 0, 1, 0, scm_dc_select);
 398     scm_c_define_gsubr("dc-getresp", 0, 1, 0, scm_dc_getresp);
 399     scm_c_define_gsubr("dc-extract", 1, 0, 0, scm_dc_extract);
 400     scm_c_define_gsubr("dc-intresp", 1, 0, 0, scm_dc_intresp);
 401     scm_c_define_gsubr("dc-qcmd", 1, 1, 0, scm_dc_qcmd);
 402     scm_c_define_gsubr("dc-loginasync", 2, 1, 0, scm_dc_loginasync);
 403     scm_c_define_gsubr("dc-lexsexpr", 1, 0, 0, scm_dc_lexsexpr);
 404     scm_c_define_gsubr("dc-checkproto", 1, 1, 0, scm_dc_checkproto);
 405     scm_c_define("dc-latest", scm_from_int(DC_LATEST));
 406     resptype = scm_make_smob_type("dc-resp", sizeof(struct respsmob));
 407     scm_set_smob_free(resptype, resp_free);
 408     scm_set_smob_print(resptype, resp_print);
 409     dc_init();
 410 }