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 :: 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         0x10 PVOID heap-size read-process-memory
  62         PVOID deref :> args-offset
  63         args-offset ALIEN: 0 = [
  64             f
  65         ] [
  66             handle args-offset 0x40 UNICODE_STRING heap-size read-process-memory
  67             [ handle ] dip
  68             UNICODE_STRING deref [ Buffer>> 0 ] [ Length>> ] bi read-process-memory
  69             utf16n decode
  70         ] if
  71     ] [ drop f ] if* ;
  72
  73 : process-list ( -- assoc )
  74     [
  75         TH32CS_SNAPALL do-snapshot
  76         [ <win32-handle> &dispose drop ]
  77         [ first-process ]
  78         [ '[ drop _ next-process ] follow ] tri
  79         [
  80             [ th32ProcessID>> ]
  81             [ th32ProcessID>> open-process-read dup [ read-args ] when ]
  82             [ szExeFile>> [ 0 = ] trim-tail >string or ] tri 2array
  83         ] map
  84     ] with-destructors ;
  85
  86 M: windows ps ( -- assoc ) process-list ;