USING: accessors alien alien.c-types alien.data alien.syntax
-arrays byte-arrays classes.struct destructors fry io
-io.encodings.string io.encodings.utf16n kernel literals locals
-math nested-comments sequences strings system tools.ps
-windows.errors windows.handles windows.kernel32 windows.ntdll
-windows.types ;
+arrays byte-arrays classes.struct combinators.short-circuit
+continuations destructors fry io io.encodings.string
+io.encodings.utf16 kernel literals locals math sequences
+strings system tools.ps windows.errors windows.handles
+windows.kernel32 windows.ntdll windows.types ;
IN: tools.ps.windows
: do-snapshot ( snapshot-type -- handle )
f
NtQueryInformationProcess drop
] keep ;
-
+
:: read-process-memory ( HANDLE alien offset len -- byte-array )
HANDLE
offset alien <displaced-alien>
ReadProcessMemory win32-error=0/f
ba ;
+: read-peb ( handle address -- peb )
+ 0 PEB heap-size read-process-memory PEB memory>struct ;
+
+: my-peb ( -- peb )
+ GetCurrentProcessId [
+ open-process-read
+ [ <win32-handle> &dispose drop ]
+ [ dup query-information-process PebBaseAddress>> read-peb ] bi
+ ] with-destructors ;
+
:: read-args ( handle -- string/f )
handle <win32-handle> &dispose drop
handle query-information-process :> process-basic-information
handle process-basic-information PebBaseAddress>>
[
- 0x10 PVOID heap-size read-process-memory
+ "ProcessParameters" PEB offset-of
+ PVOID heap-size
+ read-process-memory
PVOID deref :> args-offset
args-offset ALIEN: 0 = [
f
] [
- handle args-offset 0x40 UNICODE_STRING heap-size read-process-memory
+ handle
+ args-offset
+ "CommandLine" RTL_USER_PROCESS_PARAMETERS offset-of
+ UNICODE_STRING heap-size
+ read-process-memory
[ handle ] dip
UNICODE_STRING deref [ Buffer>> 0 ] [ Length>> ] bi read-process-memory
utf16n decode
] if
] [ drop f ] if* ;
-
+
: process-list ( -- assoc )
[
TH32CS_SNAPALL do-snapshot
[ first-process ]
[ '[ drop _ next-process ] follow ] tri
[
- [ th32ProcessID>> ]
- [ th32ProcessID>> open-process-read dup [ read-args ] when ]
- [ szExeFile>> [ 0 = ] trim-tail >string or ] tri 2array
- ] map
+ [
+ [ th32ProcessID>> ]
+ [ th32ProcessID>> open-process-read dup [ read-args ] when ]
+ [ szExeFile>> [ 0 = ] trim-tail >string or ] tri 2array
+ ] [
+ ! Reading the arguments can fail
+ ! Win32 error 0x12b: Only part of a ReadProcessMemory or WriteProcessMemory request was completed.
+ dup { [ windows-error? ] [ n>> 0x12b = ] } 1&& [ 2drop f ] [ rethrow ] if
+ ] recover
+ ] map sift
] with-destructors ;
M: windows ps ( -- assoc ) process-list ;