@@ -10,24 +10,25 @@
1010--
1111-- [Tracing/Debugging Facilities]
1212--
13−-- Cloud Haskell provides a general purpose tracing mechanism that allows a
14−-- user supplied /tracer process/ to receive messages when certain events
15−-- take place. It's possible to use this facility to debug a running system
16−-- and/or generate runtime monitoring data in a variety of formats.
13+-- Cloud Haskell provides a general purpose tracing mechanism, allowing a
14+-- user supplied /tracer process/ to receive messages when certain classes of
15+-- system events occur. It's possible to use this facility to aid in debugging
16+-- and/or perform other diagnostic tasks to a program at runtime.
1717--
1818-- [Enabling Tracing]
1919--
20−-- Tracing is disabled by default, because it carries a (relatively small, but
21−-- real) cost at runtime. To enable any kind of tracing to work, the environment
22−-- variable @DISTRIBUTED_PROCESS_TRACE_ENABLED@ must be set (the contents are
23−-- ignored). When the environment variable /is/ set, the system will generate
24−-- a /trace events/ in various circumstances - see 'TraceEvent' for a list of
25−-- all the published events. A user can additionally publish custom trace events
26−-- in the form of 'TraceEvLog' log messages or pass custom (i.e., completely
27−-- user defined) event data using the 'traceMessage' function. If the
28−-- environment variable is not set, no trace events will ever be published.
20+-- Tracing is disabled by default, because it carries a relatively small, but
21+-- tangible cost. To enable tracing, the environment variable
22+-- @DISTRIBUTED_PROCESS_TRACE_ENABLED@ must be set to some value (the contents
23+-- are ignored). When the environment variable /is/ set, the system will
24+-- generate /trace events/ in various circumstances - see 'TraceEvent' for a
25+-- list of all the published events. A user can additionally publish custom
26+-- trace events in the form of 'TraceEvLog' log messages or pass custom
27+-- (i.e., completely user defined) event data using the 'traceMessage' function.
28+-- If the environment variable is not set, no trace events will ever be
29+-- published.
2930--
30−-- All published trace events are forwarded to a /tracer process/, which can be
31+-- All published traces are forwarded to a /tracer process/, which can be
3132-- specified (and changed) at runtime using 'traceEnable'. Some pre-defined
3233-- tracer processes are provided for conveniently printing to stderr, a log file
3334-- or the GHC eventlog.
@@ -100,16 +101,15 @@ module Control.Distributed.Process.Debug
100101 , enableTrace
101102 , enableTraceAsync
102103 , disableTrace
103− , disableTraceAsync
104104 , withTracer
105105 , withFlags
106106 , getTraceFlags
107107 , setTraceFlags
108108 , setTraceFlagsAsync
109109 , defaultTraceFlags
110− , Tracer.traceOn
111− , Tracer.traceOnly
112− , Tracer.traceOff
110+ , traceOn
111+ , traceOnly
112+ , traceOff
113113 -- * Debugging
114114 , startTracer
115115 , stopTracer
@@ -117,6 +117,10 @@ module Control.Distributed.Process.Debug
117117 , traceLog
118118 , traceLogFmt
119119 , traceMessage
120+ -- * Working with remote nodes
121+ , Remote.remoteTable
122+ , Remote.startTraceRelay
123+ , Remote.setTraceFlagsRemote
120124 -- * Built in tracers
121125 , systemLoggerTracer
122126 , logfileTracer
@@ -129,12 +133,9 @@ import Control.Distributed.Process.Internal.Primitives
129133 ( proxy
130134 , finally
131135 , die
132− , getSelfPid
133− , reregister
134136 , whereis
135137 , send
136138 , newChan
137− , sendChan
138139 , receiveChan
139140 , receiveWait
140141 , matchIf
@@ -143,6 +144,9 @@ import Control.Distributed.Process.Internal.Primitives
143144 , monitor
144145 , say
145146 )
147+import Control.Distributed.Process.Internal.Spawn
148+ ( spawn
149+ )
146150import Control.Distributed.Process.Internal.Types
147151 ( Tracer(..)
148152 , LocalNode(..)
@@ -151,6 +155,7 @@ import Control.Distributed.Process.Internal.Types
151155 , LocalProcess(..)
152156 , SendPort(..)
153157 , ProcessMonitorNotification(..)
158+ , NodeId(..)
154159 )
155160import Control.Distributed.Process.Internal.Trace.Types
156161 ( TraceArg(..)
@@ -165,22 +170,23 @@ import Control.Distributed.Process.Internal.Trace.Tracer
165170 , logfileTracer
166171 , eventLogTracer
167172 )
168−import qualified Control.Distributed.Process.Internal.Trace.Primitives as Tracer
169− ( traceLog
170− , traceLogFmt
171− , traceMessage
173+import Control.Distributed.Process.Internal.Trace.Primitives
174+ ( withRegisteredTracer
172175 , enableTrace
173− , enableTraceSync
176+ , enableTraceAsync
174177 , disableTrace
175− , disableTraceSync
176178 , setTraceFlags
177− , setTraceFlagsSync
179+ , setTraceFlagsAsync
178180 , getTraceFlags
179− , getCurrentTraceClient
181+ , isTracingEnabled
180182 , traceOn
181183 , traceOff
182184 , traceOnly
185+ , traceLog
186+ , traceLogFmt
187+ , traceMessage
183188 )
189+import qualified Control.Distributed.Process.Internal.Trace.Remote as Remote
184190import Control.Distributed.Process.Node
185191import Control.Distributed.Process.Serializable
186192
@@ -222,7 +228,6 @@ withTracer :: forall a.
222228 -> Process a
223229 -> Process (Either SomeException a)
224230withTracer handler proc = do
225− say "starting new tracer"
226231 previous <- whereis "tracer"
227232 tracer <- startTracer handler
228233 finally (try proc)
@@ -234,42 +239,36 @@ withTracer handler proc = do
234239 Nothing -> return ()
235240 Just p -> do
236241 ref <- monitor tracer
237− say "resetting to previous tracer" >> enableTrace p
238− say "stopping tracer"
239242 send tracer TraceEvDisable
240− say $ "waiting for EXIT from tracer " ++ (show tracer)
241243 receiveWait [
242244 matchIf (\(ProcessMonitorNotification ref' _ _) -> ref == ref')
243− (\_ -> say "seen EXIT ok")
245+ (\_ -> return ())
244246 ]
245247
246248-- | Evaluate @proc@ with the supplied flags enabled. Any previously set
247−-- flags are restored immediately afterwards.
249+-- trace flags are restored immediately afterwards.
248250withFlags :: forall a.
249251 TraceFlags
250252 -> Process a
251253 -> Process (Either SomeException a)
252254withFlags flags proc = do
253− (sp, rp) <- newChan
254− withLocalTracer $ \t -> liftIO $ Tracer.getTraceFlags t sp
255− oldFlags <- receiveChan rp
255+ oldFlags <- getTraceFlags
256256 finally (setTraceFlags flags >> try proc)
257− (setTraceFlags oldFlags >> say "exit withFlags")
257+ (setTraceFlags oldFlags)
258258
259259traceProxy :: ProcessId -> (TraceEvent -> Process ()) -> Process ()
260260traceProxy pid act = do
261− say "tracing has started"
262261 proxy pid $ \(ev :: TraceEvent) ->
263262 case ev of
264− (TraceEvTakeover p) -> say ((show p) ++ " has taken over...") >> return False
265− TraceEvDisable -> say "dying - disabled..." >> die "disabled"
266− _ -> say ("act on " ++ (show ev)) >> act ev >> return True
263+ (TraceEvTakeover p) -> return False
264+ TraceEvDisable -> die "disabled"
265+ _ -> act ev >> return True
267266
268267-- | Stops a user supplied tracer started with 'startTracer'.
269268-- Note that only one tracer process can be active at any given time.
270269-- This process will stop the last process started with 'startTracer'.
271270-- If 'startTracer' is called multiple times, successive calls to this
272−-- function will stop the tracers in the reverse order in which they were
271+-- function will stop the tracers in the reverse order which they were
273272-- started.
274273--
275274-- This function will never stop the system tracer (i.e., the tracer
@@ -278,10 +277,8 @@ traceProxy pid act = do
278277-- subsequent calls to this function will have no effect.
279278--
280279-- If tracing support is disabled for the node, this function will also
281−-- have no effect. If the last tracer to have been registered (or the process
282−-- registered with the label @"tracer"@ at the time the stop instruction
283−-- is received) was not started with 'startTracer' then the behaviour of
284−-- this function is /undefined/.
280+-- have no effect. If the last tracer to have been registered was not started
281+-- with 'startTracer' then the behaviour of this function is /undefined/.
285282stopTracer :: Process ()
286283stopTracer =
287284 withRegisteredTracer $ \pid -> do
@@ -293,86 +290,3 @@ stopTracer =
293290 True -> return ()
294291 False -> send pid TraceEvDisable
295292
296−withRegisteredTracer :: (ProcessId -> Process a) -> Process a
297−withRegisteredTracer act = do
298− (sp, rp) <- newChan
299− withLocalTracer $ \t -> liftIO $ Tracer.getCurrentTraceClient t sp
300− currentTracer <- receiveChan rp
301− case currentTracer of
302− Nothing -> do { (Just p') <- whereis "tracer.initial"; act p' }
303− (Just p) -> act p
304−
305−-- | Determine whether or not tracing has been enabled.
306−isTracingEnabled :: Process Bool
307−isTracingEnabled = do
308− node <- processNode <$> ask
309− case (localTracer node) of
310− (ActiveTracer _ _) -> return True
311− _ -> return False
312−
313−-- | Enable tracing to the supplied process.
314−enableTraceAsync :: ProcessId -> Process ()
315−enableTraceAsync pid = withLocalTracer $ \t -> liftIO $ Tracer.enableTrace t pid
316−
317−-- TODO: refactor _Sync versions of trace configuration functions...
318−
319−-- | Enable tracing to the supplied process and wait for a @TraceOk@
320−-- response from the trace coordinator process.
321−enableTrace :: ProcessId -> Process ()
322−enableTrace pid =
323− withLocalTracerSync $ \t sp -> Tracer.enableTraceSync t sp pid
324−
325−-- | Disable the currently configured trace.
326−disableTraceAsync :: Process ()
327−disableTraceAsync = withLocalTracer $ \t -> liftIO $ Tracer.disableTrace t
328−
329−-- | Disable the currently configured trace and wait for a @TraceOk@
330−-- response from the trace coordinator process.
331−disableTrace :: Process ()
332−disableTrace =
333− withLocalTracerSync $ \t sp -> Tracer.disableTraceSync t sp
334−
335−getTraceFlags :: Process TraceFlags
336−getTraceFlags = do
337− (sp, rp) <- newChan
338− withLocalTracer $ \t -> liftIO $ Tracer.getTraceFlags t sp
339− receiveChan rp
340−
341−-- | Set the given flags for the current tracer.
342−setTraceFlagsAsync :: TraceFlags -> Process ()
343−setTraceFlagsAsync f = withLocalTracer $ \t -> liftIO $ Tracer.setTraceFlags t f
344−
345−-- | Set the given flags for the current tracer and wait for a @TraceOk@
346−-- response from the trace coordinator process.
347−setTraceFlags :: TraceFlags -> Process ()
348−setTraceFlags f =
349− withLocalTracerSync $ \t sp -> Tracer.setTraceFlagsSync t sp f
350−
351−withLocalTracerSync :: (Tracer -> SendPort TraceOk -> IO ()) -> Process ()
352−withLocalTracerSync act = do
353− (sp, rp) <- newChan
354− withLocalTracer $ \t -> liftIO $ (act t sp)
355− TraceOk <- receiveChan rp
356− return ()
357−
358−-- | Send a log message to the internal tracing facility. If tracing is
359−-- enabled, this will create a custom trace log event.
360−--
361−traceLog :: String -> Process ()
362−traceLog s = withLocalTracer $ \t -> liftIO $ Tracer.traceLog t s
363−
364−-- | Send a log message to the internal tracing facility, using the given
365−-- list of printable 'TraceArg's interspersed with the preceding delimiter.
366−--
367−traceLogFmt :: String -> [TraceArg] -> Process ()
368−traceLogFmt d ls = withLocalTracer $ \t -> liftIO $ Tracer.traceLogFmt t d ls
369−
370−-- | Send an arbitrary 'Message' to the tracer process.
371−traceMessage :: Serializable m => m -> Process ()
372−traceMessage msg = withLocalTracer $ \t -> liftIO $ Tracer.traceMessage t msg
373−
374−withLocalTracer :: (Tracer -> Process ()) -> Process ()
375−withLocalTracer act = do
376− node <- processNode <$> ask
377− act (localTracer node)
378−