diff --git a/wtrace.cmd/Commons/Globals.fs b/wtrace.cmd/Commons/Globals.fs index 25ec46f..00c9e41 100644 --- a/wtrace.cmd/Commons/Globals.fs +++ b/wtrace.cmd/Commons/Globals.fs @@ -10,10 +10,6 @@ open System.Runtime.CompilerServices (* Constants *) -// The timeout for buffered observable - maximum amount of time that -// the buffered observable will wait for events -let eventBufferedObservableTimeout = TimeSpan.FromSeconds(0.5) - [] let invalidEventId = Int32.MinValue diff --git a/wtrace.cmd/Commons/WinApi.fs b/wtrace.cmd/Commons/WinApi.fs index 275b596..0f46af5 100644 --- a/wtrace.cmd/Commons/WinApi.fs +++ b/wtrace.cmd/Commons/WinApi.fs @@ -1,9 +1,13 @@ module LowLevelDesign.WTrace.WinApi open System -open PInvoke - -type SHandle = Kernel32.SafeObjectHandle +open FSharp.NativeInterop +open System.Runtime.InteropServices +open Windows.Win32 +open Windows.Win32.Foundation +open Windows.Win32.Security +open Windows.Win32.System.Threading +open System.ComponentModel let kernelProviderId = Guid(int32 0x9e814aad, int16 0x3204, int16 0x11d2, byte 0x9a, byte 0x82, byte 0x00, byte 0x60, byte 0x08, byte 0xa8, byte 0x69, byte 0x39); @@ -25,55 +29,50 @@ let getNtStatusDesc (n : int32) = let CheckResultBool s b = if b then Ok () else Error (sprintf "[%s] %s" s (Win32Exception().Message)) -let CheckResultHandle s h = - if h = Kernel32.INVALID_HANDLE_VALUE then Error (sprintf "[%s] %s" s (Win32Exception().Message)) - else Ok h +let CheckResultBOOL s b = + if b = BOOL(true) then Ok () else Error (sprintf "[%s] %s" s (Win32Exception().Message)) -let CheckResultSafeHandle s (h : SHandle) = - if h.IsInvalid then Error (sprintf "[%s] %s" s (Win32Exception().Message)) +let CheckResultHandle s (h : HANDLE) = + if h = HANDLE.INVALID_HANDLE_VALUE then Error (sprintf "[%s] %s" s (Win32Exception().Message)) else Ok h let Win32ErrorMessage (err : int) = Win32Exception(err).Message - let startProcessSuspended (args : seq) spawnNewConsole = - result { - let mutable pi = Kernel32.PROCESS_INFORMATION() - let mutable si = Kernel32.STARTUPINFO(hStdInput = IntPtr.Zero, - hStdOutput = IntPtr.Zero, - hStdError = IntPtr.Zero) - + let cmdline = String.Join(" ", args) + use cmdlinePtr = fixed cmdline - let flags = - if spawnNewConsole then - Kernel32.CreateProcessFlags.CREATE_NEW_CONSOLE - else Kernel32.CreateProcessFlags.None - - let flags = flags ||| - Kernel32.CreateProcessFlags.CREATE_SUSPENDED ||| - Kernel32.CreateProcessFlags.CREATE_UNICODE_ENVIRONMENT - - do! Kernel32.CreateProcess(null, String.Join(" ", args), IntPtr.Zero, IntPtr.Zero, false, - flags, IntPtr.Zero, null, &si, &pi) |> CheckResultBool "CreateProcess" - - return (pi.dwProcessId, new SHandle(pi.hProcess), new SHandle(pi.hThread)) + result { + let pi = NativePtr.stackalloc 1 + let si = NativePtr.stackalloc 1 + NativePtr.write si (STARTUPINFOW(cb = uint32 (Marshal.SizeOf()))) + + let flags = PROCESS_CREATION_FLAGS.CREATE_SUSPENDED ||| ( + if spawnNewConsole then PROCESS_CREATION_FLAGS.CREATE_NEW_CONSOLE else ( + Microsoft.FSharp.Core.LanguagePrimitives.EnumOfValue 0u)) + + do! PInvoke.CreateProcess(PCWSTR(), PWSTR(cmdlinePtr), NativePtr.nullPtr, NativePtr.nullPtr, false, flags, + NativePtr.toVoidPtr NativePtr.nullPtr, PCWSTR(), si, pi) |> CheckResultBOOL "CreateProcess" + + let pi = NativePtr.read pi + return (int32 pi.dwProcessId, pi.hProcess, pi.hThread) } -let openRunningProcess pid = - Kernel32.OpenProcess(Kernel32.ACCESS_MASK(uint32 Kernel32.ACCESS_MASK.StandardRight.SYNCHRONIZE), false, pid) - |> CheckResultSafeHandle "OpenProcess" +let openRunningProcess (pid : int32) = + PInvoke.OpenProcess(PROCESS_ACCESS_RIGHTS.PROCESS_SYNCHRONIZE, false, uint32 pid) + |> CheckResultHandle "OpenProcess" -let resumeThread hThread = - if Kernel32.ResumeThread(hThread) = -1 then - Error (sprintf "[ResumeThread] %s" (Win32Exception().Message)) +let resumeProcess (hThread : HANDLE) = + if PInvoke.ResumeThread(hThread) = UInt32.MaxValue then + Error (sprintf "[DebugActiveProcessStop] %s" (Win32Exception().Message)) else Ok () -let waitForProcessExit hProcess timeoutMs = - match Kernel32.WaitForSingleObject(hProcess, timeoutMs) with - | Kernel32.WaitForSingleObjectResult.WAIT_OBJECT_0 -> Ok true - | Kernel32.WaitForSingleObjectResult.WAIT_TIMEOUT -> Ok false - | Kernel32.WaitForSingleObjectResult.WAIT_ABANDONED -> Error "[WaitForSingleObject] mutex abandoned" - | Kernel32.WaitForSingleObjectResult.WAIT_FAILED +let waitForProcessExit (hProcess : HANDLE) timeoutMs = + match PInvoke.WaitForSingleObject(hProcess, timeoutMs) with + | WAIT_EVENT.WAIT_OBJECT_0 -> Ok true + | WAIT_EVENT.WAIT_TIMEOUT -> Ok false + | WAIT_EVENT.WAIT_ABANDONED -> Error "[WaitForSingleObject] mutex abandoned" + | WAIT_EVENT.WAIT_FAILED | _ -> Error (sprintf "[WaitForSingleObject] %s" (Win32Exception().Message)) diff --git a/wtrace.cmd/Events/Registry.fs b/wtrace.cmd/Events/Registry.fs index 5ecd94a..33bcb19 100644 --- a/wtrace.cmd/Events/Registry.fs +++ b/wtrace.cmd/Events/Registry.fs @@ -47,7 +47,7 @@ module private H = match state.KeyHandleToName.TryGetValue(ev.KeyHandle) with | (true, name) -> name | (false, _) -> sprintf "<0x%X>" ev.KeyHandle - Path.Combine(baseKeyName, ev.KeyName) + $"{baseKeyName}\\{ev.KeyName}" let ev = toEvent ev id "" path "" ev.Status state.Broadcast.publishTraceEvent (TraceEventWithFields (ev, noFields)) diff --git a/wtrace.cmd/TraceControl.fs b/wtrace.cmd/TraceControl.fs index fde681b..d627236 100644 --- a/wtrace.cmd/TraceControl.fs +++ b/wtrace.cmd/TraceControl.fs @@ -10,8 +10,11 @@ open FSharp.Control.Reactive open LowLevelDesign.WTrace.Events open LowLevelDesign.WTrace.Tracing open LowLevelDesign.WTrace.Processing +open Windows.Win32 +open Windows.Win32.Foundation let mutable lostEventsCount = 0 +let mutable lastEventTime = DateTime.MinValue.Ticks let sessionWaitEvent = new ManualResetEvent(false) type WorkCancellation = { @@ -62,6 +65,7 @@ module private H = else sprintf " -> %s" (WinApi.getNtStatusDesc ev.Result) printfn "%s %s (%d.%d) %s%s%s%s" (ev.TimeStamp.ToString("HH:mm:ss.ffff")) ev.ProcessName ev.ProcessId ev.ThreadId ev.EventName (getPath ev.Path) (getDesc ev.Details) result + Interlocked.Exchange(&lastEventTime, DateTime.Now.Ticks) |> ignore let onError (ex : Exception) = printfn "ERROR: an error occured while collecting the trace - %s" (ex.ToString()) @@ -123,7 +127,7 @@ let traceEverything ct handlers filter showSummary debugSymbols = module private ProcessApi = // returns true if the process stopped by itself, false if the ct got cancelled let rec waitForProcessExit (ct : CancellationToken) hProcess = - match WinApi.waitForProcessExit hProcess 500 with + match WinApi.waitForProcessExit hProcess 500u with | Error err -> Error err | Ok processFinished -> if processFinished then @@ -135,7 +139,7 @@ module private ProcessApi = else waitForProcessExit ct hProcess - let traceProcess ct handlers filter showSummary debugSymbols includeChildren (pid, hProcess, hThread : WinApi.SHandle) = + let traceProcess ct handlers filter showSummary debugSymbols includeChildren (pid, hProcess, hThread) = result { let settings = { Handlers = handlers @@ -164,15 +168,28 @@ module private ProcessApi = use sub = initiateEtwSession etwObservable ct.TracingCancellationToken - if not hThread.IsInvalid then - do! WinApi.resumeThread hThread + if hThread <> HANDLE.INVALID_HANDLE_VALUE then + do! WinApi.resumeProcess hThread let! processFinished = waitForProcessExit ct.TracingCancellationToken hProcess if processFinished then printfn "Process (%d) exited." pid - hThread.Close() - hProcess.Close() + let mutable savedLastEventTime = Interlocked.Read(&lastEventTime) + let rec waitForMoreEvents () = + let t = Interlocked.Read(&lastEventTime) + if t <> savedLastEventTime && (not ct.TracingCancellationToken.IsCancellationRequested) then + savedLastEventTime <- t + Thread.Sleep(1000) + waitForMoreEvents () + + // when process exists too fast, we might miss some events + // so we wait for a few seconds to prevent that + Thread.Sleep(3000) + waitForMoreEvents () + + PInvoke.CloseHandle(hThread) |> ignore + PInvoke.CloseHandle(hProcess) |> ignore return (tstate, counters) } @@ -189,7 +206,7 @@ let traceNewProcess ct handlers filter showSummary debugSymbols newConsole inclu let traceRunningProcess ct handlers filter showSummary debugSymbols includeChildren pid = result { let! hProcess = WinApi.openRunningProcess pid - let processIds = (pid, hProcess, WinApi.SHandle.Invalid) + let processIds = (pid, hProcess, HANDLE.INVALID_HANDLE_VALUE) return! ProcessApi.traceProcess ct handlers filter showSummary debugSymbols includeChildren processIds } diff --git a/wtrace.cmd/wtrace.cmd.fsproj b/wtrace.cmd/wtrace.cmd.fsproj index 05e6cca..f14b9aa 100644 --- a/wtrace.cmd/wtrace.cmd.fsproj +++ b/wtrace.cmd/wtrace.cmd.fsproj @@ -1,56 +1,57 @@  - - net472 - Sebastian Solnica - Sebastian Solnica (lowleveldesign.org) - true - en - + + net48 + Sebastian Solnica + Sebastian Solnica (wtrace.net) + true + en + 9,3391 + - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - + + + + + + - - - + + + - - - + + + diff --git a/wtrace.deps/wtrace.deps.csproj b/wtrace.deps/wtrace.deps.csproj index 4bbcd88..d0af343 100644 --- a/wtrace.deps/wtrace.deps.csproj +++ b/wtrace.deps/wtrace.deps.csproj @@ -1,15 +1,16 @@  - - Exe - net472 - ..\bin\deps - true - en - + + Exe + net48 + ..\bin\deps + true + en + 9.0 + - - - + + + diff --git a/wtrace.imports/NativeMethods.json b/wtrace.imports/NativeMethods.json new file mode 100644 index 0000000..0ffee06 --- /dev/null +++ b/wtrace.imports/NativeMethods.json @@ -0,0 +1,5 @@ +{ + "$schema": "https://aka.ms/CsWin32.schema.json", + "emitSingleFile": false, + "public": true +} \ No newline at end of file diff --git a/wtrace.imports/NativeMethods.txt b/wtrace.imports/NativeMethods.txt new file mode 100644 index 0000000..f4f231c --- /dev/null +++ b/wtrace.imports/NativeMethods.txt @@ -0,0 +1,15 @@ +// methods +CreateProcess +OpenProcess +ResumeThread +WaitForSingleObject +DebugActiveProcessStop + +// structures + +// consts +STATUS_WAIT_1 +WAIT_EVENT + +INVALID_HANDLE_VALUE + diff --git a/wtrace.imports/wtrace.imports.csproj b/wtrace.imports/wtrace.imports.csproj index e6297ba..da3b132 100644 --- a/wtrace.imports/wtrace.imports.csproj +++ b/wtrace.imports/wtrace.imports.csproj @@ -1,13 +1,17 @@  - - net472 - LowLevelDesign.WTrace - true - + + net48 + LowLevelDesign.WTrace + true + 9.0 + - - - + + + + all + + diff --git a/wtrace.sln b/wtrace.sln index 4022a25..07e4dff 100644 --- a/wtrace.sln +++ b/wtrace.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 16 -VisualStudioVersion = 16.0.30804.86 +# Visual Studio Version 17 +VisualStudioVersion = 17.8.34408.163 MinimumVisualStudioVersion = 10.0.40219.1 Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "wtrace.cmd", "wtrace.cmd\wtrace.cmd.fsproj", "{22B0116E-15E9-48FA-A221-AF227EA4D90D}" EndProject @@ -16,6 +16,8 @@ Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "wtrace", "wtrace\wtrace.csp {03FA048B-6B69-44B4-831A-69163A21A1BE} = {03FA048B-6B69-44B4-831A-69163A21A1BE} EndProjectSection EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{C68B199A-7034-4026-A3B7-91136289ADEF}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU diff --git a/wtrace.tests/wtrace.tests.fsproj b/wtrace.tests/wtrace.tests.fsproj index cccc950..9692fb9 100644 --- a/wtrace.tests/wtrace.tests.fsproj +++ b/wtrace.tests/wtrace.tests.fsproj @@ -1,16 +1,16 @@  - net472 + net48 false false - - - + + + @@ -25,7 +25,7 @@ - + diff --git a/wtrace/wtrace.csproj b/wtrace/wtrace.csproj index 65a2235..035cf42 100644 --- a/wtrace/wtrace.csproj +++ b/wtrace/wtrace.csproj @@ -1,124 +1,109 @@  - - Exe - net472 - LowLevelDesign.WTrace - Sebastian Solnica - Sebastian Solnica (lowleveldesign.org) - 1.0.0.0 - 1.0.0.0 - en - ..\bin\wtrace - true - + + Exe + net48 + LowLevelDesign.WTrace + Sebastian Solnica + Sebastian Solnica (wtrace.net) + 1.0.0.0 + 1.0.0.0 + en + ..\bin\wtrace + true + 9.0 + - - - + + + - - - .\Dia2Lib.dll - - - .\Microsoft.Diagnostics.FastSerialization.dll - - - .\Microsoft.Diagnostics.Tracing.TraceEvent.dll - - - .\OSExtensions.dll - - - .\System.Runtime.CompilerServices.Unsafe.dll - - - .\TraceReloggerLib.dll - - - .\FSharp.Core.dll - - - .\FSharp.Control.Reactive.dll - - - .\PInvoke.Kernel32.dll - - - .\PInvoke.Windows.Core.dll - - - .\System.Buffers.dll - - - .\System.Memory.dll - - - .\System.Numerics.Vectors.dll - - - .\System.Reactive.dll - - - .\System.Threading.Tasks.Extensions.dll - - - .\NtApiDotNet.dll - - - .\wtrace.cmd.dll - - - .\wtrace.imports.dll - - - - - .\amd64\KernelTraceControl.dll - - - .\amd64\msdia140.dll - - - .\amd64\msvcp140.dll - - - .\amd64\vcruntime140.dll - - - .\amd64\vcruntime140_1.dll - - - - - .\x86\KernelTraceControl.dll - - - .\x86\KernelTraceControl.Win61.dll - - - .\x86\msdia140.dll - - - .\x86\msvcp140.dll - - - .\x86\vcruntime140.dll - - - - .\x86\dbghelp.dll - - - .\x86\symsrv.dll - - - .\amd64\dbghelp.dll - - - .\amd64\symsrv.dll - - - + + + .\Dia2Lib.dll + + + .\Microsoft.Diagnostics.FastSerialization.dll + + + .\Microsoft.Diagnostics.Tracing.TraceEvent.dll + + + .\Microsoft.Win32.Registry.dll + + + .\System.Security.AccessControl.dll + + + .\System.Security.Principal.Windows.dll + + + .\System.Runtime.CompilerServices.Unsafe.dll + + + .\TraceReloggerLib.dll + + + .\FSharp.Core.dll + + + .\FSharp.Control.Reactive.dll + + + .\System.Buffers.dll + + + .\System.Memory.dll + + + .\System.Numerics.Vectors.dll + + + .\System.Reactive.dll + + + .\System.Threading.Tasks.Extensions.dll + + + .\NtApiDotNet.dll + + + .\wtrace.cmd.dll + + + .\wtrace.imports.dll + + + + + .\amd64\KernelTraceControl.dll + + + .\amd64\msdia140.dll + + + + .\x86\KernelTraceControl.dll + + + .\x86\KernelTraceControl.Win61.dll + + + .\x86\msdia140.dll + + + + .\x86\dbghelp.dll + + + .\x86\symsrv.dll + + + .\amd64\dbghelp.dll + + + .\amd64\symsrv.dll + + +