[doldaconnect.git] / lib / guile / dolcon-guile.c

/*
 *  Dolda Connect - Modular multiuser Direct Connect-style client
 *  Copyright (C) 2007 Fredrik Tolf <fredrik@dolda2000.com>
 *  
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *  
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *  
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*/
#include <stdlib.h>
#include <stdio.h>
#include <sys/poll.h>
#include <errno.h>
#include <libguile.h>

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
#include <doldaconnect/uilib.h>
#include <doldaconnect/uimisc.h>
#include <doldaconnect/utils.h>

struct respsmob
{
    struct dc_response *resp;
};

struct scmcb
{
    SCM subr;
};

static int fd = -1;
static scm_t_bits resptype;

static SCM scm_dc_connect(SCM host)
{
    char *chost;
    
    if(fd >= 0)
	dc_disconnect();
    if((host == SCM_UNDEFINED) || (host == SCM_BOOL_F))
    {
	chost = NULL;
    } else {
	SCM_ASSERT(scm_is_string(host), host, SCM_ARG1, "dc-connect");
	chost = scm_to_locale_string(host);
    }
    fd = dc_connect(chost);
    if(chost != NULL)
	free(chost);
    if(fd < 0)
	scm_syserror("dc-connect");
    return(scm_from_int(fd));
}

static SCM scm_dc_disconnect(void)
{
    dc_disconnect();
    return(scm_from_int(0));
}

static SCM scm_dc_connected(void)
{
    return((fd == -1)?SCM_BOOL_F:SCM_BOOL_T);
}

static SCM scm_dc_select(SCM timeout)
{
    struct pollfd pfd;
    int cto, ret, enob;
    
    if(timeout == SCM_UNDEFINED)
    {
	cto = -1;
    } else {
	SCM_ASSERT(scm_is_integer(timeout), timeout, SCM_ARG1, "dc-select");
	cto = scm_to_int(timeout);
    }
    if(fd < 0)
	scm_syserror_msg("dc-select", "Not connected", SCM_EOL, ENOTCONN);
    pfd.fd = fd;
    pfd.events = POLLIN;
    if(dc_wantwrite())
	pfd.events |= POLLOUT;
    if((ret = poll(&pfd, 1, cto)) < 0)
    {
	if(errno == EINTR)
	    return(SCM_BOOL_F);
	enob = errno;
	dc_disconnect();
	errno = enob;
	scm_syserror("dc-select");
    }
    if(((pfd.revents & POLLIN) && dc_handleread()) || ((pfd.revents & POLLOUT) && dc_handlewrite()))
    {
	if(errno == 0)
	{
	    fd = -1;
	    return(SCM_BOOL_F);
	}
	scm_syserror("dc-select");
    }
    return(ret?SCM_BOOL_T:SCM_BOOL_F);
}

static SCM makerespsmob(struct dc_response *resp)
{
    struct respsmob *data;
    
    data = scm_gc_malloc(sizeof(*data), "respsmob");
    data->resp = resp;
    SCM_RETURN_NEWSMOB(resptype, data);
}

static SCM scm_dc_getresp(SCM tag)
{
    struct dc_response *resp;
    SCM ret;
    
    if(tag == SCM_UNDEFINED)
    {
	if((resp = dc_getresp()) == NULL)
	    return(SCM_BOOL_F);
    } else {
	SCM_ASSERT(scm_is_integer(tag), tag, SCM_ARG1, "dc-getresp");
	if((resp = dc_gettaggedresp(scm_to_int(tag))) == NULL)
	    return(SCM_BOOL_F);
    }
    ret = makerespsmob(resp);
    return(ret);
}

static SCM scm_dc_extract(SCM scm_resp)
{
    int i, o;
    struct dc_response *resp;
    SCM ret, l, w;
    
    SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-extract");
    resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
    ret = SCM_EOL;
    ret = scm_cons(scm_cons(scm_str2symbol("cmd"), scm_makfrom0str(icswcstombs(resp->cmdname, "UTF-8", NULL))), ret);
    ret = scm_cons(scm_cons(scm_str2symbol("code"), scm_from_int(resp->code)), ret);
    ret = scm_cons(scm_cons(scm_str2symbol("tag"), scm_from_int(resp->tag)), ret);
    l = SCM_EOL;
    for(i = resp->numlines - 1; i >= 0; i--)
    {
	w = SCM_EOL;
	for(o = resp->rlines[i].argc - 1; o >= 0; o--)
	    w = scm_cons(scm_makfrom0str(icswcstombs(resp->rlines[i].argv[o], "UTF-8", NULL)), w);
	l = scm_cons(w, l);
    }
    ret = scm_cons(scm_cons(scm_str2symbol("resp"), l), ret);
    return(ret);
}

static SCM scm_dc_intresp(SCM scm_resp)
{
    int i;
    struct dc_response *resp;
    struct dc_intresp *ires;
    SCM ret;
    
    SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-intresp");
    resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
    if((ires = dc_interpret(resp)) == NULL)
	return(SCM_BOOL_F);
    ret = SCM_EOL;
    for(i = ires->argc - 1; i >= 0; i--)
    {
	switch(ires->argv[i].type)
	{
	case 1:
	    ret = scm_cons(scm_makfrom0str(icswcstombs(ires->argv[i].val.str, "UTF-8", NULL)), ret);
	    break;
	case 2:
	    ret = scm_cons(scm_from_int(ires->argv[i].val.num), ret);
	    break;
	case 3:
	    ret = scm_cons(scm_from_double(ires->argv[i].val.flnum), ret);
	    break;
	case 4:
	    ret = scm_cons(scm_from_int64(ires->argv[i].val.lnum), ret);
	    break;
	}
    }
    dc_freeires(ires);
    return(ret);
}

static int qcmd_scmcb(struct dc_response *resp)
{
    struct scmcb *scmcb;
    
    scmcb = resp->data;
    scm_apply(scmcb->subr, scm_cons(makerespsmob(resp), SCM_EOL), SCM_EOL);
    scm_gc_unprotect_object(scmcb->subr);
    free(scmcb);
    return(2);
}

static wchar_t *scm_string_to_wcs(SCM str)
{
    char *buf;
    wchar_t *ret;
    
    buf = scm_to_locale_string(str);
    ret = icmbstowcs(buf, NULL);
    free(buf);
    return(ret);
}

static SCM scm_dc_qcmd(SCM argv, SCM callback)
{
    int tag, enob;
    wchar_t **toks, *tok, *cmd;
    size_t tokssize, toksdata;
    SCM port;
    struct scmcb *scmcb;
    
    SCM_ASSERT(SCM_CONSP(argv), argv, SCM_ARG1, "dc-qcmd");
    if(callback != SCM_UNDEFINED)
	SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG2, "dc-qcmd");
    cmd = NULL;
    toks = NULL;
    tokssize = toksdata = 0;
    for(; argv != SCM_EOL; argv = SCM_CDR(argv))
    {
	port = scm_open_output_string();
	scm_display(SCM_CAR(argv), port);
	if((tok = scm_string_to_wcs(scm_get_output_string(port))) == NULL)
	{
	    enob = errno;
	    addtobuf(toks, NULL);
	    dc_freewcsarr(toks);
	    if(cmd != NULL)
		free(cmd);
	    errno = enob;
	    scm_syserror("dc-qcmd");
	}
	if(cmd == NULL)
	    cmd = tok;
	else
	    addtobuf(toks, tok);
    }
    addtobuf(toks, NULL);
    if(callback == SCM_UNDEFINED)
    {
	tag = dc_queuecmd(NULL, NULL, cmd, L"%a", toks, NULL);
    } else {
	scmcb = scm_malloc(sizeof(*scmcb));
	scm_gc_protect_object(scmcb->subr = callback);
	tag = dc_queuecmd(qcmd_scmcb, scmcb, cmd, L"%a", toks, NULL);
    }
    dc_freewcsarr(toks);
    if(cmd != NULL)
	free(cmd);
    if(tag == -1) {
	if(errno == ENOSYS) {
	    scm_error(scm_str2symbol("no-such-cmd"), "dc-qcmd", "Invalid command name", SCM_EOL, SCM_BOOL_F);
	} else if(errno == EINVAL) {
	    scm_error(scm_str2symbol("illegal-escape"), "dc-qcmd", "Invalid escape sequence", SCM_EOL, SCM_BOOL_F);
	} else {
	    scm_syserror("dc-qcmd");
	}
    } else {
	return(scm_from_int(tag));
    }
}

static void login_scmcb(int err, wchar_t *reason, struct scmcb *scmcb)
{
    SCM errsym;
    
    switch(err)
    {
    case DC_LOGIN_ERR_SUCCESS:
	errsym = scm_str2symbol("success");
	break;
    case DC_LOGIN_ERR_NOLOGIN:
	errsym = scm_str2symbol("nologin");
	break;
    case DC_LOGIN_ERR_SERVER:
	errsym = scm_str2symbol("server");
	break;
    case DC_LOGIN_ERR_USER:
	errsym = scm_str2symbol("user");
	break;
    case DC_LOGIN_ERR_CONV:
	errsym = scm_str2symbol("conv");
	break;
    case DC_LOGIN_ERR_AUTHFAIL:
	errsym = scm_str2symbol("authfail");
	break;
    }
    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);
    scm_gc_unprotect_object(scmcb->subr);
    free(scmcb);
}

static SCM scm_dc_loginasync(SCM callback, SCM useauthless, SCM username)
{
    struct scmcb *scmcb;
    char *un;
    
    SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
    scmcb = scm_malloc(sizeof(*scmcb));
    scm_gc_protect_object(scmcb->subr = callback);
    if(scm_is_string(username))
	un = scm_to_locale_string(username);
    else
	un = NULL;
    dc_loginasync(un, SCM_NFALSEP(useauthless), NULL, (void (*)(int, wchar_t *, void *))login_scmcb, scmcb);
    if(un != NULL)
	free(un);
    return(SCM_BOOL_T);
}

static SCM scm_dc_lexsexpr(SCM sexpr)
{
    SCM ret;
    wchar_t **arr, **ap, *buf;
    
    SCM_ASSERT(scm_is_string(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
    if((buf = scm_string_to_wcs(sexpr)) == NULL)
	scm_syserror("dc-lexsexpr");
    arr = dc_lexsexpr(buf);
    free(buf);
    ret = SCM_EOL;
    if(arr != NULL)
    {
	for(ap = arr; *ap != NULL; ap++)
	    ret = scm_cons(scm_makfrom0str(icswcstombs(*ap, "UTF-8", NULL)), ret);
	dc_freewcsarr(arr);
    }
    return(scm_reverse(ret));
}

static SCM scm_dc_checkproto(SCM resp, SCM version)
{
    int ver;
    
    SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, resp), resp, SCM_ARG1, "dc-checkproto");
    if(version == SCM_UNDEFINED)
    {
	ver = DC_LATEST;
    } else {
	SCM_ASSERT(scm_is_integer(version), version, SCM_ARG2, "dc-checkproto");
	ver = scm_to_int(version);
    }
    if(dc_checkprotocol(((struct respsmob *)SCM_SMOB_DATA(resp))->resp, ver))
	return(SCM_BOOL_F);
    else
	return(SCM_BOOL_T);
}

static size_t resp_free(SCM respsmob)
{
    struct respsmob *data;
    
    data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
    dc_freeresp(data->resp);
    scm_gc_free(data, sizeof(*data), "respsmob");
    return(0);
}

static int resp_print(SCM respsmob, SCM port, scm_print_state *pstate)
{
    struct respsmob *data;
    
    data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
    scm_puts("#<dc-response ", port);
    scm_display(scm_from_int(data->resp->tag), port);
    scm_puts(" ", port);
    scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
    scm_puts(" ", port);
    scm_display(scm_from_int(data->resp->code), port);
    scm_puts(">", port);
    return(1);
}

void init_guiledc(void)
{
    scm_c_define_gsubr("dc-connect", 0, 1, 0, scm_dc_connect);
    scm_c_define_gsubr("dc-disconnect", 0, 0, 0, scm_dc_disconnect);
    scm_c_define_gsubr("dc-connected", 0, 0, 0, scm_dc_connected);
    scm_c_define_gsubr("dc-select", 0, 1, 0, scm_dc_select);
    scm_c_define_gsubr("dc-getresp", 0, 1, 0, scm_dc_getresp);
    scm_c_define_gsubr("dc-extract", 1, 0, 0, scm_dc_extract);
    scm_c_define_gsubr("dc-intresp", 1, 0, 0, scm_dc_intresp);
    scm_c_define_gsubr("dc-qcmd", 1, 1, 0, scm_dc_qcmd);
    scm_c_define_gsubr("dc-loginasync", 2, 1, 0, scm_dc_loginasync);
    scm_c_define_gsubr("dc-lexsexpr", 1, 0, 0, scm_dc_lexsexpr);
    scm_c_define_gsubr("dc-checkproto", 1, 1, 0, scm_dc_checkproto);
    scm_c_define("dc-latest", scm_from_int(DC_LATEST));
    resptype = scm_make_smob_type("dc-resp", sizeof(struct respsmob));
    scm_set_smob_free(resptype, resp_free);
    scm_set_smob_print(resptype, resp_print);
    dc_init();
}
Commit	Line	Data
3af4536f FT	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	*/
d3372da9	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;
dda84ebc	43	static scm_t_bits resptype;
d3372da9	44
12383d48	45	static SCM scm_dc_connect(SCM host)
d3372da9	46	{
12383d48	47	char *chost;
d3372da9	48
12383d48	49	if(fd >= 0)
12383d48	50	dc_disconnect();
0b8b2b53	51	if((host == SCM_UNDEFINED) \|\| (host == SCM_BOOL_F))
d3372da9	52	{
12383d48	53	chost = NULL;
d3372da9	54	} else {
91333cf2 FT	55	SCM_ASSERT(scm_is_string(host), host, SCM_ARG1, "dc-connect");
91333cf2 FT	56	chost = scm_to_locale_string(host);
d3372da9	57	}
91333cf2 FT	58	fd = dc_connect(chost);
	59	if(chost != NULL)
	60	free(chost);
	61	if(fd < 0)
d3372da9	62	scm_syserror("dc-connect");
91333cf2	63	return(scm_from_int(fd));
d3372da9	64	}
	65
	66	static SCM scm_dc_disconnect(void)
	67	{
	68	dc_disconnect();
91333cf2	69	return(scm_from_int(0));
d3372da9	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 {
91333cf2 FT	86	SCM_ASSERT(scm_is_integer(timeout), timeout, SCM_ARG1, "dc-select");
91333cf2 FT	87	cto = scm_to_int(timeout);
d3372da9	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
91333cf2	120	data = scm_gc_malloc(sizeof(*data), "respsmob");
d3372da9	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 {
91333cf2 FT	135	SCM_ASSERT(scm_is_integer(tag), tag, SCM_ARG1, "dc-getresp");
91333cf2 FT	136	if((resp = dc_gettaggedresp(scm_to_int(tag))) == NULL)
d3372da9	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);
91333cf2 FT	153	ret = scm_cons(scm_cons(scm_str2symbol("code"), scm_from_int(resp->code)), ret);
91333cf2 FT	154	ret = scm_cons(scm_cons(scm_str2symbol("tag"), scm_from_int(resp->tag)), ret);
d3372da9	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:
41f6ea31	187	ret = scm_cons(scm_from_int(ires->argv[i].val.num), ret);
d3372da9	188	break;
d3372da9	189	case 3:
41f6ea31 FT	190	ret = scm_cons(scm_from_double(ires->argv[i].val.flnum), ret);
	191	break;
	192	case 4:
84f2822d	193	ret = scm_cons(scm_from_int64(ires->argv[i].val.lnum), ret);
d3372da9	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
91333cf2 FT	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
d3372da9	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);
91333cf2	241	if((tok = scm_string_to_wcs(scm_get_output_string(port))) == NULL)
d3372da9	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	{
0931eb36	259	tag = dc_queuecmd(NULL, NULL, cmd, L"%a", toks, NULL);
d3372da9	260	} else {
91333cf2	261	scmcb = scm_malloc(sizeof(*scmcb));
d3372da9	262	scm_gc_protect_object(scmcb->subr = callback);
0931eb36	263	tag = dc_queuecmd(qcmd_scmcb, scmcb, cmd, L"%a", toks, NULL);
d3372da9	264	}
	265	dc_freewcsarr(toks);
	266	if(cmd != NULL)
	267	free(cmd);
fee53a96 FT	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	}
d3372da9	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;
91333cf2	314	char *un;
d3372da9	315
d3372da9	316	SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
91333cf2	317	scmcb = scm_malloc(sizeof(*scmcb));
d3372da9	318	scm_gc_protect_object(scmcb->subr = callback);
91333cf2 FT	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);
d3372da9	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
91333cf2 FT	334	SCM_ASSERT(scm_is_string(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
91333cf2 FT	335	if((buf = scm_string_to_wcs(sexpr)) == NULL)
d3372da9	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
9cbeb60c	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 {
91333cf2 FT	358	SCM_ASSERT(scm_is_integer(version), version, SCM_ARG2, "dc-checkproto");
91333cf2 FT	359	ver = scm_to_int(version);
9cbeb60c	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
d3372da9	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);
91333cf2 FT	373	scm_gc_free(data, sizeof(*data), "respsmob");
91333cf2 FT	374	return(0);
d3372da9	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);
91333cf2	383	scm_display(scm_from_int(data->resp->tag), port);
d3372da9	384	scm_puts(" ", port);
	385	scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
	386	scm_puts(" ", port);
91333cf2	387	scm_display(scm_from_int(data->resp->code), port);
d3372da9	388	scm_puts(">", port);
	389	return(1);
	390	}
	391
	392	void init_guiledc(void)
	393	{
12383d48	394	scm_c_define_gsubr("dc-connect", 0, 1, 0, scm_dc_connect);
d3372da9	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);
9cbeb60c	404	scm_c_define_gsubr("dc-checkproto", 1, 1, 0, scm_dc_checkproto);
91333cf2	405	scm_c_define("dc-latest", scm_from_int(DC_LATEST));
d3372da9	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	}