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