From d06ebc86eb82e3902e878d7a8e6f1b55b1f2b2f1 Mon Sep 17 00:00:00 2001
From: Jon Kristensen <info@jonkri.com>
Date: Mon, 11 Mar 2013 00:39:56 +0100
Subject: [PATCH] Make legacy sesion bind optional and disabled by default

---
 source/Network/Xmpp/Sasl.hs  | 8 +++++++-
 source/Network/Xmpp/Types.hs | 5 +++++
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/source/Network/Xmpp/Sasl.hs b/source/Network/Xmpp/Sasl.hs
index 5b55c3d..f9b9ef9 100644
--- a/source/Network/Xmpp/Sasl.hs
+++ b/source/Network/Xmpp/Sasl.hs
@@ -107,7 +107,13 @@ auth :: [SaslHandler]
 auth mechanisms resource con = runErrorT $ do
     ErrorT $ xmppSasl mechanisms con
     jid <- ErrorT $ xmppBind resource con
-    _ <- lift $ startSession con
+    ErrorT $ flip withStream con $ do
+        s <- get
+        case establishSession $ streamConfiguration s of
+            False -> return $ Right Nothing
+            True -> do
+                _ <- lift $ startSession con
+                return $ Right Nothing
     return Nothing
 
 -- Produces a `bind' element, optionally wrapping a resource.
diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs
index 88871c8..2d76173 100644
--- a/source/Network/Xmpp/Types.hs
+++ b/source/Network/Xmpp/Types.hs
@@ -1036,6 +1036,10 @@ data StreamConfiguration =
                         , socketDetails :: Maybe (Socket, SockAddr)
                           -- | DNS resolver configuration
                         , resolvConf :: ResolvConf
+                          -- | Whether or not to perform the legacy
+                          -- session bind as defined in the (outdated)
+                          -- RFC 3921 specification
+                        , establishSession :: Bool
                         }
 
 
@@ -1044,6 +1048,7 @@ instance Default StreamConfiguration where
                               , toJid = Nothing
                               , socketDetails = Nothing
                               , resolvConf = defaultResolvConf
+                              , establishSession = False
                               }
 
 data Hostname = Hostname Text deriving (Eq, Show)