From 46010b91c762fcba786e3a8c68e4445dc16b152f Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 25 Jun 2013 20:30:50 -0400 Subject: quiet debug prints --- Presence/XMPPServer.hs | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) (limited to 'Presence/XMPPServer.hs') diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs index c9decd6c..58dcf430 100644 --- a/Presence/XMPPServer.hs +++ b/Presence/XMPPServer.hs @@ -242,7 +242,7 @@ startCon session_factory sock st = do -- a resource is bound. r <- xmlifyPresenceForClient presence hPutStrLn h r - L.putStrLn $ "\nOUT:\n" <++> r + L.putStrLn $ "\nOUT client:\n" <++> r Right (Send r) -> hPutStrLn h r loop @@ -361,14 +361,14 @@ doCon st elem cont = do hsend r = do atomically $ writeTChan cmdChan (Send r) -- hPutStrLn h r - L.putStrLn $ "\nOUT:\n" <++> r + L.putStrLn $ "\nOUT client:\n" <++> r -- host <- fmap pack $ getHostName -- Assume localhost for client session JID host <- do jid <- getJID session names <- getNamesForPeer (peer jid) return (head names) - putStrLn $ (Prelude.show $ hang (text "\nIN:") 2 $ pp elem) ++ "\n" + putStrLn $ (Prelude.show $ hang (text "\nIN client:") 2 $ pp elem) ++ "\n" case elem of OpenTag _ -> @@ -479,33 +479,33 @@ listenForXmppClients session_factory port st = do startPeer session_factory sock st = do let h = hOccursFst st :: Handle name <- fmap bshow $ getPeerName sock - L.putStrLn $ "REMOTE-IN: connected " <++> name - let quit = L.putStrLn $ "REMOTE-IN: disconnected " <++> name + L.putStrLn $ "IN peer: connected " <++> name + let quit = L.putStrLn $ "IN peer: disconnected " <++> name session <- newSession session_factory sock h return ( session .*. ConnectionFinalizer quit .*. st ) doPeer st elem cont = do let session = hHead st - L.putStrLn $ "REMOTE-IN: received " <++> bshow elem + L.putStrLn $ "IN peer: " <++> bshow elem case elem of Element e@(Elem (N "presence") attrs content) -> do let jid = fmap pack (lookup (N "from") attrs >>= unattr) typ = fmap pack (lookup (N "type") attrs >>= unattr) case (jid,typ) of (Just jid,Just "unavailable") -> do - L.putStrLn $ "INBOUND PRESENCE! Offline jid=" <++> jid + L.putStrLn $ "IN peer: PRESENCE! Offline jid=" <++> jid -- parseAddressJID -- convert peer reported user@address to JID data structure peer_jid <- parseAddressJID jid announcePresence session (Presence peer_jid Offline) (Just jid,Just typ) -> -- possible probe, ignored for now - L.putStrLn $ "INBOUND PRESENCE! "<++>typ<++>" jid="<++>jid + L.putStrLn $ "IN peer: PRESENCE! "<++>typ<++>" jid="<++>jid (Just jid,Nothing) -> do let string (CString _ s _) = [s] stat = listToMaybe . Prelude.concatMap string . tagcontent "show" $ content -- Available or Away. names <- parseAddressJID jid >>= getNamesForPeer . peer - L.putStrLn $ "INBOUND PRESENCE! "<++>bshow (stat,names)<++>" avail/away jid=" <++> jid + L.putStrLn $ "IN peer: PRESENCE! "<++>bshow (stat,names)<++>" avail/away jid=" <++> jid -- todo: announcePresence _ -> return () -- putStrLn $ "inbound unhandled: "++show v cont () @@ -553,16 +553,16 @@ sendMessage cons msg peer = do let newEntry = do chan <- atomically newTChan t <- forkIO $ connect_to_server chan peer - L.putStrLn $ "remote-map new: " <++> showPeer peer + -- L.putStrLn $ "remote-map new: " <++> showPeer peer return (True,(chan,t)) (is_new,entry) <- maybe newEntry ( \(chan,t) -> do st <- threadStatus t let running = do - L.putStrLn $ "remote-map, thread running: " <++> showPeer peer + -- L.putStrLn $ "remote-map, thread running: " <++> showPeer peer return (False,(chan,t)) died = do - L.putStrLn $ "remote-map, thread died("<++>bshow st<++>"): " <++> showPeer peer + -- L.putStrLn $ "remote-map, thread died("<++>bshow st<++>"): " <++> showPeer peer newEntry case st of ThreadRunning -> running @@ -571,7 +571,7 @@ sendMessage cons msg peer = do ThreadFinished -> died ) found - L.putStrLn $ "sendMessage ->"<++>showPeer peer<++>": "<++>bshow msg + -- L.putStrLn $ "sendMessage ->"<++>showPeer peer<++>": "<++>bshow msg atomically $ writeTChan (fst entry) msg when is_new . atomically $ readTVar cons >>= writeTVar cons . Map.insert peer entry @@ -609,23 +609,23 @@ connect_to_server chan peer = (>> return ()) . runMaybeT $ do h <- socketToHandle sock ReadWriteMode hSetBuffering h NoBuffering hPutStrLn h "" - L.putStrLn $ "REMOTE-OUT: " + L.putStrLn $ "OUT peer: " cache <- fmap Map.assocs . readIORef $ cached writeIORef cached Map.empty -- hint garbage collector: we're done with this forM_ cache $ \(jid,st) -> do r <- xmlifyPresenceForPeer sock (Presence jid st) hPutStrLn h r - L.putStrLn $ "REMOTE-OUT (cache):\n" <++> r <++> "\n" + L.putStrLn $ "OUT peer: (cache)\n" <++> r <++> "\n" fix $ \loop -> do event <- atomically $ readTChan chan case event of OutBoundPresence p -> do r <- xmlifyPresenceForPeer sock p hPutStrLn h r - L.putStrLn $ "REMOTE-OUT:\n" <++> r <++> "\n" + L.putStrLn $ "OUT peer:\n" <++> r <++> "\n" loop hPutStrLn h "" - L.putStrLn $ "REMOTE-OUT: " + L.putStrLn $ "OUT peer: " splitJID :: ByteString -> (Maybe ByteString,ByteString,Maybe ByteString) @@ -653,7 +653,7 @@ parseAddressJID jid = do hints = Just $ defaultHints { addrFlags = [ {- AI_NUMERICHOST, -} AI_CANONNAME ] } peer_string' = unpack . strip_brackets $ peer_string peer <- do - putStrLn $ "getAddrInfo 2 " ++ Prelude.show ( Just (unpack peer_string)) + -- putStrLn $ "getAddrInfo 2 " ++ Prelude.show ( Just (unpack peer_string)) info <- getAddrInfo hints (Just peer_string') Nothing -- (Just "xmpp-server") let info0 = head info return . RemotePeer . addrAddress $ info0 @@ -667,7 +667,7 @@ parseHostNameJID jid = do if peer_string=="localhost" then return LocalHost else do - putStrLn $ "getAddrInfo 3 " ++ Prelude.show ( Just (unpack peer_string)) + -- putStrLn $ "getAddrInfo 3 " ++ Prelude.show ( Just (unpack peer_string)) info <- getAddrInfo hints (Just (unpack peer_string)) Nothing -- (Just "xmpp-server") let info0 = head info cname = addrCanonName info0 @@ -737,14 +737,13 @@ seekRemotePeers config chan = do event <- atomically $ readTChan chan case event of p@(Presence jid stat) -> do - L.putStrLn $ "seekRemotePeers: " <++> L.show jid <++> " " <++> bshow stat + -- L.putStrLn $ "seekRemotePeers: " <++> L.show jid <++> " " <++> bshow stat runMaybeT $ do u <- MaybeT . return $ name jid subscribers <- liftIO $ do subs <- getSubscribers config u mapM parseHostNameJID subs - liftIO . L.putStrLn $ "subscribers: " <++> bshow subscribers - -- parseJID -- get subscriber list reported user@hostname to JID data structure + -- liftIO . L.putStrLn $ "subscribers: " <++> bshow subscribers let peers = Set.map peer (Set.fromList subscribers) forM_ (Set.toList peers) $ \peer -> do when (is_remote peer) $ -- cgit v1.2.3