switch over to using Winsock on the _WIN32 side
getServiceByPort, -- :: PortNumber -> ProtocolName -> IO ServiceEntry
getServicePortNumber, -- :: ServiceName -> IO PortNumber
getServiceByPort, -- :: PortNumber -> ProtocolName -> IO ServiceEntry
getServicePortNumber, -- :: ServiceName -> IO PortNumber
-#ifndef cygwin32_TARGET_OS
getServiceEntry, -- :: IO ServiceEntry
setServiceEntry, -- :: Bool -> IO ()
endServiceEntry, -- :: IO ()
getServiceEntry, -- :: IO ServiceEntry
setServiceEntry, -- :: Bool -> IO ()
endServiceEntry, -- :: IO ()
getProtocolByNumber, -- :: ProtocolNumber -> IO ProtcolEntry
getProtocolNumber, -- :: ProtocolName -> ProtocolNumber
getProtocolByNumber, -- :: ProtocolNumber -> IO ProtcolEntry
getProtocolNumber, -- :: ProtocolName -> ProtocolNumber
-#ifndef cygwin32_TARGET_OS
setProtocolEntry, -- :: Bool -> IO ()
getProtocolEntry, -- :: IO ProtocolEntry
endProtocolEntry, -- :: IO ()
setProtocolEntry, -- :: Bool -> IO ()
getProtocolEntry, -- :: IO ProtocolEntry
endProtocolEntry, -- :: IO ()
getHostByAddr, -- :: HostAddress -> Family -> IO HostEntry
hostAddress, -- :: HostEntry -> HostAddress
getHostByAddr, -- :: HostAddress -> Family -> IO HostEntry
hostAddress, -- :: HostEntry -> HostAddress
-#ifndef cygwin32_TARGET_OS
setHostEntry, -- :: Bool -> IO ()
getHostEntry, -- :: IO HostEntry
endHostEntry, -- :: IO ()
setHostEntry, -- :: Bool -> IO ()
getHostEntry, -- :: IO HostEntry
endHostEntry, -- :: IO ()
NetworkName,
NetworkAddr,
NetworkEntry(..)
NetworkName,
NetworkAddr,
NetworkEntry(..)
-#ifndef cygwin32_TARGET_OS
, getNetworkByName -- :: NetworkName -> IO NetworkEntry
, getNetworkByAddr -- :: NetworkAddr -> Family -> IO NetworkEntry
, setNetworkEntry -- :: Bool -> IO ()
, getNetworkByName -- :: NetworkName -> IO NetworkEntry
, getNetworkByAddr -- :: NetworkAddr -> Family -> IO NetworkEntry
, setNetworkEntry -- :: Bool -> IO ()
(ServiceEntry _ _ port _) <- getServiceByName name "tcp"
return port
(ServiceEntry _ _ port _) <- getServiceByName name "tcp"
return port
-#ifndef cygwin32_TARGET_OS
getServiceEntry :: IO ServiceEntry
getServiceEntry = do
ptr <- _ccall_ getservent
getServiceEntry :: IO ServiceEntry
getServiceEntry = do
ptr <- _ccall_ getservent
getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
getProtocolNumber :: ProtocolName -> IO ProtocolNumber
getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry
getProtocolNumber :: ProtocolName -> IO ProtocolNumber
-#ifndef cygwin32_TARGET_OS
setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
endProtocolEntry :: IO ()
setProtocolEntry :: Bool -> IO () -- Keep DB Open ?
getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
endProtocolEntry :: IO ()
(ProtocolEntry _ _ num) <- getProtocolByName proto
return num
(ProtocolEntry _ _ num) <- getProtocolByName proto
return num
-#ifndef cygwin32_TARGET_OS
--getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
getProtocolEntry = do
ptr <- _ccall_ getprotoent
--getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB
getProtocolEntry = do
ptr <- _ccall_ getprotoent
then ioError (IOError Nothing NoSuchThing "getHostByAddr" "no such host entry")
else unpackHostEntry ptr
then ioError (IOError Nothing NoSuchThing "getHostByAddr" "no such host entry")
else unpackHostEntry ptr
-#ifndef cygwin32_TARGET_OS
getHostEntry :: IO HostEntry
getHostEntry = do
ptr <- _ccall_ gethostent
getHostEntry :: IO HostEntry
getHostEntry = do
ptr <- _ccall_ gethostent
networkFamily :: Family, -- type
networkAddress :: NetworkAddr
}
networkFamily :: Family, -- type
networkAddress :: NetworkAddr
}
-#ifndef cygwin32_TARGET_OS
getNetworkByName :: NetworkName -> IO NetworkEntry
getNetworkByName name = do
ptr <- _ccall_ getnetbyname name
getNetworkByName :: NetworkName -> IO NetworkEntry
getNetworkByName name = do
ptr <- _ccall_ getnetbyname name
-# $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.
#
#
# Makefile for miscellaneous libraries.
#
+# (what's this stuff doing here?)
WAY_p_HC_OPTS += -GPrelude
WAY_mr_HC_OPTS += -GPrelude
WAY_p_HC_OPTS += -GPrelude
WAY_mr_HC_OPTS += -GPrelude
SRC_MKDEPENDHS_OPTS += -I$(GHC_INCLUDE_DIR)
#-----------------------------------------------------------------------------
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
# Installation; need to install .hi files as well as libraries
#
# The interface files are put inside the $(libdir), since they
sendTo, -- :: Hostname -> PortID -> String -> IO ()
recvFrom, -- :: Hostname -> PortID -> IO String
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
data PortID =
Service String -- Service Name eg "ftp"
| PortNumber PortNumber -- User defined Port Number
data PortID =
Service String -- Service Name eg "ftp"
| PortNumber PortNumber -- User defined Port Number
-#ifndef cygwin32_TARGET_OS
| UnixSocket String -- Unix family socket in file system
#endif
| UnixSocket String -- Unix family socket in file system
#endif
connect sock (SockAddrInet port (hostAddress he))
socketToHandle sock ReadWriteMode
connect sock (SockAddrInet port (hostAddress he))
socketToHandle sock ReadWriteMode
-#ifndef cygwin32_TARGET_OS
connectTo _ (UnixSocket path) = do
sock <- socket AF_UNIX Datagram 0
connect sock (SockAddrUnix path)
connectTo _ (UnixSocket path) = do
sock <- socket AF_UNIX Datagram 0
connect sock (SockAddrUnix path)
listen sock maxListenQueue
return sock
listen sock maxListenQueue
return sock
-#ifndef cygwin32_TARGET_OS
listenOn (UnixSocket path) = do
sock <- socket AF_UNIX Datagram 0
bindSocket sock (SockAddrUnix path)
listenOn (UnixSocket path) = do
sock <- socket AF_UNIX Datagram 0
bindSocket sock (SockAddrUnix path)
portID sa =
case sa of
SockAddrInet port _ -> PortNumber port
portID sa =
case sa of
SockAddrInet port _ -> PortNumber port
-#ifndef cygwin32_TARGET_OS
SockAddrUnix path -> UnixSocket path
#endif
SockAddrUnix path -> UnixSocket path
#endif
packSocketType,
packSockAddr, unpackSockAddr
packSocketType,
packSockAddr, unpackSockAddr
+ , withSocketsDo -- :: IO a -> IO a
+
import PrelIOBase -- IOError, Handle representation
import PrelHandle
import Foreign
import PrelIOBase -- IOError, Handle representation
import PrelHandle
import Foreign
+import Addr ( nullAddr )
import IO
import IOExts ( IORef, newIORef, readIORef, writeIORef )
import IO
import IOExts ( IORef, newIORef, readIORef, writeIORef )
signum n = mkPortNumber (signum (ntohs n))
data SockAddr -- C Names
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
= SockAddrUnix -- struct sockaddr_un
String -- sun_path
| SockAddrInet -- struct sockaddr_in
-> IO ()
bindSocket (MkSocket s _family _stype _protocol socketStatus) addr = do
-> 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
let isDomainSocket = if _family == AF_UNIX then 1 else (0::Int)
#else
let isDomainSocket = 0
-> IO ()
connect (MkSocket s _family _stype _protocol socketStatus) addr = do
-> IO ()
connect (MkSocket s _family _stype _protocol socketStatus) addr = do
-#ifndef cygwin32_TARGET_OS
let isDomainSocket = if _family == AF_UNIX then 1 else (0::Int)
#else
let isDomainSocket = 0
let isDomainSocket = if _family == AF_UNIX then 1 else (0::Int)
#else
let isDomainSocket = 0
| RecvBuffer {- SO_RCVBUF -}
| KeepAlive {- SO_KEEPALIVE -}
| OOBInline {- SO_OOBINLINE -}
| RecvBuffer {- SO_RCVBUF -}
| KeepAlive {- SO_KEEPALIVE -}
| OOBInline {- SO_OOBINLINE -}
| MaxSegment {- TCP_MAXSEG -}
| MaxSegment {- TCP_MAXSEG -}
| NoDelay {- TCP_NODELAY -}
-- | Linger {- SO_LINGER -}
#if 0
| NoDelay {- TCP_NODELAY -}
-- | Linger {- SO_LINGER -}
#if 0
RecvBuffer -> ``SO_RCVBUF''
KeepAlive -> ``SO_KEEPALIVE''
OOBInline -> ``SO_OOBINLINE''
RecvBuffer -> ``SO_RCVBUF''
KeepAlive -> ``SO_KEEPALIVE''
OOBInline -> ``SO_OOBINLINE''
MaxSegment -> ``TCP_MAXSEG''
MaxSegment -> ``TCP_MAXSEG''
NoDelay -> ``TCP_NODELAY''
#if 0
ReusePort -> ``SO_REUSEPORT'' -- BSD only?
NoDelay -> ``TCP_NODELAY''
#if 0
ReusePort -> ``SO_REUSEPORT'' -- BSD only?
+#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
data Family =
AF_UNSPEC -- unspecified
data Family =
AF_UNSPEC -- unspecified
-- This is for a box running cygwin32 toolchain.
-- This is for a box running cygwin32 toolchain.
-#if defined(cygwin32_TARGET_OS)
data SocketType =
Stream
| Datagram
| Raw
| RDM -- reliably delivered msg
| SeqPacket
data SocketType =
Stream
| Datagram
| Raw
| RDM -- reliably delivered msg
| SeqPacket
deriving (Eq, Ord, Ix, Show)
packSocketType stype =
deriving (Eq, Ord, Ix, Show)
packSocketType stype =
Raw -> ``SOCK_RAW''
RDM -> ``SOCK_RDM''
SeqPacket -> ``SOCK_SEQPACKET''
Raw -> ``SOCK_RAW''
RDM -> ``SOCK_RDM''
SeqPacket -> ``SOCK_SEQPACKET''
- Packet -> ``SOCK_PACKET''
-------------------------------------------------------------------------------
sIsAcceptable :: Socket -> IO Bool
-------------------------------------------------------------------------------
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)
sIsAcceptable (MkSocket _ AF_UNIX Stream _ status) = do
value <- readIORef status
return (value == Connected || value == Bound || value == Listening)
allocSockAddr :: Family -> IO (MutableByteArray RealWorld Int, Int)
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
allocSockAddr AF_UNIX = do
ptr <- allocChars ``sizeof(struct sockaddr_un)''
let (_,sz) = boundsOfMutableByteArray ptr
unpackSockAddr arr len = do
fam <- _casm_ ``%r = ((struct sockaddr*)%0)->sa_family;'' arr
case unpackFamily fam of
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
-------------------------------------------------------------------------------
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
{-
sun_path is *not* NULL terminated, hence we *do* need to know the
packSockAddr :: SockAddr -> IO (MutableByteArray RealWorld Int)
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
packSockAddr (SockAddrUnix path) = do
(ptr,_) <- allocSockAddr AF_UNIX
_casm_ ``(((struct sockaddr_un *)%0)->sun_family) = AF_UNIX;'' ptr
socketToHandle :: Socket -> IOMode -> IO Handle
socketToHandle (MkSocket fd _ _ _ _) m = do
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 = "<socket: "++show fd
where
socket_str = "<socket: "++show fd
+#ifdef _WIN32
+ file_flags = flush_on_close + 1024{-I'm a socket fd, me!-}
+#else
+ file_flags = flush_on_close
+#endif
+
(flush_on_close, file_mode) =
case m of
AppendMode -> (1, 0)
(flush_on_close, file_mode) =
case m of
AppendMode -> (1, 0)
+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}