static int put_write_options(term_t opts_in, write_options *options) { GET_LD term_t newlist = PL_new_term_ref(); term_t precopt = PL_new_term_ref(); fid_t fid = PL_open_foreign_frame(); term_t head = PL_new_term_ref(); term_t tail = PL_copy_term_ref(opts_in); term_t newhead = PL_new_term_ref(); term_t newtail = PL_copy_term_ref(newlist); int rc = TRUE; while(rc && PL_get_list(tail, head, tail)) { if ( !PL_is_functor(head, FUNCTOR_priority1) ) rc = ( PL_unify_list(newtail, newhead, newtail) && PL_unify(newhead, head) ); } if ( rc ) { rc = ( PL_unify_list(newtail, head, newtail) && PL_unify_functor(head, FUNCTOR_priority1) && PL_get_arg(1, head, precopt) && PL_unify_nil(newtail) ); } if ( rc ) { options->write_options = newlist; options->prec_opt = precopt; } PL_close_foreign_frame(fid); return rc; }
static int parse_options(term_t options, p_options *info) { term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); term_t arg = PL_new_term_ref(); info->window = MAYBE; while(PL_get_list(tail, head, tail)) { atom_t name; int arity; if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 ) return type_error(head, "option"); _PL_get_arg(1, head, arg); if ( name == ATOM_stdin ) { if ( !get_stream(arg, info, &info->streams[0]) ) return FALSE; } else if ( name == ATOM_stdout ) { if ( !get_stream(arg, info, &info->streams[1]) ) return FALSE; } else if ( name == ATOM_stderr ) { if ( !get_stream(arg, info, &info->streams[2]) ) return FALSE; } else if ( name == ATOM_process ) { info->pid = PL_copy_term_ref(arg); } else if ( name == ATOM_detached ) { if ( !PL_get_bool(arg, &info->detached) ) return type_error(arg, "boolean"); } else if ( name == ATOM_cwd ) { #ifdef __WINDOWS__ if ( !PL_get_wchars(arg, NULL, &info->cwd, CVT_ATOM|CVT_STRING|CVT_EXCEPTION|BUF_MALLOC) ) return FALSE; #else if ( !PL_get_chars(arg, &info->cwd, CVT_ATOM|CVT_STRING|CVT_EXCEPTION|BUF_MALLOC|REP_FN) ) return FALSE; #endif } else if ( name == ATOM_window ) { if ( !PL_get_bool(arg, &info->window) ) return type_error(arg, "boolean"); } else if ( name == ATOM_env ) { if ( !parse_environment(arg, info) ) return FALSE; } else return domain_error(head, "process_option"); } if ( !PL_get_nil(tail) ) return type_error(tail, "list"); return TRUE; }
static foreign_t archive_property(term_t archive, term_t prop, term_t value) { archive_wrapper *ar; atom_t pn; const char *s; if ( !get_archive(archive, &ar) || !PL_get_atom_ex(prop, &pn) ) return FALSE; #ifdef HAVE_ARCHIVE_FILTER_COUNT if ( pn == ATOM_filter ) { int i, fcount = archive_filter_count(ar->archive); term_t tail = PL_copy_term_ref(value); term_t head = PL_new_term_ref(); for(i=0; i<fcount; i++) { s = archive_filter_name(ar->archive, i); if ( !s || strcmp(s, "none") == 0 ) continue; if ( !PL_unify_list(tail, head, tail) || !PL_unify_atom_chars(head, s) ) return FALSE; } return PL_unify_nil(tail); } #endif return FALSE; }
gboolean plgi_gbytes_to_term(GBytes *bytes, term_t t) { term_t list = PL_copy_term_ref(t); term_t head = PL_new_term_ref(); const guint8 *data; gsize size; gint i; PLGI_debug(" GBytes: %p ---> term: 0x%lx", bytes, t); data = g_bytes_get_data(bytes, &size); for ( i = 0; i < size; i++ ) { term_t a = PL_new_term_ref(); guint8 v = data[i]; if ( !plgi_guint8_to_term(v, a) ) { return FALSE; } if ( !(PL_unify_list(list, head, list) && PL_unify(head, a)) ) { return FALSE; } } if ( !PL_unify_nil(list) ) { return FALSE; } return TRUE; }
static int get_option(term_t t, int *opt) { term_t tail = PL_copy_term_ref(t); term_t head = PL_new_term_ref(); char *s; int option = 0; while( PL_get_list_ex(tail, head, tail) ) { if ( PL_get_chars(head, &s, CVT_ATOM|CVT_EXCEPTION) ) { if ( streq(s, "cons" ) ) option |= LOG_CONS; else if ( streq(s, "ndelay") ) option |= LOG_NDELAY; else if ( streq(s, "nowait") ) option |= LOG_NOWAIT; else if ( streq(s, "odelay") ) option |= LOG_ODELAY; #ifdef LOG_PERROR else if ( streq(s, "perror") ) option |= LOG_PERROR; #endif else if ( streq(s, "pid") ) option |= LOG_PID; else return PL_domain_error("syslog_option", head); } else return FALSE; } if ( PL_get_nil_ex(tail) ) { *opt = option; return TRUE; } return FALSE; }
static int get_show_map(term_t t, int *map) { int rc; term_t tail = PL_copy_term_ref(t); term_t head = PL_new_term_ref(); *map = 0; while (PL_get_list(tail, head, tail)) { atom_t a; if (!(rc = PL_get_atom_ex(head, &a))) { goto out; } if (a == ATOM_atoms) { *map |= clingo_show_type_atoms; } else if (a == ATOM_terms) { *map |= clingo_show_type_terms; } else if (a == ATOM_shown) { *map |= clingo_show_type_shown; } else if (a == ATOM_csp) { *map |= clingo_show_type_csp; } else if (a == ATOM_comp) { *map |= clingo_show_type_complement; } else { rc = PL_domain_error("clingo_show", head); goto out; } } if (!(rc = PL_get_nil_ex(tail))) { goto out; } out: return rc; }
gboolean plgi_term_to_gbytes(term_t t, GBytes **bytes) { GBytes *bytes0; term_t list = PL_copy_term_ref(t); term_t head = PL_new_term_ref(); guint8 *data; gsize len; gint i = 0; if ( PL_skip_list(list, 0, &len) != PL_LIST ) { return PL_type_error("list", t); } data = g_malloc0(len); while ( PL_get_list(list, head, list) ) { guint8 byte; if ( !plgi_term_to_guint8(head, &byte) ) { g_free(data); return FALSE; } data[i++] = byte; } bytes0 = g_bytes_new_take(data, len); PLGI_debug(" term: 0x%lx ---> GBytes: %p", t, bytes0); *bytes = bytes0; return TRUE; }
static int process_console_options(rlc_console_attr *attr, term_t options) { term_t tail = PL_copy_term_ref(options); term_t opt = PL_new_term_ref(); while(PL_get_list(tail, opt, tail)) { atom_t name; const char *s; int arity; if ( !PL_get_name_arity(opt, &name, &arity) ) return type_error(opt, "compound"); s = PL_atom_chars(name); if ( streq(s, "registry_key") && arity == 1 ) { TCHAR *key; if ( !get_chars_arg_ex(1, opt, &key) ) return FALSE; attr->key = key; } else return domain_error(opt, "window_option"); } if ( !PL_get_nil(tail) ) return type_error(tail, "list"); return TRUE; }
static foreign_t pl_group_info(term_t group, term_t info) { int gid; struct group grp, *pgrp; char buf[1000]; char *name; term_t members = PL_new_term_ref(); term_t tail = PL_copy_term_ref(members); term_t head = PL_new_term_ref(); char **memp; if ( PL_get_integer(group, &gid) ) { again1: errno = 0; if ( getgrgid_r(gid, &grp, buf, sizeof(buf), &pgrp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again1; } return error(errno, "info", "group", group); } } else if ( PL_get_chars(group, &name, CVT_ATOMIC|REP_MB) ) { again2: errno = 0; if ( getgrnam_r(name, &grp, buf, sizeof(buf), &pgrp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again2; } return error(errno, "info", "group", group); } } else { return PL_type_error("group", group); } if ( !pgrp ) return PL_existence_error("group", group); for(memp=pgrp->gr_mem; *memp; memp++) { if ( !PL_unify_list(tail, head, tail) || !PL_unify_chars(head, PL_ATOM|REP_MB, -1, *memp) ) return FALSE; } if ( !PL_unify_nil(tail) ) return FALSE; return PL_unify_term(info, PL_FUNCTOR_CHARS, "group_info", 4, PL_MBCHARS, pgrp->gr_name, PL_MBCHARS, pgrp->gr_passwd, PL_INT, (int)pgrp->gr_gid, PL_TERM, members ); }
/******************** * get_field_names ********************/ static int get_field_names(context_t *ctx, term_t pl_fields) { #define MAX_LENGTH 64 /* max length of a field name */ term_t pl_list, pl_head; int i, n, left, size; size_t dummy; char *p, *field; if ((n = list_length(pl_fields)) < 0) return EINVAL; size = n * sizeof(ctx->fields[0]) + n * MAX_LENGTH; if ((ctx->fields = malloc(size)) == NULL) return ENOMEM; memset(ctx->fields, 0, size); ctx->nfield = n; p = ((char *)ctx->fields) + n * sizeof(ctx->fields[0]); left = size - n * sizeof(ctx->fields[0]); pl_list = PL_copy_term_ref(pl_fields); /* XXX is this really needed? */ pl_head = PL_new_term_ref(); for (i = 0; i < n && PL_get_list(pl_list, pl_head, pl_list); i++) { switch (PL_term_type(pl_head)) { case PL_ATOM: if (!PL_get_atom_chars(pl_head, &field)) goto fail; break; case PL_STRING: if (!PL_get_string_chars(pl_head, &field, &dummy)) goto fail; break; default: goto fail; } ctx->fields[i] = p; size = snprintf(p, left, "%s", field); if (size + 1 > left) goto fail; p += size + 1; left -= size + 1; } return 0; fail: if (ctx->fields != NULL) { free(ctx->fields); ctx->fields = NULL; } return EINVAL; }
static foreign_t uri_query_components(term_t string, term_t list) { pl_wchar_t *s; size_t len; if ( PL_get_wchars(string, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) ) { return unify_query_string_components(list, len, s); } else if ( PL_is_list(list) ) { term_t tail = PL_copy_term_ref(list); term_t head = PL_new_term_ref(); term_t nv = PL_new_term_refs(2); charbuf out; int rc; fill_flags(); init_charbuf(&out); while( PL_get_list(tail, head, tail) ) { atom_t fname; int arity; if ( PL_is_functor(head, FUNCTOR_equal2) || PL_is_functor(head, FUNCTOR_pair2) ) { _PL_get_arg(1, head, nv+0); _PL_get_arg(2, head, nv+1); } else if ( PL_get_name_arity(head, &fname, &arity) && arity == 1 ) { PL_put_atom(nv+0, fname); _PL_get_arg(1, head, nv+1); } else { free_charbuf(&out); return type_error("name_value", head); } if ( out.here != out.base ) add_charbuf(&out, '&'); if ( !add_encoded_term_charbuf(&out, nv+0, ESC_QNAME) ) { free_charbuf(&out); return FALSE; } add_charbuf(&out, '='); if ( !add_encoded_term_charbuf(&out, nv+1, ESC_QVALUE) ) { free_charbuf(&out); return FALSE; } } rc = PL_unify_wchars(string, PL_ATOM, out.here-out.base, out.base); free_charbuf(&out); return rc; } else { return PL_get_wchars(string, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION); } return FALSE; }
// parse a list of Prolog terms and add arguments to an OSC message static int add_msg_args(lo_message msg, term_t list) { term_t head=PL_new_term_ref(); // copy term ref so as not to modify original list=PL_copy_term_ref(list); while (PL_get_list(list,head,list)) { atom_t name; int arity; const char *type; if (!PL_get_name_arity(head,&name,&arity)) return type_error(head,"term"); type=PL_atom_chars(name); switch (arity) { case 1: { term_t a1=PL_new_term_ref(); PL_get_arg(1,head,a1); if (!strcmp(type,"int")) { int x; if (!PL_get_integer(a1,&x)) return type_error(a1,"integer"); lo_message_add_int32(msg,x); } else if (!strcmp(type,"double")) { double x; if (!PL_get_float(a1,&x)) return type_error(a1,"float"); lo_message_add_double(msg,x); } else if (!strcmp(type,"string")) { char *x; if (!PL_get_chars(a1,&x,CVT_ATOM|CVT_STRING)) return type_error(a1,"string"); lo_message_add_string(msg,x); } else if (!strcmp(type,"symbol")) { char *x; if (!PL_get_chars(a1,&x,CVT_ATOM)) return type_error(a1,"atom"); lo_message_add_symbol(msg,x); } else if (!strcmp(type,"float")) { double x; if (!PL_get_float(a1,&x)) return type_error(a1,"float"); lo_message_add_float(msg,(float)x); } break; } case 0: { if (!strcmp(type,"true")) lo_message_add_true(msg); else if (!strcmp(type,"false")) lo_message_add_false(msg); else if (!strcmp(type,"nil")) lo_message_add_nil(msg); else if (!strcmp(type,"inf")) lo_message_add_infinitum(msg); break; } } } if (!PL_get_nil(list)) return type_error(list,"nil"); return TRUE; }
static int parse_environment(term_t t, p_options *info) { term_t tail = PL_copy_term_ref(t); term_t head = PL_new_term_ref(); term_t tmp = PL_new_term_ref(); ecbuf *eb = &info->envbuf; int count = 0; #ifndef __WINDOWS__ echar *q; char **ep; int c = 0; #endif assert(eb->size == 0); assert(eb->allocated == 0); assert(eb->buffer == NULL); while( PL_get_list(tail, head, tail) ) { echar *s; size_t len; if ( !PL_is_functor(head, FUNCTOR_eq2) ) return type_error(head, "environment_variable"); if ( !get_echars_arg_ex(1, head, tmp, &s, &len) ) return FALSE; add_ecbuf(eb, s, len); add_ecbuf(eb, ECHARS("="), 1); if ( !get_echars_arg_ex(2, head, tmp, &s, &len) ) return FALSE; add_ecbuf(eb, s, len); add_ecbuf(eb, ECHARS("\0"), 1); count++; } if ( !PL_get_nil(tail) ) return type_error(tail, "list"); #ifdef __WINDOWS__ add_ecbuf(eb, ECHARS("\0"), 1); #else info->envp = PL_malloc((count+1)*sizeof(char*)); for(ep=info->envp, c=0, q=eb->buffer; c<count; c++, ep++) { *ep = q; q += strlen(q)+1; } assert((size_t)(q-eb->buffer) == eb->size); *ep = NULL; #endif return TRUE; }
static int sha_options(term_t options, optval *result) { term_t opts = PL_copy_term_ref(options); term_t opt = PL_new_term_ref(); /* defaults */ memset(result, 0, sizeof(*result)); result->algorithm = ALGORITHM_SHA1; result->digest_size = SHA1_DIGEST_SIZE; while(PL_get_list(opts, opt, opts)) { atom_t aname; int arity; if ( PL_get_name_arity(opt, &aname, &arity) && arity == 1 ) { term_t a = PL_new_term_ref(); _PL_get_arg(1, opt, a); if ( aname == ATOM_algorithm ) { atom_t a_algorithm; result->algorithm_term = a; if ( !PL_get_atom(a, &a_algorithm) ) return pl_error(NULL, 0, NULL, ERR_TYPE, a, "algorithm"); if ( a_algorithm == ATOM_sha1 ) { result->algorithm = ALGORITHM_SHA1; result->digest_size = SHA1_DIGEST_SIZE; } else if ( a_algorithm == ATOM_sha224 ) { result->algorithm = ALGORITHM_SHA224; result->digest_size = SHA224_DIGEST_SIZE; } else if ( a_algorithm == ATOM_sha256 ) { result->algorithm = ALGORITHM_SHA256; result->digest_size = SHA256_DIGEST_SIZE; } else if ( a_algorithm == ATOM_sha384 ) { result->algorithm = ALGORITHM_SHA384; result->digest_size = SHA384_DIGEST_SIZE; } else if ( a_algorithm == ATOM_sha512 ) { result->algorithm = ALGORITHM_SHA512; result->digest_size = SHA512_DIGEST_SIZE; } else return pl_error(NULL, 0, NULL, ERR_DOMAIN, a, "algorithm"); } } else { return pl_error(NULL, 0, NULL, ERR_TYPE, opt, "option"); } } if ( !PL_get_nil(opts) ) return pl_error("sha_hash", 1, NULL, ERR_TYPE, opts, "list"); return TRUE; }
static foreign_t pl_clingo_ground(term_t ccontrol, term_t parts) { clingo_env *ctl; clingo_part_t *part_vec = NULL; size_t plen = 0; int rc; if (!(rc = get_clingo(ccontrol, &ctl))) { goto out; } switch (PL_skip_list(parts, 0, &plen)) { case PL_LIST: { term_t tail = PL_copy_term_ref(parts); term_t head = PL_new_term_ref(); if (!(part_vec = malloc(sizeof(*part_vec) * plen))) { rc = PL_resource_error("memory"); goto out; } memset(part_vec, 0, sizeof(*part_vec) * plen); for (size_t i = 0; PL_get_list(tail, head, tail); i++) { if (!(rc = get_params(head, &part_vec[i]))) { goto out; } } break; } default: { rc = PL_type_error("list", parts); goto out; } } if (!(rc = clingo_status(clingo_control_ground(ctl->control, part_vec, plen, call_function, ctl)))) { goto out; } out: if (part_vec) { for (size_t i = 0; i < plen; i++) { if (part_vec[i].params) { free((void *)part_vec[i].params); } } free(part_vec); } return rc; }
static foreign_t snowball_algorithms(term_t list) { term_t tail = PL_copy_term_ref(list); term_t head = PL_new_term_ref(); const char **algos = sb_stemmer_list(); int i; for(i=0; algos[i]; i++) { if ( !PL_unify_list(tail, head, tail) || !PL_unify_atom_chars(head, algos[i]) ) return FALSE; } return PL_unify_nil(tail); }
/************************* * swi_list_walk *************************/ int swi_list_walk(term_t list, int (*callback)(term_t item, int i, void *data), void *data) { term_t pl_list, pl_head; int i, err; pl_list = PL_copy_term_ref(list); pl_head = PL_new_term_ref(); for (i = err = 0; !err && PL_get_list(pl_list, pl_head, pl_list); i++) err = callback(pl_head, i, data); return err; }
static foreign_t pl_memberchk_eq(term_t element, term_t maybe_list) { term_t head = PL_new_term_ref(); /* variable for the elements */ term_t list = PL_copy_term_ref(maybe_list); /* copy as we need to write */ while( PL_get_list(list, head, list) ) { if ( PL_compare(element,head) == 0 ) PL_succeed ; } PL_fail; }
static foreign_t pl_cgi_get_form(term_t form) { size_t len = 0; char *data; int must_free = FALSE; term_t list = PL_copy_term_ref(form); char *ct, *boundary; if ( !get_raw_form_data(&data, &len, &must_free) ) return FALSE; if ( (ct = getenv("CONTENT_TYPE")) && (boundary = strstr(ct, "boundary=")) ) { boundary = strchr(boundary, '=')+1; switch( break_multipart(data, len, boundary, mp_add_to_form, (void *)list) ) { case FALSE: return FALSE; case TRUE: break; default: assert(0); return FALSE; } } else { switch( break_form_argument(data, add_to_form, (void *)list) ) { case FALSE: return FALSE; case TRUE: break; case ERROR_NOMEM: return pl_error("cgi_get_form", 1, NULL, ERR_RESOURCE, "memory"); case ERROR_SYNTAX_ERROR: return pl_error("cgi_get_form", 1, NULL, ERR_SYNTAX, "cgi_value"); default: assert(0); return FALSE; } } if ( must_free ) free(data); return PL_unify_nil(list); }
// handle OSC message by calling the associated Prolog goal static int prolog_handler(const char *path, const char *types, lo_arg **argv, int argc, lo_message msg, void *user_data) { term_t goal = PL_new_term_ref(); term_t term0 = PL_new_term_refs(3); term_t term1 = term0+1; term_t term2 = term0+2; term_t list; int i, rc=0; PL_recorded((record_t)user_data,goal); // retrieve the goal term PL_put_term(term0,goal); // term_t goal encoded in user_data PL_put_atom_chars(term1,path); list = PL_copy_term_ref(term2); for (i=0; i<argc; i++) { term_t head=PL_new_term_ref(); term_t tail=PL_new_term_ref(); if (!PL_unify_list(list,head,tail)) PL_fail; switch (types[i]) { case 'c': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"char",1,PL_INT,(int)argv[i]->c); break; case 'i': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"int",1,PL_INT,argv[i]->i); break; case 'h': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"int64",1,PL_INT64,argv[i]->h); break; case 'f': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"float",1,PL_FLOAT,(double)argv[i]->f); break; case 'd': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"double",1,PL_DOUBLE,argv[i]->d); break; case 's': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"string",1,PL_CHARS,&argv[i]->s); break; case 'S': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"symbol",1,PL_CHARS,&argv[i]->S); break; case 'T': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"true",0); break; case 'F': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"false",0); break; case 'N': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"nil",0); break; case 'I': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"inf",0); break; case 'b': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"blob",0); break; case 't': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"timetag",2, PL_INT64,(int64_t)argv[i]->t.sec, PL_INT64,(int64_t)argv[i]->t.frac); break; case 'm': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"midi",4, PL_INT,(int)argv[i]->m[0], PL_INT,(int)argv[i]->m[1], PL_INT,(int)argv[i]->m[2], PL_INT,(int)argv[i]->m[3]); break; } if (!rc) PL_fail; list=tail; } return PL_unify_nil(list) && PL_call_predicate(NULL,PL_Q_NORMAL,call3,term0); }
// parse a list of type terms and encode as a NULL terminated // string where each character encodes the type of one argument. static int get_types_list(term_t list, char *typespec, int len) { term_t head=PL_new_term_ref(); int count=0; // copy term ref so as not to modify original list=PL_copy_term_ref(list); while (PL_get_list(list,head,list) && count<len) { atom_t name; int arity; const char *type; if (!PL_get_name_arity(head,&name,&arity)) return type_error(head,"term"); type=PL_atom_chars(name); switch (arity) { case 1: { if (!strcmp(type,"int")) { typespec[count++]='i'; } else if (!strcmp(type,"double")) { typespec[count++]='d'; } else if (!strcmp(type,"string")) { typespec[count++]='s'; } else if (!strcmp(type,"symbol")) { typespec[count++]='S'; } else if (!strcmp(type,"float")) { typespec[count++]='f'; } break; } case 0: { if (!strcmp(type,"true")) typespec[count++]='T'; else if (!strcmp(type,"false")) typespec[count++]='F'; else if (!strcmp(type,"nil")) typespec[count++]='N'; else if (!strcmp(type,"inf")) typespec[count++]='I'; break; } } } typespec[count]=0; if (!PL_get_nil(list)) return type_error(list,"nil"); return TRUE; }
void getQueryString(term_t t,char* buf) { term_t head = PL_new_term_ref(); term_t list = PL_copy_term_ref(t); int i=0; char* c; while(PL_get_list(list,head,list)) { if(!PL_is_variable(head)) { PL_get_chars(head,&c,CVT_ATOM|BUF_DISCARDABLE); buf[i]=c[0]; } else buf[i]='_'; ++i; } buf[i]='\0'; }
static int md5_options(term_t options, optval *result) { term_t opts = PL_copy_term_ref(options); term_t opt = PL_new_term_ref(); /* defaults */ memset(result, 0, sizeof(*result)); result->encoding = REP_UTF8; while(PL_get_list(opts, opt, opts)) { atom_t aname; size_t arity; if ( PL_get_name_arity(opt, &aname, &arity) && arity == 1 ) { term_t a = PL_new_term_ref(); _PL_get_arg(1, opt, a); if ( aname == ATOM_encoding ) { atom_t a_enc; if ( !PL_get_atom_ex(a, &a_enc) ) return FALSE; if ( a_enc == ATOM_utf8 ) result->encoding = REP_UTF8; else if ( a_enc == ATOM_octet ) result->encoding = REP_ISO_LATIN_1; else return PL_domain_error("encoding", a); } } else { return PL_type_error("option", opt); } } if ( !PL_get_nil(opts) ) return PL_type_error("list", opts); return TRUE; }
static foreign_t process_wait(term_t pid, term_t code, term_t options) { pid_t p; wait_options opts; term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); term_t arg = PL_new_term_ref(); if ( !get_pid(pid, &p) ) return FALSE; memset(&opts, 0, sizeof(opts)); while(PL_get_list(tail, head, tail)) { atom_t name; int arity; if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 ) return type_error(head, "option"); _PL_get_arg(1, head, arg); if ( name == ATOM_timeout ) { atom_t a; if ( !(PL_get_atom(arg, &a) && a == ATOM_infinite) ) { if ( !PL_get_float(arg, &opts.timeout) ) return type_error(arg, "timeout"); opts.has_timeout = TRUE; } } else if ( name == ATOM_release ) { if ( !PL_get_bool(arg, &opts.release) ) return type_error(arg, "boolean"); if ( opts.release == FALSE ) return domain_error(arg, "true"); } else return domain_error(head, "process_wait_option"); } if ( !PL_get_nil(tail) ) return type_error(tail, "list"); return wait_for_pid(p, code, &opts); }
static int unify_query_string_components(term_t list, size_t len, const pl_wchar_t *qs) { if ( len == 0 ) { return PL_unify_nil(list); } else { term_t tail = PL_copy_term_ref(list); term_t head = PL_new_term_ref(); term_t eq = PL_new_term_refs(3); term_t nv = eq+1; const pl_wchar_t *end = &qs[len]; while(qs < end) { range name, value; name.start = qs; name.end = skip_not(qs, end, L"="); if ( name.end < end ) { value.start = name.end+1; value.end = skip_not(value.start, end, L"&;"); qs = value.end+1; } else { return syntax_error("illegal_uri_query"); } PL_put_variable(nv+0); PL_put_variable(nv+1); unify_decoded_atom(nv+0, &name, ESC_QNAME); unify_decoded_atom(nv+1, &value, ESC_QVALUE); if ( !PL_cons_functor_v(eq, FUNCTOR_equal2, nv) || !PL_unify_list(tail, head, tail) || !PL_unify(head, eq) ) return FALSE; } return PL_unify_nil(tail); } }
static int unify_list_from_span(term_t list, clingo_symbol_t const *syms, size_t slen) { int rc; term_t tail = PL_copy_term_ref(list); term_t head = PL_new_term_ref(); term_t tmp = PL_new_term_ref(); clingo_symbol_t const *it, *ie; for (it = syms, ie = it + slen; it != ie; ++it) { PL_put_variable(tmp); if (!(rc = (unify_value(tmp, *it) && PL_unify_list(tail, head, tail) && PL_unify(head, tmp)))) { goto out; } } if (!(rc = PL_unify_nil(tail))) { goto out; } out: return rc; }
static foreign_t pl_crypt(term_t passwd, term_t encrypted) { char *pw, *e; char salt[20]; if ( !PL_get_chars(passwd, &pw, CVT_ATOM|CVT_STRING|CVT_LIST|BUF_RING) ) return pl_error("crypt", 2, NULL, ERR_ARGTYPE, 1, passwd, "text"); if ( PL_get_chars(encrypted, &e, CVT_ATOM|CVT_STRING|CVT_LIST|BUF_RING) ) { char *s2; if ( strncmp(e, "$1$", 3) == 0 ) /* MD5 Hash */ { char *p = strchr(e+3, '$'); size_t slen; if ( p && (slen=(size_t)(p-e-3)) < sizeof(salt) ) { strncpy(salt, e+3, slen); salt[slen] = 0; s2 = md5_crypt(pw, salt); return (strcmp(s2, e) == 0) ? TRUE : FALSE; } else { Sdprintf("No salt???\n"); return FALSE; } } else { int rval; salt[0] = e[0]; salt[1] = e[1]; salt[2] = '\0'; LOCK(); s2 = crypt(pw, salt); rval = (strcmp(s2, e) == 0 ? TRUE : FALSE); UNLOCK(); return rval; } } else { term_t tail = PL_copy_term_ref(encrypted); term_t head = PL_new_term_ref(); int slen = 2; int n; int (*unify)(term_t t, const char *s) = PL_unify_list_codes; char *s2; int rval; for(n=0; n<slen; n++) { if ( PL_get_list(tail, head, tail) ) { int i; char *t; if ( PL_get_integer(head, &i) && i>=0 && i<=255 ) { salt[n] = i; } else if ( PL_get_atom_chars(head, &t) && t[1] == '\0' ) { salt[n] = t[0]; unify = PL_unify_list_chars; } else { return pl_error("crypt", 2, NULL, ERR_ARGTYPE, 2, head, "character"); } if ( n == 1 && salt[0] == '$' && salt[1] == '1' ) slen = 3; else if ( n == 2 && salt[2] == '$' ) slen = 8+3; } else break; } for( ; n < slen; n++ ) { int c = 'a'+(int)(26.0*rand()/(RAND_MAX+1.0)); if ( rand() & 0x1 ) c += 'A' - 'a'; salt[n] = c; } salt[n] = 0; LOCK(); if ( slen > 2 ) { s2 = md5_crypt(pw, salt); } else { s2 = crypt(pw, salt); } rval = (*unify)(encrypted, s2); UNLOCK(); return rval; } }
NULL, /* seek64 */ }; /******************************* * PROLOG CONNECTION * *******************************/ #define COPY_FLAGS (SIO_INPUT|SIO_OUTPUT| \ SIO_TEXT| \ SIO_REPXML|SIO_REPPL|\ SIO_RECORDPOS) static foreign_t pl_http_chunked_open(term_t org, term_t new, term_t options) { term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); chunked_context *ctx; IOSTREAM *s, *s2; int close_parent = FALSE; int max_chunk_size = 0; while(PL_get_list(tail, head, tail)) { atom_t name; int arity; term_t arg = PL_new_term_ref(); if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 ) return type_error(head, "option"); _PL_get_arg(1, head, arg);
static PyObject* pyswipl_run(PyObject* self_Py, PyObject* args_Py) { char* goalString; char* answer; int answerCount; PyObject* answerList_Py; PyObject* answerString_Py; PyObject* bindingList_Py; PyObject* binding_Py; term_t swipl_args; term_t swipl_goalCharList; term_t swipl_bindingList; term_t swipl_head; term_t swipl_list; predicate_t swipl_predicate; qid_t swipl_qid; fid_t swipl_fid; /**********************************************************/ /* The queryString_C should be a python string represting */ /* the query to be executed on the prolog system. */ /**********************************************************/ if(!PyArg_ParseTuple(args_Py, "s", &goalString)) return NULL; else { /**********************************************************/ /* Create a Python list to hold the lists of bindings. */ /**********************************************************/ //if ( answerList_Py != NULL ) // Py_DECREF(answerList_Py); answerList_Py=PyList_New(0); /**********************************************************/ /* Open a foreign frame and initialize the term refs. */ /**********************************************************/ swipl_fid=PL_open_foreign_frame(); swipl_head=PL_new_term_ref(); /* Used in unpacking the binding List */ swipl_args=PL_new_term_refs(2); /* The compound term for arguments to run/2 */ swipl_goalCharList=swipl_args; /* Alias for arg 1 */ swipl_bindingList=swipl_args+1; /* Alias for arg 2 */ /**********************************************************/ /* Pack the query string into the argument compund term. */ /**********************************************************/ PL_put_list_chars(swipl_goalCharList,goalString); /**********************************************************/ /* Generate a predicate to pyrun/2 */ /**********************************************************/ swipl_predicate=PL_predicate("pyrun",2,NULL); /**********************************************************/ /* Open the query, and iterate through the solutions. */ /**********************************************************/ swipl_qid=PL_open_query(NULL,PL_Q_NORMAL,swipl_predicate, swipl_args); while(PL_next_solution(swipl_qid)) { /**********************************************************/ /* Create a Python list to hold the bindings. */ /**********************************************************/ bindingList_Py=PyList_New(0); /**********************************************************/ /* Step through the bindings and add each to the list. */ /**********************************************************/ swipl_list=PL_copy_term_ref(swipl_bindingList); while(PL_get_list(swipl_list, swipl_head, swipl_list)) { PL_get_chars(swipl_head, &answer, CVT_ALL|CVT_WRITE|BUF_RING); answerString_Py = PyString_FromString(answer); PyList_Append(bindingList_Py, answerString_Py); Py_DECREF(answerString_Py); } /**********************************************************/ /* Add this binding list to the list of all solutions. */ /**********************************************************/ PyList_Append(answerList_Py, bindingList_Py); Py_DECREF(bindingList_Py); } /**********************************************************/ /* Free this foreign frame... */ /* Added by Nathan Denny, July 18, 2001. */ /* Fixes a bug with running out of global stack when */ /* asserting _lots_ of facts. */ /**********************************************************/ PL_close_query(swipl_qid); PL_discard_foreign_frame(swipl_fid); /**********************************************************/ /* Return the list of solutions. */ /**********************************************************/ return answerList_Py; } }
static foreign_t tcp_select(term_t Streams, term_t Available, term_t timeout) { fd_set fds; struct timeval t, *to; double time; int n, max = 0, ret, min = 1000000; fdentry *map = NULL; term_t head = PL_new_term_ref(); term_t streams = PL_copy_term_ref(Streams); term_t available = PL_copy_term_ref(Available); term_t ahead = PL_new_term_ref(); int from_buffer = 0; atom_t a; FD_ZERO(&fds); while( PL_get_list(streams, head, streams) ) { IOSTREAM *s; #ifdef __WINDOWS__ nbio_sock_t fd; #else int fd; #endif fdentry *e; if ( !PL_get_stream_handle(head, &s) ) return FALSE; #ifdef __WINDOWS__ fd = fdFromHandle(s->handle); #else fd = Sfileno(s); #endif PL_release_stream(s); if ( fd < 0 || !is_socket_stream(s) ) { return pl_error("tcp_select", 3, NULL, ERR_DOMAIN, head, "socket_stream"); } /* check for input in buffer */ if ( s->bufp < s->limitp ) { if ( !PL_unify_list(available, ahead, available) || !PL_unify(ahead, head) ) return FALSE; from_buffer++; } e = alloca(sizeof(*e)); e->fd = fd; e->stream = PL_copy_term_ref(head); e->next = map; map = e; #ifdef __WINDOWS__ FD_SET((SOCKET)fd, &fds); #else FD_SET(fd, &fds); #endif if ( fd > max ) max = fd; if( fd < min ) min = fd; } if ( !PL_get_nil(streams) ) return pl_error("tcp_select", 3, NULL, ERR_TYPE, Streams, "list"); if ( from_buffer > 0 ) return PL_unify_nil(available); if ( PL_get_atom(timeout, &a) && a == ATOM_infinite ) { to = NULL; } else { if ( !PL_get_float(timeout, &time) ) return pl_error("tcp_select", 3, NULL, ERR_TYPE, timeout, "number"); if ( time >= 0.0 ) { t.tv_sec = (int)time; t.tv_usec = ((int)(time * 1000000) % 1000000); } else { t.tv_sec = 0; t.tv_usec = 0; } to = &t; } while( (ret=nbio_select(max+1, &fds, NULL, NULL, to)) == -1 && errno == EINTR ) { fdentry *e; if ( PL_handle_signals() < 0 ) return FALSE; /* exception */ FD_ZERO(&fds); /* EINTR may leave fds undefined */ for(e=map; e; e=e->next) /* so we rebuild it to be safe */ { FD_SET((SOCKET)e->fd, &fds); } } switch(ret) { case -1: return pl_error("tcp_select", 3, NULL, ERR_ERRNO, errno, "select", "streams", Streams); case 0: /* Timeout */ break; default: /* Something happened -> check fds */ for(n=min; n <= max; n++) { if ( FD_ISSET(n, &fds) ) { if ( !PL_unify_list(available, ahead, available) || !PL_unify(ahead, findmap(map, n)) ) return FALSE; } } break; } return PL_unify_nil(available); }