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