1 files changed, 51 insertions, 14 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
 
 eofConn :: PresenceState -> SockAddr -> ConnectionData -> IO ()
 eofConn state saddr cdta = do
-    atomically $ case classifyConnection saddr cdta of
-                    Left  (pkey,_) -> modifyTVar' (pkeyToChan state) $ Map.delete pkey
-                    Right (ckey,_) -> modifyTVar' (ckeyToChan state) $ Map.delete ckey
     case classifyConnection saddr cdta of
         Left (k,_) -> do
-            let h = peerKeyToText k
+            h <- case cdType cdta of
+                -- TODO: This should be cached (perhaps by rewriteJIDForClient?) so that we
+                -- guarantee that the OFFLINE message matches the ONLINE message.
+                -- For now, we reverse-resolve the peer key.
+                XMPP -> -- For XMPP peers, informPeerPresence expects a textual
+                        -- representation of the IP address to reverse-resolve.
+                        return $ peerKeyToText k
+                Tox  -> do
+                    -- For Tox peers, informPeerPresence expects the actual hostname
+                    -- so we will use the one that the peer told us at greeting time.
+                    m <- atomically $ swapTVar (cdRemoteName cdta) Nothing
+                    case m of
+                        Nothing -> do
+                            dput XJabber $ "BUG: Tox peer didn't inform us of its name."
+                            -- The following fallback behavior is probably wrong.
+                            return $ peerKeyToText k
+                        Just toxname -> return toxname
+            -- ioToSource terminated.
+            --
+            -- dhtd: Network.Socket.getAddrInfo
+            --   (called with preferred socket type/protocol: AddrInfo
+            --      { addrFlags = [AI_NUMERICHOST], addrFamily = AF_UNSPEC
+            --      , addrSocketType = NoSocketType, addrProtocol = 0
+            --      , addrAddress = <assumed to be undefined>
+            --      , addrCanonName = <assumed to be undefined>}
+            --      , host name: Just "DdhbLjiwaV0GAiGKgesNPbvj2TbhrBHEWEEc5icfvQN.tox"
+            --      , service name: Just "0")
+            --      : does not exist (Name or service not known)
+
             jids <- atomically $ do
                 rbp <- readTVar (remotesByPeer state)
                 return $ do
                     umap <- maybeToList $ Map.lookup k rbp
                     (u,rp) <- Map.toList umap
                     r <- Map.keys (resources rp)
-                    return $ unsplitJID (Just u, h, Just r)
+                    let excludeEmpty "" = Nothing
+                        excludeEmpty x  = Just x
+                    return $ unsplitJID (excludeEmpty u, h, excludeEmpty r)
+            -- EOF PEER PeerAddress [d768:82dd:3e86:a6ba:8fb3:6f9c:6327:75d8%4236342772]:0:
+            --   ["@[d768:82dd:3e86:a6ba:8fb3:6f9c:6327:75d8%4236342772]/"]
+            -- dput XJabber $ "EOF PEER "++show k++": "++show jids
             forM_ jids $ \jid -> do
             stanza <- makePresenceStanza "jabber:client" (Just jid) Offline
             informPeerPresence state k stanza
@@ -502,6 +532,9 @@ eofConn state saddr cdta = do
             atomically $ do
                 modifyTVar' (clientsByUser    state) $ Map.alter (delclient k) (clientUser    client)
                 modifyTVar' (clientsByProfile state) $ Map.alter (delclient k) (clientProfile client)
+    atomically $ case classifyConnection saddr cdta of
+                    Left  (pkey,_) -> modifyTVar' (pkeyToChan state) $ Map.delete pkey
+                    Right (ckey,_) -> modifyTVar' (ckeyToChan state) $ Map.delete ckey
 
 {-
 parseRemoteAddress :: Text -> IO (Maybe (Remote SockAddr))
@@ -594,8 +627,9 @@ deliverMessage state fail msg =
         -- Case 1.  Client -> Peer
         mto <- join $ atomically $ do
             mclient <- Map.lookup senderk <$> readTVar (clients state)
-            return
-              $ fromMaybe -- Resolve XMPP peer.
+            return $ do
+              dput XJabber $ "deliverMessage: to="++show (stanzaTo msg,fmap clientProfile mclient)
+              fromMaybe -- Resolve XMPP peer.
                           (fmap join $ mapM rewriteJIDForPeer (stanzaTo msg))
                 $ do
                      client <- mclient
@@ -603,6 +637,7 @@ deliverMessage state fail msg =
                      let (mu,th,rsc) = splitJID to
                      (toxman,me,_) <- weAreTox state client th
                      return $ do
+                         dput XJabber $ "deliverMessage: weAreTox="++show me
                          -- In case the client sends us a lower-cased version of the base64
                          -- tox key hostname, we resolve it by comparing it with roster entries.
                          xs <- getBuddiesAndSolicited state (clientProfile client) $ \case
@@ -637,7 +672,7 @@ deliverMessage state fail msg =
                       fail)
                 $ Map.lookup senderk pchans
             <&> \(Conn { connChan = sender_chan
-                       , auxData  = ConnectionData (Left laddr) ctyp cprof }) -> do
+                       , auxData  = ConnectionData (Left laddr) ctyp cprof _ }) -> do
         fromMaybe (do dput XJabber $ "Message missing \"to\" attribute."
                       fail)
                 $ (stanzaTo msg) <&> \to -> do
@@ -777,7 +812,7 @@ informPeerPresence state k stanza = do
     let (muser0,h,mresource0) = splitJID from
         -- We'll allow the case that user and resource are simultaneously
         -- absent.  They will be stored in the remotesByPeer map using the
-        -- empty string.  This is to accomodate the tox protocol which didn't
+        -- empty string.  This is to accommodate the tox protocol which didn't
         -- anticipate a single peer would have multiple users or front-ends.
         (muser,mresource) = case (muser0,mresource0) of
             (Nothing,Nothing) -> (Just "", Just "")
@@ -826,14 +861,16 @@ informPeerPresence state k stanza = do
     (ctyp,cprof) <- atomically $ do
         mconn <- Map.lookup k <$> readTVar (pkeyToChan state)
         return $ fromMaybe (XMPP,".") $ do
-            ConnectionData _ ctyp cprof <- auxData <$> mconn
+            ConnectionData _ ctyp cprof _ <- auxData <$> mconn
             return (ctyp,cprof)
     forM_ clients $ \(ck,con,client) -> do
         -- (TODO: appropriately authorized clients only.)
         -- For now, all "available" clients (available = sent initial presence)
         is_avail <- atomically $ clientIsAvailable client
         when is_avail $ do
-        dput XJabber $ "reversing for client: " ++ show from
+        -- reversing for client: ("DdhbLjiwaV0GAiGKgesNPbvj2TbhrBHEWEEc5icfvQN.tox"
+        --                       ,XMPP,"OrjBG.GyWuQhGc1pb0KssgmYAocohFh35Vx8mREC9Nu.tox",".")
+        dput XJabber $ "reversing for client: " ++ show (from,ctyp,clientProfile client,cprof)
         froms <- case ctyp of
             Tox | clientProfile client == cprof -> return [from]
             _ -> do -- flip (maybe $ return [from]) k . const $ do
@@ -1030,7 +1067,7 @@ clientSubscriptionRequest :: PresenceState -> IO () -> ClientAddress -> Stanza -
 clientSubscriptionRequest state fail k stanza chan = do
     forClient state k fail $ \client -> do
     fromMaybe fail $ (splitJID <$> stanzaTo stanza) <&> \(mu,h,_) -> do
-    dput XJabber $ "Forwarding solictation to peer"
+    dput XJabber $ "Forwarding solicitation to peer"
     let to0   = unsplitJID (mu,h,Nothing) -- deleted resource
         cuser = clientUser client
         cprof = clientProfile client
@@ -1166,7 +1203,7 @@ peerSubscriptionRequest state fail k stanza chan = do
         cmap <- readTVar (clients state)
         return (pktc,cktc,cmap)
     fromMaybe fail $ (Map.lookup k pktc)
-        <&> \Conn { auxData=ConnectionData (Left laddr) ctyp profile } -> do
+        <&> \Conn { auxData=ConnectionData (Left laddr) ctyp profile _ } -> do
     (mine,totup) <- case (ctyp,profile) of
         (Tox,p) -> let (u,h,r) = splitJID to
                    in return ( h == p, (u,h,r) )
@@ -1314,7 +1351,7 @@ peerInformSubscription state fail k stanza = do
         return (pktc,cktc,cmap)
     fromMaybe fail $ Map.lookup k ktc
         <&> \(Conn { connChan=sender_chan
-                   , auxData =ConnectionData (Left laddr) ctyp profile}) -> do
+                   , auxData =ConnectionData (Left laddr) ctyp profile _ }) -> do
     (from_u,from_h,_) <- case ctyp of
         Tox  -> return $ splitJID from
         XMPP -> snd <$> rewriteJIDForClient laddr from []