Bug fixes, updates and JSON output support

Changes:

- updated nuget dependencies
- handing of the RPC parser exception when communicating service is not available
- added support for JSON output format (#19)

Author: lowleveldesign

ms-dbgtools/amd64/dbghelp.dll

@@ -111,7 +111,7 @@ let printProcessTree state =
         let exitTime =
             if proc.ExitTime <> DateTime.MaxValue then sprintf "finished at %s" (proc.ExitTime.ToString("HH:mm:ss.ffff"))
             else ""
-        printfn "%s├─ %s [%d] %s  %s" ("│ " |> String.replicate depth) proc.ProcessName proc.SystemProcessId startTime exitTime
+        eprintfn "%s├─ %s [%d] %s  %s" ("│ " |> String.replicate depth) proc.ProcessName proc.SystemProcessId startTime exitTime
         node.Children.Values |> Seq.iter (printChildren (depth + 1))
 
     for n in tree.Values do

ms-dbgtools/amd64/symsrv.dll

@@ -49,7 +49,13 @@ module private H =
         |> Seq.collect (
                 fun m ->
                     logger.TraceVerbose($"[rpc] parsing module '%s{m}'")
-                    RpcServer.ParsePeFile(m, dbgHelpPath, symbolsPath, parserFlags))
+                    try
+                        RpcServer.ParsePeFile(m, dbgHelpPath, symbolsPath, parserFlags)
+                    with
+                    | ex ->
+                        logger.TraceErrorWithMessage($"[rpc] failed parsing module '%s{m}'", ex)
+                        []
+        )
         |> Seq.iter (resolveRpcServer state)
 
     let resolveBindingAsync state binding (taskCount : int32 ref) =

ms-dbgtools/x86/dbghelp.dll

@@ -17,17 +17,17 @@ let appAssembly = Assembly.GetEntryAssembly()
 let appName = appAssembly.GetName()
 
 let showCopyright () =
-    printfn ""
-    printfn "%s v%s - collects process or system traces" appName.Name (appName.Version.ToString())
+    eprintfn ""
+    eprintfn "%s v%s - collects process or system traces" appName.Name (appName.Version.ToString())
     let customAttrs = appAssembly.GetCustomAttributes(typeof<AssemblyCompanyAttribute>, true);  
     assert (customAttrs.Length > 0)
-    printfn "Copyright (C) 2022 %s" (customAttrs.[0] :?> AssemblyCompanyAttribute).Company
-    printfn "Visit https://wtrace.net to learn more"
-    printfn ""
+    eprintfn "Copyright (C) 2022 %s" (customAttrs.[0] :?> AssemblyCompanyAttribute).Company
+    eprintfn "Visit https://wtrace.net to learn more"
+    eprintfn ""
 
 let showHelp () =
-    printfn "Usage: %s [OPTIONS] [pid|imagename args]" appName.Name
-    printfn @"
+    eprintfn "Usage: %s [OPTIONS] [pid|imagename args]" appName.Name
+    eprintfn @"
 Options:
   -f, --filter=FILTER   Displays only events which satisfy a given FILTER.
                         (Does not impact the summary)
@@ -39,6 +39,8 @@ Options:
                         - shown in the summary.
   --symbols=SYMPATH     Resolve stacks and RPC method names using the provided symbols path.
   --nosummary           Prints only ETW events - no summary at the end.
+  --output              Format of the events in the output. 
+                        Available options: 'freetext' (default) or 'json'
   -v, --verbose         Shows wtrace diagnostics logs.
   -h, --help            Shows this message and exits.
 
@@ -96,9 +98,9 @@ let parseHandlers args =
                 |> Set.add "process" // process handler is always on
             let handlers = handlerNames |> Set.toArray |> Array.map resolveHandler
 
-            printfn "HANDLERS"
-            printfn "  %s" (handlerNames |> String.concat ", ")
-            printfn ""
+            eprintfn "HANDLERS"
+            eprintfn "  %s" (handlerNames |> String.concat ", ")
+            eprintfn ""
 
             Ok handlers
         with
@@ -120,10 +122,10 @@ let parseFilters args =
             try
                 let filters =
                     filters |> List.map EventFilter.parseFilter
-                printfn "FILTERS"
-                if filters |> List.isEmpty then printfn "  [none]"
+                eprintfn "FILTERS"
+                if filters |> List.isEmpty then eprintfn "  [none]"
                 else EventFilter.printFilters filters
-                printfn ""
+                eprintfn ""
                 Ok (EventFilter.buildFilterFunction filters)
             with
             | EventFilter.ParseError msg -> Error msg
@@ -142,11 +144,11 @@ let checkElevated () =
 let finishProcessingAndShowSummary tstate counters (ct : CancellationToken) =
 
     if RpcResolver.isRunning () then
-        printf "\rResolving RPC endpoints (press Ctrl + C to stop) "
+        eprintf "\rResolving RPC endpoints (press Ctrl + C to stop) "
         while not ct.IsCancellationRequested && RpcResolver.isRunning () do
-            printf "."
+            eprintf "."
             Async.Sleep(500) |> Async.RunSynchronously 
-        printfn ""
+        eprintfn ""
 
     TraceSummary.dump tstate counters
 
@@ -160,7 +162,12 @@ let start (supportFilesDirectory : string) (args : Map<string, list<string>>) =
 
     if [| "v"; "verbose" |] |> isFlagEnabled then
         Trace.AutoFlush <- true
-        Logger.initialize(SourceLevels.Verbose, [ new TextWriterTraceListener(Console.Out) ])
+        Logger.initialize(SourceLevels.Verbose, [ new TextWriterTraceListener(Console.Error) ])
+
+    let outputFormat =
+        match args |> Map.tryFind "output" with
+        | Some ["json"] -> TraceControl.OutputFormat.Json
+        | _ -> TraceControl.OutputFormat.FreeText
 
     let! filterEvents = parseFilters args
     let! handlers = parseHandlers args
@@ -174,17 +181,17 @@ let start (supportFilesDirectory : string) (args : Map<string, list<string>>) =
         | None ->
             match Environment.GetEnvironmentVariable("_NT_SYMBOL_PATH") with
             | v when v <> null -> 
-                printfn "Debug symbols path: %s" v
-                printfn ""
+                eprintfn "Debug symbols path: %s" v
+                eprintfn ""
 
                 UseDbgHelp(dbgHelpPath, v)
             | _ -> DebugSymbolSettings.Ignore
         | Some paths ->
             Debug.Assert(paths.Length > 0)
             let symbolsPath = List.last paths
 
-            printfn "Debug symbols path: %s" symbolsPath
-            printfn ""
+            eprintfn "Debug symbols path: %s" symbolsPath
+            eprintfn ""
 
             UseDbgHelp(dbgHelpPath, symbolsPath)
 
@@ -199,7 +206,7 @@ let start (supportFilesDirectory : string) (args : Map<string, list<string>>) =
     Console.CancelKeyPress.Add(
         fun ev ->
             if not tracingCts.IsCancellationRequested then
-                printfn "Closing the trace session. Please wait..."
+                eprintfn "Closing the trace session. Please wait..."
                 ev.Cancel <- true
                 tracingCts.Cancel()
             elif not processingCts.IsCancellationRequested then
@@ -213,27 +220,29 @@ let start (supportFilesDirectory : string) (args : Map<string, list<string>>) =
         match args |> Map.tryFind "" with 
         | None when isSystemTrace args ->
             if not showSummary then
-                printfn "WARNING: --nosummary does not take any effect in the system-only trace."
+                eprintfn "WARNING: --nosummary does not take any effect in the system-only trace."
             TraceControl.traceSystemOnly cancellationTokens
 
         | None ->
-            TraceControl.traceEverything cancellationTokens handlers filterEvents showSummary debugSymbols
+            TraceControl.traceEverything cancellationTokens handlers filterEvents showSummary debugSymbols outputFormat
 
         | Some args ->
             let newConsole = ([| "newconsole" |] |> isFlagEnabled)
             let includeChildren = [| "c"; "children" |] |> isFlagEnabled
 
             match args with
             | [ pid ] when isInteger pid ->
-                TraceControl.traceRunningProcess cancellationTokens handlers filterEvents showSummary debugSymbols includeChildren (Int32.Parse(pid))
+                TraceControl.traceRunningProcess cancellationTokens handlers filterEvents showSummary 
+                    debugSymbols outputFormat includeChildren (Int32.Parse(pid))
             | args ->
-                TraceControl.traceNewProcess cancellationTokens handlers filterEvents showSummary debugSymbols newConsole includeChildren args
+                TraceControl.traceNewProcess cancellationTokens handlers filterEvents showSummary
+                    debugSymbols outputFormat newConsole includeChildren args
 
     if not (TraceControl.sessionWaitEvent.WaitOne(TimeSpan.FromSeconds(3.0))) then
-        printfn "WARNING: the session did not finish in the allotted time. Stop it manually: logman stop wtrace-rt -ets"
+        eprintfn "WARNING: the session did not finish in the allotted time. Stop it manually: logman stop wtrace-rt -ets"
 
     if TraceControl.lostEventsCount > 0 then
-        printfn "WARNING: %d events were lost in the session. Check wtrace help at https://wtrace.net to learn more." TraceControl.lostEventsCount
+        eprintfn "WARNING: %d events were lost in the session. Check wtrace help at https://wtrace.net to learn more." TraceControl.lostEventsCount
 
     finishProcessingAndShowSummary traceState counters cancellationTokens.ProcessingCancellationToken
 }
@@ -250,5 +259,5 @@ let main (supportFilesDirectory : string) (argv : array<string>) =
     else
         match start supportFilesDirectory args with
         | Ok _ -> 0
-        | Error msg -> printfn "ERROR: %s" msg; 1
+        | Error msg -> eprintfn "ERROR: %s" msg; 1
 

ms-dbgtools/x86/symsrv.dll

@@ -6,6 +6,7 @@ open System.Diagnostics
 open System.Reactive.Linq
 open System.Reactive.Subjects
 open System.Threading
+open System.Text.Json
 open FSharp.Control.Reactive
 open LowLevelDesign.WTrace.Events
 open LowLevelDesign.WTrace.Tracing
@@ -22,6 +23,10 @@ type WorkCancellation = {
     ProcessingCancellationToken : CancellationToken
 }
 
+type OutputFormat =
+| FreeText = 0
+| Json = 1
+
 [<AutoOpen>]
 module private H =
     let rundownWaitEvent = new ManualResetEvent(false)
@@ -30,7 +35,7 @@ module private H =
         match s with
         | SessionRunning -> rundownWaitEvent.Set() |> ignore
         | SessionError msg ->
-            printfn "ERROR: Error when starting the trace session\n%s" msg
+            eprintfn "ERROR: Error when starting the trace session\n%s" msg
             rundownWaitEvent.Set() |> ignore
             sessionWaitEvent.Set() |> ignore
         | SessionStopped n ->
@@ -53,11 +58,15 @@ module private H =
         let etwsub = etwObservable.Connect()
         let reg = ct.Register(fun () -> etwsub.Dispose())
 
-        printfn "Starting the tracing session (might take a moment). Press Ctrl + C to exit."
+        eprintfn "Starting the tracing session (might take a moment). Press Ctrl + C to exit."
         rundownWaitEvent.WaitOne() |> ignore
 
         Disposable.compose etwsub reg
 
+    let onEventJson (TraceEventWithFields (ev, _)) =
+        printfn "%s" (JsonSerializer.Serialize(ev))
+        Interlocked.Exchange(&lastEventTime, DateTime.Now.Ticks) |> ignore
+
     let onEvent (TraceEventWithFields (ev, _)) =
         let getPath v = if v = "" then "" else sprintf " '%s'" v
         let getDesc v = if v = "" then "" else sprintf " %s" v
@@ -68,7 +77,7 @@ module private H =
         Interlocked.Exchange(&lastEventTime, DateTime.Now.Ticks) |> ignore
 
     let onError (ex : Exception) =
-        printfn "ERROR: an error occured while collecting the trace - %s" (ex.ToString())
+        eprintfn "ERROR: an error occured while collecting the trace - %s" (ex.ToString())
 
 let traceSystemOnly ct = 
     result {
@@ -91,7 +100,7 @@ let traceSystemOnly ct =
         return (tstate, counters)
     }
 
-let traceEverything ct handlers filter showSummary debugSymbols =
+let traceEverything ct handlers filter showSummary debugSymbols outputFormat =
     result {
         let settings = {
             Handlers = handlers
@@ -106,6 +115,8 @@ let traceEverything ct handlers filter showSummary debugSymbols =
             etwObservable
             |> Observable.filter (TraceEventProcessor.processAndFilterEvent tstate)
 
+        let onEvent = if outputFormat = OutputFormat.Json then onEventJson else onEvent
+
         eventObservable
         |> Observable.filter (fun (TraceEventWithFields (ev, _)) -> filter ev)
         |> Observable.subscribeWithCallbacks onEvent onError ignore
@@ -139,13 +150,15 @@ module private ProcessApi =
             else
                 waitForProcessExit ct hProcess
 
-    let traceProcess ct handlers filter showSummary debugSymbols includeChildren (pid, hProcess, hThread) =
+    let traceProcess ct handlers filter showSummary debugSymbols outputFormat includeChildren (pid, hProcess, hThread) =
         result {
             let settings = {
                 Handlers = handlers
                 EnableStacks = false
             }
 
+            let onEvent = if outputFormat = OutputFormat.Json then onEventJson else onEvent
+
             let etwObservable = createEtwObservable settings
 
             let processFilter = ProcessFilter.Process (pid, includeChildren)
@@ -173,7 +186,7 @@ module private ProcessApi =
 
             let! processFinished = waitForProcessExit ct.TracingCancellationToken hProcess
             if processFinished then
-                printfn "Process (%d) exited." pid
+                eprintfn "Process (%d) exited." pid
 
             let mutable savedLastEventTime = Interlocked.Read(&lastEventTime)
             let rec waitForMoreEvents () =
@@ -195,19 +208,19 @@ module private ProcessApi =
         }
 
 
-let traceNewProcess ct handlers filter showSummary debugSymbols newConsole includeChildren (args : list<string>) =
+let traceNewProcess ct handlers filter showSummary debugSymbols outputFormat newConsole includeChildren (args : list<string>) =
     result {
         Debug.Assert(args.Length > 0, "[TraceControl] invalid number of arguments")
         let! processIds = WinApi.startProcessSuspended args newConsole
 
-        return! ProcessApi.traceProcess ct handlers filter showSummary debugSymbols includeChildren processIds
+        return! ProcessApi.traceProcess ct handlers filter showSummary debugSymbols outputFormat includeChildren processIds
     }
 
-let traceRunningProcess ct handlers filter showSummary debugSymbols includeChildren pid =
+let traceRunningProcess ct handlers filter showSummary debugSymbols outputFormat includeChildren pid =
     result {
         let! hProcess = WinApi.openRunningProcess pid
         let processIds = (pid, hProcess, HANDLE.INVALID_HANDLE_VALUE)
 
-        return! ProcessApi.traceProcess ct handlers filter showSummary debugSymbols includeChildren processIds
+        return! ProcessApi.traceProcess ct handlers filter showSummary debugSymbols outputFormat includeChildren processIds
     }
 

wtrace.cmd/Processing/ProcessTree.fs

@@ -10,10 +10,10 @@ module private H =
     let printTitle (title : string) =
         let separator = "--------------------------------"
         let space = Math.Max(0, (separator.Length - title.Length) / 2)
-        printfn ""
-        printfn "%s" separator
-        printfn "%s%s" (" " |> String.replicate space) title
-        printfn "%s" separator
+        eprintfn ""
+        eprintfn "%s" separator
+        eprintfn "%s%s" (" " |> String.replicate space) title
+        eprintfn "%s" separator
 
     let getCounterValue (counter : TraceCounters.NumericCounter) key =
         match counter.TryGetValue(key) with
@@ -31,7 +31,7 @@ module private H =
                            (p, received + sent, sent, received))
             |> Seq.sortByDescending (fun (_, total, _, _) -> total)
             |> Seq.iter (fun (path, total, sent, received) ->
-                            printfn "%s Total: %dB, Sent: %dB, Received: %dB" path total sent received)
+                            eprintfn "%s Total: %dB, Sent: %dB, Received: %dB" path total sent received)
 
 
 let dump traceState (counters : TraceCounters.Counters) =
@@ -50,7 +50,7 @@ let dump traceState (counters : TraceCounters.Counters) =
                            (p, read + written, written, read))
             |> Seq.sortByDescending (fun (_, total, _, _) -> total)
             |> Seq.iter (fun (path, total, written, read) ->
-                            printfn "'%s' Total: %dB, Writes: %dB, Reads: %dB" path total written read)
+                            eprintfn "'%s' Total: %dB, Writes: %dB, Reads: %dB" path total written read)
 
         dumpNetworkStatistics "TCP/IP" counters.TcpReceivedBytes counters.TcpSentBytes
         dumpNetworkStatistics "UDP" counters.UdpReceivedBytes counters.UdpSentBytes
@@ -66,7 +66,7 @@ let dump traceState (counters : TraceCounters.Counters) =
                                | (true, procedures) when procedures.Length > procNum ->
                                    sprintf "%O (%s) [%d]{%s}" interfaceUuid binding procNum procedures[procNum]
                                | _ -> sprintf "%O (%s) [%d]" interfaceUuid binding procNum
-                    printfn "%s calls: %d" path total
+                    eprintfn "%s calls: %d" path total
                 )
 
         if counters.RpcClientCalls.Count > 0 then
@@ -85,7 +85,7 @@ let dump traceState (counters : TraceCounters.Counters) =
             |> Seq.iter (fun (baseAddr, (count, time)) ->
                             let img = traceState.LoadedSystemImages[baseAddr]
                             let time = time.ToString("#,0.000")
-                            printfn "'%s', Total: %s ms (%d event(s))" img.FileName time count)
+                            eprintfn "'%s', Total: %s ms (%d event(s))" img.FileName time count)
 
         if counters.IsrCalls.Count > 0 then
             printTitle "ISR"
@@ -95,5 +95,5 @@ let dump traceState (counters : TraceCounters.Counters) =
             |> Seq.iter (fun (baseAddr, (count, time)) ->
                             let img = traceState.LoadedSystemImages[baseAddr]
                             let time = time.ToString("#,0.000")
-                            printfn "'%s', Total: %s ms (%d event(s))" img.FileName time count)
+                            eprintfn "'%s', Total: %s ms (%d event(s))" img.FileName time count)
     )

wtrace.cmd/Processing/RpcResolver.fs

@@ -126,8 +126,8 @@ module EventFilter =
             | Details (op, s) -> ("Details", sprintf "%s '%s'" op s)
 
         let printFiltersGroup name defs =
-            printfn "  %s" name
-            printfn "    %s" (defs |> String.concat " OR ")
+            eprintfn "  %s" name
+            eprintfn "    %s" (defs |> String.concat " OR ")
 
         filters
         |> Seq.map buildFilterDescription