summaryrefslogtreecommitdiff
path: root/Presence
diff options
context:
space:
mode:
Diffstat (limited to 'Presence')
-rw-r--r--Presence/XMPP.hs49
1 files changed, 29 insertions, 20 deletions
diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 179ffd6b..8589999b 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -890,30 +890,17 @@ handlePeerIQGet :: (JabberPeerSession session, MonadIO m) =>
890handlePeerIQGet session tag = do 890handlePeerIQGet session tag = do
891 withJust (lookupAttrib "id" (tagAttrs tag)) $ \stanza_id -> do 891 withJust (lookupAttrib "id" (tagAttrs tag)) $ \stanza_id -> do
892 whenJust nextElement $ \child -> do 892 whenJust nextElement $ \child -> do
893 host <- liftIO $ do
894 names <- getNamesForPeer (peerAddress session)
895 return (S.decodeUtf8 . head $ names)
896 let unhandledGet req = do 893 let unhandledGet req = do
897 liftIO $ debugStr ("iq-get: "++show (stanza_id,child)) 894 liftIO $ debugStr ("iq-peer-get: "++show (stanza_id,child))
898 -- TODO: send service-unavailable to peer (See example 9 of XEP-0199) 895 liftIO $
899 -- Unsupported 896 sendPeerMessage session (Unsupported (JID Nothing LocalHost Nothing)
897 (JID Nothing (peerAddress session) Nothing)
898 (Just (ContentText stanza_id))
899 req)
900 -- Client equiv: liftIO . atomically . writeTChan cmdChan . Send $ iq_service_unavailable host stanza_id Nothing req 900 -- Client equiv: liftIO . atomically . writeTChan cmdChan . Send $ iq_service_unavailable host stanza_id Nothing req
901 case tagName child of 901 case tagName child of
902 -- "{http://jabber.org/protocol/disco#items}query" -> liftIO $ debugStr "iq-get-query-items" 902 -- "{http://jabber.org/protocol/disco#items}query" -> liftIO $ debugStr "iq-get-query-items"
903 "{urn:xmpp:ping}ping" -> liftIO $ do 903 "{urn:xmpp:ping}ping" -> liftIO $ do
904 {-
905 let mjid = lookupAttrib "from" (tagAttrs tag)
906 let pong = [ EventBeginElement "{jabber:server}iq"
907 $ (case mjid of
908 Just jid -> (attr "to" jid :)
909 _ -> id )
910 [ attr "type" "result"
911 , attr "id" stanza_id
912 , attr "from" host
913 ]
914 , EventEndElement "{jabber:server}iq"
915 ]
916 -}
917 sendPeerMessage session (Pong (JID Nothing LocalHost Nothing) 904 sendPeerMessage session (Pong (JID Nothing LocalHost Nothing)
918 (JID Nothing (peerAddress session) Nothing) 905 (JID Nothing (peerAddress session) Nothing)
919 (Just (ContentText stanza_id))) 906 (Just (ContentText stanza_id)))
@@ -1092,6 +1079,28 @@ toPeer sock cache chan fail = do
1092 ] 1079 ]
1093 , EventEndElement "{jabber:server}iq" 1080 , EventEndElement "{jabber:server}iq"
1094 ] 1081 ]
1082 sendUnsupported from to mid tag =
1083 sendOrFail (xmlifyUnsupported sock from to mid tag)
1084 (Unsupported from to mid tag)
1085 where
1086 xmlifyUnsupported sock from to mid req =
1087 return $
1088 [ EventBeginElement "{jabber:server}iq"
1089 $ (case mid of
1090 Just c -> (("id",[c]):)
1091 _ -> id )
1092 [("type",[ContentText "error"])
1093 , attr "to" (toStrict $ L.decodeUtf8 $ L.show to)
1094 , attr "from" (toStrict $ L.decodeUtf8 $ L.show from)
1095 ]
1096 , EventBeginElement req []
1097 , EventEndElement req
1098 , EventBeginElement "{jabber:server}error" [("type",[ContentText "cancel"])]
1099 , EventBeginElement "{urn:ietf:params:xml:ns:xmpp-stanzas}service-unavailable" []
1100 , EventEndElement "{urn:ietf:params:xml:ns:xmpp-stanzas}service-unavailable"
1101 , EventEndElement "{jabber:server}error"
1102 , EventEndElement "{jabber:server}iq"
1103 ]
1095 1104
1096 1105
1097 send greetPeer 1106 send greetPeer
@@ -1130,7 +1139,7 @@ toPeer sock cache chan fail = do
1130 sendApproval False from to 1139 sendApproval False from to
1131 OutBoundMessage msg -> sendMessage msg 1140 OutBoundMessage msg -> sendMessage msg
1132 Pong from to mid -> sendPong from to mid 1141 Pong from to mid -> sendPong from to mid
1133 Unsupported _ _ _ _ -> todo 1142 Unsupported from to mid tag -> sendUnsupported from to mid tag
1134 Disconnect -> return () 1143 Disconnect -> return ()
1135 when (not . isQuitCommand $ event) loop 1144 when (not . isQuitCommand $ event) loop
1136 return () 1145 return ()