2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-1998
4 \section[SocketPrim]{Low-level socket bindings}
6 The @SocketPrim@ module is for when you want full control over the
7 sockets, exposing the C socket API.
10 {-# OPTIONS -#include "stgio.h" -#include "cbits/ghcSockets.h" #-}
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
32 socketPort, -- :: Socket -> IO PortNumber
34 writeSocket, -- :: Socket -> String -> IO Int
35 readSocket, -- :: Socket -> Int -> IO (String, Int)
36 readSocketAll, -- :: Socket -> IO String
38 socketToHandle, -- :: Socket -> IO Handle
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
46 inet_addr, -- :: String -> IO HostAddress
47 inet_ntoa, -- :: HostAddress -> IO String
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 ()
59 getSocketOption, -- :: Socket -> SocketOption -> IO Int
60 setSocketOption, -- :: Socket -> SocketOption -> Int -> IO ()
63 mkPortNumber, -- :: Int -> PortNumber
73 -- The following are exported ONLY for use in the BSD module and
74 -- should not be used anywhere else.
76 packFamily, unpackFamily,
78 packSockAddr, unpackSockAddr
80 , withSocketsDo -- :: IO a -> IO a
87 import Weak ( addForeignFinalizer )
88 import PrelIOBase -- IOError, Handle representation
91 import Addr ( nullAddr )
94 import IOExts ( IORef, newIORef, readIORef, writeIORef )
95 import CString ( unpackNBytesBAIO,
103 %************************************************************************
105 \subsection[Socket-SocketTypes]{Socket Types}
107 %************************************************************************
110 There are a few possible ways to do this. The first is convert the
111 structs used in the C library into an equivalent Haskell type. An
112 other possible implementation is to keep all the internals in the C
113 code and use an Int\# and a status flag. The second method is used here
114 since a lot of the C structures are not required to be manipulated.
116 Originally the status was non-mutable so we had to return a new socket
117 each time we changed the status. This version now uses mutable
118 variables to avoid the need to do this. The result is a cleaner
119 interface and better security since the application programmer now
120 can't circumvent the status information to perform invalid operations
125 -- Returned Status Function called
126 = NotConnected -- socket
127 | Bound -- bindSocket
128 | Listening -- listen
129 | Connected -- connect/accept
130 | Error String -- Any
135 Int -- File Descriptor
138 Int -- Protocol Number
139 (IORef SocketStatus) -- Status Flag
142 The scheme used for addressing sockets is somewhat quirky. The
143 calls in the BSD socket API that need to know the socket address all
144 operate in terms of \tr{struct sockaddr}, a `virtual' type of socket address.
146 The Internet family of sockets are addressed as \tr{struct sockaddr\_in},
147 so when calling functions that operate on \tr{struct sockaddr}, we have
148 to type cast the Internet socket address into a \tr{struct sockaddr}. By luck(!),
149 the two structures are of the same size. Same casting is required of other
150 families of sockets such as Xerox NS. Similarly for Unix domain sockets.
152 To represent these socket addresses in Haskell-land, we do what BSD didn't do,
153 and use a union/algebraic type for the different families. Currently only
154 Unix domain sockets and the Internet family is supported.
158 -- NOTE: HostAddresses are represented in network byte order.
159 -- Functions that expect the address in machine byte order
160 -- will have to perform the necessary translation.
161 type HostAddress = Word
164 -- newtyped to prevent accidental use of sane-looking
165 -- port numbers that haven't actually been converted to
166 -- network-byte-order first.
168 newtype PortNumber = PNum Int -- 16-bit value stored in network byte order.
171 instance Show PortNumber where
172 showsPrec p pn = showsPrec p (ntohs pn)
174 mkPortNumber :: Int -> PortNumber
175 mkPortNumber v = unsafePerformIO $ do
176 po <- _casm_ ``%r=(int)htons((int)%0); '' v
179 ntohs :: PortNumber -> Int
180 ntohs (PNum po) = unsafePerformIO (_casm_ ``%r=(int)ntohs((int)%0); '' po)
182 instance Num PortNumber where
183 fromInt i = mkPortNumber i
184 fromInteger i = fromInt (fromInteger i)
186 (+) x y = mkPortNumber (ntohs x + ntohs y)
187 (-) x y = mkPortNumber (ntohs x - ntohs y)
188 negate x = mkPortNumber (-ntohs x)
189 (*) x y = mkPortNumber (ntohs x * ntohs y)
190 abs n = mkPortNumber (abs (ntohs n))
191 signum n = mkPortNumber (signum (ntohs n))
193 data SockAddr -- C Names
194 #if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
195 = SockAddrUnix -- struct sockaddr_un
197 | SockAddrInet -- struct sockaddr_in
198 PortNumber -- sin_port (network byte order)
199 HostAddress -- sin_addr (ditto)
201 = SockAddrInet -- struct sockaddr_in
202 PortNumber -- sin_port (network byte order)
203 HostAddress -- sin_addr (ditto)
208 type ProtocolNumber = Int
213 %************************************************************************
215 \subsection[Socket-Connections]{Connection Functions}
217 %************************************************************************
219 In the following connection and binding primitives. The names of the
220 equivalent C functions have been preserved where possible. It should
221 be noted that some of these names used in the C library, \tr{bind} in
222 particular, have a different meaning to many Haskell programmers and
223 have thus been renamed by appending the prefix Socket.
225 Create an unconnected socket of the given family, type and protocol.
226 The most common invocation of $socket$ is the following:
230 my_socket <- socket AF_INET Stream 6
235 socket :: Family -- Family Name (usually AF_INET)
236 -> SocketType -- Socket Type (usually Stream)
237 -> ProtocolNumber -- Protocol Number (getProtocolByName to find value)
238 -> IO Socket -- Unconnected Socket
240 socket family stype protocol = do
241 status <- _ccall_ createSocket (packFamily family)
242 (packSocketType stype)
244 case (status::Int) of
245 -1 -> constructErrorAndFail "socket"
247 socket_status <- newIORef NotConnected
248 return (MkSocket n family stype protocol socket_status)
251 Given a port number this {\em binds} the socket to that port. This
252 means that the programmer is only interested in data being sent to
253 that port number. The $Family$ passed to $bindSocket$ must
254 be the same as that passed to $socket$. If the special port
255 number $aNY\_PORT$ is passed then the system assigns the next
258 Port numbers for standard unix services can be found by calling
259 $getServiceEntry$. These are traditionally port numbers below
260 1000; although there are afew, namely NFS and IRC, which used higher
263 The port number allocated to a socket bound by using $aNY\_PORT$ can be
264 found by calling $port$
267 bindSocket :: Socket -- Unconnected Socket
268 -> SockAddr -- Address to Bind to
271 bindSocket (MkSocket s _family _stype _protocol socketStatus) addr = do
272 #if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
273 let isDomainSocket = if _family == AF_UNIX then 1 else (0::Int)
275 let isDomainSocket = 0
277 currentStatus <- readIORef socketStatus
278 if currentStatus /= NotConnected
280 ioError (userError ("bindSocket: can't peform bind on socket in status " ++
283 addr' <- packSockAddr addr
284 let (_,sz) = boundsOfMutableByteArray addr'
285 status <- _ccall_ bindSocket s addr' sz (isDomainSocket::Int)
286 case (status::Int) of
287 -1 -> constructErrorAndFail "bindSocket"
288 _ -> writeIORef socketStatus (Bound)
292 Make a connection to an already opened socket on a given machine and port.
293 assumes that we have already called createSocket, otherwise it will fail.
295 This is the dual to $bindSocket$. The {\em server} process will
296 usually bind to a port number, the {\em client} will then connect to
297 the same port number. Port numbers of user applications are normally
298 agreed in advance, otherwise we must rely on some meta protocol for telling
299 the other side what port number we have been allocated.
302 connect :: Socket -- Unconnected Socket
303 -> SockAddr -- Socket address stuff
306 connect (MkSocket s _family _stype _protocol socketStatus) addr = do
308 let isDomainSocket = if _family == AF_UNIX then 1 else (0::Int)
310 let isDomainSocket = 0
312 currentStatus <- readIORef socketStatus
313 if currentStatus /= NotConnected
315 ioError (userError ("connect: can't peform connect on socket in status " ++
318 addr' <- packSockAddr addr
319 let (_,sz) = boundsOfMutableByteArray addr'
320 status <- _ccall_ connectSocket s addr' sz (isDomainSocket::Int)
321 case (status::Int) of
322 -1 -> constructErrorAndFail "connect"
323 _ -> writeIORef socketStatus Connected
326 The programmer must call $listen$ to tell the system software
327 that they are now interested in receiving data on this port. This
328 must be called on the bound socket before any calls to read or write
331 The programmer also gives a number which indicates the length of the
332 incoming queue of unread messages for this socket. On most systems the
333 maximum queue length is around 5. To remove a message from the queue
334 for processing a call to $accept$ should be made.
337 listen :: Socket -- Connected & Bound Socket
338 -> Int -- Queue Length
341 listen (MkSocket s _family _stype _protocol socketStatus) backlog = do
342 currentStatus <- readIORef socketStatus
343 if currentStatus /= Bound
345 ioError (userError ("listen: can't peform listen on socket in status " ++
348 status <- _ccall_ listenSocket s backlog
349 case (status::Int) of
350 -1 -> constructErrorAndFail "listen"
351 _ -> writeIORef socketStatus Listening
354 A call to $accept$ only returns when data is available on the given
355 socket, unless the socket has been set to non-blocking. It will
356 return a new socket which should be used to read the incoming data and
357 should then be closed. Using the socket returned by $accept$ allows
358 incoming requests to be queued on the original socket.
361 accept :: Socket -- Queue Socket
362 -> IO (Socket, -- Readable Socket
363 SockAddr) -- Peer details
365 accept sock@(MkSocket s family stype protocol status) = do
366 currentStatus <- readIORef status
367 okay <- sIsAcceptable sock
370 ioError (userError ("accept: can't peform accept on socket in status " ++
373 (ptr, sz) <- allocSockAddr family
374 int_star <- stToIO (newIntArray ((0::Int),1))
375 stToIO (writeIntArray int_star 0 sz)
376 new_sock <- _ccall_ acceptSocket s ptr int_star
377 case (new_sock::Int) of
378 -1 -> constructErrorAndFail "accept"
380 a_sz <- stToIO (readIntArray int_star 0)
381 addr <- unpackSockAddr ptr a_sz
382 new_status <- newIORef Connected
383 return ((MkSocket new_sock family stype protocol new_status), addr)
386 %************************************************************************
388 \subsection[Socket-DataPass]{Data Passing Primitives}
390 %************************************************************************
392 To allow Haskell to talk to C programs we need to be able to
393 communicate in terms of byte streams. @writeSocket@ and
394 @readSocket@ should only be used for this purpose and not for
395 communication between Haskell programs. Haskell programs should use
396 the 1.3 IO hPutStr and associated machinery for communicating with
401 writeSocket :: Socket -- Connected Socket
402 -> String -- Data to send
403 -> IO Int -- Number of Bytes sent
405 writeSocket (MkSocket s _family _stype _protocol status) xs = do
406 currentStatus <- readIORef status
407 if not ((currentStatus == Connected) || (currentStatus == Listening))
409 ioError (userError ("writeSocket: can't peform write on socket in status " ++
412 nbytes <- _ccall_ writeDescriptor s xs (length xs)
413 case (nbytes::Int) of
414 -1 -> constructErrorAndFail "writeSocket"
418 sendTo :: Socket -- Bound/Connected Socket
419 -> String -- Data to send
421 -> IO Int -- Number of Bytes sent
423 sendTo (MkSocket s _family _stype _protocol status) xs addr = do
424 currentStatus <- readIORef status
425 if not ((currentStatus == Connected) || (currentStatus == Listening) || (currentStatus == Bound))
427 ioError (userError ("sendTo: can't peform write on socket in status " ++
430 addr' <- packSockAddr addr
431 let (_,sz) = boundsOfMutableByteArray addr'
432 nbytes <- _ccall_ sendTo__ s xs (length xs) addr' sz
433 case (nbytes::Int) of
434 -1 -> constructErrorAndFail "sendTo"
437 readSocket :: Socket -- Connected (or bound) Socket
438 -> Int -- Number of Bytes to Read
439 -> IO (String, Int) -- (Data Read, Number of Bytes)
441 readSocket (MkSocket s _family _stype _protocol status) nbytes = do
442 currentStatus <- readIORef status
443 if not ((currentStatus == Connected) || (currentStatus == Listening))
445 ioError (userError ("readSocket: can't perform read on socket in status " ++
448 ptr <- allocChars nbytes
449 rlen <- _ccall_ readDescriptor s ptr nbytes
451 -1 -> constructErrorAndFail "readSocket"
453 barr <- stToIO (unsafeFreezeByteArray ptr)
454 str <- unpackNBytesBAIO barr n
457 readSocketAll :: Socket -> IO String
462 (readSocket s 4096 >>= \ (str, nbytes) ->
471 recvFrom :: Socket -> Int -> IO (String, Int, SockAddr)
472 recvFrom (MkSocket s _family _stype _protocol status) nbytes = do
473 currentStatus <- readIORef status
474 if not ((currentStatus == Connected) || (currentStatus == Listening) || (currentStatus == Bound))
476 ioError (userError ("recvFrom: can't perform read on socket in status " ++
479 ptr <- allocChars nbytes
480 (ptr_addr,_) <- allocSockAddr AF_INET
481 rlen <- _ccall_ recvFrom__ s ptr nbytes ptr_addr
483 -1 -> constructErrorAndFail "recvFrom"
485 barr <- stToIO (unsafeFreezeByteArray ptr)
486 addr <- unpackSockAddrInet ptr_addr
487 str <- unpackNBytesBAIO barr n
488 return (str, n, addr)
492 The port number the given socket is currently connected to can be
493 determined by calling $port$, is generally only useful when bind
494 was given $aNY\_PORT$.
497 socketPort :: Socket -- Connected & Bound Socket
498 -> IO PortNumber -- Port Number of Socket
499 socketPort sock@(MkSocket _ AF_INET _ _ _) =
500 getSocketName sock >>= \(SockAddrInet port _) ->
502 socketPort (MkSocket _ family _ _ _) =
503 ioError (userError ("socketPort: not supported for Family " ++ show family))
506 Calling $getPeerName$ returns the address details of the machine,
507 other than the local one, which is connected to the socket. This is
508 used in programs such as FTP to determine where to send the returning
509 data. The corresponding call to get the details of the local machine
513 getPeerName :: Socket -> IO SockAddr
515 getPeerName (MkSocket s family _ _ _) = do
516 (ptr, a_sz) <- allocSockAddr family
517 int_star <- stToIO (newIntArray ((0::Int),1))
518 stToIO (writeIntArray int_star 0 a_sz)
519 status <- _ccall_ getPeerName s ptr int_star
520 case (status::Int) of
521 -1 -> constructErrorAndFail "getPeerName"
523 sz <- stToIO (readIntArray int_star 0)
524 unpackSockAddr ptr sz
526 getSocketName :: Socket -> IO SockAddr
528 getSocketName (MkSocket s family _ _ _) = do
529 (ptr, a_sz) <- allocSockAddr family
530 int_star <- stToIO (newIntArray ((0::Int),1))
531 stToIO (writeIntArray int_star 0 a_sz)
532 rc <- _ccall_ getSockName s ptr int_star
534 -1 -> constructErrorAndFail "getSocketName"
536 sz <- stToIO (readIntArray int_star 0)
537 unpackSockAddr ptr sz
543 %************************************************************************
545 \subsection[Socket-Properties]{Socket Properties}
547 %************************************************************************
551 = Debug {- SO_DEBUG -}
552 | ReuseAddr {- SO_REUSEADDR -}
554 | SoError {- SO_ERROR -}
555 | DontRoute {- SO_DONTROUTE -}
556 | Broadcast {- SO_BROADCAST -}
557 | SendBuffer {- SO_SNDBUF -}
558 | RecvBuffer {- SO_RCVBUF -}
559 | KeepAlive {- SO_KEEPALIVE -}
560 | OOBInline {- SO_OOBINLINE -}
562 | MaxSegment {- TCP_MAXSEG -}
564 | NoDelay {- TCP_NODELAY -}
565 -- | Linger {- SO_LINGER -}
567 | ReusePort {- SO_REUSEPORT -} -- BSD only?
568 | RecvLowWater {- SO_RCVLOWAT -}
569 | SendLowWater {- SO_SNDLOWAT -}
570 | RecvTimeOut {- SO_RCVTIMEO -}
571 | SendTimeOut {- SO_SNDTIMEO -}
572 | UseLoopBack {- SO_USELOOPBACK -} -- not used, I believe.
575 packSocketOption :: SocketOption -> Int
576 packSocketOption so =
578 Debug -> ``SO_DEBUG''
579 ReuseAddr -> ``SO_REUSEADDR''
581 SoError -> ``SO_ERROR''
582 DontRoute -> ``SO_DONTROUTE''
583 Broadcast -> ``SO_BROADCAST''
584 SendBuffer -> ``SO_SNDBUF''
585 RecvBuffer -> ``SO_RCVBUF''
586 KeepAlive -> ``SO_KEEPALIVE''
587 OOBInline -> ``SO_OOBINLINE''
589 MaxSegment -> ``TCP_MAXSEG''
591 NoDelay -> ``TCP_NODELAY''
593 ReusePort -> ``SO_REUSEPORT'' -- BSD only?
594 RecvLowWater -> ``SO_RCVLOWAT''
595 SendLowWater -> ``SO_SNDLOWAT''
596 RecvTimeOut -> ``SO_RCVTIMEO''
597 SendTimeOut -> ``SO_SNDTIMEO''
598 UseLoopBack -> ``SO_USELOOPBACK''
601 setSocketOption :: Socket
602 -> SocketOption -- Option Name
603 -> Int -- Option Value
605 setSocketOption (MkSocket s _ _ _ _) so v = do
606 rc <- _ccall_ setSocketOption__ s (packSocketOption so) v
608 then constructErrorAndFail "setSocketOption"
611 getSocketOption :: Socket
612 -> SocketOption -- Option Name
613 -> IO Int -- Option Value
614 getSocketOption (MkSocket s _ _ _ _) so = do
615 rc <- _ccall_ getSocketOption__ s (packSocketOption so)
616 if rc == -1 -- let's just hope that value isn't taken..
617 then constructErrorAndFail "getSocketOption"
622 A calling sequence table for the main functions is shown in the table below.
626 \begin{tabular}{|l|c|c|c|c|c|c|c|}
628 {\bf A Call to} & socket & connect & bindSocket & listen & accept & read & write \\
630 {\bf Precedes} & & & & & & & \\
632 socket & & & & & & & \\
634 connect & + & & & & & & \\
636 bindSocket & + & & & & & & \\
638 listen & & & + & & & & \\
640 accept & & & & + & & & \\
642 read & & + & & + & + & + & + \\
644 write & & + & & + & + & + & + \\
647 \caption{Sequence Table for Major functions of Socket}
652 %************************************************************************
654 \subsection[Socket-OSDefs]{OS Dependent Definitions}
656 %************************************************************************
659 The following Family and Socket Type declarations were manually derived
660 from @<sys/socket.h>@ on the appropriate machines.
662 Maybe a configure script that could parse the socket.h file to produce
663 the following declaration is required to make it ``portable'' rather than
664 using the dreaded \#ifdefs.
666 Presently only the following machine/os combinations are supported:
678 unpackFamily :: Int -> Family
679 packFamily :: Family -> Int
681 packSocketType :: SocketType -> Int
684 #if sunos4_TARGET_OS || solaris2_TARGET_OS
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_NBS -- nbs protocols
695 | AF_ECMA -- european computer manufacturers
696 | AF_DATAKIT -- datakit protocols
697 | AF_CCITT -- CCITT protocols, X.25 etc
699 | AF_DECnet -- DECnet
700 | AF_DLI -- Direct data link interface
702 | AF_HYLINK -- NSC Hyperchannel
703 | AF_APPLETALK -- Apple Talk
704 | AF_NIT -- Network Interface Tap
705 | AF_802 -- IEEE 802.2, also ISO 8802
706 | AF_OSI -- umbrella of all families used by OSI
707 | AF_X25 -- CCITT X.25
709 | AF_GOSSIP -- US Government OSI
710 | AF_IPX -- Novell Internet Protocol
711 deriving (Eq, Ord, Ix, Show)
713 packFamily = index (AF_UNSPEC, AF_IPX)
714 unpackFamily family = (range (AF_UNSPEC, AF_IPX))!!family
718 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
721 AF_UNSPEC -- unspecified
722 | AF_UNIX -- local to host (pipes, portals)
723 | AF_INET -- internetwork: UDP, TCP, etc
724 | AF_IMPLINK -- arpanet imp addresses
725 | AF_PUP -- pup protocols: e.g. BSP
726 | AF_CHAOS -- mit CHAOS protocols
727 | AF_NS -- XEROX NS protocols
728 | AF_ISO -- ISO protocols
729 | AF_OSI -- OSI protocols
730 | AF_ECMA -- european computer manufacturers
731 | AF_DATAKIT -- datakit protocols
732 | AF_CCITT -- CCITT protocols, X.25 etc
734 | AF_DECnet -- DECnet
735 | AF_DLI -- Direct data link interface
737 | AF_HYLINK -- NSC Hyperchannel
738 | AF_APPLETALK -- Apple Talk
739 | AF_NETBIOS -- NetBios-style addresses
740 deriving (Eq, Ord, Ix, Show)
742 packFamily = index (AF_UNSPEC, AF_NETBIOS)
743 unpackFamily family = (range (AF_UNSPEC, AF_NETBIOS))!!family
751 AF_UNSPEC -- unspecified
752 | AF_UNIX -- local to host (pipes, portals
753 | AF_INET -- internetwork: UDP, TCP, etc
754 | AF_IMPLINK -- arpanet imp addresses
755 | AF_PUP -- pup protocols: e.g. BSP
756 | AF_CHAOS -- mit CHAOS protocols
757 | AF_NS -- XEROX NS protocols
758 | AF_NBS -- nbs protocols
759 | AF_ECMA -- european computer manufacturers
760 | AF_DATAKIT -- datakit protocols
761 | AF_CCITT -- CCITT protocols, X.25 etc
763 | AF_DECnet -- DECnet
764 | AF_DLI -- Direct data link interface
766 | AF_HYLINK -- NSC Hyperchannel
767 | AF_APPLETALK -- Apple Talk
768 | AF_NIT -- Network Interface Tap
769 deriving (Eq, Ord, Ix, Show)
771 packFamily = index (AF_UNSPEC, AF_NIT)
772 unpackFamily family = (range (AF_UNSPEC, AF_NIT))!!family
776 #if osf1_TARGET_OS || osf3_TARGET_OS
779 AF_UNSPEC -- unspecified
780 | AF_UNIX -- local to host (pipes, portals)
781 | AF_INET -- internetwork: UDP, TCP, etc.
782 | AF_IMPLINK -- arpanet imp addresses
783 | AF_PUP -- pup protocols: e.g. BSP
784 | AF_CHAOS -- mit CHAOS protocols
785 | AF_NS -- XEROX NS protocols
786 | AF_ISO -- ISO protocols
787 | AF_ECMA -- european computer manufacturers
788 | AF_DATAKIT -- datakit protocols
789 | AF_CCITT -- CCITT protocols, X.25 etc
791 | AF_DECnet -- DECnet
792 | AF_DLI -- DEC Direct data link interface
794 | AF_HYLINK -- NSC Hyperchannel
795 | AF_APPLETALK -- Apple Talk
796 | AF_ROUTE -- Internal Routing Protocol
797 | AF_LINK -- Link layer interface
798 | Pseudo_AF_XTP -- eXpress Transfer Protocol (no AF)
799 | AF_NETMAN -- DNA Network Management
800 | AF_X25 -- X25 protocol
801 | AF_CTF -- Common Trace Facility
802 | AF_WAN -- Wide Area Network protocols
803 deriving (Eq, Ord, Ix, Show)
805 packFamily = index (AF_UNSPEC, AF_WAN)
806 unpackFamily family = (range (AF_UNSPEC, AF_WAN))!!family
817 deriving (Eq, Ord, Ix, Show)
819 packFamily = index (AF_UNSPEC, AF_IPX)
820 unpackFamily family = (range (AF_UNSPEC, AF_IPX))!!family
827 AF_UNSPEC -- unspecified
828 | AF_UNIX -- backward compatibility
829 | AF_INET -- internetwork: UDP, TCP, etc.
830 | AF_IMPLINK -- arpanet imp addresses
831 | AF_PUP -- pup protocols: e.g. BSP
832 | AF_CHAOS -- mit CHAOS protocols
833 | AF_NS -- XEROX NS protocols
834 | AF_ISO -- ISO protocols
835 | AF_ECMA -- european computer manufacturers
836 | AF_DATAKIT -- datakit protocols
837 | AF_CCITT -- CCITT protocols, X.25 etc
839 | AF_DECnet -- DECnet
840 | AF_DLI -- DEC Direct data link interface
842 | AF_HYLINK -- NSC Hyperchannel
843 | AF_APPLETALK -- Apple Talk
844 | AF_ROUTE -- Internal Routing Protocol
845 | AF_RAW -- Link layer interface
847 -- these two overlap AF_ROUTE and AF_RAW
848 -- | AF_NIT -- Network Interface Tap
849 -- | AF_802 -- IEEE 802.2, also ISO 8802
851 | AF_OSI -- umbrella for all families used by OSI
852 | AF_X25 -- CCITT X.25
854 | AF_GOSIP -- US Government OSI
856 | AF_SDL -- SGI Data Link for DLPI
857 | AF_INET6 -- Internet Protocol version 6
858 | AF_LINK -- Link layer interface
859 deriving (Eq, Ord, Ix, Show)
861 packFamily = index (AF_UNSPEC, AF_LINK)
862 unpackFamily family = (range (AF_UNSPEC, AF_LINK))!!family
869 AF_UNSPEC -- unspecified
870 | AF_UNIX -- local to host (pipes, portals)
871 | AF_INET -- internetwork: UDP, TCP, etc.
872 | AF_IMPLINK -- arpanet imp addresses
873 | AF_PUP -- pup protocols: e.g. BSP
874 | AF_CHAOS -- mit CHAOS protocols
875 | AF_NS -- XEROX NS protocols
876 | AF_ISO -- ISO protocols
877 -- | AF_OSI is the same as AF_ISO on AIX
878 | AF_ECMA -- european computer manufacturers
879 | AF_DATAKIT -- datakit protocols
880 | AF_CCITT -- CCITT protocols, X.25 etc
882 | AF_DECnet -- DECnet
883 | AF_DLI -- DEC Direct data link interface
885 | AF_HYLINK -- NSC Hyperchannel
886 | AF_APPLETALK -- Apple Talk
887 | AF_ROUTE -- Internal Routing Protocol
888 | AF_LINK -- Link layer interface
889 | Pseudo_AF_XTP -- eXpress Transfer Protocol (no AF)
890 | AF_INTF -- Debugging use only
891 | AF_RIF -- raw interface
895 deriving (Eq, Ord, Ix, Show)
897 packFamily = index (AF_UNSPEC, AF_MAX)
898 unpackFamily family = (range (AF_UNSPEC, AF_MAX))!!family
902 #if freebsd2_TARGET_OS || freebsd3_TARGET_OS
905 AF_UNSPEC -- unspecified
906 | AF_UNIX -- local to host (pipes, portals)
907 | AF_INET -- internetwork: UDP, TCP, etc.
908 | AF_IMPLINK -- arpanet imp addresses
909 | AF_PUP -- pup protocols: e.g. BSP
910 | AF_CHAOS -- mit CHAOS protocols
911 | AF_NS -- XEROX NS protocols
912 | AF_ISO -- ISO protocols
913 -- | AF_OSI is the same as AF_ISO
914 | AF_ECMA -- european computer manufacturers
915 | AF_DATAKIT -- datakit protocols
916 | AF_CCITT -- CCITT protocols, X.25 etc
918 | AF_DECnet -- DECnet
919 | AF_DLI -- DEC Direct data link interface
921 | AF_HYLINK -- NSC Hyperchannel
922 | AF_APPLETALK -- Apple Talk
923 | AF_ROUTE -- Internal Routing Protocol
924 | AF_LINK -- Link layer interface
925 | Pseudo_AF_XTP -- eXpress Transfer Protocol (no AF)
926 | AF_COIP -- connection-oriented IP, aka ST II
927 | AF_CNT -- Computer Network Technology
928 | Psuedo_AF_RTIP -- Help Identify RTIP packets
929 | AF_IPX -- Novell Internet Protocol
930 | AF_SIP -- Simple Internet Protocol
931 | Pseudo_AF_PIP -- Help Identify PIP packets
932 | AF_ISDN -- Integrated Services Digital Network
933 -- | AF_E164 is the same as AF_ISDN
934 | Pseudo_AF_KEY -- Internal key-management function
937 deriving (Eq, Ord, Ix, Show)
939 packFamily = index (AF_UNSPEC, AF_MAX)
940 unpackFamily family = (range (AF_UNSPEC, AF_MAX))!!family
944 -- Alpha running OSF or a SPARC with SunOS, rather than Solaris.
946 #if osf1_TARGET_OS || osf3_TARGET_OS || sunos4_TARGET_OS || hpux_TARGET_OS || \
947 aix_TARGET_OS || freebsd2_TARGET_OS || freebsd3_TARGET_OS
954 deriving (Eq, Ord, Ix, Show)
956 packSocketType stype = 1 + (index (Stream, SeqPacket) stype)
959 -- This is for a box running cygwin32 toolchain.
966 | RDM -- reliably delivered msg
968 deriving (Eq, Ord, Ix, Show)
970 packSocketType stype =
972 Stream -> ``SOCK_STREAM''
973 Datagram -> ``SOCK_DGRAM''
976 SeqPacket -> ``SOCK_SEQPACKET''
980 -- This is a Sun running Solaris rather than SunOS or SGI running IRIX
982 #if defined(solaris2_TARGET_OS) || defined(irix_TARGET_OS)
990 deriving (Eq, Ord, Ix, Show)
992 packSocketType stype = 1 + (index (Datagram, SeqPacket) stype)
1004 deriving (Eq, Ord, Ix, Show)
1006 packSocketType stype = 1 + (index (Stream, Packet) stype)
1010 %************************************************************************
1012 \subsection[Socket-Util]{Utility Functions}
1014 %************************************************************************
1017 aNY_PORT :: PortNumber
1018 aNY_PORT = mkPortNumber 0
1020 iNADDR_ANY :: HostAddress
1021 iNADDR_ANY = unsafePerformIO (_casm_ `` %r = htonl(INADDR_ANY); '')
1024 sOMAXCONN = ``SOMAXCONN''
1026 maxListenQueue :: Int
1027 maxListenQueue = sOMAXCONN
1029 -------------------------------------------------------------------------------
1035 sdownCmdToInt :: ShutdownCmd -> Int
1036 sdownCmdToInt ShutdownReceive = 0
1037 sdownCmdToInt ShutdownSend = 1
1038 sdownCmdToInt ShutdownBoth = 2
1040 shutdown :: Socket -> ShutdownCmd -> IO ()
1041 shutdown (MkSocket s _ _ _ _) stype = do
1042 let t = sdownCmdToInt stype
1043 status <- _ccall_ shutdownSocket s t
1044 case (status::Int) of
1045 -1 -> constructErrorAndFail "shutdown"
1048 -------------------------------------------------------------------------------
1050 sClose :: Socket -> IO ()
1051 sClose (MkSocket s _ _ _ _) = _ccall_ close s
1053 -------------------------------------------------------------------------------
1055 sIsConnected :: Socket -> IO Bool
1056 sIsConnected (MkSocket _ _ _ _ status) = do
1057 value <- readIORef status
1058 return (value == Connected)
1060 -------------------------------------------------------------------------------
1062 sIsBound :: Socket -> IO Bool
1063 sIsBound (MkSocket _ _ _ _ status) = do
1064 value <- readIORef status
1065 return (value == Bound)
1067 -------------------------------------------------------------------------------
1069 sIsListening :: Socket -> IO Bool
1070 sIsListening (MkSocket _ _ _ _ status) = do
1071 value <- readIORef status
1072 return (value == Listening)
1074 -------------------------------------------------------------------------------
1076 sIsReadable :: Socket -> IO Bool
1077 sIsReadable (MkSocket _ _ _ _ status) = do
1078 value <- readIORef status
1079 return (value == Listening || value == Connected)
1081 -------------------------------------------------------------------------------
1083 sIsWritable :: Socket -> IO Bool
1084 sIsWritable = sIsReadable -- sort of.
1086 -------------------------------------------------------------------------------
1088 sIsAcceptable :: Socket -> IO Bool
1089 #if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
1090 sIsAcceptable (MkSocket _ AF_UNIX Stream _ status) = do
1091 value <- readIORef status
1092 return (value == Connected || value == Bound || value == Listening)
1093 sIsAcceptable (MkSocket _ AF_UNIX _ _ _) = return False
1095 sIsAcceptable (MkSocket _ _ _ _ status) = do
1096 value <- readIORef status
1097 return (value == Connected || value == Listening)
1099 -------------------------------------------------------------------------------
1102 sSetBlocking :: Socket -> Bool -> IO ()
1103 sIsBlocking :: Socket -> IO Bool
1108 Internet address manipulation routines:
1111 inet_addr :: String -> IO HostAddress
1112 inet_addr ipstr = do
1113 had <- _ccall_ inet_addr ipstr
1114 if had == (W# (int2Word# (negateInt# 1#))) -- hack to avoid depending on Int.intToWord here.
1115 then ioError (userError ("inet_addr: Malformed address: " ++ ipstr))
1116 else return had -- network byte order
1118 inet_ntoa :: HostAddress -> IO String
1119 inet_ntoa haddr = do
1120 pstr <- _casm_ ``struct in_addr addr;
1122 %r = inet_ntoa (addr);'' haddr
1123 -- unpack straight away, since pstr points to static buffer.
1124 unpackCStringIO pstr
1128 Marshaling and allocation helper functions:
1131 -------------------------------------------------------------------------------
1133 allocSockAddr :: Family -> IO (MutableByteArray RealWorld Int, Int)
1135 #if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
1136 allocSockAddr AF_UNIX = do
1137 ptr <- allocChars ``sizeof(struct sockaddr_un)''
1138 let (_,sz) = boundsOfMutableByteArray ptr
1142 allocSockAddr AF_INET = do
1143 ptr <- allocChars ``sizeof(struct sockaddr_in)''
1144 let (_,sz) = boundsOfMutableByteArray ptr
1147 -------------------------------------------------------------------------------
1149 unpackSockAddr :: MutableByteArray RealWorld Int -> Int -> IO SockAddr
1150 unpackSockAddr arr len = do
1151 fam <- _casm_ ``%r = ((struct sockaddr*)%0)->sa_family;'' arr
1152 case unpackFamily fam of
1153 #if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
1154 AF_UNIX -> unpackSockAddrUnix arr (len - ``sizeof(short)'')
1156 AF_INET -> unpackSockAddrInet arr
1158 -------------------------------------------------------------------------------
1160 #if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
1163 sun_path is *not* NULL terminated, hence we *do* need to know the
1166 unpackSockAddrUnix :: (MutableByteArray RealWorld Int) -> Int -> IO SockAddr
1167 unpackSockAddrUnix ptr len = do
1168 char_star <- _casm_ ``%r = ((struct sockaddr_un*)%0)->sun_path;'' ptr
1169 path <- unpackCStringLenIO char_star len
1170 return (SockAddrUnix path)
1174 -------------------------------------------------------------------------------
1176 unpackSockAddrInet :: (MutableByteArray RealWorld Int) -> IO SockAddr
1177 unpackSockAddrInet ptr = do
1178 port <- _casm_ ``%r = ((struct sockaddr_in*)%0)->sin_port;'' ptr
1179 addr <- _casm_ ``%r = ((struct sockaddr_in*)%0)->sin_addr.s_addr;'' ptr
1180 return (SockAddrInet (PNum port) addr)
1182 -------------------------------------------------------------------------------
1185 packSockAddr :: SockAddr -> IO (MutableByteArray RealWorld Int)
1186 #if !defined(cygwin32_TARGET_OS) && !defined(mingw32_TARGET_OS)
1187 packSockAddr (SockAddrUnix path) = do
1188 (ptr,_) <- allocSockAddr AF_UNIX
1189 _casm_ ``(((struct sockaddr_un *)%0)->sun_family) = AF_UNIX;'' ptr
1190 _casm_ ``strcpy ((((struct sockaddr_un *)%0)->sun_path),%1);'' ptr path
1193 packSockAddr (SockAddrInet (PNum port) address) = do
1194 (ptr,_) <- allocSockAddr AF_INET
1195 _casm_ ``(((struct sockaddr_in *)%0)->sin_family) = AF_INET;'' ptr
1196 _casm_ ``(((struct sockaddr_in *)%0)->sin_port) = (int)%1;'' ptr port
1197 _casm_ ``(((struct sockaddr_in *)%0)->sin_addr.s_addr) = %1;'' ptr address
1200 -------------------------------------------------------------------------------
1203 @socketHandle@ turns a @Socket@ into a Haskell IO @Handle@. By default, the new
1204 handle will not be buffered, use @hSetBuffering@ if you want to change
1208 #ifndef __PARALLEL_HASKELL__
1209 socketToHandle :: Socket -> IOMode -> IO Handle
1211 socketToHandle (MkSocket fd _ _ _ _) m = do
1212 fileobj <- _ccall_ openFd fd (file_mode::Int) (file_flags::Int)
1213 if fileobj == nullAddr then
1214 ioError (userError "socketHandle: Failed to open file desc")
1216 fo <- mkForeignObj fileobj
1217 addForeignFinalizer fo (freeFileObject fo)
1218 mkBuffer__ fo 0 -- not buffered
1219 hndl <- newHandle (Handle__ fo htype NoBuffering socket_str)
1222 socket_str = "<socket: "++show fd
1224 file_flags = flush_on_close + 1024{-I'm a socket fd, me!-}
1226 file_flags = flush_on_close
1229 (flush_on_close, file_mode) =
1231 AppendMode -> (1, 0)
1234 ReadWriteMode -> (1, 3)
1238 ReadMode -> ReadHandle
1239 WriteMode -> WriteHandle
1240 AppendMode -> AppendHandle
1241 ReadWriteMode -> ReadWriteHandle
1243 socketToHandle (MkSocket s family stype protocol status) m =
1244 error "socketToHandle not implemented in a parallel setup"
1248 If you're using WinSock, the programmer has to call a startup
1249 routine before starting to use the goods. So, if you want to
1250 stay portable across all ghc-supported platforms, you have to
1251 use @withSocketsDo@...:
1254 withSocketsDo :: IO a -> IO a
1255 #if !defined(HAVE_WINSOCK_H) || defined(cygwin32_TARGET_OS)
1258 withSocketsDo act = do
1261 ioError (userError "Failed to initialise WinSock")
1267 foreign import "initWinSock" initWinSock :: IO Int
1268 foreign import "shutdownWinSock" shutdownWinSock :: IO ()