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

   1 USING: alien alien.c-types alien.data alien.syntax arrays continuations\r
   2 destructors generic io.mmap io.ports io.backend.windows io.files.windows\r
   3 kernel libc math math.bitwise namespaces quotations sequences windows\r
   4 windows.advapi32 windows.kernel32 io.backend system accessors\r
   5 io.backend.windows.privileges windows.errors ;\r
   6 IN: io.backend.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     [ open-process-token ] dip\r
  24     [ keep ] curry\r
  25     [ CloseHandle drop ] [ ] cleanup ; inline\r
  26 \r
  27 : lookup-privilege ( string -- luid )\r
  28     [ f ] dip "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\r
  34     "LUID_AND_ATTRIBUTES" malloc-object &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     [ lookup-privilege ] dip\r
  43     [\r
  44         TOKEN_PRIVILEGES-Privileges\r
  45         set-LUID_AND_ATTRIBUTES-Luid\r
  46     ] keep ;\r
  47 \r
  48 M: winnt set-privilege ( name ? -- )\r
  49     [\r
  50         -rot 0 -rot make-token-privileges\r
  51         dup length f f AdjustTokenPrivileges win32-error=0/f\r
  52     ] with-process-token ;\r