more windows loading fixes

db4
Joe Groff 2009-09-19 02:44:40 -05:00
parent 014163e27b
commit f738a4dc4e
2 changed files with 45 additions and 45 deletions

View File

@ -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 ;

View File

@ -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