/**********************************************************************
 
	Copyright (C) 2003 Hirohisa MORI <joshua@nichibun.ac.jp>
 
	This program is free software; you can redistribute it 
	and/or modify it under the terms of the GLOBALBASE 
	Library General Public License (G-LGPL) as published by 

	http://www.globalbase.org/
 
	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.

**********************************************************************/


#include	"memory_debug.h"
#include	"xlerror.h"
#include	"xl.h"
#include	"utils.h"
#include	"lock_level.h"
#include	"version.h"
#include	"mlong_char.h"

#define CHECK_INTERVAL	10
#define INIT_AC	10


void session_tick();

typedef struct con_ind_agent {
	struct con_ind_agent * 	next;
	L_CHAR *		name;
} CON_IND_AGENT;

typedef struct con_prefix {
	struct con_prefix *	next;
	L_CHAR *		name;
	L_CHAR *		cmd;
} CON_PREFIX;

typedef struct con_agent_initial {
	struct con_agent_initial *	next;
	int				ses;
} CON_AGENT_INITIAL;

typedef struct con_agent {
	struct con_agent *	next;
	L_CHAR *		name;

	int			iid;
	int			timeout;
#define ATT_IDLE	(-4)
#define ATT_SET_AGENT	(-3)
#define ATT_RESET	(-2)
#define ATT_INITIAL	30
#define ATT_TIMEOUT	120
	struct con_server *	server;
	CON_PREFIX *		prefix;
	L_CHAR *		login_mode;
	int			lock;
	CON_AGENT_INITIAL *	initial_list;
} CON_AGENT;

typedef struct con_server {
	struct con_server *	next;
	CON_AGENT *		agent;
	URL			url;
	struct con_session *	session;
	int			ac;
	int			iid;
	int			direct_session_id;
} CON_SERVER;


#define LOCK_SET(s)	\
	{(s)->lock_file = __FILE__;(s)->lock_line=__LINE__; \
	(s)->lock_task = get_tid();}

typedef struct con_session {
	struct con_session *	next;
	int			type;
	int			id;
	L_CHAR *		login_mode;
	L_CHAR *		working_path;
	CON_SERVER *		server;
	struct con_session *	sl_next;
	int			lock;
	char * 			lock_file;
	int			lock_line;
	int			lock_task;

	int			flags;
#define CSF_CLOSE		0x00000001
#define CSF_PROXY_INIT		0x00000002
	int			access_cnt;

	XL_SEXP *		(*pre_func)();
	XL_SEXP *		(*pre_proxy)();
	void			(*pre_gc)();
	void			(*pre_free)();
	void *			pre_work;
} CON_SESSION;

typedef struct nproxy_direct_server {
	struct nproxy_direct_server *	next;
	L_CHAR *			server;
} NPROXY_DIRECT_SERVER;

void gc_gb_sexp();


int session_id;

SEM session_lock;
CON_SERVER * server_list;
CON_SESSION *session_list;
CON_IND_AGENT *	ind_agent_list;

char * setagent_msg;
int native_proxy_session;
URL native_proxy_url;
NPROXY_DIRECT_SERVER *	np_server_list;


void agent_timeout_task();

void
init_session()
{
	session_lock = new_lock(LL_SESSION);
	new_tick(session_tick,CHECK_INTERVAL,0);
	create_task(agent_timeout_task,0,0);
}

void
set_setagent_msg(char * buf)
{
	setagent_msg = copy_str(buf);
	strcpy(setagent_msg,buf);
}



void
call_timeout(int iid)
{
XL_SEXP * ret;
CON_AGENT * aa;
CON_SERVER * s;
int timeout;
	ret = remote_query(iid,0,
		l_string(std_cm,"(GetXLIinfo 0)\n"),
		0);
	if ( get_type(ret) == XLT_ERROR ) {
		timeout = ATT_TIMEOUT;
		goto end;
	}
	ret = get_el_by_symbol(
		ret,
		l_string(std_cm,"connection-timeout"),
		0);
	ret = get_el(ret,1);
	if ( get_type(ret) != XLT_INTEGER ) {
		timeout = ATT_TIMEOUT;
		goto end;
	}
	if ( ret->integer.data < 0 )
		timeout = -1;
	else 	timeout = ret->integer.data * 3;
end:
	lock_task(session_lock);
	set_c_timeout(iid,timeout);
	for ( s = server_list ; s ; s = s->next )
		for ( aa = s->agent ; aa ; aa = aa->next ) {
			if ( aa->iid != iid )
				continue;
			if ( aa->timeout != ATT_RESET )
				continue;
			aa->timeout = timeout;
			goto end2;
		}
end2:
	unlock_task(session_lock,"call_timeout");
}

void
agent_timeout_task()
{
CON_SERVER * s;
CON_AGENT * a;
int f;
XL_INTERPRETER * xli;
int iid;

	xli = new_xl_interpreter();
	xli->a_type = XLA_SELF;
	setup_i(xli);

	for ( ; ; ) {
	retry:
		lock_task(session_lock);
		for ( s = server_list ; s ; s = s->next )
			for ( a = s->agent ; a ; a = a->next ) {
				if ( a->iid <= 0 )
					continue;
				if ( a->timeout != ATT_RESET )
					continue;
				iid = a->iid;
				unlock_task(session_lock,"agent_to");

				gc_push(0,0,"agent_timeout_task");
				call_timeout(iid);
				gc_pop(0,0);

				goto retry;
			}
		sleep_task((int)agent_timeout_task,session_lock);
	}
}




CON_PREFIX *
_search_con_prefix(CON_AGENT * a,L_CHAR * pref,L_CHAR * cmd)
{
CON_PREFIX * pf;
	for ( pf = a->prefix ; pf ; pf = pf->next )
		if ( l_strcmp(pf->name,pref) == 0 &&
				l_strcmp(pf->cmd,cmd) == 0 )
			return pf;
	return 0;
}

CON_PREFIX *
_new_con_prefix(CON_AGENT * a,L_CHAR * pref,L_CHAR * cmd)
{
CON_PREFIX * pf;
	pf = _search_con_prefix(a,pref,cmd);
	if ( pf )
		return pf;
	pf = d_alloc(sizeof(*pf));
	pf->name = ll_copy_str(pref);
	pf->cmd = ll_copy_str(cmd);

	pf->next = a->prefix;
	a->prefix = pf;
	return pf;
}

void
_free_con_prefix(CON_PREFIX * pf)
{
CON_PREFIX * pf1;
	for ( ; pf ; ) {
		pf1 = pf->next;
		d_f_ree(pf->cmd);
		d_f_ree(pf->name);
		d_f_ree(pf);
		pf = pf1;
	}
}


CON_AGENT_INITIAL *
_search_con_agent_initial(CON_AGENT * a,int ses)
{
CON_AGENT_INITIAL * ai;
	for ( ai = a->initial_list ; ai ; ai = ai->next )
		if ( ai->ses == ses )
			return ai;
	return 0; 
}

void
_insert_con_agent_initial(CON_AGENT * a,int ses)
{
CON_AGENT_INITIAL * ai;
	ai = d_alloc(sizeof(*ai));
	ai->ses = ses;
	ai->next = a->initial_list;
	a->initial_list = ai;
}

void
_free_con_agent_initial(CON_AGENT_INITIAL * ai)
{
CON_AGENT_INITIAL * ai2;
	for ( ; ai ; ) {
		ai2 = ai;
		ai = ai->next;
		d_f_ree(ai2);
	}
}


void
_free_con_agent_initial_one(CON_AGENT * a,int ses)
{
CON_AGENT_INITIAL * ai, ** aip;
	for ( aip = &a->initial_list ; *aip ; aip = &(*aip)->next ) {
		ai = *aip;
		if ( ai->ses != ses )
			continue;
		*aip = ai->next;
		d_f_ree(ai);
		return;
	}
}


CON_AGENT *
_search_con_agent(CON_SERVER * server,L_CHAR * name)
{
CON_AGENT * a;
CON_IND_AGENT * ia;
int sid;
	for ( a = server->agent; a; a = a->next )
		if ( l_strcmp(a->name,name) == 0 )
			return a;
	return 0;
}

CON_AGENT *
_search_con_agent_idle(CON_SERVER * sv)
{
CON_AGENT * a;
	for ( a = sv->agent; a ; a = a->next ) {
		if ( a->iid == 0 )
			continue;
		if ( a->lock )
			continue;
		return a;
	}
	return 0;
}


CON_AGENT *
_search_con_agent_by_prefix(CON_SERVER * server,L_CHAR * pref,L_CHAR * cmd)
{
CON_AGENT * a;
	for ( a = server->agent; a ; a = a->next ) {
		if ( _search_con_prefix(a,pref,cmd) )
			return a;
	}
	return a;
}

void
_write_lock_agent(CON_AGENT * a)
{
	for ( ; a->lock ; ) {
		sleep_task((int)a,session_lock);
		lock_task(session_lock);
	}
	a->lock = -1;
}

void
write_lock_agent(CON_AGENT * a)
{
	lock_task(session_lock);
	_write_lock_agent(a);
	unlock_task(session_lock,"write_lock_agent");
}

void
_write_unlock_agent(CON_AGENT * a)
{
	if ( a->lock >= 0 )
		er_panic("_write_unlock_agent");
	a->lock = 0;
	wakeup_task((int)a);
}

void
write_unlock_agent(CON_AGENT * a)
{
	lock_task(session_lock);
	_write_unlock_agent(a);
	unlock_task(session_lock,"write_unlock_agent");
}

void
_read_lock_agent(CON_AGENT * a)
{

	for ( ; a->lock < 0 ; ) {
		sleep_task((int)a,session_lock);
		lock_task(session_lock);
	}
	a->lock ++;
}

void
read_lock_agent(CON_AGENT * a)
{
	lock_task(session_lock);
	_read_lock_agent(a);
	unlock_task(session_lock,"read_lock_agent");
}


void
_read_unlock_agent(CON_AGENT * a)
{
	if ( a->lock <= 0 )
		er_panic("_read_unlock_agent");
	a->lock --;
	if ( a->lock == 0 )
		wakeup_task((int)a);
}

void
read_unlock_agent(CON_AGENT * a)
{
	lock_task(session_lock);
	_read_unlock_agent(a);
	unlock_task(session_lock,"read_unlock_agent");
}



CON_AGENT *
_new_con_agent(CON_SERVER * server,L_CHAR * name,int iid)
{
CON_AGENT * a;
CON_IND_AGENT * ia;
	a = _search_con_agent(server,name);
	if ( a )
		return a;
	a = d_alloc(sizeof(*a));
	a->lock = 0;
	a->name = ll_copy_str(name);
	a->iid = iid;
	a->server = server;
	a->prefix = 0;
	a->login_mode = 0;
	a->initial_list = 0;
	a->next = server->agent;
	a->timeout = ATT_IDLE;
	server->agent = a;
	return a;
}

void
_free_con_agent(CON_AGENT * a)
{
	_free_con_prefix(a->prefix);
	d_f_ree(a->name);
	_free_con_agent_initial(a->initial_list);
	d_f_ree(a);
}

CON_SERVER *
_search_con_server(URL * u,CON_SESSION * ses)
{
CON_SERVER * s;
	switch ( ses->type ) {
	case SEST_OPTIMIZE:
		for ( s = server_list ; s ; s = s->next )
			if ( l_strcmp(u->proto,s->url.proto) == 0 &&
				l_strcmp(u->server,s->url.server) == 0 &&
				u->port == s->url.port &&
				s->direct_session_id == 0 )
				return s;
		break;
	case SEST_DIRECT:
		for ( s = server_list ; s ; s = s->next )
			if ( l_strcmp(u->proto,s->url.proto) == 0 &&
				l_strcmp(u->server,s->url.server) == 0 &&
				u->port == s->url.port &&
				ses->id == s->direct_session_id )
				return s;
		break;
	default:
		er_panic("_search_con_server(1)");
	}
	return 0;
}

CON_SERVER *
_new_con_server(URL * u,CON_SESSION * ses)
{
CON_SERVER * s;
	s = _search_con_server(u,ses);
	if ( s )
		return s;
	s = d_alloc(sizeof(*s));
	copy_url(&s->url,u);
	s->iid = 0;
	s->agent = 0;
	s->next = server_list;
	s->session = 0;
	s->ac = INIT_AC;
	if ( ses->type == SEST_OPTIMIZE )
		s->direct_session_id = 0;
	else	s->direct_session_id = ses->id;
	server_list = s;
	return s;
}

void
_free_con_server(CON_SERVER * s)
{
CON_AGENT * a,* a1;
	free_url(&s->url);
	for ( a = s->agent ; a ; ) {
		a1 = a->next;
		_free_con_agent(a);
		a = a1;
	}
	if ( s->iid )
		close_interpreter(s->iid);
	d_f_ree(s);
}

CON_SESSION *
_search_con_session(int id)
{
CON_SESSION * s;
	for ( s = session_list ; s ; s = s->next )
		if ( s->id == id )
			return s;
	return 0;
}

CON_SESSION *
_new_con_session(int type)
{
CON_SESSION * s;
	for ( ; ; ) {
		if ( session_id <= 0 )
			session_id = 1;
		s = _search_con_session(session_id);
		if ( s == 0 )
			break;
		session_id ++;
	}
	s = d_alloc(sizeof(*s));
	s->access_cnt = 0;
	s->flags = 0;
	s->id = session_id;
	s->server = 0;
	s->login_mode = nl_copy_str(std_cm,"user");
	s->working_path = 0;
	s->lock = 0;
	s->sl_next = 0;
	s->type = type;
	s->pre_func = 0;
	s->pre_proxy = 0;
	s->pre_gc = 0;
	s->pre_free = 0;
	s->pre_work = 0;
	session_id ++;
	if ( session_id <= 0 )
		session_id = 1;
	s->next = session_list;
	session_list = s;
	return s;
}

void
_free_con_session(CON_SESSION * s)
{
	if ( s->working_path )
		d_f_ree(s->working_path);
	if ( s->login_mode )
		d_f_ree(s->login_mode);
	d_f_ree(s);
}



void
_connection_check()
{
CON_SERVER * sv, ** svp;
CON_SESSION  * ses;
int cnt_ses,cnt_sv,cnt;
CON_SERVER * sv_min;
	for ( cnt_ses = 0 , ses = session_list ; ses ; ses = ses->next )
		cnt_ses ++;
	for ( cnt_sv = 0 , sv = server_list ; sv ; sv = sv->next )
		cnt_sv ++;
	if ( cnt_sv <= cnt_ses*2 )
		return;
	cnt = cnt_sv-cnt_ses*2;
	for ( ; cnt ; cnt -- ) {
		sv_min = 0;
		for ( sv = server_list ; sv ; sv = sv->next ) {
			if ( sv->session )
				continue;
			if ( sv_min == 0 || sv_min->ac > sv->ac )
				sv_min = sv;
		}
		for ( svp = &server_list ; *svp ; svp = &(*svp)->next )
			if ( *svp == sv_min ) {
				*svp = sv_min->next;
				_free_con_server(sv_min);
				break;
			}
	}
	for ( sv = server_list ; sv ; sv = sv->next )
		sv->ac = sv->ac*2/3;
}

void
_detouch_server(CON_SESSION * ses)
{
CON_SESSION ** sp;
	for ( sp = &ses->server->session; *sp ; sp = &(*sp)->sl_next )
		if ( *sp == ses ) {
			*sp = ses->sl_next;
			ses->server = 0;
			ses->sl_next = 0;
			return;
		}
	ses->server = 0;
	ses->sl_next = 0;
}

void
_atouch_server(CON_SESSION * ses,CON_SERVER * sv)
{
	if ( ses->server == sv )
		return;
	if ( ses->server )
		_detouch_server(ses);
	ses->server = sv;
	ses->sl_next = sv->session;
	sv->session = ses;
	sv->ac ++;
}

void
_free_session_lock(CON_SESSION * ses)
{
CON_AGENT * a;
	ses->lock = 0;
	wakeup_task((int)ses);
}



int
_set_pre_func(
	CON_SESSION * ses,
	XL_SEXP * (*pre_func)(),
	XL_SEXP * (*pre_proxy)(),
	void (*pre_gc)(),
	void (*pre_free)(),
	void * pre_work)
{
CON_AGENT * a;
CON_SERVER * s;
	if ( ses->pre_free )
		(*ses->pre_free)(ses->pre_work);
	ses->pre_func = pre_func;
	ses->pre_proxy = pre_proxy;
	ses->pre_gc = pre_gc;
	ses->pre_work = pre_work;
	for ( s = server_list ; s ; s = s->next )
		for ( a = s->agent ; a ; a = a->next )
			_free_con_agent_initial_one(a,ses->id);
	ses->flags &= ~CSF_PROXY_INIT;
	return 0;
}

int
open_session(int type)
{
CON_SESSION * ret;
	lock_task(session_lock);
	ret = _new_con_session(type);
	unlock_task(session_lock,"open_session");
	return ret->id;
}


void
_close_session(int id)
{
CON_SESSION ** sp, * s;

	for ( sp = &session_list ; *sp ; sp = &(*sp)->next ) {
		if ( (*sp)->id != id )
			continue;
		s = *sp;
		if ( s->access_cnt ) {
			s->flags |= CSF_CLOSE;
			return;
		}
		for ( ; s->lock ; ) {
			sleep_task((int)s,session_lock);
			lock_task(session_lock);
		}
		s->lock = 1;
		LOCK_SET(s);

		if ( s->pre_free )
			(*s->pre_free)(s->pre_work);

		if ( s->server )
			_detouch_server(s);
		*sp = s->next;
		_free_con_session(s);
		break;
	}
}

void
close_session(int id)
{
	lock_task(session_lock);
	_close_session(id);
	unlock_task(session_lock,"close_session");
}


typedef struct init_sexp_work {
	XL_SEXP *		query;
	XLISP_ENV *		env;
} INIT_SEXP_WORK;

XL_SEXP *
init_sexp_func(
	CON_SESSION * ses,
	CON_AGENT * a,
	int proxy_ses)
{
XL_SEXP * q;
INIT_SEXP_WORK * w;
	w = (INIT_SEXP_WORK*)ses->pre_work;
	return w->query;
}

XL_SEXP *
init_sexp_proxy(CON_SESSION * ses)
{
INIT_SEXP_WORK * w;
	w = (INIT_SEXP_WORK*)ses->pre_work;
	if ( w == 0 )
		return 0;
	return List(
		n_get_symbol("SetSessionEnv"),
		List(n_get_symbol("quote"),
			w->query,
			-1),
		-1);
}


void
init_sexp_free(
	INIT_SEXP_WORK * w)
{
	d_f_ree(w);
}

void
init_sexp_gc(
	INIT_SEXP_WORK * w)
{
	gc_gb_sexp(w->query);
	gc_gblisp_env(w->env);
}

int
_set_initial_sexp(int id,XLISP_ENV * env,XL_SEXP * s)
{
CON_SESSION * ses;
INIT_SEXP_WORK * w;
	ses = _search_con_session(id);
	if ( ses == 0 )
		return -1;
	if ( s ) {
		w = d_alloc(sizeof(*w));
		w->env = env;
		w->query = s;
		_set_pre_func(
			ses,
			init_sexp_func,
			init_sexp_proxy,
			init_sexp_gc,
			init_sexp_free,
			w);
	}
	else {
		_set_pre_func(ses,0,0,0,0,0);
	}
	return 0;
}

int
set_initial_sexp(int id,XLISP_ENV * env,XL_SEXP * s)
{
int ret;
	lock_task(session_lock);
	ret = _set_initial_sexp(id,env,s);
	unlock_task(session_lock,"set_initial_sexp");
	return ret;
}




int
connect_server(XLISP_ENV * env,URL * u)
{
XL_INTERPRETER * xli;
int ret;

int retry_cnt;



set_cpu_msg(971);
	retry_cnt = 3;

retry:

	xli = new_xl_interpreter();
	xli->a_type = XLA_CONNECT;
	xli->env = env;
	xli->port = u->port;
	xli->environment = 1;
	xli->hostname = ll_copy_str(u->server);
	xli->connection_timeout = ATT_INITIAL;


set_cpu_msg(972);

	ret = setup_i(xli);
set_cpu_msg(973);

	if ( ret < 0 ) {
		switch ( ret ) {
		case XLIE_CANNOT_OPEN_DENIED:
		case XLIE_CANNOT_OPEN_BUSY:
			return ret;
		default:
			break;
		}
		retry_cnt --;
		if ( retry_cnt > 0 ) {
			sleep_sec(2);
			goto retry;
		}
	}
	return ret;
}


XL_SEXP *
connect_agent(
	XLISP_ENV * env,CON_AGENT * a,L_CHAR * login_mode,
		XL_FILE * f,int ln)
{
XL_SEXP * ret;
int iid;
int retry_cnt;
XL_SEXP * sa;



	lock_task(session_lock);

	if ( a->iid ) {
		if ( check_iid(a->iid) ) {
/*
printf("ret A %i %i\n",get_tid(),a->iid);
*/
			unlock_task(session_lock,"connect_agent");
			return 0;
		}
	}

	unlock_task(session_lock,"connect_agent");

	write_lock_agent(a);

	lock_task(session_lock);
	if ( a->iid ) {
		if ( check_iid(a->iid) ) {
			unlock_task(session_lock,"connect_agent");

			write_unlock_agent(a);
/*
printf("ret B %i %i\n",get_tid(),a->iid);
*/
			return 0;
		}
	}


	iid = a->server->iid;
	a->server->iid = 0;
	if ( iid && check_iid(iid) == 0 )
		iid = 0;


	unlock_task(session_lock,"connect_agent");



	retry_cnt = 1;
retry:

	a->timeout = ATT_SET_AGENT;
	if ( iid )
		a->iid = iid;
	else  	a->iid = connect_server(env,&a->server->url);

	if ( a->iid <= 0 ) {
/*
printf("ret C %i\n",get_tid());
*/
		ret = get_error(
			f,
			ln,
			XLE_PROTO_ACCESS_STREAM,
			l_string(std_cm,"RemoteSession"),
			List(n_get_string("cannot access the server"),
				get_string(get_url_str2(
				&a->server->url)),
				get_integer(a->iid,0),
				-1));
		a->iid = 0;
		goto end;
	}

	sa = n_get_symbol("SetAgent");
	if ( setagent_msg[0] )
		set_attribute(sa,
			l_string(std_cm,"client"),
			l_string(std_cm,setagent_msg));



	lock_xli_out_iid(a->iid);

	ret = remote_query(a->iid,env,0,
		List(sa,
			get_string(a->name),
			get_string(login_mode),
			-1));


	if ( get_type(ret) == XLT_ERROR ) {
		unlock_xli_out_iid(a->iid);

		switch ( ret->err.code ) {
		case XLE_PROTO_ACCESS_STREAM:
		case XLE_PROTO_INV_IID:
			retry_cnt --;
			iid = 0;
			a->iid = 0;
			if ( retry_cnt < 0 )
				goto end;
			goto retry;
		}
		close_interpreter(a->iid);
		a->iid = 0;
		goto end;
	}
	xli_page_feed(a->iid);
	unlock_xli_out_iid(a->iid);
	set_c_timeout(a->iid,ATT_TIMEOUT);

	lock_task(session_lock);
	_free_con_agent_initial(a->initial_list);
	a->initial_list = 0;
	unlock_task(session_lock,"connect_agent");

	send_code_sync(a->iid);

	ret = 0;
	iid = 0;

end:
	write_unlock_agent(a);

	lock_task(session_lock);
	a->timeout = ATT_RESET;
	wakeup_task((int)agent_timeout_task);
	a->server->iid = iid;

	unlock_task(session_lock,"connect_agent");
/*
printf("ret E %i %i\n",get_tid(),a->iid);
*/
	return ret;
}


int
get_prefix_mode(CON_SERVER * sv,int iid,XLISP_ENV * env,L_CHAR * pref)
{
XL_SEXP * ret, *r;
XL_SEXP * s_pref,* s_agent,* s_cmd,* s_1cmd;
CON_AGENT * a;


	ret = remote_query(iid,env,0,
		List(	get_symbol(l_string(std_cm,
				"GetPrefixMode")),
			get_string(pref),
			-1));

	if ( get_type(ret) == XLT_ERROR )
		return -1;
	for ( ; get_type(ret) ; ret = cdr(ret) ) {

		if ( get_type(ret) != XLT_PAIR )
			break;
		r = car(ret);
		if ( get_type(r) != XLT_PAIR )
			continue;
		s_pref = get_el(r,0);
		s_agent = get_el(r,1);
		s_cmd = get_el(r,4);
		if ( get_type(s_pref) != XLT_STRING )
			continue;
		if ( get_type(s_agent) != XLT_STRING )
			continue;
		for ( ; get_type(s_cmd) ; s_cmd = cdr(s_cmd) ) {
			if ( get_type(s_cmd) != XLT_PAIR )
				break;
			s_1cmd = car(s_cmd);
			if ( get_type(s_1cmd) != XLT_STRING )
				continue;
			a = _new_con_agent(sv,s_agent->string.data,0);
			_new_con_prefix(a,
				s_pref->string.data,
				s_1cmd->string.data);
		}
	}
	return 0;
}

CON_AGENT *
get_agent(
	XL_SEXP ** retp,
	XLISP_ENV * env,
	CON_SERVER * sv,
	URL * u,
	L_CHAR * cmd,
	L_CHAR * login_mode)
{
int p;
CON_AGENT * a;
int iid;
int retry_cnt;
XL_SEXP * ret;
int _ret;

	*retp = 0;
	retry_cnt = 0;
	for ( p = l_strlen(u->resource)-1 ; p >= 0 ; p -- )
		if ( u->resource[p] == '.' )
			goto next;
	*retp = get_error(
		0,
		0,
		XLE_PROTO_OPEN_FILE,
		l_string(std_cm,"RemoteSession"),
		List(n_get_string(
		"GET AGENT: invalid prefix (there is no prifix) "),
			get_string(get_url_str2(u)),
			-1)
			);
	return 0;
next:
	lock_task(session_lock);

	a = _search_con_agent_by_prefix(sv,&u->resource[p],cmd);
	if ( a ) {
		unlock_task(session_lock,"get_agent");
		return a;
	}
	if ( sv->iid ) {
		iid = sv->iid;
		sv->iid = 0;
		if ( check_iid(iid) ) {
			unlock_task(session_lock,"get_agent");
			goto access_sv;
		}
	}
	a = _search_con_agent_idle(sv);
	unlock_task(session_lock,"get_agent");
	if ( a ) {
		read_lock_agent(a);
		if ( check_iid(a->iid) == 0 ) {
			a->iid = 0;
			read_unlock_agent(a);
			goto connect_sv;
		}

		_ret = get_prefix_mode(sv,a->iid,env,&u->resource[p]);
		read_unlock_agent(a);
		if ( _ret < 0 )
			goto connect_sv;
		if ( retry_cnt == 0 ) {
			retry_cnt = 1;
			goto next;
		}
		/* goto connect_sv */
	}
connect_sv:
	iid = connect_server(env,u);
	if ( iid < 0 ) {
		*retp = get_error(
			0,
			0,
			XLE_PROTO_OPEN_FILE,
			l_string(std_cm,"RemoteSession"),
			List(n_get_string(
				"GET AGENT: cannot connect the server"),
				get_string(get_url_str2(u)),
				get_integer(iid,0),
				-1)
				);
		return 0;
	}
access_sv:

	_ret = get_prefix_mode(sv,iid,env,&u->resource[p]);
	if ( _ret < 0 )
		return 0;
	lock_task(session_lock);
	sv->iid = iid;
	a = _search_con_agent_by_prefix(sv,&u->resource[p],cmd);
	if ( a == 0 ) {
		unlock_task(session_lock,"get_agent");
		*retp = get_error(
			0,
			0,
			XLE_PROTO_OPEN_FILE,
			l_string(std_cm,"RemoteSession"),
			List(n_get_string(
				"GET AGENT: invalid prefix"),
				get_string(get_url_str2(u)),
				-1)
				);
		return 0;
	}
	unlock_task(session_lock,"get_agent");
	return a;
}


XL_SEXP *
remote_session_delay(XL_SEXP *);

XL_SEXP *
_remote_session(
	XLISP_ENV * env,
	int id,
	URL * u,
	L_CHAR * a_agent,
	L_CHAR * a_login_mode,
	L_CHAR * a_center_cmd,
	XL_SEXP * cmd,
	XL_FILE * f,
	int ln,
	int session_lock_enable,
	int ignore_close_flag,
	int proxy_ses)
{
CON_SESSION * ses;
CON_SERVER * sv;
CON_AGENT * a;
XL_SEXP * r,* ret;
int retry_cnt;
L_CHAR * path;
XL_SEXP * _cmd;
L_CHAR * agent,* login_mode, * center_cmd;
XL_SEXP * pre_data;

	if ( a_agent )
		agent = ll_copy_str(a_agent);
	else	agent = 0;
	if ( a_login_mode )
		login_mode = ll_copy_str(a_login_mode);
	else	login_mode = 0;
	if ( a_center_cmd )
		center_cmd = ll_copy_str(a_center_cmd);
	else	center_cmd = 0;

	lock_task(session_lock);

	ses = _search_con_session(id);
	if ( ses == 0 ) {
		unlock_task(session_lock,"remote_session");
		ret = get_error(
			f,
			ln,
			XLE_PROTO_INV_PARAM,
			l_string(std_cm,"RemoteSession"),
			List(n_get_string("invalid session id"),
				get_integer(id,0),
				-1));
		goto err;
	}
	if ( ignore_close_flag == 0 && ses->flags & CSF_CLOSE ) {
		unlock_task(session_lock,"remote_session");
		ret = get_error(
			f,
			ln,
			XLE_PROTO_INV_PARAM,
			l_string(std_cm,"RemoteSession"),
			n_get_string("invalid session id (closed)"));
		goto err;
	} 

	for ( ; ses->lock ; ) {
		sleep_task((int)ses,session_lock);
		lock_task(session_lock);
	}
	ses->lock = 1;
	LOCK_SET(ses);
	if ( login_mode ) {
		if ( ses->login_mode )
			d_f_ree(ses->login_mode);
		ses->login_mode = ll_copy_str(login_mode);
	}
	if ( ses->server ) {
		sv = ses->server;
		if ( u->proto == 0 )
			u->proto = ll_copy_str(sv->url.proto);
		if ( u->server == 0 )
			u->server = ll_copy_str(sv->url.server);
		if ( u->port == 0 )
			u->port = sv->url.port;
	}
	else {
		if ( u->proto == 0 || u->server == 0 || 
				u->port == 0 ) {
			unlock_task(session_lock,"remote_session");
			ret = get_error(
				f,
				ln,
				XLE_PROTO_INV_PARAM,
				l_string(std_cm,"RemoteSession"),
				List(n_get_string("invalid URL path 1"),
					get_string(get_url_str2(u)),
					-1));
			goto err;
		}
	}


	sv = _new_con_server(u,ses);

	if ( sv != ses->server ) {
		if ( u->db == 0 || u->db[0] != '/' ) {
			unlock_task(session_lock,"remote_session");
			ret = get_error(
				f,
				ln,
				XLE_PROTO_INV_PARAM,
				l_string(std_cm,"RemoteSession"),
				n_get_string("invalid URL path 2"));
			goto err;
		}
		if ( ses->working_path )
			d_f_ree(ses->working_path);
		ses->working_path = ll_copy_str(u->db);
	}
	else if ( u->server || u->db || u->resource ) {
		path = compose_path(ses->working_path,u->db);
		if ( path == 0 ) {
			ret = get_error(
				f,
				ln,
				XLE_PROTO_INV_PARAM,
				l_string(std_cm,"RemoteSession"),
				n_get_string("invalid URL path 3"));
			goto err;
		}
		if ( ses->working_path )
			d_f_ree(ses->working_path);
		ses->working_path = path;
	}


	_atouch_server(ses,sv);

	if ( agent ) {
		a = _new_con_agent(sv,agent,0);
		if ( a == 0 ) {
			unlock_task(session_lock,"remote_session");
			ret = get_error(
				f,
				ln,
				XLE_PROTO_UNDEF_NAME,
				l_string(std_cm,"RemoteSession"),
				n_get_string("undefined agent"));
			goto err;
		}
	}
	unlock_task(session_lock,"remote_session");


	if ( agent == 0 ) {
		a = get_agent(&ret,env,sv,u,center_cmd,ses->login_mode);
		if ( a == 0 ) {
			if ( ret == 0 )
				ret = get_error(
					f,
					ln,
					XLE_PROTO_UNDEF_NAME,
					l_string(std_cm,"RemoteSession"),
					n_get_string(
					"undefined agent or invalid prefix"));
			goto err;
		}
	}


	set_env(env,l_string(std_cm,"SessionPath"),
		get_string(ses->working_path));
	if ( u->resource )
		set_env(env,l_string(std_cm,"SessionResource"),
			get_string(u->resource));
	else
	set_env(env,l_string(std_cm,"SessionResource"),
			n_get_string(""));

	retry_cnt = 3;

retry:
	ret = connect_agent(env,a,ses->login_mode,f,ln);


	if ( get_type(ret) == XLT_ERROR )
		goto err1;

	read_lock_agent(a);

	pre_data = 0;
	lock_task(session_lock);
	if ( _search_con_agent_initial(a,ses->id) == 0 ) {
		unlock_task(session_lock,"_remote_session");

		if ( ses->pre_func )
			pre_data = (*ses->pre_func)(ses,a,proxy_ses);
		if ( get_type(pre_data) == XLT_ERROR )
			pre_data = 0;

		lock_task(session_lock);
		_insert_con_agent_initial(a,ses->id);
	}
	unlock_task(session_lock,"_remote_session");

	read_unlock_agent(a);

	_cmd = append(pre_data,cmd);

	for ( ; get_type(_cmd) == XLT_PAIR ; _cmd = cdr(_cmd) ) {

		r = car(_cmd);
		if ( get_type(r) == XLT_ERROR ) {
			ret = r;
			goto err1;
		}

		read_lock_agent(a);


		ret = remote_query(a->iid,env,0,r);

		if ( get_type(cdr(_cmd)) != XLT_PAIR &&
				ret && ret->h.type == XLT_DELAY ) {
		XL_RESULT * resp;
		int check_remote_session_delay();
			lock_mem();
			resp = (XL_RESULT*)ret->delay.d.func;
			resp->s_env = env;
			resp->s_id = id;
			mcopy_url(&resp->s_url,u);
			if ( agent )
				resp->s_agent = ll_copy_mstr(agent);
			else	resp->s_agent = 0;
			if ( login_mode )
				resp->s_login_mode
					= ll_copy_mstr(login_mode);
			else	resp->s_login_mode = 0;
			if ( center_cmd )
				resp->s_center_cmd
					= ll_copy_mstr(center_cmd);
			else	resp->s_center_cmd = 0;
			resp->s_cmd = _cmd;
			resp->s_file = f;
			resp->s_line = ln;
			resp->s_session = ses;
			resp->s_proxy_ses = proxy_ses;
			resp->h.func = remote_session_delay;
			resp->h.check_func = check_remote_session_delay;
			unlock_mem();
			read_unlock_agent(a);
			lock_task(session_lock);
			ses->access_cnt ++;
			unlock_task(session_lock,"remote_session");
			goto err1;
		}
		if ( get_type(ret) == XLT_ERROR ) {
			switch ( ret->err.code ) {
			case XLE_PROTO_ACCESS_STREAM:
			case XLE_PROTO_INV_IID:
/*
printf("**** ACCESS RETRY %i %i\n",get_tid(),a->iid);
fflush(stdout);
print_sexp(s_stdout,ret,0);
printf("\n");
*/
				retry_cnt --;
				a->iid = 0;
				if ( retry_cnt < 0 ) {
					read_unlock_agent(a);
/*
printf("ERR1(%i)\n",get_tid());
*/
					goto err1;
				}
				read_unlock_agent(a);
				goto retry;
			}
			read_unlock_agent(a);
/*
printf("ERR2(%i)\n",get_tid());
*/
			goto err1;
		}

		read_unlock_agent(a);

	}


err1:

	lock_task(session_lock);
	goto err2;

err:
	lock_task(session_lock);
err2:
	if ( ses )
		_free_session_lock(ses);
	unlock_task(session_lock,"close_session");

	if ( agent )
		d_f_ree(agent);
	if ( login_mode )
		d_f_ree(login_mode);
	if ( center_cmd )
		d_f_ree(center_cmd);
	if ( session_lock_enable )
		get_type(ret);
	return ret;
}


XL_SEXP *
setup_session_proxy(int id,XL_FILE * f,int ln)
{
CON_SESSION * ses;
XL_SEXP * ret;
XL_SEXP * send_query,* sq;
char buf[20];
XL_SEXP * open_session;
	lock_task(session_lock);
	ses = _search_con_session(id);
	if ( ses == 0 ) {
		ret = get_error(
			f,
			ln,
			XLE_PROTO_INV_PARAM,
			l_string(std_cm,"RemoteSession"),
			List(n_get_string("invalid session id"),
				get_integer(id,0),
				-1));
		goto end;
	}
	if ( ses->flags & CSF_PROXY_INIT ) {
		ret = 0;
		goto end;
	}
	ses->flags |= CSF_PROXY_INIT;
	if ( ses->pre_proxy )
		sq = (*ses->pre_proxy)(ses);
	else	sq = 0;
	unlock_task(session_lock,"setup_session_proxy");

	open_session = n_get_symbol("OpenSession");
	set_attribute(open_session,
		l_string(std_cm,"type"),
		l_string(std_cm,"optimize"));
	sprintf(buf,"rs%i",id);
	send_query = List(
		List(n_get_symbol("Define"),
			n_get_symbol(buf),
			List(open_session,
				-1),
			-1),
		sq,
		-1);

	return send_query;
end:
	unlock_task(session_lock,"setup_session_proxy");
	return ret;
}


NPROXY_DIRECT_SERVER *
_search_direct_server(L_CHAR * server)
{
NPROXY_DIRECT_SERVER * ret;
	for ( ret = np_server_list ; ret ; ret = ret->next ) {
		if ( l_strcmp(server,ret->server) == 0 )
			return ret;
	}
	return 0;
}


NPROXY_DIRECT_SERVER *
search_direct_server(L_CHAR * server)
{
NPROXY_DIRECT_SERVER * ret;
	lock_task(session_lock);
	ret = _search_direct_server(server);
	unlock_task(session_lock,"search_direct_server");
	return ret;
}


XL_SEXP *
remote_session(
	XLISP_ENV * env,
	int id,
	URL * u,
	L_CHAR * _a_agent,
	L_CHAR * _a_login_mode,
	L_CHAR * _a_center_cmd,
	XL_SEXP * cmd,
	XL_FILE * f,
	int ln,
	int session_lock_enable)
{
NPROXY_DIRECT_SERVER * is;
XL_SEXP * send_query, * ret;
char buf[20];
L_CHAR * a_agent,* a_login_mode,* a_center_cmd;
	if ( _a_agent )
		a_agent = ll_copy_str(_a_agent);
	else	a_agent = 0;
	if ( _a_login_mode )
		a_login_mode = ll_copy_str(_a_login_mode);
	else	a_login_mode = 0;
	if ( _a_center_cmd )
		a_center_cmd = ll_copy_str(_a_center_cmd);
	else	a_center_cmd = 0;
	if ( native_proxy_session == 0 ) {
		ret = _remote_session(
				env,
				id,
				u,
				a_agent,
				a_login_mode,
				a_center_cmd,
				cmd,
				f,
				ln,
				session_lock_enable,
				0,0);
		goto end;
	}
	is = search_direct_server(u->server);
	if ( is ) {
		ret = _remote_session(
				env,
				id,
				u,
				a_agent,
				a_login_mode,
				a_center_cmd,
				cmd,
				f,
				ln,
				session_lock_enable,
				0,0);
		goto end;
	}

	ret = setup_session_proxy(id,f,ln);
	if ( get_type(ret) == XLT_ERROR )
		goto end;
	if ( get_type(ret) != XLT_NULL )
		ret = _remote_session(
				gblisp_top_env0,
				native_proxy_session,
				&native_proxy_url,
				l_string(std_cm,"xlproxy"),
				l_string(std_cm,"user"),
				0,
				ret,
				f,
				ln,
				0,
				0,
				id);
	if ( ret && ret->h.type == XLT_ERROR )
		goto end;

	send_query = cmd;
	if ( a_center_cmd )
		send_query = cons(
			List(n_get_symbol("Command"),
				get_string(a_center_cmd),
				-1),
			send_query);
	if ( a_login_mode )
		send_query = cons(
			List(n_get_symbol("LoginMode"),
				get_string(a_login_mode),
				-1),
			send_query);
	if ( a_agent )
		send_query = cons(
			List(n_get_symbol("Agent"),
				get_string(a_agent),
				-1),
			send_query);
	send_query = cons(
		List(n_get_symbol("URL"),
		get_string(get_url_str2(u)),
		-1),
		send_query);

	sprintf(buf,"rs%i",id);

	send_query = cons(
		n_get_symbol(buf),
		send_query);
	send_query = cons(
		n_get_symbol("RemoteSession"),
		send_query);
/*
ss_printf("SEND ");
print_sexp(s_stdout,send_query,0);
ss_printf("\n");
 if ( a_center_cmd && l_strcmp(a_center_cmd,
		l_string(std_cm,"://")) == 0 )
er_panic("sopt");
*/

	ret = _remote_session(
			env,
			native_proxy_session,
			&native_proxy_url,
			l_string(std_cm,"xlproxy"),
			l_string(std_cm,"user"),
			0,
			List(send_query,-1),
			f,
			ln,
			session_lock_enable,
			0,id);
end:
	if ( a_agent )
		d_f_ree(a_agent);
	if ( a_login_mode )
		d_f_ree(a_login_mode);
	if ( a_center_cmd )
		d_f_ree(a_center_cmd);
	return ret;
}


XL_SEXP *
remote_session_delay(XL_SEXP * s)
{
XL_RESULT * resp;
XL_SEXP * ret;
int retry_cnt;
extern SEM xli_lock;
XL_SEXP * _wait_result_inp(XL_RESULT*);
CON_SESSION * ses;
	resp = (XL_RESULT*)s->delay.d.func;
	ses = resp->s_session;
	retry_cnt = 3;
retry:
	gc_push(0,0,"remote_delay_func");
	lock_task(xli_lock);
	ret = _wait_result_inp(resp);
	unlock_task(xli_lock,"remote_delay_func");
	gc_pop(ret,gc_gb_sexp);

	gc_push(0,0,"remote_delay_func");
	if ( ret && ret->h.type == XLT_ERROR ) {
		if ( retry_cnt <= 0 )
			goto end;
		switch ( ret->err.code ) {
		case XLE_PROTO_ACCESS_STREAM:
		case XLE_PROTO_INV_IID:
			ret = _remote_session(
				resp->s_env,
				resp->s_id,
				&resp->s_url,
				resp->s_agent,
				resp->s_login_mode,
				resp->s_center_cmd,
				resp->s_cmd,
				resp->s_file,
				resp->s_line,0,1,
				resp->s_proxy_ses);
			if ( ret->h.type != XLT_DELAY )
				goto end;
			resp = (XL_RESULT*)ret->delay.d.func;
			s->delay.d.func = &resp->h;
			retry_cnt --;
			gc_pop(ret,gc_gb_sexp);
			goto retry;
		}
	}
end:
	lock_task(session_lock);
	ses->access_cnt --;
	if ( (ses->flags & CSF_CLOSE) && ses->access_cnt == 0 )
		_close_session(ses->id);
	unlock_task(session_lock,"remote_sesion_delay");
	over_write_sexp(s,ret);
	gc_pop(0,0);
	return s;
}

extern int stop_flag ;

int
check_remote_session_delay(XL_RESULT * resp,int key)
{
int ret;
extern SEM xli_lock;

	lock_task(xli_lock);
	ret = _check_remote_delay(resp,key);

	if ( ret == CDT_READY ) {
		if ( resp->ret->h.type == XLT_ERROR ) {
			switch ( resp->ret->err.code ) {
			case XLE_PROTO_ACCESS_STREAM:
			case XLE_PROTO_INV_IID:
				ret = CDT_WAIT_ERR;
				break;
			default:
				ret = CDT_READY;
			}
		}
	}
	unlock_task(xli_lock,"remote_delay_func");
	return ret;
}

void
remote_session_tick(CON_SESSION * ses)
{
	lock_task(session_lock);
	ses->access_cnt --;
	if ( (ses->flags & CSF_CLOSE) && ses->access_cnt <= 0 )
		_close_session(ses->id);
	unlock_task(session_lock,"gc_remote_session");
}

void
session_tick()
{
	lock_task(session_lock);
	_connection_check();
	unlock_task(session_lock,"session_tick");
}

int
_set_native_proxy_direct_access(L_CHAR * server)
{
NPROXY_DIRECT_SERVER * d;
	d = _search_direct_server(server);
	if ( d )
		return -1;
	d = d_alloc(sizeof(*d));
	d->server = ll_copy_str(server);
	d->next = np_server_list;
	np_server_list = d;
	return 0;
}


int
set_native_proxy_direct_access(L_CHAR * server)
{
int ret;


	lock_task(session_lock);
	ret = _set_native_proxy_direct_access(server);
	unlock_task(session_lock,"set_native_proxy");


	return ret;
}


XL_SEXP *
pre_proxy_func(
	CON_SESSION * ses,
	CON_AGENT * a,
	int proxy_ses)
{
CON_SESSION * s;
	lock_task(session_lock);
	for ( s = session_list ; s ; s = s->next )
		s->flags &= ~CSF_PROXY_INIT;
	unlock_task(session_lock,"pre_proxy_func");

	return setup_session_proxy(proxy_ses,0,0);
}

int
set_native_proxy(URL * u)
{
CON_SESSION * ses;



	if ( u == 0 || u->server == 0 ) {
		close_session(native_proxy_session);
		native_proxy_session = 0;
		free_url(&native_proxy_url);
		zero_url(&native_proxy_url);

		return 0;
	}
	if ( native_proxy_session == 0 )
		native_proxy_session = open_session(SEST_OPTIMIZE);
	free_url(&native_proxy_url);
	copy_url(&native_proxy_url,u);


	lock_task(session_lock);
	ses = _search_con_session(native_proxy_session);
	_set_pre_func(ses,
		pre_proxy_func,
		0,
		0,
		0,
		0);
	unlock_task(session_lock,"set_native_proxy");

	return 0;
}

XL_SEXP *
_get_native_proxy_server_list()
{
NPROXY_DIRECT_SERVER * s;
XL_SEXP * ret;
	ret = 0;
	for ( s = np_server_list ; s ; s = s->next ) {
		ret = cons(
			List(n_get_symbol("server"),
				n_get_string("NoProxy"),
				get_string(s->server),
				-1),
			ret);
	}
	return ret;
}


XL_SEXP *
_get_native_proxyinfo()
{
	if ( native_proxy_session == 0 ) {
		return List(n_get_symbol("proxyinfo"),
			n_get_string("NoProxy"),
			-1);
	}
	else {
		return append(List(n_get_symbol("proxyinfo"),
			n_get_string("NativeProxy"),
			get_string(native_proxy_url.server),
			get_integer(native_proxy_url.port,0),
			-1),
			_get_native_proxy_server_list());
	}
}


XL_SEXP *
get_native_proxyinfo()
{
XL_SEXP *ret;
	lock_task(session_lock);
	ret = _get_native_proxyinfo();
	unlock_task(session_lock,"get_native_proxyinfo");
	return ret;
}

void
np_divide_p_agent(URL * u)
{
	ss_printf("DIVIDE PROXY AGENT\n");	
}


int
aboat_session(XL_SEXP * s)
{
	return aboat_remote_query(s);
}


