basis/io/windows/nt/privileges/privileges.factor

   1 USING: alien alien.c-types alien.syntax arrays continuations\r
   2 destructors generic io.mmap io.ports io.windows io.windows.files\r
   3 kernel libc math math.bitwise namespaces quotations sequences windows\r
   4 windows.advapi32 windows.kernel32 io.backend system accessors\r
   5 io.windows.privileges ;\r
   6 IN: io.windows.nt.privileges\r
   7 \r
   8 TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES\r
   9 \r
  10 ! Security tokens\r
  11 !  http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/\r
  12 \r
  13 : (open-process-token) ( handle -- handle )\r
  14     { TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags "PHANDLE" <c-object>\r
  15     [ OpenProcessToken win32-error=0/f ] keep *void* ;\r
  16 \r
  17 : open-process-token ( -- handle )\r
  18     #! remember to CloseHandle\r
  19     GetCurrentProcess (open-process-token) ;\r
  20 \r
  21 : with-process-token ( quot -- )\r
  22     #! quot: ( token-handle -- token-handle )\r
  23     >r open-process-token r>\r
  24     [ keep ] curry\r
  25     [ CloseHandle drop ] [ ] cleanup ; inline\r
  26 \r
  27 : lookup-privilege ( string -- luid )\r
  28     >r f r> "LUID" <c-object>\r
  29     [ LookupPrivilegeValue win32-error=0/f ] keep ;\r
  30 \r
  31 : make-token-privileges ( name ? -- obj )\r
  32     "TOKEN_PRIVILEGES" <c-object>\r
  33     1 [ over set-TOKEN_PRIVILEGES-PrivilegeCount ] keep\r
  34     "LUID_AND_ATTRIBUTES" malloc-array &free\r
  35     over set-TOKEN_PRIVILEGES-Privileges\r
  36 \r
  37     swap [\r
  38         SE_PRIVILEGE_ENABLED over TOKEN_PRIVILEGES-Privileges\r
  39         set-LUID_AND_ATTRIBUTES-Attributes\r
  40     ] when\r
  41 \r
  42     >r lookup-privilege r>\r
  43     [\r
  44         TOKEN_PRIVILEGES-Privileges\r
  45         >r 0 r> LUID_AND_ATTRIBUTES-nth\r
  46         set-LUID_AND_ATTRIBUTES-Luid\r
  47     ] keep ;\r
  48 \r
  49 M: winnt set-privilege ( name ? -- )\r
  50     [\r
  51         -rot 0 -rot make-token-privileges\r
  52         dup length f f AdjustTokenPrivileges win32-error=0/f\r
  53     ] with-process-token ;\r