Browse Source

move host name checks from Network.Xmpp.Types to Network.Xmpp.Utilities

master
Philipp Balzarek 13 years ago
parent
commit
1c5203204c
  1. 28
      source/Network/Xmpp/Types.hs
  2. 39
      source/Network/Xmpp/Utilities.hs

28
source/Network/Xmpp/Types.hs

@ -47,7 +47,6 @@ module Network.Xmpp.Types @@ -47,7 +47,6 @@ module Network.Xmpp.Types
, jidFromTexts
, StreamEnd(..)
, InvalidXmppXml(..)
, checkHostName
, SessionConfiguration(..)
, TlsBehaviour(..)
)
@ -1055,32 +1054,6 @@ instance Default StreamConfiguration where @@ -1055,32 +1054,6 @@ instance Default StreamConfiguration where
}
}
-- | Validates the hostname string in accordance with RFC 1123.
checkHostName :: Text -> Maybe Text
checkHostName t = do
eitherToMaybeHostName $ AP.parseOnly hostnameP t
where
eitherToMaybeHostName = either (const Nothing) Just
-- Validation of RFC 1123 hostnames.
hostnameP :: AP.Parser Text
hostnameP = do
-- Hostnames may not begin with a hyphen.
h <- AP.satisfy $ AP.inClass $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9']
t <- AP.takeWhile $ AP.inClass $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ ['-']
let label = Text.concat [Text.pack [h], t]
if Text.length label > 63
then fail "Label too long."
else do
AP.endOfInput
return label
<|> do
_ <- AP.satisfy (== '.')
r <- hostnameP
if (Text.length label) + 1 + (Text.length r) > 255
then fail "Hostname too long."
else return $ Text.concat [label, Text.pack ".", r]
type StanzaHandler = TChan Stanza -- ^ outgoing stanza
-> Stanza -- ^ stanza to handle
-> IO Bool -- ^ True when processing should continue
@ -1094,6 +1067,7 @@ data SessionConfiguration = SessionConfiguration @@ -1094,6 +1067,7 @@ data SessionConfiguration = SessionConfiguration
-- | Function to generate the stream of stanza identifiers.
, sessionStanzaIDs :: IO (IO StanzaID)
, extraStanzaHandlers :: [StanzaHandler]
, enableRoster :: Bool
}
instance Default SessionConfiguration where

39
source/Network/Xmpp/Utilities.hs

@ -9,17 +9,22 @@ module Network.Xmpp.Utilities @@ -9,17 +9,22 @@ module Network.Xmpp.Utilities
, answerMessage
, openElementToEvents
, renderOpenElement
, renderElement)
, renderElement
, checkHostName
)
where
import Network.Xmpp.Types
import Prelude
import Data.XML.Types
import Control.Applicative ((<|>))
import qualified Data.Attoparsec.Text as AP
import qualified Data.ByteString as BS
import Data.Conduit as C
import Data.Conduit.List as CL
import qualified Data.Text as Text
import Data.Text(Text)
import qualified Data.Text.Encoding as Text
import Data.XML.Types
import Network.Xmpp.Types
import Prelude
import System.IO.Unsafe(unsafePerformIO)
import qualified Text.XML.Stream.Render as TXSR
import Text.XML.Unresolved as TXU
@ -77,3 +82,29 @@ renderElement e = Text.encodeUtf8 . Text.concat . unsafePerformIO @@ -77,3 +82,29 @@ renderElement e = Text.encodeUtf8 . Text.concat . unsafePerformIO
elementToEvents :: Element -> [Event]
elementToEvents el@(Element name _ _) = openElementToEvents el
++ [EventEndElement name]
-- | Validates the hostname string in accordance with RFC 1123.
checkHostName :: Text -> Maybe Text
checkHostName t = do
eitherToMaybeHostName $ AP.parseOnly hostnameP t
where
eitherToMaybeHostName = either (const Nothing) Just
-- Validation of RFC 1123 hostnames.
hostnameP :: AP.Parser Text
hostnameP = do
-- Hostnames may not begin with a hyphen.
h <- AP.satisfy $ AP.inClass $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9']
t <- AP.takeWhile $ AP.inClass $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ ['-']
let label = Text.concat [Text.pack [h], t]
if Text.length label > 63
then fail "Label too long."
else do
AP.endOfInput
return label
<|> do
_ <- AP.satisfy (== '.')
r <- hostnameP
if (Text.length label) + 1 + (Text.length r) > 255
then fail "Hostname too long."
else return $ Text.concat [label, Text.pack ".", r]

Loading…
Cancel
Save