static char * cygwin_search_exe_in_path(struct ext_table * path, char * name)
{
char * p, * dir, * fullname;
int i;
for (p = name; *p != 0; p++) {
if (*p == '/' || *p == '\\') goto not_found;
}
for (i = 0; i < path->size; i++) {
dir = path->contents[i];
if (dir[0] == 0) dir = "."; /* empty path component = current dir */
fullname = caml_strconcat(3, dir, "/", name);
if (cygwin_file_exists(fullname)) return fullname;
caml_stat_free(fullname);
fullname = caml_strconcat(4, dir, "/", name, ".exe");
if (cygwin_file_exists(fullname)) return fullname;
caml_stat_free(fullname);
}
not_found:
if (cygwin_file_exists(name)) return caml_strdup(name);
fullname = caml_strconcat(2, name, ".exe");
if (cygwin_file_exists(fullname)) return fullname;
caml_stat_free(fullname);
return caml_strdup(name);
}
CAMLprim value mmdb_ml_dump_per_ip(value ip, value mmdb)
{
CAMLparam2(ip, mmdb);
CAMLlocal1(pulled_string);
unsigned int len = caml_string_length(ip);
char *as_string = caml_strdup(String_val(ip));
if (strlen(as_string) != (size_t)len) {
caml_failwith("Could not copy IP address properly");
}
MMDB_s *as_mmdb = (MMDB_s*)Data_custom_val(mmdb);
int gai_error = 0, mmdb_error = 0;
MMDB_lookup_result_s *result = caml_stat_alloc(sizeof(*result));
*result = MMDB_lookup_string(as_mmdb, as_string, &gai_error, &mmdb_error);
MMDB_entry_data_list_s *entry_data_list = NULL;
int status = MMDB_get_entry_data_list(&result->entry, &entry_data_list);
check_status(status);
char *pulled_from_db = data_from_dump(entry_data_list);
pulled_string = caml_copy_string(pulled_from_db);
caml_stat_free(result);
caml_stat_free(as_string);
caml_stat_free(pulled_from_db);
free(entry_data_list);
as_mmdb = NULL;
CAMLreturn(pulled_string);
}
CAMLprim value caml_natdynlink_open(value filename, value global)
{
CAMLparam2 (filename, global);
CAMLlocal3 (res, handle, header);
void *sym;
void *dlhandle;
char *p;
/* TODO: dlclose in case of error... */
p = caml_strdup(String_val(filename));
caml_enter_blocking_section();
dlhandle = caml_dlopen(String_val(filename), 1, Int_val(global));
caml_leave_blocking_section();
caml_stat_free(p);
if (NULL == dlhandle)
caml_failwith(caml_dlerror());
sym = caml_dlsym(dlhandle, "caml_plugin_header");
if (NULL == sym)
caml_failwith("not an OCaml plugin");
handle = Val_handle(dlhandle);
header = caml_input_value_from_malloc(sym, 0);
res = caml_alloc_tuple(2);
Init_field(res, 0, handle);
Init_field(res, 1, header);
CAMLreturn(res);
}
CAMLprim value caml_sys_rename(value oldname, value newname)
{
char * p_old;
char * p_new;
int ret;
p_old = caml_strdup(String_val(oldname));
p_new = caml_strdup(String_val(newname));
caml_enter_blocking_section();
ret = rename(p_old, p_new);
caml_leave_blocking_section();
caml_stat_free(p_new);
caml_stat_free(p_old);
if (ret != 0)
caml_sys_error(NO_ARG);
return Val_unit;
}
CAMLprim value caml_sys_is_directory(value name)
{
CAMLparam1(name);
#ifdef _WIN32
struct _stati64 st;
#else
struct stat st;
#endif
char * p;
int ret;
p = caml_strdup(String_val(name));
caml_enter_blocking_section();
#ifdef _WIN32
ret = _stati64(p, &st);
#else
ret = stat(p, &st);
#endif
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) caml_sys_error(name);
#ifdef S_ISDIR
CAMLreturn(Val_bool(S_ISDIR(st.st_mode)));
#else
CAMLreturn(Val_bool(st.st_mode & S_IFDIR));
#endif
}
CAMLprim value stub_launch_activate_socket(value name) {
CAMLparam1(name);
CAMLlocal1(result);
const char *c_name = caml_strdup(String_val(name));
int *listening_fds = NULL;
size_t n_listening_fds = 0;
int err;
caml_release_runtime_system();
err = launch_activate_socket(c_name, &listening_fds, &n_listening_fds);
caml_acquire_runtime_system();
caml_stat_free((void*)c_name);
switch (err) {
case 0:
result = caml_alloc_tuple(n_listening_fds);
for (int i = 0; i < n_listening_fds; i++) {
Store_field(result, i, Val_int(*(listening_fds + i)));
}
break;
default:
unix_error(err, "launch_activate_socket", name);
break;
}
CAMLreturn(result);
}
static void expand_pattern(char * pat)
{
char * prefix, * p, * name;
int handle;
struct _finddata_t ffblk;
size_t i;
handle = _findfirst(pat, &ffblk);
if (handle == -1) {
store_argument(pat); /* a la Bourne shell */
return;
}
prefix = caml_strdup(pat);
for (i = strlen(prefix); i > 0; i--) {
char c = prefix[i - 1];
if (c == '\\' || c == '/' || c == ':') {
prefix[i] = 0;
break;
}
}
do {
name = caml_strconcat(2, prefix, ffblk.name);
store_argument(name);
} while (_findnext(handle, &ffblk) != -1);
_findclose(handle);
caml_stat_free(prefix);
}
CAMLprim value caml_natdynlink_open(value filename, value global)
{
CAMLparam1 (filename);
CAMLlocal1 (res);
void *sym;
void *handle;
char *p;
/* TODO: dlclose in case of error... */
p = caml_strdup(String_val(filename));
caml_enter_blocking_section();
handle = caml_dlopen(p, 1, Int_val(global));
caml_leave_blocking_section();
caml_stat_free(p);
if (NULL == handle)
CAMLreturn(caml_copy_string(caml_dlerror()));
sym = caml_dlsym(handle, "caml_plugin_header");
if (NULL == sym)
CAMLreturn(caml_copy_string("not an OCaml plugin"));
res = caml_alloc_tuple(2);
Field(res, 0) = (value) handle;
Field(res, 1) = (value) (sym);
CAMLreturn(res);
}
CAMLexport char * caml_search_exe_in_path(char * name)
{
char * fullname, * filepart;
size_t fullnamelen;
DWORD retcode;
fullnamelen = strlen(name) + 1;
if (fullnamelen < 256) fullnamelen = 256;
while (1) {
fullname = caml_stat_alloc(fullnamelen);
retcode = SearchPath(NULL, /* use system search path */
name,
".exe", /* add .exe extension if needed */
fullnamelen,
fullname,
&filepart);
if (retcode == 0) {
caml_gc_message(0x100, "%s not found in search path\n",
(uintnat) name);
caml_stat_free(fullname);
return caml_strdup(name);
}
if (retcode < fullnamelen)
return fullname;
caml_stat_free(fullname);
fullnamelen = retcode + 1;
}
}
CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol)
{
CAMLparam2 (filename, symbol);
CAMLlocal3 (res, v, handle_v);
void *handle;
char *p;
/* TODO: dlclose in case of error... */
p = caml_strdup(String_val(filename));
caml_enter_blocking_section();
handle = caml_dlopen(p, 1, 1);
caml_leave_blocking_section();
caml_stat_free(p);
if (NULL == handle) {
res = caml_alloc(1,1);
v = caml_copy_string(caml_dlerror());
Store_field(res, 0, v);
} else {
handle_v = Val_handle(handle);
res = caml_alloc(1,0);
v = caml_natdynlink_run(handle_v, symbol);
Store_field(res, 0, v);
}
CAMLreturn(res);
}
CAMLprim value mmdb_ml_open(value s)
{
CAMLparam1(s);
CAMLlocal1(mmdb_handle);
if (polymorphic_variants.poly_bool == 0 ||
polymorphic_variants.poly_float == 0 ||
polymorphic_variants.poly_int == 0 ||
polymorphic_variants.poly_string == 0) {
polymorphic_variants.poly_bool = caml_hash_variant("Bool");
polymorphic_variants.poly_float = caml_hash_variant("Float");
polymorphic_variants.poly_int = caml_hash_variant("Int");
polymorphic_variants.poly_string = caml_hash_variant("String");
}
unsigned int len = caml_string_length(s);
char *copied = caml_strdup(String_val(s));
if (strlen(copied) != (size_t)len) {
caml_failwith("Could not open MMDB database");
}
MMDB_s *this_db = caml_stat_alloc(sizeof(*this_db));
int status = MMDB_open(copied, MMDB_MODE_MMAP, this_db);
mmdb_handle = caml_alloc_custom(&mmdb_custom_ops, sizeof(*this_db), 0, 1);
check_status(status);
memcpy(Data_custom_val(mmdb_handle), this_db, sizeof(*this_db));
caml_stat_free(this_db);
caml_stat_free(copied);
CAMLreturn(mmdb_handle);
}
CAMLprim value caml_sys_chdir(value dirname)
{
CAMLparam1(dirname);
char * p;
int ret;
p = caml_strdup(String_val(dirname));
caml_enter_blocking_section();
ret = chdir(p);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret != 0) caml_sys_error(dirname);
CAMLreturn(Val_unit);
}
CAMLprim value caml_sys_remove(value name)
{
CAMLparam1(name);
char * p;
int ret;
p = caml_strdup(String_val(name));
caml_enter_blocking_section();
ret = unlink(p);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret != 0) caml_sys_error(name);
CAMLreturn(Val_unit);
}
CAMLprim value unix_chown(value path, value uid, value gid)
{
CAMLparam1(path);
char * p;
int ret;
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = chown(p, Int_val(uid), Int_val(gid));
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) uerror("chown", path);
CAMLreturn(Val_unit);
}
CAMLprim value unix_unlink(value path)
{
CAMLparam1(path);
char * p;
int ret;
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = unlink(p);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) uerror("unlink", path);
CAMLreturn(Val_unit);
}
CAMLprim value unix_chmod(value path, value perm)
{
CAMLparam2(path, perm);
char * p;
int ret;
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = chmod(p, Int_val(perm));
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) uerror("chmod", path);
CAMLreturn(Val_unit);
}
CAMLprim value unix_stat_64(value path)
{
CAMLparam1(path);
int ret;
struct stat buf;
char * p;
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = stat(p, &buf);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) uerror("stat", path);
CAMLreturn(stat_aux(1, &buf));
}
CAMLprim value unix_truncate(value path, value len)
{
CAMLparam2(path, len);
char * p;
int ret;
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = truncate(p, Long_val(len));
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1)
uerror("truncate", path);
CAMLreturn(Val_unit);
}
CAMLprim value unix_chroot(value path)
{
CAMLparam1(path);
char * p;
int ret;
caml_unix_check_path(path, "chroot");
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = chroot(p);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) uerror("chroot", path);
CAMLreturn(Val_unit);
}
CAMLprim value unix_gethostbyname(value name)
{
struct hostent * hp;
char * hostname;
#if HAS_GETHOSTBYNAME_R
struct hostent h;
char buffer[NETDB_BUFFER_SIZE];
int err;
#endif
if (! caml_string_is_c_safe(name)) raise_not_found();
#if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT
hostname = caml_strdup(String_val(name));
#else
hostname = String_val(name);
#endif
#if HAS_GETHOSTBYNAME_R == 5
{
enter_blocking_section();
hp = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &err);
leave_blocking_section();
}
#elif HAS_GETHOSTBYNAME_R == 6
{
int rc;
enter_blocking_section();
rc = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &hp, &err);
leave_blocking_section();
if (rc != 0) hp = NULL;
}
#else
#ifdef GETHOSTBYNAME_IS_REENTRANT
enter_blocking_section();
#endif
hp = gethostbyname(hostname);
#ifdef GETHOSTBYNAME_IS_REENTRANT
leave_blocking_section();
#endif
#endif
#if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT
stat_free(hostname);
#endif
if (hp == (struct hostent *) NULL) raise_not_found();
return alloc_host_entry(hp);
}
CAMLprim value unix_readlink(value path)
{
CAMLparam1(path);
char buffer[PATH_MAX];
int len;
char * p;
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
len = readlink(p, buffer, sizeof(buffer) - 1);
caml_leave_blocking_section();
caml_stat_free(p);
if (len == -1) uerror("readlink", path);
buffer[len] = '\0';
CAMLreturn(copy_string(buffer));
}
CAMLprim value unix_mkfifo(value path, value mode)
{
CAMLparam2(path, mode);
char * p;
int ret;
caml_unix_check_path(path, "mkfifo");
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = mknod(p, (Int_val(mode) & 07777) | S_IFIFO, 0);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1)
uerror("mkfifo", path);
CAMLreturn(Val_unit);
}
CAMLprim value unix_truncate_64(value path, value vlen)
{
CAMLparam2(path, vlen);
char * p;
int ret;
file_offset len = File_offset_val(vlen);
caml_unix_check_path(path, "truncate");
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = truncate(p, len);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1)
uerror("truncate", path);
CAMLreturn(Val_unit);
}
CAMLprim value unix_stat(value path)
{
CAMLparam1(path);
int ret;
struct stat buf;
char * p;
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = stat(p, &buf);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1) uerror("stat", path);
if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG)
unix_error(EOVERFLOW, "stat", path);
CAMLreturn(stat_aux(0, &buf));
}
CAMLprim value unix_opendir(value path)
{
CAMLparam1(path);
DIR * d;
value res;
char * p;
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
d = opendir(p);
caml_leave_blocking_section();
caml_stat_free(p);
if (d == (DIR *) NULL) uerror("opendir", path);
res = alloc_small(1, Abstract_tag);
DIR_Val(res) = d;
CAMLreturn(res);
}
char * caml_decompose_path(struct ext_table * tbl, char * path)
{
char * p, * q;
int n;
if (path == NULL) return NULL;
p = caml_strdup(path);
q = p;
while (1) {
for (n = 0; q[n] != 0 && q[n] != ';'; n++) /*nothing*/;
caml_ext_table_add(tbl, q);
q = q + n;
if (*q == 0) break;
*q = 0;
q += 1;
}
return p;
}
CAMLprim value caml_dynlink_open_lib(value mode, value filename)
{
void * handle;
value result;
char * p;
caml_gc_log("Opening shared library %s", String_val(filename));
p = caml_strdup(String_val(filename));
caml_enter_blocking_section();
handle = caml_dlopen(p, Int_val(mode), 1);
caml_leave_blocking_section();
caml_stat_free(p);
if (handle == NULL) caml_failwith(caml_dlerror());
result = caml_alloc_small(1, Abstract_tag);
Handle_val(result) = handle;
return result;
}
CAMLprim value caml_sys_system_command(value command)
{
CAMLparam1 (command);
int status, retcode;
char *buf;
buf = caml_strdup(String_val(command));
caml_enter_blocking_section ();
status = system(buf);
caml_leave_blocking_section ();
caml_stat_free(buf);
if (status == -1) caml_sys_error(command);
if (WIFEXITED(status))
retcode = WEXITSTATUS(status);
else
retcode = 255;
CAMLreturn (Val_int(retcode));
}
char * caml_search_in_path(struct ext_table * path, char * name)
{
char * p, * dir, * fullname;
int i;
struct stat st;
for (p = name; *p != 0; p++) {
if (*p == '/') goto not_found;
}
for (i = 0; i < path->size; i++) {
dir = path->contents[i];
if (dir[0] == 0) dir = "."; /* empty path component = current dir */
fullname = caml_strconcat(3, dir, "/", name);
if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode))
return fullname;
caml_stat_free(fullname);
}
not_found:
return caml_strdup(name);
}
int caml_read_directory(char * dirname, struct ext_table * contents)
{
DIR * d;
#ifdef HAS_DIRENT
struct dirent * e;
#else
struct direct * e;
#endif
d = opendir(dirname);
if (d == NULL) return -1;
while (1) {
e = readdir(d);
if (e == NULL) break;
if (strcmp(e->d_name, ".") == 0 || strcmp(e->d_name, "..") == 0) continue;
caml_ext_table_add(contents, caml_strdup(e->d_name));
}
closedir(d);
return 0;
}