CAMLprim value netsys_openat(value dirfd, value path, value flags, value perm)
{
#ifdef HAVE_AT
CAMLparam4(dirfd, path, flags, perm);
int ret, cv_flags;
char * p;
/* shamelessly copied from ocaml distro */
cv_flags = convert_flag_list(flags, open_flag_table);
p = stat_alloc(string_length(path) + 1);
strcpy(p, String_val(path));
enter_blocking_section();
ret = openat(Int_val(dirfd), p, cv_flags, Int_val(perm));
leave_blocking_section();
stat_free(p);
if (ret == -1) uerror("openat", path);
#if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC)
if (convert_flag_list(flags, open_cloexec_table) != 0) {
int flags = fcntl(Int_val(dirfd), F_GETFD, 0);
if (flags == -1 || fcntl(Int_val(dirfd), F_SETFD, flags | FD_CLOEXEC) == -1)
uerror("openat", path);
}
#endif
CAMLreturn (Val_int(ret));
#else
invalid_argument("Netsys_posix.openat not available");
#endif
}
CAMLprim value unix_recv(value sock, value buff, value ofs, value len,
value flags)
{
SOCKET s = Socket_val(sock);
int flg = convert_flag_list(flags, msg_flag_table);
int ret;
intnat numbytes;
char iobuf[UNIX_BUFFER_SIZE];
DWORD err = 0;
Begin_root (buff);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
enter_blocking_section();
ret = recv(s, iobuf, (int) numbytes, flg);
if (ret == -1) err = WSAGetLastError();
leave_blocking_section();
if (ret == -1) {
win32_maperr(err);
uerror("recv", Nothing);
}
memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
End_roots();
return Val_int(ret);
}
//+ 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);
}
CAMLprim value netsys_faccessat(value dirfd, value path, value perms,
value flags)
{
#ifdef HAVE_AT
int ret, cv_perms, cv_flags;
cv_perms = convert_flag_list(perms, access_permission_table);
cv_flags = convert_flag_list(flags, at_flags_table);
cv_flags &= (AT_EACCESS | AT_SYMLINK_NOFOLLOW);
ret = faccessat(Int_val(dirfd), String_val(path), cv_perms, cv_flags);
if (ret == -1)
uerror("faccessat", path);
return Val_unit;
#else
invalid_argument("Netsys_posix.faccessat not available");
#endif
}
//+ 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);
}
//+ external dopen : t -> string -> db_type -> open_flag list
//+ -> int -> unit = "caml_db_open"
value caml_db_open(value db, value vfname,
value vdbtype, value vflags,
value vmode){
CAMLparam5(db, vfname, vdbtype, vflags, vmode);
int err;
char *fname = String_val(vfname);
int flags = convert_flag_list(vflags,db_open_flags);
int dbtype = Flag_val(vdbtype,db_types);
test_db_closed(db);
err = UW_db(db)->open(UW_db(db),
NULL,
fname,
NULL, /* no support for multiple databases in
a single file */
dbtype,
flags, /* automatic transaction on database open */
Long_val(vmode) );
if (err != 0) {
UW_db(db)->err(UW_db(db),err,
"caml_db_open");
}
CAMLreturn (Val_unit);
}
//+ external create : ?dbenv:Dbenv.t -> create_flag list -> t =
//+ "caml_db_create"
value caml_db_create(value dbenv_opt, value vflags){
CAMLparam2(dbenv_opt,vflags);
int err;
int flags;
DB *db;
DB_ENV *dbenv;
CAMLlocal1(rval);
/* The flags parameter is currently unused, and must be set to 0. */
if (vflags != Val_emptylist)
invalid_argument("DB.create invalid create flag");
flags = convert_flag_list(vflags,db_create_flags);
if (Is_None(dbenv_opt)) { dbenv = NULL; }
else {
test_dbenv_closed(Some_val(dbenv_opt));
dbenv = UW_dbenv(Some_val(dbenv_opt));
}
err = db_create(&db,dbenv,flags);
if (err != 0) { raise_db(db_strerror(err)); }
db->set_errcall(db,raise_db_cb);
rval = alloc_custom(&db_custom,Camldb_wosize,0,1);
UW_db(rval) = db;
UW_db_closed(rval) = False;
CAMLreturn (rval);
}
//+ external ajoin : ?nosort:bool -> db -> cursor array -> get_flag list ->
//+ cursor = "caml_join_cursors"
//+ let join ?nosort db cursor_list get_flag_list =
//+ ajoin ?nosort db (Array.of_list cursor_list) get_flag_list
value caml_join_cursors(value vnosort, value db,
value vcursors, value vflags) {
CAMLparam4(vnosort,db,vcursors,vflags);
CAMLlocal1(rval);
DBC *jcurs; // pointer to joined cursor
int carray_len = Wosize_val(vcursors);
int flags = convert_flag_list(vflags,cursor_get_flags);
DBC *cursors[carray_len + 1];
int i;
if (Is_Some(vnosort) && Bool_val(vnosort)) {
flags = flags | DB_JOIN_NOSORT;
}
for (i=0; i < carray_len; i++) {
if (UW_cursor_closed(Field(vcursors,i))) {
invalid_argument("caml_join_cursors: Attempt to use closed cursor");
}
cursors[i] = UW_cursor(Field(vcursors,i));
}
cursors[i] = NULL;
test_db_closed(db);
UW_db(db)->join(UW_db(db),cursors,&jcurs,flags);
rval = alloc_custom(&cursor_custom,Camlcursor_wosize,0,1);
UW_cursor(rval) = jcurs;
UW_cursor_closed(rval) = False;
CAMLreturn (rval);
}
CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len,
value flags)
{
int ret, cv_flags;
long numbytes;
char iobuf[UNIX_BUFFER_SIZE];
value res;
value adr = Val_unit;
union sock_addr_union addr;
socklen_param_type addr_len;
cv_flags = convert_flag_list(flags, msg_flag_table);
Begin_roots2 (buff, adr);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
addr_len = sizeof(addr);
enter_blocking_section();
ret = recvfrom(Int_val(sock), iobuf, (int) numbytes, cv_flags,
&addr.s_gen, &addr_len);
leave_blocking_section();
if (ret == -1) uerror("recvfrom", Nothing);
memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
adr = alloc_sockaddr(&addr, addr_len, -1);
res = alloc_small(2, 0);
Field(res, 0) = Val_int(ret);
Field(res, 1) = adr;
End_roots();
return res;
}
//+ external txn_begin : dbenv -> t option -> begin_flag list -> t
//+ = "caml_txn_begin"
value caml_txn_begin(value dbenv, value parent_opt, value vflags) {
CAMLparam3(dbenv,parent_opt,vflags);
CAMLlocal1(rval);
int err,flags;
DB_TXN *parent, *newtxn;
test_dbenv_closed(dbenv);
flags = convert_flag_list(vflags,txn_begin_flags);
if (Is_None(parent_opt)) { parent = NULL; }
else {
test_txn_closed(Some_val(parent_opt));
parent = UW_txn(Some_val(parent_opt));
//printf("********* parented transaction ***************\n"); fflush(stdout);
}
err = UW_dbenv(dbenv)->txn_begin(UW_dbenv(dbenv), parent, &newtxn, flags);
if (err != 0) {
if (err == ENOMEM) {
failwith("Maximum # of concurrent transactions reached");
} else {
UW_dbenv(dbenv)->err(UW_dbenv(dbenv), err,"caml_txn_begin");
}
}
rval = alloc_custom(&txn_custom,Camltxn_wosize,0,1);
UW_txn(rval) = newtxn;
UW_txn_closed(rval) = False;
CAMLreturn(rval);
}
//+ 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_recvfrom(value sock, value buff, value ofs, value len, value flags)
{
SOCKET s = Socket_val(sock);
int flg = convert_flag_list(flags, msg_flag_table);
int ret;
intnat numbytes;
char iobuf[UNIX_BUFFER_SIZE];
value res;
value adr = Val_unit;
union sock_addr_union addr;
socklen_param_type addr_len;
DWORD err = 0;
Begin_roots2 (buff, adr);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
addr_len = sizeof(sock_addr);
enter_blocking_section();
ret = recvfrom(s, iobuf, (int) numbytes, flg, &addr.s_gen, &addr_len);
if (ret == -1) err = WSAGetLastError();
leave_blocking_section();
if (ret == -1) {
win32_maperr(err);
uerror("recvfrom", Nothing);
}
memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
adr = alloc_sockaddr(&addr, addr_len, -1);
res = alloc_small(2, 0);
Field(res, 0) = Val_int(ret);
Field(res, 1) = adr;
End_roots();
return res;
}
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);
}
value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest)
{
SOCKET s = Socket_val(sock);
int flg = convert_flag_list(flags, msg_flag_table);
int ret;
intnat numbytes;
char iobuf[UNIX_BUFFER_SIZE];
union sock_addr_union addr;
socklen_param_type addr_len;
DWORD err = 0;
get_sockaddr(dest, &addr, &addr_len);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes);
enter_blocking_section();
ret = sendto(s, iobuf, (int) numbytes, flg, &addr.s_gen, addr_len);
if (ret == -1) err = WSAGetLastError();
leave_blocking_section();
if (ret == -1) {
win32_maperr(err);
uerror("sendto", Nothing);
}
return Val_int(ret);
}
//+ external put : t -> ?txn:txn -> key:string -> data:string
//+ -> put_flag list -> unit = "caml_db_put"
value caml_db_put(value db, value txn_opt, value vkey,
value vdata, value vflags) {
CAMLparam5(db, txn_opt, vkey, vdata, vflags);
DBT key, data;
int flags, err;
DB_TXN *txn;
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);
data.data = String_val(vdata);
data.size = string_length(vdata);
flags = convert_flag_list(vflags, db_put_flags);
err = UW_db(db)->put(UW_db(db), txn, &key, &data, flags);
if (err != 0) {
if (err == DB_KEYEXIST) {raise_key_exists();}
UW_db(db)->err(UW_db(db),err,"caml_db_put");
}
CAMLreturn (Val_unit);
}
CAMLprim value win_waitpid(value vflags, value vpid_req)
{
int flags;
DWORD status, retcode;
HANDLE pid_req = (HANDLE) Long_val(vpid_req);
DWORD err = 0;
flags = convert_flag_list(vflags, wait_flag_table);
if ((flags & CAML_WNOHANG) == 0) {
enter_blocking_section();
retcode = WaitForSingleObject(pid_req, INFINITE);
if (retcode == WAIT_FAILED) err = GetLastError();
leave_blocking_section();
if (err) {
win32_maperr(err);
uerror("waitpid", Nothing);
}
}
if (! GetExitCodeProcess(pid_req, &status)) {
win32_maperr(GetLastError());
uerror("waitpid", Nothing);
}
if (status == STILL_ACTIVE)
return alloc_process_status((HANDLE) 0, 0);
else {
CloseHandle(pid_req);
return alloc_process_status(pid_req, status);
}
}
value sys_open(value path, value flags, value perm)
{
int ret;
ret = open(String_val(path), convert_flag_list(flags, sys_open_flags),
VAL_TO_INT(perm));
if (ret == -1) sys_error(String_val(path));
return LONG_TO_VAL(ret);
}
CAMLprim value camltk_dooneevent(value flags)
{
int ret;
CheckInit();
ret = Tk_DoOneEvent(convert_flag_list(flags, event_flag_table));
return Val_int(ret);
}
CAMLprim value win_open (value path, value wpath, value flags, value perm) {
int fileaccess, createflags, fileattrib, filecreate;
SECURITY_ATTRIBUTES attr;
HANDLE h;
CAMLparam4 (path, wpath, flags, perm);
fileaccess = convert_flag_list(flags, open_access_flags);
createflags = convert_flag_list(flags, open_create_flags);
if ((createflags & (O_CREAT | O_EXCL)) == (O_CREAT | O_EXCL))
filecreate = CREATE_NEW;
else if ((createflags & (O_CREAT | O_TRUNC)) == (O_CREAT | O_TRUNC))
filecreate = CREATE_ALWAYS;
else if (createflags & O_TRUNC)
filecreate = TRUNCATE_EXISTING;
else if (createflags & O_CREAT)
filecreate = OPEN_ALWAYS;
else
filecreate = OPEN_EXISTING;
if ((createflags & O_CREAT) && (Int_val(perm) & 0200) == 0)
fileattrib = FILE_ATTRIBUTE_READONLY;
else
fileattrib = FILE_ATTRIBUTE_NORMAL;
attr.nLength = sizeof(attr);
attr.lpSecurityDescriptor = NULL;
attr.bInheritHandle = TRUE;
h = CreateFileW((LPCWSTR) String_val(wpath), fileaccess,
FILE_SHARE_READ | FILE_SHARE_WRITE, &attr,
filecreate, fileattrib, NULL);
if (h == INVALID_HANDLE_VALUE) {
win32_maperr (GetLastError ());
uerror("open", path);
}
if (createflags & O_APPEND) SetFilePointer (h, 0, NULL, FILE_END);
CAMLreturn(win_alloc_handle(h));
}
CAMLprim value unix_access(value path, value perms)
{
int ret, cv_flags;
cv_flags = convert_flag_list(perms, access_permission_table);
ret = access(String_val(path), cv_flags);
if (ret == -1)
uerror("access", path);
return Val_unit;
}
CAMLprim value unix_waitpid(value flags, value pid_req)
{
int pid, status, cv_flags;
cv_flags = convert_flag_list(flags, wait_flag_table);
enter_blocking_section();
pid = waitpid(Int_val(pid_req), &status, cv_flags);
leave_blocking_section();
if (pid == -1) uerror("waitpid", Nothing);
return alloc_process_status(pid, status);
}
CAMLprim value unix_open(value path, value flags, value perm)
{
int fileaccess, createflags, fileattrib, filecreate, sharemode, cloexec;
SECURITY_ATTRIBUTES attr;
HANDLE h;
fileaccess = convert_flag_list(flags, open_access_flags);
sharemode = FILE_SHARE_READ | FILE_SHARE_WRITE
| convert_flag_list(flags, open_share_flags);
createflags = convert_flag_list(flags, open_create_flags);
if ((createflags & (O_CREAT | O_EXCL)) == (O_CREAT | O_EXCL))
filecreate = CREATE_NEW;
else if ((createflags & (O_CREAT | O_TRUNC)) == (O_CREAT | O_TRUNC))
filecreate = CREATE_ALWAYS;
else if (createflags & O_TRUNC)
filecreate = TRUNCATE_EXISTING;
else if (createflags & O_CREAT)
filecreate = OPEN_ALWAYS;
else
filecreate = OPEN_EXISTING;
if ((createflags & O_CREAT) && (Int_val(perm) & 0200) == 0)
fileattrib = FILE_ATTRIBUTE_READONLY;
else
fileattrib = FILE_ATTRIBUTE_NORMAL;
cloexec = convert_flag_list(flags, open_cloexec_flags);
attr.nLength = sizeof(attr);
attr.lpSecurityDescriptor = NULL;
attr.bInheritHandle = cloexec ? FALSE : TRUE;
h = CreateFile(String_val(path), fileaccess,
sharemode, &attr,
filecreate, fileattrib, NULL);
if (h == INVALID_HANDLE_VALUE) {
win32_maperr(GetLastError());
uerror("open", path);
}
return win_alloc_handle(h);
}
/* Dbm.open : string -> Sys.open_flag list -> int -> t */
value caml_dbm_open(value vfile, value vflags, value vmode) /* ML */
{
char *file = String_val(vfile);
int flags = convert_flag_list(vflags, dbm_open_flags);
int mode = Int_val(vmode);
DBM *db = dbm_open(file,flags,mode);
if (db == NULL)
raise_dbm("Can't open file");
else
return (alloc_dbm(db));
}
value sys_open(value path, value flags, value perm) /* ML */
{
int ret;
#ifdef macintosh
extern void set_file_type (char *name, long type);
#if defined(THINK_C) || defined(__MWERKS__)
# define FILE_NAME_SIZE 256
char filename_temp[FILE_NAME_SIZE];
char *expanded;
extern char *unix_to_mac_filename(char *, char *, int);
expanded = unix_to_mac_filename(String_val(path), filename_temp, FILE_NAME_SIZE);
if (expanded == NULL)
ret = -1;
else
ret = open(expanded, convert_flag_list(flags, sys_open_flags));
if ( ret != -1 && convert_flag_list (flags, sys_text_flags)
&& convert_flag_list (flags, sys_write_flags))
set_file_type (expanded, 'TEXT');
#else
ret = open(String_val(path), convert_flag_list(flags, sys_open_flags));
if (ret != -1 && convert_flag_list (flags, sys_text_flags))
set_file_type (String_val (path), 'TEXT');
#endif
#else
ret = open(String_val(path), convert_flag_list(flags, sys_open_flags),
Int_val(perm));
#endif
if (ret == -1) sys_error(String_val(path));
return Val_long(ret);
}
CAMLprim value netsys_unlinkat(value dirfd, value path, value flags)
{
#ifdef HAVE_AT
int cv_flags;
cv_flags = convert_flag_list(flags, at_flags_table);
cv_flags &= AT_REMOVEDIR; /* only allowed flag here */
if (unlinkat(Int_val(dirfd), String_val(path), cv_flags) == -1)
uerror("unlinkat", path);
return Val_unit;
#else
invalid_argument("Netsys_posix.unlinkat not available");
#endif
}
//+ external set_flags : t -> set_flag list -> unit = "caml_db_set_flags"
value caml_db_set_flags(value db, value vflags) {
CAMLparam2(db,vflags);
int flags=0,err;
test_db_closed(db);
flags = convert_flag_list(vflags,db_set_flags);
err = UW_db(db)->set_flags(UW_db(db),flags);
if (err != 0) { UW_db(db)->err(UW_db(db),err,"caml_db_set_flags"); }
CAMLreturn (Val_unit);
}
CAMLprim value stub_sem_open(value path, value flags, value perm, value size) {
CAMLparam4(path, flags, perm, size);
CAMLlocal2(result, perrno);
int s, fs, lerrno;
mode_t mode;
char *p;
size_t plen;
sem_t *sem;
fs = convert_flag_list(flags, open_flag_table);
mode = Int_val(perm);
s = Int_val(size);
plen = caml_string_length(path);
#ifdef NOALLOCA
if (NULL == (p = malloc(msg_len + 1))) {
caml_raise_out_of_memory();
}
#else
p = alloca(plen + 1);
#endif
memcpy(p, String_val(path), plen);
p[plen] = '\0';
caml_release_runtime_system();
sem = sem_open(p, fs, mode, s);
lerrno = errno;
#ifdef NOALLOCA
free(p);
#endif
caml_acquire_runtime_system();
if (SEM_FAILED == sem) {
goto ERROR;
}
result = caml_alloc(1, 0); // Result.Ok
Store_field(result, 0, caml_copy_semaphore(sem));
goto END;
ERROR:
perrno = caml_alloc(2, 0);
Store_field(perrno, 0, eunix); // `EUnix
Store_field(perrno, 1, unix_error_of_code(lerrno));
result = caml_alloc(1, 1); // Result.Error
Store_field(result, 0, perrno);
END:
CAMLreturn(result);
}
CAMLprim value netsys_linkat(value olddirfd, value oldpath,
value newdirfd, value newpath, value flags)
{
#ifdef HAVE_AT
int cv_flags;
cv_flags = convert_flag_list(flags, at_flags_table);
cv_flags &= AT_SYMLINK_FOLLOW; /* only allowed flag here */
if (linkat(Int_val(olddirfd), String_val(oldpath),
Int_val(newdirfd), String_val(newpath), cv_flags) == -1)
uerror("linkat", oldpath);
return Val_unit;
#else
invalid_argument("Netsys_posix.linkat not available");
#endif
}
CAMLprim value unix_open(value path, value flags, value perm)
{
CAMLparam3(path, flags, perm);
int ret, cv_flags;
char * p;
cv_flags = convert_flag_list(flags, open_flag_table);
p = stat_alloc(string_length(path) + 1);
strcpy(p, String_val(path));
/* open on a named FIFO can block (PR#1533) */
enter_blocking_section();
ret = open(p, cv_flags, Int_val(perm));
leave_blocking_section();
stat_free(p);
if (ret == -1) uerror("open", path);
CAMLreturn (Val_int(ret));
}
CAMLprim value unix_send(value sock, value buff, value ofs, value len,
value flags)
{
int ret, cv_flags;
long numbytes;
char iobuf[UNIX_BUFFER_SIZE];
cv_flags = convert_flag_list(flags, msg_flag_table);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes);
enter_blocking_section();
ret = send(Int_val(sock), iobuf, (int) numbytes, cv_flags);
leave_blocking_section();
if (ret == -1) uerror("send", Nothing);
return Val_int(ret);
}
