socketToHandle, -- :: Socket -> IO Handle
--- Alternative read/write interface not yet implemented.
--- sendto -- :: Socket -> String -> SockAddr -> IO Int
--- recvfrm -- :: Socket -> Int -> SockAddr -> IO (String, Int)
+ sendTo, -- :: Socket -> String -> SockAddr -> IO Int
+ recvFrom, -- :: Socket -> Int -> IO (String, Int, SockAddr)
-- sendmsg -- :: Socket -> Message -> MsgFlags -> IO Int
-- recvmsg -- :: Socket -> MsgFlags -> IO Message
- shutdown, -- :: Socket -> ShutdownCmd -> IO ()
- sClose, -- :: Socket -> IO ()
inet_addr, -- :: String -> IO HostAddress
inet_ntoa, -- :: HostAddress -> IO String
sIsListening, -- :: Socket -> IO Bool
sIsReadable, -- :: Socket -> IO Bool
sIsWritable, -- :: Socket -> IO Bool
+ shutdown, -- :: Socket -> ShutdownCmd -> IO ()
+ sClose, -- :: Socket -> IO ()
+ -- socket opts
+ SocketOption(..),
+ getSocketOption, -- :: Socket -> SocketOption -> IO Int
+ setSocketOption, -- :: Socket -> SocketOption -> Int -> IO ()
PortNumber(..),
mkPortNumber, -- :: Int -> PortNumber
aNY_PORT,
iNADDR_ANY,
--- sOL_SOCKET,
sOMAXCONN,
maxListenQueue,
-- The following are exported ONLY for use in the BSD module and
--- should not be used else where.
+-- should not be used anywhere else.
packFamily, unpackFamily,
packSocketType,
import GlaExts
import ST
import Ix
+import Weak ( addForeignFinaliser )
import PrelIOBase -- IOError, Handle representation
import PrelHandle
import Foreign
-import Posix
-import PosixUtil
import IO
import IOExts ( IORef, newIORef, readIORef, writeIORef )
-import PackedString ( unpackNBytesPS, byteArrayToPS,
+import CString ( unpackNBytesBAIO,
unpackCString, unpackCStringIO,
- unpackCStringLenIO
+ unpackCStringLenIO,
+ allocChars
)
\end{code}
newtype PortNumber = PNum Int -- 16-bit value stored in network byte order.
deriving ( Eq )
+instance Show PortNumber where
+ showsPrec p pn = showsPrec p (ntohs pn)
+
mkPortNumber :: Int -> PortNumber
mkPortNumber v = unsafePerformIO $ do
po <- _casm_ ``%r=(int)htons((int)%0); '' v
return (PNum po)
+ntohs :: PortNumber -> Int
+ntohs (PNum po) = unsafePerformIO (_casm_ ``%r=(int)ntohs((int)%0); '' po)
+
+instance Num PortNumber where
+ fromInt i = mkPortNumber i
+ fromInteger i = fromInt (fromInteger i)
+ -- for completeness.
+ (+) x y = mkPortNumber (ntohs x + ntohs y)
+ (-) x y = mkPortNumber (ntohs x - ntohs y)
+ negate x = mkPortNumber (-ntohs x)
+ (*) x y = mkPortNumber (ntohs x * ntohs y)
+ abs n = mkPortNumber (abs (ntohs n))
+ signum n = mkPortNumber (signum (ntohs n))
+
data SockAddr -- C Names
#ifndef cygwin32_TARGET_OS
= SockAddrUnix -- struct sockaddr_un
writeSocket (MkSocket s family stype protocol status) xs = do
currentStatus <- readIORef status
- if not ((currentStatus /= Connected) || (currentStatus /= Listening))
+ if not ((currentStatus == Connected) || (currentStatus == Listening))
then
fail (userError ("writeSocket: can't peform write on socket in status " ++
show currentStatus))
-1 -> constructErrorAndFail "writeSocket"
_ -> return nbytes
-readSocket :: Socket -- Connected Socket
+
+sendTo :: Socket -- Bound/Connected Socket
+ -> String -- Data to send
+ -> SockAddr
+ -> IO Int -- Number of Bytes sent
+
+sendTo (MkSocket s family stype protocol status) xs addr = do
+ currentStatus <- readIORef status
+ if not ((currentStatus == Connected) || (currentStatus == Listening) || (currentStatus == Bound))
+ then
+ fail (userError ("sendTo: can't peform write on socket in status " ++
+ show currentStatus))
+ else do
+ addr' <- packSockAddr addr
+ let (_,sz) = boundsOfByteArray addr'
+ nbytes <- _ccall_ sendTo__ s xs (length xs) addr' sz
+ case nbytes of
+ -1 -> constructErrorAndFail "sendTo"
+ _ -> return nbytes
+
+readSocket :: Socket -- Connected (or bound) Socket
-> Int -- Number of Bytes to Read
-> IO (String, Int) -- (Data Read, Number of Bytes)
readSocket (MkSocket s family stype protocol status) nbytes = do
currentStatus <- readIORef status
- if not ((currentStatus /= Connected) || (currentStatus /= Listening))
+ if not ((currentStatus == Connected) || (currentStatus == Listening))
then
fail (userError ("readSocket: can't perform read on socket in status " ++
show currentStatus))
else do
- ptr <- stToIO (newCharArray (0, nbytes))
+ ptr <- allocChars nbytes
nbytes <- _ccall_ readDescriptor s ptr nbytes
case nbytes of
-1 -> constructErrorAndFail "readSocket"
n -> do
barr <- stToIO (unsafeFreezeByteArray ptr)
- return (unpackNBytesPS (byteArrayToPS barr) n, n)
+ s <- unpackNBytesBAIO barr n
+ return (s,n)
readSocketAll :: Socket -> IO String
readSocketAll s =
(\ _ -> return xs)
in
loop ""
+
+recvFrom :: Socket -> Int -> IO (String, Int, SockAddr)
+recvFrom (MkSocket s family stype protocol status) nbytes = do
+ currentStatus <- readIORef status
+ if not ((currentStatus == Connected) || (currentStatus == Listening) || (currentStatus == Bound))
+ then
+ fail (userError ("recvFrom: can't perform read on socket in status " ++
+ show currentStatus))
+ else do
+ ptr <- allocChars nbytes
+ (ptr_addr,_) <- allocSockAddr AF_INET
+ nbytes <- _ccall_ recvFrom__ s ptr nbytes ptr_addr
+ case nbytes of
+ -1 -> constructErrorAndFail "recvFrom"
+ n -> do
+ barr <- stToIO (unsafeFreezeByteArray ptr)
+ addr <- unpackSockAddrInet ptr_addr
+ s <- unpackNBytesBAIO barr n
+ return (s, n, addr)
+
\end{code}
The port number the given socket is currently connected to can be
%************************************************************************
\begin{code}
-{-
-data SocketOption =
- Debug
- | AcceptConnection
- | ReuseAddr
- | KeepAlive
- | DontRoute
- | Broadcast
- | UseLoopBack
- | Linger
- | OOBInline
- | SendBuffer
- | RecvBuffer
- | SendLowWater
- | RecvLowWater
- | SendTimeOut
- | RecvTimeOut
- | Error
- | Type
-
-sOL_SOCKET = ``SOL_SOCKET''
-
-setSocketOptions :: Socket ->
- Int -> -- Level
- SocketOption -> -- Option Name
- String -> -- Option Value
- IO ()
-
-getSocketOptions :: Socket ->
- Int -> -- Level
- SocketOption -> -- Option Name
- IO String -- Option Value
--}
+data SocketOption
+ = Debug {- SO_DEBUG -}
+ | ReuseAddr {- SO_REUSEADDR -}
+ | Type {- SO_TYPE -}
+ | SoError {- SO_ERROR -}
+ | DontRoute {- SO_DONTROUTE -}
+ | Broadcast {- SO_BROADCAST -}
+ | SendBuffer {- SO_SNDBUF -}
+ | RecvBuffer {- SO_RCVBUF -}
+ | KeepAlive {- SO_KEEPALIVE -}
+ | OOBInline {- SO_OOBINLINE -}
+ | MaxSegment {- TCP_MAXSEG -}
+ | NoDelay {- TCP_NODELAY -}
+-- | Linger {- SO_LINGER -}
+#if 0
+ | ReusePort {- SO_REUSEPORT -} -- BSD only?
+ | RecvLowWater {- SO_RCVLOWAT -}
+ | SendLowWater {- SO_SNDLOWAT -}
+ | RecvTimeOut {- SO_RCVTIMEO -}
+ | SendTimeOut {- SO_SNDTIMEO -}
+ | UseLoopBack {- SO_USELOOPBACK -} -- not used, I believe.
+#endif
+
+packSocketOption :: SocketOption -> Int
+packSocketOption so =
+ case so of
+ Debug -> ``SO_DEBUG''
+ ReuseAddr -> ``SO_REUSEADDR''
+ Type -> ``SO_TYPE''
+ SoError -> ``SO_ERROR''
+ DontRoute -> ``SO_DONTROUTE''
+ Broadcast -> ``SO_BROADCAST''
+ SendBuffer -> ``SO_SNDBUF''
+ RecvBuffer -> ``SO_RCVBUF''
+ KeepAlive -> ``SO_KEEPALIVE''
+ OOBInline -> ``SO_OOBINLINE''
+ MaxSegment -> ``TCP_MAXSEG''
+ NoDelay -> ``TCP_NODELAY''
+#if 0
+ ReusePort -> ``SO_REUSEPORT'' -- BSD only?
+ RecvLowWater -> ``SO_RCVLOWAT''
+ SendLowWater -> ``SO_SNDLOWAT''
+ RecvTimeOut -> ``SO_RCVTIMEO''
+ SendTimeOut -> ``SO_SNDTIMEO''
+ UseLoopBack -> ``SO_USELOOPBACK''
+#endif
+
+setSocketOption :: Socket
+ -> SocketOption -- Option Name
+ -> Int -- Option Value
+ -> IO ()
+setSocketOption (MkSocket s family stype protocol status) so v = do
+ rc <- _ccall_ setSocketOption__ s (packSocketOption so) v
+ if rc /= 0
+ then constructErrorAndFail "setSocketOption"
+ else return ()
+
+getSocketOption :: Socket
+ -> SocketOption -- Option Name
+ -> IO Int -- Option Value
+getSocketOption (MkSocket s family stype protocol status) so = do
+ rc <- _ccall_ getSocketOption__ s (packSocketOption so)
+ if rc == -1 -- let's just hope that value isn't taken..
+ then constructErrorAndFail "getSocketOption"
+ else return rc
+
\end{code}
A calling sequence table for the main functions is shown in the table below.
#endif
-#if freebsd_TARGET_OS
+#if freebsd2_TARGET_OS || freebsd3_TARGET_OS
data Family =
AF_UNSPEC -- unspecified
-- Alpha running OSF or a SPARC with SunOS, rather than Solaris.
#if osf1_TARGET_OS || osf3_TARGET_OS || sunos4_TARGET_OS || hpux_TARGET_OS || \
- aix_TARGET_OS || freebsd_TARGET_OS
+ aix_TARGET_OS || freebsd2_TARGET_OS || freebsd3_TARGET_OS
data SocketType =
Stream
| Datagram
%************************************************************************
\begin{code}
-aNY_PORT = 0::Int
+aNY_PORT :: PortNumber
+aNY_PORT = mkPortNumber 0
+
iNADDR_ANY :: HostAddress
iNADDR_ANY = unsafePerformIO (_casm_ `` %r = htonl(INADDR_ANY); '')
#ifndef cygwin32_TARGET_OS
allocSockAddr AF_UNIX = do
- ptr <- stToIO (newCharArray (0,``sizeof(struct sockaddr_un)''))
+ ptr <- allocChars ``sizeof(struct sockaddr_un)''
let (_,sz) = boundsOfByteArray ptr
return (ptr, sz)
#endif
allocSockAddr AF_INET = do
- ptr <- stToIO (newCharArray (0,``sizeof(struct sockaddr_in)''))
+ ptr <- allocChars ``sizeof(struct sockaddr_in)''
let (_,sz) = boundsOfByteArray ptr
return (ptr, sz)
#ifndef __PARALLEL_HASKELL__
socketToHandle :: Socket -> IOMode -> IO Handle
-socketToHandle (MkSocket s family stype protocol status) m = do
- ptr <- _casm_ ``%r = fdopen (%0, (char *)%1);'' s m'
- fp <- makeForeignObj ptr (``&freeFile'' :: Addr)
- hndl <- newHandle (htype fp Nothing False)
- hSetBuffering hndl NoBuffering
+socketToHandle (MkSocket fd family stype protocol status) m = do
+ fo <- _ccall_ openFd fd file_mode flush_on_close
+ fo <- makeForeignObj fo
+ addForeignFinaliser fo (freeFileObject fo)
+ mkBuffer__ fo 0 -- not buffered
+ hndl <- newHandle (Handle__ fo htype NoBuffering socket_str)
return hndl
where
- m' =
+ socket_str = "<socket: "++show fd
+ (flush_on_close, file_mode) =
case m of
- ReadMode -> "r"
- WriteMode -> "w"
- AppendMode -> "a"
- ReadWriteMode -> "r+"
+ AppendMode -> (1, 0)
+ WriteMode -> (1, 1)
+ ReadMode -> (0, 2)
+ ReadWriteMode -> (1, 3)
+
htype =
case m of
ReadMode -> ReadHandle
projects / ghc-hetmet.git / blobdiff