module Network.Socket( Socket , SocketType(..) , Family(..) , isSupportedFamily , SockAddr(..) , SocketStatus(..) , ShutdownCmd(..) , PortNumber(..) , HostName , ServiceName , AddrInfo(..) , AddrInfoFlag(..) , addrInfoFlagImplemented , defaultHints , getAddrInfo , NameInfoFlag(..) , getNameInfo , socket , socketPair , connect , bind , listen , accept , getPeerName , getSocketName , getPeerCred , socketPort , socketToHandle , sendTo , sendBufTo , recvFrom , recvBufFrom , send , recv , recvLen , sendBuf , recvBuf , inet_addr , inet_ntoa , shutdown , close , isConnected , isBound , isListening , isReadable , isWritable , SocketOption(..) , defaultProtocol , isSupportedSocketOption , getSocketOption , setSocketOption , aNY_PORT , iNADDR_ANY , iN6ADDR_ANY , sOMAXCONN , sOL_SOCKET , sCM_RIGHTS , maxListenQueue , withSocketsDo , sClose ) where import Control.Concurrent.MVar import Control.Exception import Data.Typeable import Data.Word import Data.ByteString(useAsCStringLen, packCStringLen) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as BSL import Data.ByteString.Lazy.Char8(pack, unpack) import Foreign.C.Types import Foreign.Ptr import Foreign.Storable import GHC.IO.Handle(mkFileHandle) import Hans.Address.IP4 import Hans.Message.Tcp(getPort) import qualified Hans.NetworkStack as NS import Hans.Socket.Handle import Network.BSD import qualified Network.Socket.ByteString as NBS import Network.Socket.Internal import qualified Network.Socket.ByteString.Lazy as SL import System.IO isSupportedFamily :: Family -> Bool isSupportedFamily AF_INET = True isSupportedFamily _ = False data AddrInfo = AddrInfo { addrFlags :: [AddrInfoFlag] , addrFamily :: Family , addrSocketType :: SocketType , addrProtocol :: ProtocolNumber , addrAddress :: SockAddr , addrCanonName :: Maybe String } deriving (Eq, Show, Typeable) data AddrInfoFlag = AI_ADDRCONFIG | AI_ALL | AI_CANONNAME | AI_NUMERICHOST | AI_NUMERICSERV | AI_PASSIVE | AI_V4MAPPED deriving (Eq, Read, Show, Typeable) addrInfoFlagImplemented :: AddrInfoFlag -> Bool addrInfoFlagImplemented _ = False defaultHints :: AddrInfo defaultHints = AddrInfo [] AF_UNSPEC NoSocketType defaultProtocol undefined undefined getAddrInfo :: Maybe AddrInfo -> Maybe HostName -> Maybe ServiceName -> IO [AddrInfo] getAddrInfo _ Nothing Nothing = throwIO (userError "Cannot pass two Nothings to getAddrInfo") getAddrInfo Nothing mhn msn = getAddrInfo (Just defaultHints) mhn msn getAddrInfo mai Nothing msn = getAddrInfo mai (Just "127.0.0.1") msn getAddrInfo (Just hints) (Just hostname) msn = do addr <- case reads hostname of [(addr, "")] -> return (convertToWord32 addr) _ -> hostAddress `fmap` (getHostByName hostname) (port, proto) <- case msn of Nothing -> return (0, defaultProtocol) Just sn -> do pent <- getProtocolByNumber (addrProtocol hints) entry <- getServiceByName "sn" (protoName pent) let port = servicePort entry prot <- getProtocolByName (serviceProtocol entry) return (port, protoNumber prot) let stype = if proto == 6 then Stream else Datagram -- Now figure out the socket type let sockaddr = SockAddrInet port addr return [hints{ addrFamily = AF_INET, addrSocketType = stype, addrProtocol = proto, addrAddress = sockaddr, addrCanonName = Just hostname }] data NameInfoFlag = NI_DGRAM | NI_NAMEREQD | NI_NOFQDN | NI_NUMERICHOST | NI_NUMERICSERV deriving (Eq, Read, Show, Typeable) getNameInfo :: [NameInfoFlag] -> Bool -> Bool -> SockAddr -> IO (Maybe HostName, Maybe ServiceName) getNameInfo _ _ _ _ = throwIO (userError "FIXME: ERROR: network-hans does not support getNameInfo") socketPair :: Family -> SocketType -> ProtocolNumber -> IO (Socket, Socket) socketPair _ _ _ = throwIO (userError "FIXME: ERROR: network-hans does not support socketPair") getPeerName :: Socket -> IO SockAddr getPeerName s = do nsock <- getConnectedHansSocket s ForNeither let oaddr = convertToWord32 (NS.sockRemoteHost nsock) oport = fromIntegral (getPort (NS.sockRemotePort nsock)) return (SockAddrInet oport oaddr) getSocketName :: Socket -> IO SockAddr getSocketName s = do nsock <- getConnectedHansSocket s ForNeither let lport = fromIntegral (getPort (NS.sockLocalPort nsock)) laddr = convertToWord32 (IP4 127 0 0 1) return (SockAddrInet lport laddr) getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt) getPeerCred _ = throwIO (userError "getPeerCred not supported on HaNS") socketPort :: Socket -> IO PortNumber socketPort sock = do SockAddrInet port _ <- getSocketName sock return port socketToHandle :: Socket -> IOMode -> IO Handle socketToHandle so mode = do nsock <- getConnectedHansSocket so ForBoth makeHansHandle nsock mode sendTo :: Socket -> String -> SockAddr -> IO Int sendTo s str addr = NBS.sendTo s (BSC.pack str) addr sendBufTo :: Socket -> Ptr a -> Int -> SockAddr -> IO Int sendBufTo sock ptr sz addr = do bstr <- packCStringLen (castPtr ptr, fromIntegral sz) NBS.sendTo sock bstr addr recvFrom :: Socket -> Int -> IO (String, Int, SockAddr) recvFrom sock size = do (bstr, addr) <- NBS.recvFrom sock size return (BSC.unpack bstr, BS.length bstr, addr) recvBufFrom :: Socket -> Ptr a -> Int -> IO (Int, SockAddr) recvBufFrom sock dptr size = do (bstr, addr) <- NBS.recvFrom sock size sz <- useAsCStringLen bstr $ \ (sptr, amt) -> do memcpy dptr sptr amt return amt return (sz, addr) send :: Socket -> String -> IO Int send so st = fromIntegral `fmap` SL.send so (pack st) recv :: Socket -> Int -> IO String recv so sz = unpack `fmap` SL.recv so (fromIntegral sz) recvLen :: Socket -> Int -> IO (String, Int) recvLen so sz = do bstr <- SL.recv so (fromIntegral sz) return (unpack bstr, fromIntegral (BSL.length bstr)) sendBuf :: Socket -> Ptr Word8 -> Int -> IO Int sendBuf so ptr sz = do bstr <- packCStringLen (castPtr ptr, fromIntegral sz) NBS.send so bstr recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int recvBuf so dptr sz = do bstr <- NBS.recv so sz sz' <- useAsCStringLen bstr $ \ (sptr, amt) -> do memcpy dptr sptr amt return amt return sz' inet_addr :: String -> IO HostAddress inet_addr str = hostAddress `fmap` getHostByName str inet_ntoa :: HostAddress -> IO String inet_ntoa addr = catch (hostName `fmap` getHostByAddr AF_INET addr) (\ (_ :: SomeException) -> return (show (convertFromWord32 addr))) data SocketOption = Debug | ReuseAddr | Type | SoError | DontRoute | Broadcast | SendBuffer | RecvBuffer | KeepAlive | OOBInline | TimeToLive | MaxSegment | NoDelay | Cork | Linger | ReusePort | RecvLowWater | SendLowWater | RecvTimeOut | SendTimeOut | UseLoopBack | IPv6Only | CustomSockOpt (CInt, CInt) deriving (Show, Typeable) isSupportedSocketOption :: SocketOption -> Bool isSupportedSocketOption _ = False getSocketOption :: Socket -> SocketOption -> IO Int getSocketOption _ _ = return 0 setSocketOption :: Socket -> SocketOption -> Int -> IO () setSocketOption _ _ _ = return () aNY_PORT :: PortNumber aNY_PORT = 0 iNADDR_ANY :: HostAddress iNADDR_ANY = 0 iN6ADDR_ANY :: HostAddress6 iN6ADDR_ANY = (0, 0, 0, 0) sOMAXCONN :: Int sOMAXCONN = 128 sOL_SOCKET :: Int sOL_SOCKET = 1 sCM_RIGHTS :: Int sCM_RIGHTS = 1 maxListenQueue :: Int maxListenQueue = 128 withSocketsDo :: IO a -> IO a withSocketsDo action = action sClose :: Socket -> IO () sClose = close foreign import ccall unsafe "string.h memcpy" memcpy :: Ptr a -> Ptr b -> Int -> IO ()