You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
73 lines
2.5 KiB
73 lines
2.5 KiB
-- Implementation of the PLAIN Simple Authentication and Security Layer (SASL) |
|
-- Mechanism, http://tools.ietf.org/html/rfc4616. |
|
|
|
{-# LANGUAGE OverloadedStrings #-} |
|
|
|
module Network.Xmpp.Sasl.Plain where |
|
|
|
import Control.Applicative |
|
import Control.Arrow (left) |
|
import Control.Monad |
|
import Control.Monad.Error |
|
import Control.Monad.State.Strict |
|
import Data.Maybe (fromJust, isJust) |
|
|
|
import qualified Crypto.Classes as CC |
|
|
|
import qualified Data.Binary as Binary |
|
import qualified Data.ByteString.Base64 as B64 |
|
import qualified Data.ByteString.Char8 as BS8 |
|
import qualified Data.ByteString.Lazy as BL |
|
import qualified Data.Digest.Pure.MD5 as MD5 |
|
import qualified Data.List as L |
|
import Data.Word (Word8) |
|
|
|
import qualified Data.Text as Text |
|
import Data.Text (Text) |
|
import qualified Data.Text.Encoding as Text |
|
|
|
import Data.XML.Pickle |
|
|
|
import qualified Data.ByteString as BS |
|
|
|
import Data.XML.Types |
|
|
|
import Network.Xmpp.Monad |
|
import Network.Xmpp.Stream |
|
import Network.Xmpp.Types |
|
import Network.Xmpp.Pickle |
|
|
|
import qualified System.Random as Random |
|
|
|
import Data.Maybe (fromMaybe) |
|
import qualified Data.Text as T |
|
|
|
import Network.Xmpp.Sasl.Sasl |
|
import Network.Xmpp.Sasl.Types |
|
|
|
xmppPLAIN :: Maybe T.Text |
|
-> T.Text |
|
-> T.Text |
|
-> XmppConMonad (Either AuthError ()) |
|
xmppPLAIN authzid authcid passwd = runErrorT $ do |
|
_ <- lift . pushElement $ saslInitE "PLAIN" $ -- TODO: Check boolean? |
|
Just $ Text.decodeUtf8 $ B64.encode $ Text.encodeUtf8 $ plainMessage authzid authcid passwd |
|
lift $ pushElement saslResponse2E |
|
e <- lift pullElement |
|
case e of |
|
Element "{urn:ietf:params:xml:ns:xmpp-sasl}success" [] [] -> |
|
return () |
|
_ -> throwError AuthXmlError -- TODO: investigate |
|
-- The SASL authentication has succeeded; the stream is restarted. |
|
_ <- ErrorT $ left AuthStreamError <$> xmppRestartStream |
|
return () |
|
where |
|
-- Converts an optional authorization identity, an authentication identity, |
|
-- and a password to a \NUL-separated PLAIN message. |
|
plainMessage :: Maybe T.Text -- Authorization identity (authzid) |
|
-> T.Text -- Authentication identity (authcid) |
|
-> T.Text -- Password |
|
-> T.Text -- The PLAIN message |
|
plainMessage authzid authcid passwd = |
|
let authzid' = fromMaybe "" authzid in |
|
T.concat [authzid', "\NUL", authcid, "\NUL", passwd] |