{-# LANGUAGE CPP, ScopedTypeVariables #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------

-- |

-- Module      :  Network.Socket

-- Copyright   :  (c) The University of Glasgow 2001

-- License     :  BSD-style (see the file libraries/network/LICENSE)

--

-- Maintainer  :  libraries@haskell.org

-- Stability   :  provisional

-- Portability :  portable

--

-- The "Network.Socket" module is for when you want full control over

-- sockets.  Essentially the entire C socket API is exposed through

-- this module; in general the operations follow the behaviour of the C

-- functions of the same name (consult your favourite Unix networking book).

--

-- A higher level interface to networking operations is provided

-- through the module "Network".

--

-----------------------------------------------------------------------------

#include "HsNet.h"

-- In order to process this file, you need to have CALLCONV defined.

module Network.Socket

    (

    -- * Types

      Socket(..)

    , Family(..)

    , isSupportedFamily

    , SocketType(..)

    , isSupportedSocketType

    , SockAddr(..)

    , isSupportedSockAddr

    , SocketStatus(..)

    , HostAddress

    , hostAddressToTuple

    , tupleToHostAddress

#if defined(IPV6_SOCKET_SUPPORT)

    , HostAddress6

    , hostAddress6ToTuple

    , tupleToHostAddress6

    , FlowInfo

    , ScopeID

#endif

    , htonl

    , ntohl

    , ShutdownCmd(..)

    , ProtocolNumber

    , defaultProtocol

    , PortNumber(..)

    -- PortNumber is used non-abstractly in Network.BSD.  ToDo: remove

    -- this use and make the type abstract.

    -- * Address operations

    , HostName

    , ServiceName

#if defined(IPV6_SOCKET_SUPPORT)

    , AddrInfo(..)

    , AddrInfoFlag(..)

    , addrInfoFlagImplemented

    , defaultHints

    , getAddrInfo

    , NameInfoFlag(..)

    , getNameInfo

#endif

    -- * Socket operations

    , socket

#if defined(DOMAIN_SOCKET_SUPPORT)

    , socketPair

#endif

    , connect

    , bind

    , listen

    , accept

    , getPeerName

    , getSocketName

#if defined(HAVE_STRUCT_UCRED) || defined(HAVE_GETPEEREID)

    -- get the credentials of our domain socket peer.

    , getPeerCred

#if defined(HAVE_GETPEEREID)

    , getPeerEid

#endif

#endif

    , socketPort

    , socketToHandle

    -- ** Sending and receiving data

    -- *** Sending and receiving with String

    -- $sendrecv

    , send

    , sendTo

    , recv

    , recvFrom

    , recvLen

    -- *** Sending and receiving with a buffer

    , sendBuf

    , recvBuf

    , sendBufTo

    , recvBufFrom

    -- ** Misc

    , inet_addr

    , inet_ntoa

    , shutdown

    , close

    -- ** Predicates on sockets

    , isConnected

    , isBound

    , isListening

    , isReadable

    , isWritable

    -- * Socket options

    , SocketOption(..)

    , isSupportedSocketOption

    , getSocketOption

    , setSocketOption

    -- * File descriptor transmission

#ifdef DOMAIN_SOCKET_SUPPORT

    , sendFd

    , recvFd

#endif

    -- * Special constants

    , aNY_PORT

    , iNADDR_ANY

#if defined(IPV6_SOCKET_SUPPORT)

    , iN6ADDR_ANY

#endif

    , sOMAXCONN

    , sOL_SOCKET

#ifdef SCM_RIGHTS

    , sCM_RIGHTS

#endif

    , maxListenQueue

    -- * Initialisation

    , withSocketsDo

    -- * Very low level operations

    -- in case you ever want to get at the underlying file descriptor..

    , fdSocket

    , mkSocket

    , setNonBlockIfNeeded

    -- * Deprecated aliases

    -- $deprecated-aliases

    , bindSocket

    , sClose

    , sIsConnected

    , sIsBound

    , sIsListening

    , sIsReadable

    , sIsWritable

    -- * Internal

    -- | The following are exported ONLY for use in the BSD module and

    -- should not be used anywhere else.

    , packFamily

    , unpackFamily

    , packSocketType

    ) where

import Data.Bits

import Data.Functor

import Data.List (foldl')

import Data.Maybe (isJust)

import Data.Word (Word8, Word32)

import Foreign.Ptr (Ptr, castPtr, nullPtr)

import Foreign.Storable (Storable(..))

import Foreign.C.Error

import Foreign.C.String (CString, withCString, withCStringLen, peekCString, peekCStringLen)

import Foreign.C.Types (CUInt, CChar)

import Foreign.C.Types (CInt(..), CSize(..))

import Foreign.Marshal.Alloc ( alloca, allocaBytes )

import Foreign.Marshal.Array ( peekArray )

import Foreign.Marshal.Utils ( maybeWith, with )

import System.IO

import Control.Monad (liftM, when)

import Control.Concurrent.MVar

import Data.Typeable

import System.IO.Error

import GHC.Conc (threadWaitRead, threadWaitWrite)

##if MIN_VERSION_base(4,3,1)

import GHC.Conc (closeFdWith)

##endif

# if defined(mingw32_HOST_OS)

import qualified Control.Exception as E

import GHC.Conc (asyncDoProc)

import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr)

import Foreign (FunPtr)

# endif

# if defined(darwin_HOST_OS)

import Data.List (delete)

# endif

import qualified GHC.IO.Device

import GHC.IO.Handle.FD

import GHC.IO.Exception

import GHC.IO

import qualified System.Posix.Internals

import Network.Socket.Internal

import Network.Socket.Types

import Prelude -- Silence AMP warnings

-- | Either a host name e.g., @\"haskell.org\"@ or a numeric host

-- address string consisting of a dotted decimal IPv4 address or an

-- IPv6 address e.g., @\"192.168.0.1\"@.

type HostName       = String

type ServiceName    = String

-- ----------------------------------------------------------------------------

-- On Windows, our sockets are not put in non-blocking mode (non-blocking

-- is not supported for regular file descriptors on Windows, and it would

-- be a pain to support it only for sockets).  So there are two cases:

--

--  - the threaded RTS uses safe calls for socket operations to get

--    non-blocking I/O, just like the rest of the I/O library

--

--  - with the non-threaded RTS, only some operations on sockets will be

--    non-blocking.  Reads and writes go through the normal async I/O

--    system.  accept() uses asyncDoProc so is non-blocking.  A handful

--    of others (recvFrom, sendFd, recvFd) will block all threads - if this

--    is a problem, -threaded is the workaround.

--

##if defined(mingw32_HOST_OS)

##define SAFE_ON_WIN safe

##else

##define SAFE_ON_WIN unsafe

##endif

-----------------------------------------------------------------------------

-- Socket types

#if defined(mingw32_HOST_OS)

socket2FD  (MkSocket fd _ _ _ _) =

  -- HACK, 1 means True

  FD{fdFD = fd,fdIsSocket_ = 1}

#endif

-- | Smart constructor for constructing a 'Socket'. It should only be

-- called once for every new file descriptor. The caller must make

-- sure that the socket is in non-blocking mode. See

-- 'setNonBlockIfNeeded'.

mkSocket :: CInt

         -> Family

         -> SocketType

         -> ProtocolNumber

         -> SocketStatus

         -> IO Socket

mkSocket fd fam sType pNum stat = do

   mStat <- newMVar stat

   withSocketsDo $ return ()

   return (MkSocket fd fam sType pNum mStat)

fdSocket :: Socket -> CInt

fdSocket (MkSocket fd _ _ _ _) = fd

-- | This is the default protocol for a given service.

defaultProtocol :: ProtocolNumber

defaultProtocol = 0

-----------------------------------------------------------------------------

-- SockAddr

instance Show SockAddr where

#if defined(DOMAIN_SOCKET_SUPPORT)

  showsPrec _ (SockAddrUnix str) = showString str

#endif

  showsPrec _ (SockAddrInet port ha)

   = showString (unsafePerformIO (inet_ntoa ha))

   . showString ":"

   . shows port

#if defined(IPV6_SOCKET_SUPPORT)

  showsPrec _ addr@(SockAddrInet6 port _ _ _)

   = showChar '['

   . showString (unsafePerformIO $

                 fst `liftM` getNameInfo [NI_NUMERICHOST] True False addr >>=

                 maybe (fail "showsPrec: impossible internal error") return)

   . showString "]:"

   . shows port

#endif

#if defined(CAN_SOCKET_SUPPORT)

  showsPrec _ (SockAddrCan ifidx) = shows ifidx

#endif

-----------------------------------------------------------------------------

-- Connection Functions

-- In the following connection and binding primitives.  The names of

-- the equivalent C functions have been preserved where possible. It

-- should be noted that some of these names used in the C library,

-- \tr{bind} in particular, have a different meaning to many Haskell

-- programmers and have thus been renamed by appending the prefix

-- Socket.

-- | Create a new socket using the given address family, socket type

-- and protocol number.  The address family is usually 'AF_INET',

-- 'AF_INET6', or 'AF_UNIX'.  The socket type is usually 'Stream' or

-- 'Datagram'.  The protocol number is usually 'defaultProtocol'.

-- If 'AF_INET6' is used and the socket type is 'Stream' or 'Datagram',

-- the 'IPv6Only' socket option is set to 0 so that both IPv4 and IPv6

-- can be handled with one socket.

--

-- >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream }

-- >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "5000")

-- >>> sock@(MkSocket _ fam stype _ _) <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)

-- >>> fam

-- AF_INET

-- >>> stype

-- Stream

-- >>> bind sock (addrAddress addr)

-- >>> getSocketName sock

-- 127.0.0.1:5000

socket :: Family         -- Family Name (usually AF_INET)

       -> SocketType     -- Socket Type (usually Stream)

       -> ProtocolNumber -- Protocol Number (getProtocolByName to find value)

       -> IO Socket      -- Unconnected Socket

socket family stype protocol = do

    c_stype <- packSocketTypeOrThrow "socket" stype

    fd <- throwSocketErrorIfMinus1Retry "Network.Socket.socket" $

                c_socket (packFamily family) c_stype protocol

    setNonBlockIfNeeded fd

    socket_status <- newMVar NotConnected

    withSocketsDo $ return ()

    let sock = MkSocket fd family stype protocol socket_status

#if HAVE_DECL_IPV6_V6ONLY

    -- The default value of the IPv6Only option is platform specific,

    -- so we explicitly set it to 0 to provide a common default.

# if defined(mingw32_HOST_OS)

    -- The IPv6Only option is only supported on Windows Vista and later,

    -- so trying to change it might throw an error.

    when (family == AF_INET6 && (stype == Stream || stype == Datagram)) $

      E.catch (setSocketOption sock IPv6Only 0) $ (\(_ :: E.IOException) -> return ())

# else

    when (family == AF_INET6 && (stype == Stream || stype == Datagram)) $

      setSocketOption sock IPv6Only 0 `onException` close sock

# endif

#endif

    return sock

-- | Build a pair of connected socket objects using the given address

-- family, socket type, and protocol number.  Address family, socket

-- type, and protocol number are as for the 'socket' function above.

-- Availability: Unix.

#if defined(DOMAIN_SOCKET_SUPPORT)

socketPair :: Family              -- Family Name (usually AF_INET or AF_INET6)

           -> SocketType          -- Socket Type (usually Stream)

           -> ProtocolNumber      -- Protocol Number

           -> IO (Socket, Socket) -- unnamed and connected.

socketPair family stype protocol = do

    allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do

    c_stype <- packSocketTypeOrThrow "socketPair" stype

    _rc <- throwSocketErrorIfMinus1Retry "Network.Socket.socketpair" $

                c_socketpair (packFamily family) c_stype protocol fdArr

    [fd1,fd2] <- peekArray 2 fdArr

    s1 <- mkNonBlockingSocket fd1

    s2 <- mkNonBlockingSocket fd2

    return (s1,s2)

  where

    mkNonBlockingSocket fd = do

       setNonBlockIfNeeded fd

       stat <- newMVar Connected

       withSocketsDo $ return ()

       return (MkSocket fd family stype protocol stat)

foreign import ccall unsafe "socketpair"

  c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt

#endif

-- | Set the socket to nonblocking, if applicable to this platform.

--

-- Depending on the platform this is required when using sockets from file

-- descriptors that are passed in through 'recvFd' or other means.

setNonBlockIfNeeded :: CInt -> IO ()

setNonBlockIfNeeded fd =

    System.Posix.Internals.setNonBlockingFD fd True

-----------------------------------------------------------------------------

-- Binding a socket

-- | Bind the socket to an address. The socket must not already be

-- bound.  The 'Family' passed to @bind@ must be the

-- same as that passed to 'socket'.  If the special port number

-- 'aNY_PORT' is passed then the system assigns the next available

-- use port.

bind :: Socket    -- Unconnected Socket

           -> SockAddr  -- Address to Bind to

           -> IO ()

bind (MkSocket s _family _stype _protocol socketStatus) addr = do

 modifyMVar_ socketStatus $ \ status -> do

 if status /= NotConnected

  then

   ioError $ userError $

     "Network.Socket.bind: can't bind to socket with status " ++ show status

  else do

   withSockAddr addr $ \p_addr sz -> do

   _status <- throwSocketErrorIfMinus1Retry "Network.Socket.bind" $

     c_bind s p_addr (fromIntegral sz)

   return Bound

-----------------------------------------------------------------------------

-- Connecting a socket

-- | Connect to a remote socket at address.

connect :: Socket    -- Unconnected Socket

        -> SockAddr  -- Socket address stuff

        -> IO ()

connect sock@(MkSocket s _family _stype _protocol socketStatus) addr = withSocketsDo $ do

 modifyMVar_ socketStatus $ \currentStatus -> do

 if currentStatus /= NotConnected && currentStatus /= Bound

  then

    ioError $ userError $

      errLoc ++ ": can't connect to socket with status " ++ show currentStatus

  else do

    withSockAddr addr $ \p_addr sz -> do

    let connectLoop = do

           r <- c_connect s p_addr (fromIntegral sz)

           if r == -1

               then do

#if !(defined(HAVE_WINSOCK2_H))

                   err <- getErrno

                   case () of

                     _ | err == eINTR       -> connectLoop

                     _ | err == eINPROGRESS -> connectBlocked

--                   _ | err == eAGAIN      -> connectBlocked

                     _otherwise             -> throwSocketError errLoc

#else

                   throwSocketError errLoc

#endif

               else return ()

        connectBlocked = do

           threadWaitWrite (fromIntegral s)

           err <- getSocketOption sock SoError

           if (err == 0)

                then return ()

                else throwSocketErrorCode errLoc (fromIntegral err)

    connectLoop

    return Connected

 where

   errLoc = "Network.Socket.connect: " ++ show sock

-----------------------------------------------------------------------------

-- Listen

-- | Listen for connections made to the socket.  The second argument

-- specifies the maximum number of queued connections and should be at

-- least 1; the maximum value is system-dependent (usually 5).

listen :: Socket  -- Connected & Bound Socket

       -> Int     -- Queue Length

       -> IO ()

listen (MkSocket s _family _stype _protocol socketStatus) backlog = do

 modifyMVar_ socketStatus $ \ status -> do

 if status /= Bound

   then

     ioError $ userError $

       "Network.Socket.listen: can't listen on socket with status " ++ show status

   else do

     throwSocketErrorIfMinus1Retry_ "Network.Socket.listen" $

       c_listen s (fromIntegral backlog)

     return Listening

-----------------------------------------------------------------------------

-- Accept

--

-- A call to `accept' only returns when data is available on the given

-- socket, unless the socket has been set to non-blocking.  It will

-- return a new socket which should be used to read the incoming data and

-- should then be closed. Using the socket returned by `accept' allows

-- incoming requests to be queued on the original socket.

-- | Accept a connection.  The socket must be bound to an address and

-- listening for connections.  The return value is a pair @(conn,

-- address)@ where @conn@ is a new socket object usable to send and

-- receive data on the connection, and @address@ is the address bound

-- to the socket on the other end of the connection.

accept :: Socket                        -- Queue Socket

       -> IO (Socket,                   -- Readable Socket

              SockAddr)                 -- Peer details

accept sock@(MkSocket s family stype protocol status) = do

 currentStatus <- readMVar status

 okay <- isAcceptable sock

 if not okay

   then

     ioError $ userError $

       "Network.Socket.accept: can't accept socket (" ++

         show (family, stype, protocol) ++ ") with status " ++

         show currentStatus

   else do

     let sz = sizeOfSockAddrByFamily family

     allocaBytes sz $ \ sockaddr -> do

#if defined(mingw32_HOST_OS)

     new_sock <-

        if threaded

           then with (fromIntegral sz) $ \ ptr_len ->

                  throwSocketErrorIfMinus1Retry "Network.Socket.accept" $

                    c_accept_safe s sockaddr ptr_len

           else do

                paramData <- c_newAcceptParams s (fromIntegral sz) sockaddr

                rc        <- asyncDoProc c_acceptDoProc paramData

                new_sock  <- c_acceptNewSock    paramData

                c_free paramData

                when (rc /= 0) $

                     throwSocketErrorCode "Network.Socket.accept" (fromIntegral rc)

                return new_sock

#else

     with (fromIntegral sz) $ \ ptr_len -> do

# ifdef HAVE_ACCEPT4

     new_sock <- throwSocketErrorIfMinus1RetryMayBlock "Network.Socket.accept"

                        (threadWaitRead (fromIntegral s))

                        (c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK))

# else

     new_sock <- throwSocketErrorWaitRead sock "Network.Socket.accept"

                        (c_accept s sockaddr ptr_len)

     setNonBlockIfNeeded new_sock

# endif /* HAVE_ACCEPT4 */

#endif

     addr <- peekSockAddr sockaddr

     new_status <- newMVar Connected

     return ((MkSocket new_sock family stype protocol new_status), addr)

#if defined(mingw32_HOST_OS)

foreign import ccall unsafe "HsNet.h acceptNewSock"

  c_acceptNewSock :: Ptr () -> IO CInt

foreign import ccall unsafe "HsNet.h newAcceptParams"

  c_newAcceptParams :: CInt -> CInt -> Ptr a -> IO (Ptr ())

foreign import ccall unsafe "HsNet.h &acceptDoProc"

  c_acceptDoProc :: FunPtr (Ptr () -> IO Int)

foreign import ccall unsafe "free"

  c_free:: Ptr a -> IO ()

#endif

-----------------------------------------------------------------------------

-- ** Sending and receiving data

-- $sendrecv

--

-- Do not use the @send@ and @recv@ functions defined in this section

-- in new code, as they incorrectly represent binary data as a Unicode

-- string.  As a result, these functions are inefficient and may lead

-- to bugs in the program.  Instead use the @send@ and @recv@

-- functions defined in the "Network.Socket.ByteString" module.

-----------------------------------------------------------------------------

-- sendTo & recvFrom

-- | Send data to the socket.  The recipient can be specified

-- explicitly, so the socket need not be in a connected state.

-- Returns the number of bytes sent.  Applications are responsible for

-- ensuring that all data has been sent.

--

-- NOTE: blocking on Windows unless you compile with -threaded (see

-- GHC ticket #1129)

{-# WARNING sendTo "Use sendTo defined in \"Network.Socket.ByteString\"" #-}

sendTo :: Socket        -- (possibly) bound/connected Socket

       -> String        -- Data to send

       -> SockAddr

       -> IO Int        -- Number of Bytes sent

sendTo sock xs addr = do

 withCStringLen xs $ \(str, len) -> do

   sendBufTo sock str len addr

-- | Send data to the socket.  The recipient can be specified

-- explicitly, so the socket need not be in a connected state.

-- Returns the number of bytes sent.  Applications are responsible for

-- ensuring that all data has been sent.

sendBufTo :: Socket            -- (possibly) bound/connected Socket

          -> Ptr a -> Int  -- Data to send

          -> SockAddr

          -> IO Int            -- Number of Bytes sent

sendBufTo sock@(MkSocket s _family _stype _protocol _status) ptr nbytes addr = do

 withSockAddr addr $ \p_addr sz -> do

   liftM fromIntegral $

     throwSocketErrorWaitWrite sock "Network.Socket.sendTo" $

        c_sendto s ptr (fromIntegral $ nbytes) 0{-flags-}

                        p_addr (fromIntegral sz)

-- | Receive data from the socket. The socket need not be in a

-- connected state. Returns @(bytes, nbytes, address)@ where @bytes@

-- is a @String@ of length @nbytes@ representing the data received and

-- @address@ is a 'SockAddr' representing the address of the sending

-- socket.

--

-- NOTE: blocking on Windows unless you compile with -threaded (see

-- GHC ticket #1129)

{-# WARNING recvFrom "Use recvFrom defined in \"Network.Socket.ByteString\"" #-}

recvFrom :: Socket -> Int -> IO (String, Int, SockAddr)

recvFrom sock nbytes =

  allocaBytes nbytes $ \ptr -> do

    (len, sockaddr) <- recvBufFrom sock ptr nbytes

    str <- peekCStringLen (ptr, len)

    return (str, len, sockaddr)

-- | Receive data from the socket, writing it into buffer instead of

-- creating a new string.  The socket need not be in a connected

-- state. Returns @(nbytes, address)@ where @nbytes@ is the number of

-- bytes received and @address@ is a 'SockAddr' representing the

-- address of the sending socket.

--

-- NOTE: blocking on Windows unless you compile with -threaded (see

-- GHC ticket #1129)

recvBufFrom :: Socket -> Ptr a -> Int -> IO (Int, SockAddr)

recvBufFrom sock@(MkSocket s family _stype _protocol _status) ptr nbytes

 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvFrom")

 | otherwise   =

    withNewSockAddr family $ \ptr_addr sz -> do

      alloca $ \ptr_len -> do

        poke ptr_len (fromIntegral sz)

        len <- throwSocketErrorWaitRead sock "Network.Socket.recvFrom" $

                   c_recvfrom s ptr (fromIntegral nbytes) 0{-flags-}

                                ptr_addr ptr_len

        let len' = fromIntegral len

        if len' == 0

         then ioError (mkEOFError "Network.Socket.recvFrom")

         else do

           flg <- isConnected sock

             -- For at least one implementation (WinSock 2), recvfrom() ignores

             -- filling in the sockaddr for connected TCP sockets. Cope with

             -- this by using getPeerName instead.

           sockaddr <-

                if flg then

                   getPeerName sock

                else

                   peekSockAddr ptr_addr

           return (len', sockaddr)

-----------------------------------------------------------------------------

-- send & recv

-- | Send data to the socket. The socket must be connected to a remote

-- socket. Returns the number of bytes sent.  Applications are

-- responsible for ensuring that all data has been sent.

--

-- Sending data to closed socket may lead to undefined behaviour.

{-# WARNING send "Use send defined in \"Network.Socket.ByteString\"" #-}

send :: Socket  -- Bound/Connected Socket

     -> String  -- Data to send

     -> IO Int  -- Number of Bytes sent

send sock xs = withCStringLen xs $ \(str, len) ->

    sendBuf sock (castPtr str) len

-- | Send data to the socket. The socket must be connected to a remote

-- socket. Returns the number of bytes sent.  Applications are

-- responsible for ensuring that all data has been sent.

--

-- Sending data to closed socket may lead to undefined behaviour.

sendBuf :: Socket     -- Bound/Connected Socket

        -> Ptr Word8  -- Pointer to the data to send

        -> Int        -- Length of the buffer

        -> IO Int     -- Number of Bytes sent

sendBuf sock@(MkSocket s _family _stype _protocol _status) str len = do

   liftM fromIntegral $

#if defined(mingw32_HOST_OS)

-- writeRawBufferPtr is supposed to handle checking for errors, but it's broken

-- on x86_64 because of GHC bug #12010 so we duplicate the check here. The call

-- to throwSocketErrorIfMinus1Retry can be removed when no GHC version with the

-- bug is supported.

    throwSocketErrorIfMinus1Retry "Network.Socket.sendBuf" $ writeRawBufferPtr

      "Network.Socket.sendBuf"

      (socket2FD sock)

      (castPtr str)

      0

      (fromIntegral len)

#else

     throwSocketErrorWaitWrite sock "Network.Socket.sendBuf" $

        c_send s str (fromIntegral len) 0{-flags-}

#endif

-- | Receive data from the socket.  The socket must be in a connected

-- state. This function may return fewer bytes than specified.  If the

-- message is longer than the specified length, it may be discarded

-- depending on the type of socket.  This function may block until a

-- message arrives.

--

-- Considering hardware and network realities, the maximum number of

-- bytes to receive should be a small power of 2, e.g., 4096.

--

-- For TCP sockets, a zero length return value means the peer has

-- closed its half side of the connection.

--

-- Receiving data from closed socket may lead to undefined behaviour.

{-# WARNING recv "Use recv defined in \"Network.Socket.ByteString\"" #-}

recv :: Socket -> Int -> IO String

recv sock l = fst <$> recvLen sock l

{-# WARNING recvLen "Use recvLen defined in \"Network.Socket.ByteString\"" #-}

recvLen :: Socket -> Int -> IO (String, Int)

recvLen sock nbytes =

     allocaBytes nbytes $ \ptr -> do

        len <- recvBuf sock ptr nbytes

        s <- peekCStringLen (castPtr ptr,len)

        return (s, len)

-- | Receive data from the socket.  The socket must be in a connected

-- state. This function may return fewer bytes than specified.  If the

-- message is longer than the specified length, it may be discarded

-- depending on the type of socket.  This function may block until a

-- message arrives.

--

-- Considering hardware and network realities, the maximum number of

-- bytes to receive should be a small power of 2, e.g., 4096.

--

-- For TCP sockets, a zero length return value means the peer has

-- closed its half side of the connection.

--

-- Receiving data from closed socket may lead to undefined behaviour.

recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int

recvBuf sock@(MkSocket s _family _stype _protocol _status) ptr nbytes

 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf")

 | otherwise   = do

        len <-

#if defined(mingw32_HOST_OS)

-- see comment in sendBuf above.

            throwSocketErrorIfMinus1Retry "Network.Socket.recvBuf" $

                readRawBufferPtr "Network.Socket.recvBuf"

                (socket2FD sock) ptr 0 (fromIntegral nbytes)

#else

               throwSocketErrorWaitRead sock "Network.Socket.recvBuf" $

                   c_recv s (castPtr ptr) (fromIntegral nbytes) 0{-flags-}

#endif

        let len' = fromIntegral len

        if len' == 0

         then ioError (mkEOFError "Network.Socket.recvBuf")

         else return len'

-- ---------------------------------------------------------------------------

-- socketPort

--

-- The port number the given socket is currently connected to can be

-- determined by calling $port$, is generally only useful when bind

-- was given $aNY\_PORT$.

socketPort :: Socket            -- Connected & Bound Socket

           -> IO PortNumber     -- Port Number of Socket

socketPort sock@(MkSocket _ AF_INET _ _ _) = do

    (SockAddrInet port _) <- getSocketName sock

    return port

#if defined(IPV6_SOCKET_SUPPORT)

socketPort sock@(MkSocket _ AF_INET6 _ _ _) = do

    (SockAddrInet6 port _ _ _) <- getSocketName sock

    return port

#endif

socketPort (MkSocket _ family _ _ _) =

    ioError $ userError $

      "Network.Socket.socketPort: address family '" ++ show family ++

      "' not supported."

-- ---------------------------------------------------------------------------

-- getPeerName

-- Calling $getPeerName$ returns the address details of the machine,

-- other than the local one, which is connected to the socket. This is

-- used in programs such as FTP to determine where to send the

-- returning data.  The corresponding call to get the details of the

-- local machine is $getSocketName$.

getPeerName   :: Socket -> IO SockAddr

getPeerName (MkSocket s family _ _ _) = do

 withNewSockAddr family $ \ptr sz -> do

   with (fromIntegral sz) $ \int_star -> do

   throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerName" $

     c_getpeername s ptr int_star

   _sz <- peek int_star

   peekSockAddr ptr

getSocketName :: Socket -> IO SockAddr

getSocketName (MkSocket s family _ _ _) = do

 withNewSockAddr family $ \ptr sz -> do

   with (fromIntegral sz) $ \int_star -> do

   throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketName" $

     c_getsockname s ptr int_star

   peekSockAddr ptr

-----------------------------------------------------------------------------

-- Socket Properties

-- | Socket options for use with 'setSocketOption' and 'getSocketOption'.

--

-- The existence of a constructor does not imply that the relevant option

-- is supported on your system: see 'isSupportedSocketOption'

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

    | TimeToLive    -- ^ IP_TTL

    | MaxSegment    -- ^ TCP_MAXSEG

    | NoDelay       -- ^ TCP_NODELAY

    | Cork          -- ^ TCP_CORK

    | Linger        -- ^ SO_LINGER

    | ReusePort     -- ^ SO_REUSEPORT

    | RecvLowWater  -- ^ SO_RCVLOWAT

    | SendLowWater  -- ^ SO_SNDLOWAT

    | RecvTimeOut   -- ^ SO_RCVTIMEO

    | SendTimeOut   -- ^ SO_SNDTIMEO

    | UseLoopBack   -- ^ SO_USELOOPBACK

    | UserTimeout   -- ^ TCP_USER_TIMEOUT

    | IPv6Only      -- ^ IPV6_V6ONLY

    | CustomSockOpt (CInt, CInt)

    deriving (Show, Typeable)

-- | Does the 'SocketOption' exist on this system?

isSupportedSocketOption :: SocketOption -> Bool

isSupportedSocketOption = isJust . packSocketOption

-- | For a socket option, return Just (level, value) where level is the

-- corresponding C option level constant (e.g. SOL_SOCKET) and value is

-- the option constant itself (e.g. SO_DEBUG)

-- If either constant does not exist, return Nothing.

packSocketOption :: SocketOption -> Maybe (CInt, CInt)

packSocketOption so =

  -- The Just here is a hack to disable GHC's overlapping pattern detection:

  -- the problem is if all constants are present, the fallback pattern is

  -- redundant, but if they aren't then it isn't. Hence we introduce an

  -- extra pattern (Nothing) that can't possibly happen, so that the

  -- fallback is always (in principle) necessary.

  -- I feel a little bad for including this, but such are the sacrifices we

  -- make while working with CPP - excluding the fallback pattern correctly

  -- would be a serious nuisance.

  -- (NB: comments elsewhere in this file refer to this one)

  case Just so of

#ifdef SOL_SOCKET

#ifdef SO_DEBUG

    Just Debug         -> Just ((#const SOL_SOCKET), (#const SO_DEBUG))

#endif

#ifdef SO_REUSEADDR

    Just ReuseAddr     -> Just ((#const SOL_SOCKET), (#const SO_REUSEADDR))

#endif

#ifdef SO_TYPE

    Just Type          -> Just ((#const SOL_SOCKET), (#const SO_TYPE))

#endif

#ifdef SO_ERROR

    Just SoError       -> Just ((#const SOL_SOCKET), (#const SO_ERROR))

#endif

#ifdef SO_DONTROUTE

    Just DontRoute     -> Just ((#const SOL_SOCKET), (#const SO_DONTROUTE))

#endif

#ifdef SO_BROADCAST

    Just Broadcast     -> Just ((#const SOL_SOCKET), (#const SO_BROADCAST))

#endif

#ifdef SO_SNDBUF