diff options
| -rw-r--r-- | ghc/lib/misc/SocketPrim.lhs | 22 | ||||
| -rw-r--r-- | ghc/lib/misc/cbits/connectSocket.c | 8 | ||||
| -rw-r--r-- | ghc/lib/misc/cbits/ghcSockets.h | 4 | ||||
| -rw-r--r-- | ghc/lib/misc/cbits/socketOpt.c | 33 |
4 files changed, 30 insertions, 37 deletions
diff --git a/ghc/lib/misc/SocketPrim.lhs b/ghc/lib/misc/SocketPrim.lhs index 1eb4111357..1c76d6c4c5 100644 --- a/ghc/lib/misc/SocketPrim.lhs +++ b/ghc/lib/misc/SocketPrim.lhs @@ -87,7 +87,7 @@ import Ix import Weak ( addForeignFinalizer ) import PrelIOBase -- IOError, Handle representation import PrelHandle -import PrelConc ( threadWaitRead ) +import PrelConc ( threadWaitRead, threadWaitWrite ) import Foreign import Addr ( nullAddr ) @@ -321,6 +321,8 @@ connect (MkSocket s _family _stype _protocol socketStatus) addr = do status <- _ccall_ connectSocket s addr' sz (isDomainSocket::Int) case (status::Int) of -1 -> constructErrorAndFail "connect" + -6 -> do threadWaitWrite s >> writeIORef socketStatus Connected + -- ToDo: check for error with getsockopt _ -> writeIORef socketStatus Connected \end{code} @@ -585,6 +587,15 @@ data SocketOption | UseLoopBack {- SO_USELOOPBACK -} -- not used, I believe. #endif +socketOptLevel :: SocketOption -> Int +socketOptLevel so = + case so of +#ifndef _WIN32 + MaxSegment -> ``IPPROTO_TCP'' +#endif + NoDelay -> ``IPPROTO_TCP'' + _ -> ``SOL_SOCKET'' + packSocketOption :: SocketOption -> Int packSocketOption so = case so of @@ -616,7 +627,10 @@ setSocketOption :: Socket -> Int -- Option Value -> IO () setSocketOption (MkSocket s _ _ _ _) so v = do - rc <- _ccall_ setSocketOption__ s (packSocketOption so) v + rc <- _ccall_ setSocketOption__ s + (packSocketOption so) + (socketOptLevel so) + v if rc /= (0::Int) then constructErrorAndFail "setSocketOption" else return () @@ -625,7 +639,9 @@ getSocketOption :: Socket -> SocketOption -- Option Name -> IO Int -- Option Value getSocketOption (MkSocket s _ _ _ _) so = do - rc <- _ccall_ getSocketOption__ s (packSocketOption so) + rc <- _ccall_ getSocketOption__ s + (packSocketOption so) + (socketOptLevel so) if rc == -1 -- let's just hope that value isn't taken.. then constructErrorAndFail "getSocketOption" else return rc diff --git a/ghc/lib/misc/cbits/connectSocket.c b/ghc/lib/misc/cbits/connectSocket.c index 4874cb3bf8..961b6bbac8 100644 --- a/ghc/lib/misc/cbits/connectSocket.c +++ b/ghc/lib/misc/cbits/connectSocket.c @@ -18,7 +18,11 @@ connectSocket(I_ sockfd, A_ servaddr, I_ addrlen, I_ isUnixDomain) int rc; while ((rc = connect((int)sockfd, (struct sockaddr *)servaddr, (int)addrlen)) < 0) { - if (errno != EINTR) { + if (errno == EINPROGRESS) { + errno = 0; + return FILEOBJ_BLOCKED_WRITE; + + } else if (errno != EINTR) { cvtErrno(); switch (ghc_errno) { default: @@ -44,7 +48,6 @@ connectSocket(I_ sockfd, A_ servaddr, I_ addrlen, I_ isUnixDomain) ghc_errtype = ERR_INVALIDARGUMENT; ghc_errstr = "Address cannot be used with socket"; break; - case GHC_EINPROGRESS: case GHC_EALREADY: ghc_errtype = ERR_RESOURCEBUSY; ghc_errstr = "Non-blocking socket, previous connection attempt not completed"; @@ -65,7 +68,6 @@ connectSocket(I_ sockfd, A_ servaddr, I_ addrlen, I_ isUnixDomain) ghc_errtype = ERR_SYSTEMERROR; ghc_errstr = "Specified size of structure not equal valid address for family"; break; - break; case GHC_ENETUNREACH: ghc_errtype = ERR_PERMISSIONDENIED; ghc_errstr = "Network not reachable from host"; diff --git a/ghc/lib/misc/cbits/ghcSockets.h b/ghc/lib/misc/cbits/ghcSockets.h index f2f636a11f..7b0efd62b3 100644 --- a/ghc/lib/misc/cbits/ghcSockets.h +++ b/ghc/lib/misc/cbits/ghcSockets.h @@ -87,8 +87,8 @@ StgInt recvFrom__ (StgInt, StgAddr, StgInt, StgAddr); StgInt sendTo__ (StgInt, StgAddr, StgInt, StgAddr, StgInt); /* socketOpt.c */ -StgInt getSocketOption__ (StgInt, StgInt); -StgInt setSocketOption__ (StgInt, StgInt, StgInt); +StgInt getSocketOption__ (StgInt, StgInt, StgInt); +StgInt setSocketOption__ (StgInt, StgInt, StgInt, StgInt); /* writeDescriptor.lc */ StgInt writeDescriptor (StgInt, StgAddr, StgInt); diff --git a/ghc/lib/misc/cbits/socketOpt.c b/ghc/lib/misc/cbits/socketOpt.c index 69e1fa1214..21ce7a2d23 100644 --- a/ghc/lib/misc/cbits/socketOpt.c +++ b/ghc/lib/misc/cbits/socketOpt.c @@ -13,21 +13,9 @@ #include "stgio.h" StgInt -getSocketOption__ (fd, opt) -StgInt fd; -StgInt opt; +getSocketOption__ (StgInt fd, StgInt opt, StgInt level) { - int level,optval, sz_optval,rc; - - if ( -#ifndef _WIN32 - opt == TCP_MAXSEG || -#endif - opt == TCP_NODELAY ) { - level = IPPROTO_TCP; - } else { - level = SOL_SOCKET; - } + int optval, sz_optval, rc; sz_optval = sizeof(int); @@ -42,23 +30,10 @@ StgInt opt; } StgInt -setSocketOption__ (fd, opt, val) -StgInt fd; -StgInt opt; -StgInt val; +setSocketOption__ (StgInt fd, StgInt opt, StgInt level, StgInt val) { - int level, optval,rc; + int optval, rc; - if ( -#ifndef _WIN32 - opt == TCP_MAXSEG || -#endif - opt == TCP_NODELAY ) { - level = IPPROTO_TCP; - } else { - level = SOL_SOCKET; - } - optval = val; while ( (rc = setsockopt((int)fd, level, opt, &optval, sizeof(optval))) < 0 ) { |