basis/tools/ps/windows/windows.factor

   1 USING: accessors alien alien.c-types alien.data alien.syntax
   2 arrays byte-arrays classes.struct destructors fry io
   3 io.encodings.string io.encodings.utf16n kernel literals locals
   4 math nested-comments sequences strings system tools.ps
   5 windows.errors windows.handles windows.kernel32 windows.ntdll
   6 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 <struct> 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 <struct> [
  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 : slot-offset-by-name ( struct-class name -- value/f )
  57     [ struct-slots ] dip '[ name>> _ = ] find swap [ offset>> ] when ;
  58
  59 :: read-args ( handle -- string/f )
  60     handle <win32-handle> &dispose drop
  61     handle query-information-process :> process-basic-information
  62     handle process-basic-information PebBaseAddress>>
  63     [
  64         PEB "ProcessParameters" slot-offset-by-name
  65         PVOID heap-size
  66         read-process-memory
  67         PVOID deref :> args-offset
  68         args-offset ALIEN: 0 = [
  69             f
  70         ] [
  71             handle
  72             args-offset
  73             RTL_USER_PROCESS_PARAMETERS "CommandLine" slot-offset-by-name
  74             UNICODE_STRING heap-size
  75             read-process-memory
  76             [ handle ] dip
  77             UNICODE_STRING deref [ Buffer>> 0 ] [ Length>> ] bi read-process-memory
  78             utf16n decode
  79         ] if
  80     ] [ drop f ] if* ;
  81
  82 : process-list ( -- assoc )
  83     [
  84         TH32CS_SNAPALL do-snapshot
  85         [ <win32-handle> &dispose drop ]
  86         [ first-process ]
  87         [ '[ drop _ next-process ] follow ] tri
  88         [
  89             [ th32ProcessID>> ]
  90             [ th32ProcessID>> open-process-read dup [ read-args ] when ]
  91             [ szExeFile>> [ 0 = ] trim-tail >string or ] tri 2array
  92         ] map
  93     ] with-destructors ;
  94
  95 M: windows ps ( -- assoc ) process-list ;