network 2.3.2.1 → 2.4.0.0
raw patch · 11 files changed
+559/−858 lines, 11 filesdep ~basedep ~parsec
Dependency ranges changed: base, parsec
Files
- Network/BSD.hsc +2/−2
- Network/Socket.hsc +333/−352
- Network/Socket/Internal.hsc +5/−131
- Network/URI.hs +54/−8
- cbits/ancilData.c +0/−114
- configure +107/−164
- include/HsNet.h +1/−18
- include/HsNetworkConfig.h +8/−32
- include/HsNetworkConfig.h.in +3/−27
- network.cabal +4/−4
- tests/uri001.hs +42/−6
Network/BSD.hsc view
@@ -16,10 +16,8 @@ #include "HsNet.h" -#if __GLASGOW_HASKELL__ < 708 -- NOTE: ##, we want this interpreted when compiling the .hs, not by hsc2hs. ##include "Typeable.h"-#endif module Network.BSD (@@ -126,6 +124,8 @@ #endif import Control.Monad (liftM)++import Network.Socket.Internal (throwSocketErrorIfMinus1_) -- --------------------------------------------------------------------------- -- Basic Types
Network/Socket.hsc view
@@ -22,10 +22,8 @@ #include "HsNet.h" -#if __GLASGOW_HASKELL__ < 708 -- NOTE: ##, we want this interpreted when compiling the .hs, not by hsc2hs. ##include "Typeable.h"-#endif -- In order to process this file, you need to have CALLCONV defined. @@ -34,7 +32,9 @@ -- * Types Socket(..) , Family(..) + , isSupportedFamily , SocketType(..)+ , isSupportedSocketType , SockAddr(..) , SocketStatus(..) , HostAddress@@ -76,7 +76,7 @@ , socketPair #endif , connect- , bindSocket+ , bind , listen , accept , getPeerName@@ -107,17 +107,18 @@ , inet_ntoa , shutdown- , sClose+ , close -- ** Predicates on sockets- , sIsConnected- , sIsBound- , sIsListening- , sIsReadable- , sIsWritable+ , isConnected+ , isBound+ , isListening+ , isReadable+ , isWritable -- * Socket options , SocketOption(..)+ , isSupportedSocketOption , getSocketOption , setSocketOption @@ -126,10 +127,6 @@ , sendFd , recvFd - -- Note: these two will disappear shortly- , sendAncillary- , recvAncillary- #endif -- * Special constants@@ -153,6 +150,16 @@ , fdSocket , mkSocket + -- * Deprecated aliases+ -- $deprecated-aliases+ , bindSocket+ , sClose+ , sIsConnected+ , sIsBound+ , sIsListening+ , sIsReadable+ , sIsWritable+ -- * Internal -- | The following are exported ONLY for use in the BSD module and@@ -161,7 +168,6 @@ , packFamily , unpackFamily , packSocketType- , throwSocketErrorIfMinus1_ ) where #ifdef __HUGS__@@ -179,6 +185,7 @@ import Data.Bits import Data.List (foldl')+import Data.Maybe (fromMaybe, isJust) import Data.Word (Word16, Word32) import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.Storable (Storable(..))@@ -278,11 +285,11 @@ data SocketStatus -- Returned Status Function called = NotConnected -- socket- | Bound -- bindSocket+ | Bound -- bind | Listening -- listen | Connected -- connect/accept | ConvertedToHandle -- is now a Handle, don't touch- | Closed -- sClose + | Closed -- close deriving (Eq, Show, Typeable) data Socket@@ -414,8 +421,9 @@ -> ProtocolNumber -- Protocol Number (getProtocolByName to find value) -> IO Socket -- Unconnected Socket socket family stype protocol = do+ c_stype <- packSocketTypeOrThrow "socket" stype fd <- throwSocketErrorIfMinus1Retry "socket" $- c_socket (packFamily family) (packSocketType stype) protocol+ c_socket (packFamily family) c_stype protocol #if !defined(__HUGS__) # if __GLASGOW_HASKELL__ < 611 System.Posix.Internals.setNonBlockingFD fd@@ -448,10 +456,9 @@ -> IO (Socket, Socket) -- unnamed and connected. socketPair family stype protocol = do allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do+ c_stype <- packSocketTypeOrThrow "socketPair" stype _rc <- throwSocketErrorIfMinus1Retry "socketpair" $- c_socketpair (packFamily family)- (packSocketType stype)- protocol fdArr+ c_socketpair (packFamily family) c_stype protocol fdArr [fd1,fd2] <- peekArray 2 fdArr s1 <- mkNonBlockingSocket fd1 s2 <- mkNonBlockingSocket fd2@@ -476,18 +483,18 @@ -- Binding a socket -- | Bind the socket to an address. The socket must not already be--- bound. The 'Family' passed to @bindSocket@ must be the+-- bound. The 'Family' passed to @bind@ must be the -- same as that passed to 'socket'. If the special port number -- 'aNY_PORT' is passed then the system assigns the next available -- use port.-bindSocket :: Socket -- Unconnected Socket+bind :: Socket -- Unconnected Socket -> SockAddr -- Address to Bind to -> IO ()-bindSocket (MkSocket s _family _stype _protocol socketStatus) addr = do+bind (MkSocket s _family _stype _protocol socketStatus) addr = do modifyMVar_ socketStatus $ \ status -> do if status /= NotConnected then- ioError (userError ("bindSocket: can't peform bind on socket in status " +++ ioError (userError ("bind: can't peform bind on socket in status " ++ show status)) else do withSockAddr addr $ \p_addr sz -> do@@ -587,7 +594,7 @@ accept sock@(MkSocket s family stype protocol status) = do currentStatus <- readMVar status- okay <- sIsAcceptable sock+ okay <- isAcceptable sock if not okay then ioError (userError ("accept: can't perform accept on socket (" ++ (show (family,stype,protocol)) ++") in status " ++@@ -734,7 +741,7 @@ if len' == 0 then ioError (mkEOFError "Network.Socket.recvFrom") else do- flg <- sIsConnected sock+ flg <- isConnected sock -- For at least one implementation (WinSock 2), recvfrom() ignores -- filling in the sockaddr for connected TCP sockets. Cope with -- this by using getPeerName instead.@@ -874,188 +881,166 @@ ----------------------------------------------------------------------------- -- Socket Properties +-- | Socket options for use with 'setSocketOption' and 'getSocketOption'.+--+-- The existence of a constructor does not imply that the relevant option+-- is supported on your system: see 'isSupportedSocketOption' data SocketOption- = DummySocketOption__+ = Debug -- ^ SO_DEBUG+ | ReuseAddr -- ^ SO_REUSEADDR+ | Type -- ^ SO_TYPE+ | SoError -- ^ SO_ERROR+ | DontRoute -- ^ SO_DONTROUTE+ | Broadcast -- ^ SO_BROADCAST+ | SendBuffer -- ^ SO_SNDBUF+ | RecvBuffer -- ^ SO_RCVBUF+ | KeepAlive -- ^ SO_KEEPALIVE+ | OOBInline -- ^ SO_OOBINLINE+ | TimeToLive -- ^ IP_TTL+ | MaxSegment -- ^ TCP_MAXSEG+ | NoDelay -- ^ TCP_NODELAY+ | Cork -- ^ TCP_CORK+ | Linger -- ^ SO_LINGER+ | ReusePort -- ^ SO_REUSEPORT+ | RecvLowWater -- ^ SO_RCVLOWAT+ | SendLowWater -- ^ SO_SNDLOWAT+ | RecvTimeOut -- ^ SO_RCVTIMEO+ | SendTimeOut -- ^ SO_SNDTIMEO+ | UseLoopBack -- ^ SO_USELOOPBACK+ | IPv6Only -- ^ IPV6_V6ONLY+ deriving (Show, Typeable)++-- | Does the 'SocketOption' exist on this system?+isSupportedSocketOption :: SocketOption -> Bool+isSupportedSocketOption = isJust . packSocketOption++-- | For a socket option, return Just (level, value) where level is the+-- corresponding C option level constant (e.g. SOL_SOCKET) and value is+-- the option constant itself (e.g. SO_DEBUG)+-- If either constant does not exist, return Nothing.+packSocketOption :: SocketOption -> Maybe (CInt, CInt)+packSocketOption so =+ -- The Just here is a hack to disable GHC's overlapping pattern detection:+ -- the problem is if all constants are present, the fallback pattern is+ -- redundant, but if they aren't then it isn't. Hence we introduce an+ -- extra pattern (Nothing) that can't possibly happen, so that the+ -- fallback is always (in principle) necessary.+ -- I feel a little bad for including this, but such are the sacrifices we+ -- make while working with CPP - excluding the fallback pattern correctly+ -- would be a serious nuisance.+ -- (NB: comments elsewhere in this file refer to this one)+ case Just so of+#ifdef SOL_SOCKET #ifdef SO_DEBUG- | Debug {- SO_DEBUG -}+ Just Debug -> Just ((#const SOL_SOCKET), (#const SO_DEBUG)) #endif #ifdef SO_REUSEADDR- | ReuseAddr {- SO_REUSEADDR -}+ Just ReuseAddr -> Just ((#const SOL_SOCKET), (#const SO_REUSEADDR)) #endif #ifdef SO_TYPE- | Type {- SO_TYPE -}+ Just Type -> Just ((#const SOL_SOCKET), (#const SO_TYPE)) #endif #ifdef SO_ERROR- | SoError {- SO_ERROR -}+ Just SoError -> Just ((#const SOL_SOCKET), (#const SO_ERROR)) #endif #ifdef SO_DONTROUTE- | DontRoute {- SO_DONTROUTE -}+ Just DontRoute -> Just ((#const SOL_SOCKET), (#const SO_DONTROUTE)) #endif #ifdef SO_BROADCAST- | Broadcast {- SO_BROADCAST -}+ Just Broadcast -> Just ((#const SOL_SOCKET), (#const SO_BROADCAST)) #endif #ifdef SO_SNDBUF- | SendBuffer {- SO_SNDBUF -}+ Just SendBuffer -> Just ((#const SOL_SOCKET), (#const SO_SNDBUF)) #endif #ifdef SO_RCVBUF- | RecvBuffer {- SO_RCVBUF -}+ Just RecvBuffer -> Just ((#const SOL_SOCKET), (#const SO_RCVBUF)) #endif #ifdef SO_KEEPALIVE- | KeepAlive {- SO_KEEPALIVE -}+ Just KeepAlive -> Just ((#const SOL_SOCKET), (#const SO_KEEPALIVE)) #endif #ifdef SO_OOBINLINE- | OOBInline {- SO_OOBINLINE -}-#endif-#ifdef IP_TTL- | TimeToLive {- IP_TTL -}-#endif-#ifdef TCP_MAXSEG- | MaxSegment {- TCP_MAXSEG -}-#endif-#ifdef TCP_NODELAY- | NoDelay {- TCP_NODELAY -}-#endif-#ifdef TCP_CORK- | Cork {- TCP_CORK -}+ Just OOBInline -> Just ((#const SOL_SOCKET), (#const SO_OOBINLINE)) #endif #ifdef SO_LINGER- | Linger {- SO_LINGER -}+ Just Linger -> Just ((#const SOL_SOCKET), (#const SO_LINGER)) #endif #ifdef SO_REUSEPORT- | ReusePort {- SO_REUSEPORT -}+ Just ReusePort -> Just ((#const SOL_SOCKET), (#const SO_REUSEPORT)) #endif #ifdef SO_RCVLOWAT- | RecvLowWater {- SO_RCVLOWAT -}+ Just RecvLowWater -> Just ((#const SOL_SOCKET), (#const SO_RCVLOWAT)) #endif #ifdef SO_SNDLOWAT- | SendLowWater {- SO_SNDLOWAT -}+ Just SendLowWater -> Just ((#const SOL_SOCKET), (#const SO_SNDLOWAT)) #endif #ifdef SO_RCVTIMEO- | RecvTimeOut {- SO_RCVTIMEO -}+ Just RecvTimeOut -> Just ((#const SOL_SOCKET), (#const SO_RCVTIMEO)) #endif #ifdef SO_SNDTIMEO- | SendTimeOut {- SO_SNDTIMEO -}+ Just SendTimeOut -> Just ((#const SOL_SOCKET), (#const SO_SNDTIMEO)) #endif #ifdef SO_USELOOPBACK- | UseLoopBack {- SO_USELOOPBACK -}-#endif-#if HAVE_DECL_IPV6_V6ONLY- | IPv6Only {- IPV6_V6ONLY -}+ Just UseLoopBack -> Just ((#const SOL_SOCKET), (#const SO_USELOOPBACK)) #endif- deriving (Show, Typeable)--socketOptLevel :: SocketOption -> CInt-socketOptLevel so = - case so of+#endif // SOL_SOCKET+#ifdef IPPROTO_IP #ifdef IP_TTL- TimeToLive -> #const IPPROTO_IP+ Just TimeToLive -> Just ((#const IPPROTO_IP), (#const IP_TTL)) #endif+#endif // IPPROTO_IP+#ifdef IPPROTO_TCP #ifdef TCP_MAXSEG- MaxSegment -> #const IPPROTO_TCP+ Just MaxSegment -> Just ((#const IPPROTO_TCP), (#const TCP_MAXSEG)) #endif #ifdef TCP_NODELAY- NoDelay -> #const IPPROTO_TCP+ Just NoDelay -> Just ((#const IPPROTO_TCP), (#const TCP_NODELAY)) #endif #ifdef TCP_CORK- Cork -> #const IPPROTO_TCP+ Just Cork -> Just ((#const IPPROTO_TCP), (#const TCP_CORK)) #endif+#endif // IPPROTO_TCP+#ifdef IPPROTO_IPV6 #if HAVE_DECL_IPV6_V6ONLY- IPv6Only -> #const IPPROTO_IPV6+ Just IPv6Only -> Just ((#const IPPROTO_IPV6), (#const IPV6_V6ONLY)) #endif- _ -> #const SOL_SOCKET+#endif // IPPROTO_IPV6+ _ -> Nothing -packSocketOption :: SocketOption -> CInt-packSocketOption so =- case so of-#ifdef SO_DEBUG- Debug -> #const SO_DEBUG-#endif-#ifdef SO_REUSEADDR- ReuseAddr -> #const SO_REUSEADDR-#endif-#ifdef SO_TYPE- Type -> #const SO_TYPE-#endif-#ifdef SO_ERROR- SoError -> #const SO_ERROR-#endif-#ifdef SO_DONTROUTE- DontRoute -> #const SO_DONTROUTE-#endif-#ifdef SO_BROADCAST- Broadcast -> #const SO_BROADCAST-#endif-#ifdef SO_SNDBUF- SendBuffer -> #const SO_SNDBUF-#endif-#ifdef SO_RCVBUF- RecvBuffer -> #const SO_RCVBUF-#endif-#ifdef SO_KEEPALIVE- KeepAlive -> #const SO_KEEPALIVE-#endif-#ifdef SO_OOBINLINE- OOBInline -> #const SO_OOBINLINE-#endif-#ifdef IP_TTL- TimeToLive -> #const IP_TTL-#endif-#ifdef TCP_MAXSEG- MaxSegment -> #const TCP_MAXSEG-#endif-#ifdef TCP_NODELAY- NoDelay -> #const TCP_NODELAY-#endif-#ifdef TCP_CORK- Cork -> #const TCP_CORK-#endif-#ifdef SO_LINGER- Linger -> #const SO_LINGER-#endif-#ifdef SO_REUSEPORT- ReusePort -> #const SO_REUSEPORT-#endif-#ifdef SO_RCVLOWAT- RecvLowWater -> #const SO_RCVLOWAT-#endif-#ifdef SO_SNDLOWAT- SendLowWater -> #const SO_SNDLOWAT-#endif-#ifdef SO_RCVTIMEO- RecvTimeOut -> #const SO_RCVTIMEO-#endif-#ifdef SO_SNDTIMEO- SendTimeOut -> #const SO_SNDTIMEO-#endif-#ifdef SO_USELOOPBACK- UseLoopBack -> #const SO_USELOOPBACK-#endif-#if HAVE_DECL_IPV6_V6ONLY- IPv6Only -> #const IPV6_V6ONLY-#endif- unknown -> error ("Network.Socket.packSocketOption: unknown option " ++- show unknown)+-- | Return the option level and option value if they exist,+-- otherwise throw an error that begins "Network.Socket." ++ the String+-- parameter+packSocketOption' :: String -> SocketOption -> IO (CInt, CInt)+packSocketOption' caller so = maybe err return (packSocketOption so)+ where+ err = ioError . userError . concat $ ["Network.Socket.", caller,+ ": socket option ", show so, " unsupported on this system"] +-- | Set a socket option that expects an Int value.+-- There is currently no API to set e.g. the timeval socket options setSocketOption :: Socket -> SocketOption -- Option Name -> Int -- Option Value -> IO () setSocketOption (MkSocket s _ _ _ _) so v = do+ (level, opt) <- packSocketOption' "setSocketOption" so with (fromIntegral v) $ \ptr_v -> do throwErrnoIfMinus1_ "setSocketOption" $- c_setsockopt s (socketOptLevel so) (packSocketOption so) ptr_v + c_setsockopt s level opt ptr_v (fromIntegral (sizeOf (undefined :: CInt))) return () +-- | Get a socket option that gives an Int value.+-- There is currently no API to get e.g. the timeval socket options getSocketOption :: Socket -> SocketOption -- Option Name -> IO Int -- Option Value getSocketOption (MkSocket s _ _ _ _) so = do+ (level, opt) <- packSocketOption' "getSocketOption" so alloca $ \ptr_v -> with (fromIntegral (sizeOf (undefined :: CInt))) $ \ptr_sz -> do throwErrnoIfMinus1 "getSocketOption" $- c_getsockopt s (socketOptLevel so) (packSocketOption so) ptr_v ptr_sz+ c_getsockopt s level opt ptr_v ptr_sz fromIntegral `liftM` peek ptr_v @@ -1097,7 +1082,7 @@ #endif -- Note: If Winsock supported FD-passing, thi would have been -- incorrect (since socket FDs need to be closed via closesocket().)- close outfd+ closeFd outfd recvFd :: Socket -> IO CInt recvFd sock = do@@ -1110,299 +1095,228 @@ c_recvFd fd return theFd --sendAncillary :: Socket- -> Int- -> Int- -> Int- -> Ptr a- -> Int- -> IO ()-sendAncillary sock level ty flags datum len = do- let fd = fdSocket sock- _ <--#if !defined(__HUGS__)- throwSocketErrorIfMinus1RetryMayBlock "sendAncillary"- (threadWaitWrite (fromIntegral fd)) $-#endif- c_sendAncillary fd (fromIntegral level) (fromIntegral ty)- (fromIntegral flags) datum (fromIntegral len)- return ()--recvAncillary :: Socket- -> Int- -> Int- -> IO (Int,Int,Ptr a,Int)-recvAncillary sock flags len = do- let fd = fdSocket sock- alloca $ \ ptr_len ->- alloca $ \ ptr_lev ->- alloca $ \ ptr_ty ->- alloca $ \ ptr_pData -> do- poke ptr_len (fromIntegral len)- _ <- -#if !defined(__HUGS__)- throwSocketErrorIfMinus1RetryMayBlock "recvAncillary" - (threadWaitRead (fromIntegral fd)) $-#endif- c_recvAncillary fd ptr_lev ptr_ty (fromIntegral flags) ptr_pData ptr_len- rcvlen <- fromIntegral `liftM` peek ptr_len- lev <- fromIntegral `liftM` peek ptr_lev- ty <- fromIntegral `liftM` peek ptr_ty- pD <- peek ptr_pData- return (lev,ty,pD, rcvlen)-foreign import ccall SAFE_ON_WIN "sendAncillary"- c_sendAncillary :: CInt -> CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt--foreign import ccall SAFE_ON_WIN "recvAncillary"- c_recvAncillary :: CInt -> Ptr CInt -> Ptr CInt -> CInt -> Ptr (Ptr a) -> Ptr CInt -> IO CInt- foreign import ccall SAFE_ON_WIN "sendFd" c_sendFd :: CInt -> CInt -> IO CInt foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt #endif --{--A calling sequence table for the main functions is shown in the table below.--\begin{figure}[h]-\begin{center}-\begin{tabular}{|l|c|c|c|c|c|c|c|}d-\hline-{\bf A Call to} & socket & connect & bindSocket & listen & accept & read & write \\-\hline-{\bf Precedes} & & & & & & & \\-\hline -socket & & & & & & & \\-\hline-connect & + & & & & & & \\-\hline-bindSocket & + & & & & & & \\-\hline-listen & & & + & & & & \\-\hline-accept & & & & + & & & \\-\hline-read & & + & & + & + & + & + \\-\hline-write & & + & & + & + & + & + \\-\hline-\end{tabular}-\caption{Sequence Table for Major functions of Socket}-\label{tab:api-seq}-\end{center}-\end{figure}--}- -- --------------------------------------------------------------------------- -- OS Dependent Definitions- -unpackFamily :: CInt -> Family-packFamily :: Family -> CInt -packSocketType :: SocketType -> CInt-unpackSocketType:: CInt -> SocketType+packFamily :: Family -> CInt+packFamily f = case packFamily' f of+ Just fam -> fam+ Nothing -> error $+ "Network.Socket.packFamily: unsupported address family: " +++ show f ------- ------- -packFamily f = case f of- AF_UNSPEC -> #const AF_UNSPEC+-- | Does the AF_ constant corresponding to the given family exist on this +-- system?+isSupportedFamily :: Family -> Bool+isSupportedFamily = isJust . packFamily'++packFamily' :: Family -> Maybe CInt+packFamily' f = case Just f of+ -- the Just above is to disable GHC's overlapping pattern+ -- detection: see comments for packSocketOption+ Just AF_UNSPEC -> Just #const AF_UNSPEC #ifdef AF_UNIX- AF_UNIX -> #const AF_UNIX+ Just AF_UNIX -> Just #const AF_UNIX #endif #ifdef AF_INET- AF_INET -> #const AF_INET+ Just AF_INET -> Just #const AF_INET #endif #ifdef AF_INET6- AF_INET6 -> #const AF_INET6+ Just AF_INET6 -> Just #const AF_INET6 #endif #ifdef AF_IMPLINK- AF_IMPLINK -> #const AF_IMPLINK+ Just AF_IMPLINK -> Just #const AF_IMPLINK #endif #ifdef AF_PUP- AF_PUP -> #const AF_PUP+ Just AF_PUP -> Just #const AF_PUP #endif #ifdef AF_CHAOS- AF_CHAOS -> #const AF_CHAOS+ Just AF_CHAOS -> Just #const AF_CHAOS #endif #ifdef AF_NS- AF_NS -> #const AF_NS+ Just AF_NS -> Just #const AF_NS #endif #ifdef AF_NBS- AF_NBS -> #const AF_NBS+ Just AF_NBS -> Just #const AF_NBS #endif #ifdef AF_ECMA- AF_ECMA -> #const AF_ECMA+ Just AF_ECMA -> Just #const AF_ECMA #endif #ifdef AF_DATAKIT- AF_DATAKIT -> #const AF_DATAKIT+ Just AF_DATAKIT -> Just #const AF_DATAKIT #endif #ifdef AF_CCITT- AF_CCITT -> #const AF_CCITT+ Just AF_CCITT -> Just #const AF_CCITT #endif #ifdef AF_SNA- AF_SNA -> #const AF_SNA+ Just AF_SNA -> Just #const AF_SNA #endif #ifdef AF_DECnet- AF_DECnet -> #const AF_DECnet+ Just AF_DECnet -> Just #const AF_DECnet #endif #ifdef AF_DLI- AF_DLI -> #const AF_DLI+ Just AF_DLI -> Just #const AF_DLI #endif #ifdef AF_LAT- AF_LAT -> #const AF_LAT+ Just AF_LAT -> Just #const AF_LAT #endif #ifdef AF_HYLINK- AF_HYLINK -> #const AF_HYLINK+ Just AF_HYLINK -> Just #const AF_HYLINK #endif #ifdef AF_APPLETALK- AF_APPLETALK -> #const AF_APPLETALK+ Just AF_APPLETALK -> Just #const AF_APPLETALK #endif #ifdef AF_ROUTE- AF_ROUTE -> #const AF_ROUTE+ Just AF_ROUTE -> Just #const AF_ROUTE #endif #ifdef AF_NETBIOS- AF_NETBIOS -> #const AF_NETBIOS+ Just AF_NETBIOS -> Just #const AF_NETBIOS #endif #ifdef AF_NIT- AF_NIT -> #const AF_NIT+ Just AF_NIT -> Just #const AF_NIT #endif #ifdef AF_802- AF_802 -> #const AF_802+ Just AF_802 -> Just #const AF_802 #endif #ifdef AF_ISO- AF_ISO -> #const AF_ISO+ Just AF_ISO -> Just #const AF_ISO #endif #ifdef AF_OSI- AF_OSI -> #const AF_OSI+ Just AF_OSI -> Just #const AF_OSI #endif #ifdef AF_NETMAN- AF_NETMAN -> #const AF_NETMAN+ Just AF_NETMAN -> Just #const AF_NETMAN #endif #ifdef AF_X25- AF_X25 -> #const AF_X25+ Just AF_X25 -> Just #const AF_X25 #endif #ifdef AF_AX25- AF_AX25 -> #const AF_AX25+ Just AF_AX25 -> Just #const AF_AX25 #endif #ifdef AF_OSINET- AF_OSINET -> #const AF_OSINET+ Just AF_OSINET -> Just #const AF_OSINET #endif #ifdef AF_GOSSIP- AF_GOSSIP -> #const AF_GOSSIP+ Just AF_GOSSIP -> Just #const AF_GOSSIP #endif #ifdef AF_IPX- AF_IPX -> #const AF_IPX+ Just AF_IPX -> Just #const AF_IPX #endif #ifdef Pseudo_AF_XTP- Pseudo_AF_XTP -> #const Pseudo_AF_XTP+ Just Pseudo_AF_XTP -> Just #const Pseudo_AF_XTP #endif #ifdef AF_CTF- AF_CTF -> #const AF_CTF+ Just AF_CTF -> Just #const AF_CTF #endif #ifdef AF_WAN- AF_WAN -> #const AF_WAN+ Just AF_WAN -> Just #const AF_WAN #endif #ifdef AF_SDL- AF_SDL -> #const AF_SDL+ Just AF_SDL -> Just #const AF_SDL #endif #ifdef AF_NETWARE- AF_NETWARE -> #const AF_NETWARE + Just AF_NETWARE -> Just #const AF_NETWARE #endif #ifdef AF_NDD- AF_NDD -> #const AF_NDD + Just AF_NDD -> Just #const AF_NDD #endif #ifdef AF_INTF- AF_INTF -> #const AF_INTF+ Just AF_INTF -> Just #const AF_INTF #endif #ifdef AF_COIP- AF_COIP -> #const AF_COIP+ Just AF_COIP -> Just #const AF_COIP #endif #ifdef AF_CNT- AF_CNT -> #const AF_CNT+ Just AF_CNT -> Just #const AF_CNT #endif #ifdef Pseudo_AF_RTIP- Pseudo_AF_RTIP -> #const Pseudo_AF_RTIP+ Just Pseudo_AF_RTIP -> Just #const Pseudo_AF_RTIP #endif #ifdef Pseudo_AF_PIP- Pseudo_AF_PIP -> #const Pseudo_AF_PIP+ Just Pseudo_AF_PIP -> Just #const Pseudo_AF_PIP #endif #ifdef AF_SIP- AF_SIP -> #const AF_SIP+ Just AF_SIP -> Just #const AF_SIP #endif #ifdef AF_ISDN- AF_ISDN -> #const AF_ISDN+ Just AF_ISDN -> Just #const AF_ISDN #endif #ifdef Pseudo_AF_KEY- Pseudo_AF_KEY -> #const Pseudo_AF_KEY+ Just Pseudo_AF_KEY -> Just #const Pseudo_AF_KEY #endif #ifdef AF_NATM- AF_NATM -> #const AF_NATM+ Just AF_NATM -> Just #const AF_NATM #endif #ifdef AF_ARP- AF_ARP -> #const AF_ARP+ Just AF_ARP -> Just #const AF_ARP #endif #ifdef Pseudo_AF_HDRCMPLT- Pseudo_AF_HDRCMPLT -> #const Pseudo_AF_HDRCMPLT+ Just Pseudo_AF_HDRCMPLT -> Just #const Pseudo_AF_HDRCMPLT #endif #ifdef AF_ENCAP- AF_ENCAP -> #const AF_ENCAP + Just AF_ENCAP -> Just #const AF_ENCAP #endif #ifdef AF_LINK- AF_LINK -> #const AF_LINK+ Just AF_LINK -> Just #const AF_LINK #endif #ifdef AF_RAW- AF_RAW -> #const AF_RAW+ Just AF_RAW -> Just #const AF_RAW #endif #ifdef AF_RIF- AF_RIF -> #const AF_RIF+ Just AF_RIF -> Just #const AF_RIF #endif #ifdef AF_NETROM- AF_NETROM -> #const AF_NETROM+ Just AF_NETROM -> Just #const AF_NETROM #endif #ifdef AF_BRIDGE- AF_BRIDGE -> #const AF_BRIDGE+ Just AF_BRIDGE -> Just #const AF_BRIDGE #endif #ifdef AF_ATMPVC- AF_ATMPVC -> #const AF_ATMPVC+ Just AF_ATMPVC -> Just #const AF_ATMPVC #endif #ifdef AF_ROSE- AF_ROSE -> #const AF_ROSE+ Just AF_ROSE -> Just #const AF_ROSE #endif #ifdef AF_NETBEUI- AF_NETBEUI -> #const AF_NETBEUI+ Just AF_NETBEUI -> Just #const AF_NETBEUI #endif #ifdef AF_SECURITY- AF_SECURITY -> #const AF_SECURITY+ Just AF_SECURITY -> Just #const AF_SECURITY #endif #ifdef AF_PACKET- AF_PACKET -> #const AF_PACKET+ Just AF_PACKET -> Just #const AF_PACKET #endif #ifdef AF_ASH- AF_ASH -> #const AF_ASH+ Just AF_ASH -> Just #const AF_ASH #endif #ifdef AF_ECONET- AF_ECONET -> #const AF_ECONET+ Just AF_ECONET -> Just #const AF_ECONET #endif #ifdef AF_ATMSVC- AF_ATMSVC -> #const AF_ATMSVC+ Just AF_ATMSVC -> Just #const AF_ATMSVC #endif #ifdef AF_IRDA- AF_IRDA -> #const AF_IRDA+ Just AF_IRDA -> Just #const AF_IRDA #endif #ifdef AF_PPPOX- AF_PPPOX -> #const AF_PPPOX+ Just AF_PPPOX -> Just #const AF_PPPOX #endif #ifdef AF_WANPIPE- AF_WANPIPE -> #const AF_WANPIPE+ Just AF_WANPIPE -> Just #const AF_WANPIPE #endif #ifdef AF_BLUETOOTH- AF_BLUETOOTH -> #const AF_BLUETOOTH+ Just AF_BLUETOOTH -> Just #const AF_BLUETOOTH #endif+ _ -> Nothing --------- ---------- +unpackFamily :: CInt -> Family unpackFamily f = case f of (#const AF_UNSPEC) -> AF_UNSPEC #ifdef AF_UNIX@@ -1606,64 +1520,89 @@ -- | Socket Types. ----- This data type might have different constructors depending on what is--- supported by the operating system.+-- The existence of a constructor does not necessarily imply that that+-- socket type is supported on your system: see 'isSupportedSocketType'. data SocketType- = NoSocketType-#ifdef SOCK_STREAM- | Stream -#endif-#ifdef SOCK_DGRAM- | Datagram-#endif-#ifdef SOCK_RAW- | Raw -#endif-#ifdef SOCK_RDM- | RDM -#endif-#ifdef SOCK_SEQPACKET- | SeqPacket-#endif+ = NoSocketType -- ^ 0, used in getAddrInfo hints, for example+ | Stream -- ^ SOCK_STREAM+ | Datagram -- ^ SOCK_DGRAM+ | Raw -- ^ SOCK_RAW+ | RDM -- ^ SOCK_RDM+ | SeqPacket -- ^ SOCK_SEQPACKET deriving (Eq, Ord, Read, Show, Typeable) -packSocketType stype = case stype of- NoSocketType -> 0+-- | Does the SOCK_ constant corresponding to the given SocketType exist on+-- this system?+isSupportedSocketType :: SocketType -> Bool+isSupportedSocketType = isJust . packSocketType'++-- | Find the SOCK_ constant corresponding to the SocketType value.+packSocketType' :: SocketType -> Maybe CInt+packSocketType' stype = case Just stype of+ -- the Just above is to disable GHC's overlapping pattern+ -- detection: see comments for packSocketOption+ Just NoSocketType -> Just 0 #ifdef SOCK_STREAM- Stream -> #const SOCK_STREAM+ Just Stream -> Just #const SOCK_STREAM #endif #ifdef SOCK_DGRAM- Datagram -> #const SOCK_DGRAM+ Just Datagram -> Just #const SOCK_DGRAM #endif #ifdef SOCK_RAW- Raw -> #const SOCK_RAW+ Just Raw -> Just #const SOCK_RAW #endif #ifdef SOCK_RDM- RDM -> #const SOCK_RDM+ Just RDM -> Just #const SOCK_RDM #endif #ifdef SOCK_SEQPACKET- SeqPacket -> #const SOCK_SEQPACKET+ Just SeqPacket -> Just #const SOCK_SEQPACKET #endif+ _ -> Nothing +packSocketType :: SocketType -> CInt+packSocketType stype = fromMaybe (error errMsg) (packSocketType' stype)+ where+ errMsg = concat ["Network.Socket.packSocketType: ",+ "socket type ", show stype, " unsupported on this system"]++-- | Try packSocketType' on the SocketType, if it fails throw an error with+-- message starting "Network.Socket." ++ the String parameter+packSocketTypeOrThrow :: String -> SocketType -> IO CInt+packSocketTypeOrThrow caller stype = maybe err return (packSocketType' stype)+ where+ err = ioError . userError . concat $ ["Network.Socket.", caller, ": ",+ "socket type ", show stype, " unsupported on this system"]+++unpackSocketType:: CInt -> Maybe SocketType unpackSocketType t = case t of- 0 -> NoSocketType+ 0 -> Just NoSocketType #ifdef SOCK_STREAM- (#const SOCK_STREAM) -> Stream+ (#const SOCK_STREAM) -> Just Stream #endif #ifdef SOCK_DGRAM- (#const SOCK_DGRAM) -> Datagram+ (#const SOCK_DGRAM) -> Just Datagram #endif #ifdef SOCK_RAW- (#const SOCK_RAW) -> Raw+ (#const SOCK_RAW) -> Just Raw #endif #ifdef SOCK_RDM- (#const SOCK_RDM) -> RDM+ (#const SOCK_RDM) -> Just RDM #endif #ifdef SOCK_SEQPACKET- (#const SOCK_SEQPACKET) -> SeqPacket+ (#const SOCK_SEQPACKET) -> Just SeqPacket #endif- _ -> NoSocketType+ _ -> Nothing +-- | Try unpackSocketType on the CInt, if it fails throw an error with+-- message starting "Network.Socket." ++ the String parameter+unpackSocketType' :: String -> CInt -> IO SocketType+unpackSocketType' caller ty = maybe err return (unpackSocketType ty)+ where+ err = ioError . userError . concat $ ["Network.Socket.", caller, ": ",+ "socket type ", show ty, " unsupported on this system"]++ -- --------------------------------------------------------------------------- -- Utility Functions @@ -1724,53 +1663,53 @@ -- | Close the socket. All future operations on the socket object -- will fail. The remote end will receive no more data (after queued -- data is flushed).-sClose :: Socket -> IO ()-sClose (MkSocket s _ _ _ socketStatus) = do +close :: Socket -> IO ()+close (MkSocket s _ _ _ socketStatus) = do modifyMVar_ socketStatus $ \ status -> case status of ConvertedToHandle ->- ioError (userError ("sClose: converted to a Handle, use hClose instead"))+ ioError (userError ("close: converted to a Handle, use hClose instead")) Closed -> return status- _ -> closeFdWith (close . fromIntegral) (fromIntegral s) >> return Closed+ _ -> closeFdWith (closeFd . fromIntegral) (fromIntegral s) >> return Closed -- ----------------------------------------------------------------------------- -sIsConnected :: Socket -> IO Bool-sIsConnected (MkSocket _ _ _ _ status) = do+isConnected :: Socket -> IO Bool+isConnected (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Connected) -- ----------------------------------------------------------------------------- -- Socket Predicates -sIsBound :: Socket -> IO Bool-sIsBound (MkSocket _ _ _ _ status) = do+isBound :: Socket -> IO Bool+isBound (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Bound) -sIsListening :: Socket -> IO Bool-sIsListening (MkSocket _ _ _ _ status) = do+isListening :: Socket -> IO Bool+isListening (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening) -sIsReadable :: Socket -> IO Bool-sIsReadable (MkSocket _ _ _ _ status) = do+isReadable :: Socket -> IO Bool+isReadable (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening || value == Connected) -sIsWritable :: Socket -> IO Bool-sIsWritable = sIsReadable -- sort of.+isWritable :: Socket -> IO Bool+isWritable = isReadable -- sort of. -sIsAcceptable :: Socket -> IO Bool+isAcceptable :: Socket -> IO Bool #if defined(DOMAIN_SOCKET_SUPPORT)-sIsAcceptable (MkSocket _ AF_UNIX x _ status)+isAcceptable (MkSocket _ AF_UNIX x _ status) | x == Stream || x == SeqPacket = do value <- readMVar status return (value == Connected || value == Bound || value == Listening)-sIsAcceptable (MkSocket _ AF_UNIX _ _ _) = return False+isAcceptable (MkSocket _ AF_UNIX _ _ _) = return False #endif-sIsAcceptable (MkSocket _ _ _ _ status) = do+isAcceptable (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Connected || value == Listening) @@ -1815,6 +1754,7 @@ # elif defined(__HUGS__) h <- openFd (fromIntegral fd) True{-is a socket-} mode True{-bin-} # endif+ hSetBuffering h NoBuffering return (ConvertedToHandle, h) #else socketToHandle (MkSocket s family stype protocol status) m =@@ -1921,20 +1861,23 @@ then return Nothing else liftM Just $ peekCString ai_canonname_ptr + socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype return (AddrInfo { addrFlags = unpackBits aiFlagMapping ai_flags, addrFamily = unpackFamily ai_family,- addrSocketType = unpackSocketType ai_socktype,+ addrSocketType = socktype, addrProtocol = ai_protocol, addrAddress = ai_addr, addrCanonName = ai_canonname }) poke p (AddrInfo flags family socketType protocol _ _) = do+ c_stype <- packSocketTypeOrThrow "AddrInfo.poke" socketType+ (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags) (#poke struct addrinfo, ai_family) p (packFamily family)- (#poke struct addrinfo, ai_socktype) p (packSocketType socketType)+ (#poke struct addrinfo, ai_socktype) p c_stype (#poke struct addrinfo, ai_protocol) p protocol -- stuff below is probably not needed, but let's zero it for safety@@ -1978,7 +1921,7 @@ -- | Resolve a host or service name to one or more addresses. -- The 'AddrInfo' values that this function returns contain 'SockAddr' -- values that you can pass directly to 'connect' or--- 'bindSocket'.+-- 'bind'. -- -- This function is protocol independent. It can return both IPv4 and -- IPv6 address information.@@ -2205,8 +2148,8 @@ foreign import CALLCONV unsafe "shutdown" c_shutdown :: CInt -> CInt -> IO CInt -close :: CInt -> IO ()-close fd = throwErrnoIfMinus1Retry_ "Network.Socket.close" $ c_close fd+closeFd :: CInt -> IO ()+closeFd fd = throwErrnoIfMinus1Retry_ "Network.Socket.close" $ c_close fd #if !defined(WITH_WINSOCK) foreign import ccall unsafe "close"@@ -2255,3 +2198,41 @@ c_getsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt foreign import CALLCONV unsafe "setsockopt" c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt++-- ---------------------------------------------------------------------------+-- * Deprecated aliases++-- $deprecated-aliases+--+-- These aliases are deprecated and should not be used in new code.+-- They will be removed in some future version of the package.++-- | Deprecated alias for 'bind'.+bindSocket :: Socket -- Unconnected Socket+ -> SockAddr -- Address to Bind to+ -> IO ()+bindSocket = bind++-- | Deprecated alias for 'close'.+sClose :: Socket -> IO ()+sClose = close++-- | Deprecated alias for 'isConnected'.+sIsConnected :: Socket -> IO Bool+sIsConnected = isConnected++-- | Deprecated alias for 'isBound'.+sIsBound :: Socket -> IO Bool+sIsBound = isBound++-- | Deprecated alias for 'isListening'.+sIsListening :: Socket -> IO Bool+sIsListening = isListening++-- | Deprecated alias for 'isReadable'.+sIsReadable :: Socket -> IO Bool+sIsReadable = isReadable++-- | Deprecated alias for 'isWritable'.+sIsWritable :: Socket -> IO Bool+sIsWritable = isWritable
Network/Socket/Internal.hsc view
@@ -189,7 +189,7 @@ | SockAddrUnix String -- sun_path #endif- deriving (Eq, Typeable)+ deriving (Eq, Ord, Typeable) #if defined(WITH_WINSOCK) || defined(cygwin32_HOST_OS) type CSaFamily = (#type unsigned short)@@ -312,202 +312,76 @@ ------------------------------------------------------------------------ -- Protocol Families. --- | This data type might have different constructors depending on--- what is supported by the operating system.+-- | Address families.+--+-- A constructor being present here does not mean it is supported by the+-- operating system: see 'isSupportedFamily'. data Family = AF_UNSPEC -- unspecified-#ifdef AF_UNIX | AF_UNIX -- local to host (pipes, portals-#endif-#ifdef AF_INET | AF_INET -- internetwork: UDP, TCP, etc-#endif-#ifdef AF_INET6 | AF_INET6 -- Internet Protocol version 6-#endif-#ifdef AF_IMPLINK | AF_IMPLINK -- arpanet imp addresses-#endif-#ifdef AF_PUP | AF_PUP -- pup protocols: e.g. BSP-#endif-#ifdef AF_CHAOS | AF_CHAOS -- mit CHAOS protocols-#endif-#ifdef AF_NS | AF_NS -- XEROX NS protocols-#endif-#ifdef AF_NBS | AF_NBS -- nbs protocols-#endif-#ifdef AF_ECMA | AF_ECMA -- european computer manufacturers-#endif-#ifdef AF_DATAKIT | AF_DATAKIT -- datakit protocols-#endif-#ifdef AF_CCITT | AF_CCITT -- CCITT protocols, X.25 etc-#endif-#ifdef AF_SNA | AF_SNA -- IBM SNA-#endif-#ifdef AF_DECnet | AF_DECnet -- DECnet-#endif-#ifdef AF_DLI | AF_DLI -- Direct data link interface-#endif-#ifdef AF_LAT | AF_LAT -- LAT-#endif-#ifdef AF_HYLINK | AF_HYLINK -- NSC Hyperchannel-#endif-#ifdef AF_APPLETALK | AF_APPLETALK -- Apple Talk-#endif-#ifdef AF_ROUTE | AF_ROUTE -- Internal Routing Protocol-#endif-#ifdef AF_NETBIOS | AF_NETBIOS -- NetBios-style addresses-#endif-#ifdef AF_NIT | AF_NIT -- Network Interface Tap-#endif-#ifdef AF_802 | AF_802 -- IEEE 802.2, also ISO 8802-#endif-#ifdef AF_ISO | AF_ISO -- ISO protocols-#endif-#ifdef AF_OSI | AF_OSI -- umbrella of all families used by OSI-#endif-#ifdef AF_NETMAN | AF_NETMAN -- DNA Network Management-#endif-#ifdef AF_X25 | AF_X25 -- CCITT X.25-#endif-#ifdef AF_AX25 | AF_AX25-#endif-#ifdef AF_OSINET | AF_OSINET -- AFI-#endif-#ifdef AF_GOSSIP | AF_GOSSIP -- US Government OSI-#endif-#ifdef AF_IPX | AF_IPX -- Novell Internet Protocol-#endif-#ifdef Pseudo_AF_XTP | Pseudo_AF_XTP -- eXpress Transfer Protocol (no AF)-#endif-#ifdef AF_CTF | AF_CTF -- Common Trace Facility-#endif-#ifdef AF_WAN | AF_WAN -- Wide Area Network protocols-#endif-#ifdef AF_SDL | AF_SDL -- SGI Data Link for DLPI-#endif-#ifdef AF_NETWARE | AF_NETWARE-#endif-#ifdef AF_NDD | AF_NDD-#endif-#ifdef AF_INTF | AF_INTF -- Debugging use only-#endif-#ifdef AF_COIP | AF_COIP -- connection-oriented IP, aka ST II-#endif-#ifdef AF_CNT | AF_CNT -- Computer Network Technology-#endif-#ifdef Pseudo_AF_RTIP | Pseudo_AF_RTIP -- Help Identify RTIP packets-#endif-#ifdef Pseudo_AF_PIP | Pseudo_AF_PIP -- Help Identify PIP packets-#endif-#ifdef AF_SIP | AF_SIP -- Simple Internet Protocol-#endif-#ifdef AF_ISDN | AF_ISDN -- Integrated Services Digital Network-#endif-#ifdef Pseudo_AF_KEY | Pseudo_AF_KEY -- Internal key-management function-#endif-#ifdef AF_NATM | AF_NATM -- native ATM access-#endif-#ifdef AF_ARP | AF_ARP -- (rev.) addr. res. prot. (RFC 826)-#endif-#ifdef Pseudo_AF_HDRCMPLT | Pseudo_AF_HDRCMPLT -- Used by BPF to not rewrite hdrs in iface output-#endif-#ifdef AF_ENCAP | AF_ENCAP-#endif-#ifdef AF_LINK | AF_LINK -- Link layer interface-#endif-#ifdef AF_RAW | AF_RAW -- Link layer interface-#endif-#ifdef AF_RIF | AF_RIF -- raw interface-#endif-#ifdef AF_NETROM | AF_NETROM -- Amateur radio NetROM-#endif-#ifdef AF_BRIDGE | AF_BRIDGE -- multiprotocol bridge-#endif-#ifdef AF_ATMPVC | AF_ATMPVC -- ATM PVCs-#endif-#ifdef AF_ROSE | AF_ROSE -- Amateur Radio X.25 PLP-#endif-#ifdef AF_NETBEUI | AF_NETBEUI -- 802.2LLC-#endif-#ifdef AF_SECURITY | AF_SECURITY -- Security callback pseudo AF-#endif-#ifdef AF_PACKET | AF_PACKET -- Packet family-#endif-#ifdef AF_ASH | AF_ASH -- Ash-#endif-#ifdef AF_ECONET | AF_ECONET -- Acorn Econet-#endif-#ifdef AF_ATMSVC | AF_ATMSVC -- ATM SVCs-#endif-#ifdef AF_IRDA | AF_IRDA -- IRDA sockets-#endif-#ifdef AF_PPPOX | AF_PPPOX -- PPPoX sockets-#endif-#ifdef AF_WANPIPE | AF_WANPIPE -- Wanpipe API sockets-#endif-#ifdef AF_BLUETOOTH | AF_BLUETOOTH -- bluetooth sockets-#endif deriving (Eq, Ord, Read, Show) -- ---------------------------------------------------------------------
Network/URI.hs view
@@ -80,6 +80,10 @@ , isIPv6address , isIPv4address + -- * Predicates+ , uriIsAbsolute+ , uriIsRelative+ -- * Relative URIs , relativeTo , nonStrictRelativeTo@@ -96,6 +100,7 @@ , uriToString , isReserved, isUnreserved , isAllowedInURI, isUnescapedInURI+ , isUnescapedInURIComponent , escapeURIChar , escapeURIString , unEscapeString@@ -122,6 +127,7 @@ import Control.Monad (MonadPlus(..)) import Data.Char (ord, chr, isHexDigit, toLower, toUpper, digitToInt)+import Data.Bits ((.|.),(.&.),shiftL,shiftR) import Debug.Trace (trace) import Numeric (showIntAtBase) @@ -155,7 +161,7 @@ , uriPath :: String -- ^ @\/ghc@ , uriQuery :: String -- ^ @?query@ , uriFragment :: String -- ^ @#frag@- } deriving (Eq+ } deriving (Eq, Ord #ifdef __GLASGOW_HASKELL__ , Typeable, Data #endif@@ -174,7 +180,7 @@ { uriUserInfo :: String -- ^ @anonymous\@@ , uriRegName :: String -- ^ @www.haskell.org@ , uriPort :: String -- ^ @:42@- } deriving (Eq+ } deriving (Eq, Ord, Show #ifdef __GLASGOW_HASKELL__ , Typeable, Data #endif@@ -332,6 +338,16 @@ } ------------------------------------------------------------+-- Predicates+------------------------------------------------------------++uriIsAbsolute :: URI -> Bool+uriIsAbsolute (URI {uriScheme = scheme}) = scheme /= ""++uriIsRelative :: URI -> Bool+uriIsRelative = not . uriIsAbsolute++------------------------------------------------------------ -- URI parser body based on Parsec elements and combinators ------------------------------------------------------------ @@ -892,6 +908,11 @@ isUnescapedInURI :: Char -> Bool isUnescapedInURI c = isReserved c || isUnreserved c +-- | Returns 'True' if the character is allowed unescaped in a URI component.+--+isUnescapedInURIComponent :: Char -> Bool+isUnescapedInURIComponent c = not (isReserved c || not (isUnescapedInURI c))+ ------------------------------------------------------------ -- Escape sequence handling ------------------------------------------------------------@@ -902,7 +923,7 @@ escapeURIChar :: (Char->Bool) -> Char -> String escapeURIChar p c | p c = [c]- | otherwise = '%' : myShowHex (ord c) ""+ | otherwise = concatMap (\i -> '%' : myShowHex i "") (utf8EncodeChar c) where myShowHex :: Int -> ShowS myShowHex n r = case showIntAtBase 16 (toChrHex) n r of@@ -913,6 +934,29 @@ | d < 10 = chr (ord '0' + fromIntegral d) | otherwise = chr (ord 'A' + fromIntegral (d - 10)) +-- From http://hackage.haskell.org/package/utf8-string+-- by Eric Mertens, BSD3+-- Returns [Int] for use with showIntAtBase+utf8EncodeChar :: Char -> [Int]+utf8EncodeChar = map fromIntegral . go . ord+ where+ go oc+ | oc <= 0x7f = [oc]++ | oc <= 0x7ff = [ 0xc0 + (oc `shiftR` 6)+ , 0x80 + oc .&. 0x3f+ ]++ | oc <= 0xffff = [ 0xe0 + (oc `shiftR` 12)+ , 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ , 0x80 + oc .&. 0x3f+ ]+ | otherwise = [ 0xf0 + (oc `shiftR` 18)+ , 0x80 + ((oc `shiftR` 12) .&. 0x3f)+ , 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ , 0x80 + oc .&. 0x3f+ ]+ -- |Can be used to make a string valid for use in a URI. -- escapeURIString@@ -945,7 +989,7 @@ -- Algorithm from RFC3986 [3], section 5.2.2 -- -nonStrictRelativeTo :: URI -> URI -> Maybe URI+nonStrictRelativeTo :: URI -> URI -> URI nonStrictRelativeTo ref base = relativeTo ref' base where ref' = if uriScheme ref == uriScheme base@@ -955,9 +999,11 @@ isDefined :: ( MonadPlus m, Eq (m a) ) => m a -> Bool isDefined a = a /= mzero --- |Compute an absolute 'URI' for a supplied URI--- relative to a given base.-relativeTo :: URI -> URI -> Maybe URI+-- | Returns a new 'URI' which represents the value of the first 'URI'+-- interpreted as relative to the second 'URI'.+--+-- Algorithm from RFC3986 [3], section 5.2+relativeTo :: URI -> URI -> URI relativeTo ref base | isDefined ( uriScheme ref ) = just_segments ref@@ -990,7 +1036,7 @@ } where just_segments u =- Just $ u { uriPath = removeDotSegments (uriPath u) }+ u { uriPath = removeDotSegments (uriPath u) } mergePaths b r | isDefined (uriAuthority b) && null pb = '/':pr | otherwise = dropLast pb ++ pr
cbits/ancilData.c view
@@ -30,15 +30,6 @@ * * - no support for scattered read/writes. * - only possible to send one ancillary chunk of data at a time.- *- *- * NOTE: recv/sendAncillary() is being phased out in preference- * of the more specific send/recvFd(), as the latter is- * really the only application of recv/sendAncillary() and- * stand the chance of being supported on platforms that- * don't have send/recvmsg() (but do have ioctl() support- * for this kind of thing, for instance.)- * */ int@@ -80,50 +71,6 @@ } int-sendAncillary(int sock,- int level,- int type,- int flags,- void* data,- int len)-{- struct msghdr msg = {0};- struct iovec iov[1];- char buf[2];-#if HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS- /* Contains the older BSD msghdr fields only, so no room- for 'type' or 'level' data.- */- msg.msg_accrights = data;- msg.msg_accrightslen=len;-#else- struct cmsghdr *cmsg;- char ancBuffer[CMSG_SPACE(len)];- char* dPtr;- - msg.msg_control = ancBuffer;- msg.msg_controllen = sizeof(ancBuffer);-- cmsg = CMSG_FIRSTHDR(&msg);- cmsg->cmsg_level = level;- cmsg->cmsg_type = type;- cmsg->cmsg_len = CMSG_LEN(len);- dPtr = (char*)CMSG_DATA(cmsg);- - memcpy(dPtr, data, len);- msg.msg_controllen = cmsg->cmsg_len;-#endif- buf[0] = 0; buf[1] = '\0';- iov[0].iov_base = buf;- iov[0].iov_len = 2;-- msg.msg_iov = iov;- msg.msg_iovlen = 1;- - return sendmsg(sock,&msg,flags);-}--int recvFd(int sock) { struct msghdr msg = {0};@@ -173,65 +120,4 @@ #endif } --int-recvAncillary(int sock,- int* pLevel,- int* pType,- int flags,- void** pData,- int* pLen)-{- struct msghdr msg = {0};- char duffBuf[10];- int rc;- struct iovec iov[1];-#if HAVE_STRUCT_MSGHDR_MSG_CONTROL- struct cmsghdr *cmsg = NULL;- struct cmsghdr *cptr;-#endif- - iov[0].iov_base = duffBuf;- iov[0].iov_len = sizeof(duffBuf);- msg.msg_iov = iov;- msg.msg_iovlen = 1;--#if HAVE_STRUCT_MSGHDR_MSG_CONTROL- cmsg = (struct cmsghdr*)malloc(CMSG_SPACE(*pLen));- if (cmsg==NULL) {- return -1;- }- - msg.msg_control = (void *)cmsg;- msg.msg_controllen = CMSG_LEN(*pLen);-#else- *pData = (void*)malloc(*pLen);- if (*pData) {- msg.msg_accrights = *pData;- } else {- return -1;- }- msg.msg_accrightslen = *pLen;-#endif-- if ((rc = recvmsg(sock,&msg,flags)) < 0) {- return rc;- }- -#if HAVE_STRUCT_MSGHDR_MSG_CONTROL- cptr = (struct cmsghdr*)CMSG_FIRSTHDR(&msg);-- *pLevel = cptr->cmsg_level;- *pType = cptr->cmsg_type;- /* The length of the data portion only */- *pLen = cptr->cmsg_len - sizeof(struct cmsghdr);- *pData = CMSG_DATA(cptr);-#else- /* Sensible defaults, I hope.. */- *pLevel = 0;- *pType = 0;-#endif-- return rc;-} #endif
configure view
@@ -1,11 +1,13 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.69 for Haskell network package 2.3.0.14.+# Generated by GNU Autoconf 2.68 for Haskell network package 2.3.0.14. # # Report bugs to <libraries@haskell.org>. # #-# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software+# Foundation, Inc. # # # This configure script is free software; the Free Software Foundation@@ -134,31 +136,6 @@ # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH -# Use a proper internal environment variable to ensure we don't fall- # into an infinite loop, continuously re-executing ourselves.- if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then- _as_can_reexec=no; export _as_can_reexec;- # We cannot yet assume a decent shell, so we have to provide a-# neutralization value for shells without unset; and this also-# works around shells that cannot unset nonexistent variables.-# Preserve -v and -x to the replacement shell.-BASH_ENV=/dev/null-ENV=/dev/null-(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV-case $- in # ((((- *v*x* | *x*v* ) as_opts=-vx ;;- *v* ) as_opts=-v ;;- *x* ) as_opts=-x ;;- * ) as_opts= ;;-esac-exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}-# Admittedly, this is quite paranoid, since all the known shells bail-# out after a failed `exec'.-$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2-as_fn_exit 255- fi- # We don't want this to propagate to other subprocesses.- { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : emulate sh@@ -192,8 +169,7 @@ else exitcode=1; echo positional parameters were not saved. fi-test x\$exitcode = x0 || exit 1-test -x / || exit 1"+test x\$exitcode = x0 || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&@@ -238,25 +214,21 @@ if test "x$CONFIG_SHELL" != x; then :- export CONFIG_SHELL- # We cannot yet assume a decent shell, so we have to provide a-# neutralization value for shells without unset; and this also-# works around shells that cannot unset nonexistent variables.-# Preserve -v and -x to the replacement shell.-BASH_ENV=/dev/null-ENV=/dev/null-(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV-case $- in # ((((- *v*x* | *x*v* ) as_opts=-vx ;;- *v* ) as_opts=-v ;;- *x* ) as_opts=-x ;;- * ) as_opts= ;;-esac-exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}-# Admittedly, this is quite paranoid, since all the known shells bail-# out after a failed `exec'.-$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2-exit 255+ # We cannot yet assume a decent shell, so we have to provide a+ # neutralization value for shells without unset; and this also+ # works around shells that cannot unset nonexistent variables.+ # Preserve -v and -x to the replacement shell.+ BASH_ENV=/dev/null+ ENV=/dev/null+ (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+ export CONFIG_SHELL+ case $- in # ((((+ *v*x* | *x*v* ) as_opts=-vx ;;+ *v* ) as_opts=-v ;;+ *x* ) as_opts=-x ;;+ * ) as_opts= ;;+ esac+ exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} fi if test x$as_have_required = xno; then :@@ -359,14 +331,6 @@ } # as_fn_mkdir_p--# as_fn_executable_p FILE-# ------------------------# Test if FILE is an executable regular file.-as_fn_executable_p ()-{- test -f "$1" && test -x "$1"-} # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take@@ -488,10 +452,6 @@ chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } - # If we had to re-execute with $CONFIG_SHELL, we're ensured to have- # already done that, so ensure we don't try to do so again and fall- # in an infinite loop. This has already happened in practice.- _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this).@@ -526,16 +486,16 @@ # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.- # In both cases, we have to default to `cp -pR'.+ # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||- as_ln_s='cp -pR'+ as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else- as_ln_s='cp -pR'+ as_ln_s='cp -p' fi else- as_ln_s='cp -pR'+ as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null@@ -547,8 +507,28 @@ as_mkdir_p=false fi -as_test_x='test -x'-as_executable_p=as_fn_executable_p+if test -x / >/dev/null 2>&1; then+ as_test_x='test -x'+else+ if ls -dL / >/dev/null 2>&1; then+ as_ls_L_option=L+ else+ as_ls_L_option=+ fi+ as_test_x='+ eval sh -c '\''+ if test -d "$1"; then+ test -d "$1/.";+ else+ case $1 in #(+ -*)set "./$1";;+ esac;+ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((+ ???[sx]*):;;*)false;;esac;fi+ '\'' sh+ '+fi+as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"@@ -1153,6 +1133,8 @@ if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe+ $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.+ If a cross compiler is detected then cross compile mode will be used" >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi@@ -1389,9 +1371,9 @@ if $ac_init_version; then cat <<\_ACEOF Haskell network package configure 2.3.0.14-generated by GNU Autoconf 2.69+generated by GNU Autoconf 2.68 -Copyright (C) 2012 Free Software Foundation, Inc.+Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF@@ -1668,7 +1650,7 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes ||- test -x conftest$ac_exeext+ $as_test_x conftest$ac_exeext }; then : ac_retval=0 else@@ -1861,7 +1843,7 @@ running configure, to aid debugging if configure makes a mistake. It was created by Haskell network package $as_me 2.3.0.14, which was-generated by GNU Autoconf 2.69. Invocation command line was+generated by GNU Autoconf 2.68. Invocation command line was $ $0 $@ @@ -2226,6 +2208,9 @@ # include <ws2tcpip.h> // fix for MingW not defining IPV6_V6ONLY # define IPV6_V6ONLY 27+#endif+#ifdef HAVE_WSPIAPI_H+# include <wspiapi.h> #endif" # Safety check: Ensure that we are in the correct source directory.@@ -2363,7 +2348,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -2403,7 +2388,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -2456,7 +2441,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -2497,7 +2482,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue@@ -2555,7 +2540,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -2599,7 +2584,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+ if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -3045,7 +3030,8 @@ /* end confdefs.h. */ #include <stdarg.h> #include <stdio.h>-struct stat;+#include <sys/types.h>+#include <sys/stat.h> /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int);@@ -3143,11 +3129,11 @@ int main () {-+/* FIXME: Include the comments suggested by Paul. */ #ifndef __cplusplus- /* Ultrix mips cc rejects this sort of thing. */+ /* Ultrix mips cc rejects this. */ typedef int charset[2];- const charset cs = { 0, 0 };+ const charset cs; /* SunOS 4.1.1 cc rejects this. */ char const *const *pcpcc; char **ppc;@@ -3164,9 +3150,8 @@ ++pcpcc; ppc = (char**) pcpcc; pcpcc = (char const *const *) ppc;- { /* SCO 3.2v4 cc rejects this sort of thing. */- char tx;- char *t = &tx;+ { /* SCO 3.2v4 cc rejects this. */+ char *t; char const *s = 0 ? (char *) 0 : (char const *) 0; *t++ = 0;@@ -3182,10 +3167,10 @@ iptr p = 0; ++p; }- { /* AIX XL C 1.02.0.0 rejects this sort of thing, saying+ { /* AIX XL C 1.02.0.0 rejects this saying "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */- struct s { int j; const int *ap[3]; } bx;- struct s *b = &bx; b->j = 5;+ struct s { int j; const int *ap[3]; };+ struct s *b; b->j = 5; } { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ const int foo = 10;@@ -3368,7 +3353,7 @@ for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"- as_fn_executable_p "$ac_path_GREP" || continue+ { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in@@ -3434,7 +3419,7 @@ for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"- as_fn_executable_p "$ac_path_EGREP" || continue+ { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in@@ -3611,7 +3596,7 @@ done -for ac_header in fcntl.h limits.h stdlib.h sys/types.h unistd.h winsock2.h ws2tcpip.h+for ac_header in fcntl.h limits.h stdlib.h sys/types.h unistd.h winsock2.h ws2tcpip.h wspiapi.h do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"@@ -3624,7 +3609,7 @@ done -for ac_header in arpa/inet.h netdb.h netinet/in.h netinet/tcp.h sys/socket.h sys/uio.h sys/un.h linux/can.h linux/tcp.h+for ac_header in arpa/inet.h netdb.h netinet/in.h netinet/tcp.h sys/socket.h sys/uio.h sys/un.h do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"@@ -3637,20 +3622,8 @@ done -for ac_header in net/if.h-do :- ac_fn_c_check_header_mongrel "$LINENO" "net/if.h" "ac_cv_header_net_if_h" "$ac_includes_default"-if test "x$ac_cv_header_net_if_h" = xyes; then :- cat >>confdefs.h <<_ACEOF-#define HAVE_NET_IF_H 1-_ACEOF -fi--done---for ac_func in readlink symlink if_nametoindex+for ac_func in readlink symlink do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"@@ -3805,16 +3778,6 @@ $as_echo "yes" >&6; } fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpeereid in unistd.h" >&5-$as_echo_n "checking for getpeereid in unistd.h... " >&6; }-ac_fn_c_check_func "$LINENO" "getpeereid" "ac_cv_func_getpeereid"-if test "x$ac_cv_func_getpeereid" = xyes; then :--$as_echo "#define HAVE_GETPEEREID 1" >>confdefs.h--fi-- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _head_libws2_32_a in -lws2_32" >&5 $as_echo_n "checking for _head_libws2_32_a in -lws2_32... " >&6; } if ${ac_cv_lib_ws2_32__head_libws2_32_a+:} false; then :@@ -3985,38 +3948,6 @@ _ACEOF -ac_fn_c_check_decl "$LINENO" "IPPROTO_IP" "ac_cv_have_decl_IPPROTO_IP" "$ac_includes_default"-if test "x$ac_cv_have_decl_IPPROTO_IP" = xyes; then :- ac_have_decl=1-else- ac_have_decl=0-fi--cat >>confdefs.h <<_ACEOF-#define HAVE_DECL_IPPROTO_IP $ac_have_decl-_ACEOF-ac_fn_c_check_decl "$LINENO" "IPPROTO_TCP" "ac_cv_have_decl_IPPROTO_TCP" "$ac_includes_default"-if test "x$ac_cv_have_decl_IPPROTO_TCP" = xyes; then :- ac_have_decl=1-else- ac_have_decl=0-fi--cat >>confdefs.h <<_ACEOF-#define HAVE_DECL_IPPROTO_TCP $ac_have_decl-_ACEOF-ac_fn_c_check_decl "$LINENO" "IPPROTO_IPV6" "ac_cv_have_decl_IPPROTO_IPV6" "$ac_includes_default"-if test "x$ac_cv_have_decl_IPPROTO_IPV6" = xyes; then :- ac_have_decl=1-else- ac_have_decl=0-fi--cat >>confdefs.h <<_ACEOF-#define HAVE_DECL_IPPROTO_IPV6 $ac_have_decl-_ACEOF-- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sendfile in sys/sendfile.h" >&5 $as_echo_n "checking for sendfile in sys/sendfile.h... " >&6; } cat confdefs.h - <<_ACEOF >conftest.$ac_ext@@ -4082,7 +4013,7 @@ case "$host" in-*-mingw* | *-msys*)+*-mingw32) EXTRA_SRCS="cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c" EXTRA_LIBS=ws2_32 CALLCONV=stdcall ;;@@ -4510,16 +4441,16 @@ # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.- # In both cases, we have to default to `cp -pR'.+ # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||- as_ln_s='cp -pR'+ as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else- as_ln_s='cp -pR'+ as_ln_s='cp -p' fi else- as_ln_s='cp -pR'+ as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null@@ -4579,16 +4510,28 @@ as_mkdir_p=false fi --# as_fn_executable_p FILE-# ------------------------# Test if FILE is an executable regular file.-as_fn_executable_p ()-{- test -f "$1" && test -x "$1"-} # as_fn_executable_p-as_test_x='test -x'-as_executable_p=as_fn_executable_p+if test -x / >/dev/null 2>&1; then+ as_test_x='test -x'+else+ if ls -dL / >/dev/null 2>&1; then+ as_ls_L_option=L+ else+ as_ls_L_option=+ fi+ as_test_x='+ eval sh -c '\''+ if test -d "$1"; then+ test -d "$1/.";+ else+ case $1 in #(+ -*)set "./$1";;+ esac;+ case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((+ ???[sx]*):;;*)false;;esac;fi+ '\'' sh+ '+fi+as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"@@ -4610,7 +4553,7 @@ # values after options handling. ac_log=" This file was extended by Haskell network package $as_me 2.3.0.14, which was-generated by GNU Autoconf 2.69. Invocation command line was+generated by GNU Autoconf 2.68. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS@@ -4672,10 +4615,10 @@ ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ Haskell network package config.status 2.3.0.14-configured by $0, generated by GNU Autoconf 2.69,+configured by $0, generated by GNU Autoconf 2.68, with options \\"\$ac_cs_config\\" -Copyright (C) 2012 Free Software Foundation, Inc.+Copyright (C) 2010 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -4763,7 +4706,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then- set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion+ set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL'
include/HsNet.h view
@@ -23,7 +23,7 @@ #ifndef INLINE # if defined(_MSC_VER) # define INLINE extern __inline-# elif defined(__GNUC_GNU_INLINE__)+# elif defined(__GNUC__) # define INLINE extern inline # else # define INLINE inline@@ -112,23 +112,6 @@ extern int recvFd(int sock);--/* The next two are scheduled for deletion */-extern int-sendAncillary(int sock,- int level,- int type,- int flags,- void* data,- int len);--extern int-recvAncillary(int sock,- int* pLevel,- int* pType,- int flags,- void** pData,- int* pLen); #endif /* HAVE_WINSOCK2_H && !__CYGWIN */
include/HsNetworkConfig.h view
@@ -2,13 +2,13 @@ /* include/HsNetworkConfig.h.in. Generated from configure.ac by autoheader. */ /* Define to 1 if you have the `accept4' function. */-#define HAVE_ACCEPT4 1+/* #undef HAVE_ACCEPT4 */ /* Define to 1 if you have the <arpa/inet.h> header file. */ #define HAVE_ARPA_INET_H 1 /* Define to 1 if you have a BSDish sendfile(2) implementation. */-/* #undef HAVE_BSD_SENDFILE */+#define HAVE_BSD_SENDFILE 1 /* Define to 1 if you have the declaration of `AI_ADDRCONFIG', and to 0 if you don't. */@@ -26,18 +26,6 @@ don't. */ #define HAVE_DECL_AI_V4MAPPED 1 -/* Define to 1 if you have the declaration of `IPPROTO_IP', and to 0 if you- don't. */-#define HAVE_DECL_IPPROTO_IP 1--/* Define to 1 if you have the declaration of `IPPROTO_IPV6', and to 0 if you- don't. */-#define HAVE_DECL_IPPROTO_IPV6 1--/* Define to 1 if you have the declaration of `IPPROTO_TCP', and to 0 if you- don't. */-#define HAVE_DECL_IPPROTO_TCP 1- /* Define to 1 if you have the declaration of `IPV6_V6ONLY', and to 0 if you don't. */ #define HAVE_DECL_IPV6_V6ONLY 1@@ -54,12 +42,6 @@ /* Define to 1 if you have the `gethostent' function. */ #define HAVE_GETHOSTENT 1 -/* Define to 1 if you have getpeereid. */-/* #undef HAVE_GETPEEREID */--/* Define to 1 if you have the `if_nametoindex' function. */-#define HAVE_IF_NAMETOINDEX 1- /* Define to 1 if you have the <inttypes.h> header file. */ #define HAVE_INTTYPES_H 1 @@ -72,14 +54,8 @@ /* Define to 1 if you have the <limits.h> header file. */ #define HAVE_LIMITS_H 1 -/* Define to 1 if you have the <linux/can.h> header file. */-#define HAVE_LINUX_CAN_H 1- /* Define to 1 if you have a Linux sendfile(2) implementation. */-#define HAVE_LINUX_SENDFILE 1--/* Define to 1 if you have the <linux/tcp.h> header file. */-#define HAVE_LINUX_TCP_H 1+/* #undef HAVE_LINUX_SENDFILE */ /* Define to 1 if you have the <memory.h> header file. */ #define HAVE_MEMORY_H 1@@ -93,9 +69,6 @@ /* Define to 1 if you have the <netinet/tcp.h> header file. */ #define HAVE_NETINET_TCP_H 1 -/* Define to 1 if you have the <net/if.h> header file. */-#define HAVE_NET_IF_H 1- /* Define to 1 if you have the `readlink' function. */ #define HAVE_READLINK 1 @@ -118,10 +91,10 @@ #define HAVE_STRUCT_MSGHDR_MSG_CONTROL 1 /* Define to 1 if `sa_len' is a member of `struct sockaddr'. */-/* #undef HAVE_STRUCT_SOCKADDR_SA_LEN */+#define HAVE_STRUCT_SOCKADDR_SA_LEN 1 /* Define to 1 if you have both SO_PEERCRED and struct ucred. */-#define HAVE_STRUCT_UCRED 1+/* #undef HAVE_STRUCT_UCRED */ /* Define to 1 if you have the `symlink' function. */ #define HAVE_SYMLINK 1@@ -149,6 +122,9 @@ /* Define to 1 if you have the <ws2tcpip.h> header file. */ /* #undef HAVE_WS2TCPIP_H */++/* Define to 1 if you have the <wspiapi.h> header file. */+/* #undef HAVE_WSPIAPI_H */ /* Define to 1 if the `getaddrinfo' function needs WINVER set. */ /* #undef NEED_WINVER_XP */
include/HsNetworkConfig.h.in view
@@ -25,18 +25,6 @@ don't. */ #undef HAVE_DECL_AI_V4MAPPED -/* Define to 1 if you have the declaration of `IPPROTO_IP', and to 0 if you- don't. */-#undef HAVE_DECL_IPPROTO_IP--/* Define to 1 if you have the declaration of `IPPROTO_IPV6', and to 0 if you- don't. */-#undef HAVE_DECL_IPPROTO_IPV6--/* Define to 1 if you have the declaration of `IPPROTO_TCP', and to 0 if you- don't. */-#undef HAVE_DECL_IPPROTO_TCP- /* Define to 1 if you have the declaration of `IPV6_V6ONLY', and to 0 if you don't. */ #undef HAVE_DECL_IPV6_V6ONLY@@ -53,12 +41,6 @@ /* Define to 1 if you have the `gethostent' function. */ #undef HAVE_GETHOSTENT -/* Define to 1 if you have getpeereid. */-#undef HAVE_GETPEEREID--/* Define to 1 if you have the `if_nametoindex' function. */-#undef HAVE_IF_NAMETOINDEX- /* Define to 1 if you have the <inttypes.h> header file. */ #undef HAVE_INTTYPES_H @@ -71,15 +53,9 @@ /* Define to 1 if you have the <limits.h> header file. */ #undef HAVE_LIMITS_H -/* Define to 1 if you have the <linux/can.h> header file. */-#undef HAVE_LINUX_CAN_H- /* Define to 1 if you have a Linux sendfile(2) implementation. */ #undef HAVE_LINUX_SENDFILE -/* Define to 1 if you have the <linux/tcp.h> header file. */-#undef HAVE_LINUX_TCP_H- /* Define to 1 if you have the <memory.h> header file. */ #undef HAVE_MEMORY_H @@ -92,9 +68,6 @@ /* Define to 1 if you have the <netinet/tcp.h> header file. */ #undef HAVE_NETINET_TCP_H -/* Define to 1 if you have the <net/if.h> header file. */-#undef HAVE_NET_IF_H- /* Define to 1 if you have the `readlink' function. */ #undef HAVE_READLINK @@ -148,6 +121,9 @@ /* Define to 1 if you have the <ws2tcpip.h> header file. */ #undef HAVE_WS2TCPIP_H++/* Define to 1 if you have the <wspiapi.h> header file. */+#undef HAVE_WSPIAPI_H /* Define to 1 if the `getaddrinfo' function needs WINVER set. */ #undef NEED_WINVER_XP
network.cabal view
@@ -1,5 +1,5 @@ name: network-version: 2.3.2.1+version: 2.4.0.0 license: BSD3 license-file: LICENSE maintainer: Johan Tibell <johan.tibell@gmail.com>@@ -18,7 +18,7 @@ -- C sources only used on some systems cbits/ancilData.c cbits/asyncAccept.c cbits/initWinSock.c cbits/winSockErr.c-homepage: http://github.com/haskell/network+homepage: https://github.com/haskell/network bug-reports: https://github.com/haskell/network/issues library@@ -39,9 +39,9 @@ Network.Socket.ByteString.MsgHdr build-depends:- base >= 3 && < 4.10,+ base >= 3 && < 5, bytestring,- parsec >= 3.1+ parsec >= 2.0 if !os(windows) build-depends:
tests/uri001.hs view
@@ -32,9 +32,11 @@ , parseURI, parseURIReference, parseRelativeReference, parseAbsoluteURI , parseAbsoluteURI , isURI, isURIReference, isRelativeReference, isAbsoluteURI+ , uriIsAbsolute, uriIsRelative , relativeTo, nonStrictRelativeTo , relativeFrom , uriToString+ , isUnescapedInURIComponent , isUnescapedInURI, escapeURIString, unEscapeString , normalizeCase, normalizeEscape, normalizePathSegments )@@ -438,11 +440,9 @@ testRelJoin label base urel uabs = testEq label uabs (mkabs purel pubas) where- mkabs (Just u1) (Just u2) = shabs (u1 `relativeTo` u2)+ mkabs (Just u1) (Just u2) = show (u1 `relativeTo` u2) mkabs Nothing _ = "Invalid URI: "++urel mkabs _ Nothing = "Invalid URI: "++uabs- shabs (Just u) = show u- shabs Nothing = "No result" purel = parseURIReference urel pubas = parseURIReference base @@ -1064,12 +1064,21 @@ testEscapeURIString04 = testEq "testEscapeURIString04" te02str (unEscapeString te02esc) +testEscapeURIString05 = testEq "testEscapeURIString05"+ "http%3A%2F%2Fexample.org%2Faz%2F09-_%2F.~%3A%2F%3F%23%5B%5D%40%21%24%26%27%28%29%2A%2B%2C%3B%3D"+ (escapeURIString isUnescapedInURIComponent te01str) +testEscapeURIString06 = testEq "testEscapeURIString06"+ "hello%C3%B8%C2%A9%E6%97%A5%E6%9C%AC"+ (escapeURIString isUnescapedInURIComponent "helloø©日本")+ testEscapeURIString = TF.testGroup "testEscapeURIString" [ TF.testCase "testEscapeURIString01" testEscapeURIString01 , TF.testCase "testEscapeURIString02" testEscapeURIString02 , TF.testCase "testEscapeURIString03" testEscapeURIString03 , TF.testCase "testEscapeURIString04" testEscapeURIString04+ , TF.testCase "testEscapeURIString05" testEscapeURIString05+ , TF.testCase "testEscapeURIString06" testEscapeURIString06 ] -- URI string normalization tests@@ -1123,17 +1132,17 @@ testRelativeTo01 = testEq "testRelativeTo01" "http://bar.org/foo"- (show . fromJust $+ (show $ (fromJust $ parseURIReference "foo") `relativeTo` trbase) testRelativeTo02 = testEq "testRelativeTo02" "http:foo"- (show . fromJust $+ (show $ (fromJust $ parseURIReference "http:foo") `relativeTo` trbase) testRelativeTo03 = testEq "testRelativeTo03" "http://bar.org/foo"- (show . fromJust $+ (show $ (fromJust $ parseURIReference "http:foo") `nonStrictRelativeTo` trbase) testRelativeTo = TF.testGroup "testRelativeTo"@@ -1186,6 +1195,31 @@ , TF.testCase "testAltFn17" testAltFn17 ] +testUriIsAbsolute :: String -> Assertion+testUriIsAbsolute str =+ assertBool str (uriIsAbsolute uri)+ where+ Just uri = parseURIReference str++testUriIsRelative :: String -> Assertion+testUriIsRelative str =+ assertBool str (uriIsRelative uri)+ where+ Just uri = parseURIReference str++testIsAbsolute = TF.testGroup "testIsAbsolute"+ [ TF.testCase "testIsAbsolute01" $ testUriIsAbsolute "http://google.com"+ , TF.testCase "testIsAbsolute02" $ testUriIsAbsolute "ftp://p.x.ca/woo?hai=a"+ , TF.testCase "testIsAbsolute03" $ testUriIsAbsolute "mailto:bob@example.com"+ ]++testIsRelative = TF.testGroup "testIsRelative"+ [ TF.testCase "testIsRelative01" $ testUriIsRelative "//google.com"+ , TF.testCase "testIsRelative02" $ testUriIsRelative "/hello"+ , TF.testCase "testIsRelative03" $ testUriIsRelative "this/is/a/path"+ , TF.testCase "testIsRelative04" $ testUriIsRelative "?what=that"+ ]+ -- Full test suite allTests = [ testURIRefSuite@@ -1199,6 +1233,8 @@ , testNormalizeURIString , testRelativeTo , testAltFn+ , testIsAbsolute+ , testIsRelative ] main = TF.defaultMain allTests