basis/tools/ps/windows/windows.factor

   1 USING: accessors alien alien.c-types alien.data alien.syntax
   2 arrays byte-arrays classes.struct combinators.short-circuit
   3 continuations destructors fry io io.encodings.string
   4 io.encodings.utf16n kernel literals locals math sequences
   5 strings system tools.ps windows.errors windows.handles
   6 windows.kernel32 windows.ntdll windows.types ;
   7 IN: tools.ps.windows
   8
   9 : do-snapshot ( snapshot-type -- handle )
  10     0 CreateToolhelp32Snapshot dup win32-error=0/f ;
  11
  12 : default-process-entry ( -- obj )
  13     PROCESSENTRY32 new PROCESSENTRY32 heap-size >>dwSize ;
  14
  15 : first-process ( handle -- PROCESSENTRY32 )
  16     default-process-entry
  17     [ Process32First win32-error=0/f ] keep ;
  18
  19 : next-process ( handle -- PROCESSENTRY32/f )
  20     default-process-entry [ Process32Next ] keep swap
  21     FALSE = [ drop f ] when ;
  22
  23 : open-process-read ( dwProcessId -- HANDLE )
  24     [
  25         flags{ PROCESS_QUERY_INFORMATION PROCESS_VM_READ }
  26         FALSE
  27     ] dip OpenProcess ;
  28
  29 : query-information-process ( HANDLE -- PROCESS_BASIC_INFORMATION )
  30     0
  31     PROCESS_BASIC_INFORMATION new [
  32         dup byte-length
  33         f
  34         NtQueryInformationProcess drop
  35     ] keep ;
  36
  37 :: read-process-memory ( HANDLE alien offset len -- byte-array )
  38     HANDLE
  39     offset alien <displaced-alien>
  40     len <byte-array> dup :> ba
  41     len
  42     f
  43     ReadProcessMemory win32-error=0/f
  44     ba ;
  45
  46 : read-peb ( handle address -- peb )
  47     0 PEB heap-size read-process-memory PEB memory>struct ;
  48
  49 : my-peb ( -- peb )
  50     GetCurrentProcessId [
  51         open-process-read
  52         [ <win32-handle> &dispose drop ]
  53         [ dup query-information-process PebBaseAddress>> read-peb ] bi
  54     ] with-destructors ;
  55
  56 :: read-args ( handle -- string/f )
  57     handle <win32-handle> &dispose drop
  58     handle query-information-process :> process-basic-information
  59     handle process-basic-information PebBaseAddress>>
  60     [
  61         "ProcessParameters" PEB offset-of
  62         PVOID heap-size
  63         read-process-memory
  64         PVOID deref :> args-offset
  65         args-offset ALIEN: 0 = [
  66             f
  67         ] [
  68             handle
  69             args-offset
  70             "CommandLine" RTL_USER_PROCESS_PARAMETERS offset-of
  71             UNICODE_STRING heap-size
  72             read-process-memory
  73             [ handle ] dip
  74             UNICODE_STRING deref [ Buffer>> 0 ] [ Length>> ] bi read-process-memory
  75             utf16n decode
  76         ] if
  77     ] [ drop f ] if* ;
  78
  79 : process-list ( -- assoc )
  80     [
  81         TH32CS_SNAPALL do-snapshot
  82         [ <win32-handle> &dispose drop ]
  83         [ first-process ]
  84         [ '[ drop _ next-process ] follow ] tri
  85         [
  86             [
  87                 [ th32ProcessID>> ]
  88                 [ th32ProcessID>> open-process-read dup [ read-args ] when ]
  89                 [ szExeFile>> [ 0 = ] trim-tail >string or ] tri 2array
  90             ] [
  91                 ! Reading the arguments can fail
  92                 ! Win32 error 0x12b: Only part of a ReadProcessMemory or WriteProcessMemory request was completed.
  93                 dup { [ windows-error? ] [ n>> 0x12b = ] } 1&& [ 2drop f ] [ rethrow ] if
  94             ] recover
  95         ] map sift
  96     ] with-destructors ;
  97
  98 M: windows ps process-list ;