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