// 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; }
word pl_setenv(term_t var, term_t value) { char *n, *v; if ( PL_get_chars(var, &n, CVT_ALL|BUF_RING) && PL_get_chars(value, &v, CVT_ALL) ) { Setenv(n, v); succeed; } return warning("setenv/2: instantiation fault"); }
word pl_dwim_match(term_t a1, term_t a2, term_t mm) { char *s1, *s2; atom_t type; if ( PL_get_chars(a1, &s1, CVT_ALL|BUF_RING) && PL_get_chars(a2, &s2, CVT_ALL|BUF_RING) && (type = dwimMatch(s1, s2)) && PL_unify_atom(mm, type) ) succeed; fail; }
foreign_t mk_address(term_t host, term_t port, term_t addr) { char *h, *p; if (PL_get_chars(host, &h, CVT_ATOM | CVT_STRING)) { if (PL_get_chars(port, &p, CVT_INTEGER)) { lo_address a = lo_address_new(h,p); return unify_addr(addr,a); } else { return type_error(port,"integer"); } } else { return type_error(host,"atom"); } }
static foreign_t re_name(term_t name, term_t value) { char *a; int len; int i; if (PL_get_chars(name, &a, CVT_ALL)) { for (i = 1; i NAMES; i ++) { if (data_rslt[i].n[0] == 0) { PL_fail; } if (! strcmp(a, data_rslt[i].n)) { memset(data_value, 0, NAMES); strncpy(data_value, data_str + data_rslt[i].b, data_rslt[i].e - data_rslt[i].b); PL_unify_string_chars(value, data_value); PL_succeed; } } } PL_fail; }
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; }
word pl_dde_poke(term_t handle, term_t item, term_t data, term_t timeout) { int hdl; char *datastr; HDDEDATA Hvalue; HSZ Hitem; long tmo; if ( !get_conv_handle(handle, &hdl) || !get_hsz(item, &Hitem) ) fail; if ( !PL_get_chars(data, &datastr, CVT_ALL) ) return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_text, data); if ( !PL_get_long(timeout, &tmo) ) return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_integer, timeout); if ( tmo <= 0 ) tmo = TIMEOUT_VERY_LONG; Hvalue = DdeClientTransaction(datastr, strlen(datastr)+1, conv_handle[hdl], Hitem, CF_TEXT, XTYP_POKE, (DWORD)tmo, NULL); if ( !Hvalue ) return dde_warning("poke"); succeed; }
static foreign_t re_search(term_t reg, term_t str) { char *a; char *b; if (PL_get_chars(reg, &a, CVT_ALL)) { if (PL_get_chars(str, &b, CVT_ALL)) { if (regexp_main(a, /* "(?fooa*)(?barb*)(?fooc*)" */ b) /* "aaaaaaabbbbbbbbccc" */ == 0) { PL_succeed; } } } PL_fail; }
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 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 ); }
static int get_exe(term_t exe, p_options *info) { int arity; term_t arg = PL_new_term_ref(); if ( !PL_get_name_arity(exe, &info->exe_name, &arity) ) return type_error(exe, "callable"); PL_put_atom(arg, info->exe_name); #ifdef __WINDOWS__ if ( !PL_get_wchars(arg, NULL, &info->exe, CVT_ATOM|CVT_EXCEPTION|BUF_MALLOC) ) return FALSE; if ( !win_command_line(exe, arity, info->exe, &info->cmdline) ) return FALSE; #else /*__WINDOWS__*/ if ( !PL_get_chars(arg, &info->exe, CVT_ATOM|CVT_EXCEPTION|BUF_MALLOC|REP_FN) ) return FALSE; if ( !(info->argv = PL_malloc((arity+2)*sizeof(char*))) ) return PL_resource_error("memory"); memset(info->argv, 0, (arity+2)*sizeof(char*)); if ( !(info->argv[0] = PL_malloc(strlen(info->exe)+1)) ) return PL_resource_error("memory"); strcpy(info->argv[0], info->exe); { int i; for(i=1; i<=arity; i++) { _PL_get_arg(i, exe, arg); if ( !PL_get_chars(arg, &info->argv[i], CVT_ATOMIC|CVT_EXCEPTION|BUF_MALLOC|REP_FN) ) return FALSE; } info->argv[i] = NULL; } #endif /*__WINDOWS__*/ return TRUE; }
foreign_t mk_server(term_t port, term_t server) { char *p; if (PL_get_chars(port, &p, CVT_INTEGER)) { my_server_thread s = my_server_thread_new(p, server_error); if (s) return unify_server(server,s); else return FALSE; } else { return type_error(port,"integer"); } }
word pl_unsetenv(term_t var) { char *n; if ( PL_get_chars(var, &n, CVT_ALL) ) { Unsetenv(n); succeed; } return warning("unsetenv/1: instantiation fault"); }
word pl_shell(term_t command, term_t status) { char *cmd; if ( PL_get_chars(command, &cmd, CVT_ALL) ) { int rval = System(cmd); return PL_unify_integer(status, rval); } return warning("shell/1: instantiation fault"); }
static foreign_t is_diacritics1(term_t atom) { char* s; wchar_t* ws; size_t len; if (PL_get_chars(atom, &s, CVT_ATOMIC)) return is_diacritics((unsigned char*) s); if (PL_get_wchars(atom, &len, &ws, CVT_ATOMIC)) return is_wdiacritics(ws, len); return FALSE; }
static foreign_t is_plaincase1(term_t atom) { char* s; wchar_t* ws; size_t len; if (PL_get_chars(atom, &s, CVT_ATOMIC)) return is_plaincase(s); if (PL_get_wchars(atom, &len, &ws, CVT_ATOMIC)) return is_wplaincase(ws, len); return FALSE; }
static int prolog_debug(term_t t, int flag) { char *topic; /* FIXME: handle lists */ if ( !PL_get_chars(t, &topic, CVT_ATOM|CVT_STRING|CVT_EXCEPTION) ) fail; if ( prolog_debug_topic(topic, flag) ) return TRUE; return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_debug_topic, t); }
foreign_t pl_read_dictionary(term_t filepath_term) { size_t length; char* filename; if(PL_is_string(filepath_term)) return PL_warning("please input a valid string"); PL_get_chars(filepath_term,&filename,CVT_ALL|BUF_DISCARDABLE); printf("reading the file for list of words %s\n",filename); if(read_dictionary(filename)==0) PL_succeed; else PL_fail; }
static int get_hsz(term_t data, HSZ *rval) { char *s; if ( PL_get_chars(data, &s, CVT_ALL) ) { HSZ h = DdeCreateStringHandle(ddeInst, s, CP_WINANSI); if ( h ) { *rval = h; succeed; } } return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_text, data); }
static foreign_t pl_syslog(term_t Priority, term_t Message) { int p; char *msg; if ( get_priority(Priority, &p) && PL_get_chars(Message, &msg, CVT_ALL|CVT_VARIABLE|CVT_WRITE|REP_MB|CVT_EXCEPTION) ) { syslog(p, "%s", msg); return TRUE; } return FALSE; }
static foreign_t pl_openlog(term_t Ident, term_t Option, term_t Facility) { char *ident; int option = 0; int facility = 0; if ( PL_get_chars(Ident, &ident, CVT_ATOM|REP_MB|CVT_EXCEPTION) && get_option(Option, &option) && get_facility(Facility, &facility) ) { openlog(strdup(ident), option, facility); return TRUE; } return FALSE; }
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 ); }
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'; }
void getQueryString(term_t t,char* buf) { int i=0; char* c; term_t h; while(PL_get_list(t,h,t)) { if(!PL_is_variable(h)) { PL_get_chars(h,&c,CVT_ATOM|BUF_DISCARDABLE); buf[i]=c[0]; } else buf[i]='_'; ++i; } buf[i]='\0'; printf("buf : %s\n",buf); }
static foreign_t pl_get_ps_parameters(term_t file, term_t iseps, term_t bb) { char *fname; FILE *fd; if ( !PL_get_chars(file, &fname, CVT_ALL) ) return PL_warning("get_ps_parameters/3: invalid filename"); if ( (fd = fopen(fname, "r")) ) { char buf[MAXLINE]; char *s; if ( (s=fgets(buf, sizeof(buf), fd)) ) { if ( substr(s, "EPSF") ) PL_unify_atom_chars(iseps, "eps"); else PL_unify_atom_chars(iseps, "ps"); } do { double a1, a2, a3, a4; if ( sscanf(buf, "%%%%BoundingBox: %lf %lf %lf %lf", &a1, &a2, &a3, &a4) == 4 ) { fclose(fd); return PL_unify_term(bb, PL_FUNCTOR, PL_new_functor(PL_new_atom("bb"), 4), PL_FLOAT, a1, PL_FLOAT, a2, PL_FLOAT, a3, PL_FLOAT, a4); } } while( (s=fgets(buf, sizeof(buf), fd)) ); fclose(fd); PL_warning("get_ps_parameters/3: could not find %%%%BoundingBox in %s", fname); PL_fail; } PL_warning("get_ps_parameters/3: could not open %s", fname); PL_fail; }
static int get_showCmd(term_t show, UINT *cmd) { char *s; showtype *st; static showtype types[] = { { "hide", SW_HIDE }, { "maximize", SW_MAXIMIZE }, { "minimize", SW_MINIMIZE }, { "restore", SW_RESTORE }, { "show", SW_SHOW }, { "showdefault", SW_SHOWDEFAULT }, { "showmaximized", SW_SHOWMAXIMIZED }, { "showminimized", SW_SHOWMINIMIZED }, { "showminnoactive", SW_SHOWMINNOACTIVE }, { "showna", SW_SHOWNA }, { "shownoactive", SW_SHOWNOACTIVATE }, { "shownormal", SW_SHOWNORMAL }, /* compatibility */ { "normal", SW_SHOWNORMAL }, { "iconic", SW_MINIMIZE }, { NULL, 0 }, }; if ( show == 0 ) { *cmd = SW_SHOWNORMAL; succeed; } if ( !PL_get_chars(show, &s, CVT_ATOM|CVT_EXCEPTION) ) fail; for(st=types; st->name; st++) { if ( streq(st->name, s) ) { *cmd = st->id; succeed; } } return PL_error(NULL, 0, NULL, ERR_DOMAIN, PL_new_atom("win_show"), show); }
static int get_facility(term_t t, int *fac) { char *s; int facility; if ( PL_get_chars(t, &s, CVT_ATOM|CVT_EXCEPTION) ) { if ( streq(s, "auth" ) ) facility = LOG_AUTH; #ifdef LOG_AUTHPRIV else if ( streq(s, "authpriv") ) facility = LOG_AUTHPRIV; #endif else if ( streq(s, "cron") ) facility = LOG_CRON; else if ( streq(s, "daemon") ) facility = LOG_DAEMON; #ifdef LOG_FTP else if ( streq(s, "ftp") ) facility = LOG_FTP; #endif else if ( streq(s, "kern") ) facility = LOG_KERN; else if ( streq(s, "local0") ) facility = LOG_LOCAL0; else if ( streq(s, "local1") ) facility = LOG_LOCAL1; else if ( streq(s, "local2") ) facility = LOG_LOCAL2; else if ( streq(s, "local3") ) facility = LOG_LOCAL3; else if ( streq(s, "local4") ) facility = LOG_LOCAL4; else if ( streq(s, "local5") ) facility = LOG_LOCAL5; else if ( streq(s, "local6") ) facility = LOG_LOCAL6; else if ( streq(s, "local7") ) facility = LOG_LOCAL7; else if ( streq(s, "lpr") ) facility = LOG_LPR; else if ( streq(s, "mail") ) facility = LOG_MAIL; else if ( streq(s, "news") ) facility = LOG_NEWS; else if ( streq(s, "syslog") ) facility = LOG_SYSLOG; else if ( streq(s, "user") ) facility = LOG_USER; else if ( streq(s, "uucp") ) facility = LOG_UUCP; else return PL_domain_error("syslog_facility", t); } else return FALSE; *fac = facility; return TRUE; }
word pl_getenv(term_t var, term_t value) { char *n; if ( PL_get_chars(var, &n, CVT_ALL) ) { int len = getenvl(n); if ( len >= 0 ) { char *buf = alloca(len+1); if ( buf ) { char *s; if ( (s=getenv3(n, buf, len+1)) ) return PL_unify_atom_chars(value, s); } else return PL_error("getenv", 2, NULL, ERR_NOMEM); } fail; } return warning("getenv/2: instantiation fault"); }
static int get_priority(term_t t, int *pri) { char *s; int priority; if ( PL_get_chars(t, &s, CVT_ATOM|CVT_EXCEPTION) ) { if ( streq(s, "emerg" ) ) priority = LOG_EMERG; else if ( streq(s, "alert") ) priority = LOG_ALERT; else if ( streq(s, "crit") ) priority = LOG_CRIT; else if ( streq(s, "err") ) priority = LOG_ERR; else if ( streq(s, "warning") ) priority = LOG_WARNING; else if ( streq(s, "notice") ) priority = LOG_NOTICE; else if ( streq(s, "info") ) priority = LOG_INFO; else if ( streq(s, "debug") ) priority = LOG_DEBUG; else { PL_domain_error("syslog_priority", t); return FALSE; } } else return FALSE; *pri = priority; return TRUE; }
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; } }