/* _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 */
/* _ml_P_FileSys_link : string * string -> unit
* existing newname
*
* Creates a hard link from newname to existing file.
*/
ml_val_t _ml_P_FileSys_link (ml_state_t *msp, ml_val_t arg)
{
int sts;
ml_val_t existing = REC_SEL(arg, 0);
ml_val_t newname = REC_SEL(arg, 1);
sts = link(STR_MLtoC(existing), STR_MLtoC(newname));
CHK_RETURN_UNIT (msp, sts)
} /* end of _ml_P_FileSys_link */
/* _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;
}
/* _ml_NetDB_getservbyport
* : (int * string option) -> (string * string list * int * string) option
*/
ml_val_t _ml_NetDB_getservbyport (ml_state_t *msp, ml_val_t arg)
{
ml_val_t mlProto = REC_SEL(arg, 1);
char *proto;
if (mlProto == OPTION_NONE)
proto = NIL(char *);
else
lib7_val_t _lib7_runtime_recordmeld ( lib7_state_t* lib7_state,
lib7_val_t arg
)
{
/* _lib7_runtime_recordmeld : (chunk * chunk) -> chunk */
lib7_val_t r1 = REC_SEL(arg,0);
lib7_val_t r2 = REC_SEL(arg,1);
if (r1 == LIB7_void) return r2;
else if (r2 == LIB7_void) return r1;
else {
lib7_val_t result = RecordMeld (lib7_state, r1, r2);
if (result == LIB7_void) return RAISE_ERROR( lib7_state, "recordmeld: not a record");
else return result;
}
}
/* _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 */
/* _ml_P_FileSys_utime : (string * Int32.int * Int32.int) -> unit
* name actime modtime
*
* Sets file access and modification times. If
* actime = -1, then set both to current time.
*/
ml_val_t _ml_P_FileSys_utime (ml_state_t *msp, ml_val_t arg)
{
ml_val_t path = REC_SEL(arg, 0);
time_t actime = REC_SELINT32(arg, 1);
time_t modtime = REC_SELINT32(arg, 2);
int sts;
if (actime == -1) {
sts = utime (STR_MLtoC(path), NIL(struct utimbuf *));
}
/* _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_P_Dynload_dlsym : Word32.word * string -> Word32.word
*
* Extract symbol from dynamically loaded library.
*/
ml_val_t _ml_U_Dynload_dlsym (ml_state_t *msp, ml_val_t arg)
{
ml_val_t ml_handle = REC_SEL (arg, 0);
char *symname = STR_MLtoC (REC_SEL (arg, 1));
void *handle = (void *) (WORD_MLtoC (ml_handle));
void *addr;
ml_val_t res;
#ifdef OPSYS_WIN32
addr = GetProcAddress (handle, symname);
if (addr == NULL && symname != NULL)
dlerror_set ("Symbol `%s' not found", symname);
#else
addr = dlsym (handle, symname);
#endif
WORD_ALLOC (msp, res, (Word_t) addr);
return res;
}
/* _lib7_P_FileSys_mkdir : (String * word) -> Void
* name mode
*
* Make a directory
*/
lib7_val_t _lib7_P_FileSys_mkdir (lib7_state_t *lib7_state, lib7_val_t arg)
{
lib7_val_t path = REC_SEL(arg, 0);
mode_t mode = REC_SELWORD(arg, 1);
int status;
status = mkdir (STR_LIB7toC(path), mode);
CHECK_RETURN_UNIT(lib7_state, status)
} /* end of _lib7_P_FileSys_mkdir */
/* _ml_P_FileSys_access : (string * word) -> bool
* name access_mode
*
* Determine accessibility of a file.
*/
ml_val_t _ml_P_FileSys_access (ml_state_t *msp, ml_val_t arg)
{
ml_val_t path = REC_SEL(arg, 0);
mode_t mode = REC_SELWORD(arg, 1);
int sts;
sts = access (STR_MLtoC(path), mode);
if (sts == 0)
return ML_true;
else
return ML_false;
} /* end of _ml_P_FileSys_access */
/* _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_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 */
}
PVT Word_t getWord32(ml_val_t v)
{
return (Word_t) REC_SEL(v,0);
}
