git.iko.soy/distributed-process
on 87bb129 help sign in
distributed-process/src/Control/Distributed/Process/Debug.hs
292 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 , finally
148 , die
149 , whereis
150 , send
151 , receiveWait
152 , matchIf
153 , finally
154 , try
155 , monitor
156 )
157import Control.Distributed.Process.Internal.Types
158 ( ProcessId
159 , Process
160 , LocalProcess(..)
161 , ProcessMonitorNotification(..)
162 )
163import Control.Distributed.Process.Management.Internal.Types
164 ( MxEvent(..)
165 )
166import Control.Distributed.Process.Management.Internal.Trace.Types
167 ( TraceArg(..)
168 , TraceFlags(..)
169 , TraceSubject(..)
170 , defaultTraceFlags
171 )
172import Control.Distributed.Process.Management.Internal.Trace.Tracer
173 ( systemLoggerTracer
174 , logfileTracer
175 , eventLogTracer
176 )
177import Control.Distributed.Process.Management.Internal.Trace.Primitives
178 ( withRegisteredTracer
179 , enableTrace
180 , enableTraceAsync
181 , disableTrace
182 , setTraceFlags
183 , setTraceFlagsAsync
184 , getTraceFlags
185 , traceOn
186 , traceOff
187 , traceOnly
188 , traceLog
189 , traceLogFmt
190 , traceMessage
191 )
192import qualified Control.Distributed.Process.Management.Internal.Trace.Remote as Remote
193import Control.Distributed.Process.Node
195import Control.Exception (SomeException)
197import Control.Monad.IO.Class (liftIO)
198import Control.Monad.Reader (ask)
200import Data.Binary()
202#if ! MIN_VERSION_base(4,6,0)
203import Prelude hiding (catch)
204#endif
206--------------------------------------------------------------------------------
207-- Debugging/Tracing API --
208--------------------------------------------------------------------------------
210-- | Starts a new tracer, using the supplied trace function.
211-- Only one tracer can be registered at a time, however /this/ function overlays
212-- the registered tracer with the supplied handler, allowing the user to layer
213-- multiple tracers on top of one another, with trace events forwarded down
214-- through all the layers in turn. Once the top layer is stopped, the user
215-- is responsible for re-registering the original (prior) tracer pid before
216-- terminating. See 'withTracer' for a mechanism that handles that.
217startTracer :: (MxEvent -> Process ()) -> Process ProcessId
218startTracer handler = do
219 withRegisteredTracer $ \pid -> do
220 node <- processNode <$> ask
221 newPid <- liftIO $ forkProcess node $ traceProxy pid handler
222 enableTrace newPid -- invokes sync + registration
223 return newPid
225-- | Evaluate @proc@ with tracing enabled via @handler@, and immediately
226-- disable tracing thereafter, before giving the result (or exception
227-- in case of failure).
228withTracer :: forall a.
229 (MxEvent -> Process ())
230 -> Process a
231 -> Process (Either SomeException a)
232withTracer handler proc = do
233 previous <- whereis "tracer"
234 tracer <- startTracer handler
235 finally (try proc)
236 (stopTracing tracer previous)
237 where
238 stopTracing :: ProcessId -> Maybe ProcessId -> Process ()
239 stopTracing tracer previousTracer = do
240 case previousTracer of
241 Nothing -> return ()
242 Just _ -> do
243 ref <- monitor tracer
244 send tracer MxTraceDisable
245 receiveWait [
246 matchIf (\(ProcessMonitorNotification ref' _ _) -> ref == ref')
247 (\_ -> return ())
248 ]
250-- | Evaluate @proc@ with the supplied flags enabled. Any previously set
251-- trace flags are restored immediately afterwards.
252withFlags :: forall a.
253 TraceFlags
254 -> Process a
255 -> Process (Either SomeException a)
256withFlags flags proc = do
257 oldFlags <- getTraceFlags
258 finally (setTraceFlags flags >> try proc)
259 (setTraceFlags oldFlags)
261traceProxy :: ProcessId -> (MxEvent -> Process ()) -> Process ()
262traceProxy pid act = do
263 proxy pid $ \(ev :: MxEvent) ->
264 case ev of
265 (MxTraceTakeover _) -> return False
266 MxTraceDisable -> die "disabled"
267 _ -> act ev >> return True
269-- | Stops a user supplied tracer started with 'startTracer'.
270-- Note that only one tracer process can be active at any given time.
271-- This process will stop the last process started with 'startTracer'.
272-- If 'startTracer' is called multiple times, successive calls to this
273-- function will stop the tracers in the reverse order which they were
274-- started.
275--
276-- This function will never stop the system tracer (i.e., the tracer
277-- initially started when the node is created), therefore once all user
278-- supplied tracers (i.e., processes started via 'startTracer') have exited,
279-- subsequent calls to this function will have no effect.
280--
281-- If the last tracer to have been registered was not started
282-- with 'startTracer' then the behaviour of this function is /undefined/.
283stopTracer :: Process ()
284stopTracer =
285 withRegisteredTracer $ \pid -> do
286 -- we need to avoid killing the initial (base) tracer, as
287 -- nothing we rely on having exactly 1 registered tracer
288 -- process at all times.
289 basePid <- whereis "tracer.initial"
290 case basePid == (Just pid) of
291 True -> return ()
292 False -> send pid MxTraceDisable