/**********************************************************************
 
	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"

XL_SEXP * xl_RemoteSession();

void
init_RemoteSession(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"RemoteSession"),
		get_func_prim(xl_RemoteSession,FO_NORMAL,0,2,-1));
}

XL_SEXP *
xl_RemoteSession(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,
	XL_SYM_FIELD * sf)
{
XL_SEXP * id;
XL_SEXP * path, * agent,* lt,* ccmd;
int _id;
L_CHAR * _path;
L_CHAR * _agent;
L_CHAR * _lt;
L_CHAR * _ccmd;
XL_SEXP * sym, * cmd,* ret,* s_i;
URL u;
L_CHAR * type;

int tim;

	s_i = s;
	id = eval(env,get_el(s,1));
	switch ( get_type(id) ) {
	case XLT_ERROR:
		return id;
	case XLT_INTEGER:
		_id = id->integer.data;
		break;
	default:
		goto type_missmatch;
	}
	_path = 0;
	_agent = 0;
	_lt = 0;
	_ccmd = 0;
	zero_url(&u);
	s = cdr(cdr(s));
	for ( ; get_type(s) ; s = cdr(s) ) {
		cmd = car(s);
		switch ( get_type(cmd) ) {
		case XLT_ERROR:
			return cmd;
		case XLT_PAIR:
			break;
		default:
			goto next;
		}
		sym = car(cmd);
		switch ( get_type(sym) ) {
		case XLT_ERROR:
			return sym;
		case XLT_SYMBOL:
			break;
		default:
			goto next;
		}
		if ( l_strcmp(sym->symbol.data,l_string(std_cm,"URL"))
				== 0 ) {
			if ( list_length(cmd) != 2 )
				goto length_error;
			path = eval(env,get_el(cmd,1));
			switch ( get_type(path) ) {
			case XLT_ERROR:
				return path;
			case XLT_STRING:
				_path = path->string.data;
				break;
			default:
				goto type_missmatch;
			}
		}
		else if ( l_strcmp(sym->symbol.data,l_string(std_cm,"Agent"))
				== 0 ) {
			if ( list_length(cmd) != 2 )
				goto length_error;
			agent = eval(env,get_el(cmd,1));
			switch ( get_type(agent) ) {
			case XLT_ERROR:
				return agent;
			case XLT_STRING:
				_agent = 
				  ll_copy_str(agent->string.data,1470);
				break;
			default:
				goto type_missmatch;
			}
		}
		else if ( l_strcmp(sym->symbol.data,
			l_string(std_cm,"LoginMode")) == 0 ) {
			if ( list_length(cmd) != 2 )
				goto length_error;
			lt = eval(env,get_el(cmd,1));
			switch ( get_type(lt) ) {
			case XLT_ERROR:
				return lt;
			case XLT_STRING:
				_lt = ll_copy_str(lt->string.data,1469);
				break;
			default:
				goto type_missmatch;
			}
		}
		else if ( l_strcmp(sym->symbol.data,
			l_string(std_cm,"Command")) == 0 ) {
			if ( list_length(cmd) != 2 )
				goto length_error;
			ccmd = eval(env,get_el(cmd,1));
			switch ( get_type(ccmd) ) {
			case XLT_ERROR:
				return ccmd;
			case XLT_STRING:
				_ccmd = 
				  ll_copy_str(ccmd->string.data,1468);
				break;
			default:
				goto type_missmatch;
			}
		}
		else goto next;
	}
next:
	if ( _path )
		get_url2(&u,_path,1205);
	else	zero_url(&u);
	if ( _ccmd == 0 )
		_ccmd = nl_copy_str(std_cm,"Get");
	type = get_sf_attribute(sf,l_string(std_cm,"type"));
	if ( type )
		s = gb_quote_trace(env,s,type);

tim = clock();

	ret = remote_session(env,_id,&u,_agent,_lt,_ccmd,s,
			     s_i->h.file,s_i->h.line,0);

	goto end;
type_missmatch:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"RemoteSession"),
		n_get_string("type missmatch"));
	goto end;
length_error:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_INV_PARAM_LENGTH,
		l_string(std_cm,"RemoteSession"),
		n_get_string("invalid parameter length"));
end:
	free_url(&u);
	if ( _lt )
		d_f_ree(_lt);
	if ( _ccmd )
		d_f_ree(_ccmd);
	if ( _agent )
		d_f_ree(_agent);
	return ret;
}


