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