41 #include "EST_FringeServer.h"
43 static bool have_read_table=FALSE;
45 static int tc_fringe_server= -1;
51 if (TYPEP(x,tc_fringe_server))
54 err(
"wrong type of argument to get_c_fringe_server",x);
59 int siod_fringe_server_p(LISP x)
61 if (TYPEP(x,tc_fringe_server))
72 return siod_make_typed_cell(tc_fringe_server,s);
75 static void fringe_server_free(LISP lserver)
79 USERVAL(lserver) = NULL;
84 LISP fringe_read_server_table(LISP args)
96 LISP fringe_servers(
void)
101 if (!have_read_table)
102 fringe_read_server_table(NIL);
108 for(p.
begin(names); p; ++p)
109 lnames = cons(strcons((*p).length(), *p), lnames);
123 case connect_not_found_error:
124 EST_sys_error(
"Can't find host '%s:%d'", (
const char *)server->
servername(), server->
port());
127 case connect_not_allowed_error:
128 EST_sys_error(
"Can't connect to '%s:%d'", (
const char *)server->
servername(), server->
port());
132 EST_sys_error(
"Error connecting to '%s:%d'", (
const char *)server->
servername(), server->
port());
137 LISP fringe_server(LISP lname)
142 EST_String name=NULLP(lname)?
"fringe":get_c_string(lname);
144 if (!have_read_table)
145 fringe_read_server_table(NIL);
147 LISP verbose = siod_get_lval(
"fringe_verbose", NULL);
151 fringe_connect(server);
153 return siod_make_fringe_server(server);
158 if (siod_fringe_server_p(lserver))
163 lserver = fringe_server(lserver);
166 return get_c_fringe_server(lserver);
169 LISP fringe_connect(LISP lserver)
171 if (!siod_fringe_server_p(lserver))
172 EST_error(
"not a fringe server %s", get_c_string(lserver));
177 fringe_connect(server);
182 LISP fringe_disconnect(LISP lserver)
184 if (!siod_fringe_server_p(lserver))
185 EST_error(
"not a fringe server %s", get_c_string(lserver));
194 LISP fringe_command_string(LISP lserver,
204 fringe_connect(server);
210 if (!server->execute(command, handler))
215 return strcons(err.
length(), err);
224 LISP fringe_command(LISP lserver,
233 EST_String package = NULLP(lpackage)?"":get_c_string(lpackage);
234 EST_String operation = NULLP(loperation)?
"":get_c_string(loperation);
239 EST_error(
"Bad argument list");
241 lisp_to_features(largs, args);
247 fringe_connect(server);
249 if (!server->execute(package, operation, args, handler))
254 return strcons(err.
length(), err);
263 void siod_fringe_init()
267 tc_fringe_server = siod_register_user_type(
"FringeServer");
268 set_gc_hooks(tc_fringe_server, 0, NULL,NULL,NULL,fringe_server_free,NULL,&kind);
271 init_lsubr(
"fringe_read_server_table", fringe_read_server_table,
272 "(fringe_read_server_table &opt FILENAME)\n"
273 " Read the users table of fringe servers, or the table\n"
274 " in FILENAME if given.");
276 init_subr_0(
"fringe_servers", fringe_servers,
278 " Returns a list of the know fringe servers. This doesn't\n"
279 " guarantee that they are still running.");
281 init_lsubr(
"fringe_server", fringe_server,
282 "(fringe_server &opt NAME)\n"
283 " Return a connection to a fringe server with the given name.\n"
284 " If name is omitted it defaults to \"fringe\".");
286 init_subr_1(
"fringe_disconnect", fringe_disconnect,
287 "(fringe_disconnect SERVER)\n"
288 " Close the connection to the server.");
290 init_subr_1(
"fringe_connect", fringe_connect,
291 "(fringe_connect SERVER)\n"
292 " Re-open the connection to the server.");
294 init_subr_2(
"fringe_command_string", fringe_command_string,
295 "(fringe_command_string SERVER COMMAND)\n"
296 " Send COMMAND to the fringe server SERVER.");
298 init_subr_4(
"fringe_command", fringe_command,
299 "(fringe_command SERVER PACKAGE OPERATION ARGS) \n"
300 " Send command to the fringe server SERVER.\n"
301 " ARGS should be an association list of key-value pairs.");