28beaa2 · distributed-process

git.iko.soy/distributed-process

on master help sign in

remove support for disabling tracing (since we now fire events anyway)

28beaa2Tim Watson13 years ago

src/Control/Distributed/Process/Debug.hs+25−29

compare with master

unifiedsplit

@@ -17,16 +17,14 @@

17--

18-- [Enabling Tracing]

19--

20−-- Tracing is disabled by default, because it carries a relatively small, but

20+-- Throughout the lifecycle of a local node, the distributed-process runtime

21−-- tangible cost. To enable tracing, the environment variable

21+-- generates /trace events/, describing internal runtime activities such as

22−-- @DISTRIBUTED_PROCESS_TRACE_ENABLED@ must be set to some value (actual content

22+-- the spawning and death of processes, message sending, delivery and so on.

23−-- is ignored). When the environment variable /is/ set, the system will

23+-- See the 'TraceEvent' type's documentation for a list of all the published

24−-- generate /trace events/ in various circumstances - see 'TraceEvent' for a

24+-- event types.

25−-- list of all the published events. A user can additionally publish custom

25+-- Users can additionally publish custom trace events in the form of

26−-- trace events in the form of 'TraceEvLog' log messages or pass custom

26+-- 'TraceEvLog' log messages or pass custom (i.e., completely user defined)

27−-- (i.e., completely user defined) event data using the 'traceMessage' function.

27+-- event data using the 'traceMessage' function.

28−-- If the environment variable is not set, no trace events will ever be

29−-- published.

30--

28--

31-- All published traces are forwarded to a /tracer process/, which can be

29-- All published traces are forwarded to a /tracer process/, which can be

32-- specified (and changed) at runtime using 'traceEnable'. Some pre-defined

30-- specified (and changed) at runtime using 'traceEnable'. Some pre-defined

@@ -37,15 +35,15 @@

37--

35--

38-- [Working with multiple tracer processes]

36-- [Working with multiple tracer processes]

39--

37--

40−-- The system tracing facility only ever writes to a single tracer process. This

38+-- The tracing facility only ever writes to a single tracer process. This

41-- invariant insulates the tracer controller and ensures a fast path for

39-- invariant insulates the tracer controller and ensures a fast path for

42-- handling all trace events. /This/ module provides facilities for layering

40-- handling all trace events. /This/ module provides facilities for layering

43-- trace handlers using Cloud Haskell's built-in delegation primitives.

41-- trace handlers using Cloud Haskell's built-in delegation primitives.

44--

42--

45-- The 'startTracer' function wraps the registered @tracer@ process with the

43-- The 'startTracer' function wraps the registered @tracer@ process with the

46−-- supplied handler and also forwarding trace events to the original tracer.

44+-- supplied handler and also forwards trace events to the original tracer.

47-- The corresponding 'stopTracer' function terminates tracer processes in

45-- The corresponding 'stopTracer' function terminates tracer processes in

48−-- reverse of the order in which they were started, and re-establishes the

46+-- reverse of the order in which they were started, and re-registers the

49-- previous tracer process.

47-- previous tracer process.

50--

48--

51-- [Built in tracers]

49-- [Built in tracers]

@@ -53,22 +51,21 @@

53-- The built in tracers provide a simple /logging/ facility that writes trace

51-- The built in tracers provide a simple /logging/ facility that writes trace

54-- events out to either a log file, @stderr@ or the GHC eventlog. These tracers

52-- events out to either a log file, @stderr@ or the GHC eventlog. These tracers

55-- can be configured using environment variables, or specified manually using

53-- can be configured using environment variables, or specified manually using

56−-- the 'traceEnable' function. The base tracer process cannot be

54+-- the 'traceEnable' function.

57--

55--

58-- When a new local node is started, the contents of several environment

56-- When a new local node is started, the contents of several environment

59−-- variables are checked to determine how the default tracer process

57+-- variables are checked to determine which default tracer process is selected.

60−-- will handle trace events. If none of these variables is set, then the

58+-- If none of these variables is set, a no-op tracer process is installed,

61−-- trace events will be effectively ignored, although they will still be

59+-- which effectively ignores all trace messages. Note that in this case,

62−-- generated and passed through the system. Only one configuration will be

60+-- trace events are still generated and passed through the system.

63−-- chosen - the first that contains a (valid) value. These environment

61+-- Only one default tracer will be chosen - the first that contains a (valid)

64−-- variables, in the order they're checked, are:

62+-- value. These environment variables, in the order they're examined, are:

65--

63--

66-- 1. @DISTRIBUTED_PROCESS_TRACE_FILE@

64-- 1. @DISTRIBUTED_PROCESS_TRACE_FILE@

67-- This is checked for a valid file path. If it exists and the file can be

65-- This is checked for a valid file path. If it exists and the file can be

68-- opened for writing, all trace output will be directed thence. If the supplied

66-- opened for writing, all trace output will be directed thence. If the supplied

69−-- path is invalid, or the file is unavailable for writing - e.g., because

67+-- path is invalid, or the file is unavailable for writing, this tracer will not

70−-- another node has already started tracing to it - then this tracer will be

68+-- be selected.

71−-- disabled.

72--

69--

73-- 2. @DISTRIBUTED_PROCESS_TRACE_CONSOLE@

70-- 2. @DISTRIBUTED_PROCESS_TRACE_CONSOLE@

74-- This is checked for /any/ non-empty value. If set, then all trace output will

71-- This is checked for /any/ non-empty value. If set, then all trace output will

@@ -81,8 +78,10 @@

81-- Users of the /simplelocalnet/ Cloud Haskell backend should also note that

78-- Users of the /simplelocalnet/ Cloud Haskell backend should also note that

82-- because the trace file option only supports trace output from a single node

79-- because the trace file option only supports trace output from a single node

83-- (so as to avoid interleaving), a file trace configured for the master node

80-- (so as to avoid interleaving), a file trace configured for the master node

84−-- will prevent slaves from tracing to the file and will need to fall back to

81+-- will prevent slaves from tracing to the file. They will need to fall back to

85−-- the console or eventlog tracers instead.

82+-- the console or eventlog tracers instead, which can be accomplished by setting

83+-- one of these environment variables /as well/, since the latter will only be

84+-- selected on slaves (when the file tracer selection fails).

86--

85--

87-- Support for writing to the eventlog requires specific intervention to work,

86-- Support for writing to the eventlog requires specific intervention to work,

88-- without which, written traces are silently dropped/ignored and no output will

87-- without which, written traces are silently dropped/ignored and no output will

@@ -97,7 +96,6 @@ module Control.Distributed.Process.Debug

97 , TraceFlags(..)

96 , TraceFlags(..)

98 , TraceSubject(..)

97 , TraceSubject(..)

99 -- * Configuring Tracing

98 -- * Configuring Tracing

100− , isTracingEnabled

101 , enableTrace

99 , enableTrace

102 , enableTraceAsync

100 , enableTraceAsync

103 , disableTrace

101 , disableTrace

@@ -167,7 +165,6 @@ import Control.Distributed.Process.Internal.Trace.Primitives

167 , setTraceFlags

165 , setTraceFlags

168 , setTraceFlagsAsync

166 , setTraceFlagsAsync

169 , getTraceFlags

167 , getTraceFlags

170− , isTracingEnabled

171 , traceOn

168 , traceOn

172 , traceOff

169 , traceOff

173 , traceOnly

170 , traceOnly

@@ -264,8 +261,7 @@ traceProxy pid act = do

264-- supplied tracers (i.e., processes started via 'startTracer') have exited,

261-- supplied tracers (i.e., processes started via 'startTracer') have exited,

265-- subsequent calls to this function will have no effect.

262-- subsequent calls to this function will have no effect.

266--

263--

267−-- If tracing support is disabled for the node, this function will also

268−-- have no effect. If the last tracer to have been registered was not started

264+-- If the last tracer to have been registered was not started

269-- with 'startTracer' then the behaviour of this function is /undefined/.

265-- with 'startTracer' then the behaviour of this function is /undefined/.

270stopTracer :: Process ()

266stopTracer :: Process ()

271stopTracer =

267stopTracer =

src/Control/Distributed/Process/Internal/Trace/Primitives.hs+2−17

@@ -13,7 +13,6 @@ module Control.Distributed.Process.Internal.Trace.Primitives

13 , traceLogFmt

14 , traceMessage

15 -- * Configuring A Tracer

16− , isTracingEnabled

17 , defaultTraceFlags

16 , defaultTraceFlags

18 , enableTrace

17 , enableTrace

19 , enableTraceAsync

18 , enableTraceAsync

@@ -99,14 +98,6 @@ traceOn = Just TraceAll

99traceOff :: Maybe TraceSubject

98traceOff :: Maybe TraceSubject

100traceOff = Nothing

99traceOff = Nothing

101

100

102−-- | Determine whether or not tracing has been enabled.

103−isTracingEnabled :: Process Bool

104−isTracingEnabled = do

105− processNode <$> ask >>= return . isActive . tracer . localEventBus

106− where

107− isActive InactiveTracer = False

108− isActive (ActiveTracer _ _) = True

109−

110-- | Enable tracing to the supplied process.

101-- | Enable tracing to the supplied process.

111enableTraceAsync :: ProcessId -> Process ()

102enableTraceAsync :: ProcessId -> Process ()

112enableTraceAsync pid = withLocalTracer $ \t -> liftIO $ Tracer.enableTrace t pid

103enableTraceAsync pid = withLocalTracer $ \t -> liftIO $ Tracer.enableTrace t pid

@@ -169,20 +160,14 @@ withLocalTracer act = do

169withLocalTracerSync :: (MxEventBus -> SendPort TraceOk -> IO ()) -> Process ()

160withLocalTracerSync :: (MxEventBus -> SendPort TraceOk -> IO ()) -> Process ()

170withLocalTracerSync act = do

161withLocalTracerSync act = do

171 (sp, rp) <- newChan

162 (sp, rp) <- newChan

172− withLocalTracer $ \t -> do

163+ withLocalTracer $ \t -> liftIO $ (act t sp)

173− case (tracer t) of

174− InactiveTracer -> error "TraceDisabled"

175− _ -> liftIO $ (act t sp)

176 TraceOk <- receiveChan rp

164 TraceOk <- receiveChan rp

177 return ()

165 return ()

178

166

179withRegisteredTracer :: (ProcessId -> Process a) -> Process a

167withRegisteredTracer :: (ProcessId -> Process a) -> Process a

180withRegisteredTracer act = do

168withRegisteredTracer act = do

181 (sp, rp) <- newChan

169 (sp, rp) <- newChan

182− withLocalTracer $ \t -> do

183− case (tracer t) of

184− InactiveTracer -> error "TraceDisabled"

185− _ -> liftIO $ Tracer.getCurrentTraceClient t sp

170+ withLocalTracer $ \t -> liftIO $ Tracer.getCurrentTraceClient t sp

186 currentTracer <- receiveChan rp

171 currentTracer <- receiveChan rp

187 case currentTracer of

172 case currentTracer of

188 Nothing -> do { (Just p') <- whereis "tracer.initial"; act p' }

173 Nothing -> do { (Just p') <- whereis "tracer.initial"; act p' }

src/Control/Distributed/Process/Internal/Trace/Tracer.hs+2−2

@@ -191,8 +191,8 @@ logfileTracer p = do

191

192traceController :: MVar ((Weak (CQueue Message))) -> Process ()

193traceController mv = do

194+ -- See the documentation for mxAgentController for a

194− -- This breach of encapsulation is deliberate: we don't want to tie up

195+ -- commentary that explains this breach of encapsulation

195− -- the node's internal control channel if we can possibly help it!

196 weakQueue <- processWeakQ <$> ask

197 liftIO $ putMVar mv weakQueue

198 initState <- initialState

src/Control/Distributed/Process/Internal/Types.hs+8−9

@@ -199,15 +199,14 @@ nullProcessId nid =

199-- Local nodes and processes --

200--------------------------------------------------------------------------------

201

202+-- | Provides access to the trace controller.

202−data Tracer =

203+data Tracer = Tracer

203− InactiveTracer

204− | ActiveTracer

205− {

204+ {

206− tracerPid :: !ProcessId

205+ tracerPid :: !ProcessId

207− , weakQ :: !(Weak (CQueue Message))

206+ , weakQ :: !(Weak (CQueue Message))

208− }

207+ }

209−

208+

210−-- | Required for the system management and tracing facilities

209+-- | Required for the system management and tracing facilities.

211data MxEventBus =

210data MxEventBus =

212 MxEventBusInitialising

211 MxEventBusInitialising

213 | MxEventBus

212 | MxEventBus

src/Control/Distributed/Process/Management/Agent.hs+17−23

@@ -66,16 +66,17 @@ type AgentConfig =

66-- @LocalNode@ would be inelegant. We forward messages directly to the

67-- trace controller's message queue, just as the @MxEventBus@ that's

68-- set up on the @LocalNode@ forwards messages directly to us. This

69−-- also optimises the code path for tracing and avoids overloading the

69+-- optimises the code path for tracing and avoids overloading the node

70−-- node controller with additional routing, at the cost of a little

70+-- node controller's internal control plane with additional routing, at the

71−-- more complexity for us here.

71+-- cost of a little more complexity and two cases where we break

72+-- encapsulation.

72--

73--

73mxAgentController :: Fork

74mxAgentController :: Fork

74 -> MVar AgentConfig

75 -> MVar AgentConfig

75 -> Process ()

76 -> Process ()

76mxAgentController forkProcess mv = do

77mxAgentController forkProcess mv = do

77 node <- processNode <$> ask

78 node <- processNode <$> ask

78− trc <- liftIO $ startTracing forkProcess node

79+ trc <- liftIO $ startTracing forkProcess

79 sigbus <- liftIO $ newBroadcastTChanIO

80 sigbus <- liftIO $ newBroadcastTChanIO

80 weakQueue <- processWeakQ <$> ask

81 weakQueue <- processWeakQ <$> ask

81 liftIO $ putMVar mv (trc, weakQueue, mxAgent forkProcess sigbus)

82 liftIO $ putMVar mv (trc, weakQueue, mxAgent forkProcess sigbus)

@@ -88,14 +89,15 @@ mxAgentController forkProcess mv = do

88 -- our mailbox, the dequeue (i.e., matchMessage) can fail and

89 -- our mailbox, the dequeue (i.e., matchMessage) can fail and

89 -- crash this process, which we DO NOT want. Alternatively,

90 -- crash this process, which we DO NOT want. Alternatively,

90 -- we handle IO exceptions here explicitly, since we don't want

91 -- we handle IO exceptions here explicitly, since we don't want

91− -- this process to every crash, and the assumption we therefore

92+ -- this process to ever crash, and the assumption we therefore

92 -- make is thus:

93 -- make is thus:

93 --

94 --

94− -- 1. only ThreadKilled can tell this thread to terminate

95+ -- 1. only ThreadKilled can tell this process to terminate

95 -- 2. all other exceptions are invalid and should be ignored

96 -- 2. all other exceptions are invalid and should be ignored

96 --

97 --

97− -- The outcome of course, is that /bad/ calls to mxNotify will

98+ -- The outcome of course, is that /bad/ calls to mxNotify

99+ -- (e.g., passing unevaluated thunks that will crash when

98− -- be silently ignored.

100+ -- they're eventually forced) are thus silently ignored.

99 --

101 --

100 matchAny (\msg -> liftIO $ broadcast bus tracer msg)

102 matchAny (\msg -> liftIO $ broadcast bus tracer msg)

101 ] `catches` [Handler (\ThreadKilled -> die "Killed"),

103 ] `catches` [Handler (\ThreadKilled -> die "Killed"),

@@ -107,8 +109,7 @@ mxAgentController forkProcess mv = do

107 atomicBroadcast ch tmQueue msg

109 atomicBroadcast ch tmQueue msg

108

110

109 tracerQueue :: Tracer -> IO (Maybe (CQueue Message))

111 tracerQueue :: Tracer -> IO (Maybe (CQueue Message))

110− tracerQueue InactiveTracer = return Nothing

111− tracerQueue (ActiveTracer _ wQ) = deRefWeak wQ

112+ tracerQueue (Tracer _ wQ) = deRefWeak wQ

112

113

113 atomicBroadcast :: TChan Message

114 atomicBroadcast :: TChan Message

114 -> Maybe (CQueue Message)

115 -> Maybe (CQueue Message)

@@ -125,17 +126,10 @@ mxAgent fork chan handler = (atomically (dupTChan chan)) >>= fork . run handler

125 run handler' chan' = do

126 run handler' chan' = do

126 (liftIO $ atomically $ readTChan chan') >>= handler' >> run handler' chan'

127 (liftIO $ atomically $ readTChan chan') >>= handler' >> run handler' chan'

127

128

128−startTracing :: Fork -> LocalNode -> IO Tracer

129+startTracing :: Fork -> IO Tracer

129−startTracing forkProcess node =

130+startTracing forkProcess = do

130− -- TODO: use tryGetEnv once we drop support for GHC 7.2.x

131− Ex.catch

132− (getEnv "DISTRIBUTED_PROCESS_TRACE_ENABLED" >> startTracing' forkProcess node)

133− (\(_ :: IOError) -> return InactiveTracer)

134− where

135− startTracing' :: Fork -> LocalNode -> IO Tracer

136− startTracing' fork' n = do

137− mv <- newEmptyMVar

131+ mv <- newEmptyMVar

138− pid <- fork' $ traceController mv

132+ pid <- forkProcess $ traceController mv

139− wQ <- liftIO $ takeMVar mv

133+ wQ <- liftIO $ takeMVar mv

140− return $ ActiveTracer pid wQ

134+ return $ Tracer pid wQ

141

135

src/Control/Distributed/Process/Node.hs+1−1

@@ -258,7 +258,7 @@ startDefaultTracer :: LocalNode -> IO ()

258startDefaultTracer node' = do

259 let t = localEventBus node'

260 case t of

261− MxEventBus _ (ActiveTracer pid _) _ _ -> do

261+ MxEventBus _ (Tracer pid _) _ _ -> do

262 runProcess node' $ register "trace.controller" pid

263 pid' <- forkProcess node' defaultTracer

264 enableTrace (localEventBus node') pid'

tests/TestTracing.hs+2−14

@@ -328,11 +328,8 @@ tests node1 = do

328 -- various tracers will race with one another and

329 -- we'll get garbage results (or worse, deadlocks)

330 lock <- liftIO $ newMVar ()

331− enabled <- checkTraceEnabled

331+ return [

332− case enabled of

333− True ->

334− return [

335− testGroup "Tracing" [

332+ testGroup "Tracing" [

336 testCase "Spawn Tracing"

333 testCase "Spawn Tracing"

337 (delayedAssertion

334 (delayedAssertion

338 "expected dead process-info to be ProcessInfoNone"

335 "expected dead process-info to be ProcessInfoNone"

@@ -366,14 +363,6 @@ tests node1 = do

366 "expected blah"

363 "expected blah"

367 node1 True testRemoteTraceRelay lock)

364 node1 True testRemoteTraceRelay lock)

368 ] ]

365 ] ]

369− False ->

370− return []

371−

372−checkTraceEnabled :: IO Bool

373−checkTraceEnabled =

374− Ex.catch (getEnv "DISTRIBUTED_PROCESS_TRACE_ENABLED" >> return True)

375− (\(_ :: IOError) -> return False)

376−

377

366

378mkNode :: String -> IO LocalNode

367mkNode :: String -> IO LocalNode

379mkNode port = do

368mkNode port = do

@@ -383,7 +372,6 @@ mkNode port = do

383

372

384main :: IO ()

373main :: IO ()

385main = do

374main = do

386− setEnv "DISTRIBUTED_PROCESS_TRACE_ENABLED" "true" True

387 node1 <- mkNode "8081"

375 node1 <- mkNode "8081"

388 testData <- tests node1

376 testData <- tests node1

389 defaultMain testData

377 defaultMain testData