[MLton-commit] r7196
Wesley Terpstra
wesley at mlton.org
Tue Jun 30 15:37:26 PDT 2009
On MinGW, socket functions failed to return their error status because we
did not convert this from WSAGetLastError. This patch addresses the problem
with the following changes:
* Ensure all the Posix socket error codes exist. If they don't already exist
in the MinGW headers, define them in terms of WinSock codes which have a
distinct range from the normal error codes (so there is no conflict).
* Map WSAGetLastError codes to the appropriate Posix error codes in a MinGW
specific method. Reassign errno to the appropriate value.
* Wherever socket calls are made in the runtime, insert calls to fixup the
error status if the function has failed.
----------------------------------------------------------------------
U mlton/trunk/runtime/basis/Net/NetHostDB.c
U mlton/trunk/runtime/basis/Net/Socket/GenericSock.c
U mlton/trunk/runtime/basis/Net/Socket/Socket.c
U mlton/trunk/runtime/basis/Net/Socket/select.c
U mlton/trunk/runtime/platform/mingw.c
U mlton/trunk/runtime/platform/mingw.h
U mlton/trunk/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/trunk/runtime/basis/Net/NetHostDB.c
===================================================================
--- mlton/trunk/runtime/basis/Net/NetHostDB.c 2009-06-23 16:32:40 UTC (rev 7195)
+++ mlton/trunk/runtime/basis/Net/NetHostDB.c 2009-06-30 22:37:25 UTC (rev 7196)
@@ -51,6 +51,11 @@
}
C_Errno_t(C_Int_t) NetHostDB_getHostName(Array(Char8_t) buf, C_Size_t len) {
+ int out;
+
MLton_initSockets ();
- return gethostname ((char*)buf, len);
+ out = gethostname ((char*)buf, len);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
Modified: mlton/trunk/runtime/basis/Net/Socket/GenericSock.c
===================================================================
--- mlton/trunk/runtime/basis/Net/Socket/GenericSock.c 2009-06-23 16:32:40 UTC (rev 7195)
+++ mlton/trunk/runtime/basis/Net/Socket/GenericSock.c 2009-06-30 22:37:25 UTC (rev 7196)
@@ -2,12 +2,22 @@
C_Errno_t(C_Int_t)
Socket_GenericSock_socket (C_Int_t domain, C_Int_t type, C_Int_t protocol) {
+ int out;
+
MLton_initSockets ();
- return socket (domain, type, protocol);
+ out = socket (domain, type, protocol);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_Int_t)
Socket_GenericSock_socketPair (C_Int_t domain, C_Int_t type, C_Int_t protocol, Array(C_Int_t) sv) {
+ int out;
+
MLton_initSockets ();
- return socketpair (domain, type, protocol, (int*)sv);
+ out = socketpair (domain, type, protocol, (int*)sv);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
Modified: mlton/trunk/runtime/basis/Net/Socket/Socket.c
===================================================================
--- mlton/trunk/runtime/basis/Net/Socket/Socket.c 2009-06-23 16:32:40 UTC (rev 7195)
+++ mlton/trunk/runtime/basis/Net/Socket/Socket.c 2009-06-30 22:37:25 UTC (rev 7196)
@@ -1,26 +1,47 @@
#include "platform.h"
C_Errno_t(C_Int_t) Socket_accept (C_Sock_t s, Array(Word8_t) addr, Ref(C_Socklen_t) addrlen) {
+ int out;
+
MLton_initSockets ();
- return accept (s, (struct sockaddr*)addr, (socklen_t*)addrlen);
+ out = accept (s, (struct sockaddr*)addr, (socklen_t*)addrlen);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_Int_t) Socket_bind (C_Sock_t s, Vector(Word8_t) addr, C_Socklen_t addrlen) {
+ int out;
+
MLton_initSockets ();
- return bind (s, (const struct sockaddr*)addr, (socklen_t)addrlen);
+ out = bind (s, (const struct sockaddr*)addr, (socklen_t)addrlen);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_Int_t) Socket_close(C_Sock_t s) {
#ifdef __MINGW32__
- return closesocket(s);
+ int out;
+
+ MLton_initSockets ();
+ out = closesocket(s);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
#else
return close(s);
#endif
}
C_Errno_t(C_Int_t) Socket_connect (C_Sock_t s, Vector(Word8_t) addr, C_Socklen_t addrlen) {
+ int out;
+
MLton_initSockets ();
- return connect (s, (const struct sockaddr*)addr, (socklen_t)addrlen);
+ out = connect (s, (const struct sockaddr*)addr, (socklen_t)addrlen);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Int_t Socket_familyOfAddr(Vector(Word8_t) addr) {
@@ -28,31 +49,51 @@
}
C_Errno_t(C_Int_t) Socket_listen (C_Sock_t s, C_Int_t backlog) {
+ int out;
+
MLton_initSockets ();
- return listen (s, backlog);
+ out = listen (s, backlog);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_SSize_t)
Socket_recv (C_Sock_t s, Array(Word8_t) msg,
C_Int_t start, C_Size_t len, C_Int_t flags) {
+ int out;
+
MLton_initSockets ();
- return MLton_recv (s, (void*)((char *)msg + start), len, flags);
+ out = MLton_recv (s, (void*)((char *)msg + start), len, flags);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_SSize_t)
Socket_recvFrom (C_Sock_t s, Array(Word8_t) msg,
C_Int_t start, C_Size_t len, C_Int_t flags,
Array(Word8_t) addr, Ref(C_Socklen_t) addrlen) {
+ int out;
+
MLton_initSockets ();
- return MLton_recvfrom (s, (void*)((char *)msg + start), len, flags,
- (struct sockaddr*)addr, (socklen_t*)addrlen);
+ out = MLton_recvfrom (s, (void*)((char *)msg + start), len, flags,
+ (struct sockaddr*)addr, (socklen_t*)addrlen);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
static inline C_Errno_t(C_SSize_t)
Socket_send (C_Sock_t s, Pointer msg,
C_Int_t start, C_Size_t len, C_Int_t flags) {
+ int out;
+
MLton_initSockets ();
- return send (s, (void*)((char *)msg + start), len, flags);
+ out = send (s, (void*)((char *)msg + start), len, flags);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_SSize_t)
@@ -70,9 +111,14 @@
Socket_sendTo (C_Sock_t s, Pointer msg,
C_Int_t start, C_Size_t len, C_Int_t flags,
Vector(Word8_t) addr, C_Socklen_t addrlen) {
+ int out;
+
MLton_initSockets ();
- return sendto (s, (void*)((char *)msg + start), len, flags,
- (const struct sockaddr*)addr, (socklen_t)addrlen);
+ out = sendto (s, (void*)((char *)msg + start), len, flags,
+ (const struct sockaddr*)addr, (socklen_t)addrlen);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_SSize_t)
@@ -89,42 +135,77 @@
}
C_Errno_t(C_Int_t) Socket_shutdown (C_Sock_t s, C_Int_t how) {
+ int out;
+
MLton_initSockets ();
- return shutdown (s, how);
+ out = shutdown (s, how);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_Int_t)
Socket_Ctl_getSockOpt (C_Sock_t s, C_Int_t level, C_Int_t optname,
Array(Word8_t) optval, Ref(C_Socklen_t) optlen) {
+ int out;
+
MLton_initSockets ();
- return getsockopt (s, level, optname, (void*)optval, (socklen_t*)optlen);
+ out = getsockopt (s, level, optname, (void*)optval, (socklen_t*)optlen);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_Int_t)
Socket_Ctl_setSockOpt (C_Sock_t s, C_Int_t level, C_Int_t optname,
Vector(Word8_t) optval, C_Socklen_t optlen) {
+ int out;
+
MLton_initSockets ();
- return setsockopt (s, level, optname, (const void*)optval, (socklen_t)optlen);
+ out = setsockopt (s, level, optname, (const void*)optval, (socklen_t)optlen);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_Int_t)
Socket_Ctl_getIOCtl (C_Sock_t s, C_Int_t request, Array(Word8_t) argp) {
+ int out;
+
MLton_initSockets ();
- return ioctl (s, request, (void*)argp);
+ out = ioctl (s, request, (void*)argp);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_Int_t)
Socket_Ctl_setIOCtl (C_Sock_t s, C_Int_t request, Vector(Word8_t) argp) {
+ int out;
+
MLton_initSockets ();
- return ioctl (s, request, (const void*)argp);
+ out = ioctl (s, request, (const void*)argp);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_Int_t) Socket_Ctl_getPeerName (C_Sock_t s, Array(Word8_t) name, Ref(C_Socklen_t) namelen) {
+ int out;
+
MLton_initSockets ();
- return getpeername (s, (struct sockaddr*)name, (socklen_t*)namelen);
+ out = getpeername (s, (struct sockaddr*)name, (socklen_t*)namelen);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
C_Errno_t(C_Int_t) Socket_Ctl_getSockName (C_Sock_t s, Array(Word8_t) name, Ref(C_Socklen_t) namelen) {
+ int out;
+
MLton_initSockets ();
- return getsockname (s, (struct sockaddr*)name, (socklen_t*)namelen);
+ out = getsockname (s, (struct sockaddr*)name, (socklen_t*)namelen);
+ if (out == -1) MLton_fixSocketErrno ();
+
+ return out;
}
Modified: mlton/trunk/runtime/basis/Net/Socket/select.c
===================================================================
--- mlton/trunk/runtime/basis/Net/Socket/select.c 2009-06-23 16:32:40 UTC (rev 7195)
+++ mlton/trunk/runtime/basis/Net/Socket/select.c 2009-06-30 22:37:25 UTC (rev 7196)
@@ -63,8 +63,10 @@
except_fds = NULL;
}
res = select(FD_SETSIZE, read_fds, write_fds, except_fds, Socket_timeoutPtr);
- if (res == -1)
+ if (res == -1) {
+ MLton_fixSocketErrno();
return res;
+ }
if (read_len > 0) {
for (unsigned int i = 0; i < read_len; i++) {
int fd = ((int *)read_vec)[i];
Modified: mlton/trunk/runtime/platform/mingw.c
===================================================================
--- mlton/trunk/runtime/platform/mingw.c 2009-06-23 16:32:40 UTC (rev 7195)
+++ mlton/trunk/runtime/platform/mingw.c 2009-06-30 22:37:25 UTC (rev 7196)
@@ -1173,6 +1173,96 @@
}
}
+/* This table was constructed with help of
+ * http://msdn.microsoft.com/en-us/library/ms740668(VS.85).aspx#winsock.wsaenotsock_2
+ * man errno(3)
+ */
+void MLton_fixSocketErrno (void) {
+ int status = WSAGetLastError ();
+
+ switch (status) {
+ case 0: errno = 0; break;
+ case WSAEINTR: errno = EINTR; break;
+ case WSAEBADF: errno = EBADF; break;
+ case WSAEACCES: errno = EACCES; break;
+ case WSAEFAULT: errno = EFAULT; break;
+ case WSAEINVAL: errno = EINVAL; break;
+ case WSAEMFILE: errno = EMFILE; break;
+ case WSAEWOULDBLOCK: errno = EWOULDBLOCK; break;
+ case WSAEINPROGRESS: errno = EINPROGRESS; break;
+ case WSAEALREADY: errno = EALREADY; break;
+ case WSAENOTSOCK: errno = ENOTSOCK; break;
+ case WSAEDESTADDRREQ: errno = EDESTADDRREQ; break;
+ case WSAEMSGSIZE: errno = EMSGSIZE; break;
+ case WSAEPROTOTYPE: errno = EPROTOTYPE; break;
+ case WSAENOPROTOOPT: errno = ENOPROTOOPT; break;
+ case WSAEPROTONOSUPPORT: errno = EPROTONOSUPPORT; break;
+ case WSAESOCKTNOSUPPORT: errno = ESOCKTNOSUPPORT; break;
+ case WSAEOPNOTSUPP: errno = EOPNOTSUPP; break;
+ case WSAEPFNOSUPPORT: errno = EPFNOSUPPORT; break;
+ case WSAEAFNOSUPPORT: errno = EAFNOSUPPORT; break;
+ case WSAEADDRINUSE: errno = EADDRINUSE; break;
+ case WSAEADDRNOTAVAIL: errno = EADDRNOTAVAIL; break;
+ case WSAENETDOWN: errno = ENETDOWN; break;
+ case WSAENETUNREACH: errno = ENETUNREACH; break;
+ case WSAENETRESET: errno = ENETRESET; break;
+ case WSAECONNABORTED: errno = ECONNABORTED; break;
+ case WSAECONNRESET: errno = ECONNRESET; break;
+ case WSAENOBUFS: errno = ENOBUFS; break;
+ case WSAEISCONN: errno = EISCONN; break;
+ case WSAENOTCONN: errno = ENOTCONN; break;
+ case WSAESHUTDOWN: errno = ESHUTDOWN; break;
+ case WSAETIMEDOUT: errno = ETIMEDOUT; break;
+ case WSAECONNREFUSED: errno = ECONNREFUSED; break;
+ case WSAELOOP: errno = ELOOP; break;
+ case WSAENAMETOOLONG: errno = ENAMETOOLONG; break;
+ case WSAEHOSTDOWN: errno = EHOSTDOWN; break;
+ case WSAEHOSTUNREACH: errno = EHOSTUNREACH; break;
+ case WSAENOTEMPTY: errno = ENOTEMPTY; break;
+ case WSAEDQUOT: errno = EDQUOT; break;
+ case WSAESTALE: errno = ESTALE; break;
+ case WSAEREMOTE: errno = EREMOTE; break;
+ /* These codes appear to have a matching name, but the manual
+ * descriptions of what the error codes mean seem to differ
+ */
+ case WSAEUSERS: errno = EUSERS; break;
+ case WSAECANCELLED: errno = ECANCELED; break;
+ case WSA_E_CANCELLED: errno = ECANCELED; break;
+ /* These codes have no matching code in the errno(3) man page. */
+ case WSAEPROCLIM: errno = EBUSY; break;
+ case WSAETOOMANYREFS: errno = ENOMEM; break;
+ case WSAEDISCON: errno = ESHUTDOWN; break;
+ case WSA_E_NO_MORE:
+ case WSAENOMORE:
+ case WSASYSCALLFAILURE: errno = EIO; break;
+ /* These codes are returned from the OS and subject to chage */
+ // WSA_INVALID_HANDLE
+ // WSA_NOT_ENOUGH_MEMORY
+ // WSA_INVALID_PARAMETER
+ // WSA_OPERATION_ABORTED
+ // WSA_IO_INCOMPLETE
+ // WSA_IO_PENDING
+ /* These codes mean some sort of windows specific fatal error */
+ case WSASYSNOTREADY:
+ case WSAVERNOTSUPPORTED:
+ case WSANOTINITIALISED:
+ case WSAEINVALIDPROCTABLE:
+ case WSAEINVALIDPROVIDER:
+ case WSAEPROVIDERFAILEDINIT:
+ case WSASERVICE_NOT_FOUND:
+ case WSATYPE_NOT_FOUND:
+ die("Problem loading winsock");
+ case WSAEREFUSED:
+ case WSAHOST_NOT_FOUND:
+ case WSATRY_AGAIN:
+ case WSANO_RECOVERY:
+ case WSANO_DATA:
+ die("Strange winsock specific status code");
+ default:
+ die("Unknown winsock status code");
+ }
+}
+
/* ------------------------------------------------- */
/* Syslog */
/* ------------------------------------------------- */
Modified: mlton/trunk/runtime/platform/mingw.h
===================================================================
--- mlton/trunk/runtime/platform/mingw.h 2009-06-23 16:32:40 UTC (rev 7195)
+++ mlton/trunk/runtime/platform/mingw.h 2009-06-30 22:37:25 UTC (rev 7196)
@@ -364,18 +364,185 @@
/* Posix.Error */
/* ------------------------------------------------- */
+
+/* If MinGW doesn't (currently) define an error status we need, but winsock
+ * does, then default to using the winsock status. They will not conflict.
+ */
+
+#ifndef EINTR
+#define EINTR WSAEINTR
+#endif
+
+#ifndef EBADF
+#define EBADF WSAEBADF
+#endif
+
+#ifndef EACCES
+#define EACCES WSAEACCES
+#endif
+
+#ifndef EFAULT
+#define EFAULT WSAEFAULT
+#endif
+
+#ifndef EINVAL
+#define EINVAL WSAEINVAL
+#endif
+
+#ifndef EMFILE
+#define EMFILE WSAEMFILE
+#endif
+
+#ifndef EAGAIN
+#define EAGAIN WSAEWOULDBLOCK
+#endif
+
+#ifndef EWOULDBLOCK
+#define EWOULDBLOCK EAGAIN
+#endif
+
#ifndef EINPROGRESS
#define EINPROGRESS WSAEINPROGRESS
#endif
+#ifndef EALREADY
+#define EALREADY WSAEALREADY
+#endif
+
+#ifndef ENOTSOCK
+#define ENOTSOCK WSAENOTSOCK
+#endif
+
+#ifndef EDESTADDRREQ
+#define EDESTADDRREQ WSAEDESTADDRREQ
+#endif
+
#ifndef EMSGSIZE
#define EMSGSIZE WSAEMSGSIZE
#endif
+#ifndef EPROTOTYPE
+#define EPROTOTYPE WSAEPROTOTYPE
+#endif
+
+#ifndef ENOPROTOOPT
+#define ENOPROTOOPT WSAENOPROTOOPT
+#endif
+
+#ifndef EPROTONOSUPPORT
+#define EPROTONOSUPPORT WSAEPROTONOSUPPORT
+#endif
+
+#ifndef ESOCKTNOSUPPORT
+#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
+#endif
+
+#ifndef EOPNOTSUPP
+#define EOPNOTSUPP WSAEOPNOTSUPP
+#endif
+
+#ifndef EPFNOSUPPORT
+#define EPFNOSUPPORT WSAEPFNOSUPPORT
+#endif
+
+#ifndef EAFNOSUPPORT
+#define EAFNOSUPPORT WSAEAFNOSUPPORT
+#endif
+
+#ifndef EADDRINUSE
+#define EADDRINUSE WSAEADDRINUSE
+#endif
+
+#ifndef EADDRNOTAVAIL
+#define EADDRNOTAVAIL WSAEADDRNOTAVAIL
+#endif
+
+#ifndef ENETDOWN
+#define ENETDOWN WSAENETDOWN
+#endif
+
+#ifndef ENETUNREACH
+#define ENETUNREACH WSAENETUNREACH
+#endif
+
+#ifndef ENETRESET
+#define ENETRESET WSAENETRESET
+#endif
+
+#ifndef ECONNABORTED
+#define ECONNABORTED WSAECONNABORTED
+#endif
+
+#ifndef ECONNRESET
+#define ECONNRESET WSAECONNRESET
+#endif
+
+#ifndef ENOBUFS
+#define ENOBUFS WSAENOBUFS
+#endif
+
+#ifndef EISCONN
+#define EISCONN WSAEISCONN
+#endif
+
+#ifndef ENOTCONN
+#define ENOTCONN WSAENOTCONN
+#endif
+
+#ifndef ESHUTDOWN
+#define ESHUTDOWN WSAESHUTDOWN
+#endif
+
+#ifndef ETIMEDOUT
+#define ETIMEDOUT WSAETIMEDOUT
+#endif
+
+#ifndef ECONNREFUSED
+#define ECONNREFUSED WSAECONNREFUSED
+#endif
+
#ifndef ELOOP
#define ELOOP WSAELOOP
#endif
+#ifndef ENAMETOOLONG
+#define ENAMETOOLONG WSAENAMETOOLONG
+#endif
+
+#ifndef EHOSTDOWN
+#define EHOSTDOWN WSAEHOSTDOWN
+#endif
+
+#ifndef EHOSTUNREACH
+#define EHOSTUNREACH WSAEHOSTUNREACH
+#endif
+
+#ifndef ENOTEMPTY
+#define ENOTEMPTY WSAENOTEMPTY
+#endif
+
+#ifndef EDQUOT
+#define EDQUOT WSAEDQUOT
+#endif
+
+#ifndef ESTALE
+#define ESTALE WSAESTALE
+#endif
+
+#ifndef ERMOTE
+#define EREMOTE WSAEREMOTE
+#endif
+
+/* Questionable fall backs: */
+
+#ifndef EUSERS
+#define EUSERS WSAEUSERS
+#endif
+
+#ifndef ECANCELED
+#define ECANCELED WSAECANCELLED
+#endif
+
#ifndef EBADMSG
#define EBADMSG 77
#endif
Modified: mlton/trunk/runtime/platform.h
===================================================================
--- mlton/trunk/runtime/platform.h 2009-06-23 16:32:40 UTC (rev 7195)
+++ mlton/trunk/runtime/platform.h 2009-06-30 22:37:25 UTC (rev 7196)
@@ -202,8 +202,10 @@
#if (defined (__MSVCRT__))
PRIVATE void MLton_initSockets (void);
+PRIVATE void MLton_fixSocketErrno (void);
#else
static inline void MLton_initSockets (void) {}
+static inline void MLton_fixSocketErrno (void) {}
#endif
#if HAS_MSG_DONTWAIT
More information about the MLton-commit
mailing list