2 files changed, 13 insertions, 2 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index e66eea70..7fc11124 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -1503,6 +1503,7 @@ monitor sv params xmpp = do
             RequiresPing -> return () -- wlog $ tomsg k "RequiresPing"
             _ -> return ()
       , readTChan stanzas >>= \stanza -> return $ do
+        {-
         dup <- case stanzaType stanza of
                 -- Must dup anything that is going to be delivered...
                 Message {} -> do
@@ -1512,6 +1513,9 @@ monitor sv params xmpp = do
                     dup <- cloneStanza stanza -- dupped so we can make debug print
                     return dup
                 _ -> return stanza
+        -}
+        dup <- cloneStanza stanza
+
         forkIO $ do
             case stanzaOrigin stanza of
                 NetworkOrigin k@(ClientKey {}) replyto -> 
@@ -1574,6 +1578,7 @@ monitor sv params xmpp = do
                     case stanzaType stanza of
                         PresenceRequestStatus {} -> do
                             xmppAnswerProbe xmpp k stanza replyto
+                        _ -> return ()
                 _ -> return ()
             let deliver replyto = do
                     -- TODO: Issuing RecipientUnavailable for all errors is a presence leak
diff --git a/xmppServer.hs b/xmppServer.hs
index 5487e532..3899a258 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -414,6 +414,7 @@ informClientPresence state k stanza = do
         writeTVar (clientStatus cstate) $ Just dup
 
 answerProbe state k stanza chan = do
+    putStrLn $ "answerProbe! " ++ show (stanzaType stanza)
     ktc <- atomically $ readTVar (keyToChan state)
     replies <- runTraversableT $ do
         let liftMaybe = liftT . maybeToList
@@ -427,8 +428,13 @@ answerProbe state k stanza chan = do
         cbu <- lift . atomically $ readTVar (clientsByUser state)
         lpres <- liftMaybe $ Map.lookup u cbu
         clientState <- liftT $ Map.elems (networkClients lpres)
-        mstanza <- lift $ atomically (readTVar (clientStatus clientState))
-        liftMaybe mstanza
+        stanza <- liftIOMaybe $ atomically (readTVar (clientStatus clientState))
+        -- TODO: from address!!
+        let jid = unsplitJID (Just $ clientUser clientState
+                             , ch
+                             ,Just $ clientResource clientState)
+            ch = addrToText (auxAddr conn)
+        return stanza { stanzaFrom = Just jid }
     forM_ replies $ \reply -> do
         sendModifiedStanzaToPeer reply chan
     -- TODO: if null replies, send offline message