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