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 -- Alternative read/write interface not yet implemented.
41 -- sendto -- :: Socket -> String -> SockAddr -> IO Int
42 -- recvfrm -- :: Socket -> Int -> SockAddr -> IO (String, Int)
43 -- sendmsg -- :: Socket -> Message -> MsgFlags -> IO Int
44 -- recvmsg -- :: Socket -> MsgFlags -> IO Message
46 shutdown, -- :: Socket -> ShutdownCmd -> IO ()
47 sClose, -- :: Socket -> IO ()
49 inet_addr, -- :: String -> IO HostAddress
50 inet_ntoa, -- :: HostAddress -> IO String
52 sIsConnected, -- :: Socket -> IO Bool
53 sIsBound, -- :: Socket -> IO Bool
54 sIsListening, -- :: Socket -> IO Bool
55 sIsReadable, -- :: Socket -> IO Bool
56 sIsWritable, -- :: Socket -> IO Bool
60 mkPortNumber, -- :: Int -> PortNumber
71 -- The following are exported ONLY for use in the BSD module and
72 -- should not be used else where.
74 packFamily, unpackFamily,
76 packSockAddr, unpackSockAddr
83 import PrelIOBase -- IOError, Handle representation
90 import IOExts ( IORef, newIORef, readIORef, writeIORef )
91 import PackedString ( unpackNBytesPS, byteArrayToPS,
92 unpackCString, unpackCStringIO,
98 %************************************************************************
100 \subsection[Socket-SocketTypes]{Socket Types}
102 %************************************************************************
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.
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
120 -- Returned Status Function called
121 = NotConnected -- socket
122 | Bound -- bindSocket
123 | Listening -- listen
124 | Connected -- connect/accept
125 | Error String -- Any
130 Int -- File Descriptor
133 Int -- Protocol Number
134 (IORef SocketStatus) -- Status Flag
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.
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.
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.
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
159 -- newtyped to prevent accidental use of sane-looking
160 -- port numbers that haven't actually been converted to
161 -- network-byte-order first.
163 newtype PortNumber = PNum Int -- 16-bit value stored in network byte order.
166 mkPortNumber :: Int -> PortNumber
167 mkPortNumber v = unsafePerformIO $ do
168 po <- _casm_ ``%r=(int)htons((int)%0); '' v
171 data SockAddr -- C Names
172 #ifndef cygwin32_TARGET_OS
173 = SockAddrUnix -- struct sockaddr_un
175 | SockAddrInet -- struct sockaddr_in
176 PortNumber -- sin_port (network byte order)
177 HostAddress -- sin_addr (ditto)
179 = SockAddrInet -- struct sockaddr_in
180 PortNumber -- sin_port (network byte order)
181 HostAddress -- sin_addr (ditto)
186 type ProtocolNumber = Int
191 %************************************************************************
193 \subsection[Socket-Connections]{Connection Functions}
195 %************************************************************************
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.
203 Create an unconnected socket of the given family, type and protocol.
204 The most common invocation of $socket$ is the following:
208 my_socket <- socket AF_INET Stream 6
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
218 socket family stype protocol = do
219 status <- _ccall_ createSocket (packFamily family)
220 (packSocketType stype)
223 -1 -> constructErrorAndFail "socket"
225 socket_status <- newIORef NotConnected
226 return (MkSocket n family stype protocol socket_status)
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
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
241 The port number allocated to a socket bound by using $aNY\_PORT$ can be
242 found by calling $port$
245 bindSocket :: Socket -- Unconnected Socket
246 -> SockAddr -- Address to Bind to
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)
253 let isDomainSocket = 0
255 currentStatus <- readIORef socketStatus
256 if currentStatus /= NotConnected
258 fail (userError ("bindSocket: can't peform bind on socket in status " ++
261 addr' <- packSockAddr addr
262 let (_,sz) = boundsOfByteArray addr'
263 status <- _ccall_ bindSocket s addr' sz isDomainSocket
265 -1 -> constructErrorAndFail "bindSocket"
266 0 -> writeIORef socketStatus (Bound)
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.
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.
280 connect :: Socket -- Unconnected Socket
281 -> SockAddr -- Socket address stuff
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)
288 let isDomainSocket = 0
290 currentStatus <- readIORef socketStatus
291 if currentStatus /= NotConnected
293 fail (userError ("connect: can't peform connect on socket in status " ++
296 addr' <- packSockAddr addr
297 let (_,sz) = boundsOfByteArray addr'
298 status <- _ccall_ connectSocket s addr' sz isDomainSocket
300 -1 -> constructErrorAndFail "connect"
301 0 -> writeIORef socketStatus Connected
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
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.
315 listen :: Socket -- Connected & Bound Socket
316 -> Int -- Queue Length
319 listen (MkSocket s family stype protocol socketStatus) backlog = do
320 currentStatus <- readIORef socketStatus
321 if currentStatus /= Bound
323 fail (userError ("listen: can't peform listen on socket in status " ++
326 status <- _ccall_ listenSocket s backlog
328 -1 -> constructErrorAndFail "listen"
329 0 -> writeIORef socketStatus Listening
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.
339 accept :: Socket -- Queue Socket
340 -> IO (Socket, -- Readable Socket
341 SockAddr) -- Peer details
343 accept sock@(MkSocket s family stype protocol status) = do
344 currentStatus <- readIORef status
345 okay <- sIsAcceptable sock
348 fail (userError ("accept: can't peform accept on socket in status " ++
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
356 -1 -> constructErrorAndFail "accept"
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)
364 %************************************************************************
366 \subsection[Socket-DataPass]{Data Passing Primitives}
368 %************************************************************************
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
379 writeSocket :: Socket -- Connected Socket
380 -> String -- Data to send
381 -> IO Int -- Number of Bytes sent
383 writeSocket (MkSocket s family stype protocol status) xs = do
384 currentStatus <- readIORef status
385 if not ((currentStatus /= Connected) || (currentStatus /= Listening))
387 fail (userError ("writeSocket: can't peform write on socket in status " ++
390 nbytes <- _ccall_ writeDescriptor s xs (length xs)
392 -1 -> constructErrorAndFail "writeSocket"
395 readSocket :: Socket -- Connected Socket
396 -> Int -- Number of Bytes to Read
397 -> IO (String, Int) -- (Data Read, Number of Bytes)
399 readSocket (MkSocket s family stype protocol status) nbytes = do
400 currentStatus <- readIORef status
401 if not ((currentStatus /= Connected) || (currentStatus /= Listening))
403 fail (userError ("readSocket: can't perform read on socket in status " ++
406 ptr <- stToIO (newCharArray (0, nbytes))
407 nbytes <- _ccall_ readDescriptor s ptr nbytes
409 -1 -> constructErrorAndFail "readSocket"
411 barr <- stToIO (unsafeFreezeByteArray ptr)
412 return (unpackNBytesPS (byteArrayToPS barr) n, n)
414 readSocketAll :: Socket -> IO String
419 (readSocket s 4096 >>= \ (str, nbytes) ->
429 The port number the given socket is currently connected to can be
430 determined by calling $port$, is generally only useful when bind
431 was given $aNY\_PORT$.
434 socketPort :: Socket -- Connected & Bound Socket
435 -> IO PortNumber -- Port Number of Socket
436 socketPort sock@(MkSocket s AF_INET stype protocol status) =
437 getSocketName sock >>= \(SockAddrInet port _) ->
439 socketPort (MkSocket s family stype protocol status) =
440 fail (userError ("socketPort: not supported for Family " ++ show family))
443 Calling $getPeerName$ returns the address details of the machine,
444 other than the local one, which is connected to the socket. This is
445 used in programs such as FTP to determine where to send the returning
446 data. The corresponding call to get the details of the local machine
450 getPeerName :: Socket -> IO SockAddr
452 getPeerName (MkSocket s family stype protocol status) = do
453 (ptr, sz) <- allocSockAddr family
454 int_star <- stToIO (newIntArray (0,1))
455 stToIO (writeIntArray int_star 0 sz)
456 status <- _ccall_ getPeerName s ptr int_star
458 -1 -> constructErrorAndFail "getPeerName"
460 sz <- stToIO (readIntArray int_star 0)
461 unpackSockAddr ptr sz
463 getSocketName :: Socket -> IO SockAddr
465 getSocketName (MkSocket s family stype protocol status) = do
466 (ptr, sz) <- allocSockAddr family
467 int_star <- stToIO (newIntArray (0,1))
468 stToIO (writeIntArray int_star 0 sz)
469 status <- _ccall_ getSockName s ptr int_star
471 -1 -> constructErrorAndFail "getSocketName"
473 sz <- stToIO (readIntArray int_star 0)
474 unpackSockAddr ptr sz
480 %************************************************************************
482 \subsection[Socket-Properties]{Socket Properties}
484 %************************************************************************
507 sOL_SOCKET = ``SOL_SOCKET''
509 setSocketOptions :: Socket ->
511 SocketOption -> -- Option Name
512 String -> -- Option Value
515 getSocketOptions :: Socket ->
517 SocketOption -> -- Option Name
518 IO String -- Option Value
522 A calling sequence table for the main functions is shown in the table below.
526 \begin{tabular}{|l|c|c|c|c|c|c|c|}
528 {\bf A Call to} & socket & connect & bindSocket & listen & accept & read & write \\
530 {\bf Precedes} & & & & & & & \\
532 socket & & & & & & & \\
534 connect & + & & & & & & \\
536 bindSocket & + & & & & & & \\
538 listen & & & + & & & & \\
540 accept & & & & + & & & \\
542 read & & + & & + & + & + & + \\
544 write & & + & & + & + & + & + \\
547 \caption{Sequence Table for Major functions of Socket}
552 %************************************************************************
554 \subsection[Socket-OSDefs]{OS Dependent Definitions}
556 %************************************************************************
559 The following Family and Socket Type declarations were manually derived
560 from @<sys/socket.h>@ on the appropriate machines.
562 Maybe a configure script that could parse the socket.h file to produce
563 the following declaration is required to make it ``portable'' rather than
564 using the dreaded \#ifdefs.
566 Presently only the following machine/os combinations are supported:
578 unpackFamily :: Int -> Family
579 packFamily :: Family -> Int
581 packSocketType :: SocketType -> Int
584 #if sunos4_TARGET_OS || solaris2_TARGET_OS
587 AF_UNSPEC -- unspecified
588 | AF_UNIX -- local to host (pipes, portals
589 | AF_INET -- internetwork: UDP, TCP, etc
590 | AF_IMPLINK -- arpanet imp addresses
591 | AF_PUP -- pup protocols: e.g. BSP
592 | AF_CHAOS -- mit CHAOS protocols
593 | AF_NS -- XEROX NS protocols
594 | AF_NBS -- nbs protocols
595 | AF_ECMA -- european computer manufacturers
596 | AF_DATAKIT -- datakit protocols
597 | AF_CCITT -- CCITT protocols, X.25 etc
599 | AF_DECnet -- DECnet
600 | AF_DLI -- Direct data link interface
602 | AF_HYLINK -- NSC Hyperchannel
603 | AF_APPLETALK -- Apple Talk
604 | AF_NIT -- Network Interface Tap
605 | AF_802 -- IEEE 802.2, also ISO 8802
606 | AF_OSI -- umbrella of all families used by OSI
607 | AF_X25 -- CCITT X.25
609 | AF_GOSSIP -- US Government OSI
610 | AF_IPX -- Novell Internet Protocol
611 deriving (Eq, Ord, Ix, Show)
613 packFamily = index (AF_UNSPEC, AF_IPX)
614 unpackFamily family = (range (AF_UNSPEC, AF_IPX))!!family
618 #if cygwin32_TARGET_OS
621 AF_UNSPEC -- unspecified
622 | AF_UNIX -- local to host (pipes, portals)
623 | AF_INET -- internetwork: UDP, TCP, etc
624 | AF_IMPLINK -- arpanet imp addresses
625 | AF_PUP -- pup protocols: e.g. BSP
626 | AF_CHAOS -- mit CHAOS protocols
627 | AF_NS -- XEROX NS protocols
628 | AF_ISO -- ISO protocols
629 | AF_OSI -- OSI protocols
630 | AF_ECMA -- european computer manufacturers
631 | AF_DATAKIT -- datakit protocols
632 | AF_CCITT -- CCITT protocols, X.25 etc
634 | AF_DECnet -- DECnet
635 | AF_DLI -- Direct data link interface
637 | AF_HYLINK -- NSC Hyperchannel
638 | AF_APPLETALK -- Apple Talk
639 | AF_NETBIOS -- NetBios-style addresses
640 deriving (Eq, Ord, Ix, Show)
642 packFamily = index (AF_UNSPEC, AF_NETBIOS)
643 unpackFamily family = (range (AF_UNSPEC, AF_NETBIOS))!!family
651 AF_UNSPEC -- unspecified
652 | AF_UNIX -- local to host (pipes, portals
653 | AF_INET -- internetwork: UDP, TCP, etc
654 | AF_IMPLINK -- arpanet imp addresses
655 | AF_PUP -- pup protocols: e.g. BSP
656 | AF_CHAOS -- mit CHAOS protocols
657 | AF_NS -- XEROX NS protocols
658 | AF_NBS -- nbs protocols
659 | AF_ECMA -- european computer manufacturers
660 | AF_DATAKIT -- datakit protocols
661 | AF_CCITT -- CCITT protocols, X.25 etc
663 | AF_DECnet -- DECnet
664 | AF_DLI -- Direct data link interface
666 | AF_HYLINK -- NSC Hyperchannel
667 | AF_APPLETALK -- Apple Talk
668 | AF_NIT -- Network Interface Tap
669 deriving (Eq, Ord, Ix, Show)
671 packFamily = index (AF_UNSPEC, AF_NIT)
672 unpackFamily family = (range (AF_UNSPEC, AF_NIT))!!family
676 #if osf1_TARGET_OS || osf3_TARGET_OS
679 AF_UNSPEC -- unspecified
680 | AF_UNIX -- local to host (pipes, portals)
681 | AF_INET -- internetwork: UDP, TCP, etc.
682 | AF_IMPLINK -- arpanet imp addresses
683 | AF_PUP -- pup protocols: e.g. BSP
684 | AF_CHAOS -- mit CHAOS protocols
685 | AF_NS -- XEROX NS protocols
686 | AF_ISO -- ISO protocols
687 | AF_ECMA -- european computer manufacturers
688 | AF_DATAKIT -- datakit protocols
689 | AF_CCITT -- CCITT protocols, X.25 etc
691 | AF_DECnet -- DECnet
692 | AF_DLI -- DEC Direct data link interface
694 | AF_HYLINK -- NSC Hyperchannel
695 | AF_APPLETALK -- Apple Talk
696 | AF_ROUTE -- Internal Routing Protocol
697 | AF_LINK -- Link layer interface
698 | Pseudo_AF_XTP -- eXpress Transfer Protocol (no AF)
699 | AF_NETMAN -- DNA Network Management
700 | AF_X25 -- X25 protocol
701 | AF_CTF -- Common Trace Facility
702 | AF_WAN -- Wide Area Network protocols
703 deriving (Eq, Ord, Ix, Show)
705 packFamily = index (AF_UNSPEC, AF_WAN)
706 unpackFamily family = (range (AF_UNSPEC, AF_WAN))!!family
717 deriving (Eq, Ord, Ix, Show)
719 packFamily = index (AF_UNSPEC, AF_IPX)
720 unpackFamily family = (range (AF_UNSPEC, AF_IPX))!!family
727 AF_UNSPEC -- unspecified
728 | AF_UNIX -- backward compatibility
729 | AF_INET -- internetwork: UDP, TCP, etc.
730 | AF_IMPLINK -- arpanet imp addresses
731 | AF_PUP -- pup protocols: e.g. BSP
732 | AF_CHAOS -- mit CHAOS protocols
733 | AF_NS -- XEROX NS protocols
734 | AF_ISO -- ISO protocols
735 | AF_ECMA -- european computer manufacturers
736 | AF_DATAKIT -- datakit protocols
737 | AF_CCITT -- CCITT protocols, X.25 etc
739 | AF_DECnet -- DECnet
740 | AF_DLI -- DEC Direct data link interface
742 | AF_HYLINK -- NSC Hyperchannel
743 | AF_APPLETALK -- Apple Talk
744 | AF_ROUTE -- Internal Routing Protocol
745 | AF_RAW -- Link layer interface
747 -- these two overlap AF_ROUTE and AF_RAW
748 -- | AF_NIT -- Network Interface Tap
749 -- | AF_802 -- IEEE 802.2, also ISO 8802
751 | AF_OSI -- umbrella for all families used by OSI
752 | AF_X25 -- CCITT X.25
754 | AF_GOSIP -- US Government OSI
756 | AF_SDL -- SGI Data Link for DLPI
757 | AF_INET6 -- Internet Protocol version 6
758 | AF_LINK -- Link layer interface
759 deriving (Eq, Ord, Ix, Show)
761 packFamily = index (AF_UNSPEC, AF_LINK)
762 unpackFamily family = (range (AF_UNSPEC, AF_LINK))!!family
769 AF_UNSPEC -- unspecified
770 | AF_UNIX -- local to host (pipes, portals)
771 | AF_INET -- internetwork: UDP, TCP, etc.
772 | AF_IMPLINK -- arpanet imp addresses
773 | AF_PUP -- pup protocols: e.g. BSP
774 | AF_CHAOS -- mit CHAOS protocols
775 | AF_NS -- XEROX NS protocols
776 | AF_ISO -- ISO protocols
777 -- | AF_OSI is the same as AF_ISO on AIX
778 | AF_ECMA -- european computer manufacturers
779 | AF_DATAKIT -- datakit protocols
780 | AF_CCITT -- CCITT protocols, X.25 etc
782 | AF_DECnet -- DECnet
783 | AF_DLI -- DEC Direct data link interface
785 | AF_HYLINK -- NSC Hyperchannel
786 | AF_APPLETALK -- Apple Talk
787 | AF_ROUTE -- Internal Routing Protocol
788 | AF_LINK -- Link layer interface
789 | Pseudo_AF_XTP -- eXpress Transfer Protocol (no AF)
790 | AF_INTF -- Debugging use only
791 | AF_RIF -- raw interface
795 deriving (Eq, Ord, Ix, Show)
797 packFamily = index (AF_UNSPEC, AF_MAX)
798 unpackFamily family = (range (AF_UNSPEC, AF_MAX))!!family
802 #if freebsd_TARGET_OS
805 AF_UNSPEC -- unspecified
806 | AF_UNIX -- local to host (pipes, portals)
807 | AF_INET -- internetwork: UDP, TCP, etc.
808 | AF_IMPLINK -- arpanet imp addresses
809 | AF_PUP -- pup protocols: e.g. BSP
810 | AF_CHAOS -- mit CHAOS protocols
811 | AF_NS -- XEROX NS protocols
812 | AF_ISO -- ISO protocols
813 -- | AF_OSI is the same as AF_ISO
814 | AF_ECMA -- european computer manufacturers
815 | AF_DATAKIT -- datakit protocols
816 | AF_CCITT -- CCITT protocols, X.25 etc
818 | AF_DECnet -- DECnet
819 | AF_DLI -- DEC Direct data link interface
821 | AF_HYLINK -- NSC Hyperchannel
822 | AF_APPLETALK -- Apple Talk
823 | AF_ROUTE -- Internal Routing Protocol
824 | AF_LINK -- Link layer interface
825 | Pseudo_AF_XTP -- eXpress Transfer Protocol (no AF)
826 | AF_COIP -- connection-oriented IP, aka ST II
827 | AF_CNT -- Computer Network Technology
828 | Psuedo_AF_RTIP -- Help Identify RTIP packets
829 | AF_IPX -- Novell Internet Protocol
830 | AF_SIP -- Simple Internet Protocol
831 | Pseudo_AF_PIP -- Help Identify PIP packets
832 | AF_ISDN -- Integrated Services Digital Network
833 -- | AF_E164 is the same as AF_ISDN
834 | Pseudo_AF_KEY -- Internal key-management function
837 deriving (Eq, Ord, Ix, Show)
839 packFamily = index (AF_UNSPEC, AF_MAX)
840 unpackFamily family = (range (AF_UNSPEC, AF_MAX))!!family
844 -- Alpha running OSF or a SPARC with SunOS, rather than Solaris.
846 #if osf1_TARGET_OS || osf3_TARGET_OS || sunos4_TARGET_OS || hpux_TARGET_OS || \
847 aix_TARGET_OS || freebsd_TARGET_OS
854 deriving (Eq, Ord, Ix, Show)
856 packSocketType stype = 1 + (index (Stream, SeqPacket) stype)
859 -- This is for a box running cygwin32 toolchain.
861 #if defined(cygwin32_TARGET_OS)
866 | RDM -- reliably delivered msg
869 deriving (Eq, Ord, Ix, Show)
871 packSocketType stype =
873 Stream -> ``SOCK_STREAM''
874 Datagram -> ``SOCK_DGRAM''
877 SeqPacket -> ``SOCK_SEQPACKET''
878 Packet -> ``SOCK_PACKET''
882 -- This is a Sun running Solaris rather than SunOS or SGI running IRIX
884 #if defined(solaris2_TARGET_OS) || defined(irix_TARGET_OS)
892 deriving (Eq, Ord, Ix, Show)
894 packSocketType stype = 1 + (index (Datagram, SeqPacket) stype)
906 deriving (Eq, Ord, Ix, Show)
908 packSocketType stype = 1 + (index (Stream, Packet) stype)
912 %************************************************************************
914 \subsection[Socket-Util]{Utility Functions}
916 %************************************************************************
920 iNADDR_ANY = ``INADDR_ANY''::Word
921 sOMAXCONN = ``SOMAXCONN''::Int
922 maxListenQueue = sOMAXCONN
924 -------------------------------------------------------------------------------
930 sdownCmdToInt :: ShutdownCmd -> Int
931 sdownCmdToInt ShutdownReceive = 0
932 sdownCmdToInt ShutdownSend = 1
933 sdownCmdToInt ShutdownBoth = 2
935 shutdown :: Socket -> ShutdownCmd -> IO ()
936 shutdown (MkSocket s _ _ _ _) stype = do
937 let t = sdownCmdToInt stype
938 status <- _ccall_ shutdownSocket s t
940 -1 -> constructErrorAndFail "shutdown"
943 -------------------------------------------------------------------------------
945 sClose :: Socket -> IO ()
946 sClose (MkSocket s family stype protocol status) = _ccall_ close s
948 -------------------------------------------------------------------------------
950 sIsConnected :: Socket -> IO Bool
951 sIsConnected (MkSocket s family stype protocol status) = do
952 value <- readIORef status
953 return (value == Connected)
955 -------------------------------------------------------------------------------
957 sIsBound :: Socket -> IO Bool
958 sIsBound (MkSocket s family stype protocol status) = do
959 value <- readIORef status
960 return (value == Bound)
962 -------------------------------------------------------------------------------
964 sIsListening :: Socket -> IO Bool
965 sIsListening (MkSocket s family stype protocol status) = do
966 value <- readIORef status
967 return (value == Listening)
969 -------------------------------------------------------------------------------
971 sIsReadable :: Socket -> IO Bool
972 sIsReadable (MkSocket s family stype protocol status) = do
973 value <- readIORef status
974 return (value == Listening || value == Connected)
976 -------------------------------------------------------------------------------
978 sIsWritable :: Socket -> IO Bool
979 sIsWritable = sIsReadable
981 -------------------------------------------------------------------------------
983 sIsAcceptable :: Socket -> IO Bool
984 #ifndef cygwin32_TARGET_OS
985 sIsAcceptable (MkSocket s AF_UNIX Stream protocol status) = do
986 value <- readIORef status
987 return (value == Connected || value == Bound || value == Listening)
988 sIsAcceptable (MkSocket s AF_UNIX _ protocol status) =
991 sIsAcceptable (MkSocket s _ stype protocol status) = do
992 value <- readIORef status
993 return (value == Connected || value == Listening)
995 -------------------------------------------------------------------------------
998 sSetBlocking :: Socket -> Bool -> IO ()
999 sIsBlocking :: Socket -> IO Bool
1004 Internet address manipulation routines:
1007 inet_addr :: String -> IO HostAddress
1008 inet_addr ipstr = do
1009 had <- _ccall_ inet_addr ipstr
1010 if had == (W# (int2Word# (negateInt# 1#))) -- hack to avoid depending on Int.intToWord here.
1011 then fail (userError ("inet_addr: Malformed address: " ++ ipstr))
1012 else return had -- network byte order
1014 inet_ntoa :: HostAddress -> IO String
1015 inet_ntoa haddr = do
1016 pstr <- _casm_ ``struct in_addr addr;
1018 %r = inet_ntoa (addr);'' haddr
1019 -- unpack straight away, since pstr points to static buffer.
1020 unpackCStringIO pstr
1024 Marshaling and allocation helper functions:
1027 -------------------------------------------------------------------------------
1029 allocSockAddr :: Family -> IO (MutableByteArray RealWorld Int, Int)
1031 #ifndef cygwin32_TARGET_OS
1032 allocSockAddr AF_UNIX = do
1033 ptr <- stToIO (newCharArray (0,``sizeof(struct sockaddr_un)''))
1034 let (_,sz) = boundsOfByteArray ptr
1038 allocSockAddr AF_INET = do
1039 ptr <- stToIO (newCharArray (0,``sizeof(struct sockaddr_in)''))
1040 let (_,sz) = boundsOfByteArray ptr
1043 -------------------------------------------------------------------------------
1045 unpackSockAddr :: MutableByteArray RealWorld Int -> Int -> IO SockAddr
1046 unpackSockAddr arr len = do
1047 fam <- _casm_ ``%r = ((struct sockaddr*)%0)->sa_family;'' arr
1048 case unpackFamily fam of
1049 #ifndef cygwin32_TARGET_OS
1050 AF_UNIX -> unpackSockAddrUnix arr (len - ``sizeof(short)'')
1052 AF_INET -> unpackSockAddrInet arr
1054 -------------------------------------------------------------------------------
1056 #ifndef cygwin32_TARGET_OS
1059 sun_path is *not* NULL terminated, hence we *do* need to know the
1062 unpackSockAddrUnix :: (MutableByteArray RealWorld Int) -> Int -> IO SockAddr
1063 unpackSockAddrUnix ptr len = do
1064 char_star <- _casm_ ``%r = ((struct sockaddr_un*)%0)->sun_path;'' ptr
1065 path <- unpackCStringLenIO char_star len
1066 return (SockAddrUnix path)
1070 -------------------------------------------------------------------------------
1072 unpackSockAddrInet :: (MutableByteArray RealWorld Int) -> IO SockAddr
1073 unpackSockAddrInet ptr = do
1074 port <- _casm_ ``%r = ((struct sockaddr_in*)%0)->sin_port;'' ptr
1075 addr <- _casm_ ``%r = ((struct sockaddr_in*)%0)->sin_addr.s_addr;'' ptr
1076 return (SockAddrInet (PNum port) addr)
1078 -------------------------------------------------------------------------------
1081 packSockAddr :: SockAddr -> IO (MutableByteArray RealWorld Int)
1082 #ifndef cygwin32_TARGET_OS
1083 packSockAddr (SockAddrUnix path) = do
1084 (ptr,_) <- allocSockAddr AF_UNIX
1085 _casm_ ``(((struct sockaddr_un *)%0)->sun_family) = AF_UNIX;'' ptr
1086 _casm_ ``strcpy ((((struct sockaddr_un *)%0)->sun_path),%1);'' ptr path
1089 packSockAddr (SockAddrInet (PNum port) address) = do
1090 (ptr,_) <- allocSockAddr AF_INET
1091 _casm_ ``(((struct sockaddr_in *)%0)->sin_family) = AF_INET;'' ptr
1092 _casm_ ``(((struct sockaddr_in *)%0)->sin_port) = (int)%1;'' ptr port
1093 _casm_ ``(((struct sockaddr_in *)%0)->sin_addr.s_addr) = %1;'' ptr address
1096 -------------------------------------------------------------------------------
1099 @socketHandle@ turns a @Socket@ into a Haskell IO @Handle@. By default, the new
1100 handle will not be buffered, use @hSetBuffering@ if you want to change
1104 #ifndef __PARALLEL_HASKELL__
1105 socketToHandle :: Socket -> IOMode -> IO Handle
1107 socketToHandle (MkSocket s family stype protocol status) m = do
1108 ptr <- _casm_ ``%r = fdopen (%0, (char *)%1);'' s m'
1109 fp <- makeForeignObj ptr (``&freeFile'' :: Addr)
1110 hndl <- newHandle (htype fp Nothing False)
1111 hSetBuffering hndl NoBuffering
1119 ReadWriteMode -> "r+"
1122 ReadMode -> ReadHandle
1123 WriteMode -> WriteHandle
1124 AppendMode -> AppendHandle
1125 ReadWriteMode -> ReadWriteHandle
1127 socketToHandle (MkSocket s family stype protocol status) m =
1128 error "socketToHandle not implemented in a parallel setup"