basis/windows/privileges/privileges.factor

   1 ! Copyright (C) 2010 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.data alien.syntax classes.struct
   4 continuations kernel libc literals sequences windows.advapi32
   5 windows.errors windows.kernel32 windows.types ;
   6 IN: windows.privileges
   7
   8 TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
   9
  10 ! Security tokens
  11 !  http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/
  12
  13 : (open-process-token) ( handle -- handle )
  14     flags{ TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY }
  15     { PHANDLE }
  16     [ OpenProcessToken win32-error=0/f ]
  17     with-out-parameters ;
  18
  19 : open-process-token ( -- handle )
  20     ! remember to CloseHandle
  21     GetCurrentProcess (open-process-token) ;
  22
  23 : with-process-token ( quot -- )
  24     ! quot: ( token-handle -- token-handle )
  25     [ open-process-token ] dip
  26     [ keep ] curry
  27     [ CloseHandle drop ] finally ; inline
  28
  29 : lookup-privilege ( string -- luid )
  30     [ f ] dip LUID new
  31     [ LookupPrivilegeValue win32-error=0/f ] keep ;
  32
  33 :: make-token-privileges ( name enabled? -- obj )
  34     TOKEN_PRIVILEGES new
  35         1 >>PrivilegeCount
  36         LUID_AND_ATTRIBUTES malloc-struct &free
  37             enabled? [ SE_PRIVILEGE_ENABLED >>Attributes ] when
  38             name lookup-privilege >>Luid
  39         >>Privileges ;
  40
  41 : set-privilege ( name ? -- )
  42     '[
  43         0
  44         _ _ make-token-privileges
  45         dup byte-length
  46         f
  47         f
  48         AdjustTokenPrivileges win32-error=0/f
  49     ] with-process-token ;
  50
  51 : with-privileges ( seq quot -- )
  52     [ '[ _ [ t set-privilege ] each @ ] ]
  53     [ drop '[ _ [ f set-privilege ] each ] ]
  54     2bi finally ; inline