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, forwarding trace events to the original tracer. The
46-- corresponding 'stopTracer' function terminates tracer processes in reverse
47-- of the order in which they were started.
51-- The built in tracers provide a simple /logging/ facility that writes trace
52-- events out to either a log file, @stderr@ or the GHC eventlog. These tracers
53-- can be configured using environment variables, or specified manually using
54-- the 'traceEnable' function. The base tracer process cannot be
56-- When a new local node is started, the contents of the environment variable
57-- @DISTRIBUTED_PROCESS_TRACE_FILE@ are checked for a valid file path. If this
58-- exists and the file can be opened for writing, all trace output will be
59-- directed thence. If the environment variable is empty, the path invalid, or
60-- the file is unavailable for writing - e.g., because another node has already
61-- started tracing to it - then the @DISTRIBUTED_PROCESS_TRACE_CONSOLE@
62-- environment variable is checked for /any/ non-empty value. If this is set,
63-- then all trace output will be directed to the system logger process. If
64-- neither variable provides a valid trace configuration, all internal traces
65-- are written to "Debug.Trace.traceEventIO", which writes to the GHC eventlog.
67-- Users of the /simplelocalnet/ Cloud Haskell backend should also note that
68-- because the trace file option only supports trace output from a single node
69-- (so as to avoid interleaving), a file trace configured for the master node
70-- will prevent slaves from tracing to the file and they will fall back to using
71-- the console or eventlog tracers instead.
73-- Just as with the "Debug.Trace" module, this is a debugging/tracing facility
74-- for use in development, and probably not best used in a production setting -
75-- which is why the default behaviour is to trace to the GHC eventlog. For a
76-- general purpose logging facility, you should consider 'say'.
78-- Support for writing to the eventlog requires specific intervention to work,
79-- without which traces are silently dropped/ignored and no output will be
80-- generated. The GHC eventlog documentation provides information about enabling,
81-- viewing and working with event traces at
82-- <http://hackage.haskell.org/trac/ghc/wiki/EventLog>.
84module Control.Distributed.Process.Debug
85 ( -- * Exported Data Types
90 -- * Configuring Tracing
108 -- * Sending Trace Data
112 -- * Built in tracers
119import Control.Applicative ((<$>))
120import Control.Distributed.Process.Internal.Primitives
138import Control.Distributed.Process.Internal.Types
145 , ProcessMonitorNotification(..)
147import Control.Distributed.Process.Internal.Trace.Types
155import Control.Distributed.Process.Internal.Trace.Tracer
160import qualified Control.Distributed.Process.Internal.Trace.Primitives as Tracer
175import Control.Distributed.Process.Node
176import Control.Distributed.Process.Serializable
178import Control.Exception (SomeException)
180import Control.Monad.IO.Class (liftIO)
181import Control.Monad.Reader (ask)
185#if ! MIN_VERSION_base(4,6,0)
186import Prelude hiding (catch)
190--------------------------------------------------------------------------------
191-- Debugging/Tracing API --
192--------------------------------------------------------------------------------
194-- | Starts a new tracer, using the supplied trace function.
195-- Only one tracer can be registered at a time, however /this/ function overlays
196-- the registered tracer with the supplied handler, allowing the user to layer
197-- multiple tracers on top of one another, with trace events forwarded down
198-- through all the layers in turn. Once the top layer is stopped, it will
199-- reregister the original (prior) tracer pid before terminating.
200startTracer :: (TraceEvent -> Process ()) -> Process ProcessId
201startTracer handler = do
202 withRegisteredTracer $ \pid -> do
203 node <- processNode <$> ask
204 newPid <- liftIO $ forkProcess node $ do
205 -- TODO: we ensure that the original
206 -- tracer is re-registered, but it is
207 -- possible this could lead to races
208 -- if multiple tracers crash in very
209 -- close succession, due to scheduling
210 finally (traceProxy pid handler)
212 enableTrace newPid -- invokes sync + registration
215-- | Evaluate @proc@ with tracing enabled via @handler@, and immediately
216-- disable tracing thereafter, before giving the result (or exception
217-- in case of failure).
218withTracer :: forall a.
219 (TraceEvent -> Process ())
221 -> Process (Either SomeException a)
222withTracer handler proc = do
223 say "starting new tracer"
224 tracer <- startTracer handler
225 finally (try ((say "evaluating tracer proc...") >> proc))
228 stopTracing :: ProcessId -> Process ()
229 stopTracing tracer = do
230 say "stopping tracer"
231 ref <- monitor tracer
234 matchIf (\(ProcessMonitorNotification ref' _ _) -> ref == ref')
239-- | Evaluate @proc@ with the supplied flags enabled. Any previously set
240-- flags are restored immediately afterwards.
241withFlags :: forall a.
244 -> Process (Either SomeException a)
245withFlags flags proc = do
247 withLocalTracer $ \t -> liftIO $ Tracer.getTraceFlags t sp
248 oldFlags <- receiveChan rp
249 finally (setTraceFlags flags >> try proc)
250 (setTraceFlags oldFlags >> say "exit withFlags")
252traceProxy :: ProcessId -> (TraceEvent -> Process ()) -> Process ()
253traceProxy pid act = do
254 say "tracing has started"
255 proxy pid $ \(ev :: TraceEvent) ->
257 (TraceEvTakeover _) -> die "takeover"
258 TraceEvDisable -> die "disabled"
259 _ -> act ev >> return True
261resetTracer :: ProcessId -> Process ()
263 say $ "resetting trace to " ++ (show pid)
266-- | Stops a user supplied tracer started with 'startTracer'.
267-- Note that only one tracer process can be active at any given time.
268-- This process will stop the last process started with 'startTracer'.
269-- If 'startTracer' is called multiple times, successive calls to this
270-- function will stop the tracers in the reverse order in which they were
273-- This function will never stop the system tracer (i.e., the tracer
274-- initially started when the node is created), therefore once all user
275-- supplied tracers (i.e., processes started via 'startTracer') have exited,
276-- subsequent calls to this function will have no effect.
278-- If tracing is support disabled for the node, this function will also
280stopTracer :: Process ()
282 withRegisteredTracer $ \pid -> do
283 -- we need to avoid killing the initial (base) tracer, as
284 -- nothing we rely on having exactly 1 registered tracer
285 -- process at all times!
286 basePid <- whereis "tracer.initial"
287 case basePid == (Just pid) of
289 False -> send pid TraceEvDisable
291withRegisteredTracer :: (ProcessId -> Process a) -> Process a
292withRegisteredTracer act = do
293 currentTracer <- whereis "tracer"
294 case currentTracer of
295 Nothing -> do { (Just p') <- whereis "tracer.initial"; act p' }
298-- | Determine whether or not tracing has been enabled.
299isTracingEnabled :: Process Bool
301 node <- processNode <$> ask
302 case (localTracer node) of
303 (ActiveTracer _ _) -> return True
306-- | Enable tracing to the supplied process.
307enableTraceAsync :: ProcessId -> Process ()
308enableTraceAsync pid = withLocalTracer $ \t -> liftIO $ Tracer.enableTrace t pid
310-- TODO: refactor _Sync versions of trace configuration functions...
312-- | Enable tracing to the supplied process and wait for a @TraceOk@
313-- response from the trace coordinator process.
314enableTrace :: ProcessId -> Process ()
316 withLocalTracerSync $ \t sp -> Tracer.enableTraceSync t sp pid
318-- | Disable the currently configured trace.
319disableTraceAsync :: Process ()
320disableTraceAsync = withLocalTracer $ \t -> liftIO $ Tracer.disableTrace t
322-- | Disable the currently configured trace and wait for a @TraceOk@
323-- response from the trace coordinator process.
324disableTrace :: Process ()
326 withLocalTracerSync $ \t sp -> Tracer.disableTraceSync t sp
328getTraceFlags :: Process TraceFlags
331 withLocalTracer $ \t -> liftIO $ Tracer.getTraceFlags t sp
334-- | Set the given flags for the current tracer.
335setTraceFlagsAsync :: TraceFlags -> Process ()
336setTraceFlagsAsync f = withLocalTracer $ \t -> liftIO $ Tracer.setTraceFlags t f
338-- | Set the given flags for the current tracer and wait for a @TraceOk@
339-- response from the trace coordinator process.
340setTraceFlags :: TraceFlags -> Process ()
342 withLocalTracerSync $ \t sp -> Tracer.setTraceFlagsSync t sp f
344withLocalTracerSync :: (Tracer -> SendPort TraceOk -> IO ()) -> Process ()
345withLocalTracerSync act = do
347 withLocalTracer $ \t -> liftIO $ (act t sp)
348 TraceOk <- receiveChan rp
351-- | Send a log message to the internal tracing facility. If tracing is
352-- enabled, this will create a custom trace log event.
354traceLog :: String -> Process ()
355traceLog s = withLocalTracer $ \t -> liftIO $ Tracer.traceLog t s
357-- | Send a log message to the internal tracing facility, using the given
358-- list of printable 'TraceArg's interspersed with the preceding delimiter.
360traceLogFmt :: String -> [TraceArg] -> Process ()
361traceLogFmt d ls = withLocalTracer $ \t -> liftIO $ Tracer.traceLogFmt t d ls
363-- | Send an arbitrary 'Message' to the tracer process.
364traceMessage :: Serializable m => m -> Process ()
365traceMessage msg = withLocalTracer $ \t -> liftIO $ Tracer.traceMessage t msg
367withLocalTracer :: (Tracer -> Process ()) -> Process ()
368withLocalTracer act = do
369 node <- processNode <$> ask
370 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