static foreign_t
pl_setopt(term_t Socket, term_t opt)
{ int socket;
atom_t a;
int arity;
if ( !tcp_get_socket(Socket, &socket) )
return FALSE;
if ( PL_get_name_arity(opt, &a, &arity) )
{ if ( a == ATOM_reuseaddr && arity == 0 )
{ if ( nbio_setopt(socket, TCP_REUSEADDR, TRUE) == 0 )
return TRUE;
return FALSE;
} else if ( a == ATOM_nodelay && arity <= 1 )
{ int enable, rc;
if ( arity == 0 )
{ enable = TRUE;
} else /*if ( arity == 1 )*/
{ term_t a = PL_new_term_ref();
_PL_get_arg(1, opt, a);
if ( !PL_get_bool(a, &enable) )
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a, "boolean");
}
if ( (rc=nbio_setopt(socket, TCP_NO_DELAY, enable) == 0) )
return TRUE;
if ( rc == -2 )
goto not_implemented;
return FALSE;
} else if ( a == ATOM_broadcast && arity == 0 )
{ if ( nbio_setopt(socket, UDP_BROADCAST, TRUE) == 0 )
return TRUE;
return FALSE;
} else if ( a == ATOM_dispatch && arity == 1 )
{ int val;
term_t a1 = PL_new_term_ref();
if ( PL_get_arg(1, opt, a1) && PL_get_bool(a1, &val) )
{ if ( nbio_setopt(socket, TCP_DISPATCH, val) == 0 )
return TRUE;
return FALSE;
}
} else if ( a == ATOM_nonblock && arity == 0 )
{ if ( nbio_setopt(socket, TCP_NONBLOCK) == 0 )
return TRUE;
return FALSE;
}
}
not_implemented:
return pl_error(NULL, 0, NULL, ERR_DOMAIN, opt, "socket_option");
}
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 int
pl_get_bool_ex(term_t arg, int *val)
{ if ( PL_get_bool(arg, val) )
return TRUE;
return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 0, arg, "bool");
}
static int
get_bool_ex(term_t t, int *i)
{ if ( PL_get_bool(t, i) )
return TRUE;
return type_error(t, "boolean");
}
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);
}
word
pl_dde_register_service(term_t topic, term_t onoff)
{ HSZ t;
int a;
TRY(dde_initialise());
if ( !get_hsz(topic, &t) )
fail;
if ( !PL_get_bool(onoff, &a) )
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_bool, onoff);
if ( !a )
{ int rval = (int)DdeNameService(ddeInst, t, 0L, DNS_UNREGISTER);
DdeFreeStringHandle(ddeInst, t);
return rval ? TRUE : FALSE;
} else
{ if ( DdeNameService(ddeInst, t, 0L, DNS_REGISTER|DNS_FILTERON) )
succeed; /* should we free too? */
DdeFreeStringHandle(ddeInst, t);
return dde_warning("register_request");
}
}
static foreign_t
pl_tipc_setopt(term_t Socket, term_t opt)
{ int socket;
atom_t a;
int arity;
if ( !tipc_get_socket(Socket, &socket) )
return FALSE;
if ( PL_get_name_arity(opt, &a, &arity) )
{ if ( a == ATOM_importance && arity == 1 )
{ atom_t val;
term_t a1 = PL_new_term_ref();
int ival = TIPC_LOW_IMPORTANCE;
if (PL_get_arg(1, opt, a1))
{ if(!PL_get_atom(a1, &val) )
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "atom");
if(val == ATOM_low)
ival = TIPC_LOW_IMPORTANCE;
else if(val == ATOM_medium)
ival = TIPC_MEDIUM_IMPORTANCE;
else if(val == ATOM_high)
ival = TIPC_HIGH_IMPORTANCE;
else if(val == ATOM_critical)
ival = TIPC_CRITICAL_IMPORTANCE;
else
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "low, medium, high, or critical");
return((tipc_setopt(socket, NB_TIPC_IMPORTANCE, ival) == 0) ? TRUE : FALSE);
}
}
if ( ((a == ATOM_dest_droppable) ||
(a == ATOM_src_droppable)) && arity == 1 )
{ int val;
term_t a1 = PL_new_term_ref();
int option = (a == ATOM_dest_droppable) ? NB_TIPC_DEST_DROPPABLE
: NB_TIPC_SRC_DROPPABLE;
if (PL_get_arg(1, opt, a1))
{ if(!PL_get_bool(a1, &val) )
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "boolean");
return((tipc_setopt(socket, option, val) == 0) ? TRUE : FALSE);
}
}
if ( a == ATOM_conn_timeout && arity == 1 )
{ double val;
int ival;
term_t a1 = PL_new_term_ref();
if (PL_get_arg(1, opt, a1))
{ if(!PL_get_float(a1, &val) || val < 0)
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "float");
ival = val * 1000; // time is in milliseconds
return((tipc_setopt(socket, NB_TIPC_CONN_TIMEOUT, ival) == 0) ? TRUE : FALSE);
}
}
if ( a == ATOM_nodelay && arity <= 1 )
{ int enable, rc;
if ( arity == 0 )
{ enable = TRUE;
} else /*if ( arity == 1 )*/
{ term_t a = PL_new_term_ref();
_PL_get_arg(1, opt, a);
if ( !PL_get_bool(a, &enable) )
return pl_error(NULL, 0, NULL, ERR_DOMAIN, a, "boolean");
}
if ( (rc=nbio_setopt(socket, TCP_NO_DELAY, enable) == 0) )
return TRUE;
if ( rc == -2 )
return pl_error(NULL, 0, NULL, ERR_DOMAIN, opt, "socket_option");
}
if ( a == ATOM_nonblock && arity == 0 )
return((nbio_setopt(socket, TCP_NONBLOCK) == 0) ? TRUE : FALSE );
if ( a == ATOM_dispatch && arity == 1 )
{ int val;
term_t a1 = PL_new_term_ref();
if ( PL_get_arg(1, opt, a1) && PL_get_bool(a1, &val) )
{ if ( nbio_setopt(socket, TCP_DISPATCH, val) == 0 )
return TRUE;
return FALSE;
}
}
}
return pl_error(NULL, 0, NULL, ERR_DOMAIN, opt, "socket_option");
}
