From 76bef32b5e6c84183d8974f91749592a3ada8c9d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 24 Apr 2013 21:13:10 -0400
Subject: assistant: Sanitize XMPP presence information logged for debugging.

---
 Assistant/Threads/XMPPClient.hs | 37 ++++++++++++++++++++++++++++---------
 1 file changed, 28 insertions(+), 9 deletions(-)

(limited to 'Assistant/Threads')

diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs
index 6f15505fe..417c6c976 100644
--- a/Assistant/Threads/XMPPClient.hs
+++ b/Assistant/Threads/XMPPClient.hs
@@ -84,7 +84,7 @@ xmppClient urlrenderer d creds =
 		inAssistant $ do
 			modifyDaemonStatus_ $ \s -> s
 				{ xmppClientID = Just $ xmppJID creds }
-			debug ["connected", show selfjid]
+			debug ["connected", logJid selfjid]
 
 		xmppThread $ receivenotifications selfjid
 		forever $ do
@@ -94,7 +94,7 @@ xmppClient urlrenderer d creds =
 	receivenotifications selfjid = forever $ do
 		l <- decodeStanza selfjid <$> getStanza
 		inAssistant $ debug
-			["received:", show $ map sanitizeXMPPEvent l]
+			["received:", show $ map logXMPPEvent l]
 		mapM_ (handle selfjid) l
 
 	handle selfjid (PresenceMessage p) = do
@@ -123,8 +123,8 @@ xmppClient urlrenderer d creds =
 			let msg' = readdressNetMessage msg c
 			inAssistant $ debug
 				[ "sending to new client:"
-				, show c
-				, show $ sanitizeNetMessage msg'
+				, logJid jid
+				, show $ logNetMessage msg'
 				]
 			a <- inAssistant $ convertNetMsg msg' selfjid
 			a
@@ -139,9 +139,28 @@ data XMPPEvent
 	| ProtocolError ReceivedStanza
 	deriving Show
 
-sanitizeXMPPEvent :: XMPPEvent -> XMPPEvent
-sanitizeXMPPEvent (GotNetMessage m) = GotNetMessage $ sanitizeNetMessage m
-sanitizeXMPPEvent v = v
+logXMPPEvent :: XMPPEvent -> String
+logXMPPEvent (GotNetMessage m) = logNetMessage m
+logXMPPEvent (PresenceMessage p) = logPresence p
+logXMPPEvent (Ignorable (ReceivedPresence p)) = "Ignorable " ++ logPresence p
+logXMPPEvent v = show v
+
+logPresence :: Presence -> String
+logPresence (p@Presence { presenceFrom = Just jid }) = unwords
+	[ "Presence from"
+	, logJid jid
+	, show $ extractGitAnnexTag p
+	]
+logPresence _ = "Presence from unknown"
+
+logJid :: JID -> String
+logJid jid =
+	let name = T.unpack (buddyName jid)
+	    resource = maybe "" (T.unpack . strResource) (jidResource jid)
+	in take 1 name ++ show (length name) ++ "/" ++ resource
+
+logClient :: Client -> String
+logClient (Client jid) = logJid jid
 
 {- Decodes an XMPP stanza into one or more events. -}
 decodeStanza :: JID -> ReceivedStanza -> [XMPPEvent]
@@ -180,7 +199,7 @@ decodeStanza _ s = [Unknown s]
 relayNetMessage :: JID -> Assistant (XMPP ())
 relayNetMessage selfjid = do
 	msg <- waitNetMessage
-	debug ["sending:", show $ sanitizeNetMessage msg]
+	debug ["sending:", logNetMessage msg]
 	a1 <- handleImportant msg
 	a2 <- convert msg
 	return (a1 >> a2)
@@ -197,7 +216,7 @@ relayNetMessage selfjid = do
 			then do
 				clients <- maybe [] (S.toList . buddyAssistants)
 					<$> getBuddy (genBuddyKey tojid) <<~ buddyList
-				debug ["exploded undirected message to clients", show clients]
+				debug ["exploded undirected message to clients", unwords $ map logClient clients]
 				return $ forM_ (clients) $ \(Client jid) ->
 					putStanza $ pushMessage pushstage jid selfjid
 			else return $ putStanza $ pushMessage pushstage tojid selfjid
-- 
cgit v1.2.3