2010-09-19 15:02:32 -04:00
|
|
|
! Copyright (C) 2010 Doug Coleman.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: accessors alien alien.data alien.syntax classes.struct
|
|
|
|
continuations fry kernel libc literals locals sequences
|
2011-09-08 16:06:19 -04:00
|
|
|
windows.advapi32 windows.errors windows.kernel32 windows.types
|
|
|
|
alien.c-types ;
|
2010-09-19 15:02:32 -04:00
|
|
|
IN: windows.privileges
|
2009-09-19 03:44:40 -04:00
|
|
|
|
|
|
|
TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
|
|
|
|
|
|
|
|
! Security tokens
|
|
|
|
! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/
|
|
|
|
|
|
|
|
: (open-process-token) ( handle -- handle )
|
2010-05-23 03:07:47 -04:00
|
|
|
flags{ TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY }
|
|
|
|
{ PHANDLE }
|
2010-07-16 17:32:05 -04:00
|
|
|
[ OpenProcessToken win32-error=0/f ]
|
2010-05-23 03:07:47 -04:00
|
|
|
with-out-parameters ;
|
2009-09-19 03:44:40 -04:00
|
|
|
|
|
|
|
: open-process-token ( -- handle )
|
|
|
|
#! remember to CloseHandle
|
|
|
|
GetCurrentProcess (open-process-token) ;
|
|
|
|
|
|
|
|
: with-process-token ( quot -- )
|
|
|
|
#! quot: ( token-handle -- token-handle )
|
|
|
|
[ open-process-token ] dip
|
|
|
|
[ keep ] curry
|
|
|
|
[ CloseHandle drop ] [ ] cleanup ; inline
|
|
|
|
|
|
|
|
: lookup-privilege ( string -- luid )
|
|
|
|
[ f ] dip LUID <struct>
|
|
|
|
[ LookupPrivilegeValue win32-error=0/f ] keep ;
|
|
|
|
|
2009-09-19 11:01:12 -04:00
|
|
|
:: make-token-privileges ( name enabled? -- obj )
|
2009-09-19 03:44:40 -04:00
|
|
|
TOKEN_PRIVILEGES <struct>
|
|
|
|
1 >>PrivilegeCount
|
|
|
|
LUID_AND_ATTRIBUTES malloc-struct &free
|
2009-09-19 11:01:12 -04:00
|
|
|
enabled? [ SE_PRIVILEGE_ENABLED >>Attributes ] when
|
|
|
|
name lookup-privilege >>Luid
|
|
|
|
>>Privileges ;
|
2009-09-19 03:44:40 -04:00
|
|
|
|
2010-09-19 15:02:32 -04:00
|
|
|
: set-privilege ( name ? -- )
|
2010-05-03 18:31:01 -04:00
|
|
|
'[
|
|
|
|
0
|
|
|
|
_ _ make-token-privileges
|
|
|
|
dup byte-length
|
|
|
|
f
|
|
|
|
f
|
|
|
|
AdjustTokenPrivileges win32-error=0/f
|
2009-09-19 03:44:40 -04:00
|
|
|
] with-process-token ;
|
2010-09-19 15:02:32 -04:00
|
|
|
|
|
|
|
: with-privileges ( seq quot -- )
|
|
|
|
[ '[ _ [ t set-privilege ] each @ ] ]
|
|
|
|
[ drop '[ _ [ f set-privilege ] each ] ]
|
|
|
|
2bi [ ] cleanup ; inline
|