summaryrefslogtreecommitdiff
path: root/dht
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2019-10-16 07:58:55 +0000
committerJoe Crayne <joe@jerkface.net>2020-01-01 19:40:59 -0500
commit6894ac341a4e5691c72346bde9a26457d4e70460 (patch)
tree7ee2bf4b55b053bdbadfe65ad419e5f3199b4a76 /dht
parentc4dcf8374e218e741f4c3120d889c420d8ca2edb (diff)
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.
Diffstat (limited to 'dht')
-rw-r--r--dht/Presence/LocalPeerCred.hs2
-rw-r--r--dht/Presence/XMPPServer.hs2
-rw-r--r--dht/dht-client.cabal3
-rw-r--r--dht/src/Network/SocketLike.hs38
-rw-r--r--dht/src/Network/StreamServer.hs4
5 files changed, 32 insertions, 17 deletions
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 _)) =
62 -- see also: Network.Socket.getPeerCred 62 -- see also: Network.Socket.getPeerCred
63 return Nothing 63 return Nothing
64 64
65{- // Removed due to no call-sites
65getLocalPeerCred :: SocketLike sock => sock -> IO (Maybe UserID) 66getLocalPeerCred :: SocketLike sock => sock -> IO (Maybe UserID)
66getLocalPeerCred sock = do 67getLocalPeerCred sock = do
67 addr <- getPeerName sock 68 addr <- getPeerName sock
@@ -72,6 +73,7 @@ getLocalPeerCred sock = do
72 where sndOf3 (pid,uid,gid) = uid 73 where sndOf3 (pid,uid,gid) = uid
73 where 74 where
74 validate uid = Just uid -- TODO 75 validate uid = Just uid -- TODO
76-}
75 77
76from16 :: Word16 -> Int 78from16 :: Word16 -> Int
77from16 = fromEnum 79from16 = 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
1101peerKey bind_addr sock = do 1101peerKey bind_addr sock = do
1102 laddr <- getSocketName sock 1102 laddr <- getSocketName sock
1103 raddr <- 1103 raddr <-
1104 sIsConnected sock >>= \c -> 1104 isValidSocket sock >>= \(sock,c) ->
1105 if c then getPeerName sock -- addr is normally socketName 1105 if c then getPeerName sock -- addr is normally socketName
1106 else return laddr -- Weird hack: addr is would-be peer name 1106 else return laddr -- Weird hack: addr is would-be peer name
1107 -- Assume remote peers are listening on the same port that we do. 1107 -- 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
37 description: Use network-bsd package. 37 description: Use network-bsd package.
38 default: True 38 default: True
39 39
40-- TODO: Due to removed functions, this flag doesn't actually build. 40-- supports network >3.0
41-- In the future, this flag should support network >3.0
42flag new-network-bsd 41flag new-network-bsd
43 description: Use newer network-bsd package. 42 description: Use newer network-bsd package.
44 default: False 43 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 @@
1{-# LANGUAGE GeneralizedNewtypeDeriving #-} 1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE TupleSections #-}
2{-# LANGUAGE CPP #-} 3{-# LANGUAGE CPP #-}
3-- | 4-- |
4-- 5--
@@ -33,6 +34,7 @@ import Foreign.C.Types ( CUInt )
33 34
34import qualified Network.Socket as NS 35import qualified Network.Socket as NS
35import System.IO (Handle,hClose,hIsOpen) 36import System.IO (Handle,hClose,hIsOpen)
37import Control.Arrow
36 38
37-- | A safe (mostly read-only) interface to a 'NS.Socket'. Note that despite 39-- | A safe (mostly read-only) interface to a 'NS.Socket'. Note that despite
38-- how this class is named, it provides no access to typical 'NS.Socket' uses 40-- how this class is named, it provides no access to typical 'NS.Socket' uses
@@ -43,22 +45,36 @@ class SocketLike sock where
43 -- | See 'NS.getPeerName' 45 -- | See 'NS.getPeerName'
44 getPeerName :: sock -> IO SockAddr 46 getPeerName :: sock -> IO SockAddr
45 -- | See 'NS.getPeerCred' 47 -- | See 'NS.getPeerCred'
46 getPeerCred :: sock -> IO (CUInt, CUInt, CUInt) 48-- getPeerCred :: sock -> IO (CUInt, CUInt, CUInt)
47 49
48 -- | Is the socket still valid? Connected 50 -- | Is the socket still valid? Connected
49 sIsConnected :: sock -> IO Bool 51 --
52 -- In order to give the instance writer
53 -- the option to do book-keeping in a pure
54 -- type, a conceptually modified version of
55 -- the 'SocketLike' is returned.
56 --
57 isValidSocket :: sock -> IO (sock,Bool)
50 58
51 59
52instance SocketLike NS.Socket where 60instance SocketLike NS.Socket where
53 getSocketName = NS.getSocketName 61 getSocketName = NS.getSocketName
54 getPeerName = NS.getPeerName 62 getPeerName = NS.getPeerName
55 getPeerCred = NS.getPeerCred 63-- getPeerCred = NS.getPeerCred
64#if MIN_VERSION_network(3,1,0)
65 isValidSocket s = (s,) <$> NS.withFdSocket s (return . (/= (-1)))
66#else
67#if MIN_VERSION_network(3,0,0)
68 isValidSocket s = (s,) . (/= (-1)) <$> NS.fdSocket s
69#else
56#if MIN_VERSION_network(2,4,0) 70#if MIN_VERSION_network(2,4,0)
57 sIsConnected = NS.isConnected -- warning: this is always False if the socket 71 isValidSocket s = (s,) . NS.isConnected s -- warning: this is always False if the socket
58 -- was converted to a Handle 72 -- was converted to a Handle
59#else 73#else
60 sIsConnected = NS.sIsConnected -- warning: this is always False if the socket 74 isValidSocket = (s,) . NS.sIsConnected s -- warning: this is always False if the socket
61 -- was converted to a Handle 75 -- was converted to a Handle
76#endif
77#endif
62#endif 78#endif
63 79
64-- | An encapsulated socket. Data reads and writes are not possible. 80-- | An encapsulated socket. Data reads and writes are not possible.
@@ -67,12 +83,8 @@ data RestrictedSocket = Restricted (Maybe Handle) NS.Socket deriving Show
67instance SocketLike RestrictedSocket where 83instance SocketLike RestrictedSocket where
68 getSocketName (Restricted mb sock) = NS.getSocketName sock 84 getSocketName (Restricted mb sock) = NS.getSocketName sock
69 getPeerName (Restricted mb sock) = NS.getPeerName sock 85 getPeerName (Restricted mb sock) = NS.getPeerName sock
70 getPeerCred (Restricted mb sock) = NS.getPeerCred sock 86-- getPeerCred (Restricted mb sock) = NS.getPeerCred sock
71#if MIN_VERSION_network(2,4,0) 87 isValidSocket rs@(Restricted mb sock) = maybe (first (Restricted mb) <$> isValidSocket sock) (((rs,) <$>) . hIsOpen) mb
72 sIsConnected (Restricted mb sock) = maybe (NS.isConnected sock) (hIsOpen) mb
73#else
74 sIsConnected (Restricted mb sock) = maybe (NS.sIsConnected sock) (hIsOpen) mb
75#endif
76 88
77-- | Create a 'RestrictedSocket' that explicitly disallows sending or 89-- | Create a 'RestrictedSocket' that explicitly disallows sending or
78-- receiving data. 90-- 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
10 , ServerConfig(..) 10 , ServerConfig(..)
11 , withSession 11 , withSession
12 , quitListening 12 , quitListening
13 , dummyServerHandle 13 --, dummyServerHandle
14 , listenSocket 14 , listenSocket
15 ) where 15 ) where
16 16
@@ -52,6 +52,7 @@ data ServerHandle = ServerHandle Socket (Weak ThreadId)
52listenSocket :: ServerHandle -> RestrictedSocket 52listenSocket :: ServerHandle -> RestrictedSocket
53listenSocket (ServerHandle sock _) = restrictSocket sock 53listenSocket (ServerHandle sock _) = restrictSocket sock
54 54
55{- // Removed, bit-rotted and there are no call sites
55-- | Create a useless do-nothing 'ServerHandle'. 56-- | Create a useless do-nothing 'ServerHandle'.
56dummyServerHandle :: IO ServerHandle 57dummyServerHandle :: IO ServerHandle
57dummyServerHandle = do 58dummyServerHandle = do
@@ -59,6 +60,7 @@ dummyServerHandle = do
59 let sock = MkSocket 0 AF_UNSPEC NoSocketType 0 mvar 60 let sock = MkSocket 0 AF_UNSPEC NoSocketType 0 mvar
60 thread <- mkWeakThreadId <=< forkIO $ return () 61 thread <- mkWeakThreadId <=< forkIO $ return ()
61 return (ServerHandle sock thread) 62 return (ServerHandle sock thread)
63-}
62 64
63removeSocketFile :: SockAddr -> IO () 65removeSocketFile :: SockAddr -> IO ()
64removeSocketFile (SockAddrUnix fname) = removeFile fname 66removeSocketFile (SockAddrUnix fname) = removeFile fname