more windows loading fixes
parent
014163e27b
commit
f738a4dc4e
|
@ -1,44 +1,44 @@
|
||||||
USING: alien alien.c-types alien.data alien.syntax arrays continuations
|
USING: alien alien.c-types alien.data alien.syntax arrays continuations
|
||||||
destructors generic io.mmap io.ports io.backend.windows io.files.windows
|
destructors generic io.mmap io.ports io.backend.windows io.files.windows
|
||||||
kernel libc math math.bitwise namespaces quotations sequences windows
|
kernel libc math math.bitwise namespaces quotations sequences windows
|
||||||
windows.advapi32 windows.kernel32 windows.types io.backend system accessors
|
windows.advapi32 windows.kernel32 windows.types io.backend system accessors
|
||||||
io.backend.windows.privileges windows.errors ;
|
io.backend.windows.privileges classes.struct windows.errors ;
|
||||||
IN: io.backend.windows.nt.privileges
|
IN: io.backend.windows.nt.privileges
|
||||||
|
|
||||||
TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
|
TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
|
||||||
|
|
||||||
! Security tokens
|
! Security tokens
|
||||||
! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/
|
! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/
|
||||||
|
|
||||||
: (open-process-token) ( handle -- handle )
|
: (open-process-token) ( handle -- handle )
|
||||||
{ TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags PHANDLE <c-object>
|
{ TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags PHANDLE <c-object>
|
||||||
[ OpenProcessToken win32-error=0/f ] keep *void* ;
|
[ OpenProcessToken win32-error=0/f ] keep *void* ;
|
||||||
|
|
||||||
: open-process-token ( -- handle )
|
: open-process-token ( -- handle )
|
||||||
#! remember to CloseHandle
|
#! remember to CloseHandle
|
||||||
GetCurrentProcess (open-process-token) ;
|
GetCurrentProcess (open-process-token) ;
|
||||||
|
|
||||||
: with-process-token ( quot -- )
|
: with-process-token ( quot -- )
|
||||||
#! quot: ( token-handle -- token-handle )
|
#! quot: ( token-handle -- token-handle )
|
||||||
[ open-process-token ] dip
|
[ open-process-token ] dip
|
||||||
[ keep ] curry
|
[ keep ] curry
|
||||||
[ CloseHandle drop ] [ ] cleanup ; inline
|
[ CloseHandle drop ] [ ] cleanup ; inline
|
||||||
|
|
||||||
: lookup-privilege ( string -- luid )
|
: lookup-privilege ( string -- luid )
|
||||||
[ f ] dip LUID <struct>
|
[ f ] dip LUID <struct>
|
||||||
[ LookupPrivilegeValue win32-error=0/f ] keep ;
|
[ LookupPrivilegeValue win32-error=0/f ] keep ;
|
||||||
|
|
||||||
: make-token-privileges ( name ? -- obj )
|
: make-token-privileges ( name ? -- obj )
|
||||||
TOKEN_PRIVILEGES <struct>
|
TOKEN_PRIVILEGES <struct>
|
||||||
1 >>PrivilegeCount
|
1 >>PrivilegeCount
|
||||||
LUID_AND_ATTRIBUTES malloc-struct &free
|
LUID_AND_ATTRIBUTES malloc-struct &free
|
||||||
swap [ SE_PRIVILEGE_ENABLED >>Attributes ] when
|
swap [ SE_PRIVILEGE_ENABLED >>Attributes ] when
|
||||||
>>Privileges
|
>>Privileges
|
||||||
[ lookup-privilege ] dip
|
[ lookup-privilege ] dip
|
||||||
[ Privileges>> (>>Luid) ] keep ;
|
[ Privileges>> (>>Luid) ] keep ;
|
||||||
|
|
||||||
M: winnt set-privilege ( name ? -- )
|
M: winnt set-privilege ( name ? -- )
|
||||||
[
|
[
|
||||||
-rot 0 -rot make-token-privileges
|
-rot 0 -rot make-token-privileges
|
||||||
dup length f f AdjustTokenPrivileges win32-error=0/f
|
dup length f f AdjustTokenPrivileges win32-error=0/f
|
||||||
] with-process-token ;
|
] with-process-token ;
|
||||||
|
|
|
@ -204,8 +204,8 @@ CONSTANT: MAX_PROTOCOL_CHAIN 7
|
||||||
|
|
||||||
STRUCT: WSAPROTOCOLCHAIN
|
STRUCT: WSAPROTOCOLCHAIN
|
||||||
{ ChainLen int }
|
{ ChainLen int }
|
||||||
! { ChainEntries { DWORD MAX_PROTOCOL_CHAIN } } ;
|
|
||||||
{ ChainEntries { DWORD 7 } } ;
|
{ ChainEntries { DWORD 7 } } ;
|
||||||
|
! { ChainEntries { DWORD MAX_PROTOCOL_CHAIN } } ;
|
||||||
TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
|
TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
|
||||||
|
|
||||||
CONSTANT: WSAPROTOCOL_LEN 255
|
CONSTANT: WSAPROTOCOL_LEN 255
|
||||||
|
|
Loading…
Reference in New Issue