CAMLprim value unix_getgrnam(value name)
{
struct group * entry;
if (! caml_string_is_c_safe(name)) raise_not_found();
entry = getgrnam(String_val(name));
if (entry == NULL) raise_not_found();
return alloc_group_entry(entry);
}
CAMLprim value unix_getprotobyname(value name)
{
struct protoent * entry;
if (! caml_string_is_c_safe(name)) raise_not_found();
entry = getprotobyname(String_val(name));
if (entry == (struct protoent *) NULL) raise_not_found();
return alloc_proto_entry(entry);
}
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_getpwnam(value name)
{
struct passwd * entry;
entry = getpwnam(String_val(name));
if (entry == (struct passwd *) NULL) raise_not_found();
return alloc_passwd_entry(entry);
}
CAMLprim value unix_getpwuid(value uid)
{
struct passwd * entry;
entry = getpwuid(Int_val(uid));
if (entry == (struct passwd *) NULL) raise_not_found();
return alloc_passwd_entry(entry);
}
//+ external get : t -> get_type -> get_flag list -> string * string
//+ = "caml_cursor_get"
value caml_cursor_get(value cursor, value vtype, value vflags) {
CAMLparam3(cursor,vtype,vflags);
CAMLlocal3(rpair,rkey,rdata);
DBT key,data;
int flags = Flag_val(vtype,cursor_get_type) |
convert_flag_list(vflags,cursor_get_flags);
int err;
zerob(&key,sizeof(DBT)); zerob(&data,sizeof(DBT));
test_cursor_closed(cursor);
err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data,flags);
if (err != 0) {
if (err == DB_NOTFOUND) { raise_not_found(); }
raise_db(db_strerror(err));
}
rkey = alloc_string(key.size);
memcpy (String_val(rkey), key.data, key.size);
rdata = alloc_string(data.size);
memcpy (String_val(rdata), data.data, data.size);
rpair = alloc(2,0);
Store_field(rpair,0,rkey);
Store_field(rpair,1,rdata);
CAMLreturn (rpair);
}
//+ external init_both : t -> key:string -> data:string
//+ -> get_flag list -> unit = "caml_cursor_init_both"
value caml_cursor_init_both(value cursor, value vkey,
value vdata , value vflags
) {
CAMLparam4(cursor,vkey,vdata,vflags);
DBT key,data;
int flags;
int err;
/* int ctr = 0; */
flags = convert_flag_list(vflags,cursor_get_flags) | DB_GET_BOTH;
test_cursor_closed(cursor);
zerob(&key,sizeof(DBT)); zerob(&data,sizeof(DBT));
key.data = String_val(vkey);
key.size = string_length(vkey);
data.data = String_val(vdata);
data.size = string_length(vdata);
err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data, flags);
if (err != 0) {
if (err == DB_NOTFOUND) { raise_not_found (); }
raise_db(db_strerror(err));
}
CAMLreturn (Val_unit);
}
CAMLprim value unix_gethostbyaddr(value a)
{
struct in_addr adr = GET_INET_ADDR(a);
struct hostent * hp;
#if HAS_GETHOSTBYADDR_R == 7
struct hostent h;
char buffer[NETDB_BUFFER_SIZE];
int h_errnop;
enter_blocking_section();
hp = gethostbyaddr_r((char *) &adr, 4, AF_INET,
&h, buffer, sizeof(buffer), &h_errnop);
leave_blocking_section();
#elif HAS_GETHOSTBYADDR_R == 8
struct hostent h;
char buffer[NETDB_BUFFER_SIZE];
int h_errnop, rc;
enter_blocking_section();
rc = gethostbyaddr_r((char *) &adr, 4, AF_INET,
&h, buffer, sizeof(buffer), &hp, &h_errnop);
leave_blocking_section();
if (rc != 0) hp = NULL;
#else
#ifdef GETHOSTBYADDR_IS_REENTRANT
enter_blocking_section();
#endif
hp = gethostbyaddr((char *) &adr, 4, AF_INET);
#ifdef GETHOSTBYADDR_IS_REENTRANT
leave_blocking_section();
#endif
#endif
if (hp == (struct hostent *) NULL) raise_not_found();
return alloc_host_entry(hp);
}
CAMLprim value unix_getservbyport(value port, value proto)
{
struct servent * entry;
entry = getservbyport(htons(Int_val(port)), String_val(proto));
if (entry == (struct servent *) NULL) raise_not_found();
return alloc_service_entry(entry);
}
CAMLprim value unix_getprotobynumber(value proto)
{
struct protoent * entry;
entry = getprotobynumber(Int_val(proto));
if (entry == (struct protoent *) NULL) raise_not_found();
return alloc_proto_entry(entry);
}
CAMLprim value unix_getservbyname(value name, value proto)
{
struct servent * entry;
entry = getservbyname(String_val(name), String_val(proto));
if (entry == (struct servent *) NULL) raise_not_found();
return alloc_service_entry(entry);
}
CAMLprim value unix_getgrgid(value gid)
{
struct group * entry;
entry = getgrgid(Int_val(gid));
if (entry == NULL) raise_not_found();
return alloc_group_entry(entry);
}
//+ external get : t -> ?txn:txn -> string -> get_flag list -> string
//+ = "caml_db_get"
value caml_db_get(value db, value txn_opt, value vkey, value vflags) {
CAMLparam4(db, txn_opt, vkey, vflags);
DBT key,data;
int flags, err;
DB_TXN *txn;
CAMLlocal1(rval);
if (Is_None(txn_opt)) { txn = NULL; }
else {
test_txn_closed(Some_val(txn_opt));
txn = UW_txn(Some_val(txn_opt));
}
test_db_closed(db);
zerob(&key,sizeof(DBT)); zerob(&data,sizeof(DBT));
key.data = String_val(vkey);
key.size = string_length(vkey);
flags = convert_flag_list(vflags, db_get_flags);
err = UW_db(db)->get(UW_db(db), txn, &key, &data, flags);
if (err != 0) {
////fprintf(stderr,"Error found: %d\n",err); fflush(stderr);
if (err == DB_NOTFOUND) { raise_not_found(); }
UW_db(db)->err(UW_db(db),err,"caml_db_get");
}
// FIX: this currently uses an extra, unnecessary copy in order to simplify
// memory management.
rval = alloc_string(data.size);
memcpy (String_val(rval), data.data, data.size);
CAMLreturn (rval);
}
CAMLprim value unix_getnameinfo(value vaddr, value vopts)
{
CAMLparam0();
CAMLlocal3(vhost, vserv, vres);
union sock_addr_union addr;
socklen_param_type addr_len;
char host[4096];
char serv[1024];
int opts, retcode;
get_sockaddr(vaddr, &addr, &addr_len);
opts = convert_flag_list(vopts, getnameinfo_flag_table);
enter_blocking_section();
retcode =
getnameinfo((const struct sockaddr *) &addr.s_gen, addr_len,
host, sizeof(host), serv, sizeof(serv), opts);
leave_blocking_section();
if (retcode != 0) raise_not_found(); /* TODO: detailed error reporting? */
vhost = copy_string(host);
vserv = copy_string(serv);
vres = alloc_small(2, 0);
Field(vres, 0) = vhost;
Field(vres, 1) = vserv;
CAMLreturn(vres);
}
CAMLprim value
netcgi2_apache_request_main (value rv)
{
CAMLparam1 (rv);
request_rec *r = Request_rec_val (rv), *rr = r->main;
if (rr)
CAMLreturn (Val_request_rec (rr));
else
raise_not_found ();
}
CAMLprim value
netcgi2_apache_request_content_type (value rv)
{
CAMLparam1 (rv);
request_rec *r = Request_rec_val (rv);
if (r->content_type)
CAMLreturn (copy_string (r->content_type));
else
raise_not_found ();
}
CAMLprim value
netcgi2_apache_request_args (value rv)
{
CAMLparam1 (rv);
request_rec *r = Request_rec_val (rv);
if (r->args)
CAMLreturn (copy_string (r->args));
else
raise_not_found ();
}
CAMLprim value
netcgi2_apache_server_admin(value sv)
{
CAMLparam1(sv);
server_rec *s = Server_rec_val(sv);
if (s->server_admin)
CAMLreturn(copy_string(s->server_admin));
else
raise_not_found();
}
value caml_dbm_nextkey(value vdb) /* ML */
{
datum key = dbm_nextkey(extract_dbm(vdb));
if (key.dptr) {
value res = alloc_string(key.dsize);
memmove (String_val (res), key.dptr, key.dsize);
return res;
}
else raise_not_found();
}
CAMLprim value
netcgi2_apache_table_get (value tv, value str)
{
CAMLparam2(tv, str);
table *t = Table_val (tv);
const char *res = apr_table_get(t, String_val (str));
if (res)
CAMLreturn (copy_string (res));
else
raise_not_found ();
}
value ml_ints_of_string(value s_v)
{
char *s = String_val(s_v);
uint a1,a2,a3,a4;
value res;
char *curs = s;
char *first;
char c;
while(*curs == ' ') curs++;
first = curs;
while(isdigit(*curs)) curs++;
if(*curs != '.' || curs == first || curs - first > 3) goto error;
*curs = 0;
a1 = atoi(first);
*curs++ = '.';
first = curs;
while(isdigit(*curs)) curs++;
if(*curs != '.' || curs == first || curs - first > 3) goto error;
*curs = 0;
a2 = atoi(first);
*curs++ = '.';
first = curs;
while(isdigit(*curs)) curs++;
if(*curs != '.' || curs == first || curs - first > 3) goto error;
*curs = 0;
a3 = atoi(first);
*curs++ = '.';
first = curs;
while(isdigit(*curs)) curs++;
if(curs == first || curs - first > 3) goto error;
c = *curs; *curs = 0;
a4 = atoi(first);
*curs++ = c;
/* sscanf(s, "%d.%d.%d.%d", &a1, &a2, &a3, &a4); */
goto ok;
error:
/* printf("Error while parsing[%s]\n",s); */
raise_not_found();
/* a1 = a2 = a3 = a4 = 0; */
ok:
res = alloc(4,0);
Field(res, 0) = Val_int(a1);
Field(res, 1) = Val_int(a2);
Field(res, 2) = Val_int(a3);
Field(res, 3) = Val_int(a4);
return res;
}
/* Dbm.fetch: t -> string -> string */
value caml_dbm_fetch(value vdb, value vkey) /* ML */
{
datum key,answer;
key.dptr = String_val(vkey);
key.dsize = string_length(vkey);
answer = dbm_fetch(extract_dbm(vdb), key);
if (answer.dptr) {
value res = alloc_string(answer.dsize);
memmove (String_val (res), answer.dptr, answer.dsize);
return res;
}
else raise_not_found();
}
CAMLprim value netcgi2_apache_auth_type(value rv)
{
CAMLparam1(rv);
request_rec *r = Request_rec_val(rv);
#if APACHE2
if (r->ap_auth_type)
CAMLreturn(copy_string(r->ap_auth_type));
#else
if (r->connection->ap_auth_type)
CAMLreturn(copy_string(r->connection->ap_auth_type));
#endif
else
raise_not_found();
}
CAMLprim value
netcgi2_apache_get_dir_config (value rv)
{
CAMLparam1 (rv);
CAMLlocal1 (config);
request_rec *r = Request_rec_val (rv);
if (r->per_dir_config) {
void *c = ap_get_module_config (r->per_dir_config, &netcgi_module);
if (c) config = *(value *) c;
else goto not_found;
} else
not_found:
raise_not_found ();
CAMLreturn (config);
}
extern CAMLprim
value kc_replace(value caml_db, value key, value val)
{
CAMLparam3(caml_db, key, val);
KCDB* db = get_db(caml_db);
if (! kcdbreplace(db,
String_val(key), caml_string_length(key),
String_val(val), caml_string_length(val)
)) {
if (kcdbecode(db) == KCENOREC) raise_not_found();
else RAISE(kcdbemsg(db));
}
CAMLreturn(Val_unit);
}
value caml_read_history(value name) {
CAMLparam1(name);
int result;
result = read_history( String_val(name) );
if (result == ENOENT) {
raise_not_found();
}
else if (result != 0) {
CAMLlocal1(error);
error = copy_string(strerror( result ));
raise_sys_error( error );
}
CAMLreturn(Val_unit);
}
CAMLprim value win_getenv(value var)
{
LPWSTR s;
DWORD len;
CAMLparam1(var);
CAMLlocal1(res);
s = stat_alloc (65536);
len = GetEnvironmentVariableW((LPCWSTR) String_val(var), s, 65536);
if (len == 0) { stat_free (s); raise_not_found(); }
res = copy_wstring(s);
stat_free (s);
CAMLreturn (res);
}
extern CAMLprim
value kc_find(value caml_db, value key)
{
CAMLparam2(caml_db, key);
CAMLlocal1(val);
KCDB* db = get_db(caml_db);
if (! kcdbaccept(db,
String_val(key), caml_string_length(key),
get_the_value, found_no_value, &val, 0
)) {
RAISE(kcdbemsg(db));
}
if ((char*)val == NULL) raise_not_found();
CAMLreturn(val);
}
/*
* 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)
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);
}
//+ external init : t -> string -> get_flag list -> string
//+ = "caml_cursor_init"
value caml_cursor_init(value cursor, value vkey, value vflags) {
CAMLparam3(cursor,vkey,vflags);
CAMLlocal1(rval);
DBT key,data;
int flags = convert_flag_list(vflags,cursor_get_flags) | DB_SET;
int err;
test_cursor_closed(cursor);
zerob(&key,sizeof(DBT)); zerob(&data,sizeof(DBT));
key.data = String_val(vkey);
key.size = string_length(vkey);
err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data, flags);
if (err != 0) {
if (err == DB_NOTFOUND) { raise_not_found(); }
raise_db(db_strerror(err));
}
rval = alloc_string(data.size);
memcpy (String_val(rval), data.data, data.size);
CAMLreturn (rval);
}
