network 2.4.1.2 → 2.4.2.0
raw patch · 13 files changed
+164/−53 lines, 13 files
Files
- Network.hs +17/−9
- Network/BSD.hsc +16/−16
- Network/Socket.hsc +39/−12
- Network/Socket/ByteString.hsc +1/−1
- Network/Socket/ByteString/IOVec.hsc +1/−0
- Network/Socket/Types.hsc +3/−2
- Network/URI.hs +7/−7
- configure +4/−4
- configure.ac +7/−1
- include/HsNet.h +4/−0
- network.buildinfo.in +1/−0
- network.cabal +1/−1
- tests/Simple.hs +63/−0
Network.hs view
@@ -4,7 +4,7 @@ -- Module : Network -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/network/LICENSE)--- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable@@ -32,7 +32,7 @@ -- * Initialisation , withSocketsDo- + -- * Server-side connections , listenOn , accept@@ -63,7 +63,8 @@ import Control.Monad (liftM) import Data.Maybe (fromJust) import Network.BSD-import Network.Socket hiding (accept, socketPort, recvFrom, sendTo, PortNumber)+import Network.Socket hiding (accept, socketPort, recvFrom,+ sendTo, PortNumber, sClose) import qualified Network.Socket as Socket (accept) import System.IO import Prelude@@ -77,7 +78,7 @@ -- raised. Alternatively an empty string may be given to @connectTo@ -- signalling that the current hostname applies. -data PortID = +data PortID = Service String -- Service Name eg "ftp" | PortNumber PortNumber -- User defined Port Number #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32)@@ -88,7 +89,7 @@ -- | Calling 'connectTo' creates a client side socket which is -- connected to the given host and port. The Protocol and socket type is -- derived from the given port identifier. If a port number is given--- then the result is always an internet family 'Stream' socket. +-- then the result is always an internet family 'Stream' socket. connectTo :: HostName -- Hostname -> PortID -- Port Identifier@@ -267,14 +268,14 @@ accept :: Socket -- ^ Listening Socket -> IO (Handle, HostName,- PortNumber) -- ^ Triple of: read\/write 'Handle' for + PortNumber) -- ^ Triple of: read\/write 'Handle' for -- communicating with the client, -- the 'HostName' of the peer socket, and -- the 'PortNumber' of the remote connection. accept sock@(MkSocket _ AF_INET _ _ _) = do ~(sock', (SockAddrInet port haddr)) <- Socket.accept sock peer <- catchIO- (do + (do (HostEntry peer _ _ _) <- getHostByAddr AF_INET haddr return peer )@@ -308,6 +309,13 @@ accept (MkSocket _ family _ _ _) = error $ "Sorry, address family " ++ (show family) ++ " is not supported!" ++-- | 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 = close -- Explicit redefinition because Network.sClose is deperecated,+ -- hence the re-export would also be marked as such.+ -- ----------------------------------------------------------------------------- -- sendTo/recvFrom @@ -361,7 +369,7 @@ ip <- getHostByName host let ipHs = hostAddresses ip s <- listenOn port- let + let waiting = do ~(s', SockAddrInet _ haddr) <- Socket.accept s he <- getHostByAddr AF_INET haddr@@ -400,7 +408,7 @@ -- --------------------------------------------------------------------------- -- Utils --- Like bracket, but only performs the final action if there was an +-- Like bracket, but only performs the final action if there was an -- exception raised by the middle bit. bracketOnError :: IO a -- ^ computation to run first (\"acquire resource\")
Network/BSD.hsc view
@@ -4,7 +4,7 @@ -- Module : Network.BSD -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/network/LICENSE)--- +-- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable@@ -141,7 +141,7 @@ -- close the database a call to endServiceEntry is required. This -- database file is usually stored in the file /etc/services. -data ServiceEntry = +data ServiceEntry = ServiceEntry { serviceName :: ServiceName, -- Official Name serviceAliases :: [ServiceName], -- aliases@@ -187,7 +187,7 @@ $ (trySysCall (c_getservbyname cstr_name cstr_proto)) >>= peek -foreign import CALLCONV unsafe "getservbyname" +foreign import CALLCONV unsafe "getservbyname" c_getservbyname :: CString -> CString -> IO (Ptr ServiceEntry) -- | Get the service given a 'PortNumber' and 'ProtocolName'.@@ -198,7 +198,7 @@ $ (trySysCall (c_getservbyport (fromIntegral port) cstr_proto)) >>= peek -foreign import CALLCONV unsafe "getservbyport" +foreign import CALLCONV unsafe "getservbyport" c_getservbyport :: CInt -> CString -> IO (Ptr ServiceEntry) -- | Get the 'PortNumber' corresponding to the 'ServiceName'.@@ -242,9 +242,9 @@ -- As for setServiceEntry above, calling setProtocolEntry. -- determines whether or not the protocol database file, usually -- @/etc/protocols@, is to be kept open between calls of--- getProtocolEntry. Similarly, +-- getProtocolEntry. Similarly, -data ProtocolEntry = +data ProtocolEntry = ProtocolEntry { protoName :: ProtocolName, -- Official Name protoAliases :: [ProtocolName], -- aliases@@ -264,12 +264,12 @@ -- With WinSock, the protocol number is only a short; -- hoist it in as such, but represent it on the Haskell side -- as a CInt.- p_proto_short <- (#peek struct protoent, p_proto) p + p_proto_short <- (#peek struct protoent, p_proto) p let p_proto = fromIntegral (p_proto_short :: CShort) #else- p_proto <- (#peek struct protoent, p_proto) p + p_proto <- (#peek struct protoent, p_proto) p #endif- return (ProtocolEntry { + return (ProtocolEntry { protoName = p_name, protoAliases = p_aliases, protoNumber = p_proto@@ -284,7 +284,7 @@ $ (trySysCall.c_getprotobyname) name_cstr >>= peek -foreign import CALLCONV unsafe "getprotobyname" +foreign import CALLCONV unsafe "getprotobyname" c_getprotobyname :: CString -> IO (Ptr ProtocolEntry) @@ -331,7 +331,7 @@ -- --------------------------------------------------------------------------- -- Host lookups -data HostEntry = +data HostEntry = HostEntry { hostName :: HostName, -- Official Name hostAliases :: [HostName], -- aliases@@ -385,7 +385,7 @@ $ trySysCall $ c_gethostbyname name_cstr peek ent -foreign import CALLCONV safe "gethostbyname" +foreign import CALLCONV safe "gethostbyname" c_gethostbyname :: CString -> IO (Ptr HostEntry) @@ -460,7 +460,7 @@ return (NetworkEntry { networkName = n_name, networkAliases = n_aliases,- networkFamily = unpackFamily (fromIntegral + networkFamily = unpackFamily (fromIntegral (n_addrtype :: CInt)), networkAddress = n_net })@@ -476,7 +476,7 @@ $ trySysCall $ c_getnetbyname name_cstr >>= peek -foreign import ccall unsafe "getnetbyname" +foreign import ccall unsafe "getnetbyname" c_getnetbyname :: CString -> IO (Ptr NetworkEntry) getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry@@ -485,7 +485,7 @@ $ trySysCall $ c_getnetbyaddr addr (packFamily family) >>= peek -foreign import ccall unsafe "getnetbyaddr" +foreign import ccall unsafe "getnetbyaddr" c_getnetbyaddr :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry) getNetworkEntry :: IO NetworkEntry@@ -539,7 +539,7 @@ throwSocketErrorIfMinus1_ "getHostName" $ c_gethostname cstr (fromIntegral size) peekCString cstr -foreign import CALLCONV unsafe "gethostname" +foreign import CALLCONV unsafe "gethostname" c_gethostname :: CString -> CSize -> IO CInt -- Helper function used by the exported functions that provides a
Network/Socket.hsc view
@@ -82,10 +82,13 @@ , getPeerName , getSocketName -#ifdef HAVE_STRUCT_UCRED+#if defined(HAVE_STRUCT_UCRED) || defined(HAVE_GETPEEREID) -- get the credentials of our domain socket peer. , getPeerCred+#if defined(HAVE_GETPEEREID) + , getPeerEid #endif+#endif , socketPort @@ -179,7 +182,7 @@ import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.Storable (Storable(..)) import Foreign.C.Error-import Foreign.C.String (CString, withCString, peekCString, peekCStringLen)+import Foreign.C.String (CString, withCString, withCStringLen, peekCString, peekCStringLen) import Foreign.C.Types (CUInt, CChar) #if __GLASGOW_HASKELL__ >= 703 import Foreign.C.Types (CInt(..), CSize(..))@@ -510,17 +513,16 @@ return new_sock #else with (fromIntegral sz) $ \ ptr_len -> do- new_sock <- # ifdef HAVE_ACCEPT4- throwSocketErrorIfMinus1RetryMayBlock "accept"+ new_sock <- throwSocketErrorIfMinus1RetryMayBlock "accept" (threadWaitRead (fromIntegral s)) (c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK)) # else- throwSocketErrorWaitRead sock "accept"+ new_sock <- throwSocketErrorWaitRead sock "accept" (c_accept s sockaddr ptr_len)+ setNonBlockIfNeeded new_sock # endif /* HAVE_ACCEPT4 */ #endif- setNonBlockIfNeeded new_sock addr <- peekSockAddr sockaddr new_status <- newMVar Connected return ((MkSocket new_sock family stype protocol new_status), addr)@@ -562,8 +564,8 @@ -> SockAddr -> IO Int -- Number of Bytes sent sendTo sock xs addr = do- withCString xs $ \str -> do- sendBufTo sock str (length xs) addr+ withCStringLen xs $ \(str, len) -> do+ sendBufTo sock str len addr -- | Send data to the socket. The recipient can be specified -- explicitly, so the socket need not be in a connected state.@@ -638,8 +640,7 @@ -> String -- Data to send -> IO Int -- Number of Bytes sent send sock@(MkSocket s _family _stype _protocol _status) xs = do- let len = length xs- withCString xs $ \str -> do+ withCStringLen xs $ \(str, len) -> do liftM fromIntegral $ #if defined(mingw32_HOST_OS) # if __GLASGOW_HASKELL__ >= 611@@ -983,12 +984,15 @@ fromIntegral `liftM` peek ptr_v -#ifdef HAVE_STRUCT_UCRED+#if defined(HAVE_STRUCT_UCRED) || defined(HAVE_GETPEEREID) -- | Returns the processID, userID and groupID of the socket's peer. ----- Only available on platforms that support SO_PEERCRED on domain sockets.+-- Only available on platforms that support SO_PEERCRED or GETPEEREID(3)+-- on domain sockets.+-- GETPEEREID(3) returns userID and groupID. processID is always 0. getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt) getPeerCred sock = do+#ifdef HAVE_STRUCT_UCRED let fd = fdSocket sock let sz = (fromIntegral (#const sizeof(struct ucred))) with sz $ \ ptr_cr ->@@ -1000,8 +1004,27 @@ uid <- (#peek struct ucred, uid) ptr_cr gid <- (#peek struct ucred, gid) ptr_cr return (pid, uid, gid)+#else+ (uid,gid) <- getPeerEid sock+ return (0,uid,gid) #endif +#ifdef HAVE_GETPEEREID+-- | The getpeereid() function returns the effective user and group IDs of the+-- peer connected to a UNIX-domain socket+getPeerEid :: Socket -> IO (CUInt, CUInt)+getPeerEid sock = do + let fd = fdSocket sock+ alloca $ \ ptr_uid ->+ alloca $ \ ptr_gid -> do+ throwSocketErrorIfMinus1Retry "getPeerEid" $+ c_getpeereid fd ptr_uid ptr_gid+ uid <- peek ptr_uid+ gid <- peek ptr_gid+ return (uid, gid)+#endif+#endif+ ##if !(MIN_VERSION_base(4,3,1)) closeFdWith closer fd = closer fd ##endif@@ -1634,6 +1657,10 @@ foreign import CALLCONV unsafe "setsockopt" c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt +#if defined(HAVE_GETPEEREID)+foreign import CALLCONV unsafe "getpeereid"+ c_getpeereid :: CInt -> Ptr CUInt -> Ptr CUInt -> IO CInt+#endif -- --------------------------------------------------------------------------- -- * Deprecated aliases
Network/Socket/ByteString.hsc view
@@ -23,7 +23,7 @@ -- > import Network.Socket.ByteString -- module Network.Socket.ByteString- ( + ( -- * Send data to a socket send , sendAll
Network/Socket/ByteString/IOVec.hsc view
@@ -9,6 +9,7 @@ import Foreign.Ptr (Ptr) import Foreign.Storable (Storable(..)) +#include <sys/types.h> #include <sys/uio.h> data IOVec = IOVec
Network/Socket/Types.hsc view
@@ -1,6 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ForeignFunctionInterface #-}++#include "HsNet.h"+ module Network.Socket.Types ( -- * Socket@@ -49,8 +52,6 @@ -- * Low-level helpers , zeroMemory ) where--#include "HsNet.h" import Control.Concurrent.MVar import Control.Monad
Network/URI.hs view
@@ -64,13 +64,13 @@ URI(..) , URIAuth(..) , nullURI- + -- * Parsing , parseURI , parseURIReference , parseRelativeReference , parseAbsoluteURI- + -- * Test for strings containing various kinds of URI , isURI , isURIReference@@ -78,16 +78,16 @@ , isAbsoluteURI , isIPv6address , isIPv4address- + -- * Predicates , uriIsAbsolute , uriIsRelative- + -- * Relative URIs , relativeTo , nonStrictRelativeTo , relativeFrom- + -- * Operations on URI strings -- | Support for putting strings into URI-friendly -- escaped format and getting them back again.@@ -103,12 +103,12 @@ , escapeURIChar , escapeURIString , unEscapeString- + -- * URI Normalization functions , normalizeCase , normalizeEscape , normalizePathSegments- + -- * Deprecated functions , parseabsoluteURI , escapeString
configure view
@@ -687,7 +687,7 @@ ac_subst_files='' ac_user_opts=' enable_option_checking-with_cc+with_gcc ' ac_precious_vars='build_alias host_alias@@ -2339,9 +2339,9 @@ -# Check whether --with-cc was given.-if test "${with_cc+set}" = set; then :- withval=$with_cc; CC=$withval+# Check whether --with-gcc was given.+if test "${with_gcc+set}" = set; then :+ withval=$with_gcc; CC=$withval fi ac_ext=c
configure.ac view
@@ -29,7 +29,7 @@ AC_CANONICAL_HOST -AC_ARG_WITH([cc],+AC_ARG_WITH([gcc], [C compiler], [CC=$withval]) AC_PROG_CC()@@ -101,6 +101,12 @@ AC_DEFINE([HAVE_STRUCT_UCRED], [1], [Define to 1 if you have both SO_PEERCRED and struct ucred.]) AC_MSG_RESULT(yes) fi++dnl --------------------------------------------------+dnl * test for GETPEEREID(3) +dnl --------------------------------------------------+AC_MSG_CHECKING(for getpeereid in unistd.h)+AC_CHECK_FUNC( getpeereid, AC_DEFINE([HAVE_GETPEEREID], [1], [Define to 1 if you have getpeereid.] )) dnl -------------------------------------------------- dnl * check for Windows networking libraries
include/HsNet.h view
@@ -176,4 +176,8 @@ # define IOV_MAX 1024 #endif +#if !defined(SOCK_NONBLOCK) // Missing define in Bionic libc (Android)+# define SOCK_NONBLOCK O_NONBLOCK+#endif+ #endif /* HSNET_H */
network.buildinfo.in view
@@ -1,5 +1,6 @@ ghc-options: -DCALLCONV=@CALLCONV@ @EXTRA_CPPFLAGS@ ghc-prof-options: -DCALLCONV=@CALLCONV@ @EXTRA_CPPFLAGS@+ld-options: @LDFLAGS@ cc-options: -DCALLCONV=@CALLCONV@ @EXTRA_CPPFLAGS@ c-sources: @EXTRA_SRCS@ extra-libraries: @EXTRA_LIBS@
network.cabal view
@@ -1,5 +1,5 @@ name: network-version: 2.4.1.2+version: 2.4.2.0 license: BSD3 license-file: LICENSE maintainer: Johan Tibell <johan.tibell@gmail.com>
tests/Simple.hs view
@@ -112,6 +112,67 @@ client sock = send sock testMsg +{-+testGetPeerCred:: Assertion+testGetPeerCred =+ test clientSetup clientAct serverSetup server+ where+ clientSetup = do+ sock <- socket AF_UNIX Stream defaultProtocol+ connect sock $ SockAddrUnix addr + return sock++ serverSetup = do+ sock <- socket AF_UNIX Stream defaultProtocol+ bindSocket sock $ SockAddrUnix addr + listen sock 1+ return sock++ server sock = do+ (clientSock, _) <- accept sock+ serverAct clientSock+ sClose clientSock++ addr = "/tmp/testAddr1"+ clientAct sock = withSocketsDo $ do + sendAll sock testMsg+ (pid,uid,gid) <- getPeerCred sock+ putStrLn $ unwords ["pid=",show pid,"uid=",show uid, "gid=", show gid]+ serverAct sock = withSocketsDo $ do+ msg <- recv sock 1024+ putStrLn $ C.unpack msg+++testGetPeerEid :: Assertion+testGetPeerEid = + test clientSetup clientAct serverSetup server+ where+ clientSetup = do+ sock <- socket AF_UNIX Stream defaultProtocol+ connect sock $ SockAddrUnix addr + return sock++ serverSetup = do+ sock <- socket AF_UNIX Stream defaultProtocol+ bindSocket sock $ SockAddrUnix addr + listen sock 1+ return sock++ server sock = do+ (clientSock, _) <- accept sock+ serverAct clientSock+ sClose clientSock++ addr = "/tmp/testAddr2"+ clientAct sock = withSocketsDo $ do + sendAll sock testMsg+ (uid,gid) <- getPeerEid sock+ putStrLn $ unwords ["uid=",show uid, "gid=", show gid]+ serverAct sock = withSocketsDo $ do+ msg <- recv sock 1024+ putStrLn $ C.unpack msg+-}+ ------------------------------------------------------------------------ -- Other @@ -132,6 +193,8 @@ , testCase "testOverFlowRecv" testOverFlowRecv , testCase "testRecvFrom" testRecvFrom , testCase "testOverFlowRecvFrom" testOverFlowRecvFrom+-- , testCase "testGetPeerCred" testGetPeerCred+-- , testCase "testGetPeerEid" testGetPeerEid ] tests :: [Test]