summaryrefslogtreecommitdiff
path: root/dht/Presence/XMPPServer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'dht/Presence/XMPPServer.hs')
-rw-r--r--dht/Presence/XMPPServer.hs22
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)
65import Control.Monad.IO.Class (MonadIO, liftIO) 65import Control.Monad.IO.Class (MonadIO, liftIO)
66import Control.Monad.Fix (fix) 66import Control.Monad.Fix (fix)
67import Control.Monad 67import Control.Monad
68import Control.Concurrent.ThreadUtil (forkIO,myThreadId,forkLabeled,labelThread,ThreadId,MVar,putMVar,takeMVar,newMVar) 68import Control.Concurrent.ThreadUtil (forkIO,myThreadId,forkLabeled,labelThread,ThreadId,MVar,putMVar,takeMVar,newMVar,threadDelay)
69import Control.Concurrent.STM 69import Control.Concurrent.STM
70import Data.List hiding ((\\)) 70import Data.List hiding ((\\))
71-- import Control.Concurrent.STM.TChan 71-- import Control.Concurrent.STM.TChan
@@ -107,6 +107,7 @@ import Stanza.Parse
107import Stanza.Types 107import Stanza.Types
108import MUC 108import MUC
109import Chat 109import Chat
110import 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
117my_uuid = "154ae29f-98f2-4af4-826d-a40c8a188574" 118my_uuid = "154ae29f-98f2-4af4-826d-a40c8a188574"
118 119
119 120
120newtype Local a = Local a deriving (Eq,Ord,Show)
121newtype Remote a = Remote a deriving (Eq,Ord,Show)
122
123data XMPPServerParameters = 121data 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
1093peerKey :: SocketLike sock => Maybe SockAddr -> sock -> IO (PeerAddress,ConnectionData) 1091peerKey :: SocketLike sock => Maybe SockAddr -> (sock, (Local SockAddr, Remote SockAddr)) -> IO (PeerAddress,ConnectionData)
1094peerKey bind_addr sock = do 1092peerKey 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
1114clientKey :: SocketLike sock => sock -> IO (PeerAddress,ConnectionData) 1114clientKey :: SocketLike sock => (sock, (Local SockAddr,Remote SockAddr)) -> IO (PeerAddress,ConnectionData)
1115clientKey sock = do 1115clientKey (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)