From 6bef2efe08950ca762d188e42bb64986df0538eb Mon Sep 17 00:00:00 2001 From: sof Date: Wed, 5 May 1999 10:36:31 +0000 Subject: [PATCH] [project @ 1999-05-05 10:36:29 by sof] switch over to using Winsock on the _WIN32 side --- ghc/lib/misc/BSD.lhs | 18 +++++------ ghc/lib/misc/Makefile | 12 ++++++- ghc/lib/misc/Socket.lhs | 15 ++++++--- ghc/lib/misc/SocketPrim.lhs | 75 ++++++++++++++++++++++++++++++++----------- 4 files changed, 87 insertions(+), 33 deletions(-) diff --git a/ghc/lib/misc/BSD.lhs b/ghc/lib/misc/BSD.lhs index e7fbecf..2b07ebc 100644 --- a/ghc/lib/misc/BSD.lhs +++ b/ghc/lib/misc/BSD.lhs @@ -25,7 +25,7 @@ module BSD ( getServiceByPort, -- :: PortNumber -> ProtocolName -> IO ServiceEntry getServicePortNumber, -- :: ServiceName -> IO PortNumber -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 getServiceEntry, -- :: IO ServiceEntry setServiceEntry, -- :: Bool -> IO () endServiceEntry, -- :: IO () @@ -39,7 +39,7 @@ module BSD ( getProtocolByNumber, -- :: ProtocolNumber -> IO ProtcolEntry getProtocolNumber, -- :: ProtocolName -> ProtocolNumber -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 setProtocolEntry, -- :: Bool -> IO () getProtocolEntry, -- :: IO ProtocolEntry endProtocolEntry, -- :: IO () @@ -54,7 +54,7 @@ module BSD ( getHostByAddr, -- :: HostAddress -> Family -> IO HostEntry hostAddress, -- :: HostEntry -> HostAddress -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 setHostEntry, -- :: Bool -> IO () getHostEntry, -- :: IO HostEntry endHostEntry, -- :: IO () @@ -64,7 +64,7 @@ module BSD ( NetworkName, NetworkAddr, NetworkEntry(..) -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 , getNetworkByName -- :: NetworkName -> IO NetworkEntry , getNetworkByAddr -- :: NetworkAddr -> Family -> IO NetworkEntry , setNetworkEntry -- :: Bool -> IO () @@ -178,7 +178,7 @@ getServicePortNumber name = do (ServiceEntry _ _ port _) <- getServiceByName name "tcp" return port -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 getServiceEntry :: IO ServiceEntry getServiceEntry = do ptr <- _ccall_ getservent @@ -214,7 +214,7 @@ getProtocolByName :: ProtocolName -> IO ProtocolEntry getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry getProtocolNumber :: ProtocolName -> IO ProtocolNumber -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 setProtocolEntry :: Bool -> IO () -- Keep DB Open ? getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB endProtocolEntry :: IO () @@ -242,7 +242,7 @@ getProtocolNumber proto = do (ProtocolEntry _ _ num) <- getProtocolByName proto return num -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 --getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB getProtocolEntry = do ptr <- _ccall_ getprotoent @@ -284,7 +284,7 @@ getHostByAddr family addr = do then ioError (IOError Nothing NoSuchThing "getHostByAddr" "no such host entry") else unpackHostEntry ptr -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 getHostEntry :: IO HostEntry getHostEntry = do ptr <- _ccall_ gethostent @@ -328,7 +328,7 @@ data NetworkEntry = networkFamily :: Family, -- type networkAddress :: NetworkAddr } -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 getNetworkByName :: NetworkName -> IO NetworkEntry getNetworkByName name = do ptr <- _ccall_ getnetbyname name diff --git a/ghc/lib/misc/Makefile b/ghc/lib/misc/Makefile index 2483768..64768bd 100644 --- a/ghc/lib/misc/Makefile +++ b/ghc/lib/misc/Makefile @@ -1,4 +1,4 @@ -# $Id: Makefile,v 1.11 1999/02/03 16:54:01 simonm Exp $ +# $Id: Makefile,v 1.12 1999/05/05 10:36:30 sof Exp $ # # Makefile for miscellaneous libraries. # @@ -41,6 +41,7 @@ SRC_HC_OPTS += -i../concurrent -recomp -cpp -fglasgow-exts -fvia-C -Rghc-timing # # Profiling options +# (what's this stuff doing here?) WAY_p_HC_OPTS += -GPrelude WAY_mr_HC_OPTS += -GPrelude @@ -65,6 +66,15 @@ PackedString_HC_OPTS += -H12m SRC_MKDEPENDHS_OPTS += -I$(GHC_INCLUDE_DIR) #----------------------------------------------------------------------------- +# Win32 DLL setup + +DLL_NAME = HSmisc.dll +DLL_IMPLIB_NAME = libHSmisc_imp.a +SRC_BLD_DLL_OPTS += --export-all --output-def=HSmisc.def +SRC_BLD_DLL_OPTS += -lwinmm -lwsock32 -lHSrts_imp -lHS_cbits_imp -lHSmisc_cbits_imp -lHS_imp -lHSexts_imp -lgmp -L. -L../../rts/gmp -L../../rts -L../std -L../std/cbits -L../exts -Lcbits + + +#----------------------------------------------------------------------------- # Installation; need to install .hi files as well as libraries # # The interface files are put inside the $(libdir), since they diff --git a/ghc/lib/misc/Socket.lhs b/ghc/lib/misc/Socket.lhs index 30bf12e..b960b90 100644 --- a/ghc/lib/misc/Socket.lhs +++ b/ghc/lib/misc/Socket.lhs @@ -26,7 +26,12 @@ module Socket ( sendTo, -- :: Hostname -> PortID -> String -> IO () recvFrom, -- :: Hostname -> PortID -> IO String - socketPort -- :: Socket -> IO PortID + socketPort, -- :: Socket -> IO PortID + + withSocketsDo, -- :: IO a -> IO a + + PortNumber, + mkPortNumber -- :: Int -> PortNumber ) where @@ -56,7 +61,7 @@ signalling that the current hostname applies. data PortID = Service String -- Service Name eg "ftp" | PortNumber PortNumber -- User defined Port Number -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 | UnixSocket String -- Unix family socket in file system #endif @@ -88,7 +93,7 @@ connectTo hostname (PortNumber port) = do connect sock (SockAddrInet port (hostAddress he)) socketToHandle sock ReadWriteMode -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 connectTo _ (UnixSocket path) = do sock <- socket AF_UNIX Datagram 0 connect sock (SockAddrUnix path) @@ -119,7 +124,7 @@ listenOn (PortNumber port) = do listen sock maxListenQueue return sock -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 listenOn (UnixSocket path) = do sock <- socket AF_UNIX Datagram 0 bindSocket sock (SockAddrUnix path) @@ -190,7 +195,7 @@ socketPort s = do portID sa = case sa of SockAddrInet port _ -> PortNumber port -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 SockAddrUnix path -> UnixSocket path #endif diff --git a/ghc/lib/misc/SocketPrim.lhs b/ghc/lib/misc/SocketPrim.lhs index 589edfa..d88e3d7 100644 --- a/ghc/lib/misc/SocketPrim.lhs +++ b/ghc/lib/misc/SocketPrim.lhs @@ -77,6 +77,8 @@ module SocketPrim ( packSocketType, packSockAddr, unpackSockAddr + , withSocketsDo -- :: IO a -> IO a + ) where import GlaExts @@ -86,6 +88,7 @@ import Weak ( addForeignFinalizer ) import PrelIOBase -- IOError, Handle representation import PrelHandle import Foreign +import Addr ( nullAddr ) import IO import IOExts ( IORef, newIORef, readIORef, writeIORef ) @@ -188,7 +191,7 @@ instance Num PortNumber where signum n = mkPortNumber (signum (ntohs n)) data SockAddr -- C Names -#ifndef cygwin32_TARGET_OS +#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS) = SockAddrUnix -- struct sockaddr_un String -- sun_path | SockAddrInet -- struct sockaddr_in @@ -266,7 +269,7 @@ bindSocket :: Socket -- Unconnected Socket -> IO () bindSocket (MkSocket s _family _stype _protocol socketStatus) addr = do -#ifndef cygwin32_TARGET_OS +#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS) let isDomainSocket = if _family == AF_UNIX then 1 else (0::Int) #else let isDomainSocket = 0 @@ -301,7 +304,7 @@ connect :: Socket -- Unconnected Socket -> IO () connect (MkSocket s _family _stype _protocol socketStatus) addr = do -#ifndef cygwin32_TARGET_OS +#ifndef _WIN32 let isDomainSocket = if _family == AF_UNIX then 1 else (0::Int) #else let isDomainSocket = 0 @@ -555,7 +558,9 @@ data SocketOption | RecvBuffer {- SO_RCVBUF -} | KeepAlive {- SO_KEEPALIVE -} | OOBInline {- SO_OOBINLINE -} +#ifndef _WIN32 | MaxSegment {- TCP_MAXSEG -} +#endif | NoDelay {- TCP_NODELAY -} -- | Linger {- SO_LINGER -} #if 0 @@ -580,7 +585,9 @@ packSocketOption so = RecvBuffer -> ``SO_RCVBUF'' KeepAlive -> ``SO_KEEPALIVE'' OOBInline -> ``SO_OOBINLINE'' +#ifndef _WIN32 MaxSegment -> ``TCP_MAXSEG'' +#endif NoDelay -> ``TCP_NODELAY'' #if 0 ReusePort -> ``SO_REUSEPORT'' -- BSD only? @@ -708,7 +715,7 @@ unpackFamily family = (range (AF_UNSPEC, AF_IPX))!!family #endif -#if cygwin32_TARGET_OS +#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS) data Family = AF_UNSPEC -- unspecified @@ -951,14 +958,13 @@ packSocketType stype = 1 + (index (Stream, SeqPacket) stype) -- This is for a box running cygwin32 toolchain. -#if defined(cygwin32_TARGET_OS) +#if defined(_WIN32) data SocketType = Stream | Datagram | Raw | RDM -- reliably delivered msg | SeqPacket - | Packet deriving (Eq, Ord, Ix, Show) packSocketType stype = @@ -968,7 +974,6 @@ packSocketType stype = Raw -> ``SOCK_RAW'' RDM -> ``SOCK_RDM'' SeqPacket -> ``SOCK_SEQPACKET'' - Packet -> ``SOCK_PACKET'' #endif @@ -1081,7 +1086,7 @@ sIsWritable = sIsReadable -- sort of. ------------------------------------------------------------------------------- sIsAcceptable :: Socket -> IO Bool -#ifndef cygwin32_TARGET_OS +#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS) sIsAcceptable (MkSocket _ AF_UNIX Stream _ status) = do value <- readIORef status return (value == Connected || value == Bound || value == Listening) @@ -1127,7 +1132,7 @@ Marshaling and allocation helper functions: allocSockAddr :: Family -> IO (MutableByteArray RealWorld Int, Int) -#ifndef cygwin32_TARGET_OS +#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS) allocSockAddr AF_UNIX = do ptr <- allocChars ``sizeof(struct sockaddr_un)'' let (_,sz) = boundsOfMutableByteArray ptr @@ -1145,14 +1150,14 @@ unpackSockAddr :: MutableByteArray RealWorld Int -> Int -> IO SockAddr unpackSockAddr arr len = do fam <- _casm_ ``%r = ((struct sockaddr*)%0)->sa_family;'' arr case unpackFamily fam of -#ifndef cygwin32_TARGET_OS +#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS) AF_UNIX -> unpackSockAddrUnix arr (len - ``sizeof(short)'') #endif AF_INET -> unpackSockAddrInet arr ------------------------------------------------------------------------------- -#ifndef cygwin32_TARGET_OS +#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS) {- sun_path is *not* NULL terminated, hence we *do* need to know the @@ -1178,7 +1183,7 @@ unpackSockAddrInet ptr = do packSockAddr :: SockAddr -> IO (MutableByteArray RealWorld Int) -#ifndef cygwin32_TARGET_OS +#if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS) packSockAddr (SockAddrUnix path) = do (ptr,_) <- allocSockAddr AF_UNIX _casm_ ``(((struct sockaddr_un *)%0)->sun_family) = AF_UNIX;'' ptr @@ -1204,14 +1209,23 @@ it subsequently. socketToHandle :: Socket -> IOMode -> IO Handle socketToHandle (MkSocket fd _ _ _ _) m = do - fileobj <- _ccall_ openFd fd (file_mode::Int) (flush_on_close::Int) - fo <- mkForeignObj fileobj - addForeignFinalizer fo (freeFileObject fo) - mkBuffer__ fo 0 -- not buffered - hndl <- newHandle (Handle__ fo htype NoBuffering socket_str) - return hndl + fileobj <- _ccall_ openFd fd (file_mode::Int) (file_flags::Int) + if fileobj == nullAddr then + ioError (userError "socketHandle: Failed to open file desc") + else do + fo <- mkForeignObj fileobj + addForeignFinalizer fo (freeFileObject fo) + mkBuffer__ fo 0 -- not buffered + hndl <- newHandle (Handle__ fo htype NoBuffering socket_str) + return hndl where socket_str = " (1, 0) @@ -1231,3 +1245,28 @@ socketToHandle (MkSocket s family stype protocol status) m = #endif \end{code} +If you're using WinSock, the programmer has to call a startup +routine before starting to use the goods. So, if you want to +stay portable across all ghc-supported platforms, you have to +use @withSocketsDo@...: + +\begin{code} +withSocketsDo :: IO a -> IO a +#ifndef _WIN32 +withSocketsDo x = x +#else +withSocketsDo act = do + x <- initWinSock + if ( x /= 0 ) then + ioError (userError "Failed to initialise WinSock") + else do + v <- act + shutdownWinSock + return v + +foreign import "initWinSock" initWinSock :: IO Int +foreign import "shutdownWinSock" shutdownWinSock :: IO () + +#endif + +\end{code} -- 1.7.10.4