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); } }