static int
wait_for_pid(pid_t pid, term_t code, wait_options *opts)
{ pid_t p2;
int status;
if ( opts->has_timeout && opts->timeout == 0.0 )
{ if ( (p2=waitpid(pid, &status, WNOHANG)) == pid )
return unify_exit_status(code, status);
else if ( p2 == 0 )
return PL_unify_atom(code, ATOM_timeout);
else
{ term_t PID;
error:
return ((PID = PL_new_term_ref()) &&
PL_put_integer(PID, pid) &&
pl_error(NULL, 0, "waitpid", ERR_ERRNO,
errno, "wait", "process", PID));
}
}
for(;;)
{ if ( (p2=waitpid(pid, &status, 0)) == pid )
return unify_exit_status(code, status);
if ( p2 == -1 && errno == EINTR )
{ if ( PL_handle_signals() < 0 )
return FALSE;
} else
{ goto error;
}
}
}
static int
mp_add_to_form(const char *name, size_t nlen,
const char *value, size_t len,
const char *file, void *closure)
{ term_t head = PL_new_term_ref();
term_t tail = (term_t) closure;
term_t val = PL_new_term_ref();
long vl;
double vf;
int rc;
atom_t aname = 0;
if ( isinteger(value, &vl, len) )
rc = PL_put_integer(val, vl);
else if ( isfloat(value, &vf, len) )
rc = PL_put_float(val, vf);
else
rc = PL_unify_chars(val, PL_ATOM|REP_UTF8, len, value);
rc = ( rc &&
PL_unify_list(tail, head, tail) &&
(aname = PL_new_atom_nchars(nlen, name)) &&
PL_unify_term(head,
PL_FUNCTOR, PL_new_functor(aname, 1),
PL_TERM, val) );
if ( aname )
PL_unregister_atom(aname);
return rc;
}
static HANDLE
find_process_from_pid(DWORD pid, const char *pred)
{ win_process *wp;
LOCK();
for(wp=processes; wp; wp=wp->next)
{ if ( wp->pid == pid )
{ HANDLE h = wp->handle;
UNLOCK();
return h;
}
}
UNLOCK();
if ( pred )
{ term_t ex = PL_new_term_ref();
PL_put_integer(ex, pid);
pl_error(NULL, 2, NULL, ERR_EXISTENCE,
"process", ex);
}
return (HANDLE)0;
}
/********************
* fact_field_term
********************/
static int
fact_field_term(OhmFact *fact, char *field, term_t term)
{
GValue *value;
int i;
double d;
char *s;
if ((value = ohm_fact_get(fact, field)) == NULL)
return FALSE;
switch (G_VALUE_TYPE(value)) {
case G_TYPE_INT:
i = g_value_get_int(value);
PL_put_integer(term, i);
break;
case G_TYPE_UINT:
i = g_value_get_uint(value);
PL_put_integer(term, i);
break;
case G_TYPE_LONG:
i = g_value_get_long(value);
PL_put_integer(term, i);
break;
case G_TYPE_ULONG:
i = g_value_get_ulong(value);
PL_put_integer(term, i);
break;
case G_TYPE_DOUBLE:
d = g_value_get_double(value);
PL_put_float(term, d);
break;
case G_TYPE_FLOAT:
d = 1.0 * g_value_get_float(value);
PL_put_float(term, d);
break;
case G_TYPE_STRING:
s = (char *)g_value_get_string(value);
PL_put_atom_chars(term, s);
break;
default:
return FALSE;
}
return TRUE;
}
static int
unify_uri_authority_components(term_t components,
size_t len, const pl_wchar_t *s)
{ const pl_wchar_t *end = &s[len];
const pl_wchar_t *e;
range user = {0};
range passwd = {0};
range host = {0};
range port = {0};
term_t t = PL_new_term_refs(5);
term_t av = t+1;
if ( (e=skip_not(s, end, L"@")) && e<end )
{ user.start = s;
user.end = e;
s = e+1;
if ( (e=skip_not(user.start, user.end, L":")) && e<user.end )
{ passwd.start = e+1;
passwd.end = user.end;
user.end = e;
}
}
host.start = s;
host.end = skip_not(s, end, L":");
if ( host.end < end )
{ port.start = host.end+1;
port.end = end;
}
if ( user.start )
unify_decoded_atom(av+0, &user, ESC_USER);
if ( passwd.start )
unify_decoded_atom(av+1, &passwd, ESC_PASSWD);
unify_decoded_atom(av+2, &host, ESC_HOST);
if ( port.start )
{ wchar_t *ep;
long pn = wcstol(port.start, &ep, 10);
if ( ep == port.end )
{ if ( !PL_put_integer(av+3, pn) )
return FALSE;
} else
{ unify_decoded_atom(av+3, &port, ESC_PORT);
}
}
return (PL_cons_functor_v(t, FUNCTOR_uri_authority4, av) &&
PL_unify(components, t));
}
static int
put_name_arity(term_t t, functor_t f)
{ GET_LD
FunctorDef fdef = valueFunctor(f);
term_t a;
if ( (a=PL_new_term_refs(2)) )
{ PL_put_atom(a+0, fdef->name);
return (PL_put_integer(a+1, fdef->arity) &&
PL_cons_functor(t, FUNCTOR_divide2, a+0, a+1));
}
return FALSE;
}
word
pl_write_term3(term_t stream, term_t term, term_t opts)
{ GET_LD
bool quoted = FALSE;
bool ignore_ops = FALSE;
int numbervars = -1; /* not set */
bool portray = FALSE;
term_t gportray = 0;
bool bqstring = truePrologFlag(PLFLAG_BACKQUOTED_STRING);
int charescape = -1; /* not set */
atom_t mname = ATOM_user;
atom_t attr = ATOM_nil;
atom_t blobs = ATOM_nil;
int priority = 1200;
bool partial = FALSE;
bool cycles = TRUE;
term_t varnames = 0;
int local_varnames;
IOSTREAM *s = NULL;
write_options options;
int rc;
memset(&options, 0, sizeof(options));
options.spacing = ATOM_standard;
if ( !scan_options(opts, 0, ATOM_write_option, write_term_options,
"ed, &ignore_ops, &numbervars, &portray, &gportray,
&charescape, &options.max_depth, &mname,
&bqstring, &attr, &priority, &partial, &options.spacing,
&blobs, &cycles, &varnames) )
fail;
if ( attr == ATOM_nil )
{ options.flags |= LD->prolog_flag.write_attributes;
} else
{ int mask = writeAttributeMask(attr);
if ( !mask )
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_write_option, opts);
options.flags |= mask;
}
if ( blobs != ATOM_nil )
{ int mask = writeBlobMask(blobs);
if ( mask < 0 )
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_write_option, opts);
options.flags |= mask;
}
if ( priority < 0 || priority > OP_MAXPRIORITY )
{ term_t t = PL_new_term_ref();
PL_put_integer(t, priority);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_operator_priority, t);
}
switch( options.spacing )
{ case ATOM_standard:
case ATOM_next_argument:
break;
default:
{ term_t t = PL_new_term_ref();
PL_put_atom(t, options.spacing);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_spacing, t);
}
}
options.module = lookupModule(mname);
if ( charescape == TRUE ||
(charescape == -1
#ifndef __YAP_PROLOG__
&& True(options.module, M_CHARESCAPE)
#endif
) )
options.flags |= PL_WRT_CHARESCAPES;
if ( gportray )
{ options.portray_goal = gportray;
if ( !put_write_options(opts, &options) ||
!PL_qualify(options.portray_goal, options.portray_goal) )
return FALSE;
portray = TRUE;
}
if ( numbervars == -1 )
numbervars = (portray ? TRUE : FALSE);
if ( quoted ) options.flags |= PL_WRT_QUOTED;
if ( ignore_ops ) options.flags |= PL_WRT_IGNOREOPS;
if ( numbervars ) options.flags |= PL_WRT_NUMBERVARS;
if ( portray ) options.flags |= PL_WRT_PORTRAY;
if ( bqstring ) options.flags |= PL_WRT_BACKQUOTED_STRING;
if ( !cycles ) options.flags |= PL_WRT_NO_CYCLES;
local_varnames = (varnames && False(&options, PL_WRT_NUMBERVARS));
BEGIN_NUMBERVARS(local_varnames);
if ( varnames )
{ if ( (rc=bind_varnames(varnames PASS_LD)) )
options.flags |= PL_WRT_VARNAMES;
else
goto out;
}
if ( !(rc=getTextOutputStream(stream, &s)) )
goto out;
options.out = s;
if ( !partial )
PutOpenToken(EOF, s); /* reset this */
if ( (options.flags & PL_WRT_QUOTED) && !(s->flags&SIO_REPPL) )
{ s->flags |= SIO_REPPL;
rc = writeTopTerm(term, priority, &options);
s->flags &= ~SIO_REPPL;
} else
{ rc = writeTopTerm(term, priority, &options);
}
out:
END_NUMBERVARS(local_varnames);
return (!s || streamStatus(s)) && rc;
}
static HDDEDATA CALLBACK
DdeCallback(UINT type, UINT fmt, HCONV hconv, HSZ hsz1, HSZ hsz2,
HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
switch(type)
{ case XTYP_CONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect3, MODULE_dde);
int rval;
PL_put_atom( argv+0, hszToAtom(hsz2)); /* topic */
PL_put_atom( argv+1, hszToAtom(hsz1)); /* service */
PL_put_integer(argv+2, dwData2 ? 1 : 0); /* same instance */
rval = PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
return (void *)rval;
}
case XTYP_CONNECT_CONFIRM:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect_confirm3, MODULE_dde);
int plhandle;
if ( (plhandle = allocServerHandle(hconv)) >= 0 )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect_confirm3, MODULE_dde);
PL_put_atom( argv+0, hszToAtom(hsz2)); /* topic */
PL_put_atom( argv+1, hszToAtom(hsz1)); /* service */
PL_put_integer(argv+2, plhandle);
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
}
return NULL;
}
case XTYP_DISCONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(1);
predicate_t pred = PL_pred(FUNCTOR_dde_disconnect1, MODULE_dde);
int plhandle = findServerHandle(hconv);
if ( plhandle >= 0 && plhandle < MAX_CONVERSATIONS )
server_handle[plhandle] = (HCONV)NULL;
PL_put_integer(argv+0, plhandle);
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
return NULL;
}
case XTYP_EXECUTE:
{ int plhandle = findServerHandle(hconv);
HDDEDATA rval = DDE_FNOTPROCESSED;
fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_execute3, MODULE_dde);
DEBUG(0, Sdprintf("Got XTYP_EXECUTE request\n"));
PL_put_integer(argv+0, plhandle);
PL_put_atom( argv+1, hszToAtom(hsz1));
unify_hdata( argv+2, hData);
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
rval = (void *) DDE_FACK;
PL_discard_foreign_frame(cid);
DdeFreeDataHandle(hData);
return rval;
}
case XTYP_REQUEST:
{ HDDEDATA data = (HDDEDATA) NULL;
if ( fmt == CF_TEXT )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(4);
predicate_t pred = PL_pred(FUNCTOR_dde_request4, MODULE_dde);
int plhandle = findServerHandle(hconv);
PL_put_integer( argv+0, plhandle);
PL_put_atom( argv+1, hszToAtom(hsz1)); /* topic */
PL_put_atom( argv+2, hszToAtom(hsz2)); /* item */
PL_put_variable(argv+3);
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
{ char *s;
if ( PL_get_chars(argv+3, &s, CVT_ALL) )
data = DdeCreateDataHandle(ddeInst, s, strlen(s)+1,
0, hsz2, CF_TEXT, 0);
}
PL_discard_foreign_frame(cid);
}
return data;
}
default:
;
}
return (HDDEDATA)NULL;
}
static HDDEDATA CALLBACK
DdeCallback(UINT type, UINT fmt, HCONV hconv, HSZ hsz1, HSZ hsz2,
HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{ GET_LD
DWORD ddeInst = LD->os.dde_instance;
switch(type)
{ case XTYP_CONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect3, MODULE_dde);
int rval;
if ( unify_hsz(ddeInst, argv+0, hsz2) && /* topic */
unify_hsz(ddeInst, argv+1, hsz1) && /* service */
PL_unify_integer(argv+2, dwData2 ? 1 : 0) ) /* same instance */
{ rval = PL_call_predicate(MODULE_dde, TRUE, pred, argv);
} else
{ rval = FALSE;
}
PL_discard_foreign_frame(cid);
return (void *)(intptr_t)rval;
}
case XTYP_CONNECT_CONFIRM:
{ int plhandle;
if ( (plhandle = allocServerHandle(hconv)) >= 0 )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect_confirm3, MODULE_dde);
if ( unify_hsz(ddeInst, argv+0, hsz2) && /* topic */
unify_hsz(ddeInst, argv+1, hsz1) && /* service */
PL_unify_integer(argv+2, plhandle) )
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
}
return NULL;
}
case XTYP_DISCONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(1);
predicate_t pred = PL_pred(FUNCTOR_dde_disconnect1, MODULE_dde);
int plhandle = findServerHandle(hconv);
if ( plhandle >= 0 && plhandle < MAX_CONVERSATIONS )
server_handle[plhandle] = (HCONV)NULL;
PL_put_integer(argv+0, plhandle);
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
return NULL;
}
case XTYP_EXECUTE:
{ int plhandle = findServerHandle(hconv);
HDDEDATA rval = DDE_FNOTPROCESSED;
fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_execute3, MODULE_dde);
DEBUG(1, Sdprintf("Got XTYP_EXECUTE request\n"));
PL_put_integer(argv+0, plhandle);
unify_hsz(ddeInst, argv+1, hsz1);
unify_hdata( argv+2, hData);
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
rval = (void *) DDE_FACK;
PL_discard_foreign_frame(cid);
DdeFreeDataHandle(hData);
return rval;
}
case XTYP_REQUEST:
{ HDDEDATA data = (HDDEDATA) NULL;
if ( fmt == CF_UNICODETEXT )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(4);
predicate_t pred = PL_pred(FUNCTOR_dde_request4, MODULE_dde);
int plhandle = findServerHandle(hconv);
PL_put_integer( argv+0, plhandle);
unify_hsz(ddeInst, argv+1, hsz1); /* topic */
unify_hsz(ddeInst, argv+2, hsz2); /* item */
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
{ wchar_t *s;
size_t len;
/* TBD: error handling */
if ( PL_get_wchars(argv+3, &len, &s, CVT_ALL) )
data = DdeCreateDataHandle(ddeInst,
(unsigned char*) s,
(DWORD)(len+1)*sizeof(wchar_t),
0, hsz2, CF_UNICODETEXT, 0);
}
PL_discard_foreign_frame(cid);
}
return data;
}
default:
;
}
return (HDDEDATA)NULL;
}
int
get_raw_form_data(char **data, size_t *lenp, int *must_free)
{ char *method;
char *s;
if ( (method = getenv("REQUEST_METHOD")) &&
strcmp(method, "POST") == 0 )
{ char *lenvar = getenv("CONTENT_LENGTH");
char *q;
long len;
if ( !lenvar )
{ term_t env = PL_new_term_ref();
PL_put_atom_chars(env, "CONTENT_LENGTH");
return pl_error(NULL, 0, NULL, ERR_EXISTENCE, "environment", env);
}
len = atol(lenvar);
if ( len < 0 )
{ term_t t = PL_new_term_ref();
if ( !PL_put_integer(t, len) )
return FALSE;
return pl_error(NULL, 0, "< 0", ERR_DOMAIN, t, "content_length");
}
if ( lenp )
{ if ( *lenp && (size_t)len > *lenp )
{ term_t t = PL_new_term_ref();
char msg[100];
if ( !PL_put_integer(t, len) )
return FALSE;
sprintf(msg, "> %ld", (long)*lenp);
return pl_error(NULL, 0, msg, ERR_DOMAIN, t, "content_length");
}
*lenp = len;
}
q = s = malloc(len+1);
if ( !q )
return pl_error(NULL, 0, NULL, ERR_RESOURCE, "memory");
while(len > 0)
{ int done;
while( (done=read(fileno(stdin), q, len)) > 0 )
{ q+=done;
len-=done;
}
if ( done < 0 )
{ int e;
term_t obj;
no_data:
e = errno;
obj = PL_new_term_ref();
free(s);
PL_put_nil(obj);
return pl_error(NULL, 0, NULL, ERR_ERRNO, e, "read", "cgi_data", obj);
}
}
if ( len == 0 )
{ *q = '\0';
*data = s;
*must_free = TRUE;
return TRUE;
} else
goto no_data;
} else if ( (s = getenv("QUERY_STRING")) )
{ if ( lenp )
*lenp = strlen(s);
*data = s;
*must_free = FALSE;
return TRUE;
} else
{ term_t env = PL_new_term_ref();
PL_put_atom_chars(env, "QUERY_STRING");
return pl_error(NULL, 0, NULL, ERR_EXISTENCE, "environment", env);
}
}
