1{-# LANGUAGE CPP #-} 2{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 3----------------------------------------------------------------------------- 4-- | 5-- Module : Network 6-- Copyright : (c) The University of Glasgow 2001 7-- License : BSD-style (see the file libraries/network/LICENSE) 8-- 9-- Maintainer : libraries@haskell.org 10-- Stability : provisional 11-- Portability : portable 12-- 13-- This module is kept for backwards-compatibility. New users are 14-- encouraged to use "Network.Socket" instead. 15-- 16-- "Network" was intended as a \"higher-level\" interface to networking 17-- facilities, and only supports TCP. 18-- 19----------------------------------------------------------------------------- 20 21#include "HsNetworkConfig.h" 22 23#ifdef HAVE_GETADDRINFO 24-- Use IPv6-capable function definitions if the OS supports it. 25#define IPV6_SOCKET_SUPPORT 1 26#endif 27 28module Network 29 ( 30 -- * Basic data types 31 Socket 32 , PortID(..) 33 , HostName 34 , PortNumber 35 36 -- * Initialisation 37 , withSocketsDo 38 39 -- * Server-side connections 40 , listenOn 41 , accept 42 , sClose 43 44 -- * Client-side connections 45 , connectTo 46 47 -- * Simple sending and receiving 48 {-$sendrecv-} 49 , sendTo 50 , recvFrom 51 52 -- * Miscellaneous 53 , socketPort 54 55 -- * Networking Issues 56 -- ** Buffering 57 {-$buffering-} 58 59 -- ** Improving I\/O Performance over sockets 60 {-$performance-} 61 ) where 62 63import Control.Monad (liftM) 64import Data.Maybe (fromJust) 65import Network.BSD 66import Network.Socket hiding (accept, socketPort, recvFrom, 67 sendTo, PortNumber, sClose) 68import qualified Network.Socket as Socket (accept) 69import System.IO 70import Prelude 71import qualified Control.Exception as Exception 72 73-- --------------------------------------------------------------------------- 74-- High Level ``Setup'' functions 75 76-- If the @PortID@ specifies a unix family socket and the @Hostname@ 77-- differs from that returned by @getHostname@ then an error is 78-- raised. Alternatively an empty string may be given to @connectTo@ 79-- signalling that the current hostname applies. 80 81data PortID = 82 Service String -- Service Name eg "ftp" 83 | PortNumber PortNumber -- User defined Port Number 84#if !defined(mingw32_HOST_OS) 85 | UnixSocket String -- Unix family socket in file system 86#endif 87 deriving (Show, Eq) 88 89-- | Calling 'connectTo' creates a client side socket which is 90-- connected to the given host and port. The Protocol and socket type is 91-- derived from the given port identifier. If a port number is given 92-- then the result is always an internet family 'Stream' socket. 93 94connectTo :: HostName -- Hostname 95 -> PortID -- Port Identifier 96 -> IO Handle -- Connected Socket 97 98#if defined(IPV6_SOCKET_SUPPORT) 99-- IPv6 and IPv4. 100 101connectTo hostname (Service serv) = connect' "Network.connectTo" hostname serv 102 103connectTo hostname (PortNumber port) = connect' "Network.connectTo" hostname (show port) 104#else 105-- IPv4 only. 106 107connectTo hostname (Service serv) = do 108 proto <- getProtocolNumber "tcp" 109 bracketOnError 110 (socket AF_INET Stream proto) 111 (sClose) -- only done if there's an error 112 (\sock -> do 113 port <- getServicePortNumber serv 114 he <- getHostByName hostname 115 connect sock (SockAddrInet port (hostAddress he)) 116 socketToHandle sock ReadWriteMode 117 ) 118 119connectTo hostname (PortNumber port) = do 120 proto <- getProtocolNumber "tcp" 121 bracketOnError 122 (socket AF_INET Stream proto) 123 (sClose) -- only done if there's an error 124 (\sock -> do 125 he <- getHostByName hostname 126 connect sock (SockAddrInet port (hostAddress he)) 127 socketToHandle sock ReadWriteMode 128 ) 129#endif 130 131#if !defined(mingw32_HOST_OS) 132connectTo _ (UnixSocket path) = do 133 bracketOnError 134 (socket AF_UNIX Stream 0) 135 (sClose) 136 (\sock -> do 137 connect sock (SockAddrUnix path) 138 socketToHandle sock ReadWriteMode 139 ) 140#endif 141 142#if defined(IPV6_SOCKET_SUPPORT) 143connect' :: String -> HostName -> ServiceName -> IO Handle 144 145connect' caller host serv = do 146 proto <- getProtocolNumber "tcp" 147 let hints = defaultHints { addrFlags = [AI_ADDRCONFIG] 148 , addrProtocol = proto 149 , addrSocketType = Stream } 150 addrs <- getAddrInfo (Just hints) (Just host) (Just serv) 151 firstSuccessful caller $ map tryToConnect addrs 152 where 153 tryToConnect addr = 154 bracketOnError 155 (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) 156 (sClose) -- only done if there's an error 157 (\sock -> do 158 connect sock (addrAddress addr) 159 socketToHandle sock ReadWriteMode 160 ) 161#endif 162 163-- | Creates the server side socket which has been bound to the 164-- specified port. 165-- 166-- 'maxListenQueue' (typically 128) is specified to the listen queue. 167-- This is good enough for normal network servers but is too small 168-- for high performance servers. 169-- 170-- To avoid the \"Address already in use\" problems, 171-- the 'ReuseAddr' socket option is set on the listening socket. 172-- 173-- If available, the 'IPv6Only' socket option is set to 0 174-- so that both IPv4 and IPv6 can be accepted with this socket. 175-- 176-- If you don't like the behavior above, please use the lower level 177-- 'Network.Socket.listen' instead. 178 179listenOn :: PortID -- ^ Port Identifier 180 -> IO Socket -- ^ Listening Socket 181 182#if defined(IPV6_SOCKET_SUPPORT) 183-- IPv6 and IPv4. 184 185listenOn (Service serv) = listen' serv 186 187listenOn (PortNumber port) = listen' (show port) 188#else 189-- IPv4 only. 190 191listenOn (Service serv) = do 192 proto <- getProtocolNumber "tcp" 193 bracketOnError 194 (socket AF_INET Stream proto) 195 (sClose) 196 (\sock -> do 197 port <- getServicePortNumber serv 198 setSocketOption sock ReuseAddr 1 199 bind sock (SockAddrInet port iNADDR_ANY) 200 listen sock maxListenQueue 201 return sock 202 ) 203 204listenOn (PortNumber port) = do 205 proto <- getProtocolNumber "tcp" 206 bracketOnError 207 (socket AF_INET Stream proto) 208 (sClose) 209 (\sock -> do 210 setSocketOption sock ReuseAddr 1 211 bind sock (SockAddrInet port iNADDR_ANY) 212 listen sock maxListenQueue 213 return sock 214 ) 215#endif 216 217#if !defined(mingw32_HOST_OS) 218listenOn (UnixSocket path) = 219 bracketOnError 220 (socket AF_UNIX Stream 0) 221 (sClose) 222 (\sock -> do 223 setSocketOption sock ReuseAddr 1 224 bind sock (SockAddrUnix path) 225 listen sock maxListenQueue 226 return sock 227 ) 228#endif 229 230#if defined(IPV6_SOCKET_SUPPORT) 231listen' :: ServiceName -> IO Socket 232 233listen' serv = do 234 proto <- getProtocolNumber "tcp" 235 -- We should probably specify addrFamily = AF_INET6 and the filter 236 -- code below should be removed. AI_ADDRCONFIG is probably not 237 -- necessary. But this code is well-tested. So, let's keep it. 238 let hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_PASSIVE] 239 , addrSocketType = Stream 240 , addrProtocol = proto } 241 addrs <- getAddrInfo (Just hints) Nothing (Just serv) 242 -- Choose an IPv6 socket if exists. This ensures the socket can 243 -- handle both IPv4 and IPv6 if v6only is false. 244 let addrs' = filter (\x -> addrFamily x == AF_INET6) addrs 245 addr = if null addrs' then head addrs else head addrs' 246 bracketOnError 247 (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) 248 (sClose) 249 (\sock -> do 250 setSocketOption sock ReuseAddr 1 251 bind sock (addrAddress addr) 252 listen sock maxListenQueue 253 return sock 254 ) 255#endif 256 257-- ----------------------------------------------------------------------------- 258-- accept 259 260-- | Accept a connection on a socket created by 'listenOn'. Normal 261-- I\/O operations (see "System.IO") can be used on the 'Handle' 262-- returned to communicate with the client. 263-- Notice that although you can pass any Socket to Network.accept, 264-- only sockets of either AF_UNIX, AF_INET, or AF_INET6 will work 265-- (this shouldn't be a problem, though). When using AF_UNIX, HostName 266-- will be set to the path of the socket and PortNumber to -1. 267-- 268accept :: Socket -- ^ Listening Socket 269 -> IO (Handle, 270 HostName, 271 PortNumber) -- ^ Triple of: read\/write 'Handle' for 272 -- communicating with the client, 273 -- the 'HostName' of the peer socket, and 274 -- the 'PortNumber' of the remote connection. 275accept sock@(MkSocket _ AF_INET _ _ _) = do 276 ~(sock', (SockAddrInet port haddr)) <- Socket.accept sock 277 peer <- catchIO 278 (do 279 (HostEntry peer _ _ _) <- getHostByAddr AF_INET haddr 280 return peer 281 ) 282 (\_e -> inet_ntoa haddr) 283 -- if getHostByName fails, we fall back to the IP address 284 handle <- socketToHandle sock' ReadWriteMode 285 return (handle, peer, port) 286#if defined(IPV6_SOCKET_SUPPORT) 287accept sock@(MkSocket _ AF_INET6 _ _ _) = do 288 (sock', addr) <- Socket.accept sock 289 peer <- catchIO ((fromJust . fst) `liftM` getNameInfo [] True False addr) $ 290 \_ -> case addr of 291 SockAddrInet _ a -> inet_ntoa a 292 SockAddrInet6 _ _ a _ -> return (show a) 293#if defined(mingw32_HOST_OS) 294 SockAddrUnix {} -> ioError $ userError "Network.accept: peer socket address 'SockAddrUnix' not supported on this platform." 295#else 296 SockAddrUnix a -> return a 297#endif 298#if defined(CAN_SOCKET_SUPPORT) 299 SockAddrCan {} -> ioError $ userError "Network.accept: peer socket address 'SockAddrCan' not supported." 300#else 301 SockAddrCan {} -> ioError $ userError "Network.accept: peer socket address 'SockAddrCan' not supported on this platform." 302#endif 303 handle <- socketToHandle sock' ReadWriteMode 304 let port = case addr of 305 SockAddrInet p _ -> p 306 SockAddrInet6 p _ _ _ -> p 307 _ -> -1 308 return (handle, peer, port) 309#endif 310#if !defined(mingw32_HOST_OS) 311accept sock@(MkSocket _ AF_UNIX _ _ _) = do 312 ~(sock', (SockAddrUnix path)) <- Socket.accept sock 313 handle <- socketToHandle sock' ReadWriteMode 314 return (handle, path, -1) 315#endif 316accept (MkSocket _ family _ _ _) = 317 ioError $ userError $ "Network.accept: address family '" ++ 318 show family ++ "' not supported." 319 320 321-- | Close the socket. Sending data to or receiving data from closed socket 322-- may lead to undefined behaviour. 323sClose :: Socket -> IO () 324sClose = close -- Explicit redefinition because Network.sClose is deprecated, 325 -- hence the re-export would also be marked as such. 326 327-- ----------------------------------------------------------------------------- 328-- sendTo/recvFrom 329 330{-$sendrecv 331Send and receive data from\/to the given host and port number. These 332should normally only be used where the socket will not be required for 333further calls. Also, note that due to the use of 'hGetContents' in 'recvFrom' 334the socket will remain open (i.e. not available) even if the function already 335returned. Their use is strongly discouraged except for small test-applications 336or invocations from the command line. 337-} 338 339sendTo :: HostName -- Hostname 340 -> PortID -- Port Number 341 -> String -- Message to send 342 -> IO () 343sendTo h p msg = do 344 s <- connectTo h p 345 hPutStr s msg 346 hClose s 347 348recvFrom :: HostName -- Hostname 349 -> PortID -- Port Number 350 -> IO String -- Received Data 351 352#if defined(IPV6_SOCKET_SUPPORT) 353recvFrom host port = do 354 proto <- getProtocolNumber "tcp" 355 let hints = defaultHints { addrFlags = [AI_ADDRCONFIG] 356 , addrProtocol = proto 357 , addrSocketType = Stream } 358 allowed <- map addrAddress `liftM` getAddrInfo (Just hints) (Just host) 359 Nothing 360 s <- listenOn port 361 let waiting = do 362 (s', addr) <- Socket.accept s 363 if not (addr `oneOf` allowed) 364 then sClose s' >> waiting 365 else socketToHandle s' ReadMode >>= hGetContents 366 waiting 367 where 368 a@(SockAddrInet _ ha) `oneOf` ((SockAddrInet _ hb):bs) 369 | ha == hb = True 370 | otherwise = a `oneOf` bs 371 a@(SockAddrInet6 _ _ ha _) `oneOf` ((SockAddrInet6 _ _ hb _):bs) 372 | ha == hb = True 373 | otherwise = a `oneOf` bs 374 _ `oneOf` _ = False 375#else 376recvFrom host port = do 377 ip <- getHostByName host 378 let ipHs = hostAddresses ip 379 s <- listenOn port 380 let 381 waiting = do 382 ~(s', SockAddrInet _ haddr) <- Socket.accept s 383 he <- getHostByAddr AF_INET haddr 384 if not (any (`elem` ipHs) (hostAddresses he)) 385 then do 386 sClose s' 387 waiting 388 else do 389 h <- socketToHandle s' ReadMode 390 msg <- hGetContents h 391 return msg 392 393 message <- waiting 394 return message 395#endif 396 397-- --------------------------------------------------------------------------- 398-- Access function returning the port type/id of socket. 399 400-- | Returns the 'PortID' associated with a given socket. 401socketPort :: Socket -> IO PortID 402socketPort s = do 403 sockaddr <- getSocketName s 404 case sockaddr of 405 SockAddrInet port _ -> return $ PortNumber port 406#if defined(IPV6_SOCKET_SUPPORT) 407 SockAddrInet6 port _ _ _ -> return $ PortNumber port 408#else 409 SockAddrInet6 {} -> ioError $ userError "Network.socketPort: socket address 'SockAddrInet6' not supported on this platform." 410#endif 411#if defined(mingw32_HOST_OS) 412 SockAddrUnix {} -> ioError $ userError "Network.socketPort: socket address 'SockAddrUnix' not supported on this platform." 413#else 414 SockAddrUnix path -> return $ UnixSocket path 415#endif 416 SockAddrCan {} -> ioError $ userError "Network.socketPort: socket address 'SockAddrCan' not supported." 417 418-- --------------------------------------------------------------------------- 419-- Utils 420 421-- Like bracket, but only performs the final action if there was an 422-- exception raised by the middle bit. 423bracketOnError 424 :: IO a -- ^ computation to run first (\"acquire resource\") 425 -> (a -> IO b) -- ^ computation to run last (\"release resource\") 426 -> (a -> IO c) -- ^ computation to run in-between 427 -> IO c -- returns the value from the in-between computation 428bracketOnError = Exception.bracketOnError 429 430----------------------------------------------------------------------------- 431-- Extra documentation 432 433{-$buffering 434 435The 'Handle' returned by 'connectTo' and 'accept' is 'NoBuffering' by 436default. For an interactive application you may want to set the 437buffering mode on the 'Handle' to 438'LineBuffering' or 'BlockBuffering', like so: 439 440> h <- connectTo host port 441> hSetBuffering h LineBuffering 442-} 443 444{-$performance 445 446For really fast I\/O, it might be worth looking at the 'hGetBuf' and 447'hPutBuf' family of functions in "System.IO". 448-} 449 450catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a 451#if MIN_VERSION_base(4,0,0) 452catchIO = Exception.catch 453#else 454catchIO = Exception.catchJust Exception.ioErrors 455#endif 456 457-- Version of try implemented in terms of the locally defined catchIO 458tryIO :: IO a -> IO (Either Exception.IOException a) 459tryIO m = catchIO (liftM Right m) (return . Left) 460 461-- Returns the first action from a list which does not throw an exception. 462-- If all the actions throw exceptions (and the list of actions is not empty), 463-- the last exception is thrown. 464-- The operations are run outside of the catchIO cleanup handler because 465-- catchIO masks asynchronous exceptions in the cleanup handler. 466-- In the case of complete failure, the last exception is actually thrown. 467firstSuccessful :: String -> [IO a] -> IO a 468firstSuccessful caller = go Nothing 469 where 470 -- Attempt the next operation, remember exception on failure 471 go _ (p:ps) = 472 do r <- tryIO p 473 case r of 474 Right x -> return x 475 Left e -> go (Just e) ps 476 477 -- All operations failed, throw error if one exists 478 go Nothing [] = ioError $ userError $ caller ++ ": firstSuccessful: empty list" 479 go (Just e) [] = Exception.throwIO e 480