ghc/lib/misc/SocketPrim.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-1998
   3 %
   4 \section[SocketPrim]{Low-level socket bindings}
   5
   6 The @SocketPrim@ module is for when you want full control over the
   7 sockets, exposing the C socket API.
   8
   9 \begin{code}
  10 {-# OPTIONS -#include "stgio.h" -#include "cbits/ghcSockets.h" #-}
  11
  12 #include "config.h"
  13
  14 module SocketPrim (
  15
  16     Socket,
  17     Family(..),
  18     SocketType(..),
  19     SockAddr(..),
  20     HostAddress,
  21     ShutdownCmd(..),
  22     ProtocolNumber,
  23
  24     socket,             -- :: Family -> SocketType -> ProtocolNumber -> IO Socket
  25     connect,            -- :: Socket -> SockAddr -> IO ()
  26     bindSocket,         -- :: Socket -> SockAddr -> IO ()
  27     listen,             -- :: Socket -> Int -> IO ()
  28     accept,             -- :: Socket -> IO (Socket, SockAddr)
  29     getPeerName,        -- :: Socket -> IO SockAddr
  30     getSocketName,      -- :: Socket -> IO SockAddr
  31
  32     socketPort,         -- :: Socket -> IO PortNumber
  33
  34     writeSocket,        -- :: Socket -> String -> IO Int
  35     readSocket,         -- :: Socket -> Int -> IO (String, Int)
  36     readSocketAll,      -- :: Socket -> IO String
  37
  38     socketToHandle,     -- :: Socket -> IO Handle
  39
  40     sendTo,             -- :: Socket -> String -> SockAddr -> IO Int
  41     recvFrom,           -- :: Socket -> Int -> IO (String, Int, SockAddr)
  42 --    sendmsg           -- :: Socket -> Message -> MsgFlags -> IO Int
  43 --    recvmsg           -- :: Socket -> MsgFlags -> IO Message
  44
  45
  46     inet_addr,          -- :: String -> IO HostAddress
  47     inet_ntoa,          -- :: HostAddress -> IO String
  48
  49     sIsConnected,       -- :: Socket -> IO Bool
  50     sIsBound,           -- :: Socket -> IO Bool
  51     sIsListening,       -- :: Socket -> IO Bool
  52     sIsReadable,        -- :: Socket -> IO Bool
  53     sIsWritable,        -- :: Socket -> IO Bool
  54     shutdown,           -- :: Socket -> ShutdownCmd -> IO ()
  55     sClose,             -- :: Socket -> IO ()
  56
  57     -- socket opts
  58     SocketOption(..),
  59     getSocketOption,     -- :: Socket -> SocketOption -> IO Int
  60     setSocketOption,     -- :: Socket -> SocketOption -> Int -> IO ()
  61
  62     PortNumber(..),
  63     mkPortNumber,           -- :: Int -> PortNumber
  64
  65 -- Special Constants
  66
  67     aNY_PORT,
  68     iNADDR_ANY,
  69     sOMAXCONN,
  70     maxListenQueue,
  71
  72
  73 -- The following are exported ONLY for use in the BSD module and
  74 -- should not be used anywhere else.
  75
  76     packFamily, unpackFamily,
  77     packSocketType,
  78     packSockAddr, unpackSockAddr
  79
  80 ) where
  81
  82 import GlaExts
  83 import ST
  84 import Ix
  85 import PrelIOBase  -- IOError, Handle representation
  86 import PrelHandle
  87 import Foreign
  88
  89 import IO
  90 import IOExts       ( IORef, newIORef, readIORef, writeIORef )
  91 import PackedString ( unpackNBytesPS, byteArrayToPS,
  92                       unpackCString, unpackCStringIO,
  93                       unpackCStringLenIO
  94                     )
  95 \end{code}
  96
  97
  98 %************************************************************************
  99 %*                                                                      *
 100 \subsection[Socket-SocketTypes]{Socket Types}
 101 %*                                                                      *
 102 %************************************************************************
 103
 104
 105 There are a few possible ways to do this.  The first is convert the
 106 structs used in the C library into an equivalent Haskell type.  An
 107 other possible implementation is to keep all the internals in the C
 108 code and use an Int\# and a status flag. The second method is used here
 109 since a lot of the C structures are not required to be manipulated.
 110
 111 Originally the status was non-mutable so we had to return a new socket
 112 each time we changed the status.  This version now uses mutable
 113 variables to avoid the need to do this.  The result is a cleaner
 114 interface and better security since the application programmer now
 115 can't circumvent the status information to perform invalid operations
 116 on sockets.
 117
 118 \begin{code}
 119 data SocketStatus
 120   -- Returned Status    Function called
 121   = NotConnected        -- socket
 122   | Bound               -- bindSocket
 123   | Listening           -- listen
 124   | Connected           -- connect/accept
 125   | Error String        -- Any
 126     deriving (Eq, Show)
 127
 128 data Socket
 129   = MkSocket
 130             Int                  -- File Descriptor
 131             Family
 132             SocketType
 133             Int                  -- Protocol Number
 134             (IORef SocketStatus) -- Status Flag
 135 \end{code}
 136
 137 The scheme used for addressing sockets is somewhat quirky. The
 138 calls in the BSD socket API that need to know the socket address all
 139 operate in terms of \tr{struct sockaddr}, a `virtual' type of socket address.
 140
 141 The Internet family of sockets are addressed as \tr{struct sockaddr\_in},
 142 so when calling functions that operate on \tr{struct sockaddr}, we have
 143 to type cast the Internet socket address into a \tr{struct sockaddr}. By luck(!),
 144 the two structures are of the same size. Same casting is required of other
 145 families of sockets such as Xerox NS. Similarly for Unix domain sockets.
 146
 147 To represent these socket addresses in Haskell-land, we do what BSD didn't do,
 148 and use a union/algebraic type for the different families. Currently only
 149 Unix domain sockets and the Internet family is supported.
 150
 151 \begin{code}
 152
 153 -- NOTE: HostAddresses are represented in network byte order.
 154 --       Functions that expect the address in machine byte order
 155 --       will have to perform the necessary translation.
 156 type HostAddress = Word
 157
 158 --
 159 -- newtyped to prevent accidental use of sane-looking
 160 -- port numbers that haven't actually been converted to
 161 -- network-byte-order first.
 162 --
 163 newtype PortNumber = PNum Int  -- 16-bit value stored in network byte order.
 164                      deriving ( Eq )
 165
 166 instance Show PortNumber where
 167   showsPrec p (PNum pn) = showsPrec p pn_host
 168    where
 169      pn_host :: Int
 170      pn_host = unsafePerformIO  (_casm_ ``%r=(int)ntohs((int)%0); '' pn)
 171
 172
 173 mkPortNumber :: Int -> PortNumber
 174 mkPortNumber v = unsafePerformIO $ do
 175    po <- _casm_ ``%r=(int)htons((int)%0); '' v
 176    return (PNum po)
 177
 178 data SockAddr           -- C Names
 179 #ifndef cygwin32_TARGET_OS
 180   = SockAddrUnix        -- struct sockaddr_un
 181         String          -- sun_path
 182   | SockAddrInet        -- struct sockaddr_in
 183         PortNumber      -- sin_port  (network byte order)
 184         HostAddress     -- sin_addr  (ditto)
 185 #else
 186   = SockAddrInet        -- struct sockaddr_in
 187         PortNumber      -- sin_port  (network byte order)
 188         HostAddress     -- sin_addr  (ditto)
 189
 190 #endif
 191     deriving Eq
 192
 193 type ProtocolNumber = Int
 194
 195 \end{code}
 196
 197
 198 %************************************************************************
 199 %*                                                                      *
 200 \subsection[Socket-Connections]{Connection Functions}
 201 %*                                                                      *
 202 %************************************************************************
 203
 204 In the following connection and binding primitives.  The names of the
 205 equivalent C functions have been preserved where possible. It should
 206 be noted that some of these names used in the C library, \tr{bind} in
 207 particular, have a different meaning to many Haskell programmers and
 208 have thus been renamed by appending the prefix Socket.
 209
 210 Create an unconnected socket of the given family, type and protocol.
 211 The most common invocation of $socket$ is the following:
 212
 213 \begin{verbatim}
 214    ...
 215    my_socket <- socket AF_INET Stream 6
 216    ...
 217 \end{verbatim}
 218
 219 \begin{code}
 220 socket :: Family         -- Family Name (usually AF_INET)
 221        -> SocketType     -- Socket Type (usually Stream)
 222        -> ProtocolNumber -- Protocol Number (getProtocolByName to find value)
 223        -> IO Socket      -- Unconnected Socket
 224
 225 socket family stype protocol = do
 226     status <- _ccall_ createSocket (packFamily family)
 227                                    (packSocketType stype)
 228                                    protocol
 229     case status of
 230       -1 -> constructErrorAndFail "socket"
 231       n  -> do
 232         socket_status <- newIORef NotConnected
 233         return (MkSocket n family stype protocol socket_status)
 234 \end{code}
 235
 236 Given a port number this {\em binds} the socket to that port. This
 237 means that the programmer is only interested in data being sent to
 238 that port number. The $Family$ passed to $bindSocket$ must
 239 be the same as that passed to $socket$.  If the special port
 240 number $aNY\_PORT$ is passed then the system assigns the next
 241 available use port.
 242
 243 Port numbers for standard unix services can be found by calling
 244 $getServiceEntry$.  These are traditionally port numbers below
 245 1000; although there are afew, namely NFS and IRC, which used higher
 246 numbered ports.
 247
 248 The port number allocated to a socket bound by using $aNY\_PORT$ can be
 249 found by calling $port$
 250
 251 \begin{code}
 252 bindSocket :: Socket    -- Unconnected Socket
 253            -> SockAddr  -- Address to Bind to
 254            -> IO ()
 255
 256 bindSocket (MkSocket s family stype protocol socketStatus) addr = do
 257 #ifndef cygwin32_TARGET_OS
 258  let isDomainSocket = if family == AF_UNIX then 1 else (0::Int)
 259 #else
 260  let isDomainSocket = 0
 261 #endif
 262  currentStatus <- readIORef socketStatus
 263  if currentStatus /= NotConnected
 264   then
 265    fail (userError ("bindSocket: can't peform bind on socket in status " ++
 266          show currentStatus))
 267   else do
 268    addr' <- packSockAddr addr
 269    let (_,sz) = boundsOfByteArray addr'
 270    status <- _ccall_ bindSocket s addr' sz isDomainSocket
 271    case status of
 272      -1 -> constructErrorAndFail "bindSocket"
 273      0  -> writeIORef socketStatus (Bound)
 274 \end{code}
 275
 276
 277 Make a connection to an already opened socket on a given machine and port.
 278 assumes that we have already called createSocket, othewise it will fail.
 279
 280 This is the dual to $bindSocket$.  The {\em server} process will
 281 usually bind to a port number, the {\em client} will then connect to
 282 the same port number.  Port numbers of user applications are normally
 283 agreed in advance, otherwise we must rely on some meta protocol for telling
 284 the other side what port number we have been allocated.
 285
 286 \begin{code}
 287 connect :: Socket       -- Unconnected Socket
 288         -> SockAddr     -- Socket address stuff
 289         -> IO ()
 290
 291 connect (MkSocket s family stype protocol socketStatus) addr = do
 292 #ifndef cygwin32_TARGET_OS
 293  let isDomainSocket = if family == AF_UNIX then 1 else (0::Int)
 294 #else
 295  let isDomainSocket = 0
 296 #endif
 297  currentStatus <- readIORef socketStatus
 298  if currentStatus /= NotConnected
 299   then
 300    fail (userError ("connect: can't peform connect on socket in status " ++
 301          show currentStatus))
 302   else do
 303    addr' <- packSockAddr addr
 304    let (_,sz) = boundsOfByteArray addr'
 305    status <- _ccall_ connectSocket s addr' sz isDomainSocket
 306    case status of
 307      -1 -> constructErrorAndFail "connect"
 308      0 -> writeIORef socketStatus Connected
 309 \end{code}
 310
 311 The programmer must call $listen$ to tell the system software
 312 that they are now interested in receiving data on this port.  This
 313 must be called on the bound socket before any calls to read or write
 314 data are made.
 315
 316 The programmer also gives a number which indicates the length of the
 317 incoming queue of unread messages for this socket. On most systems the
 318 maximum queue length is around 5.  To remove a message from the queue
 319 for processing a call to $accept$ should be made.
 320
 321 \begin{code}
 322 listen :: Socket  -- Connected & Bound Socket
 323        -> Int     -- Queue Length
 324        -> IO ()
 325
 326 listen (MkSocket s family stype protocol socketStatus) backlog = do
 327  currentStatus <- readIORef socketStatus
 328  if currentStatus /= Bound
 329    then
 330     fail (userError ("listen: can't peform listen on socket in status " ++
 331           show currentStatus))
 332    else do
 333     status <- _ccall_ listenSocket s backlog
 334     case status of
 335       -1 -> constructErrorAndFail "listen"
 336       0  -> writeIORef socketStatus Listening
 337 \end{code}
 338
 339 A call to $accept$ only returns when data is available on the given
 340 socket, unless the socket has been set to non-blocking.  It will
 341 return a new socket which should be used to read the incoming data and
 342 should then be closed. Using the socket returned by $accept$ allows
 343 incoming requests to be queued on the original socket.
 344
 345 \begin{code}
 346 accept :: Socket                        -- Queue Socket
 347        -> IO (Socket,                   -- Readable Socket
 348               SockAddr)                 -- Peer details
 349
 350 accept sock@(MkSocket s family stype protocol status) = do
 351  currentStatus <- readIORef status
 352  okay <- sIsAcceptable sock
 353  if not okay
 354    then
 355      fail (userError ("accept: can't peform accept on socket in status " ++
 356          show currentStatus))
 357    else do
 358      (ptr, sz) <- allocSockAddr family
 359      int_star <- stToIO (newIntArray (0,1))
 360      stToIO (writeIntArray int_star 0 sz)
 361      sock <- _ccall_ acceptSocket s ptr int_star
 362      case sock of
 363           -1 -> constructErrorAndFail "accept"
 364           _  -> do
 365                 sz <- stToIO (readIntArray int_star 0)
 366                 addr <- unpackSockAddr ptr sz
 367                 status <- newIORef Connected
 368                 return ((MkSocket sock family stype protocol status), addr)
 369 \end{code}
 370
 371 %************************************************************************
 372 %*                                                                      *
 373 \subsection[Socket-DataPass]{Data Passing Primitives}
 374 %*                                                                      *
 375 %************************************************************************
 376
 377 To allow Haskell to talk to C programs we need to be able to
 378 communicate in terms of byte streams. @writeSocket@ and
 379 @readSocket@ should only be used for this purpose and not for
 380 communication between Haskell programs.  Haskell programs should use
 381 the 1.3 IO hPutStr and associated machinery for communicating with
 382 each other.
 383
 384
 385 \begin{code}
 386 writeSocket :: Socket   -- Connected Socket
 387             -> String   -- Data to send
 388             -> IO Int   -- Number of Bytes sent
 389
 390 writeSocket (MkSocket s family stype protocol status) xs = do
 391  currentStatus <- readIORef status
 392  if not ((currentStatus == Connected) || (currentStatus == Listening))
 393    then
 394     fail (userError ("writeSocket: can't peform write on socket in status " ++
 395           show currentStatus))
 396    else do
 397     nbytes <- _ccall_ writeDescriptor s xs (length xs)
 398     case nbytes of
 399       -1 -> constructErrorAndFail "writeSocket"
 400       _  -> return nbytes
 401
 402
 403 sendTo :: Socket        -- Bound/Connected Socket
 404        -> String        -- Data to send
 405        -> SockAddr
 406        -> IO Int        -- Number of Bytes sent
 407
 408 sendTo (MkSocket s family stype protocol status) xs addr = do
 409  currentStatus <- readIORef status
 410  if not ((currentStatus == Connected) || (currentStatus == Listening) || (currentStatus == Bound))
 411    then
 412     fail (userError ("sendTo: can't peform write on socket in status " ++
 413           show currentStatus))
 414    else do
 415     addr' <- packSockAddr addr
 416     let (_,sz) = boundsOfByteArray addr'
 417     nbytes <- _ccall_ sendTo__ s xs (length xs) addr' sz
 418     case nbytes of
 419       -1 -> constructErrorAndFail "sendTo"
 420       _  -> return nbytes
 421
 422 readSocket :: Socket            -- Connected (or bound) Socket
 423            -> Int               -- Number of Bytes to Read
 424            -> IO (String, Int)  -- (Data Read, Number of Bytes)
 425
 426 readSocket (MkSocket s family stype protocol status) nbytes = do
 427  currentStatus <- readIORef status
 428  if not ((currentStatus == Connected) || (currentStatus == Listening))
 429    then
 430     fail (userError ("readSocket: can't perform read on socket in status " ++
 431           show currentStatus))
 432    else do
 433     ptr <- stToIO (newCharArray (1, nbytes))
 434     nbytes <- _ccall_ readDescriptor s ptr nbytes
 435     case nbytes of
 436       -1 -> constructErrorAndFail "readSocket"
 437       n  -> do
 438             barr <- stToIO (unsafeFreezeByteArray ptr)
 439             return (unpackNBytesPS (byteArrayToPS barr) n, n)
 440
 441 readSocketAll :: Socket -> IO String
 442 readSocketAll s =
 443     let
 444       loop xs =
 445        catch
 446         (readSocket s 4096                      >>= \ (str, nbytes) ->
 447          if nbytes /= 0 then
 448             loop (str ++ xs)
 449          else
 450             return xs)
 451         (\ _ -> return xs)
 452     in
 453         loop ""
 454
 455 recvFrom :: Socket -> Int -> IO (String, Int, SockAddr)
 456 recvFrom (MkSocket s family stype protocol status) nbytes = do
 457  currentStatus <- readIORef status
 458  if not ((currentStatus == Connected) || (currentStatus == Listening) || (currentStatus == Bound))
 459    then
 460     fail (userError ("recvFrom: can't perform read on socket in status " ++
 461           show currentStatus))
 462    else do
 463     ptr      <- stToIO (newCharArray (0, nbytes))
 464     (ptr_addr,_) <- allocSockAddr AF_INET
 465     nbytes   <- _ccall_ recvFrom__ s ptr nbytes ptr_addr
 466     case nbytes of
 467       -1 -> constructErrorAndFail "recvFrom"
 468       n  -> do
 469             barr <- stToIO (unsafeFreezeByteArray ptr)
 470             addr <- unpackSockAddrInet ptr_addr
 471             return (unpackNBytesPS (byteArrayToPS barr) n, n, addr)
 472
 473 \end{code}
 474
 475 The port number the given socket is currently connected to can be
 476 determined by calling $port$, is generally only useful when bind
 477 was given $aNY\_PORT$.
 478
 479 \begin{code}
 480 socketPort :: Socket            -- Connected & Bound Socket
 481            -> IO PortNumber     -- Port Number of Socket
 482 socketPort sock@(MkSocket s AF_INET stype protocol status) =
 483     getSocketName sock >>= \(SockAddrInet port _) ->
 484     return port
 485 socketPort (MkSocket s family stype protocol status) =
 486     fail (userError ("socketPort: not supported for Family " ++ show family))
 487 \end{code}
 488
 489 Calling $getPeerName$ returns the address details of the machine,
 490 other than the local one, which is connected to the socket. This is
 491 used in programs such as FTP to determine where to send the returning
 492 data.  The corresponding call to get the details of the local machine
 493 is $getSocketName$.
 494
 495 \begin{code}
 496 getPeerName   :: Socket -> IO SockAddr
 497
 498 getPeerName (MkSocket s family stype protocol status) = do
 499  (ptr, sz) <- allocSockAddr family
 500  int_star <- stToIO (newIntArray (0,1))
 501  stToIO (writeIntArray int_star 0 sz)
 502  status <- _ccall_ getPeerName s ptr int_star
 503  case status of
 504    -1 -> constructErrorAndFail "getPeerName"
 505    _  -> do
 506           sz <- stToIO (readIntArray int_star 0)
 507           unpackSockAddr ptr sz
 508
 509 getSocketName :: Socket -> IO SockAddr
 510
 511 getSocketName (MkSocket s family stype protocol status) = do
 512  (ptr, sz) <- allocSockAddr family
 513  int_star <- stToIO (newIntArray (0,1))
 514  stToIO (writeIntArray int_star 0 sz)
 515  status <- _ccall_ getSockName s ptr int_star
 516  case status of
 517    -1 -> constructErrorAndFail "getSocketName"
 518    _  -> do
 519          sz <- stToIO (readIntArray int_star 0)
 520          unpackSockAddr ptr sz
 521
 522
 523 \end{code}
 524
 525
 526 %************************************************************************
 527 %*                                                                      *
 528 \subsection[Socket-Properties]{Socket Properties}
 529 %*                                                                      *
 530 %************************************************************************
 531
 532 \begin{code}
 533 data SocketOption
 534     = Debug         {- SO_DEBUG     -}
 535     | ReuseAddr     {- SO_REUSEADDR -}
 536     | Type          {- SO_TYPE      -}
 537     | SoError       {- SO_ERROR     -}
 538     | DontRoute     {- SO_DONTROUTE -}
 539     | Broadcast     {- SO_BROADCAST -}
 540     | SendBuffer    {- SO_SNDBUF    -}
 541     | RecvBuffer    {- SO_RCVBUF    -}
 542     | KeepAlive     {- SO_KEEPALIVE -}
 543     | OOBInline     {- SO_OOBINLINE -}
 544     | MaxSegment    {- TCP_MAXSEG   -}
 545     | NoDelay       {- TCP_NODELAY  -}
 546 --    | Linger        {- SO_LINGER    -}
 547 #if 0
 548     | RecvLowWater  {- SO_RCVLOWAT  -}
 549     | SendLowWater  {- SO_SNDLOWAT  -}
 550     | RecvTimeOut   {- SO_RCVTIMEO  -}
 551     | SendTimeOut   {- SO_SNDTIMEO  -}
 552     | UseLoopBack   {- SO_USELOOPBACK -}  -- not used, I believe.
 553 #endif
 554
 555 packSocketOption :: SocketOption -> Int
 556 packSocketOption so =
 557   case so of
 558     Debug         -> ``SO_DEBUG''
 559     ReuseAddr     -> ``SO_REUSEADDR''
 560     Type          -> ``SO_TYPE''
 561     SoError       -> ``SO_ERROR''
 562     DontRoute     -> ``SO_DONTROUTE''
 563     Broadcast     -> ``SO_BROADCAST''
 564     SendBuffer    -> ``SO_SNDBUF''
 565     RecvBuffer    -> ``SO_RCVBUF''
 566     KeepAlive     -> ``SO_KEEPALIVE''
 567     OOBInline     -> ``SO_OOBINLINE''
 568     MaxSegment    -> ``TCP_MAXSEG''
 569     NoDelay       -> ``TCP_NODELAY''
 570 #if 0
 571     RecvLowWater  -> ``SO_RCVLOWAT''
 572     SendLowWater  -> ``SO_SNDLOWAT''
 573     RecvTimeOut   -> ``SO_RCVTIMEO''
 574     SendTimeOut   -> ``SO_SNDTIMEO''
 575     UseLoopBack   -> ``SO_USELOOPBACK''
 576 #endif
 577
 578 setSocketOption :: Socket
 579                 -> SocketOption -- Option Name
 580                 -> Int           -- Option Value
 581                 -> IO ()
 582 setSocketOption (MkSocket s family stype protocol status) so v = do
 583    rc <- _ccall_ setSocketOption__ s (packSocketOption so) v
 584    if rc /= 0
 585     then constructErrorAndFail "setSocketOption"
 586     else return ()
 587
 588 getSocketOption :: Socket
 589                 -> SocketOption  -- Option Name
 590                 -> IO Int         -- Option Value
 591 getSocketOption (MkSocket s family stype protocol status) so = do
 592    rc <- _ccall_ getSocketOption__ s (packSocketOption so)
 593    if rc == -1 -- let's just hope that value isn't taken..
 594     then constructErrorAndFail "getSocketOption"
 595     else return rc
 596
 597 \end{code}
 598
 599 A calling sequence table for the main functions is shown in the table below.
 600
 601 \begin{figure}[h]
 602 \begin{center}
 603 \begin{tabular}{|l|c|c|c|c|c|c|c|}
 604 \hline
 605 {\bf A Call to} & socket & connect & bindSocket & listen & accept & read & write \\
 606 \hline
 607 {\bf Precedes} & & & & & & & \\
 608 \hline
 609 socket &        &         &            &        &        &      & \\
 610 \hline
 611 connect & +     &         &            &        &        &      & \\
 612 \hline
 613 bindSocket & +  &         &            &        &        &      & \\
 614 \hline
 615 listen &        &         & +          &        &        &      & \\
 616 \hline
 617 accept &        &         &            &  +     &        &      & \\
 618 \hline
 619 read   &        &   +     &            &  +     &  +     &  +   & + \\
 620 \hline
 621 write  &        &   +     &            &  +     &  +     &  +   & + \\
 622 \hline
 623 \end{tabular}
 624 \caption{Sequence Table for Major functions of Socket}
 625 \label{tab:api-seq}
 626 \end{center}
 627 \end{figure}
 628
 629 %************************************************************************
 630 %*                                                                      *
 631 \subsection[Socket-OSDefs]{OS Dependent Definitions}
 632 %*                                                                      *
 633 %************************************************************************
 634
 635
 636 The following Family and Socket Type declarations were manually derived
 637 from @<sys/socket.h>@ on the appropriate machines.
 638
 639 Maybe a configure script that could parse the socket.h file to produce
 640 the following declaration is required to make it ``portable'' rather than
 641 using the dreaded \#ifdefs.
 642
 643 Presently only the following machine/os combinations are supported:
 644
 645 \begin{itemize}
 646 \item Intelx86/Linux
 647 \item SPARC/SunOS
 648 \item SPARC/Solaris
 649 \item Alpha/OSF
 650 \item HPPA/HPUX9
 651 \item MIPS/IRIX6.2
 652 \end{itemize}
 653
 654 \begin{code}
 655 unpackFamily    :: Int -> Family
 656 packFamily      :: Family -> Int
 657
 658 packSocketType  :: SocketType -> Int
 659
 660
 661 #if sunos4_TARGET_OS || solaris2_TARGET_OS
 662
 663 data Family =
 664           AF_UNSPEC     -- unspecified
 665         | AF_UNIX       -- local to host (pipes, portals
 666         | AF_INET       -- internetwork: UDP, TCP, etc
 667         | AF_IMPLINK    -- arpanet imp addresses
 668         | AF_PUP        -- pup protocols: e.g. BSP
 669         | AF_CHAOS      -- mit CHAOS protocols
 670         | AF_NS         -- XEROX NS protocols
 671         | AF_NBS        -- nbs protocols
 672         | AF_ECMA       -- european computer manufacturers
 673         | AF_DATAKIT    -- datakit protocols
 674         | AF_CCITT      -- CCITT protocols, X.25 etc
 675         | AF_SNA        -- IBM SNA
 676         | AF_DECnet     -- DECnet
 677         | AF_DLI        -- Direct data link interface
 678         | AF_LAT        -- LAT
 679         | AF_HYLINK     -- NSC Hyperchannel
 680         | AF_APPLETALK  -- Apple Talk
 681         | AF_NIT        -- Network Interface Tap
 682         | AF_802        -- IEEE 802.2, also ISO 8802
 683         | AF_OSI        -- umbrella of all families used by OSI
 684         | AF_X25        -- CCITT X.25
 685         | AF_OSINET     -- AFI
 686         | AF_GOSSIP     -- US Government OSI
 687         | AF_IPX        -- Novell Internet Protocol
 688         deriving (Eq, Ord, Ix, Show)
 689
 690 packFamily = index (AF_UNSPEC, AF_IPX)
 691 unpackFamily family = (range (AF_UNSPEC, AF_IPX))!!family
 692
 693 #endif
 694
 695 #if cygwin32_TARGET_OS
 696
 697 data Family =
 698           AF_UNSPEC     -- unspecified
 699         | AF_UNIX       -- local to host (pipes, portals)
 700         | AF_INET       -- internetwork: UDP, TCP, etc
 701         | AF_IMPLINK    -- arpanet imp addresses
 702         | AF_PUP        -- pup protocols: e.g. BSP
 703         | AF_CHAOS      -- mit CHAOS protocols
 704         | AF_NS         -- XEROX NS protocols
 705         | AF_ISO        -- ISO protocols
 706         | AF_OSI        -- OSI protocols
 707         | AF_ECMA       -- european computer manufacturers
 708         | AF_DATAKIT    -- datakit protocols
 709         | AF_CCITT      -- CCITT protocols, X.25 etc
 710         | AF_SNA        -- IBM SNA
 711         | AF_DECnet     -- DECnet
 712         | AF_DLI        -- Direct data link interface
 713         | AF_LAT        -- LAT
 714         | AF_HYLINK     -- NSC Hyperchannel
 715         | AF_APPLETALK  -- Apple Talk
 716         | AF_NETBIOS    -- NetBios-style addresses
 717         deriving (Eq, Ord, Ix, Show)
 718
 719 packFamily = index (AF_UNSPEC, AF_NETBIOS)
 720 unpackFamily family = (range (AF_UNSPEC, AF_NETBIOS))!!family
 721
 722
 723 #endif
 724
 725 #if hpux_TARGET_OS
 726
 727 data Family =
 728           AF_UNSPEC     -- unspecified
 729         | AF_UNIX       -- local to host (pipes, portals
 730         | AF_INET       -- internetwork: UDP, TCP, etc
 731         | AF_IMPLINK    -- arpanet imp addresses
 732         | AF_PUP        -- pup protocols: e.g. BSP
 733         | AF_CHAOS      -- mit CHAOS protocols
 734         | AF_NS         -- XEROX NS protocols
 735         | AF_NBS        -- nbs protocols
 736         | AF_ECMA       -- european computer manufacturers
 737         | AF_DATAKIT    -- datakit protocols
 738         | AF_CCITT      -- CCITT protocols, X.25 etc
 739         | AF_SNA        -- IBM SNA
 740         | AF_DECnet     -- DECnet
 741         | AF_DLI        -- Direct data link interface
 742         | AF_LAT        -- LAT
 743         | AF_HYLINK     -- NSC Hyperchannel
 744         | AF_APPLETALK  -- Apple Talk
 745         | AF_NIT        -- Network Interface Tap
 746         deriving (Eq, Ord, Ix, Show)
 747
 748 packFamily = index (AF_UNSPEC, AF_NIT)
 749 unpackFamily family = (range (AF_UNSPEC, AF_NIT))!!family
 750
 751 #endif
 752
 753 #if osf1_TARGET_OS || osf3_TARGET_OS
 754
 755 data Family =
 756           AF_UNSPEC     -- unspecified
 757         | AF_UNIX       -- local to host (pipes, portals)
 758         | AF_INET       -- internetwork: UDP, TCP, etc.
 759         | AF_IMPLINK    -- arpanet imp addresses
 760         | AF_PUP        -- pup protocols: e.g. BSP
 761         | AF_CHAOS      -- mit CHAOS protocols
 762         | AF_NS         -- XEROX NS protocols
 763         | AF_ISO        -- ISO protocols
 764         | AF_ECMA       -- european computer manufacturers
 765         | AF_DATAKIT    -- datakit protocols
 766         | AF_CCITT      -- CCITT protocols, X.25 etc
 767         | AF_SNA        -- IBM SNA
 768         | AF_DECnet     -- DECnet
 769         | AF_DLI        -- DEC Direct data link interface
 770         | AF_LAT        -- LAT
 771         | AF_HYLINK     -- NSC Hyperchannel
 772         | AF_APPLETALK  -- Apple Talk
 773         | AF_ROUTE      -- Internal Routing Protocol
 774         | AF_LINK       -- Link layer interface
 775         | Pseudo_AF_XTP -- eXpress Transfer Protocol (no AF)
 776         | AF_NETMAN     -- DNA Network Management
 777         | AF_X25        -- X25 protocol
 778         | AF_CTF        -- Common Trace Facility
 779         | AF_WAN        -- Wide Area Network protocols
 780         deriving (Eq, Ord, Ix, Show)
 781
 782 packFamily = index (AF_UNSPEC, AF_WAN)
 783 unpackFamily family = (range (AF_UNSPEC, AF_WAN))!!family
 784 #endif
 785
 786 #if linux_TARGET_OS
 787
 788 data Family =
 789           AF_UNSPEC
 790         | AF_UNIX
 791         | AF_INET
 792         | AF_AX25
 793         | AF_IPX
 794         deriving (Eq, Ord, Ix, Show)
 795
 796 packFamily = index (AF_UNSPEC, AF_IPX)
 797 unpackFamily family = (range (AF_UNSPEC, AF_IPX))!!family
 798
 799 #endif
 800
 801 #if irix_TARGET_OS
 802
 803 data Family =
 804           AF_UNSPEC             -- unspecified
 805         | AF_UNIX               -- backward compatibility
 806         | AF_INET               -- internetwork: UDP, TCP, etc.
 807         | AF_IMPLINK            -- arpanet imp addresses
 808         | AF_PUP                -- pup protocols: e.g. BSP
 809         | AF_CHAOS              -- mit CHAOS protocols
 810         | AF_NS                 -- XEROX NS protocols
 811         | AF_ISO                -- ISO protocols
 812         | AF_ECMA               -- european computer manufacturers
 813         | AF_DATAKIT            -- datakit protocols
 814         | AF_CCITT              -- CCITT protocols, X.25 etc
 815         | AF_SNA                -- IBM SNA
 816         | AF_DECnet             -- DECnet
 817         | AF_DLI                -- DEC Direct data link interface
 818         | AF_LAT                -- LAT
 819         | AF_HYLINK             -- NSC Hyperchannel
 820         | AF_APPLETALK          -- Apple Talk
 821         | AF_ROUTE              -- Internal Routing Protocol
 822         | AF_RAW                -- Link layer interface
 823
 824 -- these two overlap AF_ROUTE and AF_RAW
 825 --      | AF_NIT                -- Network Interface Tap
 826 --      | AF_802                -- IEEE 802.2, also ISO 8802
 827
 828         | AF_OSI                -- umbrella for all families used by OSI
 829         | AF_X25                -- CCITT X.25
 830         | AF_OSINET             -- AFI
 831         | AF_GOSIP              -- US Government OSI
 832
 833         | AF_SDL                -- SGI Data Link for DLPI
 834         | AF_INET6              -- Internet Protocol version 6
 835         | AF_LINK               -- Link layer interface
 836         deriving (Eq, Ord, Ix, Show)
 837
 838 packFamily = index (AF_UNSPEC, AF_LINK)
 839 unpackFamily family = (range (AF_UNSPEC, AF_LINK))!!family
 840
 841 #endif
 842
 843 #if aix_TARGET_OS
 844
 845 data Family =
 846         AF_UNSPEC       -- unspecified
 847       | AF_UNIX         -- local to host (pipes, portals)
 848       | AF_INET         -- internetwork: UDP, TCP, etc.
 849       | AF_IMPLINK      -- arpanet imp addresses
 850       | AF_PUP          -- pup protocols: e.g. BSP
 851       | AF_CHAOS        -- mit CHAOS protocols
 852       | AF_NS           -- XEROX NS protocols
 853       | AF_ISO          -- ISO protocols
 854 --    | AF_OSI is the same as AF_ISO on AIX
 855       | AF_ECMA         -- european computer manufacturers
 856       | AF_DATAKIT      -- datakit protocols
 857       | AF_CCITT        -- CCITT protocols, X.25 etc
 858       | AF_SNA          -- IBM SNA
 859       | AF_DECnet       -- DECnet
 860       | AF_DLI          -- DEC Direct data link interface
 861       | AF_LAT          -- LAT
 862       | AF_HYLINK       -- NSC Hyperchannel
 863       | AF_APPLETALK    -- Apple Talk
 864       | AF_ROUTE        -- Internal Routing Protocol
 865       | AF_LINK         -- Link layer interface
 866       | Pseudo_AF_XTP   -- eXpress Transfer Protocol (no AF)
 867       | AF_INTF         -- Debugging use only
 868       | AF_RIF          -- raw interface
 869       | AF_NETWARE
 870       | AF_NDD
 871       | AF_MAX
 872         deriving (Eq, Ord, Ix, Show)
 873
 874 packFamily = index (AF_UNSPEC, AF_MAX)
 875 unpackFamily family = (range (AF_UNSPEC, AF_MAX))!!family
 876
 877 #endif
 878
 879 #if freebsd_TARGET_OS
 880
 881 data Family =
 882         AF_UNSPEC       -- unspecified
 883       | AF_UNIX         -- local to host (pipes, portals)
 884       | AF_INET         -- internetwork: UDP, TCP, etc.
 885       | AF_IMPLINK      -- arpanet imp addresses
 886       | AF_PUP          -- pup protocols: e.g. BSP
 887       | AF_CHAOS        -- mit CHAOS protocols
 888       | AF_NS           -- XEROX NS protocols
 889       | AF_ISO          -- ISO protocols
 890 --    | AF_OSI is the same as AF_ISO
 891       | AF_ECMA         -- european computer manufacturers
 892       | AF_DATAKIT      -- datakit protocols
 893       | AF_CCITT        -- CCITT protocols, X.25 etc
 894       | AF_SNA          -- IBM SNA
 895       | AF_DECnet       -- DECnet
 896       | AF_DLI          -- DEC Direct data link interface
 897       | AF_LAT          -- LAT
 898       | AF_HYLINK       -- NSC Hyperchannel
 899       | AF_APPLETALK    -- Apple Talk
 900       | AF_ROUTE        -- Internal Routing Protocol
 901       | AF_LINK         -- Link layer interface
 902       | Pseudo_AF_XTP   -- eXpress Transfer Protocol (no AF)
 903       | AF_COIP         -- connection-oriented IP, aka ST II
 904       | AF_CNT          -- Computer Network Technology
 905       | Psuedo_AF_RTIP  -- Help Identify RTIP packets
 906       | AF_IPX          -- Novell Internet Protocol
 907       | AF_SIP          -- Simple Internet Protocol
 908       | Pseudo_AF_PIP   -- Help Identify PIP packets
 909       | AF_ISDN         -- Integrated Services Digital Network
 910 --    | AF_E164 is the same as AF_ISDN
 911       | Pseudo_AF_KEY   -- Internal key-management function
 912       | AF_INET6        -- IPv6
 913       | AF_MAX
 914         deriving (Eq, Ord, Ix, Show)
 915
 916 packFamily = index (AF_UNSPEC, AF_MAX)
 917 unpackFamily family = (range (AF_UNSPEC, AF_MAX))!!family
 918
 919 #endif
 920
 921 -- Alpha running OSF or a SPARC with SunOS, rather than Solaris.
 922
 923 #if osf1_TARGET_OS || osf3_TARGET_OS || sunos4_TARGET_OS || hpux_TARGET_OS || \
 924         aix_TARGET_OS || freebsd_TARGET_OS
 925 data SocketType =
 926           Stream
 927         | Datagram
 928         | Raw
 929         | RDM
 930         | SeqPacket
 931         deriving (Eq, Ord, Ix, Show)
 932
 933 packSocketType stype = 1 + (index (Stream, SeqPacket) stype)
 934 #endif
 935
 936 -- This is for a box running cygwin32 toolchain.
 937
 938 #if defined(cygwin32_TARGET_OS)
 939 data SocketType =
 940           Stream
 941         | Datagram
 942         | Raw
 943         | RDM       -- reliably delivered msg
 944         | SeqPacket
 945         | Packet
 946         deriving (Eq, Ord, Ix, Show)
 947
 948 packSocketType stype =
 949  case stype of
 950    Stream    -> ``SOCK_STREAM''
 951    Datagram  -> ``SOCK_DGRAM''
 952    Raw       -> ``SOCK_RAW''
 953    RDM       -> ``SOCK_RDM''
 954    SeqPacket -> ``SOCK_SEQPACKET''
 955    Packet    -> ``SOCK_PACKET''
 956
 957 #endif
 958
 959 -- This is a Sun running Solaris rather than SunOS or SGI running IRIX
 960
 961 #if defined(solaris2_TARGET_OS) || defined(irix_TARGET_OS)
 962 data SocketType =
 963           Datagram
 964         | Stream
 965         | NC_TPI_COTS_ORD
 966         | Raw
 967         | RDM
 968         | SeqPacket
 969         deriving (Eq, Ord, Ix, Show)
 970
 971 packSocketType stype = 1 + (index (Datagram, SeqPacket) stype)
 972 #endif
 973
 974
 975 #if linux_TARGET_OS
 976 data SocketType =
 977           Stream
 978         | Datagram
 979         | Raw
 980         | RDM
 981         | SeqPacket
 982         | Packet
 983         deriving (Eq, Ord, Ix, Show)
 984
 985 packSocketType stype = 1 + (index (Stream, Packet) stype)
 986 #endif
 987 \end{code}
 988
 989 %************************************************************************
 990 %*                                                                      *
 991 \subsection[Socket-Util]{Utility Functions}
 992 %*                                                                      *
 993 %************************************************************************
 994
 995 \begin{code}
 996 aNY_PORT :: PortNumber
 997 aNY_PORT = mkPortNumber 0
 998
 999 iNADDR_ANY :: HostAddress
1000 iNADDR_ANY = unsafePerformIO (_casm_ `` %r = htonl(INADDR_ANY); '')
1001
1002 sOMAXCONN = ``SOMAXCONN''::Int
1003 maxListenQueue = sOMAXCONN
1004
1005 -------------------------------------------------------------------------------
1006 data ShutdownCmd
1007  = ShutdownReceive
1008  | ShutdownSend
1009  | ShutdownBoth
1010
1011 sdownCmdToInt :: ShutdownCmd -> Int
1012 sdownCmdToInt ShutdownReceive = 0
1013 sdownCmdToInt ShutdownSend    = 1
1014 sdownCmdToInt ShutdownBoth    = 2
1015
1016 shutdown :: Socket -> ShutdownCmd -> IO ()
1017 shutdown (MkSocket s _ _ _ _) stype = do
1018   let t = sdownCmdToInt stype
1019   status <- _ccall_ shutdownSocket s t
1020   case status of
1021     -1 -> constructErrorAndFail "shutdown"
1022     _  -> return ()
1023
1024 -------------------------------------------------------------------------------
1025
1026 sClose   :: Socket -> IO ()
1027 sClose (MkSocket s family stype protocol status) = _ccall_ close s
1028
1029 -------------------------------------------------------------------------------
1030
1031 sIsConnected :: Socket -> IO Bool
1032 sIsConnected (MkSocket s family stype protocol status) = do
1033     value <- readIORef status
1034     return (value == Connected)
1035
1036 -------------------------------------------------------------------------------
1037
1038 sIsBound :: Socket -> IO Bool
1039 sIsBound (MkSocket s family stype protocol status) = do
1040     value <- readIORef status
1041     return (value == Bound)
1042
1043 -------------------------------------------------------------------------------
1044
1045 sIsListening :: Socket -> IO Bool
1046 sIsListening (MkSocket s family stype protocol status) = do
1047     value <- readIORef status
1048     return (value == Listening)
1049
1050 -------------------------------------------------------------------------------
1051
1052 sIsReadable  :: Socket -> IO Bool
1053 sIsReadable (MkSocket s family stype protocol status) = do
1054     value <- readIORef status
1055     return (value == Listening || value == Connected)
1056
1057 -------------------------------------------------------------------------------
1058
1059 sIsWritable  :: Socket -> IO Bool
1060 sIsWritable = sIsReadable
1061
1062 -------------------------------------------------------------------------------
1063
1064 sIsAcceptable :: Socket -> IO Bool
1065 #ifndef cygwin32_TARGET_OS
1066 sIsAcceptable (MkSocket s AF_UNIX Stream protocol status) = do
1067     value <- readIORef status
1068     return (value == Connected || value == Bound || value == Listening)
1069 sIsAcceptable (MkSocket s AF_UNIX _ protocol status) =
1070     return False
1071 #endif
1072 sIsAcceptable (MkSocket s _ stype protocol status) = do
1073     value <- readIORef status
1074     return (value == Connected || value == Listening)
1075
1076 -------------------------------------------------------------------------------
1077
1078 {-
1079 sSetBlocking :: Socket -> Bool -> IO ()
1080 sIsBlocking  :: Socket -> IO Bool
1081 -}
1082
1083 \end{code}
1084
1085 Internet address manipulation routines:
1086
1087 \begin{code}
1088 inet_addr :: String -> IO HostAddress
1089 inet_addr ipstr = do
1090    had <- _ccall_ inet_addr ipstr
1091    if had == (W# (int2Word# (negateInt# 1#))) -- hack to avoid depending on Int.intToWord here.
1092     then fail (userError ("inet_addr: Malformed address: " ++ ipstr))
1093     else return had  -- network byte order
1094
1095 inet_ntoa :: HostAddress -> IO String
1096 inet_ntoa haddr = do
1097   pstr <- _casm_ ``struct in_addr addr;
1098                    addr.s_addr = %0;
1099                    %r = inet_ntoa (addr);'' haddr
1100   -- unpack straight away, since pstr points to static buffer.
1101   unpackCStringIO pstr
1102
1103 \end{code}
1104
1105 Marshaling and allocation helper functions:
1106
1107 \begin{code}
1108 -------------------------------------------------------------------------------
1109
1110 allocSockAddr :: Family -> IO (MutableByteArray RealWorld Int, Int)
1111
1112 #ifndef cygwin32_TARGET_OS
1113 allocSockAddr AF_UNIX = do
1114     ptr <- stToIO (newCharArray (0,``sizeof(struct sockaddr_un)''))
1115     let (_,sz) = boundsOfByteArray ptr
1116     return (ptr, sz)
1117 #endif
1118
1119 allocSockAddr AF_INET = do
1120     ptr <- stToIO (newCharArray (0,``sizeof(struct sockaddr_in)''))
1121     let (_,sz) = boundsOfByteArray ptr
1122     return (ptr, sz)
1123
1124 -------------------------------------------------------------------------------
1125
1126 unpackSockAddr :: MutableByteArray RealWorld Int -> Int -> IO SockAddr
1127 unpackSockAddr arr len = do
1128     fam <- _casm_ ``%r = ((struct sockaddr*)%0)->sa_family;'' arr
1129     case unpackFamily fam of
1130 #ifndef cygwin32_TARGET_OS
1131         AF_UNIX -> unpackSockAddrUnix arr (len - ``sizeof(short)'')
1132 #endif
1133         AF_INET -> unpackSockAddrInet arr
1134
1135 -------------------------------------------------------------------------------
1136
1137 #ifndef cygwin32_TARGET_OS
1138
1139 {-
1140   sun_path is *not* NULL terminated, hence we *do* need to know the
1141   length of it.
1142 -}
1143 unpackSockAddrUnix :: (MutableByteArray RealWorld Int) -> Int -> IO SockAddr
1144 unpackSockAddrUnix ptr len = do
1145     char_star <- _casm_ ``%r = ((struct sockaddr_un*)%0)->sun_path;'' ptr
1146     path      <- unpackCStringLenIO char_star len
1147     return (SockAddrUnix path)
1148
1149 #endif
1150
1151 -------------------------------------------------------------------------------
1152
1153 unpackSockAddrInet :: (MutableByteArray RealWorld Int) -> IO SockAddr
1154 unpackSockAddrInet ptr = do
1155   port <- _casm_ ``%r = ((struct sockaddr_in*)%0)->sin_port;''        ptr
1156   addr <- _casm_ ``%r = ((struct sockaddr_in*)%0)->sin_addr.s_addr;'' ptr
1157   return (SockAddrInet (PNum port) addr)
1158
1159 -------------------------------------------------------------------------------
1160
1161
1162 packSockAddr :: SockAddr -> IO (MutableByteArray RealWorld Int)
1163 #ifndef cygwin32_TARGET_OS
1164 packSockAddr (SockAddrUnix path) = do
1165     (ptr,_) <- allocSockAddr AF_UNIX
1166     _casm_ ``(((struct sockaddr_un *)%0)->sun_family) = AF_UNIX;''    ptr
1167     _casm_ ``strcpy ((((struct sockaddr_un *)%0)->sun_path),%1);''    ptr path
1168     return ptr
1169 #endif
1170 packSockAddr (SockAddrInet (PNum port) address) = do
1171   (ptr,_) <- allocSockAddr AF_INET
1172   _casm_ ``(((struct sockaddr_in *)%0)->sin_family) = AF_INET;''  ptr
1173   _casm_ ``(((struct sockaddr_in *)%0)->sin_port) = (int)%1;''    ptr port
1174   _casm_ ``(((struct sockaddr_in *)%0)->sin_addr.s_addr) = %1;''  ptr address
1175   return ptr
1176
1177 -------------------------------------------------------------------------------
1178 \end{code}
1179
1180 @socketHandle@ turns a @Socket@ into a Haskell IO @Handle@. By default, the new
1181 handle will not be buffered, use @hSetBuffering@ if you want to change
1182 it subsequently.
1183
1184 \begin{code}
1185 #ifndef __PARALLEL_HASKELL__
1186 socketToHandle :: Socket -> IOMode -> IO Handle
1187
1188 socketToHandle (MkSocket fd family stype protocol status) m = do
1189     fo <- _ccall_ openFd fd file_mode flush_on_close
1190     fo <- makeForeignObj fo (``&freeFileObject'' :: Addr)
1191     mkBuffer__ fo 0  -- not buffered
1192     hndl <- newHandle (Handle__ fo htype NoBuffering socket_str)
1193     return hndl
1194  where
1195   socket_str = "<socket: "++show fd
1196   (flush_on_close, file_mode) =
1197    case m of
1198            AppendMode    -> (1, 0)
1199            WriteMode     -> (1, 1)
1200            ReadMode      -> (0, 2)
1201            ReadWriteMode -> (1, 3)
1202
1203   htype =
1204    case m of
1205      ReadMode      -> ReadHandle
1206      WriteMode     -> WriteHandle
1207      AppendMode    -> AppendHandle
1208      ReadWriteMode -> ReadWriteHandle
1209 #else
1210 socketToHandle (MkSocket s family stype protocol status) m =
1211   error "socketToHandle not implemented in a parallel setup"
1212 #endif
1213 \end{code}
1214