1-----------------------------------------------------------------------------
3-- Module : Control.Distributed.Process.Debug
4-- Copyright : (c) Well-Typed / Tim Watson
5-- License : BSD3 (see the file LICENSE)
7-- Maintainer : Tim Watson <watson.timothy@gmail.com>
8-- Stability : experimental
9-- Portability : non-portable (requires concurrency)
11-- [Tracing/Debugging Facilities]
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.
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.
30-- All published trace events are forwarded to a /tracer process/, which can be
31-- specified (and changed) at runtime using 'traceEnable'. Some pre-defined
32-- tracer processes are provided for conveniently printing to stderr, a log file
33-- or the GHC eventlog.
35-- If a tracer process crashes, no attempt is made to restart it.
37-- [Working with multiple tracer processes]
39-- The system tracing facility only ever writes to a single tracer process. This
40-- invariant insulates the tracer controller and ensures a fast path for
41-- handling all trace events. /This/ module provides facilities for layering
42-- trace handlers using Cloud Haskell's built-in delegation primitives.
44-- The 'startTracer' function wraps the registered @tracer@ process with the
45-- supplied handler and also forwarding trace events to the original tracer.
46-- The corresponding 'stopTracer' function terminates tracer processes in
47-- reverse of the order in which they were started, and re-establishes the
48-- previous tracer process.
52-- The built in tracers provide a simple /logging/ facility that writes trace
53-- events out to either a log file, @stderr@ or the GHC eventlog. These tracers
54-- can be configured using environment variables, or specified manually using
55-- the 'traceEnable' function. The base tracer process cannot be
57-- When a new local node is started, the contents of several environment
58-- variables are checked to determine how the default tracer process
59-- will handle trace events. If none of these variables is set, then the
60-- trace events will be effectively ignored, although they will still be
61-- generated and passed through the system. Only one configuration will be
62-- chosen - the first that contains a (valid) value. These environment
63-- variables, in the order they're checked, are:
65-- 1. @DISTRIBUTED_PROCESS_TRACE_FILE@
66-- This is checked for a valid file path. If it exists and the file can be
67-- opened for writing, all trace output will be directed thence. If the supplied
68-- path is invalid, or the file is unavailable for writing - e.g., because
69-- another node has already started tracing to it - then this tracer will be
72-- 2. @DISTRIBUTED_PROCESS_TRACE_CONSOLE@
73-- This is checked for /any/ non-empty value. If set, then all trace output will
74-- be directed to the system logger process.
76-- 3. @DISTRIBUTED_PROCESS_TRACE_EVENTLOG@
77-- This is checked for /any/ non-empty value. If set, all internal traces are
78-- written to the GHC eventlog.
80-- Users of the /simplelocalnet/ Cloud Haskell backend should also note that
81-- because the trace file option only supports trace output from a single node
82-- (so as to avoid interleaving), a file trace configured for the master node
83-- will prevent slaves from tracing to the file and will need to fall back to
84-- the console or eventlog tracers instead.
86-- Support for writing to the eventlog requires specific intervention to work,
87-- without which, written traces are silently dropped/ignored and no output will
88-- be generated. The GHC eventlog documentation provides information about
89-- enabling, viewing and working with event traces at
90-- <http://hackage.haskell.org/trac/ghc/wiki/EventLog>.
92module Control.Distributed.Process.Debug
93 ( -- * Exported Data Types
98 -- * Configuring Tracing
116 -- * Sending Trace Data
120 -- * Built in tracers
127import Control.Applicative ((<$>))
128import Control.Distributed.Process.Internal.Primitives
146import Control.Distributed.Process.Internal.Types
153 , ProcessMonitorNotification(..)
155import Control.Distributed.Process.Internal.Trace.Types
163import Control.Distributed.Process.Internal.Trace.Tracer
168import qualified Control.Distributed.Process.Internal.Trace.Primitives as Tracer
179 , getCurrentTraceClient
184import Control.Distributed.Process.Node
185import Control.Distributed.Process.Serializable
187import Control.Exception (SomeException)
189import Control.Monad.IO.Class (liftIO)
190import Control.Monad.Reader (ask)
194#if ! MIN_VERSION_base(4,6,0)
195import Prelude hiding (catch)
198--------------------------------------------------------------------------------
199-- Debugging/Tracing API --
200--------------------------------------------------------------------------------
202-- | Starts a new tracer, using the supplied trace function.
203-- Only one tracer can be registered at a time, however /this/ function overlays
204-- the registered tracer with the supplied handler, allowing the user to layer
205-- multiple tracers on top of one another, with trace events forwarded down
206-- through all the layers in turn. Once the top layer is stopped, the user
207-- is responsible for re-registering the original (prior) tracer pid before
208-- terminating. See 'withTracer' for a mechanism that handles that.
209startTracer :: (TraceEvent -> Process ()) -> Process ProcessId
210startTracer handler = do
211 withRegisteredTracer $ \pid -> do
212 node <- processNode <$> ask
213 newPid <- liftIO $ forkProcess node $ traceProxy pid handler
214 enableTrace newPid -- invokes sync + registration
217-- | Evaluate @proc@ with tracing enabled via @handler@, and immediately
218-- disable tracing thereafter, before giving the result (or exception
219-- in case of failure).
220withTracer :: forall a.
221 (TraceEvent -> Process ())
223 -> Process (Either SomeException a)
224withTracer handler proc = do
225 say "starting new tracer"
226 previous <- whereis "tracer"
227 tracer <- startTracer handler
229 (stopTracing tracer previous)
231 stopTracing :: ProcessId -> Maybe ProcessId -> Process ()
232 stopTracing tracer previousTracer = do
233 case previousTracer of
236 ref <- monitor tracer
237 say "resetting to previous tracer" >> enableTrace p
238 say "stopping tracer"
239 send tracer TraceEvDisable
240 say $ "waiting for EXIT from tracer " ++ (show tracer)
242 matchIf (\(ProcessMonitorNotification ref' _ _) -> ref == ref')
243 (\_ -> say "seen EXIT ok")
246-- | Evaluate @proc@ with the supplied flags enabled. Any previously set
247-- flags are restored immediately afterwards.
248withFlags :: forall a.
251 -> Process (Either SomeException a)
252withFlags flags proc = do
254 withLocalTracer $ \t -> liftIO $ Tracer.getTraceFlags t sp
255 oldFlags <- receiveChan rp
256 finally (setTraceFlags flags >> try proc)
257 (setTraceFlags oldFlags >> say "exit withFlags")
259traceProxy :: ProcessId -> (TraceEvent -> Process ()) -> Process ()
260traceProxy pid act = do
261 say "tracing has started"
262 proxy pid $ \(ev :: TraceEvent) ->
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
268-- | Stops a user supplied tracer started with 'startTracer'.
269-- Note that only one tracer process can be active at any given time.
270-- This process will stop the last process started with 'startTracer'.
271-- If 'startTracer' is called multiple times, successive calls to this
272-- function will stop the tracers in the reverse order in which they were
275-- This function will never stop the system tracer (i.e., the tracer
276-- initially started when the node is created), therefore once all user
277-- supplied tracers (i.e., processes started via 'startTracer') have exited,
278-- subsequent calls to this function will have no effect.
280-- 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/.
285stopTracer :: Process ()
287 withRegisteredTracer $ \pid -> do
288 -- we need to avoid killing the initial (base) tracer, as
289 -- nothing we rely on having exactly 1 registered tracer
290 -- process at all times.
291 basePid <- whereis "tracer.initial"
292 case basePid == (Just pid) of
294 False -> send pid TraceEvDisable
296withRegisteredTracer :: (ProcessId -> Process a) -> Process a
297withRegisteredTracer act = do
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' }
305-- | Determine whether or not tracing has been enabled.
306isTracingEnabled :: Process Bool
308 node <- processNode <$> ask
309 case (localTracer node) of
310 (ActiveTracer _ _) -> return True
313-- | Enable tracing to the supplied process.
314enableTraceAsync :: ProcessId -> Process ()
315enableTraceAsync pid = withLocalTracer $ \t -> liftIO $ Tracer.enableTrace t pid
317-- TODO: refactor _Sync versions of trace configuration functions...
319-- | Enable tracing to the supplied process and wait for a @TraceOk@
320-- response from the trace coordinator process.
321enableTrace :: ProcessId -> Process ()
323 withLocalTracerSync $ \t sp -> Tracer.enableTraceSync t sp pid
325-- | Disable the currently configured trace.
326disableTraceAsync :: Process ()
327disableTraceAsync = withLocalTracer $ \t -> liftIO $ Tracer.disableTrace t
329-- | Disable the currently configured trace and wait for a @TraceOk@
330-- response from the trace coordinator process.
331disableTrace :: Process ()
333 withLocalTracerSync $ \t sp -> Tracer.disableTraceSync t sp
335getTraceFlags :: Process TraceFlags
338 withLocalTracer $ \t -> liftIO $ Tracer.getTraceFlags t sp
341-- | Set the given flags for the current tracer.
342setTraceFlagsAsync :: TraceFlags -> Process ()
343setTraceFlagsAsync f = withLocalTracer $ \t -> liftIO $ Tracer.setTraceFlags t f
345-- | Set the given flags for the current tracer and wait for a @TraceOk@
346-- response from the trace coordinator process.
347setTraceFlags :: TraceFlags -> Process ()
349 withLocalTracerSync $ \t sp -> Tracer.setTraceFlagsSync t sp f
351withLocalTracerSync :: (Tracer -> SendPort TraceOk -> IO ()) -> Process ()
352withLocalTracerSync act = do
354 withLocalTracer $ \t -> liftIO $ (act t sp)
355 TraceOk <- receiveChan rp
358-- | Send a log message to the internal tracing facility. If tracing is
359-- enabled, this will create a custom trace log event.
361traceLog :: String -> Process ()
362traceLog s = withLocalTracer $ \t -> liftIO $ Tracer.traceLog t s
364-- | Send a log message to the internal tracing facility, using the given
365-- list of printable 'TraceArg's interspersed with the preceding delimiter.
367traceLogFmt :: String -> [TraceArg] -> Process ()
368traceLogFmt d ls = withLocalTracer $ \t -> liftIO $ Tracer.traceLogFmt t d ls
370-- | Send an arbitrary 'Message' to the tracer process.
371traceMessage :: Serializable m => m -> Process ()
372traceMessage msg = withLocalTracer $ \t -> liftIO $ Tracer.traceMessage t msg
374withLocalTracer :: (Tracer -> Process ()) -> Process ()
375withLocalTracer act = do
376 node <- processNode <$> ask
377 act (localTracer node)
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list