value caml_inotify_add_watch(value fd, value path, value selector_flags) {
CAMLparam3(fd, path, selector_flags);
int selector = caml_convert_flag_list(selector_flags, inotify_flag_table);
int watch = inotify_add_watch(Int_val(fd), String_val(path), selector);
if (watch == -1) uerror("inotify_add_watch", path);
CAMLreturn(Val_int(watch));
}
CAMLprim value caml_extunix_linkat(value v_olddirfd, value v_oldname, value v_newdirfd, value v_newname, value v_flags)
{
CAMLparam5(v_olddirfd, v_oldname, v_newdirfd, v_newname, v_flags);
int ret = 0;
int flags = caml_convert_flag_list(v_flags, at_flags_table);
flags &= AT_SYMLINK_FOLLOW; /* only allowed flag here */
ret = linkat(Int_val(v_olddirfd), String_val(v_oldname), Int_val(v_newdirfd), String_val(v_newname), flags);
if (ret != 0) uerror("linkat", v_oldname);
CAMLreturn(Val_unit);
}
value stub_inotify_add_watch(value fd, value path, value mask)
{
CAMLparam3(fd, path, mask);
int cv_mask, wd;
cv_mask = caml_convert_flag_list(mask, inotify_flag_table);
wd = inotify_add_watch(Int_val(fd), String_val(path), cv_mask);
if (wd < 0)
caml_failwith("inotify_add_watch");
CAMLreturn(Val_int(wd));
}
CAMLprim value unix_waitpid(value flags, value pid_req)
{
int pid, status, cv_flags;
cv_flags = caml_convert_flag_list(flags, wait_flag_table);
caml_enter_blocking_section();
pid = waitpid(Int_val(pid_req), &status, cv_flags);
caml_leave_blocking_section();
if (pid == -1) uerror("waitpid", Nothing);
return alloc_process_status(pid, status);
}
CAMLprim value unix_posix_openpt(value flags)
{
CAMLparam1(flags);
int fd, cv_flags;
cv_flags = caml_convert_flag_list(flags, posix_openpt_flag_table);
caml_enter_blocking_section();
fd = posix_openpt(cv_flags);
caml_leave_blocking_section();
if (fd == -1) uerror("posix_openpt", Nothing);
CAMLreturn (Val_int(fd));
}
CAMLprim value caml_extunix_unlinkat(value v_dirfd, value v_name, value v_flags)
{
CAMLparam3(v_dirfd, v_name, v_flags);
char* p = caml_stat_alloc(caml_string_length(v_name) + 1);
int ret = 0;
int flags = caml_convert_flag_list(v_flags, at_flags_table);
flags &= AT_REMOVEDIR; /* only allowed flag here */
strcpy(p, String_val(v_name));
caml_enter_blocking_section();
ret = unlinkat(Int_val(v_dirfd), p, flags);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret != 0) uerror("unlinkat", v_name);
CAMLreturn(Val_unit);
}
CAMLprim value caml_extunix_fstatat(value v_dirfd, value v_name, value v_flags)
{
CAMLparam3(v_dirfd, v_name, v_flags);
int ret;
struct stat buf;
char* p = caml_stat_alloc(caml_string_length(v_name) + 1);
int flags = caml_convert_flag_list(v_flags, at_flags_table);
flags &= (AT_SYMLINK_NOFOLLOW | AT_NO_AUTOMOUNT); /* only allowed flags here */
strcpy(p, String_val(v_name));
caml_enter_blocking_section();
ret = fstatat(Int_val(v_dirfd), p, &buf, flags);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret != 0) uerror("fstatat", v_name);
if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG)
unix_error(EOVERFLOW, "fstatat", v_name);
CAMLreturn(stat_aux(/*0,*/ &buf));
}
CAMLprim value caml_sys_open(value path, value vflags, value vperm)
{
CAMLparam3(path, vflags, vperm);
int fd, flags, perm;
char * p;
p = caml_stat_alloc(caml_string_length(path) + 1);
strcpy(p, String_val(path));
flags = caml_convert_flag_list(vflags, sys_open_flags);
perm = Int_val(vperm);
/* open on a named FIFO can block (PR#1533) */
caml_enter_blocking_section();
fd = open(p, flags, perm);
caml_leave_blocking_section();
caml_stat_free(p);
if (fd == -1) caml_sys_error(path);
#if defined(F_SETFD) && defined(FD_CLOEXEC)
fcntl(fd, F_SETFD, FD_CLOEXEC);
#endif
CAMLreturn(Val_long(fd));
}
CAMLprim value stub_xc_domain_save(value handle, value fd, value domid,
value max_iters, value max_factors,
value flags, value hvm)
{
CAMLparam5(handle, fd, domid, max_iters, max_factors);
CAMLxparam2(flags, hvm);
struct save_callbacks callbacks;
uint32_t c_flags;
uint32_t c_domid;
int r;
unsigned long generation_id_addr;
c_flags = caml_convert_flag_list(flags, suspend_flag_list);
c_domid = _D(domid);
memset(&callbacks, 0, sizeof(callbacks));
callbacks.data = (void*) c_domid;
callbacks.suspend = dispatch_suspend;
callbacks.switch_qemu_logdirty = switch_qemu_logdirty;
caml_enter_blocking_section();
generation_id_addr = xenstore_get(c_domid, GENERATION_ID_ADDRESS);
r = xc_domain_save(_H(handle), Int_val(fd), c_domid,
Int_val(max_iters), Int_val(max_factors),
c_flags, &callbacks, Bool_val(hvm)
#ifdef XENGUEST_4_2
,generation_id_addr
#endif
);
caml_leave_blocking_section();
if (r)
failwith_oss_xc(_H(handle), "xc_domain_save");
CAMLreturn(Val_unit);
}
CAMLprim value
caml_backpack_mq_open(value val_name, value val_flags, value val_mode, value val_attr)
{
CAMLparam4(val_name, val_flags, val_mode, val_attr);
CAMLlocal1(val_res);
int flags = caml_convert_flag_list(val_flags, mqueue_flags);
struct mq_attr attr, *pattr;
mqd_t mq;
if (Is_long(val_attr))
pattr = NULL;
else {
attr.mq_maxmsg = Long_val(Field(Field(val_attr, 0), 0));
attr.mq_msgsize = Long_val(Field(Field(val_attr, 0), 1));
pattr = &attr;
}
if ((mq = mq_open(String_val(val_name), flags, Int_val(val_mode), pattr)) == -1)
uerror("mq_open", val_name);
val_res = Val_int(mq);
CAMLreturn(val_res);
}
value netsys_copy_value(value flags, value orig)
{
int code;
int cflags;
intnat start_offset, bytelen;
mlsize_t wosize;
char *dest, *dest_end, *extra_block, *extra_block_end;
int color;
struct named_custom_ops bigarray_ops;
struct named_custom_ops int32_ops;
struct named_custom_ops int64_ops;
struct named_custom_ops nativeint_ops;
CAMLparam2(orig,flags);
CAMLlocal1(block);
/* First test on trivial cases: */
if (Is_long(orig) || Wosize_val(orig) == 0) {
CAMLreturn(orig);
};
code = prep_stat_tab();
if (code != 0) goto exit;
code = prep_stat_queue();
if (code != 0) goto exit;
cflags = caml_convert_flag_list(flags, init_value_flags);
/* fprintf (stderr, "counting\n"); */
/* Count only! */
code = netsys_init_value_1(stat_tab, stat_queue, NULL, NULL, orig,
(cflags & 1) ? 1 : 0, /* enable_bigarrays */
(cflags & 2) ? 1 : 0, /* enable_customs */
1, /* enable_atoms */
1, /* simulate */
NULL, NULL, 0, &start_offset, &bytelen);
if (code != 0) goto exit;
/* fprintf (stderr, "done counting bytelen=%ld\n", bytelen); */
/* set up the custom ops. We always set this, because we assume that
the values in [orig] are not trustworthy
*/
bigarray_ops.name = "_bigarray";
bigarray_ops.ops =
Custom_ops_val(alloc_bigarray_dims(CAML_BA_UINT8 | BIGARRAY_C_LAYOUT,
1, NULL, 1));
bigarray_ops.next = &int32_ops;
int32_ops.name = "_i";
int32_ops.ops = Custom_ops_val(caml_copy_int32(0));
int32_ops.next = &int64_ops;
int64_ops.name = "_j";
int64_ops.ops = Custom_ops_val(caml_copy_int64(0));
int64_ops.next = &nativeint_ops;
nativeint_ops.name = "_n";
nativeint_ops.ops = Custom_ops_val(caml_copy_nativeint(0));
nativeint_ops.next = NULL;
/* alloc */
extra_block = NULL;
extra_block_end = NULL;
/* shamelessly copied from intern.c */
wosize = Wosize_bhsize(bytelen);
/* fprintf (stderr, "wosize=%ld\n", wosize); */
if (wosize > Max_wosize) {
/* Round desired size up to next page */
asize_t request = ((bytelen + Page_size - 1) >> Page_log) << Page_log;
extra_block = caml_alloc_for_heap(request);
if (extra_block == NULL) caml_raise_out_of_memory();
extra_block_end = extra_block + request;
color = caml_allocation_color(extra_block);
dest = extra_block;
dest_end = dest + bytelen;
block = Val_hp(extra_block);
} else {
value netsys_init_value(value memv,
value offv,
value orig,
value flags,
value targetaddrv,
value target_custom_ops
)
{
int code;
value r;
intnat start_offset, bytelen;
int cflags;
void *targetaddr;
char *mem_data;
char *mem_end;
intnat off;
struct named_custom_ops *ops, *old_ops, *next_ops;
code = prep_stat_tab();
if (code != 0) goto exit;
code = prep_stat_queue();
if (code != 0) goto exit;
off = Long_val(offv);
if (off % sizeof(void *) != 0) { code=(-2); goto exit; }
cflags = caml_convert_flag_list(flags, init_value_flags);
targetaddr = (void *) (Nativeint_val(targetaddrv) + off);
ops = NULL;
while (Is_block(target_custom_ops)) {
value pair;
old_ops = ops;
pair = Field(target_custom_ops,0);
ops = (struct named_custom_ops*)
stat_alloc(sizeof(struct named_custom_ops));
ops->name = stat_alloc(caml_string_length(Field(pair,0))+1);
strcmp(ops->name, String_val(Field(pair,0)));
ops->ops = (void *) Nativeint_val(Field(pair,1));
ops->next = old_ops;
target_custom_ops = Field(target_custom_ops,1);
};
mem_data = ((char *) Bigarray_val(memv)->data) + off;
mem_end = mem_data + Bigarray_val(memv)->dim[0];
/* note: the color of the new values does not matter because bigarrays
are ignored by the GC. So we pass 0 (white).
*/
code = netsys_init_value_1(stat_tab, stat_queue, mem_data, mem_end, orig,
(cflags & 1) ? 2 : 0,
(cflags & 2) ? 1 : 0,
(cflags & 4) ? 2 : 0,
cflags & 8,
targetaddr, ops, 0,
&start_offset, &bytelen);
if (code != 0) goto exit;
unprep_stat_tab();
unprep_stat_queue();
while (ops != NULL) {
next_ops = ops->next;
stat_free(ops->name);
stat_free(ops);
ops = next_ops;
};
r = caml_alloc_small(2,0);
Field(r,0) = Val_long(start_offset + off);
Field(r,1) = Val_long(bytelen);
return r;
exit:
unprep_stat_queue();
unprep_stat_tab();
switch(code) {
case (-1):
unix_error(errno, "netsys_init_value", Nothing);
case (-2):
failwith("Netsys_mem.init_value: Library error");
case (-4):
caml_raise_constant(*caml_named_value("Netsys_mem.Out_of_space"));
default:
failwith("Netsys_mem.init_value: Unknown error");
}
}
CAMLprim value caml_extunix_recvmsg2(value vfd, value vbuf, value ofs, value vlen,
value vflags)
{
CAMLparam4(vfd, vbuf, ofs, vlen);
CAMLlocal5(vres, vlist, v, vx, vsaddr);
union {
struct cmsghdr hdr;
char buf[CMSG_SPACE(sizeof(int)) /* File descriptor passing */
#ifdef EXTUNIX_HAVE_IP_RECVIF
+ CMSG_SPACE(sizeof(struct sockaddr_dl)) /* IP_RECVIF */
#endif
#ifdef EXTUNIX_HAVE_IP_RECVDSTADDR
+ CMSG_SPACE(sizeof(struct in_addr)) /* IP_RECVDSTADDR */
#endif
];
} cmsgbuf;
struct iovec iov;
struct msghdr msg;
struct cmsghdr *cmsg;
ssize_t n;
size_t len;
char iobuf[UNIX_BUFFER_SIZE];
struct sockaddr_storage ss;
int sendflags;
#ifdef EXTUNIX_HAVE_IP_RECVIF
struct sockaddr_dl *dst = NULL;
#endif
len = Long_val(vlen);
memset(&iov, 0, sizeof(iov));
memset(&msg, 0, sizeof(msg));
if (len > UNIX_BUFFER_SIZE)
len = UNIX_BUFFER_SIZE;
iov.iov_base = iobuf;
iov.iov_len = len;
msg.msg_name = &ss;
msg.msg_namelen = sizeof(ss);
msg.msg_iov = &iov;
msg.msg_iovlen = 1;
msg.msg_control = &cmsgbuf.buf;
msg.msg_controllen = sizeof(cmsgbuf.buf);
sendflags = caml_convert_flag_list(vflags, msg_flag_table);
caml_enter_blocking_section();
n = recvmsg(Int_val(vfd), &msg, sendflags);
caml_leave_blocking_section();
vres = caml_alloc_small(4, 0);
if (n == -1) {
uerror("recvmsg", Nothing);
CAMLreturn (vres);
}
vsaddr = my_alloc_sockaddr(&ss);
memmove(&Byte(vbuf, Long_val(ofs)), iobuf, n);
vlist = Val_int(0);
/* Build the variant list vlist */
for (cmsg = CMSG_FIRSTHDR(&msg); cmsg != NULL;
cmsg = CMSG_NXTHDR(&msg, cmsg)) {
if (cmsg->cmsg_level == SOL_SOCKET &&
cmsg->cmsg_type == SCM_RIGHTS) {
/* CMSG_DATA is aligned, so the following is cool */
v = caml_alloc_small(2, TAG_FILEDESCRIPTOR);
Field(v, 0) = Val_int(*(int *)CMSG_DATA(cmsg));
Field(v, 1) = vlist;
vlist = v;
continue;
}
#ifdef EXTUNIX_HAVE_IP_RECVIF
if (cmsg->cmsg_level == IPPROTO_IP &&
cmsg->cmsg_type == IP_RECVIF) {
dst = (struct sockaddr_dl *)CMSG_DATA(cmsg);
v = caml_alloc_small(2, 0);
vx = caml_alloc_small(1, TAG_IP_RECVIF);
Field(vx, 0) = Val_int(dst->sdl_index);
Field(v, 0) = vx;
Field(v, 1) = vlist;
vlist = v;
continue;
}
#endif
#ifdef EXTUNIX_HAVE_IP_RECVDSTADDR
if (cmsg->cmsg_level == IPPROTO_IP &&
cmsg->cmsg_type == IP_RECVDSTADDR) {
struct in_addr ipdst;
ipdst = *(struct in_addr *)CMSG_DATA(cmsg);
v = caml_alloc_small(2, 0);
vx = caml_alloc_small(1, TAG_IP_RECVDSTADDR);
Field(vx, 0) = caml_alloc_string(4);
memcpy(String_val(Field(vx, 0)), &ipdst, 4);
Field(v, 0) = vx;
Field(v, 1) = vlist;
vlist = v;
continue;
}
#endif
}
/* Now build the result */
Field(vres, 0) = Val_long(n);
Field(vres, 1) = vsaddr;
Field(vres, 2) = vlist;
Field(vres, 3) = int_to_recvflags(msg.msg_flags);
CAMLreturn(vres);
}