Browse Source

make stanza handler plugins more flexible

stanza handlers used to return a Boolean value to indicate whether stanza processing should continue. Now the return lists of stanzas instead. This facilitates plugins that transform stranzas (e.g. encryption)
master
Philipp Balzarek 12 years ago
parent
commit
61c5f0dda9
  1. 17
      source/Network/Xmpp/Concurrent.hs
  2. 12
      source/Network/Xmpp/IM/Roster.hs
  3. 4
      source/Network/Xmpp/Types.hs

17
source/Network/Xmpp/Concurrent.hs

@ -52,24 +52,21 @@ runHandlers :: WriteSemaphore -> [StanzaHandler] -> Stanza -> IO () @@ -52,24 +52,21 @@ runHandlers :: WriteSemaphore -> [StanzaHandler] -> Stanza -> IO ()
runHandlers _ [] _ = return ()
runHandlers sem (h:hands) sta = do
res <- h sem sta
case res of
True -> runHandlers sem hands sta
False -> return ()
forM_ res (runHandlers sem hands)
toChan :: TChan Stanza -> StanzaHandler
toChan stanzaC _ sta = do
atomically $ writeTChan stanzaC sta
return True
return [sta]
handleIQ :: TVar IQHandlers
-> StanzaHandler
handleIQ iqHands writeSem sta = do
case sta of
IQRequestS i -> handleIQRequest iqHands i >> return False
IQResultS i -> handleIQResponse iqHands (Right i) >> return False
IQErrorS i -> handleIQResponse iqHands (Left i) >> return False
_ -> return True
IQRequestS i -> handleIQRequest iqHands i >> return []
IQResultS i -> handleIQResponse iqHands (Right i) >> return []
IQErrorS i -> handleIQResponse iqHands (Left i) >> return []
_ -> return [sta]
where
-- If the IQ request has a namespace, send it through the appropriate channel.
handleIQRequest :: TVar IQHandlers -> IQRequest -> IO ()
@ -141,7 +138,7 @@ newSession stream config realm mbSasl = runErrorT $ do @@ -141,7 +138,7 @@ newSession stream config realm mbSasl = runErrorT $ do
ros <- liftIO . newTVarIO $ Roster Nothing Map.empty
rew <- lift $ newTVarIO 60
let rosterH = if (enableRoster config) then handleRoster ros
else \ _ _ -> return True
else \ _ sta -> return [sta]
let stanzaHandler = runHandlers writeSem
$ Prelude.concat [ [ toChan stanzaChan ]
, extraStanzaHandlers

12
source/Network/Xmpp/IM/Roster.hs

@ -81,26 +81,26 @@ initRoster session = do @@ -81,26 +81,26 @@ initRoster session = do
"Server did not return a roster"
Just roster -> atomically $ writeTVar (rosterRef session) roster
handleRoster :: TVar Roster -> WriteSemaphore -> Stanza -> IO Bool
handleRoster :: TVar Roster -> WriteSemaphore -> Stanza -> IO [Stanza]
handleRoster ref sem sta = case sta of
IQRequestS (iqr@IQRequest{iqRequestPayload =
iqb@Element{elementName = en}})
| nameNamespace en == Just "jabber:iq:roster" -> do
case iqRequestFrom iqr of
Just _from -> return True -- Don't handle roster pushes from
-- unauthorized sources
Just _from -> return [sta] -- Don't handle roster pushes from
-- unauthorized sources
Nothing -> case unpickleElem xpQuery iqb of
Right Query{ queryVer = v
, queryItems = [update]
} -> do
handleUpdate v update
_ <- writeStanza sem $ result iqr
return False
return []
_ -> do
errorM "Pontarius.Xmpp" "Invalid roster query"
_ <- writeStanza sem $ badRequest iqr
return False
_ -> return True
return []
_ -> return [sta]
where
handleUpdate v' update = atomically $ modifyTVar ref $ \(Roster v is) ->
Roster (v' `mplus` v) $ case qiSubscription update of

4
source/Network/Xmpp/Types.hs

@ -756,7 +756,7 @@ instance Read Jid where @@ -756,7 +756,7 @@ instance Read Jid where
#if WITH_TEMPLATE_HASKELL
-- | Constructs a @Jid@ value at compile time.
--
--
-- Syntax:
-- @
-- [jidQ|localpart\@domainpart/resourcepart|]
@ -1037,7 +1037,7 @@ instance Default StreamConfiguration where @@ -1037,7 +1037,7 @@ instance Default StreamConfiguration where
type StanzaHandler = TMVar (BS.ByteString -> IO Bool) -- ^ outgoing stanza
-> Stanza -- ^ stanza to handle
-> IO Bool -- ^ True when processing should continue
-> IO [Stanza] -- ^ modified stanzas (if any)
-- | How the client should behave in regards to TLS.
data TlsBehaviour = RequireTls -- ^ Require the use of TLS; disconnect if it's

Loading…
Cancel
Save