[Win32forth-cvs] win32forth/src/lib Security.f,NONE,1.1

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv30411/src/lib

Added Files:
	Security.f 
Log Message:
Jos: Enables Forth to shutdown the PC

--- NEW FILE: Security.f ---
(( April 7th, 2002 - 12:07
A start for security for NT or better.
It was started for the use of shutdown.

Notes:
It can be compiled when W95 is used.
Words which are marked with *W95 will also work when W95 is used ))


needs struct.f

anew security.f \ Is also able to shutdown a PC

struct{ \ luid_and_attributes
    double  luid
    dword  attributes
 }struct luid_and_attributes

struct{ \ token_privilege
        dword PrivilegeCount
        offset luaa
        sizeof luid_and_attributes _add-struct
}struct token_privilege

sizeof token_privilege mkstruct: &token_privilege

struct{ \  _osversioninfo
    DWORD dwOSVersionInfoSize
    DWORD dwMajorVersion
    DWORD dwMinorVersion
    DWORD dwBuildNumber
    DWORD dwPlatformId
    128 add-struct szCSDVersion
}struct osversioninfo

((            W95  W98  WMe  WNT4.0  W2000  WXP
PlatformID     1    1    1    2        2     2
Major Version  4    4    4    4        5     5
Minor Version  0    10   90   0        0     1  ))

: os! ( adr - )   \ *W95
  sizeof osversioninfo over dwOSVersionInfoSize !
   call GetVersionEx ?win-error
 ;

: nt-or-better? ( - flag )    pad dup os! dwPlatformId @ 2 >= ; \ *W95

string: systemname

: computername$! ( adr - ) \ March 30th, 2002 was GetComputerName
   100 pad ! pad   \ lpszName
   over 1+              \ lpdwbuffer
   call GetComputerName drop  pad @ swap c! ;

: default-system  ( - )  systemname computername$!  ;           \ *W95

initialization-chain chain-add default-system
default-system

\ access mask to the access token
: get-token ( DesiredAccess - TokenHandle )
   nt-or-better?
      if &token_privilege luaa dup>r swap  call GetCurrentProcess
         call OpenProcessToken ?win-error  r> @
      else true abort" Need NT for security operations."
      then
 ;

: luid?   ( z"priv" - luid-h luid-l )
    &token_privilege luaa dup>r swap systemname 1+
    call LookupPrivilegeValue 0= abort" Unknown privilege."
    r> 2@
 ;

 1 constant TokenUser
 2 constant TokenGroups
 3 constant TokenPrivileges
 4 constant TokenOwner
 5 constant TokenPrimaryGroup
 6 constant TokenDefaultDacl
 7 constant TokenSource
 8 constant TokenType
 9 constant TokenImpersonationLevel
10 constant TokenStatistics
11 constant TokenRestrictedSids
12 constant TokenSessionId

: GetTokenInformation ( type TokenHandle - buffer-with-info buffer-size )
   temp$ 100 erase
   2>r pad maxstring temp$ 2r> call GetTokenInformation ?win-error
   temp$ 4 + pad @ ;

: reset_last_error     ( - )  0 call SetLastError drop ;     \ *W95

: .attribute ( attribute - )
    dup 0 = if drop ."  disabled." exit then
    dup SE_PRIVILEGE_ENABLED_BY_DEFAULT and if ."  ENABLED by default." then
    dup SE_PRIVILEGE_ENABLED            and if ."  ENABLED * " then
        SE_PRIVILEGE_USED_FOR_ACCESS    and if ." Seen by PrivilegeCheck." then
 ;

: .luid ( luid-h luid-l - )
\                       size of string  lpName,       lpLuid        pSystemName
    pad 2! 500 temp$ ! temp$   here  pad  systemname 1+
    call LookupPrivilegeName ?win-error
    here temp$ @ type
 ;

: .privs  \ Uses the buffer for storage of the privileges
    ." Priviliges at " systemname  count type ." :"
    reset_last_error
    TOKENPRIVILEGES TOKEN_QUERY get-token GetTokenInformation
     4 - [ sizeof luid_and_attributes ] literal / 0
         do   cr dup i [ sizeof luid_and_attributes ] literal * +
              dup luid 2@ .luid
              attributes @  .attribute
         loop
     drop
 ;

: setpriv  ( z"Privilege" Attribute - flag )  \ for the current process
   TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY or get-token >r
   reset_last_error
   &token_privilege luaa attributes !
   1 &token_privilege !
   luid?
   &token_privilege luaa 2!
   0 temp$ ! temp$
   pad 
   400
   &token_privilege   false
   r>
   call AdjustTokenPrivileges drop
   call GetLastError ERROR_SUCCESS =
 ;

: shutdown     ( type - )    0 swap call ExitWindowsEx  ;       \ *W95

\ down will shutdown or logoff depending on your privilege on NT or better.
: down ( - )                                                    \ *W95
    nt-or-better?
       if    z" SeShutdownPrivilege"  SE_PRIVILEGE_ENABLED setpriv
       else  true
       then
       if     EWX_SHUTDOWN EWX_POWEROFF or \ EWX_REBOOT or
       else   EWX_LOGOFF
       then
    shutdown drop
 ;

\s