/* _lib7_Sock_recvbuffrom
* : (socket * rw_unt8_vector.Rw_Vector * int * int * Bool * Bool) -> (int * addr)
*
* The arguments are: socket, data buffer, start position, number of
* bytes, OOB flag and peek flag. The result is number of bytes read and
* the source address.
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/socket-guts.pkg
*/
lib7_val_t _lib7_Sock_recvbuffrom (lib7_state_t *lib7_state, lib7_val_t arg)
{
char addrBuf[MAX_SOCK_ADDR_SZB];
int addrLen = MAX_SOCK_ADDR_SZB;
int socket = REC_SELINT(arg, 0);
lib7_val_t buf = REC_SEL(arg, 1);
int nbytes = REC_SELINT(arg, 3);
char *start = STR_LIB7toC(buf) + REC_SELINT(arg, 2);
int flag = 0;
int n;
if (REC_SEL(arg, 4) == LIB7_true) flag |= MSG_OOB;
if (REC_SEL(arg, 5) == LIB7_true) flag |= MSG_PEEK;
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
n = recvfrom (socket, start, nbytes, flag, (struct sockaddr *)addrBuf, &addrLen);
/* } while (n < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
if (n < 0)
return RAISE_SYSERR(lib7_state, status);
else {
lib7_val_t data = LIB7_CData (lib7_state, addrBuf, addrLen);
lib7_val_t addr, res;
SEQHDR_ALLOC (lib7_state, addr, DESC_word8vec, data, addrLen);
REC_ALLOC2(lib7_state, res, INT_CtoLib7(n), addr);
return res;
}
} /* end of _lib7_Sock_recvbuffrom */
/* _lib7_Sock_listen : (socket * int) -> Void
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/socket-guts.pkg
*/
lib7_val_t _lib7_Sock_listen (lib7_state_t *lib7_state, lib7_val_t arg)
{
int socket = REC_SELINT(arg, 0);
int backlog = REC_SELINT(arg, 1);
int status;
status = listen (socket, backlog);
CHECK_RETURN_UNIT(lib7_state, status);
} /* end of _lib7_Sock_listen */
/* _ml_P_Process_waitpid : int * word -> int * int * int
*
* Wait for child processes to stop or terminate
*/
ml_val_t _ml_P_Process_waitpid (ml_state_t *msp, ml_val_t arg)
{
int pid;
int status, how, val;
ml_val_t r;
pid = waitpid(REC_SELINT(arg, 0), &status, REC_SELWORD(arg, 1));
if (pid < 0)
return RAISE_SYSERR(msp, pid);
if (WIFEXITED(status)) {
how = 0;
val = WEXITSTATUS(status);
}
else if (WIFSIGNALED(status)) {
how = 1;
val = WTERMSIG(status);
}
else if (WIFSTOPPED(status)) {
how = 2;
val = WSTOPSIG(status);
}
else
return RAISE_ERROR(msp, "unknown child status");
REC_ALLOC3(msp, r, INT_CtoML(pid), INT_CtoML(how), INT_CtoML(val));
return r;
} /* end of _ml_P_Process_waitpid */
/* _lib7_Sock_recv : (Socket, Int, Bool, Bool) -> unt8_vector::Vector
*
* The arguments are: socket, number of bytes, OOB flag and peek flag; the
* result is the vector of bytes received.
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/socket-guts.pkg
*/
lib7_val_t _lib7_Sock_recv (lib7_state_t *lib7_state, lib7_val_t arg)
{
lib7_val_t vec;
lib7_val_t result;
int n;
int socket = REC_SELINT(arg, 0);
int nbytes = REC_SELINT(arg, 1);
lib7_val_t oob = REC_SEL( arg, 2);
lib7_val_t peek = REC_SEL( arg, 3);
int flag = 0;
if (oob == LIB7_true) flag |= MSG_OOB;
if (peek == LIB7_true) flag |= MSG_PEEK;
/* Allocate the vector.
* Note that this might cause a GC:
*/
vec = LIB7_AllocRaw32 (lib7_state, BYTES_TO_WORDS(nbytes));
print_if("recv.c/before: socket d=%d nbytes d=%d oob=%s peek=%s\n",socket,nbytes,(oob == LIB7_true)?"TRUE":"FALSE",(peek == LIB7_true)?"TRUE":"FALSE");
errno = 0;
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
n = recv (socket, PTR_LIB7toC(char, vec), nbytes, flag);
/* } while (n < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
print_if( "recv.c/after: n d=%d errno d=%d (%s)\n", n, errno, errno ? strerror(errno) : "");
hexdump_if( "recv.c/after: Received data: ", PTR_LIB7toC(unsigned char, vec), n );
if (n < 0)
return RAISE_SYSERR(lib7_state, status);
else if (n == 0)
return LIB7_string0;
if (n < nbytes) {
/* we need to shrink the vector */
LIB7_ShrinkRaw32 (lib7_state, vec, BYTES_TO_WORDS(n));
}
SEQHDR_ALLOC (lib7_state, result, DESC_string, vec, n);
return result;
}
/* _lib7_Date_mktime : (Int, Int, Int, Int, Int, Int, Int, Int, Int)
* -> int32::Int
*
* This takes a 9-tuple with the fields: tm_sec, tm_min, tm_hour, tm_mday,
* tm_mon, tm_year, tm_wday, tm_yday, tm_isdst, and returns the corresponding
* localtime value (in seconds).
*/
lib7_val_t _lib7_Date_mktime (lib7_state_t *lib7_state, lib7_val_t arg)
{
struct tm tm;
time_t t;
tm.tm_sec = REC_SELINT(arg, 0);
tm.tm_min = REC_SELINT(arg, 1);
tm.tm_hour = REC_SELINT(arg, 2);
tm.tm_mday = REC_SELINT(arg, 3);
tm.tm_mon = REC_SELINT(arg, 4);
tm.tm_year = REC_SELINT(arg, 5);
/* tm.tm_wday = REC_SELINT(arg, 6); */ /* ignored by mktime */
/* tm.tm_yday = REC_SELINT(arg, 7); */ /* ignored by mktime */
tm.tm_isdst = REC_SELINT(arg, 8);
t = mktime (&tm);
if (t < 0) {
return RAISE_ERROR(lib7_state, "Invalid date");
}
else {
lib7_val_t result;
INT32_ALLOC(lib7_state, result, t);
return result;
}
}
/* _lib7_P_FileSys_fchown : (int * word * word) -> Void
* fd uid gid
*
* Change owner and group of file given a file descriptor for it.
*/
lib7_val_t _lib7_P_FileSys_fchown (lib7_state_t *lib7_state, lib7_val_t arg)
{
int fd = REC_SELINT (arg, 0);
uid_t uid = REC_SELWORD(arg, 1);
gid_t gid = REC_SELWORD(arg, 2);
int status;
status = fchown (fd, uid, gid);
CHECK_RETURN_UNIT(lib7_state, status)
} /* end of _lib7_P_FileSys_fchown */
/* _lib7_Sock_socketpair : (int * int * int) -> (socket * socket)
*
* Create a pair of sockets. The arguments are: domain (should be
* AF_UNIX), type, and protocol.
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/generic-socket.pkg
*/
lib7_val_t _lib7_Sock_socketpair (lib7_state_t *lib7_state, lib7_val_t arg)
{
int domain = REC_SELINT(arg, 0);
int type = REC_SELINT(arg, 1);
int protocol = REC_SELINT(arg, 2);
int status;
int socket[2];
status = socketpair (domain, type, protocol, socket);
if (status < 0) {
return RAISE_SYSERR(lib7_state, status);
} else {
lib7_val_t res;
REC_ALLOC2(lib7_state, res, INT_CtoLib7(socket[0]), INT_CtoLib7(socket[1]));
return res;
}
} /* end of _lib7_Sock_socketpair */
/* _lib7_P_IO_fcntl_sfd : int * word -> Void
*
* Set the close-on-exec flag associated with the file descriptor.
*/
lib7_val_t _lib7_P_IO_fcntl_sfd (lib7_state_t *lib7_state, lib7_val_t arg)
{
int status;
int fd0 = REC_SELINT(arg, 0);
Word_t flag = REC_SELWORD(arg, 1);
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
status = fcntl(fd0, F_SETFD, flag);
/* } while (status < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
CHECK_RETURN_UNIT(lib7_state,status)
}
/* _lib7_OS_poll : (List (Int, Unt), Null_Or(int32.Int, Int)) -> List (Int, Unt)
*/
lib7_val_t _lib7_OS_poll (lib7_state_t *lib7_state, lib7_val_t arg)
{
lib7_val_t poll_list = REC_SEL(arg, 0);
lib7_val_t timeout = REC_SEL(arg, 1);
struct timeval tv, *tvp;
if (timeout == OPTION_NONE)
tvp = NULL;
else {
timeout = OPTION_get(timeout);
tv.tv_sec = REC_SELINT32(timeout, 0);
tv.tv_usec = REC_SELINT(timeout, 1);
tvp = &tv;
}
return LIB7_Poll (lib7_state, poll_list, tvp);
} /* end of _lib7_OS_poll */
/* _lib7_P_FileSys_ftruncate_64 : (int * word32 * word32) -> Void
* fd lengthhi lengthlo
*
* Make a directory
*/
lib7_val_t _lib7_P_FileSys_ftruncate_64 (lib7_state_t *lib7_state, lib7_val_t arg)
{
int fd = REC_SELINT(arg, 0);
off_t len =
(sizeof(off_t) > 4)
? (((off_t)WORD_LIB7toC(REC_SEL(arg, 1))) << 32) |
((off_t)(WORD_LIB7toC(REC_SEL(arg, 2))))
: ((off_t)(WORD_LIB7toC(REC_SEL(arg, 2))));
int status;
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
status = ftruncate (fd, len);
/* } while (status < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
CHECK_RETURN_UNIT(lib7_state, status)
} /* end of _lib7_P_FileSys_ftruncate_64 */
/* _ml_Sock_ctlRCVBUF : (sock * int option) -> int
*/
ml_val_t _ml_Sock_ctlRCVBUF (ml_state_t *msp, ml_val_t arg)
{
int sock = REC_SELINT(arg, 0);
ml_val_t ctl = REC_SEL(arg, 1);
int sz, sts;
if (ctl == OPTION_NONE) {
socklen_t optSz = sizeof(int);
sts = getsockopt (sock, SOL_SOCKET, SO_RCVBUF, (sockoptval_t)&sz, &optSz);
ASSERT((sts < 0) || (optSz == sizeof(int)));
}
else {
sz = INT_MLtoC(OPTION_get(ctl));
sts = setsockopt (sock, SOL_SOCKET, SO_RCVBUF, (sockoptval_t)&sz, sizeof(int));
}
if (sts < 0)
return RAISE_SYSERR(msp, sts);
else
return INT_CtoML(sz);
} /* end of _ml_Sock_ctlRCVBUF */
lib7_val_t _lib7_runtime_mkexec ( lib7_state_t* lib7_state,
lib7_val_t arg
)
{
/* _lib7_runtime_mkexec : rw_unt8_vector.Rw_Vector * int -> (chunk -> chunk)
*
* Turn a previously allocated code chunk into a closure.
* This requires that we flush the I-cache.
*/
lib7_val_t seq = REC_SEL( arg, 0);
int entrypoint = REC_SELINT(arg, 1);
char* code = GET_SEQ_DATAPTR( char, seq );
Word_t nbytes = GET_SEQ_LEN( seq );
FlushICache (code, nbytes);
{ lib7_val_t result;
REC_ALLOC1(lib7_state, result, PTR_CtoLib7(code + entrypoint));
return result;
}
}
/* _lib7_Sock_ctlNODELAY : (socket * Bool option) -> Bool
*
* NOTE: this is a TCP level option, so we cannot use the utility function.
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/internet-socket.pkg
*/
lib7_val_t _lib7_Sock_ctlNODELAY (lib7_state_t *lib7_state, lib7_val_t arg)
{
int socket = REC_SELINT(arg, 0);
lib7_val_t ctl = REC_SEL(arg, 1);
bool_t flag;
int status;
if (ctl == OPTION_NONE) {
int optSz = sizeof(int);
status = getsockopt (socket, IPPROTO_TCP, TCP_NODELAY, (sockoptval_t)&flag, &optSz);
ASSERT((status < 0) || (optSz == sizeof(int)));
}
else {
flag = (bool_t)INT_LIB7toC(OPTION_get(ctl));
status = setsockopt (socket, IPPROTO_TCP, TCP_NODELAY, (sockoptval_t)&flag, sizeof(int));
}
if (status < 0)
return RAISE_SYSERR(lib7_state, status);
else
return (flag ? LIB7_true : LIB7_false);
} /* end of _lib7_Sock_ctlNODELAY */
/* _lib7_P_Process_kill : (Int, Int) -> Void
*
* Send a signal to a process or a group of processes
*/
lib7_val_t _lib7_P_Process_kill (lib7_state_t *lib7_state, lib7_val_t arg)
{
int status = kill(REC_SELINT(arg, 0),REC_SELINT(arg, 1));
CHECK_RETURN_UNIT (lib7_state, status)
}
/* LIB7_Poll:
*
* The version of the polling operation for systems that provide BSD select.
*/
static lib7_val_t LIB7_Poll (lib7_state_t *lib7_state, lib7_val_t poll_list, struct timeval *timeout)
{
fd_set rset, wset, eset;
fd_set *rfds, *wfds, *efds;
int maxFD, status, fd, flag;
lib7_val_t l, item;
/*printf("src/runtime/c-libs/posix-os/poll.c: Using 'select' implementation\n");*/
rfds = wfds = efds = NULL;
maxFD = 0;
for (l = poll_list; l != LIST_nil; l = LIST_tl(l)) {
item = LIST_hd(l);
fd = REC_SELINT(item, 0);
flag = REC_SELINT(item, 1);
if ((flag & READABLE_BIT) != 0) {
/*int fd_flags = fcntl(fd,F_GETFL,0);*/
if (rfds == NULL) {
rfds = &rset;
FD_ZERO(rfds);
}
/*printf("src/runtime/c-libs/posix-os/poll.c: Will check fd %d for readability. fd flags x=%x O_NONBLOCK x=%x\n",fd,fd_flags,O_NONBLOCK);*/
FD_SET (fd, rfds);
}
if ((flag & WRITABLE_BIT) != 0) {
if (wfds == NULL) {
wfds = &wset;
FD_ZERO(wfds);
}
/*printf("src/runtime/c-libs/posix-os/poll.c: Will check fd %d for writability.\n",fd);*/
FD_SET (fd, wfds);
}
if ((flag & OOBDABLE_BIT) != 0) {
if (efds == NULL) {
efds = &eset;
FD_ZERO(efds);
}
/*printf("src/runtime/c-libs/posix-os/poll.c: Will check fd %d for oobdability.\n",fd);*/
FD_SET (fd, efds);
}
if (fd > maxFD) maxFD = fd;
}
/*printf("src/runtime/c-libs/posix-os/poll.c: maxFD d=%d timeout x=%x.\n",maxFD,timeout);*/
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
status = select (maxFD+1, rfds, wfds, efds, timeout);
/* } while (status < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
/*printf("src/runtime/c-libs/posix-os/poll.c: result status d=%d.\n",status);*/
if (status < 0)
return RAISE_SYSERR(lib7_state, status);
else if (status == 0)
return LIST_nil;
else {
lib7_val_t *resVec = NEW_VEC(lib7_val_t, status);
int i;
int resFlag;
for (i = 0, l = poll_list; l != LIST_nil; l = LIST_tl(l)) {
item = LIST_hd(l);
fd = REC_SELINT(item, 0);
flag = REC_SELINT(item, 1);
resFlag = 0;
if (((flag & READABLE_BIT) != 0) && FD_ISSET(fd, rfds)) {
/*int fd_flags = fcntl(fd,F_GETFL,0);*/
/*printf("src/runtime/c-libs/posix-os/poll.c: fd d=%d is in fact readable. fd flags x=%x O_NONBLOCK x=%x\n",fd,fd_flags,O_NONBLOCK);*/
resFlag |= READABLE_BIT;
}
if (((flag & WRITABLE_BIT) != 0) && FD_ISSET(fd, wfds)) {
/*printf("src/runtime/c-libs/posix-os/poll.c: fd d=%d is in fact writable.\n",fd);*/
resFlag |= WRITABLE_BIT;
}
if (((flag & OOBDABLE_BIT) != 0) && FD_ISSET(fd, efds)) {
/*printf("src/runtime/c-libs/posix-os/poll.c: fd d=%d is in fact oobdable.\n",fd);*/
resFlag |= OOBDABLE_BIT;
}
if (resFlag != 0) {
REC_ALLOC2 (lib7_state, item, INT_CtoLib7(fd), INT_CtoLib7(resFlag));
resVec[i++] = item;
}
}
ASSERT(i == status);
for (i = status-1, l = LIST_nil; i >= 0; i--) {
item = resVec[i];
LIST_cons (lib7_state, l, item, l);
}
FREE(resVec);
return l;
}
} /* end of LIB7_Poll */
/* _lib7_Sock_connect: (Socket, Address) -> Void
*
* This function gets imported into the Mythryl world via:
* src/lib/std/src/socket/socket-guts.pkg
*/
lib7_val_t _lib7_Sock_connect (lib7_state_t *lib7_state, lib7_val_t arg)
{
int socket = REC_SELINT(arg, 0);
lib7_val_t addr = REC_SEL( arg, 1);
int status;
socklen_t addrlen = GET_SEQ_LEN(addr);
{ unsigned char* a = GET_SEQ_DATAPTR(unsigned char, addr);
char buf[ 1024 ];
int i;
buf[0] = '\0';
for (i = 0; i < addrlen; ++i) {
sprintf (buf+strlen(buf), "%02x.", a[i]);
}
print_if( "connect.c/top: socket d=%d addrlen d=%d addr s='%s'\n", socket, addrlen, buf );
}
errno = 0;
status
=
connect (
socket,
GET_SEQ_DATAPTR(struct sockaddr, addr),
addrlen
);
/* NB: Unix Network Programming p135 S5.9 says that
* for connect() we cannot just retry on EINTR.
* On p452 it says we must instead do a select(),
* which will wait until the three-way TCP
* handshake either succeeds or fails:
*/
/* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
#ifdef SOME_OTHER_TIME
if (status < 0 && errno == EINTR) {
int eintr_count = 1;
int maxfd = socket+1;
fd_set read_set;
fd_set write_set;
do {
print_if( "connect.c/mid: Caught EINTR #%d, doing a select() on fd %d\n", eintr_count, socket);
FD_ZERO( &read_set);
FD_ZERO(&write_set);
FD_SET( socket, &read_set );
FD_SET( socket, &write_set );
errno = 0;
status = select(maxfd, &read_set, &write_set, NULL, NULL);
++eintr_count;
} while (status < 0 && errno == EINTR);
/* According to p452, if the connection completes properly
* the socket will be writable, but if it fails it will be
* both readable and writable. On return 'status' is the
* count of bits set in the fd_sets; if it is 2, the fd
* is both readable and writable, implying connect failure.
* To be on the safe side, in this case I ensure that status
* is negative and errno set to something valid for a failed
* connect(). I don't know if this situation is even possible:
*/
if (status == 2) {
status = -1;
errno = ENETUNREACH; /* Possibly ETIMEDOUT would be better? */
}
}
#endif
print_if( "connect.c/bot: status d=%d errno d=%d\n", status, errno);
CHECK_RETURN_UNIT(lib7_state, status); /* CHECK_RETURN_UNIT is from src/runtime/c-libs/lib7-c.h */
}
/* LIB7_Poll:
*
* The version of the polling operation for systems that provide SVR4 polling.
*/
static lib7_val_t LIB7_Poll (lib7_state_t *lib7_state, lib7_val_t poll_list, struct timeval *timeout)
{
int tout;
struct pollfd* fds;
struct pollfd* fdp;
int nfds, i, flag;
lib7_val_t l, item;
if (timeout == NULL)
tout = -1;
else
/* Convert to miliseconds: */
tout = (timeout->tv_sec * 1000) + (timeout->tv_usec / 1000);
/* Count the number of polling items:
*/
for (l = poll_list, nfds = 0; l != LIST_nil; l = LIST_tl(l))
nfds++;
/* Allocate the fds vector: */
fds = NEW_VEC(struct pollfd, nfds);
CLEAR_MEM (fds, sizeof(struct pollfd)*nfds);
/* Initialize the polling descriptors:
*/
for (l = poll_list, fdp = fds; l != LIST_nil; l = LIST_tl(l), fdp++) {
item = LIST_hd(l);
fdp->fd = REC_SELINT(item, 0);
flag = REC_SELINT(item, 1);
if ((flag & READABLE_BIT) != 0) fdp->events |= POLLIN;
if ((flag & WRITABLE_BIT) != 0) fdp->events |= POLLOUT;
if ((flag & OOBDABLE_BIT) != 0) fdp->events |= POLL_ERROR;
}
{ int status;
/* do { */ /* Backed out 2010-02-26 CrT: See discussion at bottom of src/runtime/c-libs/lib7-socket/connect.c */
status = poll (fds, nfds, tout);
/* } while (status < 0 && errno == EINTR); */ /* Restart if interrupted by a SIGALRM or SIGCHLD or whatever. */
if (status < 0) {
FREE(fds);
return RAISE_SYSERR(lib7_state, status);
}
else {
for (i = nfds-1, l = LIST_nil; i >= 0; i--) {
fdp = &(fds[i]);
if (fdp->revents != 0) {
flag = 0;
if ((fdp->revents & POLLIN ) != 0) flag |= READABLE_BIT;
if ((fdp->revents & POLLOUT ) != 0) flag |= WRITABLE_BIT;
if ((fdp->revents & POLL_ERROR) != 0) flag |= OOBDABLE_BIT;
REC_ALLOC2(lib7_state, item, INT_CtoLib7(fdp->fd), INT_CtoLib7(flag));
LIST_cons(lib7_state, l, item, l);
}
}
FREE(fds);
return l;
}
}
}
/* _lib7_P_TTY_tcsetpgrp : int * int -> Void
*
* Set foreground process group id of tty.
*/
lib7_val_t _lib7_P_TTY_tcsetpgrp (lib7_state_t *lib7_state, lib7_val_t arg)
{
int status = tcsetpgrp(REC_SELINT(arg, 0),REC_SELINT(arg, 1));
CHECK_RETURN_UNIT(lib7_state, status)
}
