switch from hslogger to purpose-built Utility.Debug

This uses a DebugSelector, rather than debug levels, which will allow
for a later option like --debug-from=Process to only
see debuging about running processes.

The module name that contains the thing being debugged is used as the
DebugSelector (in most cases; does not need to be a hard and fast rule).
Debug calls were changed to add that. hslogger did not display
that first parameter to debugM, but the DebugSelector does get
displayed.

Also fastDebug will allow doing debugging in places that are used in
tight loops, with the DebugSelector coming from the Annex Reader
essentially for free. Not done yet.
This commit is contained in:
Joey Hess 2021-04-05 13:40:31 -04:00
parent 19c672e710
commit aaba83795b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
26 changed files with 194 additions and 105 deletions

View file

@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module RemoteDaemon.Transport.Tor (server, transport, torSocketFile) where
@ -27,9 +28,9 @@ import Types.UUID
import Messages
import Git
import Git.Command
import Utility.Debug
import Control.Concurrent
import System.Log.Logger (debugM)
import Control.Concurrent.STM
import Control.Concurrent.STM.TBMQueue
import Control.Concurrent.Async
@ -48,7 +49,7 @@ server ichan th@(TransportHandle (LocalRepo r) _ _) = go
msock <- liftAnnex th torSocketFile
case msock of
Nothing -> do
debugM "remotedaemon" "Tor hidden service not enabled"
debugTor "Tor hidden service not enabled"
return False
Just sock -> do
void $ async $ startservice sock u
@ -59,7 +60,7 @@ server ichan th@(TransportHandle (LocalRepo r) _ _) = go
replicateM_ maxConnections $
forkIO $ forever $ serveClient th u r q
debugM "remotedaemon" "Tor hidden service running"
debugTor "Tor hidden service running"
serveUnixSocket sock $ \conn -> do
ok <- atomically $ ifM (isFullTBMQueue q)
( return False
@ -92,12 +93,12 @@ serveClient th@(TransportHandle _ _ rd) u r q = bracket setup cleanup start
where
setup = do
h <- atomically $ readTBMQueue q
debugM "remotedaemon" "serving a Tor connection"
debugTor "serving a Tor connection"
return h
cleanup Nothing = return ()
cleanup (Just h) = do
debugM "remotedaemon" "done with Tor connection"
debugTor "done with Tor connection"
hClose h
start Nothing = return ()
@ -121,9 +122,9 @@ serveClient th@(TransportHandle _ _ rd) u r q = bracket setup cleanup start
v <- liftIO $ runNetProto runstauth conn $ P2P.serveAuth u
case v of
Right (Just theiruuid) -> authed conn theiruuid
Right Nothing -> liftIO $ debugM "remotedaemon"
Right Nothing -> liftIO $ debugTor
"Tor connection failed to authenticate"
Left e -> liftIO $ debugM "remotedaemon" $
Left e -> liftIO $ debugTor $
"Tor connection error before authentication: " ++ describeProtoFailure e
-- Merge the duplicated state back in.
liftAnnex th $ mergeState st'
@ -135,7 +136,7 @@ serveClient th@(TransportHandle _ _ rd) u r q = bracket setup cleanup start
P2P.serveAuthed P2P.ServeReadWrite u
case v' of
Right () -> return ()
Left e -> liftIO $ debugM "remotedaemon" $
Left e -> liftIO $ debugTor $
"Tor connection error: " ++ describeProtoFailure e
-- Connect to peer's tor hidden service.
@ -200,3 +201,6 @@ torSocketFile = do
let uid = 0
#endif
liftIO $ getHiddenServiceSocketFile torAppName uid ident
debugTor :: String -> IO ()
debugTor = debug "RemoteDaemon.Transport.Tor"