{-# INCLUDE "HsNet.h" #-}
{-# OPTIONS_GHC -optc-DDOMAIN_SOCKET_SUPPORT=1 #-}
{-# LINE 1 "Network/Socket.hsc" #-}
{-# OPTIONS -fglasgow-exts -cpp #-}
{-# LINE 2 "Network/Socket.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- 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".
--
-----------------------------------------------------------------------------


{-# LINE 23 "Network/Socket.hsc" #-}

-- NOTE: ##, we want this interpreted when compiling the .hs, not by hsc2hs.
#include "Typeable.h"


{-# LINE 30 "Network/Socket.hsc" #-}


{-# LINE 32 "Network/Socket.hsc" #-}

{-# LINE 33 "Network/Socket.hsc" #-}

{-# LINE 34 "Network/Socket.hsc" #-}


{-# LINE 42 "Network/Socket.hsc" #-}

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

module Network.Socket (

    -- * Types
    Socket(..),		-- instance Eq, Show
    Family(..),		
    SocketType(..),
    SockAddr(..),
    SocketStatus(..),
    HostAddress,

{-# LINE 55 "Network/Socket.hsc" #-}
    HostAddress6,
    FlowInfo,
    ScopeID,

{-# LINE 59 "Network/Socket.hsc" #-}
    ShutdownCmd(..),
    ProtocolNumber,
    defaultProtocol,        -- :: ProtocolNumber
    PortNumber(..),
	-- PortNumber is used non-abstractly in Network.BSD.  ToDo: remove
	-- this use and make the type abstract.

    -- * Address operations

    HostName,
    ServiceName,


{-# LINE 72 "Network/Socket.hsc" #-}
    AddrInfo(..),

    AddrInfoFlag(..),
    addrInfoFlagImplemented,-- :: AddrInfoFlag -> Bool

    defaultHints,           -- :: AddrInfo

    getAddrInfo,            -- :: Maybe AddrInfo -> Maybe HostName -> Maybe ServiceName -> IO [AddrInfo]

    NameInfoFlag(..),

    getNameInfo,            -- :: [NameInfoFlag] -> Bool -> Bool -> SockAddr -> IO (Maybe HostName, Maybe ServiceName)

{-# LINE 85 "Network/Socket.hsc" #-}

    -- * Socket Operations
    socket,		-- :: Family -> SocketType -> ProtocolNumber -> IO Socket 

{-# LINE 89 "Network/Socket.hsc" #-}
    socketPair,         -- :: Family -> SocketType -> ProtocolNumber -> IO (Socket, Socket)

{-# LINE 91 "Network/Socket.hsc" #-}
    connect,		-- :: Socket -> SockAddr -> IO ()
    bindSocket,		-- :: Socket -> SockAddr -> IO ()
    listen,		-- :: Socket -> Int -> IO ()
    accept,		-- :: Socket -> IO (Socket, SockAddr)
    getPeerName,	-- :: Socket -> IO SockAddr
    getSocketName,	-- :: Socket -> IO SockAddr


{-# LINE 99 "Network/Socket.hsc" #-}
	-- get the credentials of our domain socket peer.
    getPeerCred,         -- :: Socket -> IO (CUInt{-pid-}, CUInt{-uid-}, CUInt{-gid-})

{-# LINE 102 "Network/Socket.hsc" #-}

    socketPort,		-- :: Socket -> IO PortNumber

    socketToHandle,	-- :: Socket -> IOMode -> IO Handle

    sendTo,		-- :: Socket -> String -> SockAddr -> IO Int
    sendBufTo,          -- :: Socket -> Ptr a -> Int -> SockAddr -> IO Int

    recvFrom,		-- :: Socket -> Int -> IO (String, Int, SockAddr)
    recvBufFrom,        -- :: Socket -> Ptr a -> Int -> IO (Int, SockAddr)
    
    send,		-- :: Socket -> String -> IO Int
    recv,		-- :: Socket -> Int    -> IO String
    recvLen,            -- :: Socket -> Int    -> IO (String, Int)

    inet_addr,		-- :: String -> IO HostAddress
    inet_ntoa,		-- :: HostAddress -> IO String

    shutdown,		-- :: Socket -> ShutdownCmd -> IO ()
    sClose,		-- :: Socket -> IO ()

    -- ** Predicates on sockets
    sIsConnected,	-- :: Socket -> IO Bool
    sIsBound,		-- :: Socket -> IO Bool
    sIsListening,	-- :: Socket -> IO Bool 
    sIsReadable,	-- :: Socket -> IO Bool
    sIsWritable,	-- :: Socket -> IO Bool

    -- * Socket options
    SocketOption(..),
    getSocketOption,     -- :: Socket -> SocketOption -> IO Int
    setSocketOption,     -- :: Socket -> SocketOption -> Int -> IO ()

    -- * File descriptor transmission

{-# LINE 137 "Network/Socket.hsc" #-}
    sendFd,              -- :: Socket -> CInt -> IO ()
    recvFd,              -- :: Socket -> IO CInt

      -- Note: these two will disappear shortly
    sendAncillary,       -- :: Socket -> Int -> Int -> Int -> Ptr a -> Int -> IO ()
    recvAncillary,       -- :: Socket -> Int -> Int -> IO (Int,Int,Int,Ptr a)


{-# LINE 145 "Network/Socket.hsc" #-}

    -- * Special Constants
    aNY_PORT,		-- :: PortNumber
    iNADDR_ANY,		-- :: HostAddress

{-# LINE 150 "Network/Socket.hsc" #-}
    iN6ADDR_ANY,	-- :: HostAddress6

{-# LINE 152 "Network/Socket.hsc" #-}
    sOMAXCONN,		-- :: Int
    sOL_SOCKET,         -- :: Int

{-# LINE 155 "Network/Socket.hsc" #-}
    sCM_RIGHTS,         -- :: Int

{-# LINE 157 "Network/Socket.hsc" #-}
    maxListenQueue,	-- :: Int

    -- * Initialisation
    withSocketsDo,	-- :: IO a -> IO a
    
    -- * Very low level operations
     -- in case you ever want to get at the underlying file descriptor..
    fdSocket,           -- :: Socket -> CInt
    mkSocket,           -- :: CInt   -> Family 
    			-- -> SocketType
			-- -> ProtocolNumber
			-- -> SocketStatus
			-- -> IO Socket

    -- * Internal

    -- | The following are exported ONLY for use in the BSD module and
    -- should not be used anywhere else.

    packFamily, unpackFamily,
    packSocketType,
    throwSocketErrorIfMinus1_

) where


{-# LINE 194 "Network/Socket.hsc" #-}

import Data.Bits
import Data.List (foldl')
import Data.Word ( Word8, Word16, Word32 )
import Foreign.Ptr ( Ptr, castPtr, nullPtr, plusPtr )
import Foreign.Storable ( Storable(..) )
import Foreign.C.Error
import Foreign.C.String ( CString, withCString, peekCString, peekCStringLen, castCharToCChar )
import Foreign.C.Types ( CInt, CUInt, CChar, CSize )
import Foreign.Marshal.Alloc ( alloca, allocaBytes )
import Foreign.Marshal.Array ( peekArray, pokeArray, pokeArray0 )
import Foreign.Marshal.Utils ( maybeWith, with )

import System.IO
import Control.Monad ( liftM, when )
import Data.Ratio ( (%) )

import qualified Control.Exception
import Control.Concurrent.MVar
import Data.Typeable


{-# LINE 216 "Network/Socket.hsc" #-}
import GHC.Conc		(threadWaitRead, threadWaitWrite)

{-# LINE 221 "Network/Socket.hsc" #-}
import GHC.Handle
import GHC.IOBase
import qualified System.Posix.Internals

{-# LINE 227 "Network/Socket.hsc" #-}

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

-- There are a few possible ways to do this.  The first is convert the
-- structs used in the C library into an equivalent Haskell type. An
-- other possible implementation is to keep all the internals in the C
-- code and use an Int## and a status flag. The second method is used
-- here since a lot of the C structures are not required to be
-- manipulated.

-- Originally the status was non-mutable so we had to return a new
-- socket each time we changed the status.  This version now uses
-- mutable variables to avoid the need to do this.  The result is a
-- cleaner interface and better security since the application
-- programmer now can't circumvent the status information to perform
-- invalid operations on sockets.

data SocketStatus
  -- Returned Status	Function called
  = NotConnected	-- socket
  | Bound		-- bindSocket
  | Listening		-- listen
  | Connected		-- connect/accept
  | ConvertedToHandle   -- is now a Handle, don't touch
    deriving (Eq, Show)

INSTANCE_TYPEABLE0(SocketStatus,socketStatusTc,"SocketStatus")

data Socket
  = MkSocket
	    CInt	         -- File Descriptor
	    Family				  
	    SocketType				  
	    ProtocolNumber	 -- Protocol Number
	    (MVar SocketStatus)  -- Status Flag

INSTANCE_TYPEABLE0(Socket,socketTc,"Socket")

mkSocket :: CInt
	 -> Family
	 -> SocketType
	 -> ProtocolNumber
	 -> SocketStatus
	 -> IO Socket
mkSocket fd fam sType pNum stat = do
   mStat <- newMVar stat
   return (MkSocket fd fam sType pNum mStat)

instance Eq Socket where
  (MkSocket _ _ _ _ m1) == (MkSocket _ _ _ _ m2) = m1 == m2

instance Show Socket where
  showsPrec n (MkSocket fd _ _ _ _) = 
	showString "<socket: " . shows fd . showString ">"


fdSocket :: Socket -> CInt
fdSocket (MkSocket fd _ _ _ _) = fd

type ProtocolNumber = CInt

-- | This is the default protocol for a given service.
defaultProtocol :: ProtocolNumber
defaultProtocol = 0

-- NOTE: HostAddresses are represented in network byte order.
--       Functions that expect the address in machine byte order
--       will have to perform the necessary translation.
type HostAddress = Word32


{-# LINE 322 "Network/Socket.hsc" #-}
type HostAddress6 = (Word32, Word32, Word32, Word32)

{-# LINE 324 "Network/Socket.hsc" #-}

----------------------------------------------------------------------------
-- Port Numbers
--
-- newtyped to prevent accidental use of sane-looking
-- port numbers that haven't actually been converted to
-- network-byte-order first.
--
newtype PortNumber = PortNum Word16 deriving ( Eq, Ord )

INSTANCE_TYPEABLE0(PortNumber,portNumberTc,"PortNumber")

instance Show PortNumber where
  showsPrec p pn = showsPrec p (portNumberToInt pn)

intToPortNumber :: Int -> PortNumber
intToPortNumber v = PortNum (htons (fromIntegral v))

portNumberToInt :: PortNumber -> Int
portNumberToInt (PortNum po) = fromIntegral (ntohs po)

foreign import CALLCONV unsafe "ntohs" ntohs :: Word16 -> Word16
foreign import CALLCONV unsafe "htons" htons :: Word16 -> Word16
--foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32
foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32

instance Enum PortNumber where
    toEnum   = intToPortNumber
    fromEnum = portNumberToInt

instance Num PortNumber where
   fromInteger i = intToPortNumber (fromInteger i)
    -- for completeness.
   (+) x y   = intToPortNumber (portNumberToInt x + portNumberToInt y)
   (-) x y   = intToPortNumber (portNumberToInt x - portNumberToInt y)
   negate x  = intToPortNumber (-portNumberToInt x)
   (*) x y   = intToPortNumber (portNumberToInt x * portNumberToInt y)
   abs n     = intToPortNumber (abs (portNumberToInt n))
   signum n  = intToPortNumber (signum (portNumberToInt n))

instance Real PortNumber where
    toRational x = toInteger x % 1

instance Integral PortNumber where
    quotRem a b = let (c,d) = quotRem (portNumberToInt a) (portNumberToInt b) in
		  (intToPortNumber c, intToPortNumber d)
    toInteger a = toInteger (portNumberToInt a)

instance Storable PortNumber where
   sizeOf    _ = sizeOf    (undefined :: Word16)
   alignment _ = alignment (undefined :: Word16)
   poke p (PortNum po) = poke (castPtr p) po
   peek p = PortNum `liftM` peek (castPtr p)

-----------------------------------------------------------------------------
-- SockAddr

-- The scheme used for addressing sockets is somewhat quirky. The
-- calls in the BSD socket API that need to know the socket address
-- all operate in terms of struct sockaddr, a `virtual' type of
-- socket address.

-- The Internet family of sockets are addressed as struct sockaddr_in,
-- so when calling functions that operate on struct sockaddr, we have
-- to type cast the Internet socket address into a struct sockaddr.
-- Instances of the structure for different families might *not* be
-- the same size. Same casting is required of other families of
-- sockets such as Xerox NS. Similarly for Unix domain sockets.

-- To represent these socket addresses in Haskell-land, we do what BSD
-- didn't do, and use a union/algebraic type for the different
-- families. Currently only Unix domain sockets and the Internet
-- families are supported.


{-# LINE 399 "Network/Socket.hsc" #-}
type FlowInfo = Word32
type ScopeID = Word32

{-# LINE 402 "Network/Socket.hsc" #-}

data SockAddr		-- C Names				
  = SockAddrInet
	PortNumber	-- sin_port  (network byte order)
	HostAddress	-- sin_addr  (ditto)

{-# LINE 408 "Network/Socket.hsc" #-}
  | SockAddrInet6
        PortNumber      -- sin6_port (network byte order)
        FlowInfo        -- sin6_flowinfo (ditto)
        HostAddress6    -- sin6_addr (ditto)
        ScopeID         -- sin6_scope_id (ditto)

{-# LINE 414 "Network/Socket.hsc" #-}

{-# LINE 415 "Network/Socket.hsc" #-}
  | SockAddrUnix
        String          -- sun_path

{-# LINE 418 "Network/Socket.hsc" #-}
  deriving (Eq)

INSTANCE_TYPEABLE0(SockAddr,sockAddrTc,"SockAddr")


{-# LINE 427 "Network/Socket.hsc" #-}
type CSaFamily = (Word16)
{-# LINE 428 "Network/Socket.hsc" #-}

{-# LINE 429 "Network/Socket.hsc" #-}

instance Show SockAddr where

{-# LINE 432 "Network/Socket.hsc" #-}
  showsPrec _ (SockAddrUnix str) = showString str

{-# LINE 434 "Network/Socket.hsc" #-}
  showsPrec _ (SockAddrInet port ha)
   = showString (unsafePerformIO (inet_ntoa ha)) 
   . showString ":"
   . shows port

{-# LINE 439 "Network/Socket.hsc" #-}
  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

-- The peek32 and poke32 functions work around the fact that the RFCs
-- don't require 32-bit-wide address fields to be present.  We can
-- only portably rely on an 8-bit field, s6_addr.

s6_addr_offset :: Int
s6_addr_offset = ((0))
{-# LINE 453 "Network/Socket.hsc" #-}

peek32 :: Ptr a -> Int -> IO Word32

peek32 p i = do
    let i' = i * 4
        peekByte n = peekByteOff p (s6_addr_offset + i' + n) :: IO Word8
        a `sl` i = fromIntegral a `shiftL` i
    a0 <- peekByte 0
    a1 <- peekByte 1
    a2 <- peekByte 2
    a3 <- peekByte 3
    return ((a0 `sl` 24) .|. (a1 `sl` 16) .|. (a2 `sl` 8) .|. (a3 `sl` 0))

poke32 :: Ptr a -> Int -> Word32 -> IO ()

poke32 p i a = do
    let i' = i * 4
        pokeByte n = pokeByteOff p (s6_addr_offset + i' + n)
        a `sr` i = fromIntegral (a `shiftR` i) :: Word8
    pokeByte 0 (a `sr` 24)
    pokeByte 1 (a `sr` 16)
    pokeByte 2 (a `sr`  8)
    pokeByte 3 (a `sr`  0)

instance Storable HostAddress6 where
    sizeOf _    = (16)
{-# LINE 479 "Network/Socket.hsc" #-}
    alignment _ = alignment (undefined :: CInt)

    peek p = do
        a <- peek32 p 0
        b <- peek32 p 1
        c <- peek32 p 2
        d <- peek32 p 3
        return (a, b, c, d)

    poke p (a, b, c, d) = do
        poke32 p 0 a
        poke32 p 1 b
        poke32 p 2 c
        poke32 p 3 d

{-# LINE 494 "Network/Socket.hsc" #-}

-- we can't write an instance of Storable for SockAddr, because the Storable
-- class can't easily handle alternatives. Also note that on Darwin, the
-- sockaddr structure must be zeroed before use.


{-# LINE 500 "Network/Socket.hsc" #-}
pokeSockAddr p (SockAddrUnix path) = do

{-# LINE 504 "Network/Socket.hsc" #-}

{-# LINE 507 "Network/Socket.hsc" #-}
	((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((1) :: CSaFamily)
{-# LINE 508 "Network/Socket.hsc" #-}
	let pathC = map castCharToCChar path
            poker = case path of ('\0':_) -> pokeArray; _ -> pokeArray0 0
	poker (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p) pathC
{-# LINE 511 "Network/Socket.hsc" #-}

{-# LINE 512 "Network/Socket.hsc" #-}
pokeSockAddr p (SockAddrInet (PortNum port) addr) = do

{-# LINE 516 "Network/Socket.hsc" #-}

{-# LINE 519 "Network/Socket.hsc" #-}
	((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((2) :: CSaFamily)
{-# LINE 520 "Network/Socket.hsc" #-}
	((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port
{-# LINE 521 "Network/Socket.hsc" #-}
	((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p addr	
{-# LINE 522 "Network/Socket.hsc" #-}

{-# LINE 523 "Network/Socket.hsc" #-}
pokeSockAddr p (SockAddrInet6 (PortNum port) flow addr scope) = do

{-# LINE 527 "Network/Socket.hsc" #-}

{-# LINE 530 "Network/Socket.hsc" #-}
	((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((10) :: CSaFamily)
{-# LINE 531 "Network/Socket.hsc" #-}
	((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port
{-# LINE 532 "Network/Socket.hsc" #-}
	((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p flow
{-# LINE 533 "Network/Socket.hsc" #-}
	((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p addr	
{-# LINE 534 "Network/Socket.hsc" #-}
	((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p scope
{-# LINE 535 "Network/Socket.hsc" #-}

{-# LINE 536 "Network/Socket.hsc" #-}

peekSockAddr :: Ptr SockAddr -> IO SockAddr

peekSockAddr p = do
  family <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 541 "Network/Socket.hsc" #-}
  case family :: CSaFamily of

{-# LINE 543 "Network/Socket.hsc" #-}
	(1) -> do
{-# LINE 544 "Network/Socket.hsc" #-}
		str <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p)
{-# LINE 545 "Network/Socket.hsc" #-}
		return (SockAddrUnix str)

{-# LINE 547 "Network/Socket.hsc" #-}
	(2) -> do
{-# LINE 548 "Network/Socket.hsc" #-}
		addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 549 "Network/Socket.hsc" #-}
		port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 550 "Network/Socket.hsc" #-}
		return (SockAddrInet (PortNum port) addr)

{-# LINE 552 "Network/Socket.hsc" #-}
	(10) -> do
{-# LINE 553 "Network/Socket.hsc" #-}
		port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 554 "Network/Socket.hsc" #-}
		flow <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 555 "Network/Socket.hsc" #-}
		addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 556 "Network/Socket.hsc" #-}
		scope <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 557 "Network/Socket.hsc" #-}
		return (SockAddrInet6 (PortNum port) flow addr scope)

{-# LINE 559 "Network/Socket.hsc" #-}

-- helper function used to zero a structure
zeroMemory :: Ptr a -> CSize -> IO ()
zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes)
foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO ()

-- size of struct sockaddr by family

{-# LINE 567 "Network/Socket.hsc" #-}
sizeOfSockAddr_Family AF_UNIX = 110
{-# LINE 568 "Network/Socket.hsc" #-}

{-# LINE 569 "Network/Socket.hsc" #-}

{-# LINE 570 "Network/Socket.hsc" #-}
sizeOfSockAddr_Family AF_INET6 = 28
{-# LINE 571 "Network/Socket.hsc" #-}

{-# LINE 572 "Network/Socket.hsc" #-}
sizeOfSockAddr_Family AF_INET = 16
{-# LINE 573 "Network/Socket.hsc" #-}

-- size of struct sockaddr by SockAddr

{-# LINE 576 "Network/Socket.hsc" #-}
sizeOfSockAddr (SockAddrUnix path) =
    case path of
        '\0':_ -> (2) + length path
{-# LINE 579 "Network/Socket.hsc" #-}
        _      -> 110
{-# LINE 580 "Network/Socket.hsc" #-}

{-# LINE 581 "Network/Socket.hsc" #-}
sizeOfSockAddr (SockAddrInet _ _) = 16
{-# LINE 582 "Network/Socket.hsc" #-}

{-# LINE 583 "Network/Socket.hsc" #-}
sizeOfSockAddr (SockAddrInet6 _ _ _ _) = 28
{-# LINE 584 "Network/Socket.hsc" #-}

{-# LINE 585 "Network/Socket.hsc" #-}

withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a
withSockAddr addr f = do
 let sz = sizeOfSockAddr addr
 allocaBytes sz $ \p -> pokeSockAddr p addr >> f (castPtr p) sz

withNewSockAddr :: Family -> (Ptr SockAddr -> Int -> IO a) -> IO a
withNewSockAddr family f = do
 let sz = sizeOfSockAddr_Family family
 allocaBytes sz $ \ptr -> f ptr sz

-----------------------------------------------------------------------------
-- 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 an unconnected socket of the given family, type and
-- protocol.  The most common invocation of $socket$ is the following:
--    ...
--    my_socket <- socket AF_INET Stream 6
--    ...

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
    fd <- throwSocketErrorIfMinus1Retry "socket" $
		c_socket (packFamily family) (packSocketType stype) protocol

{-# LINE 621 "Network/Socket.hsc" #-}
    System.Posix.Internals.setNonBlockingFD fd

{-# LINE 623 "Network/Socket.hsc" #-}
    socket_status <- newMVar NotConnected
    return (MkSocket fd family stype protocol socket_status)

-- Create an unnamed pair of connected sockets, given family, type and
-- protocol. Differs from a normal pipe in being a bi-directional channel
-- of communication.


{-# LINE 631 "Network/Socket.hsc" #-}
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
    rc <- throwSocketErrorIfMinus1Retry "socketpair" $
		c_socketpair (packFamily family)
			     (packSocketType stype)
			     protocol fdArr
    [fd1,fd2] <- peekArray 2 fdArr 
    s1 <- mkSocket fd1
    s2 <- mkSocket fd2
    return (s1,s2)
  where
    mkSocket fd = do

{-# LINE 648 "Network/Socket.hsc" #-}
       System.Posix.Internals.setNonBlockingFD fd

{-# LINE 650 "Network/Socket.hsc" #-}
       stat <- newMVar Connected
       return (MkSocket fd family stype protocol stat)

foreign import ccall unsafe "socketpair"
  c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt

{-# LINE 656 "Network/Socket.hsc" #-}

-----------------------------------------------------------------------------
-- Binding a socket
--
-- Given a port number this {\em binds} the socket to that port. This
-- means that the programmer is only interested in data being sent to
-- that port number. The $Family$ passed to $bindSocket$ 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.
-- 
-- Port numbers for standard unix services can be found by calling
-- $getServiceEntry$.  These are traditionally port numbers below
-- 1000; although there are afew, namely NFS and IRC, which used higher
-- numbered ports.
-- 
-- The port number allocated to a socket bound by using $aNY\_PORT$ can be
-- found by calling $port$

bindSocket :: Socket	-- Unconnected Socket
	   -> SockAddr	-- Address to Bind to
	   -> IO ()

bindSocket (MkSocket s _family _stype _protocol socketStatus) addr = do
 modifyMVar_ socketStatus $ \ status -> do
 if status /= NotConnected 
  then
   ioError (userError ("bindSocket: can't peform bind on socket in status " ++
	 show status))
  else do
   withSockAddr addr $ \p_addr sz -> do
   status <- throwSocketErrorIfMinus1Retry "bind" $ c_bind s p_addr (fromIntegral sz)
   return Bound

-----------------------------------------------------------------------------
-- Connecting a socket
--
-- Make a connection to an already opened socket on a given machine
-- and port.  assumes that we have already called createSocket,
-- otherwise it will fail.
--
-- This is the dual to $bindSocket$.  The {\em server} process will
-- usually bind to a port number, the {\em client} will then connect
-- to the same port number.  Port numbers of user applications are
-- normally agreed in advance, otherwise we must rely on some meta
-- protocol for telling the other side what port number we have been
-- allocated.

connect :: Socket	-- Unconnected Socket
	-> SockAddr 	-- Socket address stuff
	-> IO ()

connect sock@(MkSocket s _family _stype _protocol socketStatus) addr = do
 modifyMVar_ socketStatus $ \currentStatus -> do
 if currentStatus /= NotConnected 
  then
   ioError (userError ("connect: can't peform connect on socket in 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 

{-# LINE 722 "Network/Socket.hsc" #-}
	       	       err <- getErrno
		       case () of
			 _ | err == eINTR       -> connectLoop
			 _ | err == eINPROGRESS -> connectBlocked
--			 _ | err == eAGAIN      -> connectBlocked
			 otherwise              -> throwErrno "connect"

{-# LINE 739 "Network/Socket.hsc" #-}
       	       else return r

	connectBlocked = do 

{-# LINE 743 "Network/Socket.hsc" #-}
	   threadWaitWrite (fromIntegral s)

{-# LINE 745 "Network/Socket.hsc" #-}
	   err <- getSocketOption sock SoError
	   if (err == 0)
	   	then return 0
	   	else do ioError (errnoToIOError "connect" 
	   			(Errno (fromIntegral err))
	   			Nothing Nothing)

   connectLoop
   return Connected

-----------------------------------------------------------------------------
-- Listen
--
-- The programmer must call $listen$ to tell the system software that
-- they are now interested in receiving data on this port.  This must
-- be called on the bound socket before any calls to read or write
-- data are made.

-- The programmer also gives a number which indicates the length of
-- the incoming queue of unread messages for this socket. On most
-- systems the maximum queue length is around 5.  To remove a message
-- from the queue for processing a call to $accept$ should be made.

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 ("listen: can't peform listen on socket in status " ++
          show status))
   else do
    throwSocketErrorIfMinus1Retry "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 :: Socket			-- Queue Socket
       -> IO (Socket,			-- Readable Socket
	      SockAddr)			-- Peer details

accept sock@(MkSocket s family stype protocol status) = do
 currentStatus <- readMVar status
 okay <- sIsAcceptable sock
 if not okay
   then
     ioError (userError ("accept: can't perform accept on socket (" ++ (show (family,stype,protocol)) ++") in status " ++
	 show currentStatus))
   else do
     let sz = sizeOfSockAddr_Family family
     allocaBytes sz $ \ sockaddr -> do

{-# LINE 820 "Network/Socket.hsc" #-}
     with (fromIntegral sz) $ \ ptr_len -> do
     new_sock <- 

{-# LINE 823 "Network/Socket.hsc" #-}
                 throwErrnoIfMinus1Retry_repeatOnBlock "accept" 
			(threadWaitRead (fromIntegral s))

{-# LINE 826 "Network/Socket.hsc" #-}
			(c_accept s sockaddr ptr_len)

{-# LINE 828 "Network/Socket.hsc" #-}
     System.Posix.Internals.setNonBlockingFD new_sock

{-# LINE 830 "Network/Socket.hsc" #-}

{-# LINE 831 "Network/Socket.hsc" #-}
     addr <- peekSockAddr sockaddr
     new_status <- newMVar Connected
     return ((MkSocket new_sock family stype protocol new_status), addr)


{-# LINE 845 "Network/Socket.hsc" #-}

-----------------------------------------------------------------------------
-- sendTo & recvFrom

-- | NOTE: blocking on Windows unless you compile with -threaded (see
-- GHC ticket #1129)
sendTo :: Socket	-- (possibly) bound/connected Socket
       -> String	-- Data to send
       -> SockAddr
       -> IO Int	-- Number of Bytes sent

sendTo sock xs addr = do
 withCString xs $ \str -> do
   sendBufTo sock str (length xs) addr

sendBufTo :: Socket	      -- (possibly) bound/connected Socket
          -> Ptr a -> Int     -- Data to send
          -> SockAddr
          -> IO Int	      -- Number of Bytes sent

sendBufTo (MkSocket s _family _stype _protocol status) ptr nbytes addr = do
 withSockAddr addr $ \p_addr sz -> do
   liftM fromIntegral $

{-# LINE 869 "Network/Socket.hsc" #-}
     throwErrnoIfMinus1Retry_repeatOnBlock "sendTo"
	(threadWaitWrite (fromIntegral s)) $

{-# LINE 872 "Network/Socket.hsc" #-}
	c_sendto s ptr (fromIntegral $ nbytes) 0{-flags-} 
			p_addr (fromIntegral sz)

-- | NOTE: blocking on Windows unless you compile with -threaded (see
-- GHC ticket #1129)
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)

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 <- 

{-# LINE 893 "Network/Socket.hsc" #-}
	       throwErrnoIfMinus1Retry_repeatOnBlock "recvFrom" 
        	   (threadWaitRead (fromIntegral s)) $

{-# LINE 896 "Network/Socket.hsc" #-}
        	   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 <- sIsConnected 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 :: Socket	-- Bound/Connected Socket
     -> String	-- Data to send
     -> IO Int	-- Number of Bytes sent
send (MkSocket s _family _stype _protocol status) xs = do
 let len = length xs
 withCString xs $ \str -> do
   liftM fromIntegral $

{-# LINE 927 "Network/Socket.hsc" #-}

{-# LINE 928 "Network/Socket.hsc" #-}
     throwErrnoIfMinus1Retry_repeatOnBlock "send"
	(threadWaitWrite (fromIntegral s)) $

{-# LINE 931 "Network/Socket.hsc" #-}
	c_send s str (fromIntegral len) 0{-flags-} 

{-# LINE 933 "Network/Socket.hsc" #-}

recv :: Socket -> Int -> IO String
recv sock l = recvLen sock l >>= \ (s,_) -> return s

recvLen :: Socket -> Int -> IO (String, Int)
recvLen sock@(MkSocket s _family _stype _protocol status) nbytes 
 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recv")
 | otherwise   = do
     allocaBytes nbytes $ \ptr -> do
        len <- 

{-# LINE 947 "Network/Socket.hsc" #-}

{-# LINE 948 "Network/Socket.hsc" #-}
	       throwErrnoIfMinus1Retry_repeatOnBlock "recv" 
        	   (threadWaitRead (fromIntegral s)) $

{-# LINE 951 "Network/Socket.hsc" #-}
        	   c_recv s ptr (fromIntegral nbytes) 0{-flags-} 

{-# LINE 953 "Network/Socket.hsc" #-}
        let len' = fromIntegral len
	if len' == 0
	 then ioError (mkEOFError "Network.Socket.recv")
	 else do
	   s <- peekCStringLen (ptr,len')
	   return (s, 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

{-# LINE 973 "Network/Socket.hsc" #-}
socketPort sock@(MkSocket _ AF_INET6 _ _ _) = do
    (SockAddrInet6 port _ _ _) <- getSocketName sock
    return port

{-# LINE 977 "Network/Socket.hsc" #-}
socketPort (MkSocket _ family _ _ _) =
    ioError (userError ("socketPort: not supported for Family " ++ show family))


-- ---------------------------------------------------------------------------
-- 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 "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 "getSocketName" $ c_getsockname s ptr int_star
   peekSockAddr ptr

-----------------------------------------------------------------------------
-- Socket Properties

data SocketOption
    = DummySocketOption__

{-# LINE 1011 "Network/Socket.hsc" #-}
    | Debug         {- SO_DEBUG     -}

{-# LINE 1013 "Network/Socket.hsc" #-}

{-# LINE 1014 "Network/Socket.hsc" #-}
    | ReuseAddr     {- SO_REUSEADDR -}

{-# LINE 1016 "Network/Socket.hsc" #-}

{-# LINE 1017 "Network/Socket.hsc" #-}
    | Type          {- SO_TYPE      -}

{-# LINE 1019 "Network/Socket.hsc" #-}

{-# LINE 1020 "Network/Socket.hsc" #-}
    | SoError       {- SO_ERROR     -}

{-# LINE 1022 "Network/Socket.hsc" #-}

{-# LINE 1023 "Network/Socket.hsc" #-}
    | DontRoute     {- SO_DONTROUTE -}

{-# LINE 1025 "Network/Socket.hsc" #-}

{-# LINE 1026 "Network/Socket.hsc" #-}
    | Broadcast     {- SO_BROADCAST -}

{-# LINE 1028 "Network/Socket.hsc" #-}

{-# LINE 1029 "Network/Socket.hsc" #-}
    | SendBuffer    {- SO_SNDBUF    -}

{-# LINE 1031 "Network/Socket.hsc" #-}

{-# LINE 1032 "Network/Socket.hsc" #-}
    | RecvBuffer    {- SO_RCVBUF    -}

{-# LINE 1034 "Network/Socket.hsc" #-}

{-# LINE 1035 "Network/Socket.hsc" #-}
    | KeepAlive     {- SO_KEEPALIVE -}

{-# LINE 1037 "Network/Socket.hsc" #-}

{-# LINE 1038 "Network/Socket.hsc" #-}
    | OOBInline     {- SO_OOBINLINE -}

{-# LINE 1040 "Network/Socket.hsc" #-}

{-# LINE 1041 "Network/Socket.hsc" #-}
    | TimeToLive    {- IP_TTL       -}

{-# LINE 1043 "Network/Socket.hsc" #-}

{-# LINE 1044 "Network/Socket.hsc" #-}
    | MaxSegment    {- TCP_MAXSEG   -}

{-# LINE 1046 "Network/Socket.hsc" #-}

{-# LINE 1047 "Network/Socket.hsc" #-}
    | NoDelay       {- TCP_NODELAY  -}

{-# LINE 1049 "Network/Socket.hsc" #-}

{-# LINE 1050 "Network/Socket.hsc" #-}
    | Linger        {- SO_LINGER    -}

{-# LINE 1052 "Network/Socket.hsc" #-}

{-# LINE 1055 "Network/Socket.hsc" #-}

{-# LINE 1056 "Network/Socket.hsc" #-}
    | RecvLowWater  {- SO_RCVLOWAT  -}

{-# LINE 1058 "Network/Socket.hsc" #-}

{-# LINE 1059 "Network/Socket.hsc" #-}
    | SendLowWater  {- SO_SNDLOWAT  -}

{-# LINE 1061 "Network/Socket.hsc" #-}

{-# LINE 1062 "Network/Socket.hsc" #-}
    | RecvTimeOut   {- SO_RCVTIMEO  -}

{-# LINE 1064 "Network/Socket.hsc" #-}

{-# LINE 1065 "Network/Socket.hsc" #-}
    | SendTimeOut   {- SO_SNDTIMEO  -}

{-# LINE 1067 "Network/Socket.hsc" #-}

{-# LINE 1070 "Network/Socket.hsc" #-}

INSTANCE_TYPEABLE0(SocketOption,socketOptionTc,"SocketOption")

socketOptLevel :: SocketOption -> CInt
socketOptLevel so = 
  case so of

{-# LINE 1077 "Network/Socket.hsc" #-}
    TimeToLive   -> 0
{-# LINE 1078 "Network/Socket.hsc" #-}

{-# LINE 1079 "Network/Socket.hsc" #-}

{-# LINE 1080 "Network/Socket.hsc" #-}
    MaxSegment   -> 6
{-# LINE 1081 "Network/Socket.hsc" #-}

{-# LINE 1082 "Network/Socket.hsc" #-}

{-# LINE 1083 "Network/Socket.hsc" #-}
    NoDelay      -> 6
{-# LINE 1084 "Network/Socket.hsc" #-}

{-# LINE 1085 "Network/Socket.hsc" #-}
    _            -> 1
{-# LINE 1086 "Network/Socket.hsc" #-}

packSocketOption :: SocketOption -> CInt
packSocketOption so =
  case so of

{-# LINE 1091 "Network/Socket.hsc" #-}
    Debug         -> 1
{-# LINE 1092 "Network/Socket.hsc" #-}

{-# LINE 1093 "Network/Socket.hsc" #-}

{-# LINE 1094 "Network/Socket.hsc" #-}
    ReuseAddr     -> 2
{-# LINE 1095 "Network/Socket.hsc" #-}

{-# LINE 1096 "Network/Socket.hsc" #-}

{-# LINE 1097 "Network/Socket.hsc" #-}
    Type          -> 3
{-# LINE 1098 "Network/Socket.hsc" #-}

{-# LINE 1099 "Network/Socket.hsc" #-}

{-# LINE 1100 "Network/Socket.hsc" #-}
    SoError       -> 4
{-# LINE 1101 "Network/Socket.hsc" #-}

{-# LINE 1102 "Network/Socket.hsc" #-}

{-# LINE 1103 "Network/Socket.hsc" #-}
    DontRoute     -> 5
{-# LINE 1104 "Network/Socket.hsc" #-}

{-# LINE 1105 "Network/Socket.hsc" #-}

{-# LINE 1106 "Network/Socket.hsc" #-}
    Broadcast     -> 6
{-# LINE 1107 "Network/Socket.hsc" #-}

{-# LINE 1108 "Network/Socket.hsc" #-}

{-# LINE 1109 "Network/Socket.hsc" #-}
    SendBuffer    -> 7
{-# LINE 1110 "Network/Socket.hsc" #-}

{-# LINE 1111 "Network/Socket.hsc" #-}

{-# LINE 1112 "Network/Socket.hsc" #-}
    RecvBuffer    -> 8
{-# LINE 1113 "Network/Socket.hsc" #-}

{-# LINE 1114 "Network/Socket.hsc" #-}

{-# LINE 1115 "Network/Socket.hsc" #-}
    KeepAlive     -> 9
{-# LINE 1116 "Network/Socket.hsc" #-}

{-# LINE 1117 "Network/Socket.hsc" #-}

{-# LINE 1118 "Network/Socket.hsc" #-}
    OOBInline     -> 10
{-# LINE 1119 "Network/Socket.hsc" #-}

{-# LINE 1120 "Network/Socket.hsc" #-}

{-# LINE 1121 "Network/Socket.hsc" #-}
    TimeToLive    -> 2
{-# LINE 1122 "Network/Socket.hsc" #-}

{-# LINE 1123 "Network/Socket.hsc" #-}

{-# LINE 1124 "Network/Socket.hsc" #-}
    MaxSegment    -> 2
{-# LINE 1125 "Network/Socket.hsc" #-}

{-# LINE 1126 "Network/Socket.hsc" #-}

{-# LINE 1127 "Network/Socket.hsc" #-}
    NoDelay       -> 1
{-# LINE 1128 "Network/Socket.hsc" #-}

{-# LINE 1129 "Network/Socket.hsc" #-}

{-# LINE 1130 "Network/Socket.hsc" #-}
    Linger	  -> 13
{-# LINE 1131 "Network/Socket.hsc" #-}

{-# LINE 1132 "Network/Socket.hsc" #-}

{-# LINE 1135 "Network/Socket.hsc" #-}

{-# LINE 1136 "Network/Socket.hsc" #-}
    RecvLowWater  -> 18
{-# LINE 1137 "Network/Socket.hsc" #-}

{-# LINE 1138 "Network/Socket.hsc" #-}

{-# LINE 1139 "Network/Socket.hsc" #-}
    SendLowWater  -> 19
{-# LINE 1140 "Network/Socket.hsc" #-}

{-# LINE 1141 "Network/Socket.hsc" #-}

{-# LINE 1142 "Network/Socket.hsc" #-}
    RecvTimeOut   -> 20
{-# LINE 1143 "Network/Socket.hsc" #-}

{-# LINE 1144 "Network/Socket.hsc" #-}

{-# LINE 1145 "Network/Socket.hsc" #-}
    SendTimeOut   -> 21
{-# LINE 1146 "Network/Socket.hsc" #-}

{-# LINE 1147 "Network/Socket.hsc" #-}

{-# LINE 1150 "Network/Socket.hsc" #-}

setSocketOption :: Socket 
		-> SocketOption -- Option Name
		-> Int		-- Option Value
		-> IO ()
setSocketOption (MkSocket s _ _ _ _) so v = do
   with (fromIntegral v) $ \ptr_v -> do
   throwErrnoIfMinus1_ "setSocketOption" $
       c_setsockopt s (socketOptLevel so) (packSocketOption so) ptr_v 
	  (fromIntegral (sizeOf v))
   return ()


getSocketOption :: Socket
		-> SocketOption  -- Option Name
		-> IO Int	 -- Option Value
getSocketOption (MkSocket s _ _ _ _) so = do
   alloca $ \ptr_v ->
     with (fromIntegral (sizeOf (undefined :: CInt))) $ \ptr_sz -> do
       throwErrnoIfMinus1 "getSocketOption" $
	 c_getsockopt s (socketOptLevel so) (packSocketOption so) ptr_v ptr_sz
       fromIntegral `liftM` peek ptr_v



{-# LINE 1175 "Network/Socket.hsc" #-}
-- | Returns the processID, userID and groupID of the socket's peer.
--
-- Only available on platforms that support SO_PEERCRED on domain sockets.
getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt)
getPeerCred sock = do
  let fd = fdSocket sock
  let sz = (fromIntegral (12))
{-# LINE 1182 "Network/Socket.hsc" #-}
  with sz $ \ ptr_cr -> 
   alloca       $ \ ptr_sz -> do
     poke ptr_sz sz
     throwErrnoIfMinus1 "getPeerCred" $
       c_getsockopt fd (1) (17) ptr_cr ptr_sz
{-# LINE 1187 "Network/Socket.hsc" #-}
     pid <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr_cr
{-# LINE 1188 "Network/Socket.hsc" #-}
     uid <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr_cr
{-# LINE 1189 "Network/Socket.hsc" #-}
     gid <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr_cr
{-# LINE 1190 "Network/Socket.hsc" #-}
     return (pid, uid, gid)

{-# LINE 1192 "Network/Socket.hsc" #-}


{-# LINE 1194 "Network/Socket.hsc" #-}
-- sending/receiving ancillary socket data; low-level mechanism
-- for transmitting file descriptors, mainly.
sendFd :: Socket -> CInt -> IO ()
sendFd sock outfd = do
  let fd = fdSocket sock

{-# LINE 1200 "Network/Socket.hsc" #-}
  throwErrnoIfMinus1Retry_repeatOnBlock "sendFd"
     (threadWaitWrite (fromIntegral fd)) $
     c_sendFd fd outfd

{-# LINE 1206 "Network/Socket.hsc" #-}
   -- Note: If Winsock supported FD-passing, thi would have been 
   -- incorrect (since socket FDs need to be closed via closesocket().)
  c_close outfd
  return ()
  
recvFd :: Socket -> IO CInt
recvFd sock = do
  let fd = fdSocket sock
  theFd <- 

{-# LINE 1216 "Network/Socket.hsc" #-}
    throwErrnoIfMinus1Retry_repeatOnBlock "recvFd" 
        (threadWaitRead (fromIntegral fd)) $

{-# LINE 1219 "Network/Socket.hsc" #-}
         c_recvFd fd
  return theFd


sendAncillary :: Socket
	      -> Int
	      -> Int
	      -> Int
	      -> Ptr a
	      -> Int
	      -> IO ()
sendAncillary sock level ty flags datum len = do
  let fd = fdSocket sock
  _ <-

{-# LINE 1234 "Network/Socket.hsc" #-}
   throwErrnoIfMinus1Retry_repeatOnBlock "sendAncillary"
     (threadWaitWrite (fromIntegral fd)) $

{-# LINE 1237 "Network/Socket.hsc" #-}
     c_sendAncillary fd (fromIntegral level) (fromIntegral ty)
     			(fromIntegral flags) datum (fromIntegral len)
  return ()

recvAncillary :: Socket
	      -> Int
	      -> Int
	      -> IO (Int,Int,Ptr a,Int)
recvAncillary sock flags len = do
  let fd = fdSocket sock
  alloca      $ \ ptr_len   ->
   alloca      $ \ ptr_lev   ->
    alloca      $ \ ptr_ty    ->
     alloca      $ \ ptr_pData -> do
      poke ptr_len (fromIntegral len)
      _ <- 

{-# LINE 1254 "Network/Socket.hsc" #-}
        throwErrnoIfMinus1Retry_repeatOnBlock "recvAncillary" 
            (threadWaitRead (fromIntegral fd)) $

{-# LINE 1257 "Network/Socket.hsc" #-}
	    c_recvAncillary fd ptr_lev ptr_ty (fromIntegral flags) ptr_pData ptr_len
      len <- fromIntegral `liftM` peek ptr_len
      lev <- fromIntegral `liftM` peek ptr_lev
      ty  <- fromIntegral `liftM` peek ptr_ty
      pD  <- peek ptr_pData
      return (lev,ty,pD, len)
foreign import ccall SAFE_ON_WIN "sendAncillary"
  c_sendAncillary :: CInt -> CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt

foreign import ccall SAFE_ON_WIN "recvAncillary"
  c_recvAncillary :: CInt -> Ptr CInt -> Ptr CInt -> CInt -> Ptr (Ptr a) -> Ptr CInt -> IO CInt

foreign import ccall SAFE_ON_WIN "sendFd" c_sendFd :: CInt -> CInt -> IO CInt
foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt


{-# LINE 1273 "Network/Socket.hsc" #-}


{-
A calling sequence table for the main functions is shown in the table below.

\begin{figure}[h]
\begin{center}
\begin{tabular}{|l|c|c|c|c|c|c|c|}d
\hline
{\bf A Call to} & socket & connect & bindSocket & listen & accept & read & write \\
\hline
{\bf Precedes} & & & & & & & \\
\hline 
socket &	&	  &	       &	&	 &	& \\
\hline
connect & +	&	  &	       &	&	 &	& \\
\hline
bindSocket & +	&	  &	       &	&	 &	& \\
\hline
listen &	&	  & +	       &	&	 &	& \\
\hline
accept &	&	  &	       &  +	&	 &	& \\
\hline
read   &	&   +	  &	       &  +	&  +	 &  +	& + \\
\hline
write  &	&   +	  &	       &  +	&  +	 &  +	& + \\
\hline
\end{tabular}
\caption{Sequence Table for Major functions of Socket}
\label{tab:api-seq}
\end{center}
\end{figure}
-}

-- ---------------------------------------------------------------------------
-- OS Dependent Definitions
    
unpackFamily	:: CInt -> Family
packFamily	:: Family -> CInt

packSocketType	:: SocketType -> CInt
unpackSocketType:: CInt -> SocketType

-- | Address Families.
--
-- This data type might have different constructors depending on what is
-- supported by the operating system.
data Family
	= AF_UNSPEC	-- unspecified

{-# LINE 1323 "Network/Socket.hsc" #-}
	| AF_UNIX	-- local to host (pipes, portals

{-# LINE 1325 "Network/Socket.hsc" #-}

{-# LINE 1326 "Network/Socket.hsc" #-}
	| AF_INET	-- internetwork: UDP, TCP, etc

{-# LINE 1328 "Network/Socket.hsc" #-}

{-# LINE 1329 "Network/Socket.hsc" #-}
        | AF_INET6	-- Internet Protocol version 6

{-# LINE 1331 "Network/Socket.hsc" #-}

{-# LINE 1334 "Network/Socket.hsc" #-}

{-# LINE 1337 "Network/Socket.hsc" #-}

{-# LINE 1340 "Network/Socket.hsc" #-}

{-# LINE 1343 "Network/Socket.hsc" #-}

{-# LINE 1346 "Network/Socket.hsc" #-}

{-# LINE 1349 "Network/Socket.hsc" #-}

{-# LINE 1352 "Network/Socket.hsc" #-}

{-# LINE 1355 "Network/Socket.hsc" #-}

{-# LINE 1356 "Network/Socket.hsc" #-}
	| AF_SNA	-- IBM SNA

{-# LINE 1358 "Network/Socket.hsc" #-}

{-# LINE 1359 "Network/Socket.hsc" #-}
	| AF_DECnet	-- DECnet

{-# LINE 1361 "Network/Socket.hsc" #-}

{-# LINE 1364 "Network/Socket.hsc" #-}

{-# LINE 1367 "Network/Socket.hsc" #-}

{-# LINE 1370 "Network/Socket.hsc" #-}

{-# LINE 1371 "Network/Socket.hsc" #-}
	| AF_APPLETALK	-- Apple Talk

{-# LINE 1373 "Network/Socket.hsc" #-}

{-# LINE 1374 "Network/Socket.hsc" #-}
	| AF_ROUTE	-- Internal Routing Protocol 

{-# LINE 1376 "Network/Socket.hsc" #-}

{-# LINE 1379 "Network/Socket.hsc" #-}

{-# LINE 1382 "Network/Socket.hsc" #-}

{-# LINE 1385 "Network/Socket.hsc" #-}

{-# LINE 1388 "Network/Socket.hsc" #-}

{-# LINE 1391 "Network/Socket.hsc" #-}

{-# LINE 1394 "Network/Socket.hsc" #-}

{-# LINE 1395 "Network/Socket.hsc" #-}
	| AF_X25	-- CCITT X.25

{-# LINE 1397 "Network/Socket.hsc" #-}

{-# LINE 1398 "Network/Socket.hsc" #-}
	| AF_AX25

{-# LINE 1400 "Network/Socket.hsc" #-}

{-# LINE 1403 "Network/Socket.hsc" #-}

{-# LINE 1406 "Network/Socket.hsc" #-}

{-# LINE 1407 "Network/Socket.hsc" #-}
	| AF_IPX	-- Novell Internet Protocol

{-# LINE 1409 "Network/Socket.hsc" #-}

{-# LINE 1412 "Network/Socket.hsc" #-}

{-# LINE 1415 "Network/Socket.hsc" #-}

{-# LINE 1418 "Network/Socket.hsc" #-}

{-# LINE 1421 "Network/Socket.hsc" #-}

{-# LINE 1424 "Network/Socket.hsc" #-}

{-# LINE 1427 "Network/Socket.hsc" #-}

{-# LINE 1430 "Network/Socket.hsc" #-}

{-# LINE 1433 "Network/Socket.hsc" #-}

{-# LINE 1436 "Network/Socket.hsc" #-}

{-# LINE 1439 "Network/Socket.hsc" #-}

{-# LINE 1442 "Network/Socket.hsc" #-}

{-# LINE 1445 "Network/Socket.hsc" #-}

{-# LINE 1448 "Network/Socket.hsc" #-}

{-# LINE 1451 "Network/Socket.hsc" #-}

{-# LINE 1454 "Network/Socket.hsc" #-}

{-# LINE 1457 "Network/Socket.hsc" #-}

{-# LINE 1460 "Network/Socket.hsc" #-}

{-# LINE 1463 "Network/Socket.hsc" #-}

{-# LINE 1466 "Network/Socket.hsc" #-}

{-# LINE 1469 "Network/Socket.hsc" #-}

{-# LINE 1472 "Network/Socket.hsc" #-}

{-# LINE 1473 "Network/Socket.hsc" #-}
	| AF_NETROM			-- Amateur radio NetROM

{-# LINE 1475 "Network/Socket.hsc" #-}

{-# LINE 1476 "Network/Socket.hsc" #-}
	| AF_BRIDGE			-- multiprotocol bridge

{-# LINE 1478 "Network/Socket.hsc" #-}

{-# LINE 1479 "Network/Socket.hsc" #-}
	| AF_ATMPVC			-- ATM PVCs

{-# LINE 1481 "Network/Socket.hsc" #-}

{-# LINE 1482 "Network/Socket.hsc" #-}
	| AF_ROSE			-- Amateur Radio X.25 PLP

{-# LINE 1484 "Network/Socket.hsc" #-}

{-# LINE 1485 "Network/Socket.hsc" #-}
	| AF_NETBEUI			-- 802.2LLC

{-# LINE 1487 "Network/Socket.hsc" #-}

{-# LINE 1488 "Network/Socket.hsc" #-}
	| AF_SECURITY			-- Security callback pseudo AF

{-# LINE 1490 "Network/Socket.hsc" #-}

{-# LINE 1491 "Network/Socket.hsc" #-}
	| AF_PACKET			-- Packet family

{-# LINE 1493 "Network/Socket.hsc" #-}

{-# LINE 1494 "Network/Socket.hsc" #-}
	| AF_ASH			-- Ash

{-# LINE 1496 "Network/Socket.hsc" #-}

{-# LINE 1497 "Network/Socket.hsc" #-}
	| AF_ECONET			-- Acorn Econet

{-# LINE 1499 "Network/Socket.hsc" #-}

{-# LINE 1500 "Network/Socket.hsc" #-}
	| AF_ATMSVC			-- ATM SVCs

{-# LINE 1502 "Network/Socket.hsc" #-}

{-# LINE 1503 "Network/Socket.hsc" #-}
	| AF_IRDA			-- IRDA sockets

{-# LINE 1505 "Network/Socket.hsc" #-}

{-# LINE 1506 "Network/Socket.hsc" #-}
	| AF_PPPOX			-- PPPoX sockets

{-# LINE 1508 "Network/Socket.hsc" #-}

{-# LINE 1509 "Network/Socket.hsc" #-}
	| AF_WANPIPE			-- Wanpipe API sockets

{-# LINE 1511 "Network/Socket.hsc" #-}

{-# LINE 1512 "Network/Socket.hsc" #-}
	| AF_BLUETOOTH			-- bluetooth sockets

{-# LINE 1514 "Network/Socket.hsc" #-}
	deriving (Eq, Ord, Read, Show)

------ ------
			
packFamily f = case f of
	AF_UNSPEC -> 0
{-# LINE 1520 "Network/Socket.hsc" #-}

{-# LINE 1521 "Network/Socket.hsc" #-}
	AF_UNIX -> 1
{-# LINE 1522 "Network/Socket.hsc" #-}

{-# LINE 1523 "Network/Socket.hsc" #-}

{-# LINE 1524 "Network/Socket.hsc" #-}
	AF_INET -> 2
{-# LINE 1525 "Network/Socket.hsc" #-}

{-# LINE 1526 "Network/Socket.hsc" #-}

{-# LINE 1527 "Network/Socket.hsc" #-}
        AF_INET6 -> 10
{-# LINE 1528 "Network/Socket.hsc" #-}

{-# LINE 1529 "Network/Socket.hsc" #-}

{-# LINE 1532 "Network/Socket.hsc" #-}

{-# LINE 1535 "Network/Socket.hsc" #-}

{-# LINE 1538 "Network/Socket.hsc" #-}

{-# LINE 1541 "Network/Socket.hsc" #-}

{-# LINE 1544 "Network/Socket.hsc" #-}

{-# LINE 1547 "Network/Socket.hsc" #-}

{-# LINE 1550 "Network/Socket.hsc" #-}

{-# LINE 1553 "Network/Socket.hsc" #-}

{-# LINE 1554 "Network/Socket.hsc" #-}
	AF_SNA -> 22
{-# LINE 1555 "Network/Socket.hsc" #-}

{-# LINE 1556 "Network/Socket.hsc" #-}

{-# LINE 1557 "Network/Socket.hsc" #-}
	AF_DECnet -> 12
{-# LINE 1558 "Network/Socket.hsc" #-}

{-# LINE 1559 "Network/Socket.hsc" #-}

{-# LINE 1562 "Network/Socket.hsc" #-}

{-# LINE 1565 "Network/Socket.hsc" #-}

{-# LINE 1568 "Network/Socket.hsc" #-}

{-# LINE 1569 "Network/Socket.hsc" #-}
	AF_APPLETALK -> 5
{-# LINE 1570 "Network/Socket.hsc" #-}

{-# LINE 1571 "Network/Socket.hsc" #-}

{-# LINE 1572 "Network/Socket.hsc" #-}
	AF_ROUTE -> 16
{-# LINE 1573 "Network/Socket.hsc" #-}

{-# LINE 1574 "Network/Socket.hsc" #-}

{-# LINE 1577 "Network/Socket.hsc" #-}

{-# LINE 1580 "Network/Socket.hsc" #-}

{-# LINE 1583 "Network/Socket.hsc" #-}

{-# LINE 1586 "Network/Socket.hsc" #-}

{-# LINE 1589 "Network/Socket.hsc" #-}

{-# LINE 1592 "Network/Socket.hsc" #-}

{-# LINE 1593 "Network/Socket.hsc" #-}
	AF_X25 -> 9
{-# LINE 1594 "Network/Socket.hsc" #-}

{-# LINE 1595 "Network/Socket.hsc" #-}

{-# LINE 1596 "Network/Socket.hsc" #-}
	AF_AX25 -> 3
{-# LINE 1597 "Network/Socket.hsc" #-}

{-# LINE 1598 "Network/Socket.hsc" #-}

{-# LINE 1601 "Network/Socket.hsc" #-}

{-# LINE 1604 "Network/Socket.hsc" #-}

{-# LINE 1605 "Network/Socket.hsc" #-}
	AF_IPX -> 4
{-# LINE 1606 "Network/Socket.hsc" #-}

{-# LINE 1607 "Network/Socket.hsc" #-}

{-# LINE 1610 "Network/Socket.hsc" #-}

{-# LINE 1613 "Network/Socket.hsc" #-}

{-# LINE 1616 "Network/Socket.hsc" #-}

{-# LINE 1619 "Network/Socket.hsc" #-}

{-# LINE 1622 "Network/Socket.hsc" #-}

{-# LINE 1625 "Network/Socket.hsc" #-}

{-# LINE 1628 "Network/Socket.hsc" #-}

{-# LINE 1631 "Network/Socket.hsc" #-}

{-# LINE 1634 "Network/Socket.hsc" #-}

{-# LINE 1637 "Network/Socket.hsc" #-}

{-# LINE 1640 "Network/Socket.hsc" #-}

{-# LINE 1643 "Network/Socket.hsc" #-}

{-# LINE 1646 "Network/Socket.hsc" #-}

{-# LINE 1649 "Network/Socket.hsc" #-}

{-# LINE 1652 "Network/Socket.hsc" #-}

{-# LINE 1655 "Network/Socket.hsc" #-}

{-# LINE 1658 "Network/Socket.hsc" #-}

{-# LINE 1661 "Network/Socket.hsc" #-}

{-# LINE 1664 "Network/Socket.hsc" #-}

{-# LINE 1667 "Network/Socket.hsc" #-}

{-# LINE 1670 "Network/Socket.hsc" #-}

{-# LINE 1671 "Network/Socket.hsc" #-}
	AF_NETROM -> 6
{-# LINE 1672 "Network/Socket.hsc" #-}

{-# LINE 1673 "Network/Socket.hsc" #-}

{-# LINE 1674 "Network/Socket.hsc" #-}
	AF_BRIDGE -> 7
{-# LINE 1675 "Network/Socket.hsc" #-}

{-# LINE 1676 "Network/Socket.hsc" #-}

{-# LINE 1677 "Network/Socket.hsc" #-}
	AF_ATMPVC -> 8
{-# LINE 1678 "Network/Socket.hsc" #-}

{-# LINE 1679 "Network/Socket.hsc" #-}

{-# LINE 1680 "Network/Socket.hsc" #-}
	AF_ROSE -> 11
{-# LINE 1681 "Network/Socket.hsc" #-}

{-# LINE 1682 "Network/Socket.hsc" #-}

{-# LINE 1683 "Network/Socket.hsc" #-}
	AF_NETBEUI -> 13
{-# LINE 1684 "Network/Socket.hsc" #-}

{-# LINE 1685 "Network/Socket.hsc" #-}

{-# LINE 1686 "Network/Socket.hsc" #-}
	AF_SECURITY -> 14
{-# LINE 1687 "Network/Socket.hsc" #-}

{-# LINE 1688 "Network/Socket.hsc" #-}

{-# LINE 1689 "Network/Socket.hsc" #-}
	AF_PACKET -> 17
{-# LINE 1690 "Network/Socket.hsc" #-}

{-# LINE 1691 "Network/Socket.hsc" #-}

{-# LINE 1692 "Network/Socket.hsc" #-}
	AF_ASH -> 18
{-# LINE 1693 "Network/Socket.hsc" #-}

{-# LINE 1694 "Network/Socket.hsc" #-}

{-# LINE 1695 "Network/Socket.hsc" #-}
	AF_ECONET -> 19
{-# LINE 1696 "Network/Socket.hsc" #-}

{-# LINE 1697 "Network/Socket.hsc" #-}

{-# LINE 1698 "Network/Socket.hsc" #-}
	AF_ATMSVC -> 20
{-# LINE 1699 "Network/Socket.hsc" #-}

{-# LINE 1700 "Network/Socket.hsc" #-}

{-# LINE 1701 "Network/Socket.hsc" #-}
	AF_IRDA -> 23
{-# LINE 1702 "Network/Socket.hsc" #-}

{-# LINE 1703 "Network/Socket.hsc" #-}

{-# LINE 1704 "Network/Socket.hsc" #-}
	AF_PPPOX -> 24
{-# LINE 1705 "Network/Socket.hsc" #-}

{-# LINE 1706 "Network/Socket.hsc" #-}

{-# LINE 1707 "Network/Socket.hsc" #-}
	AF_WANPIPE -> 25
{-# LINE 1708 "Network/Socket.hsc" #-}

{-# LINE 1709 "Network/Socket.hsc" #-}

{-# LINE 1710 "Network/Socket.hsc" #-}
	AF_BLUETOOTH -> 31
{-# LINE 1711 "Network/Socket.hsc" #-}

{-# LINE 1712 "Network/Socket.hsc" #-}

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

unpackFamily f = case f of
	(0) -> AF_UNSPEC
{-# LINE 1717 "Network/Socket.hsc" #-}

{-# LINE 1718 "Network/Socket.hsc" #-}
	(1) -> AF_UNIX
{-# LINE 1719 "Network/Socket.hsc" #-}

{-# LINE 1720 "Network/Socket.hsc" #-}

{-# LINE 1721 "Network/Socket.hsc" #-}
	(2) -> AF_INET
{-# LINE 1722 "Network/Socket.hsc" #-}

{-# LINE 1723 "Network/Socket.hsc" #-}

{-# LINE 1724 "Network/Socket.hsc" #-}
        (10) -> AF_INET6
{-# LINE 1725 "Network/Socket.hsc" #-}

{-# LINE 1726 "Network/Socket.hsc" #-}

{-# LINE 1729 "Network/Socket.hsc" #-}

{-# LINE 1732 "Network/Socket.hsc" #-}

{-# LINE 1735 "Network/Socket.hsc" #-}

{-# LINE 1738 "Network/Socket.hsc" #-}

{-# LINE 1741 "Network/Socket.hsc" #-}

{-# LINE 1744 "Network/Socket.hsc" #-}

{-# LINE 1747 "Network/Socket.hsc" #-}

{-# LINE 1750 "Network/Socket.hsc" #-}

{-# LINE 1751 "Network/Socket.hsc" #-}
	(22) -> AF_SNA
{-# LINE 1752 "Network/Socket.hsc" #-}

{-# LINE 1753 "Network/Socket.hsc" #-}

{-# LINE 1754 "Network/Socket.hsc" #-}
	(12) -> AF_DECnet
{-# LINE 1755 "Network/Socket.hsc" #-}

{-# LINE 1756 "Network/Socket.hsc" #-}

{-# LINE 1759 "Network/Socket.hsc" #-}

{-# LINE 1762 "Network/Socket.hsc" #-}

{-# LINE 1765 "Network/Socket.hsc" #-}

{-# LINE 1766 "Network/Socket.hsc" #-}
	(5) -> AF_APPLETALK
{-# LINE 1767 "Network/Socket.hsc" #-}

{-# LINE 1768 "Network/Socket.hsc" #-}

{-# LINE 1769 "Network/Socket.hsc" #-}
	(16) -> AF_ROUTE
{-# LINE 1770 "Network/Socket.hsc" #-}

{-# LINE 1771 "Network/Socket.hsc" #-}

{-# LINE 1774 "Network/Socket.hsc" #-}

{-# LINE 1777 "Network/Socket.hsc" #-}

{-# LINE 1780 "Network/Socket.hsc" #-}

{-# LINE 1783 "Network/Socket.hsc" #-}

{-# LINE 1788 "Network/Socket.hsc" #-}

{-# LINE 1791 "Network/Socket.hsc" #-}

{-# LINE 1792 "Network/Socket.hsc" #-}
	(9) -> AF_X25
{-# LINE 1793 "Network/Socket.hsc" #-}

{-# LINE 1794 "Network/Socket.hsc" #-}

{-# LINE 1795 "Network/Socket.hsc" #-}
	(3) -> AF_AX25
{-# LINE 1796 "Network/Socket.hsc" #-}

{-# LINE 1797 "Network/Socket.hsc" #-}

{-# LINE 1800 "Network/Socket.hsc" #-}

{-# LINE 1803 "Network/Socket.hsc" #-}

{-# LINE 1804 "Network/Socket.hsc" #-}
	(4) -> AF_IPX
{-# LINE 1805 "Network/Socket.hsc" #-}

{-# LINE 1806 "Network/Socket.hsc" #-}

{-# LINE 1809 "Network/Socket.hsc" #-}

{-# LINE 1812 "Network/Socket.hsc" #-}

{-# LINE 1815 "Network/Socket.hsc" #-}

{-# LINE 1818 "Network/Socket.hsc" #-}

{-# LINE 1821 "Network/Socket.hsc" #-}

{-# LINE 1824 "Network/Socket.hsc" #-}

{-# LINE 1827 "Network/Socket.hsc" #-}

{-# LINE 1830 "Network/Socket.hsc" #-}

{-# LINE 1833 "Network/Socket.hsc" #-}

{-# LINE 1836 "Network/Socket.hsc" #-}

{-# LINE 1839 "Network/Socket.hsc" #-}

{-# LINE 1842 "Network/Socket.hsc" #-}

{-# LINE 1845 "Network/Socket.hsc" #-}

{-# LINE 1848 "Network/Socket.hsc" #-}

{-# LINE 1851 "Network/Socket.hsc" #-}

{-# LINE 1854 "Network/Socket.hsc" #-}

{-# LINE 1857 "Network/Socket.hsc" #-}

{-# LINE 1860 "Network/Socket.hsc" #-}

{-# LINE 1863 "Network/Socket.hsc" #-}

{-# LINE 1866 "Network/Socket.hsc" #-}

{-# LINE 1869 "Network/Socket.hsc" #-}

{-# LINE 1870 "Network/Socket.hsc" #-}
	(6) -> AF_NETROM
{-# LINE 1871 "Network/Socket.hsc" #-}

{-# LINE 1872 "Network/Socket.hsc" #-}

{-# LINE 1873 "Network/Socket.hsc" #-}
	(7) -> AF_BRIDGE
{-# LINE 1874 "Network/Socket.hsc" #-}

{-# LINE 1875 "Network/Socket.hsc" #-}

{-# LINE 1876 "Network/Socket.hsc" #-}
	(8) -> AF_ATMPVC
{-# LINE 1877 "Network/Socket.hsc" #-}

{-# LINE 1878 "Network/Socket.hsc" #-}

{-# LINE 1879 "Network/Socket.hsc" #-}
	(11) -> AF_ROSE
{-# LINE 1880 "Network/Socket.hsc" #-}

{-# LINE 1881 "Network/Socket.hsc" #-}

{-# LINE 1882 "Network/Socket.hsc" #-}
	(13) -> AF_NETBEUI
{-# LINE 1883 "Network/Socket.hsc" #-}

{-# LINE 1884 "Network/Socket.hsc" #-}

{-# LINE 1885 "Network/Socket.hsc" #-}
	(14) -> AF_SECURITY
{-# LINE 1886 "Network/Socket.hsc" #-}

{-# LINE 1887 "Network/Socket.hsc" #-}

{-# LINE 1888 "Network/Socket.hsc" #-}
	(17) -> AF_PACKET
{-# LINE 1889 "Network/Socket.hsc" #-}

{-# LINE 1890 "Network/Socket.hsc" #-}

{-# LINE 1891 "Network/Socket.hsc" #-}
	(18) -> AF_ASH
{-# LINE 1892 "Network/Socket.hsc" #-}

{-# LINE 1893 "Network/Socket.hsc" #-}

{-# LINE 1894 "Network/Socket.hsc" #-}
	(19) -> AF_ECONET
{-# LINE 1895 "Network/Socket.hsc" #-}

{-# LINE 1896 "Network/Socket.hsc" #-}

{-# LINE 1897 "Network/Socket.hsc" #-}
	(20) -> AF_ATMSVC
{-# LINE 1898 "Network/Socket.hsc" #-}

{-# LINE 1899 "Network/Socket.hsc" #-}

{-# LINE 1900 "Network/Socket.hsc" #-}
	(23) -> AF_IRDA
{-# LINE 1901 "Network/Socket.hsc" #-}

{-# LINE 1902 "Network/Socket.hsc" #-}

{-# LINE 1903 "Network/Socket.hsc" #-}
	(24) -> AF_PPPOX
{-# LINE 1904 "Network/Socket.hsc" #-}

{-# LINE 1905 "Network/Socket.hsc" #-}

{-# LINE 1906 "Network/Socket.hsc" #-}
	(25) -> AF_WANPIPE
{-# LINE 1907 "Network/Socket.hsc" #-}

{-# LINE 1908 "Network/Socket.hsc" #-}

{-# LINE 1909 "Network/Socket.hsc" #-}
	(31) -> AF_BLUETOOTH
{-# LINE 1910 "Network/Socket.hsc" #-}

{-# LINE 1911 "Network/Socket.hsc" #-}

-- Socket Types.

-- | Socket Types.
--
-- This data type might have different constructors depending on what is
-- supported by the operating system.
data SocketType
	= NoSocketType

{-# LINE 1921 "Network/Socket.hsc" #-}
	| Stream 

{-# LINE 1923 "Network/Socket.hsc" #-}

{-# LINE 1924 "Network/Socket.hsc" #-}
	| Datagram

{-# LINE 1926 "Network/Socket.hsc" #-}

{-# LINE 1927 "Network/Socket.hsc" #-}
	| Raw 

{-# LINE 1929 "Network/Socket.hsc" #-}

{-# LINE 1930 "Network/Socket.hsc" #-}
	| RDM 

{-# LINE 1932 "Network/Socket.hsc" #-}

{-# LINE 1933 "Network/Socket.hsc" #-}
	| SeqPacket

{-# LINE 1935 "Network/Socket.hsc" #-}
	deriving (Eq, Ord, Read, Show)
	
INSTANCE_TYPEABLE0(SocketType,socketTypeTc,"SocketType")

packSocketType stype = case stype of
	NoSocketType -> 0

{-# LINE 1942 "Network/Socket.hsc" #-}
	Stream -> 1
{-# LINE 1943 "Network/Socket.hsc" #-}

{-# LINE 1944 "Network/Socket.hsc" #-}

{-# LINE 1945 "Network/Socket.hsc" #-}
	Datagram -> 2
{-# LINE 1946 "Network/Socket.hsc" #-}

{-# LINE 1947 "Network/Socket.hsc" #-}

{-# LINE 1948 "Network/Socket.hsc" #-}
	Raw -> 3
{-# LINE 1949 "Network/Socket.hsc" #-}

{-# LINE 1950 "Network/Socket.hsc" #-}

{-# LINE 1951 "Network/Socket.hsc" #-}
	RDM -> 4
{-# LINE 1952 "Network/Socket.hsc" #-}

{-# LINE 1953 "Network/Socket.hsc" #-}

{-# LINE 1954 "Network/Socket.hsc" #-}
	SeqPacket -> 5
{-# LINE 1955 "Network/Socket.hsc" #-}

{-# LINE 1956 "Network/Socket.hsc" #-}

unpackSocketType t = case t of
	0 -> NoSocketType

{-# LINE 1960 "Network/Socket.hsc" #-}
	(1) -> Stream
{-# LINE 1961 "Network/Socket.hsc" #-}

{-# LINE 1962 "Network/Socket.hsc" #-}

{-# LINE 1963 "Network/Socket.hsc" #-}
	(2) -> Datagram
{-# LINE 1964 "Network/Socket.hsc" #-}

{-# LINE 1965 "Network/Socket.hsc" #-}

{-# LINE 1966 "Network/Socket.hsc" #-}
	(3) -> Raw
{-# LINE 1967 "Network/Socket.hsc" #-}

{-# LINE 1968 "Network/Socket.hsc" #-}

{-# LINE 1969 "Network/Socket.hsc" #-}
	(4) -> RDM
{-# LINE 1970 "Network/Socket.hsc" #-}

{-# LINE 1971 "Network/Socket.hsc" #-}

{-# LINE 1972 "Network/Socket.hsc" #-}
	(5) -> SeqPacket
{-# LINE 1973 "Network/Socket.hsc" #-}

{-# LINE 1974 "Network/Socket.hsc" #-}

-- ---------------------------------------------------------------------------
-- Utility Functions

aNY_PORT :: PortNumber 
aNY_PORT = 0

-- | The IPv4 wild card address.

iNADDR_ANY :: HostAddress
iNADDR_ANY = htonl (0)
{-# LINE 1985 "Network/Socket.hsc" #-}


{-# LINE 1987 "Network/Socket.hsc" #-}
-- | The IPv6 wild card address.

iN6ADDR_ANY :: HostAddress6
iN6ADDR_ANY = (0, 0, 0, 0)

{-# LINE 1992 "Network/Socket.hsc" #-}

sOMAXCONN :: Int
sOMAXCONN = 128
{-# LINE 1995 "Network/Socket.hsc" #-}

sOL_SOCKET :: Int
sOL_SOCKET = 1
{-# LINE 1998 "Network/Socket.hsc" #-}


{-# LINE 2000 "Network/Socket.hsc" #-}
sCM_RIGHTS :: Int
sCM_RIGHTS = 1
{-# LINE 2002 "Network/Socket.hsc" #-}

{-# LINE 2003 "Network/Socket.hsc" #-}

maxListenQueue :: Int
maxListenQueue = sOMAXCONN

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

data ShutdownCmd 
 = ShutdownReceive
 | ShutdownSend
 | ShutdownBoth

INSTANCE_TYPEABLE0(ShutdownCmd,shutdownCmdTc,"ShutdownCmd")

sdownCmdToInt :: ShutdownCmd -> CInt
sdownCmdToInt ShutdownReceive = 0
sdownCmdToInt ShutdownSend    = 1
sdownCmdToInt ShutdownBoth    = 2

shutdown :: Socket -> ShutdownCmd -> IO ()
shutdown (MkSocket s _ _ _ _) stype = do
  throwSocketErrorIfMinus1Retry "shutdown" (c_shutdown s (sdownCmdToInt stype))
  return ()

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

-- | Closes a socket
sClose	 :: Socket -> IO ()
sClose (MkSocket s _ _ _ socketStatus) = do 
 withMVar socketStatus $ \ status ->
   if status == ConvertedToHandle
	then ioError (userError ("sClose: converted to a Handle, use hClose instead"))
	else c_close s; return ()

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

sIsConnected :: Socket -> IO Bool
sIsConnected (MkSocket _ _ _ _ status) = do
    value <- readMVar status
    return (value == Connected)	

-- -----------------------------------------------------------------------------
-- Socket Predicates

sIsBound :: Socket -> IO Bool
sIsBound (MkSocket _ _ _ _ status) = do
    value <- readMVar status
    return (value == Bound)	

sIsListening :: Socket -> IO Bool
sIsListening (MkSocket _ _ _  _ status) = do
    value <- readMVar status
    return (value == Listening)	

sIsReadable  :: Socket -> IO Bool
sIsReadable (MkSocket _ _ _ _ status) = do
    value <- readMVar status
    return (value == Listening || value == Connected)

sIsWritable  :: Socket -> IO Bool
sIsWritable = sIsReadable -- sort of.

sIsAcceptable :: Socket -> IO Bool

{-# LINE 2066 "Network/Socket.hsc" #-}
sIsAcceptable (MkSocket _ AF_UNIX Stream _ status) = do
    value <- readMVar status
    return (value == Connected || value == Bound || value == Listening)
sIsAcceptable (MkSocket _ AF_UNIX _ _ _) = return False

{-# LINE 2071 "Network/Socket.hsc" #-}
sIsAcceptable (MkSocket _ _ _ _ status) = do
    value <- readMVar status
    return (value == Connected || value == Listening)
    
-- -----------------------------------------------------------------------------
-- Internet address manipulation routines:

inet_addr :: String -> IO HostAddress
inet_addr ipstr = do
   withCString ipstr $ \str -> do
   had <- c_inet_addr str
   if had == -1
    then ioError (userError ("inet_addr: Malformed address: " ++ ipstr))
    else return had  -- network byte order

inet_ntoa :: HostAddress -> IO String
inet_ntoa haddr = do
  pstr <- c_inet_ntoa haddr
  peekCString pstr

-- | turns a Socket into an 'Handle'. By default, the new handle is
-- unbuffered. Use 'System.IO.hSetBuffering' to change the buffering.
--
-- Note that since a 'Handle' is automatically closed by a finalizer
-- when it is no longer referenced, you should avoid doing any more
-- operations on the 'Socket' after calling 'socketToHandle'.  To
-- close the 'Socket' after 'socketToHandle', call 'System.IO.hClose'
-- on the 'Handle'.


{-# LINE 2101 "Network/Socket.hsc" #-}
socketToHandle :: Socket -> IOMode -> IO Handle
socketToHandle s@(MkSocket fd _ _ _ socketStatus) mode = do
 modifyMVar socketStatus $ \ status ->
    if status == ConvertedToHandle
	then ioError (userError ("socketToHandle: already a Handle"))
	else do

{-# LINE 2108 "Network/Socket.hsc" #-}
    h <- fdToHandle' (fromIntegral fd) (Just System.Posix.Internals.Stream) True (show s) mode True{-bin-}

{-# LINE 2114 "Network/Socket.hsc" #-}
    return (ConvertedToHandle, h)

{-# LINE 2119 "Network/Socket.hsc" #-}

-- | Pack a list of values into a bitmask.  The possible mappings from
-- value to bit-to-set are given as the first argument.  We assume
-- that each value can cause exactly one bit to be set; unpackBits will
-- break if this property is not true.

packBits :: (Eq a, Bits b) => [(a, b)] -> [a] -> b

packBits mapping xs = foldl' pack 0 mapping
    where pack acc (k, v) | k `elem` xs = acc .|. v
                          | otherwise   = acc

-- | Unpack a bitmask into a list of values.

unpackBits :: Bits b => [(a, b)] -> b -> [a]

unpackBits [] 0    = []
unpackBits [] r    = error ("unpackBits: unhandled bits set: " ++ show r)
unpackBits ((k,v):xs) r
    | r .&. v /= 0 = k : unpackBits xs (r .&. complement v)
    | otherwise    = unpackBits xs r

-----------------------------------------------------------------------------
-- Address and service lookups


{-# LINE 2145 "Network/Socket.hsc" #-}

-- | Flags that control the querying behaviour of 'getAddrInfo'.
data AddrInfoFlag
    = AI_ADDRCONFIG
    | AI_ALL
    | AI_CANONNAME
    | AI_NUMERICHOST
    | AI_NUMERICSERV
    | AI_PASSIVE
    | AI_V4MAPPED
    deriving (Eq, Read, Show)

INSTANCE_TYPEABLE0(AddrInfoFlag,addrInfoFlagTc,"AddrInfoFlag")

aiFlagMapping :: [(AddrInfoFlag, CInt)]

aiFlagMapping =
    [

{-# LINE 2164 "Network/Socket.hsc" #-}
     (AI_ADDRCONFIG, 32),
{-# LINE 2165 "Network/Socket.hsc" #-}

{-# LINE 2168 "Network/Socket.hsc" #-}

{-# LINE 2169 "Network/Socket.hsc" #-}
     (AI_ALL, 16),
{-# LINE 2170 "Network/Socket.hsc" #-}

{-# LINE 2173 "Network/Socket.hsc" #-}
     (AI_CANONNAME, 2),
{-# LINE 2174 "Network/Socket.hsc" #-}
     (AI_NUMERICHOST, 4),
{-# LINE 2175 "Network/Socket.hsc" #-}

{-# LINE 2176 "Network/Socket.hsc" #-}
     (AI_NUMERICSERV, 1024),
{-# LINE 2177 "Network/Socket.hsc" #-}

{-# LINE 2180 "Network/Socket.hsc" #-}
     (AI_PASSIVE, 1),
{-# LINE 2181 "Network/Socket.hsc" #-}

{-# LINE 2182 "Network/Socket.hsc" #-}
     (AI_V4MAPPED, 8)
{-# LINE 2183 "Network/Socket.hsc" #-}

{-# LINE 2186 "Network/Socket.hsc" #-}
    ]

-- | Indicate whether the given 'AddrInfoFlag' will have any effect on
-- this system.
addrInfoFlagImplemented :: AddrInfoFlag -> Bool
addrInfoFlagImplemented f = packBits aiFlagMapping [f] /= 0

data AddrInfo =
    AddrInfo {
        addrFlags :: [AddrInfoFlag],
        addrFamily :: Family,
        addrSocketType :: SocketType,
        addrProtocol :: ProtocolNumber,
        addrAddress :: SockAddr,
        addrCanonName :: Maybe String
        }
    deriving (Eq, Show)

INSTANCE_TYPEABLE0(AddrInfo,addrInfoTc,"AddrInfo")

instance Storable AddrInfo where
    sizeOf    _ = 48
{-# LINE 2208 "Network/Socket.hsc" #-}
    alignment _ = alignment (undefined :: CInt)

    peek p = do
	ai_flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 2212 "Network/Socket.hsc" #-}
	ai_family <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 2213 "Network/Socket.hsc" #-}
	ai_socktype <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 2214 "Network/Socket.hsc" #-}
	ai_protocol <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p
{-# LINE 2215 "Network/Socket.hsc" #-}
        ai_addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p >>= peekSockAddr
{-# LINE 2216 "Network/Socket.hsc" #-}
	ai_canonname_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 2217 "Network/Socket.hsc" #-}

        ai_canonname <- if ai_canonname_ptr == nullPtr
                        then return Nothing
                        else liftM Just $ peekCString ai_canonname_ptr
                             
        return (AddrInfo
                {
                 addrFlags = unpackBits aiFlagMapping ai_flags,
                 addrFamily = unpackFamily ai_family,
                 addrSocketType = unpackSocketType ai_socktype,
                 addrProtocol = ai_protocol,
                 addrAddress = ai_addr,
                 addrCanonName = ai_canonname
                })

    poke p (AddrInfo flags family socketType protocol _ _) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (packBits aiFlagMapping flags)
{-# LINE 2234 "Network/Socket.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p (packFamily family)
{-# LINE 2235 "Network/Socket.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p (packSocketType socketType)
{-# LINE 2236 "Network/Socket.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p protocol
{-# LINE 2237 "Network/Socket.hsc" #-}

        -- stuff below is probably not needed, but let's zero it for safety

        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p (0::CSize)
{-# LINE 2241 "Network/Socket.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p nullPtr
{-# LINE 2242 "Network/Socket.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p nullPtr
{-# LINE 2243 "Network/Socket.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) p nullPtr
{-# LINE 2244 "Network/Socket.hsc" #-}

data NameInfoFlag
    = NI_DGRAM
    | NI_NAMEREQD
    | NI_NOFQDN
    | NI_NUMERICHOST
    | NI_NUMERICSERV
    deriving (Eq, Read, Show)

INSTANCE_TYPEABLE0(NameInfoFlag,nameInfoFlagTc,"NameInfoFlag")

niFlagMapping :: [(NameInfoFlag, CInt)]

niFlagMapping = [(NI_DGRAM, 16),
{-# LINE 2258 "Network/Socket.hsc" #-}
                 (NI_NAMEREQD, 8),
{-# LINE 2259 "Network/Socket.hsc" #-}
                 (NI_NOFQDN, 4),
{-# LINE 2260 "Network/Socket.hsc" #-}
                 (NI_NUMERICHOST, 1),
{-# LINE 2261 "Network/Socket.hsc" #-}
                 (NI_NUMERICSERV, 2)]
{-# LINE 2262 "Network/Socket.hsc" #-}

-- | Default hints for address lookup with 'getAddrInfo'.  The values
-- of the 'addrAddress' and 'addrCanonName' fields are 'undefined',
-- and are never inspected by 'getAddrInfo'.

defaultHints :: AddrInfo

defaultHints = AddrInfo {
                         addrFlags = [],
                         addrFamily = AF_UNSPEC,
                         addrSocketType = NoSocketType,
                         addrProtocol = defaultProtocol,
                         addrAddress = undefined,
                         addrCanonName = undefined
                        }

-- | Resolve a host or service name to one or more addresses.
-- The 'AddrInfo' values that this function returns contain 'SockAddr'
-- values that you can pass directly to 'connect' or
-- 'bindSocket'.
--
-- This function is protocol independent.  It can return both IPv4 and
-- IPv6 address information.
--
-- The 'AddrInfo' argument specifies the preferred query behaviour,
-- socket options, or protocol.  You can override these conveniently
-- using Haskell's record update syntax on 'defaultHints', for example
-- as follows:
--
-- @
--   myHints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME] }
-- @
--
-- Values for 'addrFlags' control query behaviour.  The supported
-- flags are as follows:
--
--   [@AI_PASSIVE@] If no 'HostName' value is provided, the network
--     address in each 'SockAddr'
--     will be left as a "wild card", i.e. as either 'iNADDR_ANY'
--     or 'iN6ADDR_ANY'.  This is useful for server applications that
--     will accept connections from any client.
--
--   [@AI_CANONNAME@] The 'addrCanonName' field of the first returned
--     'AddrInfo' will contain the "canonical name" of the host.
--
--   [@AI_NUMERICHOST@] The 'HostName' argument /must/ be a numeric
--     address in string form, and network name lookups will not be
--     attempted.
-- 
-- /Note/: Although the following flags are required by RFC 3493, they
-- may not have an effect on all platforms, because the underlying
-- network stack may not support them.  To see whether a flag from the
-- list below will have any effect, call 'addrInfoFlagImplemented'.
--
--   [@AI_NUMERICSERV@] The 'ServiceName' argument /must/ be a port
--     number in string form, and service name lookups will not be
--     attempted.
--
--   [@AI_ADDRCONFIG@] The list of returned 'AddrInfo' values will
--     only contain IPv4 addresses if the local system has at least
--     one IPv4 interface configured, and likewise for IPv6.
--
--   [@AI_V4MAPPED@] If an IPv6 lookup is performed, and no IPv6
--     addresses are found, IPv6-mapped IPv4 addresses will be
--     returned.
--
--   [@AI_ALL@] If 'AI_ALL' is specified, return all matching IPv6 and
--     IPv4 addresses.  Otherwise, this flag has no effect.
--     
-- You must provide a 'Just' value for at least one of the 'HostName'
-- or 'ServiceName' arguments.  'HostName' can be either a numeric
-- network address (dotted quad for IPv4, colon-separated hex for
-- IPv6) or a hostname.  In the latter case, its addresses will be
-- looked up unless 'AI_NUMERICHOST' is specified as a hint.  If you
-- do not provide a 'HostName' value /and/ do not set 'AI_PASSIVE' as
-- a hint, network addresses in the result will contain the address of
-- the loopback interface.
--
-- If the query fails, this function throws an IO exception instead of
-- returning an empty list.  Otherwise, it returns a non-empty list
-- of 'AddrInfo' values.
--
-- There are several reasons why a query might result in several
-- values.  For example, the queried-for host could be multihomed, or
-- the service might be available via several protocols.
--
-- Note: the order of arguments is slightly different to that defined
-- for @getaddrinfo@ in RFC 2553.  The 'AddrInfo' parameter comes first
-- to make partial application easier.
--
-- Example:
-- @
--   let hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME] }
--   addrs <- getAddrInfo (Just hints) (Just "www.haskell.org") (Just "http")
--   let addr = head addrs
--   sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
--   connect sock (addrAddress addr)
-- @

getAddrInfo :: Maybe AddrInfo -- ^ preferred socket type or protocol
            -> Maybe HostName -- ^ host name to look up
            -> Maybe ServiceName -- ^ service name to look up
            -> IO [AddrInfo] -- ^ resolved addresses, with "best" first

getAddrInfo hints node service =
  maybeWith withCString node $ \c_node ->
    maybeWith withCString service $ \c_service ->
      maybeWith with hints $ \c_hints ->
        alloca $ \ptr_ptr_addrs -> do
          ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs
          case ret of
            0 -> do ptr_addrs <- peek ptr_ptr_addrs
                    ais <- followAddrInfo ptr_addrs
                    c_freeaddrinfo ptr_addrs
                    return ais
            _ -> do err <- gai_strerror ret
                    ioError (IOError Nothing NoSuchThing "getAddrInfo" err
                             Nothing)

followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo]

followAddrInfo ptr_ai | ptr_ai == nullPtr = return []
                      | otherwise = do
    a <- peek ptr_ai
    as <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr_ai >>= followAddrInfo
{-# LINE 2387 "Network/Socket.hsc" #-}
    return (a:as)

foreign import ccall safe "getaddrinfo"
    c_getaddrinfo :: CString -> CString -> Ptr AddrInfo -> Ptr (Ptr AddrInfo)
                  -> IO CInt

foreign import ccall safe "freeaddrinfo"
    c_freeaddrinfo :: Ptr AddrInfo -> IO ()

gai_strerror :: CInt -> IO String

gai_strerror n = c_gai_strerror n >>= peekCString

foreign import ccall safe "gai_strerror"
    c_gai_strerror :: CInt -> IO CString

withCStringIf :: Bool -> Int -> (CSize -> CString -> IO a) -> IO a
withCStringIf False _ f = f 0 nullPtr
withCStringIf True n f = allocaBytes n (f (fromIntegral n))
                    
-- | Resolve an address to a host or service name.
-- This function is protocol independent.
--
-- The list of 'NameInfoFlag' values controls query behaviour.  The
-- supported flags are as follows:
--
--   [@NI_NOFQDN@] If a host is local, return only the
--     hostname part of the FQDN.
--
--   [@NI_NUMERICHOST@] The name of the host is not
--     looked up.  Instead, a numeric representation of the host's
--     address is returned.  For an IPv4 address, this will be a
--     dotted-quad string.  For IPv6, it will be colon-separated
--     hexadecimal.
--
--   [@NI_NUMERICSERV@] The name of the service is not
--     looked up.  Instead, a numeric representation of the
--     service is returned.
--
--   [@NI_NAMEREQD@] If the hostname cannot be looked up, an IO error
--     is thrown.
--
--   [@NI_DGRAM@] Resolve a datagram-based service name.  This is
--     required only for the few protocols that have different port
--     numbers for their datagram-based versions than for their
--     stream-based versions.
--
-- Hostname and service name lookups can be expensive.  You can
-- specify which lookups to perform via the two 'Bool' arguments.  If
-- one of these is 'False', the corresponding value in the returned
-- tuple will be 'Nothing', and no lookup will be performed.
--
-- If a host or service's name cannot be looked up, then the numeric
-- form of the address or service will be returned.
--
-- If the query fails, this function throws an IO exception.
--
-- Example:
-- @
--   (hostName, _) <- getNameInfo [] True False myAddress
-- @

getNameInfo :: [NameInfoFlag] -- ^ flags to control lookup behaviour
            -> Bool -- ^ whether to look up a hostname
            -> Bool -- ^ whether to look up a service name
            -> SockAddr -- ^ the address to look up
            -> IO (Maybe HostName, Maybe ServiceName)

getNameInfo flags doHost doService addr =
  withCStringIf doHost (1025) $ \c_hostlen c_host ->
{-# LINE 2457 "Network/Socket.hsc" #-}
    withCStringIf doService (32) $ \c_servlen c_serv -> do
{-# LINE 2458 "Network/Socket.hsc" #-}
      withSockAddr addr $ \ptr_addr sz -> do
        ret <- c_getnameinfo ptr_addr (fromIntegral sz) c_host c_hostlen
                             c_serv c_servlen (packBits niFlagMapping flags)
        case ret of
          0 -> do
            let peekIf doIf c_val = if doIf
                                     then liftM Just $ peekCString c_val
                                     else return Nothing
            host <- peekIf doHost c_host
            serv <- peekIf doService c_serv
            return (host, serv)
          _ -> do err <- gai_strerror ret
                  ioError (IOError Nothing NoSuchThing "getNameInfo" err
                           Nothing)

foreign import ccall safe "getnameinfo"
    c_getnameinfo :: Ptr SockAddr -> CInt{-CSockLen???-} -> CString -> CSize -> CString
                  -> CSize -> CInt -> IO CInt

{-# LINE 2477 "Network/Socket.hsc" #-}

mkInvalidRecvArgError :: String -> IOError
mkInvalidRecvArgError loc = IOError Nothing 

{-# LINE 2481 "Network/Socket.hsc" #-}
				    InvalidArgument

{-# LINE 2485 "Network/Socket.hsc" #-}
				    loc "non-positive length" Nothing

mkEOFError :: String -> IOError
mkEOFError loc = IOError Nothing EOF loc "end of file" Nothing

-- ---------------------------------------------------------------------------
-- WinSock support

{-| On Windows operating systems, the networking subsystem has to be
initialised using 'withSocketsDo' before any networking operations can
be used.  eg.

> main = withSocketsDo $ do {...}

Although this is only strictly necessary on Windows platforms, it is
harmless on other platforms, so for portability it is good practice to
use it all the time.
-}
withSocketsDo :: IO a -> IO a

{-# LINE 2505 "Network/Socket.hsc" #-}
withSocketsDo x = x

{-# LINE 2518 "Network/Socket.hsc" #-}

-- ---------------------------------------------------------------------------
-- foreign imports from the C library

foreign import ccall unsafe "my_inet_ntoa"
  c_inet_ntoa :: HostAddress -> IO (Ptr CChar)

foreign import CALLCONV unsafe "inet_addr"
  c_inet_addr :: Ptr CChar -> IO HostAddress

foreign import CALLCONV unsafe "shutdown"
  c_shutdown :: CInt -> CInt -> IO CInt 


{-# LINE 2532 "Network/Socket.hsc" #-}
foreign import ccall unsafe "close"
  c_close :: CInt -> IO CInt

{-# LINE 2538 "Network/Socket.hsc" #-}

foreign import CALLCONV unsafe "socket"
  c_socket :: CInt -> CInt -> CInt -> IO CInt
foreign import CALLCONV unsafe "bind"
  c_bind :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt
foreign import CALLCONV unsafe "connect"
  c_connect :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt
foreign import CALLCONV unsafe "accept"
  c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt
foreign import CALLCONV safe "accept"
  c_accept_safe :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt
foreign import CALLCONV unsafe "listen"
  c_listen :: CInt -> CInt -> IO CInt


{-# LINE 2553 "Network/Socket.hsc" #-}
foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool

{-# LINE 2555 "Network/Socket.hsc" #-}

foreign import CALLCONV unsafe "send"
  c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt
foreign import CALLCONV SAFE_ON_WIN "sendto"
  c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> CInt -> IO CInt
foreign import CALLCONV unsafe "recv"
  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
foreign import CALLCONV SAFE_ON_WIN "recvfrom"
  c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt
foreign import CALLCONV unsafe "getpeername"
  c_getpeername :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt
foreign import CALLCONV unsafe "getsockname"
  c_getsockname :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt

foreign import CALLCONV unsafe "getsockopt"
  c_getsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt
foreign import CALLCONV unsafe "setsockopt"
  c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt

-----------------------------------------------------------------------------
-- Support for thread-safe blocking operations in GHC.


{-# LINE 2578 "Network/Socket.hsc" #-}


{-# SPECIALISE 
    throwErrnoIfMinus1Retry_mayBlock
	 :: String -> IO CInt -> IO CInt -> IO CInt #-}
throwErrnoIfMinus1Retry_mayBlock :: Num a => String -> IO a -> IO a -> IO a
throwErrnoIfMinus1Retry_mayBlock name on_block act = do
    res <- act
    if res == -1
        then do
            err <- getErrno
            if err == eINTR
                then throwErrnoIfMinus1Retry_mayBlock name on_block act
	        else if err == eWOULDBLOCK || err == eAGAIN
		        then on_block
                        else throwErrno name
        else return res

throwErrnoIfMinus1Retry_repeatOnBlock :: Num a => String -> IO b -> IO a -> IO a
throwErrnoIfMinus1Retry_repeatOnBlock name on_block act = do
  throwErrnoIfMinus1Retry_mayBlock name (on_block >> repeat) act
  where repeat = throwErrnoIfMinus1Retry_repeatOnBlock name on_block act

throwSocketErrorIfMinus1Retry name act = throwErrnoIfMinus1Retry name act

throwSocketErrorIfMinus1_ :: Num a => String -> IO a -> IO ()
throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_

{-# LINE 2653 "Network/Socket.hsc" #-}