CAMLprim value unix_getgrnam(value name)
{
struct group * entry;
if (! caml_string_is_c_safe(name)) caml_raise_not_found();
entry = getgrnam(String_val(name));
if (entry == NULL) caml_raise_not_found();
return alloc_group_entry(entry);
}
CAMLprim value unix_getgrgid(value gid)
{
struct group * entry;
entry = getgrgid(Int_val(gid));
if (entry == NULL) caml_raise_not_found();
return alloc_group_entry(entry);
}
static value value_of_element(GstElement *e)
{
if (!e) caml_raise_not_found();
value ans = caml_alloc_custom(&element_ops, sizeof(GstElement*), 0, 1);
Element_val(ans) = e;
return ans;
}
CAMLprim value caml_sqlite3_bind_parameter_index(value v_stmt, value v_name)
{
sqlite3_stmt *stmt = safe_get_stmtw("bind_parameter_index", v_stmt)->stmt;
char *parm_name = String_val(v_name);
int index = sqlite3_bind_parameter_index(stmt, parm_name);
if (!index) caml_raise_not_found();
return Val_int(index);
}
CAMLprim value caml_sys_getenv(value var)
{
char * res;
res = getenv(String_val(var));
if (res == 0) caml_raise_not_found();
return caml_copy_string(res);
}
CAMLprim value caml_multiboot_module(value unit) {
CAMLparam0();
CAMLlocal1(arr);
if (my_module == NULL) {
caml_raise_not_found();
}
arr = to_bigarray(my_module, my_module_length);
CAMLreturn(arr);
}
CAMLprim value ocaml_ssl_get_subject(value certificate)
{
CAMLparam1(certificate);
X509 *cert = Cert_val(certificate);
caml_enter_blocking_section();
char *subject = X509_NAME_oneline(X509_get_subject_name(cert), 0, 0);
caml_leave_blocking_section();
if (subject == NULL) caml_raise_not_found ();
CAMLreturn(caml_copy_string(subject));
}
CAMLprim value ocaml_ssl_get_issuer(value certificate)
{
CAMLparam1(certificate);
X509 *cert = Cert_val(certificate);
caml_enter_blocking_section();
char *issuer = X509_NAME_oneline(X509_get_issuer_name(cert), 0, 0);
caml_leave_blocking_section();
if (!issuer) caml_raise_not_found ();
CAMLreturn(caml_copy_string(issuer));
}
static value result_gethostbyname(struct job_gethostbyname *job)
{
if (job->ptr == NULL) {
lwt_unix_free_job(&job->job);
caml_raise_not_found();
} else {
value entry = alloc_host_entry(&job->entry);
#ifdef NON_R_GETHOSTBYNAME
hostent_free(job->ptr);
#endif
lwt_unix_free_job(&job->job);
return entry;
}
}
static inline void handle_exec_error(char *loc, const int ret)
{
switch (ret) {
/* Dedicated exceptions */
case PCRE_ERROR_NOMATCH : caml_raise_not_found();
case PCRE_ERROR_PARTIAL : raise_partial();
case PCRE_ERROR_MATCHLIMIT : raise_match_limit();
case PCRE_ERROR_BADPARTIAL : raise_bad_partial();
case PCRE_ERROR_BADUTF8 : raise_bad_utf8();
case PCRE_ERROR_BADUTF8_OFFSET : raise_bad_utf8_offset();
case PCRE_ERROR_RECURSIONLIMIT : raise_recursion_limit();
case PCRE_ERROR_DFA_WSSIZE : raise_workspace_size();
/* Unknown error */
default : {
char err_buf[100];
snprintf(err_buf, 100, "%s: unhandled PCRE error code: %d", loc, ret);
raise_internal_error(err_buf);
}
}
}
value ml_physh_map_find (value t, value key, value null)
{
CAMLparam3(t, null, key);
CAMLlocal1(v);
minor_sync(t, null);
v = null;
int found = 0;
if (value_is_young(key))
{
if (t_minor_fill(t) > 0)
{
value table = t_minor_get(t);
size_t index = table_find(table, null, key);
if (Field(table, index * 2) == key)
{
v = Field(table, index * 2 + 1);
found = 1;
}
}
}
else
{
if (t_major_fill(t) > 0)
{
value table = t_major_get(t);
size_t index = table_find(table, null, key);
if (Field(table, index * 2) == key)
{
v = Field(table, index * 2 + 1);
found = 1;
}
}
}
if (found == 0)
caml_raise_not_found();
CAMLreturn(v);
}
/*
* Release the thread when it terminates.
* Don't release the process struct yet,
* just mark it as changed.
*/
value omake_shell_sys_release_thread_pid(value v_pid, value v_code)
{
CAMLparam2(v_pid, v_code);
Process *processp;
int pid;
pid = Int_val(v_pid);
#ifdef OSH_DEBUG
fprintf(stderr, "omake_shell_sys_release_thread_pid: %d\n", pid);
fflush(stderr);
#endif
/* Find the process */
for(processp = state->processes; processp; processp = processp->next) {
#ifdef OSH_DEBUG
fprintf(stderr, "omake_shell_sys_release_thread_pid: comparing with pid = %d\n", processp->pid);
fflush(stderr);
#endif
if(processp->pid == pid)
break;
}
if(processp == 0)
caml_raise_not_found();
/* Process has terminated */
processp->changed = 1;
processp->status = STATUS_EXITED;
processp->code = Int_val(v_code);
SetEvent(processp->handle);
#ifdef OSH_DEBUG
fprintf(stderr, "omake_shell_sys_release_thread_pid: pid = %d\n", processp->pid);
fflush(stderr);
#endif
CAMLreturn(Val_unit);
}
/*
* Thread prologue.
*/
value omake_shell_sys_init_thread_pid(value v_pid)
{
CAMLparam1(v_pid);
Process *processp;
int pid;
#ifdef OSH_DEBUG
fprintf(stderr, "omake_shell_sys_init_thread_pid\n");
fflush(stderr);
#endif
/* Find the process */
pid = Int_val(v_pid);
for(processp = state->processes; processp; processp = processp->next) {
if(processp->pid == pid)
break;
}
if(processp == 0)
caml_raise_not_found();
/* Process has terminated */
processp->thread = GetCurrentThreadId();
CAMLreturn(Val_unit);
}
CAMLprim value caml_get_section_table(value unit)
{
if (caml_section_table == NULL) caml_raise_not_found();
return caml_input_value_from_block(caml_section_table,
caml_section_table_size);
}
/*
* Wait for any of the processes in the group to complete.
* There are several modes:
* pgrp == 0: wait for any process group leader
* pgrp <> 0: wait for a specific process group
* leader: if true, wait only for the group leader
* if false, wait only for the children
* nohang: if true, don't block
*
* JYH: this code has caused trouble with bogus exit codes
* and memory corruption. For safety:
* - Return a triple of results, as (bool * int * int),
* not a (int * Unix.process_status).
* - Perform all allocated within this function,
* hence the gotos.
*/
value omake_shell_sys_wait(value v_pgrp, value v_leader, value v_nohang)
{
CAMLparam3(v_pgrp, v_leader, v_nohang);
CAMLlocal1(tuple);
int processes[MAXIMUM_WAIT_OBJECTS];
HANDLE handles[MAXIMUM_WAIT_OBJECTS];
Process **processpp, *processp;
int ncount, code, pid, pgrp, leader;
DWORD exitcode, timeout, index;
#ifdef OSH_DEBUG
fprintf(stderr, "omake_shell_sys_wait\n");
fflush(stderr);
#endif
/* Parameters */
pgrp = Int_val(v_pgrp);
leader = Int_val(v_leader);
timeout = Int_val(v_nohang) ? 0 : INFINITE;
restart:
/* Collect the processes and their handles */
ncount = 1;
handles[0] = state->changed;
for(processpp = &state->processes; processp = *processpp; processpp = &(*processpp)->next) {
if((pgrp && processp->pgrp != pgrp)
|| (pgrp == 0 && processp->pgrp == INIT_PID)
|| (leader && processp->pid != processp->pgrp)
|| (leader == 0 && processp->pid == processp->pgrp)) {
continue;
}
else if(processp->changed)
goto done;
else {
if(ncount == MAXIMUM_WAIT_OBJECTS)
caml_invalid_argument("omake_shell_sys_wait: too many processes");
processes[ncount] = processp->pid;
handles[ncount] = processp->handle;
ncount++;
}
}
#ifdef OSH_DEBUG
fprintf(stderr, "omake_shell_sys_wait: waiting for %d events\n", ncount);
fprintf(stderr, "\tpgrp = %d, leader = %d, timeout = %d\n", pgrp, leader, timeout);
fflush(stderr);
#endif
/* Wait for an event */
while(1) {
/* Perform the wait */
caml_enter_blocking_section();
index = WaitForMultipleObjects(ncount, handles, FALSE, timeout);
if(index == WAIT_FAILED)
code = GetLastError();
caml_leave_blocking_section();
/* See if something has changed */
if(index == WAIT_OBJECT_0) {
for(processpp = &state->processes; processp = *processpp; processpp = &(*processpp)->next) {
if(processp->pgrp == pgrp && processp->changed)
goto done;
}
}
else
break;
}
/* Get the index of the event */
if(index >= WAIT_OBJECT_0 + 1 && index < WAIT_OBJECT_0 + ncount)
index -= WAIT_OBJECT_0;
else if(index >= WAIT_ABANDONED_0 + 1 && index < WAIT_ABANDONED_0 + ncount)
index -= WAIT_ABANDONED_0;
else
caml_raise_not_found();
/* Adjust process */
pid = processes[index];
for(processpp = &state->processes; processp = *processpp; processpp = &(*processpp)->next) {
if(processp->pid == pid)
break;
}
/* If the process is not found, some other thread waited for it */
if(processp == 0)
goto restart;
/* Otherwise, handle the wait */
processp->changed = 1;
processp->status = STATUS_EXITED;
/* Get the return code */
if(processp->is_thread == 0) {
if(GetExitCodeProcess(handles[index], &exitcode) == FALSE)
exitcode = 111;
else if(exitcode == STILL_ACTIVE)
goto restart;
processp->code = exitcode;
}
/*
* processpp points to the process that successfully exited.
* Build the result as
* bool * pid * exitcode
* bool is true iff exited
*/
done:
processp = *processpp;
processp->changed = 0;
#ifdef OSH_DEBUG
fprintf(stderr, "+++ wait: pid=%d, group=%d, status=%d\n", processp->pid, processp->pgrp, processp->status);
#endif
tuple = caml_alloc_small(3, 0);
Field(tuple, 1) = Val_int(processp->pid);
Field(tuple, 2) = Val_int(processp->code);
switch(processp->status) {
case STATUS_STOPPED:
Field(tuple, 0) = Val_false;
break;
case STATUS_EXITED:
Field(tuple, 0) = Val_true;
CloseHandle(processp->handle);
*processpp = processp->next;
free(processp);
break;
case STATUS_RUNNING:
default:
caml_invalid_argument("wait_process: process is running");
break;
}
CAMLreturn(tuple);
}
