Skip to content

GitLab

Commit 6bef2efe authored by sof's avatar sof
Browse files

[project @ 1999-05-05 10:36:29 by sof] 

switch over to using Winsock on the _WIN32 side
parent ba6cc328
Hide whitespace changes
Inline Side-by-side
ghc/lib/misc/BSD.lhs
View file @ 6bef2efe
......@@ -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
......
ghc/lib/misc/Makefile
View file @ 6bef2efe
# $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
......@@ -64,6 +65,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
#
......
ghc/lib/misc/Socket.lhs
View file @ 6bef2efe
......@@ -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
......
ghc/lib/misc/SocketPrim.lhs
View file @ 6bef2efe
......@@ -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 = "<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)
......@@ -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}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment