1 files changed, 20 insertions, 0 deletions

diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index e15b10cc..5435c913 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -282,6 +282,23 @@ handleIQSetBind session cmdChan stanza_id = do
                 atomically $ writeTChan cmdChan (Send $ iq_bind_reply stanza_id (toStrict $ L.decodeUtf8 $ L.show jid) )
         _ -> unhandledBind
 
+
+iq_session_reply host stanza_id =
+    [ EventBeginElement "{jabber:client}iq" 
+        [("id",[ContentText stanza_id])
+        ,("from",[ContentText host])
+        ,("type",[ContentText "result"])
+        ]
+    , EventEndElement "{jabber:client}iq"
+    ]
+
+handleIQSetSession session cmdChan stanza_id = do
+    host <- liftIO $ do
+        jid <- getJID session
+        names <- getNamesForPeer (peer jid)
+        return (S.decodeUtf8 . head $ names)
+    liftIO . atomically . writeTChan cmdChan . Send $ iq_session_reply host stanza_id
+
 handleIQSet session cmdChan tag = do
     withJust (lookupAttrib "id" (tagAttrs tag)) $ \stanza_id -> do
     whenJust nextElement $ \child -> do
@@ -289,6 +306,8 @@ handleIQSet session cmdChan tag = do
     case tagName child of
       "{urn:ietf:params:xml:ns:xmpp-bind}bind" 
         -> handleIQSetBind session cmdChan stanza_id
+      "{urn:ietf:params:xml:ns:xmpp-session}session"
+        -> handleIQSetSession session cmdChan stanza_id
       _ -> unhandledSet
 
 matchAttrib name value attrs = 
@@ -329,6 +348,7 @@ fromClient session cmdChan = doNestingXML $ do
     send $ greet host
     
     fix $ \loop -> do
+        log "waiting for stanza."
         whenJust nextElement $ \stanza -> do
             stanza_lvl <- nesting