diff options
Diffstat (limited to 'xmppServer.hs')
-rw-r--r-- | xmppServer.hs | 15 |
1 files changed, 14 insertions, 1 deletions
diff --git a/xmppServer.hs b/xmppServer.hs index f91c20ce..40c423aa 100644 --- a/xmppServer.hs +++ b/xmppServer.hs | |||
@@ -298,6 +298,8 @@ monitor sv params = do | |||
298 | let (xsrc,xsnk) = xmlStream conread conwrite | 298 | let (xsrc,xsnk) = xmlStream conread conwrite |
299 | forkConnection k pingflag xsrc xsnk stanzas | 299 | forkConnection k pingflag xsrc xsnk stanzas |
300 | return () | 300 | return () |
301 | ConnectFailure addr -> do | ||
302 | wlog $ tomsg k "ConnectFailure" | ||
301 | EOF -> wlog $ tomsg k "EOF" | 303 | EOF -> wlog $ tomsg k "EOF" |
302 | HalfConnection In -> do | 304 | HalfConnection In -> do |
303 | wlog $ tomsg k "ReadOnly" | 305 | wlog $ tomsg k "ReadOnly" |
@@ -323,11 +325,15 @@ data ConnectionKey | |||
323 | deriving (Show, Ord, Eq) | 325 | deriving (Show, Ord, Eq) |
324 | 326 | ||
325 | peerKey (sock,addr) = do | 327 | peerKey (sock,addr) = do |
326 | peer <- getPeerName sock | 328 | peer <- |
329 | sIsBound sock >>= \c -> | ||
330 | if c then getPeerName sock -- addr is normally socketName | ||
331 | else return addr -- Weird hack: addr is would-be peer name | ||
327 | return $ PeerKey (peer `withPort` fromIntegral peerport) | 332 | return $ PeerKey (peer `withPort` fromIntegral peerport) |
328 | 333 | ||
329 | clientKey (sock,addr) = return $ ClientKey addr | 334 | clientKey (sock,addr) = return $ ClientKey addr |
330 | 335 | ||
336 | |||
331 | peerport = 5269 | 337 | peerport = 5269 |
332 | clientport = 5222 | 338 | clientport = 5222 |
333 | 339 | ||
@@ -339,6 +345,13 @@ main = runResourceT $ do | |||
339 | , timeout = 10000 | 345 | , timeout = 10000 |
340 | , duplex = False } | 346 | , duplex = False } |
341 | client_params <- return $ connectionDefaults clientKey | 347 | client_params <- return $ connectionDefaults clientKey |
348 | let testaddr0 = "fd97:ca88:fa7c:b94b:c8b8:fad4:1021:a54d" | ||
349 | testaddr<- fmap (addrAddress . head) $ | ||
350 | getAddrInfo (Just $ defaultHints { addrFlags = [ AI_CANONNAME ]}) | ||
351 | (Just testaddr0) | ||
352 | (Just "5269") | ||
353 | putStrLn $ "Connecting to "++show testaddr | ||
354 | control sv (Connect testaddr peer_params) | ||
342 | forkIO $ monitor sv peer_params | 355 | forkIO $ monitor sv peer_params |
343 | control sv (Listen peerport peer_params) | 356 | control sv (Listen peerport peer_params) |
344 | -- control sv (Listen clientport client_params) | 357 | -- control sv (Listen clientport client_params) |