git.iko.soy/distributed-process
on master help sign in
distributed-process/src/Control/Distributed/Process/Debug.hs
288 lines 11 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE RankNTypes #-}
4-----------------------------------------------------------------------------
5-- |
6-- Module : Control.Distributed.Process.Debug
7-- Copyright : (c) Well-Typed / Tim Watson
8-- License : BSD3 (see the file LICENSE)
9--
10-- Maintainer : Tim Watson <watson.timothy@gmail.com>
11-- Stability : experimental
12-- Portability : non-portable (requires concurrency)
13--
14-- [Tracing/Debugging Facilities]
15--
16-- Cloud Haskell provides a general purpose tracing mechanism, allowing a
17-- user supplied /tracer process/ to receive messages when certain classes of
18-- system events occur. It's possible to use this facility to aid in debugging
19-- and/or perform other diagnostic tasks to a program at runtime.
20--
21-- [Enabling Tracing]
22--
23-- Throughout the lifecycle of a local node, the distributed-process runtime
24-- generates /trace events/, describing internal runtime activities such as
25-- the spawning and death of processes, message sending, delivery and so on.
26-- See the 'MxEvent' type's documentation for a list of all the published
27-- event types, which correspond directly to the types of /management/ events.
28-- Users can additionally publish custom trace events in the form of
29-- 'MxLog' log messages or pass custom (i.e., completely user defined)
30-- event data using the 'traceMessage' function.
31--
32-- All published traces are forwarded to a /tracer process/, which can be
33-- specified (and changed) at runtime using 'traceEnable'. Some pre-defined
34-- tracer processes are provided for conveniently printing to stderr, a log file
35-- or the GHC eventlog.
36--
37-- If a tracer process crashes, no attempt is made to restart it.
38--
39-- [Working with multiple tracer processes]
40--
41-- The tracing facility only ever writes to a single tracer process. This
42-- invariant insulates the tracer controller and ensures a fast path for
43-- handling all trace events. /This/ module provides facilities for layering
44-- trace handlers using Cloud Haskell's built-in delegation primitives.
45--
46-- The 'startTracer' function wraps the registered @tracer@ process with the
47-- supplied handler and also forwards trace events to the original tracer.
48-- The corresponding 'stopTracer' function terminates tracer processes in
49-- reverse of the order in which they were started, and re-registers the
50-- previous tracer process.
51--
52-- [Built in tracers]
53--
54-- The built in tracers provide a simple /logging/ facility that writes trace
55-- events out to either a log file, @stderr@ or the GHC eventlog. These tracers
56-- can be configured using environment variables, or specified manually using
57-- the 'traceEnable' function.
58--
59-- When a new local node is started, the contents of several environment
60-- variables are checked to determine which default tracer process is selected.
61-- If none of these variables is set, a no-op tracer process is installed,
62-- which effectively ignores all trace messages. Note that in this case,
63-- trace events are still generated and passed through the system.
64-- Only one default tracer will be chosen - the first that contains a (valid)
65-- value. These environment variables, in the order they're examined, are:
66--
67-- 1. @DISTRIBUTED_PROCESS_TRACE_FILE@
68-- This is checked for a valid file path. If it exists and the file can be
69-- opened for writing, all trace output will be directed thence. If the supplied
70-- path is invalid, or the file is unavailable for writing, this tracer will not
71-- be selected.
72--
73-- 2. @DISTRIBUTED_PROCESS_TRACE_CONSOLE@
74-- This is checked for /any/ non-empty value. If set, then all trace output will
75-- be directed to the system logger process.
76--
77-- 3. @DISTRIBUTED_PROCESS_TRACE_EVENTLOG@
78-- This is checked for /any/ non-empty value. If set, all internal traces are
79-- written to the GHC eventlog.
80--
81-- By default, the built in tracers will ignore all trace events! In order to
82-- enable tracing the incoming 'MxEvent' stream, the @DISTRIBUTED_PROCESS_TRACE_FLAGS@
83-- environment variable accepts the following flags, which enable tracing specific
84-- event types:
85--
86-- * @p@ = trace the spawning of new processes
87-- * @d@ = trace the death of processes
88-- * @n@ = trace registration of names (i.e., named processes)
89-- * @u@ = trace un-registration of names (i.e., named processes)
90-- * @s@ = trace the sending of messages to other processes
91-- * @r@ = trace the receipt of messages from other processes
92-- * @l@ = trace node up/down events
93--
94-- Users of the /simplelocalnet/ Cloud Haskell backend should also note that
95-- because the trace file option only supports trace output from a single node
96-- (so as to avoid interleaving), a file trace configured for the master node
97-- will prevent slaves from tracing to the file. They will need to fall back to
98-- the console or eventlog tracers instead, which can be accomplished by setting
99-- one of these environment variables /as well/, since the latter will only be
100-- selected on slaves (when the file tracer selection fails).
101--
102-- Support for writing to the eventlog requires specific intervention to work,
103-- without which, written traces are silently dropped/ignored and no output will
104-- be generated. The GHC eventlog documentation provides information about
105-- enabling, viewing and working with event traces at
106-- <http://hackage.haskell.org/trac/ghc/wiki/EventLog>.
107--
108module Control.Distributed.Process.Debug
109 ( -- * Exported Data Types
110 TraceArg(..)
111 , TraceFlags(..)
112 , TraceSubject(..)
113 -- * Configuring Tracing
114 , enableTrace
115 , enableTraceAsync
116 , disableTrace
117 , withTracer
118 , withFlags
119 , getTraceFlags
120 , setTraceFlags
121 , setTraceFlagsAsync
122 , defaultTraceFlags
123 , traceOn
124 , traceOnly
125 , traceOff
126 -- * Debugging
127 , startTracer
128 , stopTracer
129 -- * Sending Custom Trace Data
130 , traceLog
131 , traceLogFmt
132 , traceMessage
133 -- * Working with remote nodes
134 , Remote.remoteTable
135 , Remote.startTraceRelay
136 , Remote.setTraceFlagsRemote
137 -- * Built in tracers
138 , systemLoggerTracer
139 , logfileTracer
140 , eventLogTracer
141 )
142 where
144import Control.Applicative
145import Control.Distributed.Process.Internal.Primitives
146 ( proxy
147 , die
148 , whereis
149 , send
150 , receiveWait
151 , matchIf
152 , monitor
153 )
154import Control.Distributed.Process.Internal.Types
155 ( ProcessId
156 , Process
157 , LocalProcess(..)
158 , ProcessMonitorNotification(..)
159 )
160import Control.Distributed.Process.Management.Internal.Types
161 ( MxEvent(..)
162 )
163import Control.Distributed.Process.Management.Internal.Trace.Types
164 ( TraceArg(..)
165 , TraceFlags(..)
166 , TraceSubject(..)
167 , defaultTraceFlags
168 )
169import Control.Distributed.Process.Management.Internal.Trace.Tracer
170 ( systemLoggerTracer
171 , logfileTracer
172 , eventLogTracer
173 )
174import Control.Distributed.Process.Management.Internal.Trace.Primitives
175 ( withRegisteredTracer
176 , enableTrace
177 , enableTraceAsync
178 , disableTrace
179 , setTraceFlags
180 , setTraceFlagsAsync
181 , getTraceFlags
182 , traceOn
183 , traceOff
184 , traceOnly
185 , traceLog
186 , traceLogFmt
187 , traceMessage
188 )
189import qualified Control.Distributed.Process.Management.Internal.Trace.Remote as Remote
190import Control.Distributed.Process.Node
192import Control.Exception (SomeException)
194import Control.Monad.IO.Class (liftIO)
195import Control.Monad.Reader (ask)
196import Control.Monad.Catch (finally, try)
198import Data.Binary()
200import Prelude
202--------------------------------------------------------------------------------
203-- Debugging/Tracing API --
204--------------------------------------------------------------------------------
206-- | Starts a new tracer, using the supplied trace function.
207-- Only one tracer can be registered at a time, however /this/ function overlays
208-- the registered tracer with the supplied handler, allowing the user to layer
209-- multiple tracers on top of one another, with trace events forwarded down
210-- through all the layers in turn. Once the top layer is stopped, the user
211-- is responsible for re-registering the original (prior) tracer pid before
212-- terminating. See 'withTracer' for a mechanism that handles that.
213startTracer :: (MxEvent -> Process ()) -> Process ProcessId
214startTracer handler = do
215 withRegisteredTracer $ \pid -> do
216 node <- processNode <$> ask
217 newPid <- liftIO $ forkProcess node $ traceProxy pid handler
218 enableTrace newPid -- invokes sync + registration
219 return newPid
221-- | Evaluate @proc@ with tracing enabled via @handler@, and immediately
222-- disable tracing thereafter, before giving the result (or exception
223-- in case of failure).
224withTracer :: forall a.
225 (MxEvent -> Process ())
226 -> Process a
227 -> Process (Either SomeException a)
228withTracer handler proc = do
229 previous <- whereis "tracer"
230 tracer <- startTracer handler
231 finally (try proc)
232 (stopTracing tracer previous)
233 where
234 stopTracing :: ProcessId -> Maybe ProcessId -> Process ()
235 stopTracing tracer previousTracer = do
236 case previousTracer of
237 Nothing -> return ()
238 Just _ -> do
239 ref <- monitor tracer
240 send tracer MxTraceDisable
241 receiveWait [
242 matchIf (\(ProcessMonitorNotification ref' _ _) -> ref == ref')
243 (\_ -> return ())
244 ]
246-- | Evaluate @proc@ with the supplied flags enabled. Any previously set
247-- trace flags are restored immediately afterwards.
248withFlags :: forall a.
249 TraceFlags
250 -> Process a
251 -> Process (Either SomeException a)
252withFlags flags proc = do
253 oldFlags <- getTraceFlags
254 finally (setTraceFlags flags >> try proc)
255 (setTraceFlags oldFlags)
257traceProxy :: ProcessId -> (MxEvent -> Process ()) -> Process ()
258traceProxy pid act = do
259 proxy pid $ \(ev :: MxEvent) ->
260 case ev of
261 (MxTraceTakeover _) -> return False
262 MxTraceDisable -> die "disabled"
263 _ -> act ev >> return True
265-- | Stops a user supplied tracer started with 'startTracer'.
266-- Note that only one tracer process can be active at any given time.
267-- This process will stop the last process started with 'startTracer'.
268-- If 'startTracer' is called multiple times, successive calls to this
269-- function will stop the tracers in the reverse order which they were
270-- started.
271--
272-- This function will never stop the system tracer (i.e., the tracer
273-- initially started when the node is created), therefore once all user
274-- supplied tracers (i.e., processes started via 'startTracer') have exited,
275-- subsequent calls to this function will have no effect.
276--
277-- If the last tracer to have been registered was not started
278-- with 'startTracer' then the behaviour of this function is /undefined/.
279stopTracer :: Process ()
280stopTracer =
281 withRegisteredTracer $ \pid -> do
282 -- we need to avoid killing the initial (base) tracer, as
283 -- nothing we rely on having exactly 1 registered tracer
284 -- process at all times.
285 basePid <- whereis "tracer.initial"
286 case basePid == (Just pid) of
287 True -> return ()
288 False -> send pid MxTraceDisable