summaryrefslogtreecommitdiff
path: root/Presence
diff options
context:
space:
mode:
Diffstat (limited to 'Presence')
-rw-r--r--Presence/Presence.hs65
-rw-r--r--Presence/XMPPServer.hs94
2 files changed, 125 insertions, 34 deletions
diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index 4f0deb32..fad87aeb 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -475,19 +475,49 @@ delclient k mlp = do
475 475
476eofConn :: PresenceState -> SockAddr -> ConnectionData -> IO () 476eofConn :: PresenceState -> SockAddr -> ConnectionData -> IO ()
477eofConn state saddr cdta = do 477eofConn state saddr cdta = do
478 atomically $ case classifyConnection saddr cdta of
479 Left (pkey,_) -> modifyTVar' (pkeyToChan state) $ Map.delete pkey
480 Right (ckey,_) -> modifyTVar' (ckeyToChan state) $ Map.delete ckey
481 case classifyConnection saddr cdta of 478 case classifyConnection saddr cdta of
482 Left (k,_) -> do 479 Left (k,_) -> do
483 let h = peerKeyToText k 480 h <- case cdType cdta of
481 -- TODO: This should be cached (perhaps by rewriteJIDForClient?) so that we
482 -- guarantee that the OFFLINE message matches the ONLINE message.
483 -- For now, we reverse-resolve the peer key.
484 XMPP -> -- For XMPP peers, informPeerPresence expects a textual
485 -- representation of the IP address to reverse-resolve.
486 return $ peerKeyToText k
487 Tox -> do
488 -- For Tox peers, informPeerPresence expects the actual hostname
489 -- so we will use the one that the peer told us at greeting time.
490 m <- atomically $ swapTVar (cdRemoteName cdta) Nothing
491 case m of
492 Nothing -> do
493 dput XJabber $ "BUG: Tox peer didn't inform us of its name."
494 -- The following fallback behavior is probably wrong.
495 return $ peerKeyToText k
496 Just toxname -> return toxname
497 -- ioToSource terminated.
498 --
499 -- dhtd: Network.Socket.getAddrInfo
500 -- (called with preferred socket type/protocol: AddrInfo
501 -- { addrFlags = [AI_NUMERICHOST], addrFamily = AF_UNSPEC
502 -- , addrSocketType = NoSocketType, addrProtocol = 0
503 -- , addrAddress = <assumed to be undefined>
504 -- , addrCanonName = <assumed to be undefined>}
505 -- , host name: Just "DdhbLjiwaV0GAiGKgesNPbvj2TbhrBHEWEEc5icfvQN.tox"
506 -- , service name: Just "0")
507 -- : does not exist (Name or service not known)
508
484 jids <- atomically $ do 509 jids <- atomically $ do
485 rbp <- readTVar (remotesByPeer state) 510 rbp <- readTVar (remotesByPeer state)
486 return $ do 511 return $ do
487 umap <- maybeToList $ Map.lookup k rbp 512 umap <- maybeToList $ Map.lookup k rbp
488 (u,rp) <- Map.toList umap 513 (u,rp) <- Map.toList umap
489 r <- Map.keys (resources rp) 514 r <- Map.keys (resources rp)
490 return $ unsplitJID (Just u, h, Just r) 515 let excludeEmpty "" = Nothing
516 excludeEmpty x = Just x
517 return $ unsplitJID (excludeEmpty u, h, excludeEmpty r)
518 -- EOF PEER PeerAddress [d768:82dd:3e86:a6ba:8fb3:6f9c:6327:75d8%4236342772]:0:
519 -- ["@[d768:82dd:3e86:a6ba:8fb3:6f9c:6327:75d8%4236342772]/"]
520 -- dput XJabber $ "EOF PEER "++show k++": "++show jids
491 forM_ jids $ \jid -> do 521 forM_ jids $ \jid -> do
492 stanza <- makePresenceStanza "jabber:client" (Just jid) Offline 522 stanza <- makePresenceStanza "jabber:client" (Just jid) Offline
493 informPeerPresence state k stanza 523 informPeerPresence state k stanza
@@ -502,6 +532,9 @@ eofConn state saddr cdta = do
502 atomically $ do 532 atomically $ do
503 modifyTVar' (clientsByUser state) $ Map.alter (delclient k) (clientUser client) 533 modifyTVar' (clientsByUser state) $ Map.alter (delclient k) (clientUser client)
504 modifyTVar' (clientsByProfile state) $ Map.alter (delclient k) (clientProfile client) 534 modifyTVar' (clientsByProfile state) $ Map.alter (delclient k) (clientProfile client)
535 atomically $ case classifyConnection saddr cdta of
536 Left (pkey,_) -> modifyTVar' (pkeyToChan state) $ Map.delete pkey
537 Right (ckey,_) -> modifyTVar' (ckeyToChan state) $ Map.delete ckey
505 538
506{- 539{-
507parseRemoteAddress :: Text -> IO (Maybe (Remote SockAddr)) 540parseRemoteAddress :: Text -> IO (Maybe (Remote SockAddr))
@@ -594,8 +627,9 @@ deliverMessage state fail msg =
594 -- Case 1. Client -> Peer 627 -- Case 1. Client -> Peer
595 mto <- join $ atomically $ do 628 mto <- join $ atomically $ do
596 mclient <- Map.lookup senderk <$> readTVar (clients state) 629 mclient <- Map.lookup senderk <$> readTVar (clients state)
597 return 630 return $ do
598 $ fromMaybe -- Resolve XMPP peer. 631 dput XJabber $ "deliverMessage: to="++show (stanzaTo msg,fmap clientProfile mclient)
632 fromMaybe -- Resolve XMPP peer.
599 (fmap join $ mapM rewriteJIDForPeer (stanzaTo msg)) 633 (fmap join $ mapM rewriteJIDForPeer (stanzaTo msg))
600 $ do 634 $ do
601 client <- mclient 635 client <- mclient
@@ -603,6 +637,7 @@ deliverMessage state fail msg =
603 let (mu,th,rsc) = splitJID to 637 let (mu,th,rsc) = splitJID to
604 (toxman,me,_) <- weAreTox state client th 638 (toxman,me,_) <- weAreTox state client th
605 return $ do 639 return $ do
640 dput XJabber $ "deliverMessage: weAreTox="++show me
606 -- In case the client sends us a lower-cased version of the base64 641 -- In case the client sends us a lower-cased version of the base64
607 -- tox key hostname, we resolve it by comparing it with roster entries. 642 -- tox key hostname, we resolve it by comparing it with roster entries.
608 xs <- getBuddiesAndSolicited state (clientProfile client) $ \case 643 xs <- getBuddiesAndSolicited state (clientProfile client) $ \case
@@ -637,7 +672,7 @@ deliverMessage state fail msg =
637 fail) 672 fail)
638 $ Map.lookup senderk pchans 673 $ Map.lookup senderk pchans
639 <&> \(Conn { connChan = sender_chan 674 <&> \(Conn { connChan = sender_chan
640 , auxData = ConnectionData (Left laddr) ctyp cprof }) -> do 675 , auxData = ConnectionData (Left laddr) ctyp cprof _ }) -> do
641 fromMaybe (do dput XJabber $ "Message missing \"to\" attribute." 676 fromMaybe (do dput XJabber $ "Message missing \"to\" attribute."
642 fail) 677 fail)
643 $ (stanzaTo msg) <&> \to -> do 678 $ (stanzaTo msg) <&> \to -> do
@@ -777,7 +812,7 @@ informPeerPresence state k stanza = do
777 let (muser0,h,mresource0) = splitJID from 812 let (muser0,h,mresource0) = splitJID from
778 -- We'll allow the case that user and resource are simultaneously 813 -- We'll allow the case that user and resource are simultaneously
779 -- absent. They will be stored in the remotesByPeer map using the 814 -- absent. They will be stored in the remotesByPeer map using the
780 -- empty string. This is to accomodate the tox protocol which didn't 815 -- empty string. This is to accommodate the tox protocol which didn't
781 -- anticipate a single peer would have multiple users or front-ends. 816 -- anticipate a single peer would have multiple users or front-ends.
782 (muser,mresource) = case (muser0,mresource0) of 817 (muser,mresource) = case (muser0,mresource0) of
783 (Nothing,Nothing) -> (Just "", Just "") 818 (Nothing,Nothing) -> (Just "", Just "")
@@ -826,14 +861,16 @@ informPeerPresence state k stanza = do
826 (ctyp,cprof) <- atomically $ do 861 (ctyp,cprof) <- atomically $ do
827 mconn <- Map.lookup k <$> readTVar (pkeyToChan state) 862 mconn <- Map.lookup k <$> readTVar (pkeyToChan state)
828 return $ fromMaybe (XMPP,".") $ do 863 return $ fromMaybe (XMPP,".") $ do
829 ConnectionData _ ctyp cprof <- auxData <$> mconn 864 ConnectionData _ ctyp cprof _ <- auxData <$> mconn
830 return (ctyp,cprof) 865 return (ctyp,cprof)
831 forM_ clients $ \(ck,con,client) -> do 866 forM_ clients $ \(ck,con,client) -> do
832 -- (TODO: appropriately authorized clients only.) 867 -- (TODO: appropriately authorized clients only.)
833 -- For now, all "available" clients (available = sent initial presence) 868 -- For now, all "available" clients (available = sent initial presence)
834 is_avail <- atomically $ clientIsAvailable client 869 is_avail <- atomically $ clientIsAvailable client
835 when is_avail $ do 870 when is_avail $ do
836 dput XJabber $ "reversing for client: " ++ show from 871 -- reversing for client: ("DdhbLjiwaV0GAiGKgesNPbvj2TbhrBHEWEEc5icfvQN.tox"
872 -- ,XMPP,"OrjBG.GyWuQhGc1pb0KssgmYAocohFh35Vx8mREC9Nu.tox",".")
873 dput XJabber $ "reversing for client: " ++ show (from,ctyp,clientProfile client,cprof)
837 froms <- case ctyp of 874 froms <- case ctyp of
838 Tox | clientProfile client == cprof -> return [from] 875 Tox | clientProfile client == cprof -> return [from]
839 _ -> do -- flip (maybe $ return [from]) k . const $ do 876 _ -> do -- flip (maybe $ return [from]) k . const $ do
@@ -1030,7 +1067,7 @@ clientSubscriptionRequest :: PresenceState -> IO () -> ClientAddress -> Stanza -
1030clientSubscriptionRequest state fail k stanza chan = do 1067clientSubscriptionRequest state fail k stanza chan = do
1031 forClient state k fail $ \client -> do 1068 forClient state k fail $ \client -> do
1032 fromMaybe fail $ (splitJID <$> stanzaTo stanza) <&> \(mu,h,_) -> do 1069 fromMaybe fail $ (splitJID <$> stanzaTo stanza) <&> \(mu,h,_) -> do
1033 dput XJabber $ "Forwarding solictation to peer" 1070 dput XJabber $ "Forwarding solicitation to peer"
1034 let to0 = unsplitJID (mu,h,Nothing) -- deleted resource 1071 let to0 = unsplitJID (mu,h,Nothing) -- deleted resource
1035 cuser = clientUser client 1072 cuser = clientUser client
1036 cprof = clientProfile client 1073 cprof = clientProfile client
@@ -1166,7 +1203,7 @@ peerSubscriptionRequest state fail k stanza chan = do
1166 cmap <- readTVar (clients state) 1203 cmap <- readTVar (clients state)
1167 return (pktc,cktc,cmap) 1204 return (pktc,cktc,cmap)
1168 fromMaybe fail $ (Map.lookup k pktc) 1205 fromMaybe fail $ (Map.lookup k pktc)
1169 <&> \Conn { auxData=ConnectionData (Left laddr) ctyp profile } -> do 1206 <&> \Conn { auxData=ConnectionData (Left laddr) ctyp profile _ } -> do
1170 (mine,totup) <- case (ctyp,profile) of 1207 (mine,totup) <- case (ctyp,profile) of
1171 (Tox,p) -> let (u,h,r) = splitJID to 1208 (Tox,p) -> let (u,h,r) = splitJID to
1172 in return ( h == p, (u,h,r) ) 1209 in return ( h == p, (u,h,r) )
@@ -1314,7 +1351,7 @@ peerInformSubscription state fail k stanza = do
1314 return (pktc,cktc,cmap) 1351 return (pktc,cktc,cmap)
1315 fromMaybe fail $ Map.lookup k ktc 1352 fromMaybe fail $ Map.lookup k ktc
1316 <&> \(Conn { connChan=sender_chan 1353 <&> \(Conn { connChan=sender_chan
1317 , auxData =ConnectionData (Left laddr) ctyp profile}) -> do 1354 , auxData =ConnectionData (Left laddr) ctyp profile _ }) -> do
1318 (from_u,from_h,_) <- case ctyp of 1355 (from_u,from_h,_) <- case ctyp of
1319 Tox -> return $ splitJID from 1356 Tox -> return $ splitJID from
1320 XMPP -> snd <$> rewriteJIDForClient laddr from [] 1357 XMPP -> snd <$> rewriteJIDForClient laddr from []
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index ae861a61..0d2d479b 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -42,6 +42,8 @@ module XMPPServer
42 , greet' 42 , greet'
43 , (<&>) 43 , (<&>)
44 , grokStanza 44 , grokStanza
45 , Uniq24(..)
46 , uniqueAsKey
45 ) where 47 ) where
46 48
47import ConnectionKey 49import ConnectionKey
@@ -56,6 +58,8 @@ import qualified Connection
56import Util 58import Util
57import Network.Address (getBindAddress, sockAddrPort) 59import Network.Address (getBindAddress, sockAddrPort)
58 60
61import Data.Bits
62import Data.Word
59import Debug.Trace 63import Debug.Trace
60import Control.Monad.Trans (lift) 64import Control.Monad.Trans (lift)
61import Control.Monad.IO.Class (MonadIO, liftIO) 65import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -908,7 +912,7 @@ makePong namespace mid to from =
908 912
909data ClientOrPeer = IsClient | IsPeer 913data ClientOrPeer = IsClient | IsPeer
910 914
911xmppInbound :: Server SockAddr ConnectionData releaseKey XML.Event -- ^ XXX: unused 915xmppInbound :: ConnectionData
912 -> XMPPServerParameters -- ^ XXX: unused 916 -> XMPPServerParameters -- ^ XXX: unused
913 -> (Text, IO Text, IO Text, TChan Stanza -> StanzaOrigin) 917 -> (Text, IO Text, IO Text, TChan Stanza -> StanzaOrigin)
914 -> FlagCommand -- ^ action to check whether the connection needs a ping (XXX: unused) 918 -> FlagCommand -- ^ action to check whether the connection needs a ping (XXX: unused)
@@ -916,14 +920,16 @@ xmppInbound :: Server SockAddr ConnectionData releaseKey XML.Event -- ^ XXX: unu
916 -> TChan Stanza -- ^ channel used to send stanzas 920 -> TChan Stanza -- ^ channel used to send stanzas
917 -> TMVar () -- ^ mvar that is filled when the connection quits 921 -> TMVar () -- ^ mvar that is filled when the connection quits
918 -> ConduitM Event o IO () 922 -> ConduitM Event o IO ()
919xmppInbound sv xmpp (namespace,tellmyname,tellyourname,mkorigin) pingflag stanzas output donevar = doNestingXML $ do 923xmppInbound cdta xmpp (namespace,tellmyname,tellyourname,mkorigin) pingflag stanzas output donevar = doNestingXML $ do
920 withXML $ \begindoc -> do 924 withXML $ \begindoc -> do
921 when (begindoc==EventBeginDocument) $ do 925 when (begindoc==EventBeginDocument) $ do
922 whenJust nextElement $ \xml -> do 926 whenJust nextElement $ \xml -> do
923 withJust (elementAttrs "stream" xml) $ \stream_attrs -> do 927 withJust (elementAttrs "stream" xml) $ \stream_attrs -> do
924 -- liftIO $ dput XMisc $ "STREAM ATTRS "++show stream_attrs 928 -- liftIO $ dput XMisc $ "STREAM ATTRS "++show stream_attrs
925 let stream_name = lookupAttrib "to" stream_attrs 929 let stream_name = lookupAttrib "to" stream_attrs
930 stream_remote = lookupAttrib "from" stream_attrs
926 -- xmpp_version = lookupAttrib "version" stream_attrs 931 -- xmpp_version = lookupAttrib "version" stream_attrs
932 liftIO $ atomically $ writeTVar (cdRemoteName cdta) stream_remote
927 fix $ \loop -> do 933 fix $ \loop -> do
928 -- liftIO . wlog $ "waiting for stanza." 934 -- liftIO . wlog $ "waiting for stanza."
929 (chan,clsrs) <- liftIO . atomically $ 935 (chan,clsrs) <- liftIO . atomically $
@@ -1282,13 +1288,25 @@ forkConnection sv xmpp saddr cdta pingflag src snk stanzas = do
1282 let lbl n = concat [ n 1288 let lbl n = concat [ n
1283 , Text.unpack (Text.drop 7 namespace) 1289 , Text.unpack (Text.drop 7 namespace)
1284 , "." 1290 , "."
1285 , show saddr ] 1291 , case cdProfile cdta of
1286 forkIO $ do myThreadId >>= flip labelThread (lbl "post-queue.") 1292 _ | Right _ <- cdAddr cdta -> show saddr
1293 "." -> show saddr
1294 mytoxname -> show saddr {- TODO: remote tox peer name? -} ]
1295
1296 forkIO $ do myThreadId >>= flip labelThread (lbl "xmpp-post.")
1297 -- This thread handles messages after they are pulled out of
1298 -- the slots-queue. Hence, xmpp-post, for post- slots-queue.
1299
1300 -- Read all slots-queued XML events or stanzas and yield them
1301 -- upstream. This should continue until the connection is
1302 -- closed.
1287 (greet_src >> slot_src) $$ snk 1303 (greet_src >> slot_src) $$ snk
1304
1305 -- Connection is now closed. Here we handle any unsent stanzas.
1288 last <- atomically $ readTVar lastStanza 1306 last <- atomically $ readTVar lastStanza
1289 es <- while (atomically . fmap not $ Slotted.isEmpty slots) 1307 es <- while (atomically . fmap not $ Slotted.isEmpty slots)
1290 (atomically . Slotted.pull $ slots) 1308 (atomically . Slotted.pull $ slots)
1291 let es' = mapMaybe metadata es 1309 let es' = mapMaybe metadata es -- We only care about full stanzas.
1292 metadata (Left s) = Just s 1310 metadata (Left s) = Just s
1293 metadata _ = Nothing 1311 metadata _ = Nothing
1294 -- TODO: Issuing RecipientUnavailable for all errors is a presence leak 1312 -- TODO: Issuing RecipientUnavailable for all errors is a presence leak
@@ -1304,17 +1322,21 @@ forkConnection sv xmpp saddr cdta pingflag src snk stanzas = do
1304 xmppDeliverMessage xmpp (wlog $ "discarded error delivery fail") replystanza 1322 xmppDeliverMessage xmpp (wlog $ "discarded error delivery fail") replystanza
1305 notError s = case stanzaType s of 1323 notError s = case stanzaType s of
1306 Error {} -> False 1324 Error {} -> False
1307 _ -> True 1325 _ -> True
1308 -- TODO: Probably some stanzas should be queued or saved for re-connect. 1326 -- TODO: Probably some stanzas should be queued or saved for re-connect.
1309 mapM_ fail $ filter notError (maybeToList last ++ es') 1327 mapM_ fail $ filter notError (maybeToList last ++ es')
1310 wlog $ "end post-queue fork: " ++ (lbl "") 1328 wlog $ "end xmpp-post fork: " ++ (lbl "")
1311 1329
1312 output <- atomically newTChan 1330 output <- atomically newTChan
1313 hacks <- atomically $ newTVar Map.empty 1331 hacks <- atomically $ newTVar Map.empty
1314 msgids <- atomically $ newTVar [] 1332 msgids <- atomically $ newTVar []
1315 forkIO $ do 1333 forkIO $ do
1334 -- Here is the pre- slots-queue thread which handles messages as they
1335 -- arrive and assigns slots to them if that is appropriate.
1336
1316 -- mapM_ (atomically . Slotted.push slots Nothing) greetPeer 1337 -- mapM_ (atomically . Slotted.push slots Nothing) greetPeer
1317 myThreadId >>= flip labelThread (lbl "pre-queue.") 1338 myThreadId >>= flip labelThread (lbl "xmpp-pre.")
1339
1318 verbosity <- xmppVerbosity xmpp 1340 verbosity <- xmppVerbosity xmpp
1319 fix $ \loop -> do 1341 fix $ \loop -> do
1320 what <- atomically $ foldr1 orElse 1342 what <- atomically $ foldr1 orElse
@@ -1385,11 +1407,11 @@ forkConnection sv xmpp saddr cdta pingflag src snk stanzas = do
1385 ,readTMVar rdone >> return (return ()) 1407 ,readTMVar rdone >> return (return ())
1386 ] 1408 ]
1387 what 1409 what
1388 wlog $ "end pre-queue fork: " ++ show (lbl "") 1410 wlog $ "end xmpp-pre fork: " ++ show (lbl "")
1389 forkIO $ do 1411 forkIO $ do
1390 myThreadId >>= flip labelThread (lbl "reader.") 1412 myThreadId >>= flip labelThread (lbl "reader.")
1391 -- src $$ awaitForever (lift . putStrLn . takeWhile (/=' ') . show) 1413 -- src $$ awaitForever (lift . putStrLn . takeWhile (/=' ') . show)
1392 src $$ xmppInbound sv xmpp clientOrServer pingflag stanzas output rdone 1414 src $$ xmppInbound cdta xmpp clientOrServer pingflag stanzas output rdone
1393 atomically $ putTMVar rdone () 1415 atomically $ putTMVar rdone ()
1394 wlog $ "end reader fork: " ++ lbl "" 1416 wlog $ "end reader fork: " ++ lbl ""
1395 return output 1417 return output
@@ -1413,20 +1435,48 @@ peerKey bind_addr sock = do
1413 if c then getPeerName sock -- addr is normally socketName 1435 if c then getPeerName sock -- addr is normally socketName
1414 else return laddr -- Weird hack: addr is would-be peer name 1436 else return laddr -- Weird hack: addr is would-be peer name
1415 -- Assume remote peers are listening on the same port that we do. 1437 -- Assume remote peers are listening on the same port that we do.
1416 let peerport = fromIntegral $ fromMaybe 5269 $ bind_addr >>= sockAddrPort 1438 let peerport = fromIntegral $ fromMaybe 5269 $ do
1439 p <- bind_addr >>= sockAddrPort
1440 guard (p /= 0) -- Make sure we never use port 0 because it is used
1441 -- to distinguish fake address connection keys.
1442 return p
1443 rname <- atomically $ newTVar Nothing
1417 return $ ( raddr `withPort` peerport 1444 return $ ( raddr `withPort` peerport
1418 , ConnectionData { cdAddr = Left (Local laddr) 1445 , ConnectionData { cdAddr = Left (Local laddr)
1419 , cdType = XMPP 1446 , cdType = XMPP
1420 , cdProfile = "." } ) 1447 , cdProfile = "."
1448 , cdRemoteName = rname } )
1421 1449
1422clientKey :: SocketLike sock => sock -> IO (SockAddr,ConnectionData) 1450clientKey :: SocketLike sock => sock -> IO (SockAddr,ConnectionData)
1423clientKey sock = do 1451clientKey sock = do
1424 laddr <- getSocketName sock 1452 laddr <- getSocketName sock
1425 raddr <- getPeerName sock 1453 raddr <- getPeerName sock
1454 when (Just 0 == sockAddrPort laddr) $ do
1455 dput XMan $ unwords [ "BUG: XMPP Client"
1456 , show (laddr,raddr)
1457 , "is using port zero. This could interfere"
1458 , "with Tox peer sessions." ]
1459 rname <- atomically $ newTVar Nothing
1426 return $ ( laddr 1460 return $ ( laddr
1427 , ConnectionData { cdAddr = Right (Remote raddr) 1461 , ConnectionData { cdAddr = Right (Remote raddr)
1428 , cdType = XMPP 1462 , cdType = XMPP
1429 , cdProfile = "." } ) 1463 , cdProfile = "."
1464 , cdRemoteName = rname } )
1465
1466
1467data Uniq24 = Uniq24 !Word64 !Word64 !Word64
1468 deriving (Eq,Ord,Show)
1469
1470uniqueAsKey :: Uniq24 -> SockAddr
1471uniqueAsKey (Uniq24 x y z) = SockAddrInet6 (fromIntegral 0) a bcde f
1472 where
1473 a = fromIntegral (x `shiftR` 32)
1474 b = fromIntegral x
1475 c = fromIntegral (y `shiftR` 32)
1476 d = fromIntegral y
1477 e = fromIntegral (z `shiftR` 32)
1478 f = fromIntegral z
1479 bcde = (b,c,d,e)
1430 1480
1431xmlifyRosterItems :: Monad m => Set Text -> Text -> Set Text -> ConduitM i Event m () 1481xmlifyRosterItems :: Monad m => Set Text -> Text -> Set Text -> ConduitM i Event m ()
1432xmlifyRosterItems solicited stype set = mapM_ item (Set.toList set) 1482xmlifyRosterItems solicited stype set = mapM_ item (Set.toList set)
@@ -1840,9 +1890,13 @@ data ConnectionData = ConnectionData
1840 , cdProfile :: Text -- Currently ignored for clients. Instead, see 1890 , cdProfile :: Text -- Currently ignored for clients. Instead, see
1841 -- 'clientProfile' field of 'ClientState'. 1891 -- 'clientProfile' field of 'ClientState'.
1842 -- 1892 --
1843 -- For peers: "." for XMPP, otherwise the ".tox" hostname. 1893 -- For peers: "." for XMPP, otherwise the ".tox" hostname
1894 -- of this local node.
1895
1896 -- Initially Nothing, when the remote end identifies itself by a given name,
1897 -- the result will be stored here.
1898 , cdRemoteName :: TVar (Maybe Text)
1844 } 1899 }
1845 deriving (Eq,Ord,Show)
1846 1900
1847addrToPeerKey :: Remote SockAddr -> PeerAddress 1901addrToPeerKey :: Remote SockAddr -> PeerAddress
1848addrToPeerKey (Remote raddr) = PeerAddress raddr 1902addrToPeerKey (Remote raddr) = PeerAddress raddr