From 6894ac341a4e5691c72346bde9a26457d4e70460 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Wed, 16 Oct 2019 07:58:55 +0000 Subject: Successful builds against newer network package Built against both network-3.0.1.0 and network-3.1.0.0 Note, due to upstream issue, getting network-bsd-2.8.1.0 to cooperate with network-3.0.1.0 requires a little finessing. The network-bsd package expects a header(HsNetConfig.h) that network fails to provide. A simple work around is to copy the header after running a newer version of the network configure script from github. Similar for network-3.1.0.0, but this time the header is HsNetworkConfig.h. --- dht/Presence/LocalPeerCred.hs | 2 ++ dht/Presence/XMPPServer.hs | 2 +- dht/dht-client.cabal | 3 +-- dht/src/Network/SocketLike.hs | 38 +++++++++++++++++++++++++------------- dht/src/Network/StreamServer.hs | 4 +++- 5 files changed, 32 insertions(+), 17 deletions(-) (limited to 'dht') diff --git a/dht/Presence/LocalPeerCred.hs b/dht/Presence/LocalPeerCred.hs index f68557e8..a7344434 100644 --- a/dht/Presence/LocalPeerCred.hs +++ b/dht/Presence/LocalPeerCred.hs @@ -62,6 +62,7 @@ getLocalPeerCred' (unmap6mapped4 -> addr@(SockAddrUnix _)) = -- see also: Network.Socket.getPeerCred return Nothing +{- // Removed due to no call-sites getLocalPeerCred :: SocketLike sock => sock -> IO (Maybe UserID) getLocalPeerCred sock = do addr <- getPeerName sock @@ -72,6 +73,7 @@ getLocalPeerCred sock = do where sndOf3 (pid,uid,gid) = uid where validate uid = Just uid -- TODO +-} from16 :: Word16 -> Int from16 = fromEnum diff --git a/dht/Presence/XMPPServer.hs b/dht/Presence/XMPPServer.hs index fe099fb8..e98b9a2e 100644 --- a/dht/Presence/XMPPServer.hs +++ b/dht/Presence/XMPPServer.hs @@ -1101,7 +1101,7 @@ peerKey :: SocketLike sock => Maybe SockAddr -> sock -> IO (PeerAddress,Connecti peerKey bind_addr sock = do laddr <- getSocketName sock raddr <- - sIsConnected sock >>= \c -> + isValidSocket sock >>= \(sock,c) -> if c then getPeerName sock -- addr is normally socketName else return laddr -- Weird hack: addr is would-be peer name -- Assume remote peers are listening on the same port that we do. diff --git a/dht/dht-client.cabal b/dht/dht-client.cabal index 3569c6dd..168dd079 100644 --- a/dht/dht-client.cabal +++ b/dht/dht-client.cabal @@ -37,8 +37,7 @@ flag old-network-bsd description: Use network-bsd package. default: True --- TODO: Due to removed functions, this flag doesn't actually build. --- In the future, this flag should support network >3.0 +-- supports network >3.0 flag new-network-bsd description: Use newer network-bsd package. default: False diff --git a/dht/src/Network/SocketLike.hs b/dht/src/Network/SocketLike.hs index 27f6f492..2c97ddd4 100644 --- a/dht/src/Network/SocketLike.hs +++ b/dht/src/Network/SocketLike.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE CPP #-} -- | -- @@ -33,6 +34,7 @@ import Foreign.C.Types ( CUInt ) import qualified Network.Socket as NS import System.IO (Handle,hClose,hIsOpen) +import Control.Arrow -- | A safe (mostly read-only) interface to a 'NS.Socket'. Note that despite -- how this class is named, it provides no access to typical 'NS.Socket' uses @@ -43,22 +45,36 @@ class SocketLike sock where -- | See 'NS.getPeerName' getPeerName :: sock -> IO SockAddr -- | See 'NS.getPeerCred' - getPeerCred :: sock -> IO (CUInt, CUInt, CUInt) +-- getPeerCred :: sock -> IO (CUInt, CUInt, CUInt) -- | Is the socket still valid? Connected - sIsConnected :: sock -> IO Bool + -- + -- In order to give the instance writer + -- the option to do book-keeping in a pure + -- type, a conceptually modified version of + -- the 'SocketLike' is returned. + -- + isValidSocket :: sock -> IO (sock,Bool) instance SocketLike NS.Socket where getSocketName = NS.getSocketName getPeerName = NS.getPeerName - getPeerCred = NS.getPeerCred +-- getPeerCred = NS.getPeerCred +#if MIN_VERSION_network(3,1,0) + isValidSocket s = (s,) <$> NS.withFdSocket s (return . (/= (-1))) +#else +#if MIN_VERSION_network(3,0,0) + isValidSocket s = (s,) . (/= (-1)) <$> NS.fdSocket s +#else #if MIN_VERSION_network(2,4,0) - sIsConnected = NS.isConnected -- warning: this is always False if the socket - -- was converted to a Handle + isValidSocket s = (s,) . NS.isConnected s -- warning: this is always False if the socket + -- was converted to a Handle #else - sIsConnected = NS.sIsConnected -- warning: this is always False if the socket - -- was converted to a Handle + isValidSocket = (s,) . NS.sIsConnected s -- warning: this is always False if the socket + -- was converted to a Handle +#endif +#endif #endif -- | An encapsulated socket. Data reads and writes are not possible. @@ -67,12 +83,8 @@ data RestrictedSocket = Restricted (Maybe Handle) NS.Socket deriving Show instance SocketLike RestrictedSocket where getSocketName (Restricted mb sock) = NS.getSocketName sock getPeerName (Restricted mb sock) = NS.getPeerName sock - getPeerCred (Restricted mb sock) = NS.getPeerCred sock -#if MIN_VERSION_network(2,4,0) - sIsConnected (Restricted mb sock) = maybe (NS.isConnected sock) (hIsOpen) mb -#else - sIsConnected (Restricted mb sock) = maybe (NS.sIsConnected sock) (hIsOpen) mb -#endif +-- getPeerCred (Restricted mb sock) = NS.getPeerCred sock + isValidSocket rs@(Restricted mb sock) = maybe (first (Restricted mb) <$> isValidSocket sock) (((rs,) <$>) . hIsOpen) mb -- | Create a 'RestrictedSocket' that explicitly disallows sending or -- receiving data. diff --git a/dht/src/Network/StreamServer.hs b/dht/src/Network/StreamServer.hs index 79398e8e..9a5b8593 100644 --- a/dht/src/Network/StreamServer.hs +++ b/dht/src/Network/StreamServer.hs @@ -10,7 +10,7 @@ module Network.StreamServer , ServerConfig(..) , withSession , quitListening - , dummyServerHandle + --, dummyServerHandle , listenSocket ) where @@ -52,6 +52,7 @@ data ServerHandle = ServerHandle Socket (Weak ThreadId) listenSocket :: ServerHandle -> RestrictedSocket listenSocket (ServerHandle sock _) = restrictSocket sock +{- // Removed, bit-rotted and there are no call sites -- | Create a useless do-nothing 'ServerHandle'. dummyServerHandle :: IO ServerHandle dummyServerHandle = do @@ -59,6 +60,7 @@ dummyServerHandle = do let sock = MkSocket 0 AF_UNSPEC NoSocketType 0 mvar thread <- mkWeakThreadId <=< forkIO $ return () return (ServerHandle sock thread) +-} removeSocketFile :: SockAddr -> IO () removeSocketFile (SockAddrUnix fname) = removeFile fname -- cgit v1.2.3