reply to iq-set-session

2 files changed, 22 insertions, 2 deletions

diff --git a/Presence/ServerC.hs b/Presence/ServerC.hs
index ae0bf154..b16a0099 100644
--- a/Presence/ServerC.hs
+++ b/Presence/ServerC.hs
@@ -125,9 +125,9 @@ packets h = do
 
 outgoing :: MonadIO m => Handle -> Sink S.ByteString m ()
 outgoing h = do
-    liftIO . L.putStrLn $ "outgoing: waiting"
+    -- liftIO . L.putStrLn $ "outgoing: waiting"
     mpacket <- await
-    liftIO . L.putStrLn $ "outgoing: got packet " <++> bshow mpacket
+    -- liftIO . L.putStrLn $ "outgoing: got packet " <++> bshow mpacket
     maybe (return ()) 
           (\r -> (liftIO . S.hPutStrLn h $ r) >> outgoing h) 
           mpacket
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