diff options
Diffstat (limited to 'dht/Presence/XMPPServer.hs')
-rw-r--r-- | dht/Presence/XMPPServer.hs | 22 |
1 files changed, 11 insertions, 11 deletions
diff --git a/dht/Presence/XMPPServer.hs b/dht/Presence/XMPPServer.hs index 272f6efe..3bafd33c 100644 --- a/dht/Presence/XMPPServer.hs +++ b/dht/Presence/XMPPServer.hs | |||
@@ -65,7 +65,7 @@ import Control.Monad.Trans (lift) | |||
65 | import Control.Monad.IO.Class (MonadIO, liftIO) | 65 | import Control.Monad.IO.Class (MonadIO, liftIO) |
66 | import Control.Monad.Fix (fix) | 66 | import Control.Monad.Fix (fix) |
67 | import Control.Monad | 67 | import Control.Monad |
68 | import Control.Concurrent.ThreadUtil (forkIO,myThreadId,forkLabeled,labelThread,ThreadId,MVar,putMVar,takeMVar,newMVar) | 68 | import Control.Concurrent.ThreadUtil (forkIO,myThreadId,forkLabeled,labelThread,ThreadId,MVar,putMVar,takeMVar,newMVar,threadDelay) |
69 | import Control.Concurrent.STM | 69 | import Control.Concurrent.STM |
70 | import Data.List hiding ((\\)) | 70 | import Data.List hiding ((\\)) |
71 | -- import Control.Concurrent.STM.TChan | 71 | -- import Control.Concurrent.STM.TChan |
@@ -107,6 +107,7 @@ import Stanza.Parse | |||
107 | import Stanza.Types | 107 | import Stanza.Types |
108 | import MUC | 108 | import MUC |
109 | import Chat | 109 | import Chat |
110 | import Network.StreamServer (Local(..), Remote(..)) | ||
110 | 111 | ||
111 | -- peerport :: PortNumber | 112 | -- peerport :: PortNumber |
112 | -- peerport = 5269 | 113 | -- peerport = 5269 |
@@ -117,9 +118,6 @@ my_uuid :: Text | |||
117 | my_uuid = "154ae29f-98f2-4af4-826d-a40c8a188574" | 118 | my_uuid = "154ae29f-98f2-4af4-826d-a40c8a188574" |
118 | 119 | ||
119 | 120 | ||
120 | newtype Local a = Local a deriving (Eq,Ord,Show) | ||
121 | newtype Remote a = Remote a deriving (Eq,Ord,Show) | ||
122 | |||
123 | data XMPPServerParameters = | 121 | data XMPPServerParameters = |
124 | XMPPServerParameters | 122 | XMPPServerParameters |
125 | { -- | Called when a client requests a resource id. The first Maybe indicates | 123 | { -- | Called when a client requests a resource id. The first Maybe indicates |
@@ -1090,13 +1088,15 @@ data PeerState | |||
1090 | | PeerConnected (TChan Stanza) | 1088 | | PeerConnected (TChan Stanza) |
1091 | -} | 1089 | -} |
1092 | 1090 | ||
1093 | peerKey :: SocketLike sock => Maybe SockAddr -> sock -> IO (PeerAddress,ConnectionData) | 1091 | peerKey :: SocketLike sock => Maybe SockAddr -> (sock, (Local SockAddr, Remote SockAddr)) -> IO (PeerAddress,ConnectionData) |
1094 | peerKey bind_addr sock = do | 1092 | peerKey bind_addr (sock,(laddr,Remote raddr)) = do |
1093 | {- | ||
1095 | laddr <- getSocketName sock | 1094 | laddr <- getSocketName sock |
1096 | raddr <- | 1095 | raddr <- |
1097 | isValidSocket sock >>= \(sock,c) -> | 1096 | isValidSocket sock >>= \(sock,c) -> |
1098 | if c then getPeerName sock -- addr is normally socketName | 1097 | if c then getPeerName sock -- addr is normally socketName |
1099 | else return laddr -- Weird hack: addr is would-be peer name | 1098 | else return laddr -- Weird hack: addr is would-be peer name |
1099 | -} | ||
1100 | -- Assume remote peers are listening on the same port that we do. | 1100 | -- Assume remote peers are listening on the same port that we do. |
1101 | let peerport = fromIntegral $ fromMaybe 5269 $ do | 1101 | let peerport = fromIntegral $ fromMaybe 5269 $ do |
1102 | p <- bind_addr >>= sockAddrPort | 1102 | p <- bind_addr >>= sockAddrPort |
@@ -1106,15 +1106,15 @@ peerKey bind_addr sock = do | |||
1106 | rname <- atomically $ newTVar Nothing | 1106 | rname <- atomically $ newTVar Nothing |
1107 | -- dput XMan $ "peerKey " ++ show (PeerAddress $ raddr `withPort` peerport,laddr) | 1107 | -- dput XMan $ "peerKey " ++ show (PeerAddress $ raddr `withPort` peerport,laddr) |
1108 | return $ ( PeerAddress $ raddr `withPort` peerport | 1108 | return $ ( PeerAddress $ raddr `withPort` peerport |
1109 | , ConnectionData { cdAddr = Left (Local laddr) | 1109 | , ConnectionData { cdAddr = Left laddr |
1110 | , cdType = XMPP | 1110 | , cdType = XMPP |
1111 | , cdProfile = "." | 1111 | , cdProfile = "." |
1112 | , cdRemoteName = rname } ) | 1112 | , cdRemoteName = rname } ) |
1113 | 1113 | ||
1114 | clientKey :: SocketLike sock => sock -> IO (PeerAddress,ConnectionData) | 1114 | clientKey :: SocketLike sock => (sock, (Local SockAddr,Remote SockAddr)) -> IO (PeerAddress,ConnectionData) |
1115 | clientKey sock = do | 1115 | clientKey (sock,(laddr,Remote raddr)) = do |
1116 | laddr <- getSocketName sock -- [::1]:5222 bind address, same for all clients | 1116 | -- laddr <- getSocketName sock -- [::1]:5222 bind address, same for all clients |
1117 | raddr <- getPeerName sock -- [::1]:????? unique key | 1117 | -- raddr <- getPeerName sock -- [::1]:????? unique key |
1118 | when (Just 0 == sockAddrPort raddr) $ do | 1118 | when (Just 0 == sockAddrPort raddr) $ do |
1119 | dput XMan $ unwords [ "BUG: XMPP Client" | 1119 | dput XMan $ unwords [ "BUG: XMPP Client" |
1120 | , show (laddr,raddr) | 1120 | , show (laddr,raddr) |