3 files changed, 21 insertions, 13 deletions

diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index a55d49ab..678a5c99 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -99,7 +99,8 @@ data ToxManager k = ToxManager
 
 data PresenceState = forall status. PresenceState
     { clients         :: TVar (Map ConnectionKey ClientState)
-    , clientsByUser   :: TVar (Map Text LocalPresence)
+    , clientsByUser   :: TVar (Map Text LocalPresence) -- TODO: For tox-enabled clients, the lookup key should be the client's toxid
+                                                       --       rather than the unix user.
     , remotesByPeer   :: TVar (Map ConnectionKey
                                    (Map UserName RemotePresence))
     , server          :: TMVar (XMPPServer, Connection.Manager status Text)
@@ -601,6 +602,7 @@ deliverMessage state fail msg =
         let to' = unsplitJID (n,h,r)
         cmap <- atomically . readTVar $ clientsByUser state
         chans <- fmap (fromMaybe []) $ do
+            -- TODO: Tox-enabled clients need to be found by tox key.
             forM (n >>= flip Map.lookup cmap) $ \presence_container -> do
             let ks = Map.keys (networkClients presence_container)
                 chans = do
diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index f4a7cbab..2ab59568 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -83,18 +83,23 @@ xmppToTox = doNestingXML $ fix $ \loop -> do
     dput DPut.XMan $ "xmppToTox: " ++ show e
     loop
 
-toxToXmpp :: Monad m => Text -> Conduit Tox.CryptoMessage m XML.Event
-toxToXmpp toxhost = do
-    CL.sourceList $ XMPP.greet' "jabber:server" toxhost
+toxToXmpp :: Monad m => SockAddr -> PublicKey -> Text -> Conduit Tox.CryptoMessage m XML.Event
+toxToXmpp laddr me theirhost = do
+    CL.sourceList $ XMPP.greet' "jabber:server" theirhost
+    let me_u = T.pack $ show (key2id me)
     awaitForever $ \toxmsg -> do
-        xmppInstantMessage "jabber:server" (Just toxhost) (T.pack $ show $ msgID toxmsg)
+        xmppInstantMessage "jabber:server"
+            (Just theirhost)      -- /from/
+            (Just $ unsplitJID (me_u,T.pack (show laddr),Nothing)) -- /to/ should match local address of this node.
+            (T.pack $ show $ msgID toxmsg)
 
-xmppInstantMessage :: Monad m => Text -> Maybe Text -> Text -> ConduitM i Event m ()
-xmppInstantMessage namespace mfrom text = do
+xmppInstantMessage :: Monad m => Text -> Maybe Text -> Maybe Text -> Text -> ConduitM i Event m ()
+xmppInstantMessage namespace mfrom mto text = do
     let ns n = n { nameNamespace = Just namespace }
     C.yield $ EventBeginElement (ns "message")
-               ((maybe id (\t->(attr "from" t:)) mfrom)
-                 [attr "type" "normal" ])
+               (  maybe id (\t->(attr "from" t:)) mfrom
+                $ maybe id (\t->(attr "to" t:)) mto
+                $ [attr "type" "normal" ] )
     C.yield $   EventBeginElement (ns "body") []
     C.yield $     EventContent $ ContentText text
     C.yield $   EventEndElement (ns "body")
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 2b5974f1..b81e88b5 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1375,7 +1375,8 @@ newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar, ncPacketQueue
 
 -- | Called upon a new Tox friend-connection session with a remote peer in
 -- order to set up translating conduits that simulate a remote XMPP server.
-announceToxJabberPeer :: PublicKey -- ^ Remote tox node's long-term user key.
+announceToxJabberPeer :: PublicKey  -- ^ This node's long-term user key.
+                      -> PublicKey -- ^ Remote tox node's long-term user key.
                       -> TChan ((ConnectionKey,SockAddr), Tcp.ConnectionEvent XML.Event)
                       -> SockAddr -- ^ Local bind address for incoming Tox packets.
                       -> SockAddr -- ^ Remote address for this connection.
@@ -1383,14 +1384,14 @@ announceToxJabberPeer :: PublicKey -- ^ Remote tox node's long-term user key.
                       -> C.Source IO Tox.CryptoMessage
                       -> C.Sink (Flush Tox.CryptoMessage) IO ()
                       -> IO (Maybe (Tox.NetCryptoSession -> Tox.NetCryptoSession))
-announceToxJabberPeer them echan laddr saddr pingflag tsrc tsnk
+announceToxJabberPeer me them echan laddr saddr pingflag tsrc tsnk
     = do
      atomically $ writeTChan echan
         ( (PeerKey saddr, laddr )
         , Tcp.Connection pingflag xsrc xsnk )
      return Nothing
  where
-    xsrc = tsrc =$= toxToXmpp (T.pack $ show (Tox.key2id them) ++ ".tox")
+    xsrc = tsrc =$= toxToXmpp laddr me (T.pack $ show (Tox.key2id them) ++ ".tox")
     xsnk = flushPassThrough xmppToTox =$= tsnk
 
 vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString
@@ -1783,7 +1784,7 @@ main = do
                 xmppSink         = newXmmpSink netcrypto
             forM_ msv $ \sv -> do
                 let Tox.HaveDHTKey saddr = Tox.ncSockAddr netcrypto
-                announceToxJabberPeer (Tox.ncTheirPublicKey netcrypto) (xmppEventChannel sv) addrTox saddr pingflag xmppSrc xmppSink
+                announceToxJabberPeer (Tox.ncMyPublicKey netcrypto) (Tox.ncTheirPublicKey netcrypto) (xmppEventChannel sv) addrTox saddr pingflag xmppSrc xmppSink
                 forM_ mbtox $ \tox -> do
                 let ContactInfo{accounts} = Tox.toxContactInfo tox
                 mbacc <- HashMap.lookup (Tox.key2id $ Tox.ncMyPublicKey netcrypto)