static foreign_t pl_listen(term_t Sock, term_t BackLog) { int socket; int backlog; if ( !tcp_get_socket(Sock, &socket) ) return FALSE; if ( !PL_get_integer(BackLog, &backlog) ) return pl_error(NULL, 0, NULL, ERR_ARGTYPE, -1, BackLog, "integer"); if ( nbio_listen(socket, backlog) < 0 ) return FALSE; return TRUE; }
static foreign_t pl_user_info(term_t user, term_t info) { int uid; struct passwd pwd, *pwdp; char buf[1000]; char *name; if ( PL_get_integer(user, &uid) ) { again1: errno = 0; if ( getpwuid_r(uid, &pwd, buf, sizeof(buf), &pwdp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again1; } return error(errno, "info", "user", user); } } else if ( PL_get_chars(user, &name, CVT_ATOMIC|REP_MB) ) { again2: errno = 0; if ( getpwnam_r(name, &pwd, buf, sizeof(buf), &pwdp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again2; } return error(errno, "info", "user", user); } } else { return PL_type_error("user", user); } if ( !pwdp ) return PL_existence_error("user", user); return PL_unify_term(info, PL_FUNCTOR_CHARS, "user_info", 7, PL_MBCHARS, pwdp->pw_name, PL_MBCHARS, pwdp->pw_passwd, PL_INT, (int)pwdp->pw_uid, PL_INT, (int)pwdp->pw_gid, PL_MBCHARS, pwdp->pw_gecos, PL_MBCHARS, pwdp->pw_dir, PL_MBCHARS, pwdp->pw_shell ); }
/* todo */ void parse_validate_args(term_t args, EtalisEvent* event) { event->args = malloc(sizeof(int)*event->RootModel->event.arity); int arity; PL_get_name_arity(args, NULL, &arity); term_t arg_terms = PL_new_term_refs(arity); /* assuming that all arguments are ints */ /* todo implement for other types */ size_t arg_iterator; for(arg_iterator=0;arg_iterator<event->RootModel->event.arity;arg_iterator++) { PL_get_arg(arg_iterator+1,args,arg_terms+arg_iterator); PL_get_integer(arg_terms+arg_iterator,(int*)event->args+arg_iterator); } }
static foreign_t pl_pwmSetRange (term_t range_){ unsigned int range; if (!PL_get_integer(range_,&range)) { PL_warning("Argument `range` not number!\n"); PL_fail; } if (range<0) { PL_warning("Argument 'range' not unsigned one!\n"); PL_fail; } pwmSetRange(range); PL_succeed; }
/************************* * list_length *************************/ static int list_length(term_t pl_list) { predicate_t pr_length; term_t pl_args, pl_length; int length; pr_length = PL_predicate("length", 2, NULL); pl_args = PL_new_term_refs(2); pl_length = pl_args + 1; if (!PL_unify(pl_args, pl_list) || !PL_call_predicate(NULL, PL_Q_NORMAL, pr_length, pl_args)) length = -1; else PL_get_integer(pl_length, &length); return length; }
tcp_get_socket(term_t Socket, int *id) { IOSTREAM *s; int socket; if ( PL_is_functor(Socket, FUNCTOR_socket1) ) { term_t a = PL_new_term_ref(); _PL_get_arg(1, Socket, a); if ( PL_get_integer(a, id) ) return TRUE; } if ( PL_get_stream_handle(Socket, &s) ) { socket = (int)(intptr_t)s->handle; *id = socket; return TRUE; } return pl_error(NULL, 0, NULL, ERR_ARGTYPE, -1, Socket, "socket"); }
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; } }
/* parse the time window constraints */ void parse_within_op_(EtalisExecNode* operatorNode,term_t t) { assert(operatorNode != NULL); fid_t fid = PL_open_foreign_frame(); EtalisEventNode* opt_t = (EtalisEventNode*)malloc(2*sizeof(EtalisEventNode)); /* memory alignement for L1 cache optimization */ operatorNode->leftChild=opt_t; memset(operatorNode->leftChild,0,sizeof(EtalisEventNode)); operatorNode->rightChild=opt_t+1; operatorNode->condition=NULL; /* get window size */ term_t winsize = PL_new_term_ref(); PL_get_arg(2,t,winsize); WINDOW_SIZE_T i; /*get window size*/ /* depending on the target processor, this might be an int, a double or a structure. */ /* defined in WINDOW_SIZE_T : e_time.h */ #if PROCESSOR_SUPPORTS_DOUBLE ==1 if (PL_term_type(winsize) == PL_FLOAT) PL_get_float(winsize,&i); else printf("ERROR: window Size must be a floating number ! \n"); #else /* we don't support double accuracy, fall back to int */ PL_get_integer(winsize, &i); #endif operatorNode->window_size=i; #ifdef DEBUG printf("--- WITHIN Block detected | Window size: %f\n",i); #endif /* term_t _level_1 = PL_new_term_refs(3); term_t _left_event=_level_1+1; term_t _right_event=_level_1+2; atom_t _left_event_name,_right_event_name; PL_get_arg(1,t,_level_1); PL_get_arg(1,_level_1,_left_event); PL_get_arg(2,_level_1,_right_event); PL_get_name_arity(_left_event,&_left_event_name,(int*)&((operatorNode->leftChild)->event.arity)); PL_get_name_arity(_right_event,&_right_event_name,(int*)&(operatorNode->rightChild->event.arity)); PL_discard_foreign_frame(fid); strcpy(operatorNode->leftChild->event.name,PL_atom_chars(_left_event_name)); strcpy(operatorNode->rightChild->event.name,PL_atom_chars(_right_event_name)); } */ }
word pl_current_functor(term_t name, term_t arity, control_t h) { GET_LD atom_t nm = 0; size_t index; int i, last=FALSE; int ar; fid_t fid; switch( ForeignControl(h) ) { case FRG_FIRST_CALL: if ( PL_get_atom(name, &nm) && PL_get_integer(arity, &ar) ) return isCurrentFunctor(nm, ar) ? TRUE : FALSE; if ( !(PL_is_integer(arity) || PL_is_variable(arity)) ) return PL_error("current_functor", 2, NULL, ERR_DOMAIN, ATOM_integer, arity); if ( !(PL_is_atom(name) || PL_is_variable(name)) ) return PL_error("current_functor", 2, NULL, ERR_DOMAIN, ATOM_atom, name); index = 1; break; case FRG_REDO: PL_get_atom(name, &nm); index = ForeignContextInt(h); break; case FRG_CUTTED: default: succeed; } fid = PL_open_foreign_frame(); LOCK(); for(i=MSB(index); !last; i++) { size_t upto = (size_t)2<<i; FunctorDef *b = GD->functors.array.blocks[i]; if ( upto >= GD->functors.highest ) { upto = GD->functors.highest; last = TRUE; } for(; index<upto; index++) { FunctorDef fd = b[index]; if ( fd && fd->arity > 0 && (!nm || nm == fd->name) ) { if ( PL_unify_atom(name, fd->name) && PL_unify_integer(arity, fd->arity) ) { UNLOCK(); ForeignRedoInt(index+1); } else { PL_rewind_foreign_frame(fid); } } } } UNLOCK(); return FALSE; }
static foreign_t turtle_read_string(term_t C0, term_t Stream, term_t C, term_t Value) { int c; charbuf b; IOSTREAM *in; int endlen = 1; if ( !PL_get_integer(C0, &c) ) return type_error(C0, "code"); if ( c != '"' ) return FALSE; if ( !PL_get_stream_handle(Stream, &in) ) return FALSE; init_charbuf(&b); c = Sgetcode(in); if ( c == '"' ) { c = Sgetcode(in); if ( c == '"' ) /* """...""" */ { endlen = 3; c = Sgetcode(in); } else { PL_release_stream(in); return (PL_unify_integer(C, c) && PL_unify_atom(Value, ATOM_)); } } for(;;c = Sgetcode(in)) { if ( c == -1 ) { free_charbuf(&b); PL_release_stream(in); return syntax_error("eof_in_string", in); } else if ( c == '"' ) { int count = 1; for(count=1; count<endlen; ) { if ( (c=Sgetcode(in)) == '"' ) count++; else break; } if ( count == endlen ) { int rc; c = Sgetcode(in); rc = (PL_unify_integer(C, c) && PL_unify_wchars(Value, PL_ATOM, b.here-b.base, b.base)); free_charbuf(&b); PL_release_stream(in); return rc; } while(count-- > 0) add_charbuf(&b, '"'); add_charbuf(&b, c); } else if ( c == '\\' ) { int esc; c = Sgetcode(in); if ( !string_escape(in, c, &esc) ) { free_charbuf(&b); PL_release_stream(in); return FALSE; } add_charbuf(&b, esc); } else { add_charbuf(&b, c); } } }
static foreign_t udp_receive(term_t Socket, term_t Data, term_t From, term_t options) { struct sockaddr_in sockaddr; #ifdef __WINDOWS__ int alen = sizeof(sockaddr); #else socklen_t alen = sizeof(sockaddr); #endif int socket; int flags = 0; char smallbuf[UDP_DEFAULT_BUFSIZE]; char *buf = smallbuf; int bufsize = UDP_DEFAULT_BUFSIZE; term_t varport = 0; ssize_t n; int as = PL_STRING; int rc; if ( !PL_get_nil(options) ) { term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); term_t arg = PL_new_term_ref(); while(PL_get_list(tail, head, tail)) { atom_t name; size_t arity; if ( PL_get_name_arity(head, &name, &arity) && arity == 1 ) { _PL_get_arg(1, head, arg); if ( name == ATOM_as ) { atom_t a; if ( !PL_get_atom(arg, &a) ) return pl_error(NULL, 0, NULL, ERR_TYPE, head, "atom"); if ( a == ATOM_atom ) as = PL_ATOM; else if ( a == ATOM_codes ) as = PL_CODE_LIST; else if ( a == ATOM_string ) as = PL_STRING; else return pl_error(NULL, 0, NULL, ERR_DOMAIN, arg, "as_option"); } else if ( name == ATOM_max_message_size ) { if ( !PL_get_integer(arg, &bufsize) ) return pl_error(NULL, 0, NULL, ERR_TYPE, arg, "integer"); if ( bufsize < 0 || bufsize > UDP_MAXDATA ) return pl_error(NULL, 0, NULL, ERR_DOMAIN, arg, "0 - 65535"); } } else return pl_error(NULL, 0, NULL, ERR_TYPE, head, "option"); } if ( !PL_get_nil(tail) ) return pl_error(NULL, 0, NULL, ERR_TYPE, tail, "list"); } if ( !tcp_get_socket(Socket, &socket) || !nbio_get_sockaddr(From, &sockaddr, &varport) ) return FALSE; if ( bufsize > UDP_DEFAULT_BUFSIZE ) { if ( !(buf = malloc(bufsize)) ) return pl_error(NULL, 0, NULL, ERR_RESOURCE, "memory"); } if ( (n=nbio_recvfrom(socket, buf, bufsize, flags, (struct sockaddr*)&sockaddr, &alen)) == -1 ) { rc = nbio_error(errno, TCP_ERRNO); goto out; } rc = ( PL_unify_chars(Data, as, n, buf) && unify_address(From, &sockaddr) ); out: if ( buf != smallbuf ) free(buf); return rc; }
static foreign_t pl_time_debug(term_t n) { return PL_get_integer(n, &debuglevel); }
static foreign_t http_stream_debug(term_t level) { return PL_get_integer(level, &debuglevel); }
static bool get_value(term_t t, clingo_symbol_t *val, int minus) { switch (PL_term_type(t)) { case PL_INTEGER: { int i; if (PL_get_integer(t, &i)) { clingo_symbol_create_number(i, val); return true; } return false; } case PL_ATOM: { char *s; size_t len; if (PL_get_nchars(t, &len, &s, CVT_ATOM | REP_UTF8 | CVT_EXCEPTION)) { return clingo_symbol_create_id(s, !minus, val); /* no sign */ } return false; } case PL_STRING: { char *s; size_t len; if (PL_get_nchars(t, &len, &s, CVT_STRING | REP_UTF8 | CVT_EXCEPTION)) { return clingo_symbol_create_string(s, val); } return false; } case PL_TERM: { bool rc; term_t arg; atom_t name; size_t arity; /* TBD: -atom, #const */ clingo_symbol_t *values = NULL; if (!(rc = get_name_arity(t, &name, &arity))) { clingo_set_error(clingo_error_runtime, "prolog error"); goto out_term; } arg = PL_new_term_ref(); if (name == ATOM_minus && arity == 1) { if (!(rc = get_value(arg, val, TRUE))) { goto out_term; } } else if (name == ATOM_hash && arity == 1) { atom_t a; _PL_get_arg(1, t, arg); if (!(rc = PL_get_atom_ex(arg, &a))) { clingo_set_error(clingo_error_runtime, "prolog error"); goto out_term; } if (a == ATOM_inf) { clingo_symbol_create_infimum(val); } else if (a == ATOM_sup) { clingo_symbol_create_supremum(val); } else { rc = false; clingo_set_error(clingo_error_runtime, "bad value"); goto out_term; } } else { const char *id = PL_atom_chars(name); /* TBD: errors */ size_t i; if (!(values = malloc(sizeof(*values) * arity))) { rc = false; clingo_set_error(clingo_error_bad_alloc, "memory"); goto out_term; } for (i = 0; i < arity; i++) { _PL_get_arg(i + 1, t, arg); if (!(rc = get_value(arg, &values[i], FALSE))) { goto out_term; } } PL_reset_term_refs(arg); if (!(rc = clingo_symbol_create_function(id, values, arity, !minus, val))) { goto out_term; } } out_term: if (values) { free(values); } return rc; } default: clingo_set_error(clingo_error_runtime, "bad value"); return false; } }