network 2.6.0.2 → 2.6.1.0
raw patch · 14 files changed
+246/−162 lines, 14 files
Files
- Network.hs +19/−5
- Network/BSD.hsc +45/−38
- Network/Socket.hsc +9/−14
- Network/Socket/ByteString/Lazy.hs +5/−68
- Network/Socket/Internal.hsc +22/−12
- Network/Socket/Types.hsc +47/−0
- cbits/initWinSock.c +7/−16
- configure +15/−3
- configure.ac +4/−3
- include/HsNet.h +6/−1
- include/HsNetworkConfig.h +9/−0
- include/HsNetworkConfig.h.in +9/−0
- network.cabal +1/−1
- tests/Simple.hs +48/−1
Network.hs view
@@ -461,12 +461,26 @@ catchIO = Exception.catchJust Exception.ioErrors #endif +-- Version of try implemented in terms of the locally defined catchIO+tryIO :: IO a -> IO (Either Exception.IOException a)+tryIO m = catchIO (liftM Right m) (return . Left)+ -- Returns the first action from a list which does not throw an exception. -- If all the actions throw exceptions (and the list of actions is not empty), -- the last exception is thrown.+-- The operations are run outside of the catchIO cleanup handler because+-- catchIO masks asynchronous exceptions in the cleanup handler.+-- In the case of complete failure, the last exception is actually thrown. firstSuccessful :: [IO a] -> IO a-firstSuccessful [] = error "firstSuccessful: empty list"-firstSuccessful (p:ps) = catchIO p $ \e ->- case ps of- [] -> Exception.throwIO e- _ -> firstSuccessful ps+firstSuccessful = go Nothing+ where+ -- Attempt the next operation, remember exception on failure+ go _ (p:ps) =+ do r <- tryIO p+ case r of+ Right x -> return x+ Left e -> go (Just e) ps++ -- All operations failed, throw error if one exists+ go Nothing [] = error "firstSuccessful: empty list"+ go (Just e) [] = Exception.throwIO e
Network/BSD.hsc view
@@ -86,6 +86,12 @@ , getNetworkEntry , endNetworkEntry #endif++#if defined(HAVE_IF_NAMETOINDEX)+ -- * Interface names+ , ifNameToIndex+#endif+ ) where import Network.Socket@@ -96,7 +102,7 @@ #if defined(HAVE_WINSOCK2_H) && !defined(cygwin32_HOST_OS) import Foreign.C.Types ( CShort ) #endif-import Foreign.C.Types ( CInt(..), CULong(..), CSize(..) )+import Foreign.C.Types ( CInt(..), CUInt(..), CULong(..), CSize(..) ) import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (Storable(..)) import Foreign.Marshal.Array (allocaArray0, peekArray0)@@ -173,7 +179,7 @@ withCString name $ \ cstr_name -> do withCString proto $ \ cstr_proto -> do throwNoSuchThingIfNull "getServiceByName" "no such service entry"- $ (trySysCall (c_getservbyname cstr_name cstr_proto))+ $ c_getservbyname cstr_name cstr_proto >>= peek foreign import CALLCONV unsafe "getservbyname"@@ -184,7 +190,7 @@ getServiceByPort (PortNum port) proto = withLock $ do withCString proto $ \ cstr_proto -> do throwNoSuchThingIfNull "getServiceByPort" "no such service entry"- $ (trySysCall (c_getservbyport (fromIntegral port) cstr_proto))+ $ c_getservbyport (fromIntegral port) cstr_proto >>= peek foreign import CALLCONV unsafe "getservbyport"@@ -200,18 +206,18 @@ getServiceEntry :: IO ServiceEntry getServiceEntry = withLock $ do throwNoSuchThingIfNull "getServiceEntry" "no such service entry"- $ trySysCall c_getservent+ $ c_getservent >>= peek foreign import ccall unsafe "getservent" c_getservent :: IO (Ptr ServiceEntry) setServiceEntry :: Bool -> IO ()-setServiceEntry flg = withLock $ trySysCall $ c_setservent (fromBool flg)+setServiceEntry flg = withLock $ c_setservent (fromBool flg) foreign import ccall unsafe "setservent" c_setservent :: CInt -> IO () endServiceEntry :: IO ()-endServiceEntry = withLock $ trySysCall $ c_endservent+endServiceEntry = withLock $ c_endservent foreign import ccall unsafe "endservent" c_endservent :: IO () @@ -270,7 +276,7 @@ getProtocolByName name = withLock $ do withCString name $ \ name_cstr -> do throwNoSuchThingIfNull "getProtocolByName" ("no such protocol name: " ++ name)- $ (trySysCall.c_getprotobyname) name_cstr+ $ c_getprotobyname name_cstr >>= peek foreign import CALLCONV unsafe "getprotobyname"@@ -280,7 +286,7 @@ getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry getProtocolByNumber num = withLock $ do throwNoSuchThingIfNull "getProtocolByNumber" ("no such protocol number: " ++ show num)- $ (trySysCall.c_getprotobynumber) (fromIntegral num)+ $ c_getprotobynumber (fromIntegral num) >>= peek foreign import CALLCONV unsafe "getprotobynumber"@@ -296,18 +302,18 @@ getProtocolEntry :: IO ProtocolEntry -- Next Protocol Entry from DB getProtocolEntry = withLock $ do ent <- throwNoSuchThingIfNull "getProtocolEntry" "no such protocol entry"- $ trySysCall c_getprotoent+ $ c_getprotoent peek ent foreign import ccall unsafe "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry) setProtocolEntry :: Bool -> IO () -- Keep DB Open ?-setProtocolEntry flg = withLock $ trySysCall $ c_setprotoent (fromBool flg)+setProtocolEntry flg = withLock $ c_setprotoent (fromBool flg) foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO () endProtocolEntry :: IO ()-endProtocolEntry = withLock $ trySysCall $ c_endprotoent+endProtocolEntry = withLock $ c_endprotoent foreign import ccall unsafe "endprotoent" c_endprotoent :: IO () @@ -371,7 +377,7 @@ getHostByName name = withLock $ do withCString name $ \ name_cstr -> do ent <- throwNoSuchThingIfNull "getHostByName" "no such host entry"- $ trySysCall $ c_gethostbyname name_cstr+ $ c_gethostbyname name_cstr peek ent foreign import CALLCONV safe "gethostbyname"@@ -385,7 +391,7 @@ getHostByAddr family addr = do with addr $ \ ptr_addr -> withLock $ do throwNoSuchThingIfNull "getHostByAddr" "no such host entry"- $ trySysCall $ c_gethostbyaddr ptr_addr (fromIntegral (sizeOf addr)) (packFamily family)+ $ c_gethostbyaddr ptr_addr (fromIntegral (sizeOf addr)) (packFamily family) >>= peek foreign import CALLCONV safe "gethostbyaddr"@@ -395,13 +401,13 @@ getHostEntry :: IO HostEntry getHostEntry = withLock $ do throwNoSuchThingIfNull "getHostEntry" "unable to retrieve host entry"- $ trySysCall $ c_gethostent+ $ c_gethostent >>= peek foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry) setHostEntry :: Bool -> IO ()-setHostEntry flg = withLock $ trySysCall $ c_sethostent (fromBool flg)+setHostEntry flg = withLock $ c_sethostent (fromBool flg) foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO () @@ -462,7 +468,7 @@ getNetworkByName name = withLock $ do withCString name $ \ name_cstr -> do throwNoSuchThingIfNull "getNetworkByName" "no such network entry"- $ trySysCall $ c_getnetbyname name_cstr+ $ c_getnetbyname name_cstr >>= peek foreign import ccall unsafe "getnetbyname"@@ -471,7 +477,7 @@ getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry getNetworkByAddr addr family = withLock $ do throwNoSuchThingIfNull "getNetworkByAddr" "no such network entry"- $ trySysCall $ c_getnetbyaddr addr (packFamily family)+ $ c_getnetbyaddr addr (packFamily family) >>= peek foreign import ccall unsafe "getnetbyaddr"@@ -480,7 +486,7 @@ getNetworkEntry :: IO NetworkEntry getNetworkEntry = withLock $ do throwNoSuchThingIfNull "getNetworkEntry" "no more network entries"- $ trySysCall $ c_getnetent+ $ c_getnetent >>= peek foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry)@@ -489,13 +495,13 @@ -- whether a connection is maintained open between various -- networkEntry calls setNetworkEntry :: Bool -> IO ()-setNetworkEntry flg = withLock $ trySysCall $ c_setnetent (fromBool flg)+setNetworkEntry flg = withLock $ c_setnetent (fromBool flg) foreign import ccall unsafe "setnetent" c_setnetent :: CInt -> IO () -- | Close the connection to the network name database. endNetworkEntry :: IO ()-endNetworkEntry = withLock $ trySysCall $ c_endnetent+endNetworkEntry = withLock $ c_endnetent foreign import ccall unsafe "endnetent" c_endnetent :: IO () @@ -506,11 +512,29 @@ getEntries (getNetworkEntry) (endNetworkEntry) #endif +-- ---------------------------------------------------------------------------+-- Interface names++#if defined(HAVE_IF_NAMETOINDEX)++-- returns the index of the network interface corresponding to the name ifname.+ifNameToIndex :: String -> IO (Maybe Int)+ifNameToIndex ifname = do+ index <- withCString ifname c_if_nametoindex+ -- On failure zero is returned. We'll return Nothing.+ return $ if index == 0 then Nothing else Just $ fromIntegral index++foreign import CALLCONV safe "if_nametoindex"+ c_if_nametoindex :: CString -> IO CUInt++#endif++ -- Mutex for name service lockdown {-# NOINLINE lock #-} lock :: MVar ()-lock = unsafePerformIO $ newMVar ()+lock = unsafePerformIO $ withSocketsDo $ newMVar () withLock :: IO a -> IO a withLock act = withMVar lock (\_ -> act)@@ -546,23 +570,6 @@ Nothing -> return [] Just v -> loop >>= \ vs -> atEnd >> return (v:vs) ---- ------------------------------------------------------------------------------ Winsock only:--- The BSD API networking calls made locally return NULL upon failure.--- That failure may very well be due to WinSock not being initialised,--- so if NULL is seen try init'ing and repeat the call.-#if !defined(mingw32_HOST_OS) && !defined(_WIN32)-trySysCall :: IO a -> IO a-trySysCall act = act-#else-trySysCall :: IO (Ptr a) -> IO (Ptr a)-trySysCall act = do- ptr <- act- if (ptr == nullPtr)- then withSocketsDo act- else return ptr-#endif throwNoSuchThingIfNull :: String -> String -> IO (Ptr a) -> IO (Ptr a) throwNoSuchThingIfNull loc desc act = do
Network/Socket.hsc view
@@ -256,6 +256,7 @@ -> IO Socket mkSocket fd fam sType pNum stat = do mStat <- newMVar stat+ withSocketsDo $ return () return (MkSocket fd fam sType pNum mStat) @@ -313,6 +314,7 @@ c_socket (packFamily family) c_stype protocol setNonBlockIfNeeded fd socket_status <- newMVar NotConnected+ withSocketsDo $ return () let sock = MkSocket fd family stype protocol socket_status #if HAVE_DECL_IPV6_V6ONLY # if defined(mingw32_HOST_OS)@@ -348,6 +350,7 @@ mkNonBlockingSocket fd = do setNonBlockIfNeeded fd stat <- newMVar Connected+ withSocketsDo $ return () return (MkSocket fd family stype protocol stat) foreign import ccall unsafe "socketpair"@@ -388,7 +391,7 @@ connect :: Socket -- Unconnected Socket -> SockAddr -- Socket address stuff -> IO ()-connect sock@(MkSocket s _family _stype _protocol socketStatus) addr = do+connect sock@(MkSocket s _family _stype _protocol socketStatus) addr = withSocketsDo $ do modifyMVar_ socketStatus $ \currentStatus -> do if currentStatus /= NotConnected && currentStatus /= Bound then@@ -409,15 +412,7 @@ -- _ | err == eAGAIN -> connectBlocked _otherwise -> throwSocketError "connect" #else- rc <- c_getLastError- case rc of- #{const WSANOTINITIALISED} -> do- withSocketsDo (return ())- r <- c_connect s p_addr (fromIntegral sz)- if r == -1- then throwSocketError "connect"- else return ()- _ -> throwSocketError "connect"+ throwSocketError "connect" #endif else return () @@ -1126,7 +1121,7 @@ -- Internet address manipulation routines: inet_addr :: String -> IO HostAddress-inet_addr ipstr = do+inet_addr ipstr = withSocketsDo $ do withCString ipstr $ \str -> do had <- c_inet_addr str if had == -1@@ -1134,7 +1129,7 @@ else return had -- network byte order inet_ntoa :: HostAddress -> IO String-inet_ntoa haddr = do+inet_ntoa haddr = withSocketsDo $ do pstr <- c_inet_ntoa haddr peekCString pstr @@ -1402,7 +1397,7 @@ -> Maybe ServiceName -- ^ service name to look up -> IO [AddrInfo] -- ^ resolved addresses, with "best" first -getAddrInfo hints node service =+getAddrInfo hints node service = withSocketsDo $ maybeWith withCString node $ \c_node -> maybeWith withCString service $ \c_service -> maybeWith with filteredHints $ \c_hints ->@@ -1507,7 +1502,7 @@ -> SockAddr -- ^ the address to look up -> IO (Maybe HostName, Maybe ServiceName) -getNameInfo flags doHost doService addr =+getNameInfo flags doHost doService addr = withSocketsDo $ withCStringIf doHost (#const NI_MAXHOST) $ \c_hostlen c_host -> withCStringIf doService (#const NI_MAXSERV) $ \c_servlen c_serv -> do withSockAddr addr $ \ptr_addr sz -> do
Network/Socket/ByteString/Lazy.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface #-}+{-# LANGUAGE CPP #-} -- | -- Module : Network.Socket.ByteString.Lazy@@ -23,12 +23,10 @@ -- module Network.Socket.ByteString.Lazy (-#if !defined(mingw32_HOST_OS) -- * Send data to a socket send , sendAll ,-#endif -- * Receive data from a socket getContents@@ -45,71 +43,10 @@ import qualified Data.ByteString as S import qualified Network.Socket.ByteString as N -#if !defined(mingw32_HOST_OS)-import Control.Monad (unless)-import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Foreign.Marshal.Array (allocaArray)-import Foreign.Ptr (plusPtr)-import Foreign.Storable (Storable(..))-import Network.Socket.ByteString.IOVec (IOVec(IOVec))-import Network.Socket.ByteString.Internal (c_writev)-import Network.Socket.Internal--import qualified Data.ByteString.Lazy as L--import GHC.Conc (threadWaitWrite)-#endif--#if !defined(mingw32_HOST_OS)--- -------------------------------------------------------------------------------- Sending---- | Send data to the socket. The socket must be in a connected state.--- Returns the number of bytes sent. Applications are responsible for--- ensuring that all data has been sent.------ Because a lazily generated 'ByteString' may be arbitrarily long,--- this function caps the amount it will attempt to send at 4MB. This--- number is large (so it should not penalize performance on fast--- networks), but not outrageously so (to avoid demanding lazily--- computed data unnecessarily early). Before being sent, the lazy--- 'ByteString' will be converted to a list of strict 'ByteString's--- with 'L.toChunks'; at most 1024 chunks will be sent. /Unix only/.-send :: Socket -- ^ Connected socket- -> ByteString -- ^ Data to send- -> IO Int64 -- ^ Number of bytes sent-send sock@(MkSocket fd _ _ _ _) s = do- let cs = take maxNumChunks (L.toChunks s)- len = length cs- liftM fromIntegral . allocaArray len $ \ptr ->- withPokes cs ptr $ \niovs ->- throwSocketErrorWaitWrite sock "writev" $- c_writev (fromIntegral fd) ptr niovs- where- withPokes ss p f = loop ss p 0 0- where loop (c:cs) q k !niovs- | k < maxNumBytes =- unsafeUseAsCStringLen c $ \(ptr,len) -> do- poke q $ IOVec ptr (fromIntegral len)- loop cs (q `plusPtr` sizeOf (undefined :: IOVec))- (k + fromIntegral len) (niovs + 1)- | otherwise = f niovs- loop _ _ _ niovs = f niovs- maxNumBytes = 4194304 :: Int -- maximum number of bytes to transmit in one system call- maxNumChunks = 1024 :: Int -- maximum number of chunks to transmit in one system call---- | Send data to the socket. The socket must be in a connected--- state. This function continues to send data until either all data--- has been sent or an error occurs. If there is an error, an--- exception is raised, and there is no way to determine how much data--- was sent. /Unix only/.-sendAll :: Socket -- ^ Connected socket- -> ByteString -- ^ Data to send- -> IO ()-sendAll sock bs = do- sent <- send sock bs- let bs' = L.drop sent bs- unless (L.null bs') $ sendAll sock bs'+#if defined(mingw32_HOST_OS)+import Network.Socket.ByteString.Lazy.Windows (send, sendAll)+#else+import Network.Socket.ByteString.Lazy.Posix (send, sendAll) #endif -- -----------------------------------------------------------------------------
Network/Socket/Internal.hsc view
@@ -78,7 +78,9 @@ import GHC.Conc (threadWaitRead, threadWaitWrite) #if defined(HAVE_WINSOCK2_H) && !defined(cygwin32_HOST_OS)-import Control.Exception ( finally )+import Control.Exception ( evaluate )+import System.IO.Unsafe ( unsafePerformIO )+import Control.Monad ( when ) # if __GLASGOW_HASKELL__ >= 707 import GHC.IO.Exception ( IOErrorType(..) ) # else@@ -235,27 +237,35 @@ -- --------------------------------------------------------------------------- -- WinSock support -{-| On Windows operating systems, the networking subsystem has to be-initialised using 'withSocketsDo' before any networking operations can-be used. eg.+{-| With older versions of the @network@ library on Windows operating systems,+the networking subsystem must be initialised using 'withSocketsDo' before+any networking operations can be used. eg. > main = withSocketsDo $ do {...} -Although this is only strictly necessary on Windows platforms, it is-harmless on other platforms, so for portability it is good practice to-use it all the time.+It is fine to nest calls to 'withSocketsDo', and to perform networking operations+after 'withSocketsDo' has returned.++In newer versions of the @network@ library it is only necessary to call+'withSocketsDo' if you are calling the 'MkSocket' constructor directly.+However, for compatibility with older versions on Windows, it is good practice+to always call 'withSocketsDo' (it's very cheap). -}+{-# INLINE withSocketsDo #-} withSocketsDo :: IO a -> IO a #if !defined(WITH_WINSOCK) withSocketsDo x = x #else-withSocketsDo act = do+withSocketsDo act = evaluate withSocketsInit >> act+++{-# NOINLINE withSocketsInit #-}+withSocketsInit :: ()+-- Use a CAF to make forcing it do initialisation once, but subsequent forces will be cheap+withSocketsInit = unsafePerformIO $ do x <- initWinSock- if x /= 0- then ioError (userError "Failed to initialise WinSock")- else act `finally` shutdownWinSock+ when (x /= 0) $ ioError $ userError "Failed to initialise WinSock" foreign import ccall unsafe "initWinSock" initWinSock :: IO Int-foreign import ccall unsafe "shutdownWinSock" shutdownWinSock :: IO () #endif
Network/Socket/Types.hsc view
@@ -60,12 +60,23 @@ import Data.Ratio import Data.Typeable import Data.Word+import Data.Int import Foreign.C import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable +-- | Represents a socket. The fields are, respectively:+--+-- * File descriptor+-- * Socket family+-- * Socket type+-- * Protocol number+-- * Status flag+--+-- If you are calling the 'MkSocket' constructor directly you should ensure+-- you have called 'Network.withSocketsDo'. data Socket = MkSocket CInt -- File Descriptor@@ -288,6 +299,7 @@ | AF_PPPOX -- PPPoX sockets | AF_WANPIPE -- Wanpipe API sockets | AF_BLUETOOTH -- bluetooth sockets+ | AF_CAN -- Controller Area Network deriving (Eq, Ord, Read, Show) packFamily :: Family -> CInt@@ -499,6 +511,9 @@ #ifdef AF_BLUETOOTH Just AF_BLUETOOTH -> Just #const AF_BLUETOOTH #endif+#ifdef AF_CAN+ Just AF_CAN -> Just #const AF_CAN+#endif _ -> Nothing --------- ----------@@ -700,17 +715,26 @@ #ifdef AF_BLUETOOTH (#const AF_BLUETOOTH) -> AF_BLUETOOTH #endif+#ifdef AF_CAN+ (#const AF_CAN) -> AF_CAN+#endif unknown -> error ("Network.Socket.unpackFamily: unknown address " ++ "family " ++ show unknown) ------------------------------------------------------------------------ -- Port Numbers +-- | Use the @Num@ instance (i.e. use a literal) to create a+-- @PortNumber@ value with the correct network-byte-ordering. You+-- should not use the PortNum constructor. It will be removed in the+-- next release. newtype PortNumber = PortNum Word16 deriving (Eq, Ord, Typeable) -- newtyped to prevent accidental use of sane-looking -- port numbers that haven't actually been converted to -- network-byte-order first. +{-# DEPRECATED PortNum "Do not use the PortNum constructor. Use the Num instance. PortNum will be removed in the next release." #-}+ instance Show PortNumber where showsPrec p pn = showsPrec p (portNumberToInt pn) @@ -792,6 +816,11 @@ | SockAddrUnix String -- sun_path #endif+#if defined(AF_CAN)+ | SockAddrCan+ Int32 -- can_ifindex (can be get by Network.BSD.ifNameToIndex "can0")+ -- TODO: Extend this to include transport protocol information+#endif deriving (Eq, Ord, Typeable) #if defined(WITH_WINSOCK) || defined(cygwin32_HOST_OS)@@ -816,6 +845,9 @@ #if defined(IPV6_SOCKET_SUPPORT) sizeOfSockAddr (SockAddrInet6 _ _ _ _) = #const sizeof(struct sockaddr_in6) #endif+#if defined(AF_CAN)+sizeOfSockAddr (SockAddrCan _) = #const sizeof(struct sockaddr_can)+#endif -- | Computes the storage requirements (in bytes) required for a -- 'SockAddr' with the given 'Family'.@@ -827,6 +859,9 @@ sizeOfSockAddrByFamily AF_INET6 = #const sizeof(struct sockaddr_in6) #endif sizeOfSockAddrByFamily AF_INET = #const sizeof(struct sockaddr_in)+#if defined(AF_CAN)+sizeOfSockAddrByFamily AF_CAN = #const sizeof(struct sockaddr_can)+#endif -- | Use a 'SockAddr' with a function requiring a pointer to a -- 'SockAddr' and the length of that 'SockAddr'.@@ -888,6 +923,13 @@ (#poke struct sockaddr_in6, sin6_addr) p addr (#poke struct sockaddr_in6, sin6_scope_id) p scope #endif+#if defined(AF_CAN)+pokeSockAddr p (SockAddrCan ifIndex) = do+#if defined(darwin_HOST_OS)+ zeroMemory p (#const sizeof(struct sockaddr_can))+#endif+ (#poke struct sockaddr_can, can_ifindex) p ifIndex+#endif -- | Read a 'SockAddr' from the given memory location. peekSockAddr :: Ptr SockAddr -> IO SockAddr@@ -910,6 +952,11 @@ addr <- (#peek struct sockaddr_in6, sin6_addr) p scope <- (#peek struct sockaddr_in6, sin6_scope_id) p return (SockAddrInet6 (PortNum port) flow addr scope)+#endif+#if defined(AF_CAN)+ (#const AF_CAN) -> do+ ifidx <- (#peek struct sockaddr_can, can_ifindex) p+ return (SockAddrCan ifidx) #endif ------------------------------------------------------------------------
cbits/initWinSock.c view
@@ -4,8 +4,13 @@ #if defined(HAVE_WINSOCK2_H) && !defined(__CYGWIN__) static int winsock_inited = 0;-static int winsock_uninited = 0; +static void+shutdownHandler(void)+{+ WSACleanup();+}+ /* Initialising WinSock... */ int initWinSock ()@@ -29,24 +34,10 @@ return (-1); } + atexit(shutdownHandler); winsock_inited = 1; } return 0;-}--static void-shutdownHandler(void)-{- WSACleanup();-}--void-shutdownWinSock()-{- if (!winsock_uninited) {- atexit(shutdownHandler);- winsock_uninited = 1;- } } #endif
configure view
@@ -3624,7 +3624,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+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 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,8 +3637,20 @@ 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 -for ac_func in readlink symlink+fi++done+++for ac_func in readlink symlink if_nametoindex 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"@@ -4070,7 +4082,7 @@ case "$host" in-*-mingw*)+*-mingw* | *-msys*) EXTRA_SRCS="cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c" EXTRA_LIBS=ws2_32 CALLCONV=stdcall ;;
configure.ac view
@@ -35,9 +35,10 @@ dnl ** check for specific header (.h) files that we are interested in AC_CHECK_HEADERS([fcntl.h limits.h stdlib.h sys/types.h unistd.h winsock2.h ws2tcpip.h])-AC_CHECK_HEADERS([arpa/inet.h netdb.h netinet/in.h netinet/tcp.h sys/socket.h sys/uio.h sys/un.h])+AC_CHECK_HEADERS([arpa/inet.h netdb.h netinet/in.h netinet/tcp.h sys/socket.h sys/uio.h sys/un.h linux/can.h])+AC_CHECK_HEADERS([net/if.h]) -AC_CHECK_FUNCS([readlink symlink])+AC_CHECK_FUNCS([readlink symlink if_nametoindex]) dnl ** check what fields struct msghdr contains AC_CHECK_MEMBERS([struct msghdr.msg_control, struct msghdr.msg_accrights], [], [], [#if HAVE_SYS_TYPES_H@@ -169,7 +170,7 @@ AC_CHECK_FUNCS(accept4) case "$host" in-*-mingw*)+*-mingw* | *-msys*) EXTRA_SRCS="cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c" EXTRA_LIBS=ws2_32 CALLCONV=stdcall ;;
include/HsNet.h view
@@ -44,7 +44,6 @@ # define IPV6_V6ONLY 27 # endif -extern void shutdownWinSock(); extern int initWinSock (); extern const char* getWSErrorDescr(int err); extern void* newAcceptParams(int sock,@@ -90,6 +89,12 @@ #endif #ifdef HAVE_NETDB_H #include <netdb.h>+#endif+#ifdef HAVE_LINUX_CAN_H+# include <linux/can.h>+#endif+#ifdef HAVE_NET_IF+# include <net/if.h> #endif #ifdef HAVE_BSD_SENDFILE
include/HsNetworkConfig.h view
@@ -57,6 +57,9 @@ /* Define to 1 if you have getpeereid. */ #define HAVE_GETPEEREID 1 +/* 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 @@ -69,6 +72,9 @@ /* 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. */+/* #undef HAVE_LINUX_CAN_H */+ /* Define to 1 if you have a Linux sendfile(2) implementation. */ /* #undef HAVE_LINUX_SENDFILE */ @@ -83,6 +89,9 @@ /* 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
include/HsNetworkConfig.h.in view
@@ -56,6 +56,9 @@ /* 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 @@ -68,6 +71,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 @@ -82,6 +88,9 @@ /* 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
network.cabal view
@@ -1,5 +1,5 @@ name: network-version: 2.6.0.2+version: 2.6.1.0 license: BSD3 license-file: LICENSE maintainer: Johan Tibell <johan.tibell@gmail.com>
tests/Simple.hs view
@@ -1,14 +1,31 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables #-} module Main where import Control.Concurrent (ThreadId, forkIO, myThreadId) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, readMVar) import qualified Control.Exception as E+import Control.Monad (liftM) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C+import Data.Maybe (fromJust) import Network.Socket hiding (recv, recvFrom, send, sendTo) import Network.Socket.ByteString++--- To tests for AF_CAN on Linux, you need to bring up a virtual (or real can+--- interface.). Run as root:+--- # modprobe can+--- # modprobe can_raw+--- # modprobe vcan+--- # sudo ip link add dev vcan0 type vcan+--- # ip link show vcan0+--- 3: can0: <NOARP,UP,LOWER_UP> mtu 16 qdisc noqueue state UNKNOWN link/can+--- Define HAVE_LINUX_CAN to run CAN tests as well.+--- #define HAVE_LINUX_CAN 1+-- #include "../include/HsNetworkConfig.h"+#if defined(HAVE_LINUX_CAN_H)+import Network.BSD (ifNameToIndex)+#endif import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (Assertion, (@=?))@@ -173,6 +190,33 @@ putStrLn $ C.unpack msg -} +#if defined(HAVE_LINUX_CAN_H)+canTestMsg = S.pack [ 0,0,0,0 -- can ID = 0+ , 4,0,0,0 -- data length counter = 2 (bytes)+ , 0x80,123,321,55 -- SYNC with some random extra bytes+ , 0, 0, 0, 0 -- padding+ ]++testCanSend :: Assertion+testCanSend = canTest "vcan0" client server+ where+ server sock = recv sock 1024 >>= (@=?) canTestMsg+ client sock = send sock canTestMsg++canTest :: String -> (Socket -> IO a) -> (Socket -> IO b) -> IO ()+canTest ifname clientAct serverAct = do+ ifIndex <- liftM fromJust $ ifNameToIndex ifname+ test (clientSetup ifIndex) clientAct (serverSetup ifIndex) serverAct+ where+ clientSetup ifIndex = do+ sock <- socket AF_CAN Raw 1 -- protocol 1 = raw CAN+ -- bind the socket to the interface+ bind sock (SockAddrCan $ fromIntegral $ ifIndex)+ return sock+ + serverSetup = clientSetup+#endif+ ------------------------------------------------------------------------ -- Other @@ -195,6 +239,9 @@ , testCase "testOverFlowRecvFrom" testOverFlowRecvFrom -- , testCase "testGetPeerCred" testGetPeerCred -- , testCase "testGetPeerEid" testGetPeerEid+#if defined(HAVE_LINUX_CAN_H)+ , testCase "testCanSend" testCanSend +#endif ] tests :: [Test]