git.iko.soy/distributed-process
on 39fb200 help sign in
distributed-process/src/Control/Distributed/Process/Debug.hs
292 lines 11 kB history raw
1-----------------------------------------------------------------------------
2-- |
3-- Module : Control.Distributed.Process.Debug
4-- Copyright : (c) Well-Typed / Tim Watson
5-- License : BSD3 (see the file LICENSE)
6--
7-- Maintainer : Tim Watson <watson.timothy@gmail.com>
8-- Stability : experimental
9-- Portability : non-portable (requires concurrency)
10--
11-- [Tracing/Debugging Facilities]
12--
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.
17--
18-- [Enabling Tracing]
19--
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.
30--
31-- All published traces are forwarded to a /tracer process/, which can be
32-- specified (and changed) at runtime using 'traceEnable'. Some pre-defined
33-- tracer processes are provided for conveniently printing to stderr, a log file
34-- or the GHC eventlog.
35--
36-- If a tracer process crashes, no attempt is made to restart it.
37--
38-- [Working with multiple tracer processes]
39--
40-- The system tracing facility only ever writes to a single tracer process. This
41-- invariant insulates the tracer controller and ensures a fast path for
42-- handling all trace events. /This/ module provides facilities for layering
43-- trace handlers using Cloud Haskell's built-in delegation primitives.
44--
45-- The 'startTracer' function wraps the registered @tracer@ process with the
46-- supplied handler and also forwarding trace events to the original tracer.
47-- The corresponding 'stopTracer' function terminates tracer processes in
48-- reverse of the order in which they were started, and re-establishes the
49-- previous tracer process.
50--
51-- [Built in tracers]
52--
53-- The built in tracers provide a simple /logging/ facility that writes trace
54-- events out to either a log file, @stderr@ or the GHC eventlog. These tracers
55-- can be configured using environment variables, or specified manually using
56-- the 'traceEnable' function. The base tracer process cannot be
57--
58-- When a new local node is started, the contents of several environment
59-- variables are checked to determine how the default tracer process
60-- will handle trace events. If none of these variables is set, then the
61-- trace events will be effectively ignored, although they will still be
62-- generated and passed through the system. Only one configuration will be
63-- chosen - the first that contains a (valid) value. These environment
64-- variables, in the order they're checked, are:
65--
66-- 1. @DISTRIBUTED_PROCESS_TRACE_FILE@
67-- This is checked for a valid file path. If it exists and the file can be
68-- opened for writing, all trace output will be directed thence. If the supplied
69-- path is invalid, or the file is unavailable for writing - e.g., because
70-- another node has already started tracing to it - then this tracer will be
71-- disabled.
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-- Users of the /simplelocalnet/ Cloud Haskell backend should also note that
82-- because the trace file option only supports trace output from a single node
83-- (so as to avoid interleaving), a file trace configured for the master node
84-- will prevent slaves from tracing to the file and will need to fall back to
85-- the console or eventlog tracers instead.
86--
87-- Support for writing to the eventlog requires specific intervention to work,
88-- without which, written traces are silently dropped/ignored and no output will
89-- be generated. The GHC eventlog documentation provides information about
90-- enabling, viewing and working with event traces at
91-- <http://hackage.haskell.org/trac/ghc/wiki/EventLog>.
92--
93module Control.Distributed.Process.Debug
94 ( -- * Exported Data Types
95 TraceArg(..)
96 , TraceEvent(..)
97 , TraceFlags(..)
98 , TraceSubject(..)
99 -- * Configuring Tracing
100 , isTracingEnabled
101 , enableTrace
102 , enableTraceAsync
103 , disableTrace
104 , withTracer
105 , withFlags
106 , getTraceFlags
107 , setTraceFlags
108 , setTraceFlagsAsync
109 , defaultTraceFlags
110 , traceOn
111 , traceOnly
112 , traceOff
113 -- * Debugging
114 , startTracer
115 , stopTracer
116 -- * Sending Trace Data
117 , traceLog
118 , traceLogFmt
119 , traceMessage
120 -- * Working with remote nodes
121 , Remote.remoteTable
122 , Remote.startTraceRelay
123 , Remote.setTraceFlagsRemote
124 -- * Built in tracers
125 , systemLoggerTracer
126 , logfileTracer
127 , eventLogTracer
128 )
129 where
131import Control.Applicative ((<$>))
132import Control.Distributed.Process.Internal.Primitives
133 ( proxy
134 , finally
135 , die
136 , whereis
137 , send
138 , newChan
139 , receiveChan
140 , receiveWait
141 , matchIf
142 , finally
143 , try
144 , monitor
145 , say
146 )
147import Control.Distributed.Process.Internal.Spawn
148 ( spawn
149 )
150import Control.Distributed.Process.Internal.Types
151 ( Tracer(..)
152 , LocalNode(..)
153 , ProcessId
154 , Process
155 , LocalProcess(..)
156 , SendPort(..)
157 , ProcessMonitorNotification(..)
158 , NodeId(..)
159 )
160import Control.Distributed.Process.Internal.Trace.Types
161 ( TraceArg(..)
162 , TraceEvent(..)
163 , TraceFlags(..)
164 , TraceSubject(..)
165 , TraceOk(..)
166 , defaultTraceFlags
167 )
168import Control.Distributed.Process.Internal.Trace.Tracer
169 ( systemLoggerTracer
170 , logfileTracer
171 , eventLogTracer
172 )
173import Control.Distributed.Process.Internal.Trace.Primitives
174 ( withRegisteredTracer
175 , enableTrace
176 , enableTraceAsync
177 , disableTrace
178 , setTraceFlags
179 , setTraceFlagsAsync
180 , getTraceFlags
181 , isTracingEnabled
182 , traceOn
183 , traceOff
184 , traceOnly
185 , traceLog
186 , traceLogFmt
187 , traceMessage
188 )
189import qualified Control.Distributed.Process.Internal.Trace.Remote as Remote
190import Control.Distributed.Process.Node
191import Control.Distributed.Process.Serializable
193import Control.Exception (SomeException)
195import Control.Monad.IO.Class (liftIO)
196import Control.Monad.Reader (ask)
198import Data.Binary()
200#if ! MIN_VERSION_base(4,6,0)
201import Prelude hiding (catch)
202#endif
204--------------------------------------------------------------------------------
205-- Debugging/Tracing API --
206--------------------------------------------------------------------------------
208-- | Starts a new tracer, using the supplied trace function.
209-- Only one tracer can be registered at a time, however /this/ function overlays
210-- the registered tracer with the supplied handler, allowing the user to layer
211-- multiple tracers on top of one another, with trace events forwarded down
212-- through all the layers in turn. Once the top layer is stopped, the user
213-- is responsible for re-registering the original (prior) tracer pid before
214-- terminating. See 'withTracer' for a mechanism that handles that.
215startTracer :: (TraceEvent -> Process ()) -> Process ProcessId
216startTracer handler = do
217 withRegisteredTracer $ \pid -> do
218 node <- processNode <$> ask
219 newPid <- liftIO $ forkProcess node $ traceProxy pid handler
220 enableTrace newPid -- invokes sync + registration
221 return newPid
223-- | Evaluate @proc@ with tracing enabled via @handler@, and immediately
224-- disable tracing thereafter, before giving the result (or exception
225-- in case of failure).
226withTracer :: forall a.
227 (TraceEvent -> Process ())
228 -> Process a
229 -> Process (Either SomeException a)
230withTracer handler proc = do
231 previous <- whereis "tracer"
232 tracer <- startTracer handler
233 finally (try proc)
234 (stopTracing tracer previous)
235 where
236 stopTracing :: ProcessId -> Maybe ProcessId -> Process ()
237 stopTracing tracer previousTracer = do
238 case previousTracer of
239 Nothing -> return ()
240 Just p -> do
241 ref <- monitor tracer
242 send tracer TraceEvDisable
243 receiveWait [
244 matchIf (\(ProcessMonitorNotification ref' _ _) -> ref == ref')
245 (\_ -> return ())
246 ]
248-- | Evaluate @proc@ with the supplied flags enabled. Any previously set
249-- trace flags are restored immediately afterwards.
250withFlags :: forall a.
251 TraceFlags
252 -> Process a
253 -> Process (Either SomeException a)
254withFlags flags proc = do
255 oldFlags <- getTraceFlags
256 finally (setTraceFlags flags >> try proc)
257 (setTraceFlags oldFlags)
259traceProxy :: ProcessId -> (TraceEvent -> Process ()) -> Process ()
260traceProxy pid act = do
261 proxy pid $ \(ev :: TraceEvent) ->
262 case ev of
263 (TraceEvTakeover p) -> return False
264 TraceEvDisable -> die "disabled"
265 _ -> act ev >> return True
267-- | Stops a user supplied tracer started with 'startTracer'.
268-- Note that only one tracer process can be active at any given time.
269-- This process will stop the last process started with 'startTracer'.
270-- If 'startTracer' is called multiple times, successive calls to this
271-- function will stop the tracers in the reverse order which they were
272-- started.
273--
274-- This function will never stop the system tracer (i.e., the tracer
275-- initially started when the node is created), therefore once all user
276-- supplied tracers (i.e., processes started via 'startTracer') have exited,
277-- subsequent calls to this function will have no effect.
278--
279-- If tracing support is disabled for the node, this function will also
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/.
282stopTracer :: Process ()
283stopTracer =
284 withRegisteredTracer $ \pid -> do
285 -- we need to avoid killing the initial (base) tracer, as
286 -- nothing we rely on having exactly 1 registered tracer
287 -- process at all times.
288 basePid <- whereis "tracer.initial"
289 case basePid == (Just pid) of
290 True -> return ()
291 False -> send pid TraceEvDisable