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 }