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