~singpolyma/jingle-xmpp

f7bff5f917b3933eec5ebf5e104226bca0b9e74d — Christopher Vollick 1 year, 10 months ago 4a5f48c 
Handle Unknown Session

While this library is great for handling file-transfer, there are other
uses of Jingle. For now what we want to do with those is forward them to
some other service that handles those, but in order to do that the
caller needs to know which stanzas those are.

So that's what this implements.

If there's a session initiate for a file-transfer, we make a session for
it and do what we already did.

If we get a session initiate that's not a file transfer, or a jingle
message for any session we don't know about, we bounce those out to our
caller.  That way they can do whatever they'd like with that kind of
thing.
patch browse 
1 files changed, 24 insertions(+), 10 deletions(-)

M Jingle.hs

M Jingle.hs => Jingle.hs +24 -10
@@ 213,10 213,11 @@ jingleHandler' ::
	-> XMPP.IQ
	-> [XML.Element]
	-> JingleSID
	-> Maybe (XMPP.IQ -> UIO ())
	-> XMPP.XMPP ()
jingleHandler' hostPort newSession newTransport setSize iq@XMPP.IQ {
	XMPP.iqFrom = Just from
} children sid
} children sid handlerForUnknown
	| jingleAction (s"session-initiate") iq,
	  (desc:_) <- fileTransferDescription `overChildrenOf` content = do
		liftIO $ UIO.run $ newSession sid iq


@@ 224,6 225,7 @@ jingleHandler' hostPort newSession newTransport setSize iq@XMPP.IQ {
			(newTransport sid)
			setSize
			iq sid content contentName (fileSizeFromDescription desc)
	| Just handler <- handlerForUnknown = liftIO $ UIO.run $ handler iq
	| jingleAction (s"transport-info") iq,
	  (_:_) <- jingleTransport `overChildrenOf` content =
		XMPP.putStanza $ iqReply Nothing iq


@@ 248,20 250,22 @@ jingleHandler' hostPort newSession newTransport setSize iq@XMPP.IQ {
	content = XML.isNamed (s"{urn:xmpp:jingle:1}content") =<< children
	contentName = fromMaybe mempty $
		XML.attributeText (s"name") =<< headZ content
jingleHandler' _ _ _ _ iq _ _ = XMPP.putStanza $ iqError notImplemented iq
jingleHandler' _ _ _ _ iq _ _ _ = XMPP.putStanza $ iqError notImplemented iq

jingleHandler ::
	   (Text, Socket.PortNumber)
	-> (JingleSID -> XMPP.IQ -> UIO ())
	-> (JingleSID -> UIO (Maybe (XMPP.IQ -> UIO ())))
	-> (JingleSID -> JingleTSID -> UIO ())
	-> (JingleTSID -> Int -> UIO ())
	-> XMPP.IQ
	-> XML.Element
	-> XMPP.XMPP ()
jingleHandler hostPort newSession newTransport setSize iq jingle
jingleHandler hostPort newSession handlerWhenUnknown newTransport setSize iq jingle
	| Just sid <- JingleSID <$> XML.attributeText (s"sid") jingle = do
		handlerForUnknown <- liftIO $ UIO.run $ handlerWhenUnknown sid
		jingleHandler' hostPort newSession newTransport setSize
			iq (XML.elementChildren jingle) sid
			iq (XML.elementChildren jingle) sid handlerForUnknown
	| otherwise = XMPP.putStanza $ iqError notImplemented iq

ibbHandler ::


@@ 310,14 314,15 @@ iqSetHandler ::
	FilePath
	-> (Text, Socket.PortNumber)
	-> (JingleSID -> XMPP.IQ -> UIO ())
	-> (JingleSID -> UIO (Maybe (XMPP.IQ -> UIO ())))
	-> (JingleSID -> JingleTSID -> UIO ())
	-> (JingleTSID -> Int -> UIO ())
	-> (JingleTSID -> FilePath -> UIO ())
	-> XMPP.IQ
	-> XMPP.XMPP ()
iqSetHandler storePath hostPort newSession newTransport setSize transportDone iq
iqSetHandler storePath hostPort newSession handleUnknownSession newTransport setSize transportDone iq
	| Just jingle <- child (s"{urn:xmpp:jingle:1}jingle") iq =
		jingleHandler hostPort newSession newTransport setSize iq jingle
		jingleHandler hostPort newSession handleUnknownSession newTransport setSize iq jingle
	| Just (s"http://jabber.org/protocol/ibb") ==
	  (XML.nameNamespace =<< XML.elementName <$> XMPP.iqPayload iq) =
		ibbHandler storePath transportDone iq


@@ 361,17 366,25 @@ tsidToSizeMap =

sidToIqMap :: (Unexceptional m) =>
	   (XMPP.IQ -> FilePath -> UIO ())
	-> (XMPP.IQ -> UIO ())
	-> m (
		JingleSID -> XMPP.IQ -> UIO (),
		JingleSID -> UIO (Maybe (XMPP.IQ -> UIO ())),
		JingleSID -> FilePath -> UIO ()
	)
sidToIqMap notifyByIq =
sidToIqMap notifyByIq handleUnknownSession =
	fromIO_ (Cache.newCache (Just $ TimeSpec 900 0)) >>= \cache ->
	return (
		\(JingleSID sid) iq -> do
			fromIO_ $ Cache.purgeExpired cache
			fromIO_ $ Cache.insert cache sid iq
		,
		\(JingleSID sid) -> do
			session <- fromIO_ (Cache.lookup' cache sid)
			return $ case session of
				Just _ -> Nothing
				Nothing -> Just handleUnknownSession
		,
		\(JingleSID sid) path -> do
			miq <- fromIO_ $ Cache.lookup' cache sid
			case miq of


@@ 386,13 399,14 @@ setupJingleHandlers :: (Unexceptional m) =>
	-> (Text, Socket.PortNumber)
	-> (String -> UIO ())
	-> (XMPP.IQ -> FilePath -> UIO ())
	-> (XMPP.IQ -> UIO ())
	-> m (Either IOError (XMPP.IQ -> XMPP.XMPP ()))
setupJingleHandlers storePath ports hostPort logger transferDoneIq = do
	(newSession, transferDone) <- sidToIqMap transferDoneIq
setupJingleHandlers storePath ports hostPort logger transferDoneIq otherJingle = do
	(newSession, handlerWhenUnknown, transferDone) <- sidToIqMap transferDoneIq otherJingle
	(newTransport, transportDone) <- tsidToSidMap transferDone
	(setSize, getSize) <- tsidToSizeMap
	(fmap.fmap) (\() ->
			iqSetHandler storePath hostPort
				newSession newTransport setSize transportDone
				newSession handlerWhenUnknown newTransport setSize transportDone
		) $
		Socks5Server.start storePath ports logger getSize transportDone