/*----------------------------------------------------------------------------
try_match__()
The pattern matching function which includes loading perl interpreter and
trying the perl pattern matching.
arguments:
input: char* string, -- input text
char* pattern -- match pattern
output:if no match found, return FAILURE (0).
----------------------------------------------------------------------------*/
int try_match__( void )
{
SV *text; /* the storage for the string in embedded Perl */
SV *string_buff; /* the storage for the string in embedded Perl */
int was_match; /* number of the matches */
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
char *string = ptoc_string(CTXTc 1),
*pattern = ptoc_string(CTXTc 2);
/* first load the perl interpreter, if unloaded */
if (perlObjectStatus == UNLOADED) load_perl__();
text = newSV(0);
string_buff = newSV(0);
sv_setpv(text, string); /* store the string in the SV */
was_match = match(text, pattern );
global_pattern_mode = is_global_pattern(pattern);
SvREFCNT_dec(string_buff);
SvREFCNT_dec(text);
return(was_match);
}
/*----------------------------------------------------------------------------
perl_substitute__()
The pattern substitution function which includes loading perl interpreter
and doing the pattern substitution, then returning the replaced string.
arguments:
input: char* string, input text
char* pattern, match pattern
output:char* string, output text
----------------------------------------------------------------------------*/
int perl_substitute__( void )
{
SV *text; /* Perl representation for the string to be
modified by substitution */
char *subst_cmd = ptoc_string(CTXTc 2);
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
/* first load the perl interpreter, if unloaded */
if (perlObjectStatus == UNLOADED) load_perl__();
text = newSV(0);
sv_setpv(text, ptoc_string(CTXTc 1)); /* put the string to the SV */
if( !substitute(&text, subst_cmd) )
return(FAILURE);
global_pattern_mode = is_global_pattern(subst_cmd);
if (substituteString != NULL ) free(substituteString);
substituteString = malloc(strlen(SvPV(text,PL_na))+1);
strcpy(substituteString,SvPV(text,PL_na));
SvREFCNT_dec(text); /*release space*/
ctop_string(CTXTc 3, string_find(substituteString,1)); /*return changed text*/
return SUCCESS;
}
/*----------------------------------------------------------------------------
do_bulk_match__()
The pattern match function which includes loading perl interpreter and
doing the global perl pattern match, and storing the results in the global
array of bulkMatchList.
argument:
input: char* string -- input text
char* pattern -- match pattern
output: int* num_match -- the number of the matches
----------------------------------------------------------------------------*/
int do_bulk_match__( void )
{
AV *match_list; /* AV storage of matches list*/
SV *text; /* storage for the embedded perl cmd */
SV *string_buff; /* storage for the embedded perl cmd */
int num_match; /* the number of the matches */
int i;
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
/* first load the perl interpreter, if unloaded */
if (perlObjectStatus == UNLOADED) load_perl__();
text = newSV(0);
string_buff = newSV(0);
sv_setpv(text, ptoc_string(CTXTc 1)); /*put the string into an SV */
/*------------------------------------------------------------------------
free the old match list space and allocate new space for current match list
-----------------------------------------------------------------------*/
for ( i=0; i<preBulkMatchNumber; i++ )
free(bulkMatchList[i]);
if (bulkMatchList != NULL ) free(bulkMatchList);
bulkMatchList = NULL;
/*------------------------------------------------------------------------
do bulk match
----------------------------------------------------------------------*/
num_match = all_matches(text, ptoc_string(CTXTc 2),&match_list);
/* allocate the space to store the matches */
if ( num_match != 0 ) {
preBulkMatchNumber = num_match; /* reset the pre bulk match number */
bulkMatchList = (char **)malloc(num_match*sizeof(char *));
if ( bulkMatchList == NULL )
xsb_abort("Cannot alocate memory to store the results for bulk match");
}
/*get the matches from the AV */
for ( i=0;i<num_match;i++ ) {
string_buff = av_shift(match_list);
bulkMatchList[i] = (char *)malloc( strlen(SvPV(string_buff,PL_na))+1 );
strcpy((char *)bulkMatchList[i], SvPV(string_buff,PL_na) );
}
SvREFCNT_dec(string_buff); /* release space*/
SvREFCNT_dec(text);
ctop_int(CTXTc 3, num_match); /*return the number of matches*/
return SUCCESS;
}
static int socket_send(CTXTdeclc int *rc, int timeout) {
SOCKET sock_handle = (SOCKET) ptoc_int(CTXTc 2);
char *send_msg_aux = ptoc_string(CTXTc 3);
size_t msg_body_len, full_msg_len, network_encoded_len;
char *message_buffer;
if (!write_select(sock_handle, timeout)) {
return TIMED_OUT;
}
/* We we add 1 since the message is a string that ends with a '\0' (this is
how it is pased from XSB to send_msg_aux) */
msg_body_len = strlen(send_msg_aux)+1;
full_msg_len = msg_body_len+XSB_MSG_HEADER_LENGTH;
/* We use the first XSB_MSG_HEADER_LENGTH bytes for the message size. */
message_buffer = mem_calloc(full_msg_len, sizeof(char),LEAK_SPACE);
network_encoded_len = htonl((u_long)msg_body_len);
memcpy((void*)(message_buffer), (void *)&network_encoded_len, XSB_MSG_HEADER_LENGTH);
strcpy(message_buffer+XSB_MSG_HEADER_LENGTH, send_msg_aux);
*rc = sendto(sock_handle, message_buffer, (int)full_msg_len, 0, NULL, 0);
mem_dealloc(message_buffer,full_msg_len*sizeof(char),LEAK_SPACE);
return NORMAL_TERMINATION;
}
DllExport int call_conv closeStatement(void)
{
char* queryHandle;
queryHandle = ptoc_string(CTXTc 1);
return closeQueryHandle(queryHandle);
}
/*-----------------------------------------------------------------------------*/
void ODBCColumns()
{
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
char tmpstr[255];
char *str1, *str2, *str3;
RETCODE rc;
strcpy(tmpstr,ptoc_string(3));
str1 = strtok(tmpstr,".");
str2 = str3 = NULL;
if (str1) str2 = strtok(NULL,".");
if (str2) str3 = strtok(NULL,".");
if (!str3 && !str2) {str3 = str1; str1 = NULL;}
else if (!str3) {str3 = str2; str2 = NULL;}
/* printf("str1 %s, str2 %s, str3 %s\n",str1,str2,str3);*/
if (((rc=SQLColumns(cur->hstmt,
str1, SQL_NTS,
str2, SQL_NTS,
str3, SQL_NTS,
NULL,0)) == SQL_SUCCESS) ||
(rc == SQL_SUCCESS_WITH_INFO)) {
ctop_int(4,0);
} else {
ctop_int(4,PrintErrorMsg(cur));
SetCursorClose(cur);
}
return;
}
//todo: need to refactor this code.
int callpy(CTXTdecl)
{
setenv("PYTHONPATH", ".", 1);
PyObject *pName = NULL, *pModule = NULL, *pFunc = NULL;
PyObject *pArgs = NULL, *pValue = NULL;
//PyObject *pArgs, *pValue;
prolog_term V, temp;
Py_Initialize();
char *module = ptoc_string(CTXTdeclc 1);
//char *function = ptoc_string(CTXTdeclc 2);
pName = PyString_FromString(module);
pModule = PyImport_Import(pName);
if(pModule == NULL)
{
return FALSE;
}
Py_DECREF(pName);
V = extern_reg_term(2);
char *function = p2c_functor(V);
if(is_functor(V))
{
int args_count = p2c_arity(V);
pFunc = PyObject_GetAttrString(pModule, function);
Py_DECREF(pModule);
if(pFunc && PyCallable_Check(pFunc))
{
pArgs = PyTuple_New(args_count);
int i;
for(i = 1; i <= args_count; i++)
{
temp = p2p_arg(V, i);
if(!(set_python_argument(temp, pArgs, i)))
{
return FALSE;
}
}
}
else
{
return FALSE;
}
pValue = PyObject_CallObject(pFunc, pArgs);
//printf("return call : %p\n",pValue);
if(return_to_prolog(pValue))
return TRUE;
else
return FALSE;
}
else
{
return FALSE;
}
return TRUE;
}
int parse()
{
fn_source = (char*)ptoc_string(1);
fn_target = (char*)ptoc_string(2);
fn_error = (char*)ptoc_string(3);
if (strcmp(fn_error, "stderr") == 0)
error_file = stderr;
else
error_file = fopen(fn_error, "w");
if ((yyin = fopen(fn_source, "r")) == NULL) {
fprintf(error_file,
"Can not open source file %s.\n",
fn_source);
return FALSE;
}
if ((yyout = fopen(fn_target, "w")) == NULL) {
fprintf(error_file,
"Can not open target file %s.\n",
fn_target);
return FALSE;
}
line_no = 1; char_no = 1;
num_errs = 0;
yyparse();
fclose(yyin);
fclose(yyout);
if (num_errs > 0) {
fprintf(error_file,
"%s contains syntax %d errors.\n",
fn_source, num_errs);
}
if (error_file != stderr)
fclose(error_file);
return (num_errs == 0) ? TRUE : FALSE ;
}
DllExport int call_conv moreResults(void)
{
char* handle;
struct xsb_queryHandle* qHandle;
handle = ptoc_string(CTXTc 1);
if ((qHandle = isQueryHandle(handle)) != NULL && qHandle->state != QUERY_BEGIN) {
return TRUE;
}
return FALSE;
}
DllExport int call_conv closeConnection(void)
{
int (*disconnectDriver)(struct xsb_connectionHandle *);
int (*closeStmtDriver)(struct xsb_queryHandle *);
char* (*errorMesgDriver)();
char* handle;
int val, i, j;
handle = ptoc_string(CTXTc 1);
for (i = 0 ; i < numCHandles ; i++) {
if (!strcmp(CHandles[i]->handle, handle)) {
if (getDriverFunction(CHandles[i]->driver, DISCONNECT) != NULL)
disconnectDriver = getDriverFunction(CHandles[i]->driver, DISCONNECT)->disconnectDriver;
else
return FALSE;
val = disconnectDriver(CHandles[i]);
if (val == FAILURE) {
errorMesgDriver = getDriverFunction(CHandles[i]->driver, ERROR_MESG)->errorMesgDriver;
errorMesg = errorMesgDriver();
return FALSE;
}
for (j = 0 ; j < numQHandles ; j++) {
if (!strcmp(QHandles[j]->connHandle->handle, handle)) {
if (getDriverFunction(CHandles[i]->driver, ERROR_MESG) != NULL)
closeStmtDriver = getDriverFunction(CHandles[i]->driver, ERROR_MESG)->closeStmtDriver;
else
return FALSE;
val = closeStmtDriver(QHandles[j]);
if (val == FAILURE) {
errorMesgDriver = getDriverFunction(CHandles[i]->driver, ERROR_MESG)->errorMesgDriver;
errorMesg = errorMesgDriver();
return FALSE;
}
freeQueryHandle(QHandles[j], j);
j--;
}
}
freeConnectionHandle(CHandles[i], i);
return TRUE;
}
}
errorMesg = "XSB_DBI ERROR: Connection handle does not exist";
errorNumber = "XSB_DBI_004";
return FALSE;
}
/*----------------------------------------------------------------------------
try_match__()
The pattern matching function which includes loading perl interpreter and
trying the perl pattern matching.
arguments:
input: char* string, -- input text
char* pattern -- match pattern
output:if no match found, return FAILURE (0).
----------------------------------------------------------------------------*/
int try_match__( void )
{
SV *text; /* the storage for the string in embedded Perl */
SV *string_buff; /* the storage for the string in embedded Perl */
int was_match; /* number of the matches */
char *string = ptoc_string(1),
*pattern = ptoc_string(2);
/* first load the perl interpreter, if unloaded */
if (perlObjectStatus == UNLOADED) load_perl__();
text = newSV(0);
string_buff = newSV(0);
sv_setpv(text, string); /* store the string in the SV */
was_match = match(text, pattern );
global_pattern_mode = is_global_pattern(pattern);
SvREFCNT_dec(string_buff);
SvREFCNT_dec(text);
return(was_match);
}
DllExport int call_conv queryConnection(void)
{
struct xsb_data** (*queryDriver)(struct xsb_queryHandle*);
void (*freeResultDriver)();
char* (*errorMesgDriver)();
prolog_term returnList, sqlQueryList;
struct xsb_connectionHandle* cHandle;
struct xsb_queryHandle* qHandle;
struct xsb_data** result;
char *chandle, *qhandle, *sqlQuery;
int val;
chandle = ptoc_string(CTXTc 1);
qhandle = ptoc_string(CTXTc 2);
sqlQueryList = reg_term(CTXTc 3);
returnList = reg_term(CTXTc 4);
result = NULL;
cHandle = NULL;
qHandle = NULL;
if ((qHandle = isQueryHandle(qhandle)) != NULL) {
if (strcmp(qHandle->connHandle->handle, chandle)) {
errorMesg = "XSB_DBI ERROR: Query handle already exists";
errorNumber = "XSB_DBI_007";;
return FALSE;
}
if (getDriverFunction(qHandle->connHandle->driver, QUERY) != NULL) {
queryDriver =
getDriverFunction(qHandle->connHandle->driver, QUERY)->queryDriver;
}
else {
return FALSE;
}
sqlQuery = buildSQLQuery(sqlQueryList);
if (strcmp(qHandle->query, sqlQuery)) {
errorMesg =
"XSB DBI ERROR: Same query handle used for different queries";
errorNumber = "XSB_DBI_010";
if (sqlQuery != NULL) {
free(sqlQuery);
sqlQuery = NULL;
}
return FALSE;
}
if (sqlQuery != NULL) {
free(sqlQuery);
sqlQuery = NULL;
}
result = queryDriver(qHandle);
if (result == NULL && qHandle->state == QUERY_RETRIEVE) {
closeQueryHandle(qhandle);
}
}
else if ((cHandle = isConnectionHandle(chandle)) != NULL) {
if ( MAX_QUERIES <= numQHandles ){
errorMesg = "XSB_DBI ERROR: Too many active queries";
errorNumber = "XSB_DBI_016";
return FALSE;
}
sqlQuery = buildSQLQuery(sqlQueryList);
qHandle = (struct xsb_queryHandle *)malloc(sizeof(struct xsb_queryHandle));
qHandle->handle = (char *)malloc(sizeof(char)*(strlen(qhandle)+1));
strcpy(qHandle->handle,qhandle);
qHandle->connHandle = cHandle;
qHandle->query = sqlQuery;
qHandle->state = QUERY_BEGIN;
QHandles[numQHandles++] = qHandle;
if (getDriverFunction(qHandle->connHandle->driver, QUERY) != NULL)
queryDriver = getDriverFunction(qHandle->connHandle->driver, QUERY)->queryDriver;
else
return FALSE;
result = queryDriver(qHandle);
}
else {
errorMesg = "XSB_DBI ERROR: Connection handle does not exist";
errorNumber = "XSB_DBI_004";
return FALSE;
}
val = bindReturnList(returnList, result, qHandle);
if (result == NULL) {
closeQueryHandle(qhandle);
}
else {
if (getDriverFunction(qHandle->connHandle->driver, FREE_RESULT) != NULL)
freeResultDriver = getDriverFunction(qHandle->connHandle->driver, FREE_RESULT)->freeResultDriver;
else
return FALSE;
freeResultDriver(result, qHandle->numResultCols);
}
if ((cHandle = isConnectionHandle(chandle)) != NULL) {
if (getDriverFunction(cHandle->driver, ERROR_MESG) != NULL)
errorMesgDriver =
getDriverFunction(cHandle->driver, ERROR_MESG)->errorMesgDriver;
else
return FALSE;
errorMesg = errorMesgDriver();
errorNumber = "XSB_DBI_000";
}
if (errorMesg == NULL && val == RESULT_NONEMPTY_OR_NOT_REQUESTED)
return TRUE;
else
return FALSE;
}
/* TLS: making a conservative guess at which system calls need to be
mutexed. I'm doing it whenever I see the process table altered or
affected, so this is the data structure that its protecting.
At some point, the SET_FILEPTRs should be protected against other
threads closing that stream. Perhaps for such things a
thread-specific stream table should be used.
*/
xsbBool sys_system(CTXTdeclc int callno)
{
// int pid;
Integer pid;
switch (callno) {
case PLAIN_SYSTEM_CALL: /* dumb system call: no communication with XSB */
/* this call is superseded by shell and isn't used */
ctop_int(CTXTc 3, system(ptoc_string(CTXTc 2)));
return TRUE;
case SLEEP_FOR_SECS:
#ifdef WIN_NT
Sleep((int)iso_ptoc_int_arg(CTXTc 2,"sleep/1",1) * 1000);
#else
sleep(iso_ptoc_int_arg(CTXTc 2,"sleep/1",1));
#endif
return TRUE;
case GET_TMP_FILENAME:
ctop_string(CTXTc 2,tempnam(NULL,NULL));
return TRUE;
case IS_PLAIN_FILE:
case IS_DIRECTORY:
case STAT_FILE_TIME:
case STAT_FILE_SIZE:
return file_stat(CTXTc callno, ptoc_longstring(CTXTc 2));
case EXEC: {
#ifdef HAVE_EXECVP
/* execs a new process in place of XSB */
char *params[MAX_SUBPROC_PARAMS+2];
prolog_term cmdspec_term;
int index = 0;
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term)) {
prolog_term temp, head;
char *string_head=NULL;
if (isnil(cmdspec_term))
xsb_abort("[exec] Arg 1 must not be an empty list.");
temp = cmdspec_term;
do {
head = p2p_car(temp);
temp = p2p_cdr(temp);
if (isstring(head))
string_head = string_val(head);
else
xsb_abort("[exec] non-string argument passed in list.");
params[index++] = string_head;
if (index > MAX_SUBPROC_PARAMS)
xsb_abort("[exec] Too many arguments.");
} while (!isnil(temp));
params[index] = NULL;
} else if (isstring(cmdspec_term)) {
char *string = string_val(cmdspec_term);
split_command_arguments(string, params, "exec");
} else
xsb_abort("[exec] 1st argument should be term or list of strings.");
if (execvp(params[0], params))
xsb_abort("[exec] Exec call failed.");
#else
xsb_abort("[exec] builtin not supported in this architecture.");
#endif
}
case SHELL: /* smart system call: like SPAWN_PROCESS, but returns error code
instead of PID. Uses system() rather than execvp.
Advantage: can pass arbitrary shell command. */
case SPAWN_PROCESS: { /* spawn new process, reroute stdin/out/err to XSB */
/* +CallNo=2, +ProcAndArgsList,
-StreamToProc, -StreamFromProc, -StreamFromProcStderr,
-Pid */
static int pipe_to_proc[2], pipe_from_proc[2], pipe_from_stderr[2];
int toproc_stream=-1, fromproc_stream=-1, fromproc_stderr_stream=-1;
int pid_or_status;
FILE *toprocess_fptr=NULL,
*fromprocess_fptr=NULL, *fromproc_stderr_fptr=NULL;
char *params[MAX_SUBPROC_PARAMS+2]; /* one for progname--0th member,
one for NULL termination*/
prolog_term cmdspec_term, cmdlist_temp_term;
prolog_term cmd_or_arg_term;
xsbBool toproc_needed=FALSE, fromproc_needed=FALSE, fromstderr_needed=FALSE;
char *cmd_or_arg=NULL, *shell_cmd=NULL;
int idx = 0, tbl_pos;
char *callname=NULL;
xsbBool params_are_in_a_list=FALSE;
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (callno == SPAWN_PROCESS)
callname = "spawn_process/5";
else
callname = "shell/[1,2,5]";
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term))
params_are_in_a_list = TRUE;
else if (isstring(cmdspec_term))
shell_cmd = string_val(cmdspec_term);
else if (isref(cmdspec_term))
xsb_instantiation_error(CTXTc callname,1);
else
xsb_type_error(CTXTc "atom or list e.g. [command, arg, ...]",cmdspec_term,callname,1);
// xsb_abort("[%s] Arg 1 must be an atom or a list [command, arg, ...]",
// callname);
/* the user can indicate that he doesn't want either of the streams created
by putting an atom in the corresponding argument position */
if (isref(reg_term(CTXTc 3)))
toproc_needed = TRUE;
if (isref(reg_term(CTXTc 4)))
fromproc_needed = TRUE;
if (isref(reg_term(CTXTc 5)))
fromstderr_needed = TRUE;
/* if any of the arg streams is already used by XSB, then don't create
pipes --- use these streams instead. */
if (isointeger(reg_term(CTXTc 3))) {
SET_FILEPTR(toprocess_fptr, oint_val(reg_term(CTXTc 3)));
}
if (isointeger(reg_term(CTXTc 4))) {
SET_FILEPTR(fromprocess_fptr, oint_val(reg_term(CTXTc 4)));
}
if (isointeger(reg_term(CTXTc 5))) {
SET_FILEPTR(fromproc_stderr_fptr, oint_val(reg_term(CTXTc 5)));
}
if (!isref(reg_term(CTXTc 6)))
xsb_type_error(CTXTc "variable (to return process id)",reg_term(CTXTc 6),callname,5);
// xsb_abort("[%s] Arg 5 (process id) must be a variable", callname);
if (params_are_in_a_list) {
/* fill in the params[] array */
if (isnil(cmdspec_term))
xsb_abort("[%s] Arg 1 must not be an empty list", callname);
cmdlist_temp_term = cmdspec_term;
do {
cmd_or_arg_term = p2p_car(cmdlist_temp_term);
cmdlist_temp_term = p2p_cdr(cmdlist_temp_term);
if (isstring(cmd_or_arg_term)) {
cmd_or_arg = string_val(cmd_or_arg_term);
}
else
xsb_abort("[%s] Non string list member in the Arg",
callname);
params[idx++] = cmd_or_arg;
if (idx > MAX_SUBPROC_PARAMS)
xsb_abort("[%s] Too many arguments passed to subprocess",
callname);
} while (!isnil(cmdlist_temp_term));
params[idx] = NULL; /* null termination */
} else { /* params are in a string */
if (callno == SPAWN_PROCESS)
split_command_arguments(shell_cmd, params, callname);
else {
/* if callno==SHELL => call system() => don't split shell_cmd */
params[0] = shell_cmd;
params[1] = NULL;
}
}
/* -1 means: no space left */
if ((tbl_pos = get_free_process_cell()) < 0) {
xsb_warn(CTXTc "Can't create subprocess because XSB process table is full");
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
/* params[0] is the progname */
pid_or_status = xsb_spawn(CTXTc params[0], params, callno,
(toproc_needed ? pipe_to_proc : NULL),
(fromproc_needed ? pipe_from_proc : NULL),
(fromstderr_needed ? pipe_from_stderr : NULL),
toprocess_fptr, fromprocess_fptr,
fromproc_stderr_fptr);
if (pid_or_status < 0) {
xsb_warn(CTXTc "[%s] Subprocess creation failed, Error: %d, errno: %d, Cmd: %s", callname,pid_or_status,errno,params[0]);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
if (toproc_needed) {
toprocess_fptr = fdopen(pipe_to_proc[1], "w");
toproc_stream = xsb_intern_fileptr(CTXTc toprocess_fptr,callname,"pipe","w",CURRENT_CHARSET);
ctop_int(CTXTc 3, toproc_stream);
}
if (fromproc_needed) {
fromprocess_fptr = fdopen(pipe_from_proc[0], "r");
fromproc_stream = xsb_intern_fileptr(CTXTc fromprocess_fptr,callname,"pipe","r",CURRENT_CHARSET);
ctop_int(CTXTc 4, fromproc_stream);
}
if (fromstderr_needed) {
fromproc_stderr_fptr = fdopen(pipe_from_stderr[0], "r");
fromproc_stderr_stream
= xsb_intern_fileptr(CTXTc fromproc_stderr_fptr,callname,"pipe","r",CURRENT_CHARSET);
ctop_int(CTXTc 5, fromproc_stderr_stream);
}
ctop_int(CTXTc 6, pid_or_status);
xsb_process_table.process[tbl_pos].pid = pid_or_status;
xsb_process_table.process[tbl_pos].to_stream = toproc_stream;
xsb_process_table.process[tbl_pos].from_stream = fromproc_stream;
xsb_process_table.process[tbl_pos].stderr_stream = fromproc_stderr_stream;
concat_array(CTXTc params, " ",
xsb_process_table.process[tbl_pos].cmdline,MAX_CMD_LEN);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case GET_PROCESS_TABLE: { /* sys_system(3, X). X is bound to the list
of the form [process(Pid,To,From,Stderr,Cmdline), ...] */
int i;
prolog_term table_term_tail, listHead;
prolog_term table_term=reg_term(CTXTc 2);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!isref(table_term))
xsb_abort("[GET_PROCESS_TABLE] Arg 1 must be a variable");
table_term_tail = table_term;
for (i=0; i<MAX_SUBPROC_NUMBER; i++) {
if (!FREE_PROC_TABLE_CELL(xsb_process_table.process[i].pid)) {
c2p_list(CTXTc table_term_tail); /* make it into a list */
listHead = p2p_car(table_term_tail);
c2p_functor(CTXTc "process", 5, listHead);
c2p_int(CTXTc xsb_process_table.process[i].pid, p2p_arg(listHead,1));
c2p_int(CTXTc xsb_process_table.process[i].to_stream, p2p_arg(listHead,2));
c2p_int(CTXTc xsb_process_table.process[i].from_stream, p2p_arg(listHead,3));
c2p_int(CTXTc xsb_process_table.process[i].stderr_stream,
p2p_arg(listHead,4));
c2p_string(CTXTc xsb_process_table.process[i].cmdline, p2p_arg(listHead,5));
table_term_tail = p2p_cdr(table_term_tail);
}
}
c2p_nil(CTXTc table_term_tail); /* bind tail to nil */
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return p2p_unify(CTXTc table_term, reg_term(CTXTc 2));
}
case PROCESS_STATUS: {
prolog_term pid_term=reg_term(CTXTc 2), status_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isointeger(pid_term)))
xsb_abort("[PROCESS_STATUS] Arg 1 (process id) must be an integer");
pid = (int)oint_val(pid_term);
if (!isref(status_term))
xsb_abort("[PROCESS_STATUS] Arg 2 (process status) must be a variable");
switch (process_status(pid)) {
case RUNNING:
c2p_string(CTXTc "running", status_term);
break;
case STOPPED:
c2p_string(CTXTc "stopped", status_term);
break;
case EXITED_NORMALLY:
c2p_string(CTXTc "exited_normally", status_term);
break;
case EXITED_ABNORMALLY:
c2p_string(CTXTc "exited_abnormally", status_term);
break;
case ABORTED:
c2p_string(CTXTc "aborted", status_term);
break;
case INVALID:
c2p_string(CTXTc "invalid", status_term);
break;
default:
c2p_string(CTXTc "unknown", status_term);
}
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case PROCESS_CONTROL: {
/* sys_system(PROCESS_CONTROL, +Pid, +Signal). Signal: wait, kill */
int status;
prolog_term pid_term=reg_term(CTXTc 2), signal_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isointeger(pid_term)))
xsb_abort("[PROCESS_CONTROL] Arg 1 (process id) must be an integer");
pid = (int)oint_val(pid_term);
if (isstring(signal_term) && strcmp(string_val(signal_term), "kill")==0) {
if (KILL_FAILED(pid)) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
CloseHandle((HANDLE) pid);
#endif
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
if (isconstr(signal_term)
&& strcmp(p2c_functor(signal_term),"wait") == 0
&& p2c_arity(signal_term)==1) {
int exit_status;
if (WAIT(pid, status) < 0) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
exit_status = status;
#else
if (WIFEXITED(status))
exit_status = WEXITSTATUS(status);
else
exit_status = -1;
#endif
p2p_unify(CTXTc p2p_arg(signal_term,1), makeint(exit_status));
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
xsb_warn(CTXTc "[PROCESS_CONTROL] Arg 2: Invalid signal specification. Must be `kill' or `wait(Var)'");
return FALSE;
}
case LIST_DIRECTORY: {
/* assume all type- and mode-checking is done in Prolog */
prolog_term handle = reg_term(CTXTc 2); /* ref for handle */
char *dir_name = ptoc_longstring(CTXTc 3); /* +directory name */
prolog_term filename = reg_term(CTXTc 4); /* reference for name of file */
if (is_var(handle))
return xsb_find_first_file(CTXTc handle,dir_name,filename);
else
return xsb_find_next_file(CTXTc handle,dir_name,filename);
}
default:
xsb_abort("[SYS_SYSTEM] Wrong call number (an XSB bug)");
} /* end case */
return TRUE;
}
int sys_syscall(CTXTdeclc int callno)
{
int result=-1;
struct stat stat_buff;
switch (callno) {
case SYS_exit: {
int exit_code;
exit_code = (int)ptoc_int(CTXTc 3);
xsb_error("\nXSB exited with exit code: %d", exit_code);
exit(exit_code); break;
}
case SYS_getpid :
#ifndef WIN_NT
result = getpid();
#else
result = _getpid();
#endif
break;
#if (!defined(WIN_NT))
case SYS_link :
result = link(ptoc_longstring(CTXTc 3), ptoc_longstring(CTXTc 4));
break;
#endif
case SYS_mkdir: {
#ifndef WIN_NT
/* create using mode 700 */
result = mkdir(ptoc_longstring(CTXTc 3), 0700);
#else
result = _mkdir(ptoc_longstring(CTXTc 3));
#endif
break;
}
case SYS_rmdir: {
#ifndef WIN_NT
result = rmdir(ptoc_longstring(CTXTc 3));
#else
result = _rmdir(ptoc_longstring(CTXTc 3));
#endif
break;
}
case SYS_unlink: result = unlink(ptoc_longstring(CTXTc 3)); break;
case SYS_chdir : result = chdir(ptoc_longstring(CTXTc 3)); break;
case SYS_access: {
switch(*ptoc_string(CTXTc 4)) {
case 'r': /* read permission */
result = access(ptoc_longstring(CTXTc 3), R_OK_XSB);
break;
case 'w': /* write permission */
result = access(ptoc_longstring(CTXTc 3), W_OK_XSB);
break;
case 'x': /* execute permission */
result = access(ptoc_longstring(CTXTc 3), X_OK_XSB);
break;
default:
result = -1;
}
break;
}
case SYS_stat : {
/* Who put this in??? What did s/he expect to get out of this call?
stat_buff is never returned (and what do you do with it in Prolog?)!!!
*/
result = stat(ptoc_longstring(CTXTc 3), &stat_buff);
break;
}
case SYS_rename:
result = rename(ptoc_longstring(CTXTc 3), ptoc_longstring(CTXTc 4));
break;
case SYS_cwd: {
char current_dir[MAX_CMD_LEN];
/* returns 0, if != NULL, 1 otherwise */
result = (getcwd(current_dir, MAX_CMD_LEN-1) == NULL);
if (result == 0)
ctop_string(CTXTc 3,current_dir);
break;
}
case SYS_filecopy: {
char *from = ptoc_longstring(CTXTc 3);
char *to = ptoc_longstring(CTXTc 4);
result = (file_copy(CTXTc from,to,"w") == 0);
break;
}
case SYS_fileappend: {
char *from = ptoc_longstring(CTXTc 3);
char *to = ptoc_longstring(CTXTc 4);
result = (file_copy(CTXTc from,to,"a") == 0);
break;
}
case SYS_create: {
result = open(ptoc_longstring(CTXTc 3),O_CREAT|O_EXCL,S_IREAD|S_IWRITE);
if (result >= 0) close(result);
break;
}
case SYS_readlink: {
char *inpath = ptoc_longstring(CTXTc 3);
// char *outpath = file_readlink(CTXTc inpath);
char *outpath = file_readlink(inpath);
if (outpath == NULL) {
// memory for this case is dealocated in file_readlink in pathname_xsb.c
result = -1;
} else {
ctop_string(CTXTc 4,outpath);
mem_dealloc(outpath,MAXPATHLEN,OTHER_SPACE);
result = 0;
}
break;
}
case SYS_realpath: {
char *inpath = ptoc_longstring(CTXTc 3);
char *outpath = file_realpath(inpath);
if (outpath == NULL) {
// memory for this case is dealocated in file_readlink in pathname_xsb.c
result = -1;
} else {
ctop_string(CTXTc 4,outpath);
mem_dealloc(outpath,MAXPATHLEN,OTHER_SPACE);
result = 0;
}
break;
}
case STATISTICS_2: {
get_statistics(CTXT);
break;
}
case SYS_epoch_seconds: {
ctop_int(CTXTc 3,(Integer)time(0));
break;
}
case SYS_epoch_msecs: {
static struct timeb time_epoch;
ftime(&time_epoch);
ctop_int(CTXTc 3,(Integer)(time_epoch.time));
ctop_int(CTXTc 4,(Integer)(time_epoch.millitm));
break;
}
case SYS_main_memory_size: {
size_t memory_size = getMemorySize();
ctop_int(CTXTc 3,(UInteger)memory_size);
break;
}
default: xsb_abort("[SYS_SYSCALL] Unknown system call number, %d", callno);
}
return result;
}
int sys_syscall(CTXTdeclc int callno)
{
int result=-1;
struct stat stat_buff;
switch (callno) {
case SYS_exit: {
int exit_code;
exit_code = ptoc_int(CTXTc 3);
xsb_mesg("\nXSB exited with exit code: %d", exit_code);
exit(exit_code); break;
}
#if (!defined(WIN_NT))
case SYS_getpid : result = getpid(); break;
case SYS_link : result = link(ptoc_longstring(CTXTc 3), ptoc_longstring(CTXTc 4)); break;
#endif
case SYS_mkdir: {
#ifndef WIN_NT
/* create using mode 700 */
result = mkdir(ptoc_longstring(CTXTc 3), 0700);
#else
result = _mkdir(ptoc_longstring(CTXTc 3));
#endif
break;
}
case SYS_rmdir: {
#ifndef WIN_NT
result = rmdir(ptoc_longstring(CTXTc 3));
#else
result = _rmdir(ptoc_longstring(CTXTc 3));
#endif
break;
}
case SYS_unlink: result = unlink(ptoc_longstring(CTXTc 3)); break;
case SYS_chdir : result = chdir(ptoc_longstring(CTXTc 3)); break;
case SYS_access: {
switch(*ptoc_string(CTXTc 4)) {
case 'r': /* read permission */
result = access(ptoc_longstring(CTXTc 3), R_OK_XSB);
break;
case 'w': /* write permission */
result = access(ptoc_longstring(CTXTc 3), W_OK_XSB);
break;
case 'x': /* execute permission */
result = access(ptoc_longstring(CTXTc 3), X_OK_XSB);
break;
default:
result = -1;
}
break;
}
case SYS_stat : {
/* Who put this in??? What did s/he expect to get out of this call?
stat_buff is never returned (and what do you do with it in Prolog?)!!!
*/
result = stat(ptoc_longstring(CTXTc 3), &stat_buff);
break;
}
case SYS_rename:
result = rename(ptoc_longstring(CTXTc 3), ptoc_longstring(CTXTc 4));
break;
case SYS_cwd: {
char current_dir[MAX_CMD_LEN];
/* returns 0, if != NULL, 1 otherwise */
result = (getcwd(current_dir, MAX_CMD_LEN-1) == NULL);
if (result == 0)
ctop_string(CTXTc 3,current_dir);
break;
}
case SYS_filecopy: {
char *from = ptoc_longstring(CTXTc 3);
char *to = ptoc_longstring(CTXTc 4);
result = file_copy(from,to);
break;
}
case SYS_create: {
result = open(ptoc_longstring(CTXTc 3),O_CREAT|O_EXCL,S_IREAD|S_IWRITE);
if (result >= 0) close(result);
break;
}
case STATISTICS_2: {
get_statistics(CTXT);
break;
}
default: xsb_abort("[SYS_SYSCALL] Unknown system call number, %d", callno);
}
return result;
}
DllExport int call_conv openConnection(void)
{
int (*connectDriver)(struct xsb_connectionHandle*);
char* (*errorMesgDriver)();
struct xsb_connectionHandle* cHandle;
char *handle, *driver, *server, *database=NULL, *user, *password, *dsn=NULL;
int val;
cHandle = NULL;
handle = ptoc_string(CTXTc 1);
driver = ptoc_string(CTXTc 2);
server = ptoc_string(CTXTc 3);
if (strlen(server) == 0)
dsn = ptoc_string(CTXTc 4);
else
database = ptoc_string(CTXTc 4);
user = ptoc_string(CTXTc 5);
password = ptoc_string(CTXTc 6);
if (isConnectionHandle(handle) != NULL) {
errorMesg = "XSB_DBI ERROR: Connection handle already exists";
errorNumber = "XSB_DBI_006";
return FALSE;
}
if ( MAX_CONNECTIONS <= numCHandles ){
errorMesg = "XSB_DBI ERROR: Too many open connections";
errorNumber = "XSB_DBI_014";
return FALSE;
}
if (getDriverFunction(driver, CONNECT) != NULL)
connectDriver = getDriverFunction(driver, CONNECT)->connectDriver;
else
return FALSE;
cHandle = (struct xsb_connectionHandle *)malloc(sizeof(struct xsb_connectionHandle));
cHandle->handle = (char *)malloc(sizeof(char)*(strlen(handle)+1));
strcpy(cHandle->handle,handle);
cHandle->driver = driver;
if (strlen(server) == 0) {
cHandle->dsn = dsn;
cHandle->server = NULL;
cHandle->database = NULL;
}
else {
cHandle->server = server;
cHandle->database = database;
cHandle->dsn = NULL;
}
cHandle->user = user;
cHandle->password = password;
CHandles[numCHandles++] = cHandle;
if ((val = connectDriver(cHandle)) != SUCCESS) {
if (getDriverFunction(cHandle->driver, ERROR_MESG) != NULL)
errorMesgDriver = getDriverFunction(cHandle->driver, ERROR_MESG)->errorMesgDriver;
else
return FALSE;
errorMesg = errorMesgDriver();
errorNumber = "XSB_DBI_000";
freeConnectionHandle(cHandle, numCHandles - 1);
return FALSE;
}
return TRUE;
}
DllExport int call_conv executePreparedStatement(void)
{
struct xsb_data** (*executeStmtDriver)(struct xsb_data**, struct xsb_queryHandle*);
char* (*errorMesgDriver)();
void (*freeResultDriver)();
struct xsb_queryHandle* qHandle;
struct xsb_connectionHandle* cHandle;
struct xsb_data** bindValues;
struct xsb_data** result;
prolog_term bindList, returnList, element;
char *queryHandle, *chandle;
int i, val;
queryHandle = ptoc_string(CTXTc 1);
bindList = reg_term(CTXTc 2);
returnList = reg_term(CTXTc 3);
qHandle = NULL;
cHandle = NULL;
bindValues = NULL;
result = NULL;
if ((qHandle = isQueryHandle(queryHandle)) == NULL) {
errorMesg = "XSB_DBI ERROR: Query handle does not exist";
errorNumber = "XSB_DBI_005";
return FALSE;
}
if (qHandle->state == QUERY_BEGIN) {
bindValues =
(struct xsb_data **)malloc(qHandle->numParams * sizeof(struct xsb_data *));
for (i = 0 ; i < qHandle->numParams ; i++)
bindValues[i] = NULL;
for (i = 0 ; i < qHandle->numParams ; i++) {
bindValues[i] = (struct xsb_data *)malloc(sizeof(struct xsb_data));
bindValues[i]->val = NULL;
if (is_nil(bindList)) {
errorMesg = "XSB_DBI ERROR: Not all paremeters supplied";
errorNumber = "XSB_DBI_008";
freeBindValues(bindValues,qHandle->numParams);
return FALSE;
}
element = p2p_car(bindList);
if (is_string(element)) {
bindValues[i]->type = STRING_TYPE;
bindValues[i]->length = strlen(p2c_string(element));
bindValues[i]->val = (union xsb_value *)malloc(sizeof(union xsb_value));
bindValues[i]->val->str_val = p2c_string(element);
}
else if (is_int(element)) {
bindValues[i]->type = INT_TYPE;
bindValues[i]->val = (union xsb_value *)malloc(sizeof(union xsb_value));
bindValues[i]->val->i_val = p2c_int(element);
}
else if (is_float(element)) {
bindValues[i]->type = FLOAT_TYPE;
bindValues[i]->val = (union xsb_value *)malloc(sizeof(union xsb_value));
bindValues[i]->val->f_val = p2c_float(element);
}
else if (is_functor(element)) {
}
else if (is_var(element)) {
errorMesg = "XSB_DBI ERROR: Unbound variable in parameter list";
errorNumber = "XSB_DBI_009";
freeBindValues(bindValues,qHandle->numParams);
return FALSE;
}
bindList = p2p_cdr(bindList);
}
}
if (getDriverFunction(qHandle->connHandle->driver, EXEC_PREPARE) != NULL)
executeStmtDriver =
getDriverFunction(qHandle->connHandle->driver, EXEC_PREPARE)->executeStmtDriver;
else{
freeBindValues(bindValues,qHandle->numParams);
return FALSE;
}
result = executeStmtDriver(bindValues, qHandle);
freeBindValues(bindValues,qHandle->numParams);
if (result == NULL && qHandle->state == QUERY_BEGIN) {
if (getDriverFunction(qHandle->connHandle->driver, ERROR_MESG) != NULL)
errorMesgDriver =
getDriverFunction(qHandle->connHandle->driver, ERROR_MESG)->errorMesgDriver;
else
return FALSE;
errorMesg = errorMesgDriver();
if (errorMesg != NULL)
return FALSE;
}
val = bindReturnList(returnList, result, qHandle);
if (result == NULL) {
qHandle->state = QUERY_BEGIN;
}
else {
if (getDriverFunction(qHandle->connHandle->driver, FREE_RESULT) != NULL)
freeResultDriver = getDriverFunction(qHandle->connHandle->driver, FREE_RESULT)->freeResultDriver;
else
return FALSE;
freeResultDriver(result, qHandle->numResultCols);
}
if (val == TOO_MANY_RETURN_COLS || val == TOO_FEW_RETURN_COLS || val == INVALID_RETURN_LIST)
return FALSE;
cHandle = qHandle->connHandle;
chandle = cHandle->handle;
if ((cHandle = isConnectionHandle(chandle)) != NULL) {
if (getDriverFunction(cHandle->driver, ERROR_MESG) != NULL)
errorMesgDriver =
getDriverFunction(cHandle->driver, ERROR_MESG)->errorMesgDriver;
else
return FALSE;
errorMesg = errorMesgDriver();
errorNumber = "XSB_DBI_000";
}
/*
if (errorMesg == NULL && (val == RESULT_NONEMPTY_OR_NOT_REQUESTED
|| val == RESULT_EMPTY_BUT_REQUESTED)){
*/
if (errorMesg == NULL && val == RESULT_NONEMPTY_OR_NOT_REQUESTED) {
return TRUE;
}
else
return FALSE;
}
static int socket_connect(CTXTdeclc int *rc, int timeout) {
int error;
socklen_t len;
SOCKET sock_handle;
int domain, portnum;
SOCKADDR_IN socket_addr;
domain = (int)ptoc_int(CTXTc 2);
sock_handle = (SOCKET) ptoc_int(CTXTc 3);
portnum = (int)ptoc_int(CTXTc 4);
/** this may not set domain to a valid value; in this case the connect() will fail */
translate_domain(domain, &domain);
/*** prepare to connect ***/
FillWithZeros(socket_addr);
socket_addr.sin_port = htons((unsigned short)portnum);
socket_addr.sin_family = AF_INET;
socket_addr.sin_addr.s_addr =
inet_addr((char*)get_host_IP(ptoc_string(CTXTc 5)));
if (timeout > 0) {
/* Set up timeout */
if(! SET_SOCKET_BLOCKING(sock_handle, block_false)) {
xsb_error("Cannot save options");
return TIMER_SETUP_ERR;
}
/* This will return immediately */
*rc = connect(sock_handle,(PSOCKADDR)&socket_addr,sizeof(socket_addr));
error = XSB_SOCKET_ERRORCODE;
/* restore flags */
if(! SET_SOCKET_BLOCKING(sock_handle, block_true)) {
xsb_error("Cannot restore the flags: %d (0x%x)", XSB_SOCKET_ERRORCODE, XSB_SOCKET_ERRORCODE);
return TIMER_SETUP_ERR;
}
/* return and indicate an error immediately unless the connection
* was successful or the connect is still in progress. */
if(*rc < 0 && error != EINPROGRESS && error != EWOULDBLOCK) {
*rc = error;
return NORMAL_TERMINATION; /* Since it didn't time out */
}
/* Wait until the connect is completed (or a timeout occurs) */
error = write_select(sock_handle, timeout);
if(error == 0) {
closesocket(sock_handle);
*rc = XSB_SOCKET_ERRORCODE;
return TIMED_OUT;
}
/* Get the return code from the connect */
len=sizeof(error);
error = GETSOCKOPT(sock_handle, SOL_SOCKET, SO_ERROR, &error, &len);
if(error < 0) {
xsb_error("GETSOCKOPT failed");
*rc = error;
return NORMAL_TERMINATION; /* Since it didn't time out */
}
/* error=0 means success, otherwise it contains the errno */
if(error) {
*rc = error;
return NORMAL_TERMINATION; /* Since it didn't time out */
}
*rc = (int)sock_handle;
return NORMAL_TERMINATION;
} else {
*rc = connect(sock_handle,(PSOCKADDR)&socket_addr,sizeof(socket_addr));
return NORMAL_TERMINATION;
}
}
/* in order to save builtin numbers, create a single socket function with
* options socket_request(SockOperation,....) */
xsbBool xsb_socket_request(CTXTdecl)
{
int ecode = 0; /* error code for socket ops */
int timeout_flag;
SOCKET sock_handle;
int domain, portnum;
SOCKADDR_IN socket_addr;
struct linger sock_linger_opt;
int rc;
char *message_buffer = NULL; /* initialized to keep compiler happy */
UInteger msg_len = 0; /* initialized to keep compiler happy */
char char_read;
switch (ptoc_int(CTXTc 1)) {
case SOCKET_ROOT: /* this is the socket() request */
/* socket_request(SOCKET_ROOT,+domain,-socket_fd,-Error,_,_,_)
Currently only AF_INET domain */
domain = (int)ptoc_int(CTXTc 2);
if (!translate_domain(domain, &domain)) {
return FALSE;
}
sock_handle = socket(domain, SOCK_STREAM, IPPROTO_TCP);
/* error handling */
if (BAD_SOCKET(sock_handle)) {
ecode = XSB_SOCKET_ERRORCODE;
perror("SOCKET_REQUEST");
} else {
ecode = SOCK_OK;
}
ctop_int(CTXTc 3, (SOCKET) sock_handle);
return set_error_code(CTXTc ecode, 4, "SOCKET_REQUEST");
case SOCKET_BIND:
/* socket_request(SOCKET_BIND,+domain,+sock_handle,+port,-Error,_,_)
Currently only supports AF_INET */
sock_handle = (SOCKET) ptoc_int(CTXTc 3);
portnum = (int)ptoc_int(CTXTc 4);
domain = (int)ptoc_int(CTXTc 2);
if (!translate_domain(domain, &domain)) {
return FALSE;
}
/* Bind server to the agreed upon port number.
** See commdef.h for the actual port number. */
FillWithZeros(socket_addr);
socket_addr.sin_port = htons((unsigned short)portnum);
socket_addr.sin_family = AF_INET;
#ifndef WIN_NT
socket_addr.sin_addr.s_addr = htonl(INADDR_ANY);
#endif
rc = bind(sock_handle, (PSOCKADDR) &socket_addr, sizeof(socket_addr));
/* error handling */
if (SOCKET_OP_FAILED(rc)) {
ecode = XSB_SOCKET_ERRORCODE;
perror("SOCKET_BIND");
} else
ecode = SOCK_OK;
return set_error_code(CTXTc ecode, 5, "SOCKET_BIND");
case SOCKET_LISTEN:
/* socket_request(SOCKET_LISTEN,+sock_handle,+length,-Error,_,_,_) */
sock_handle = (SOCKET) ptoc_int(CTXTc 2);
rc = listen(sock_handle, (int)ptoc_int(CTXTc 3));
/* error handling */
if (SOCKET_OP_FAILED(rc)) {
ecode = XSB_SOCKET_ERRORCODE;
perror("SOCKET_LISTEN");
} else
ecode = SOCK_OK;
return set_error_code(CTXTc ecode, 4, "SOCKET_LISTEN");
case SOCKET_ACCEPT:
timeout_flag = socket_accept(CTXTc (SOCKET *)&rc, (int)pflags[SYS_TIMER]);
if (timeout_flag == TIMED_OUT) {
return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
} else {
/* error handling */
if (BAD_SOCKET(rc)) {
ecode = XSB_SOCKET_ERRORCODE;
perror("SOCKET_ACCEPT");
sock_handle = rc; /* shut up warning */
} else {
sock_handle = rc; /* accept() returns sock_out */
ecode = SOCK_OK;
}
ctop_int(CTXTc 3, (SOCKET) sock_handle);
return set_error_code(CTXTc ecode, 4, "SOCKET_ACCEPT");
}
case SOCKET_CONNECT: {
/* socket_request(SOCKET_CONNECT,+domain,+sock_handle,+port,
+hostname,-Error) */
timeout_flag = socket_connect(CTXTc &rc, (int)pflags[SYS_TIMER]);
if (timeout_flag == TIMED_OUT) {
return set_error_code(CTXTc TIMEOUT_ERR, 6, "SOCKET_CONNECT");
} else if (timeout_flag == TIMER_SETUP_ERR) {
return set_error_code(CTXTc TIMER_SETUP_ERR, 6, "SOCKET_CONNECT");
} else {
/* error handling */
if (SOCKET_OP_FAILED(rc)) {
ecode = XSB_SOCKET_ERRORCODE;
perror("SOCKET_CONNECT");
/* close, because if connect() fails then socket becomes unusable */
closesocket(ptoc_int(CTXTc 3));
} else {
ecode = SOCK_OK;
}
return set_error_code(CTXTc ecode, 6, "SOCKET_CONNECT");
}
}
case SOCKET_CLOSE:
/* socket_request(SOCKET_CLOSE,+sock_handle,-Error,_,_,_,_) */
sock_handle = (SOCKET)ptoc_int(CTXTc 2);
/* error handling */
rc = closesocket(sock_handle);
if (SOCKET_OP_FAILED(rc)) {
ecode = XSB_SOCKET_ERRORCODE;
perror("SOCKET_CLOSE");
} else
ecode = SOCK_OK;
return set_error_code(CTXTc ecode, 3, "SOCKET_CLOSE");
case SOCKET_RECV:
/* socket_request(SOCKET_RECV,+Sockfd, -Msg, -Error,_,_,_) */
// TODO: consider adding protection against interrupts, EINTR, like
// in socket_get0.
timeout_flag = socket_recv(CTXTc &rc, &message_buffer, &msg_len, (int)pflags[SYS_TIMER]);
if (timeout_flag == TIMED_OUT) {
return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
} else {
/* error handling */
switch (rc) {
case SOCK_OK:
ecode = SOCK_OK;
break;
case SOCK_READMSG_FAILED:
ecode = XSB_SOCKET_ERRORCODE;
perror("SOCKET_RECV");
break;
case SOCK_READMSG_EOF:
ecode = SOCK_EOF;
break;
case SOCK_HEADER_LEN_MISMATCH:
ecode = XSB_SOCKET_ERRORCODE;
break;
default:
xsb_abort("XSB bug: [SOCKET_RECV] invalid return code from readmsg");
}
if (message_buffer != NULL) {
/* use message_buffer+XSB_MSG_HEADER_LENGTH because the first
XSB_MSG_HEADER_LENGTH bytes are for the message length header */
ctop_string(CTXTc 3, (char*)message_buffer+XSB_MSG_HEADER_LENGTH);
mem_dealloc(message_buffer,msg_len,OTHER_SPACE);
} else { /* this happens at the end of a file */
ctop_string(CTXTc 3, (char*)"");
}
return set_error_code(CTXTc ecode, 4, "SOCKET_RECV");
}
case SOCKET_SEND:
/* socket_request(SOCKET_SEND,+Sockfd, +Msg, -Error,_,_,_) */
timeout_flag = socket_send(CTXTc &rc, (int)pflags[SYS_TIMER]);
if (timeout_flag == TIMED_OUT) {
return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
} else {
/* error handling */
if (SOCKET_OP_FAILED(rc)) {
ecode = XSB_SOCKET_ERRORCODE;
perror("SOCKET_SEND");
} else {
ecode = SOCK_OK;
}
return set_error_code(CTXTc ecode, 4, "SOCKET_SEND");
}
case SOCKET_GET0:
/* socket_request(SOCKET_GET0,+Sockfd,-C,-Error,_,_,_) */
message_buffer = &char_read;
timeout_flag = socket_get0(CTXTc &rc, message_buffer, (int)pflags[SYS_TIMER]);
if (timeout_flag == TIMED_OUT) {
return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
} else {
/*error handling */
switch (rc) {
case 1:
ctop_int(CTXTc 3,(unsigned char)message_buffer[0]);
ecode = SOCK_OK;
break;
case 0:
ecode = SOCK_EOF;
break;
default:
ctop_int(CTXTc 3,-1);
perror("SOCKET_GET0");
ecode = XSB_SOCKET_ERRORCODE;
}
return set_error_code(CTXTc ecode, 4, "SOCKET_GET0");
}
case SOCKET_PUT:
/* socket_request(SOCKET_PUT,+Sockfd,+C,-Error_,_,_) */
timeout_flag = socket_put(CTXTc &rc, (int)pflags[SYS_TIMER]);
if (timeout_flag == TIMED_OUT) {
return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
} else {
/* error handling */
if (rc == 1) {
ecode = SOCK_OK;
} else if (SOCKET_OP_FAILED(rc)) {
ecode = XSB_SOCKET_ERRORCODE;
perror("SOCKET_PUT");
}
return set_error_code(CTXTc ecode, 4, "SOCKET_PUT");
}
case SOCKET_SET_OPTION: {
/* socket_request(SOCKET_SET_OPTION,+Sockfd,+OptionName,+Value,_,_,_) */
char *option_name = ptoc_string(CTXTc 3);
sock_handle = (SOCKET)ptoc_int(CTXTc 2);
/* Set the "linger" parameter to a small number of seconds */
if (0==strcmp(option_name,"linger")) {
int linger_time=(int)ptoc_int(CTXTc 4);
if (linger_time < 0) {
sock_linger_opt.l_onoff = FALSE;
sock_linger_opt.l_linger = 0;
} else {
sock_linger_opt.l_onoff = TRUE;
sock_linger_opt.l_linger = linger_time;
}
if (SETSOCKOPT(sock_handle, SOL_SOCKET, SO_LINGER,
&sock_linger_opt, sizeof(sock_linger_opt))
< 0) {
xsb_warn(CTXTc "[SOCKET_SET_OPTION] Cannot set socket linger time");
return FALSE;
}
}else {
xsb_warn(CTXTc "[SOCKET_SET_OPTION] Invalid option, `%s'", option_name);
return FALSE;
}
return TRUE;
}
case SOCKET_SET_SELECT: {
/*socket_request(SOCKET_SET_SELECT,+connection_name,
+R_sockfd,+W_sockfd,+E_sockfd) */
prolog_term R_sockfd, W_sockfd, E_sockfd;
int i, connection_count;
int rmax_fd=0, wmax_fd=0, emax_fd=0;
char *connection_name = ptoc_string(CTXTc 2);
/* bind fds to input arguments */
R_sockfd = reg_term(CTXTc 3);
W_sockfd = reg_term(CTXTc 4);
E_sockfd = reg_term(CTXTc 5);
/* initialize the array of connect_t structure for select call */
init_connections(CTXT);
SYS_MUTEX_LOCK(MUTEX_SOCKETS);
/* check whether the same connection name exists */
for (i=0;i<MAXCONNECT;i++) {
if ((connections[i].empty_flag==FALSE) &&
(strcmp(connection_name,connections[i].connection_name)==0))
xsb_abort("[SOCKET_SET_SELECT] Connection `%s' already exists!",
connection_name);
}
/* check whether there is empty slot left for connection */
if ((connection_count=checkslot())<MAXCONNECT) {
if (connections[connection_count].connection_name == NULL) {
connections[connection_count].connection_name = connection_name;
connections[connection_count].empty_flag = FALSE;
/* call the utility function separately to take the fds in */
list_sockfd(R_sockfd, &connections[connection_count].readset,
&rmax_fd, &connections[connection_count].read_fds,
&connections[connection_count].sizer);
list_sockfd(W_sockfd, &connections[connection_count].writeset,
&wmax_fd, &connections[connection_count].write_fds,
&connections[connection_count].sizew);
list_sockfd(E_sockfd, &connections[connection_count].exceptionset,
&emax_fd,&connections[connection_count].exception_fds,
&connections[connection_count].sizee);
connections[connection_count].maximum_fd =
xsb_max(xsb_max(rmax_fd,wmax_fd), emax_fd);
} else
/* if this one is reached, it is probably a bug */
xsb_abort("[SOCKET_SET_SELECT] All connections are busy!");
} else
xsb_abort("[SOCKET_SET_SELECT] Max number of collections exceeded!");
SYS_MUTEX_UNLOCK(MUTEX_SOCKETS);
return TRUE;
}
case SOCKET_SELECT: {
/* socket_request(SOCKET_SELECT,+connection_name, +timeout
-avail_rsockfds,-avail_wsockfds,
-avail_esockfds,-ecode)
Returns 3 prolog_terms for available socket fds */
prolog_term Avail_rsockfds, Avail_wsockfds, Avail_esockfds;
prolog_term Avail_rsockfds_tail, Avail_wsockfds_tail, Avail_esockfds_tail;
int maxfd;
int i; /* index for connection_count */
char *connection_name = ptoc_string(CTXTc 2);
struct timeval *tv;
prolog_term timeout_term;
int timeout =0;
int connectname_found = FALSE;
int count=0;
SYS_MUTEX_LOCK(MUTEX_SOCKETS);
/* specify the time out */
timeout_term = reg_term(CTXTc 3);
if (isointeger(timeout_term)) {
timeout = (int)oint_val(timeout_term);
/* initialize tv */
tv = (struct timeval *)mem_alloc(sizeof(struct timeval),LEAK_SPACE);
tv->tv_sec = timeout;
tv->tv_usec = 0;
} else
tv = NULL; /* no timeouts */
/* initialize the prolog term */
Avail_rsockfds = p2p_new(CTXT);
Avail_wsockfds = p2p_new(CTXT);
Avail_esockfds = p2p_new(CTXT);
/* bind to output arguments */
Avail_rsockfds = reg_term(CTXTc 4);
Avail_wsockfds = reg_term(CTXTc 5);
Avail_esockfds = reg_term(CTXTc 6);
Avail_rsockfds_tail = Avail_rsockfds;
Avail_wsockfds_tail = Avail_wsockfds;
Avail_esockfds_tail = Avail_esockfds;
/*
// This was wrong. Lists are now made inside test_ready()
c2p_list(CTXTc Avail_rsockfds_tail);
c2p_list(CTXTc Avail_wsockfds_tail);
c2p_list(CTXTc Avail_esockfds_tail);
*/
for (i=0; i < MAXCONNECT; i++) {
/* find the matching connection_name to select */
if(connections[i].empty_flag==FALSE) {
if (strcmp(connection_name, connections[i].connection_name) == 0) {
connectname_found = TRUE;
count = i;
break;
}
}
}
if( i >= MAXCONNECT ) /* if no matching connection_name */
xsb_abort("[SOCKET_SELECT] connection `%s' doesn't exist",
connection_name);
/* compute maxfd for select call */
maxfd = connections[count].maximum_fd + 1;
/* FD_SET all sockets */
set_sockfd( CTXTc count );
/* test whether the socket fd is available */
rc = select(maxfd, &connections[count].readset,
&connections[count].writeset,
&connections[count].exceptionset, tv);
/* error handling */
if (rc == 0) /* timed out */
ecode = TIMEOUT_ERR;
else if (SOCKET_OP_FAILED(rc)) {
perror("SOCKET_SELECT");
ecode = XSB_SOCKET_ERRORCODE;
} else { /* no error */
ecode = SOCK_OK;
/* call the utility function to return the available socket fds */
test_ready(CTXTc &Avail_rsockfds_tail, &connections[count].readset,
connections[count].read_fds,connections[count].sizer);
test_ready(CTXTc &Avail_wsockfds_tail, &connections[count].writeset,
connections[count].write_fds,connections[count].sizew);
test_ready(CTXTc &Avail_esockfds_tail,&connections[count].exceptionset,
connections[count].exception_fds,connections[count].sizee);
}
SYS_MUTEX_UNLOCK(MUTEX_SOCKETS);
if (tv) mem_dealloc((struct timeval *)tv,sizeof(struct timeval),LEAK_SPACE);
SQUASH_LINUX_COMPILER_WARN(connectname_found) ;
return set_error_code(CTXTc ecode, 7, "SOCKET_SELECT");
}
case SOCKET_SELECT_DESTROY: {
/*socket_request(SOCKET_SELECT_DESTROY, +connection_name) */
char *connection_name = ptoc_string(CTXTc 2);
select_destroy(CTXTc connection_name);
return TRUE;
}
default:
xsb_warn(CTXTc "[SOCKET_REQUEST] Invalid socket request %d", (int) ptoc_int(CTXTc 1));
return FALSE;
}
/* This trick would report a bug, if a newly added case
doesn't have a return clause */
xsb_bug("SOCKET_REQUEST case %d has no return clause", ptoc_int(CTXTc 1));
}
DllExport int call_conv prepareStatement(void)
{
int (*prepareStmtDriver)(struct xsb_queryHandle*);
char* (*errorMesgDriver)();
prolog_term sqlQueryList;
char *chandle, *qhandle, *sqlQuery;
struct xsb_queryHandle* qHandle;
struct xsb_connectionHandle* cHandle;
int val;
chandle = ptoc_string(CTXTc 1);
qhandle = ptoc_string(CTXTc 2);
sqlQueryList = reg_term(CTXTc 3);
qHandle = NULL;
cHandle = NULL;
if ((cHandle = isConnectionHandle(chandle)) == NULL) {
errorMesg = "XSB_DBI ERROR: Connection handle does not exist";
errorNumber = "XSB_DBI_004";
return FALSE;
}
if ((qHandle = isQueryHandle(qhandle)) != NULL) {
errorMesg = "XSB_DBI ERROR: Query handle already exists";
errorNumber = "XSB_DBI_007";
return FALSE;
}
if ( MAX_QUERIES <= numQHandles ){
errorMesg = "XSB_DBI ERROR: Too many active queries";
errorNumber = "XSB_DBI_016";
return FALSE;
}
sqlQuery = buildSQLQuery(sqlQueryList);
qHandle = (struct xsb_queryHandle *)malloc(sizeof(struct xsb_queryHandle));
qHandle->connHandle = cHandle;
qHandle->query = sqlQuery;
qHandle->handle = (char *)malloc(sizeof(char)*(strlen(qhandle)+1));
strcpy(qHandle->handle,qhandle);
qHandle->state = QUERY_BEGIN;
if (getDriverFunction(cHandle->driver, PREPARE) != NULL)
prepareStmtDriver = getDriverFunction(cHandle->driver, PREPARE)->prepareStmtDriver;
else
return FALSE;
if ((val = prepareStmtDriver(qHandle)) != FAILURE) {
qHandle->numParams = val;
QHandles[numQHandles++] = qHandle;
}
else {
if (getDriverFunction(cHandle->driver, ERROR_MESG) != NULL) {
errorMesgDriver = getDriverFunction(cHandle->driver, ERROR_MESG)->errorMesgDriver;
errorMesg = errorMesgDriver();
} else
errorMesg = UNKNOWN_DB_ERROR;
errorNumber = "XSB_DBI_000";
return FALSE;
}
return TRUE;
}
/*-----------------------------------------------------------------------------*/
void ODBCConnect()
{
UCHAR *server;
UCHAR *pwd;
UCHAR *connectIn;
HDBC hdbc = NULL;
RETCODE rc;
/* if we don't yet have an environment, allocate one.*/
if (!henv) {
/* allocate environment handler*/
rc = SQLAllocEnv(&henv);
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
xsb_error("Environment allocation failed");
ctop_int(6, 0);
return;
}
/* SQLSetEnvAttr(henv, SQL_ATTR_ODBC_VERSION, (SQLPOINTER)SQL_OV_ODBC2,
SQL_IS_UINTEGER);
*/
LCursor = FCursor = NULL;
FCurNum = NULL;
nullStrAtom = makestring(string_find("NULL",1));
}
/* allocate connection handler*/
rc = SQLAllocConnect(henv, &hdbc);
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
xsb_error("Connection Resources Allocation Failed");
ctop_int(6, 0);
return;
}
if (!ptoc_int(2)) {
/* get server name, user id and password*/
server = (UCHAR *)ptoc_string(3);
strcpy(uid, (UCHAR *)ptoc_string(4));
pwd = (UCHAR *)ptoc_string(5);
/* connect to database*/
rc = SQLConnect(hdbc, server, SQL_NTS, uid, SQL_NTS, pwd, SQL_NTS);
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
SQLFreeConnect(hdbc);
xsb_error("Connection to server %s failed", server);
ctop_int(6, 0);
return;
}
} else {
/* connecting through driver using a connection string */
connectIn = (UCHAR *)ptoc_longstring(3);
rc = SQLDriverConnect(hdbc, NULL, connectIn, SQL_NTS, NULL, 0, NULL,SQL_DRIVER_NOPROMPT);
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
SQLFreeConnect(hdbc);
xsb_error("Connection to driver failed: %s", connectIn);
ctop_int(6, 0);
return;
}
}
serverConnected = 1;
ctop_int(6, (long)hdbc);
return;
}
