Fortran and Win32 programming - Page 3

p_p_1 · ‎12-18-2015

I'm not really experienced in Fortran, I tried unsuccessfully to call a Windows API function as a test (previously I tried some other tests such as locking the screen, with success).
The function is QueryProcessCycleTime (just for curiosity, it retrieves the cpu cycles count of a process, in my test code with a fixed pid of an actually existent process). Its syntax:

BOOL WINAPI QueryProcessCycleTime(
_In_ HANDLE ProcessHandle,
_Out_ PULONG64 CycleTime
);

I couldn't find the Fortran "translation" for these data types and I tried several combinations in my code (for each variables) with no luck. I compiled with
ifort /libs:static /exe: ... or
ifort /libs:qwin,static /exe: ...
but the output is always:
F 4936 0
(return value, pid, cycles count).

The function doesn't appear in the kernel32.f90 supplied by Intel (see Calling Windows API Routines for syntax not involving ISO_C_BINDING).

Going beyond the specific test I wondered if:
really Fortran can't load dlls supplying full path (without adding it as an environment variable)?
Or more in general and in a few words:

Can Fortran be used as a Win32 programming language?
(I don't mean only for a limited set of functions)

Or, at the end, is it (very, we know) useful only for number crunching?

My test code:

module process_cpu_cycles
use ISO_C_BINDING
implicit none

public QueryProcessCycleTime
interface
    function QueryProcessCycleTime(proc_id, cpu_cycles) bind(C,Name='QueryProcessCycleTime')
        use ISO_C_BINDING
        implicit NONE
        !DEC$ ATTRIBUTES STDCALL :: QueryProcessCycleTime
        logical(C_BOOL) :: QueryProcessCycleTime        ! tried C_INT too
        integer(C_INTPTR_T), value :: proc_id           ! tried without value
        integer(C_INTPTR_T), value :: cpu_cycles        ! tried C_INT64_T too
    end function QueryProcessCycleTime
end interface

end module process_cpu_cycles


program cycles
use process_cpu_cycles
use ISO_C_BINDING
implicit none

logical(C_BOOL) :: ret_val
integer(C_INTPTR_T) :: pid
integer(C_INTPTR_T) :: ccycle        ! tried C_INT64_T too

ccycle=0
pid=4936
ret_val = QueryProcessCycleTime(pid,ccycle)
write (*,*) ret_val, pid, ccycle
end program cycles

IanH · ‎01-20-2016

p p. wrote:

Quote:

Steve Lionel (Intel) wrote:

...

I'd also recommend against hard-coding the path to ntdll.dll, as the path to that will vary depending on whether you build a 32 or 64-bit application, or if the program is used on a non-English Windows system. Since ntdll.dll is always going to be in PATH, you can just use the DLL name.

I know the generally Fortran is used for certain purposes, but if we want to look at it as a real Win32 programming language the perspective may change.

Without specifying a full path you are more easily exposed to a DLL hijacking attack. In this article is Microsoft itself that at the first place of this guidelines affirms: "Wherever possible, specify a fully qualified path when using the LoadLibrary, LoadLibraryEx, CreateProcess, or ShellExecute functions.". Just to make things clear, this countermeasure alone could be unuseful (as often happens).

More in general, a module could be located anywhere on disk and one may prefer avoiding to fill the PATH of the environment variables. Just recently I exhausted the space available for PATH (maybe 2048 characters, can't remember) and had to clean up several (unuseful) entries.

Till now, it seems to me that the only way to freely specify the path is not to use the Fortran module loader.

If the library name supplied to LoadLibrary doesn't have a path in front of it, and there is an existing library of that name already loaded into the process, then Windows will return a handle to that existing library, rather than go looking for the library on disk.

The LoadLibrary API is accessed through KERNEL32.DLL. On WIndows NT derived systems, KERNEL32.DLL then load time references the low level NTDLL.DLL. This means that if you can call LoadLibrary on Windows NT derived systems, then KERNEL32.DLL must have been already loaded, which means NTDLL.DLL must have been already loaded, so a call to LoadLibrary with a pathless filename of NTDLL.DLL is safe.

(If you are not on a Windows NT derived system, then there's probably not much point trying to load a low level Windows NT DLL.)

p_p_1 · ‎01-21-2016

Steve Lionel (Intel) wrote:

I can tell you why your first version didn't work - you told AdjustTokenPrivileges that the size of PreviousToken was 5000 when it is more like 8. If you fix that, then the call returns success. When I tried it, it said that no privileges were changed - that's something I can't help with. (Though it looks as if you asked for debug privilege, which I'm pretty sure my process already had.)

There's nothing particularly wrong with the declaration of the types in IFWINTY - it matches that in winnt.h. But if you want to hold more than one privilege you have to get clever with pointers.

Your code worked for me too, but this is not a good news necessarily. The declaration of the function (AdjustTokenPrivileges) in advapi32.f90 is, objectively, a little convoluted (and this fact is not so negligible). I'll show why.
Below I provided an alternative code (and a bit more logical, to me).

NewState (parameter in)
Nothing wrong in the IFWINTY declaration, but things become opaque. When using it and the Intel library, it is not immediately evident in the code that NewState is a pointer and you, seemingly, will treat it as the pointee, initializing and passing it as is. In contrast, in my 2nd and last examples, I explicitly declared NewState as a pointer, in addition declared a suitable type and passed its address to the function. A bit longer but cleaner in its logic.

PreviousState (parameter out)
PreviousState is a pointer returned back by the function, but in the last example I declared it as a type and passed it by reference, with a DEC directive, as the Intel library does. In the 2nd example, instead, I did declared it as a pointer, but after I wasn't able to dereference it (the same for ReturnLength). Maybe my fault. But the question is whether it is possible to declare an API function miming exactly the Windows' definitions for that function. So preserving the logic untouched, it would be the best thing from my point of view.
It's worth noting that despite the declaration as a pointer, at least the privilege changed successfully.
In addition, you dynamically allocated memory for this parameter, but it seems there's no need for it (and I could skip it safely). Having declared it as a type was good enough, as for NewState.

ReturnLength (parameter out)
This is the worst part. My 1st example didn't fail because of the buffer length of 50000 (I already had tried much lesser values for it) but because I set ReturnLength instead of loc(ReturnLength), when calling the function. In order to make the code run, IFWINTY + Intel library forces you to write something like this:
AdjustTokenPrivileges (TokenHandle, DisableAllPrivileges, NewState, BufferLength, PreviousState, loc(ReturnLength))
instead of:
AdjustTokenPrivileges (TokenHandle, DisableAllPrivileges, NewState, BufferLength, PreviousState, ReturnLength)
Note that it's for a detail like this that my 1st code failed (invalid memory access). Not so nice. It can be easily the cause for bad headaches.
ReturnLength is a pointer to a DWORD, so, in my last last example I declared it as a DWORD and passed it by reference with a DEC directive. Now I could use simply 'ReturnLength'. Ironically, here that the Intel library declared the parameter as a pointer, as it is, it was the cause of a misunderstanding.
In this case too, it would be nice to declare it as a pointer, make the function work and have the ability to perform all the necessary conversions/dereferencings while coding.

.OR. IOR()
In this case, I borrowed the .OR. syntax from IFWINTY (see, for example, TOKEN_ALL_ACCESS_P).

So, summarizing, with the parameters_in of a function it seems to be possible to keep their original definitions while declaring the function in Fortran. With the parameters_out things are not as easy.

program change_token
use IFWINTY
use ISO_C_BINDING
use KERNEL32, only: GetLastError, GetCurrentProcess
use ADVAPI32, only: OpenProcessToken, LookupPrivilegeValue
implicit none

interface 
    function LoadLibrary(lpFileName) bind(C,name='LoadLibraryA')
        use ISO_C_BINDING
        implicit none
        character(C_CHAR) :: lpFileName(*) 
        !DEC$ ATTRIBUTES STDCALL :: LoadLibrary 
        INTEGER(C_INTPTR_T) :: LoadLibrary 
    end function LoadLibrary 

    function GetProcAddress(hModule, lpProcName) bind(C, name='GetProcAddress')
        use ISO_C_BINDING
        implicit none
        !DEC$ ATTRIBUTES STDCALL :: GetProcAddress
        TYPE(C_FUNPTR) :: GetProcAddress
        INTEGER(C_INTPTR_T), value :: hModule
        character(C_CHAR) :: lpProcName(*)
    end function GetProcAddress
end interface

abstract interface
    function AdjustTokenPrivileges_Z(TokenHandle2,DisableAllPrivileges,NewState,BufferLength,PreviousState,ReturnLength) bind(C)
        use IFWINTY
        use ISO_C_BINDING
        implicit none
        !DEC$ ATTRIBUTES STDCALL :: AdjustTokenPrivileges_Z
        integer(BOOL) :: AdjustTokenPrivileges_Z
        integer(HANDLE), value :: TokenHandle2
        integer(BOOL), value :: DisableAllPrivileges
        !DEC$ ATTRIBUTES ALLOW_NULL :: NewState
        type(C_PTR), value :: NewState
        integer(DWORD), value :: BufferLength
        !DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: PreviousState
        type(T_TOKEN_PRIVILEGES) :: PreviousState
		!DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: ReturnLength
        integer(DWORD) :: ReturnLength
    end function
end interface


character*(260) lpLibFileName
character*(260) lpProcName
INTEGER(C_INTPTR_T) :: module_handle
TYPE(C_FUNPTR) :: module_address
integer(DWORD) :: geterror
! GetCurrentProcess
integer(HANDLE) :: handle_CurrentProcess
! LookupPrivilegeValue
integer(BOOL) :: ret_val_LookupPrivilegeValue
character*(48) :: lpSystemName
character*(48) :: lpName
type(T_LUID) :: lpLuid
! OpenProcessToken
integer(BOOL) :: ret_val_OpenProcessToken
integer(HANDLE) :: ProcessHandle
integer(DWORD) :: DesiredAccess
integer(HANDLE) :: TokenHandle
! AdjustTokenPrivileges
procedure(AdjustTokenPrivileges_Z), pointer :: AdjustTokenPrivileges
integer(BOOL) :: ret_val_AdjustTokenPrivileges
integer(HANDLE) :: TokenHandle2
integer(BOOL) :: DisableAllPrivileges
type(C_PTR) :: NewState
integer(DWORD) :: BufferLength
type(T_TOKEN_PRIVILEGES) :: PreviousState
integer(DWORD) :: ReturnLength
type(T_TOKEN_PRIVILEGES) :: NewState_structure


! GetCurrentProcess
handle_CurrentProcess=GetCurrentProcess()

! OpenProcessToken
DesiredAccess=ior(TOKEN_ADJUST_PRIVILEGES, TOKEN_QUERY)     ! DesiredAccess=ior(#0008, #0020)
ProcessHandle=handle_CurrentProcess
ret_val_OpenProcessToken=OpenProcessToken(ProcessHandle, DesiredAccess, TokenHandle)

! LookupPrivilegeValue
lpSystemName=achar(0)
lpName="SeDebugPrivilege" // achar(0)
ret_val_LookupPrivilegeValue=LookupPrivilegeValue(lpSystemName, lpName, lpLuid)

! AdjustTokenPrivileges
NewState_structure%PrivilegeCount=1              ! NewState structure with desired values
NewState_structure%Privileges%Luid=lpLuid
NewState_structure%Privileges%Attributes=SE_PRIVILEGE_ENABLED               ! = (#00000002)

lpLibFileName="advapi32.dll" // achar(0)
lpProcName="AdjustTokenPrivileges" // achar(0)
module_handle=LoadLibrary(lpLibFileName)
module_address=GetProcAddress(module_handle,lpProcName)
call C_F_PROCPOINTER(module_address, AdjustTokenPrivileges)

TokenHandle2=TokenHandle
DisableAllPrivileges=FALSE
NewState=c_loc(NewState_structure)             ! gets the address of the NewState structure
BufferLength=256
ret_val_AdjustTokenPrivileges=AdjustTokenPrivileges(&
                        TokenHandle2, DisableAllPrivileges, NewState, BufferLength, PreviousState, ReturnLength)


geterror=GetLastError()
write (*,*)
write (*,*)
write (*,"('ret_val_AdjustTokenPrivileges:',i6,'   (non-zero=ok)')") ret_val_AdjustTokenPrivileges
write (*,"('LastError (Windows):          ',i6)") geterror
write (*,*)
write (*,"('PreviousState PrivilegeCount:',i6,'   (number of privileges changed)')") PreviousState%PrivilegeCount
write (*,"('Privilege:                   ',i6,'   (code of the privilege changed)')") PreviousState%Privileges%Luid%LowPart
write (*,"('(Luid High Part):            ',i6)") PreviousState%Privileges%Luid%HighPart
write (*,"('ReturnLength:                ',i6,'   (required size of PreviousState buffer)')") ReturnLength
write (*,*)
write (*,*)

call system ('pause')              ! to check SeDebugPrivilege status with third party software

end program change_token

Steven_L_Intel1 · ‎01-21-2016

I don't have time to go into further detail, but a few comments.

A lot of the declarations that were inherited from Microsoft did things like have an address-sized integer passed by value for an integer output. Whereas in some cases we could replace this and add an IGNORE_LOC, we can't do that for integer scalar arguments. So in this case the ReturnLength needs to be passed with LOC.

The bit I did with the pointer was to get a bigger buffer for PreviousState, as the default size of that buffer is just one LUID.

There's no need to do LoadLibrary and GetProcAddress for things that are defined in kernel32.lib.

I don't agree with your statement that it's "not possible". You "simply" have to wrap your head around what the interface definition says and how it corresponds to the MSDN C++ prototype. In most cases it is straightforward but there are occasional gotchas such as needing to use LOC.

andrew_4619 · ‎01-21-2016

@PP It is not particularly difficult using API's in Ifort. For any API you are not familiar with you a) look at the MSDN documentation and b) look at the IFWIN interface. The interfaces are what they are for historical reasons. In many cases as you point out you could express the interface in a different (better?) way, the simple reason is that there is no direct 'translation' in Fortran.

The choice is simple either use the IFWIN interface or write and maintain your own interface. I choose the former option as it is far less effort. From time to time if I find a more convenient way of using a specific API I write a simple wrapper for the IFORT interface, this is usually where there are long parameter lists most of which I am not interested in varying.

p_p_1 · ‎01-21-2016

Steve Lionel (Intel) wrote:

...So in this case the ReturnLength needs to be passed with LOC...

Wrong. I did it without LOC. In my last example.

The bit I did with the pointer was to get a bigger buffer for PreviousState, as the default size of that buffer is just one LUID.

This was not the cause of the error. At all. But you are insisting with this.

There's no need to do LoadLibrary and GetProcAddress for things that are defined in kernel32.lib

?? We were speaking about advapi32.lib...

You "simply" have to wrap your head around what the interface definition says and how it corresponds to the MSDN C++ prototype

I did it. My last code is a 'shiny' example.

All my answers are in my last post.
To be clear, I'm not saying this for you, but for the other users.

JVanB · ‎01-21-2016

The issue with ALLOW_NULL for a PDWORD argument is how do you pass the value of zero? With ALLOW_NULL, the C_NULL_PTR will be passed by value rather than a reference to a variable with the value 0.

In my example I showed how to inquire about the size of buffer required and then to allocate it.

My example compiles fine without using LoadLibrary/GetProcAddress. The required function is already in advapi32.lib which is linked in automatically.

When you want to pass NULL, you can use C_F_POINTER to set the address a Fortran pointer points at to C_NULL_PTR. Thus when you pass the Fortran pointer, hence the target of the pointer by reference, it passes C_NULL_PTR by value.

program change_token
use IFWINTY
use ISO_C_BINDING
use KERNEL32, only: GetLastError, GetCurrentProcess
use ADVAPI32, only: OpenProcessToken, LookupPrivilegeValue
implicit none

interface 
    function LoadLibrary(lpFileName) bind(C,name='LoadLibraryA')
        use ISO_C_BINDING
        implicit none
        character(C_CHAR) :: lpFileName(*) 
        !DEC$ ATTRIBUTES STDCALL :: LoadLibrary 
        INTEGER(C_INTPTR_T) :: LoadLibrary 
    end function LoadLibrary 

    function GetProcAddress(hModule, lpProcName) bind(C, name='GetProcAddress')
        use ISO_C_BINDING
        implicit none
        !DEC$ ATTRIBUTES STDCALL :: GetProcAddress
        TYPE(C_FUNPTR) :: GetProcAddress
        INTEGER(C_INTPTR_T), value :: hModule
        character(C_CHAR) :: lpProcName(*)
    end function GetProcAddress
end interface

abstract interface
    function AdjustTokenPrivileges_Z(TokenHandle2,DisableAllPrivileges,NewState,BufferLength,PreviousState,ReturnLength) bind(C)
        use IFWINTY
        use ISO_C_BINDING
        implicit none
        !DEC$ ATTRIBUTES STDCALL :: AdjustTokenPrivileges_Z
        integer(BOOL) :: AdjustTokenPrivileges_Z
        integer(HANDLE), value :: TokenHandle2
        integer(BOOL), value :: DisableAllPrivileges
!        !DEC$ ATTRIBUTES ALLOW_NULL :: NewState
!        type(C_PTR), value :: NewState
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        type(T_TOKEN_PRIVILEGES) :: NewState
        integer(DWORD), value :: BufferLength
!        !DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: PreviousState
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        type(T_TOKEN_PRIVILEGES) :: PreviousState
!  !DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: ReturnLength
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        integer(DWORD) :: ReturnLength
    end function
end interface


character*(260) lpLibFileName
character*(260) lpProcName
INTEGER(C_INTPTR_T) :: module_handle
TYPE(C_FUNPTR) :: module_address
integer(DWORD) :: geterror
! GetCurrentProcess
integer(HANDLE) :: handle_CurrentProcess
! LookupPrivilegeValue
integer(BOOL) :: ret_val_LookupPrivilegeValue
character*(48) :: lpSystemName
character*(48) :: lpName
type(T_LUID) :: lpLuid
! OpenProcessToken
integer(BOOL) :: ret_val_OpenProcessToken
integer(HANDLE) :: ProcessHandle
integer(DWORD) :: DesiredAccess
integer(HANDLE) :: TokenHandle
! AdjustTokenPrivileges
!procedure(AdjustTokenPrivileges_Z), pointer :: AdjustTokenPrivileges
procedure(AdjustTokenPrivileges_Z), bind(C,name='AdjustTokenPrivileges') :: AdjustTokenPrivileges
integer(BOOL) :: ret_val_AdjustTokenPrivileges
integer(HANDLE) :: TokenHandle2
integer(BOOL) :: DisableAllPrivileges
type(C_PTR) :: NewState
integer(DWORD) :: BufferLength
type(T_TOKEN_PRIVILEGES), pointer :: PreviousState
integer(DWORD) :: ReturnLength
type(T_TOKEN_PRIVILEGES) :: NewState_structure
integer(C_INT8_T), allocatable, target :: Buffer(:)

! GetCurrentProcess
handle_CurrentProcess=GetCurrentProcess()

! OpenProcessToken
DesiredAccess=ior(TOKEN_ADJUST_PRIVILEGES, TOKEN_QUERY)     ! DesiredAccess=ior(#0008, #0020)
ProcessHandle=handle_CurrentProcess
ret_val_OpenProcessToken=OpenProcessToken(ProcessHandle, DesiredAccess, TokenHandle)

! LookupPrivilegeValue
lpSystemName=achar(0)
lpName="SeDebugPrivilege" // achar(0)
ret_val_LookupPrivilegeValue=LookupPrivilegeValue(lpSystemName, lpName, lpLuid)

! AdjustTokenPrivileges
NewState_structure%PrivilegeCount=1              ! NewState structure with desired values
NewState_structure%Privileges%Luid=lpLuid
NewState_structure%Privileges%Attributes=SE_PRIVILEGE_ENABLED               ! = (#00000002)

! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!lpLibFileName="advapi32.dll" // achar(0)
!lpProcName="AdjustTokenPrivileges" // achar(0)
!module_handle=LoadLibrary(lpLibFileName)
!module_address=GetProcAddress(module_handle,lpProcName)
!call C_F_PROCPOINTER(module_address, AdjustTokenPrivileges)
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

TokenHandle2=TokenHandle
DisableAllPrivileges=FALSE
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!NewState=c_loc(NewState_structure)             ! gets the address of the NewState structure
!BufferLength=256
allocate(PreviousState)
BufferLength = 0

!ret_val_AdjustTokenPrivileges=AdjustTokenPrivileges(&
!                        TokenHandle2, DisableAllPrivileges, NewState, BufferLength, PreviousState, ReturnLength)
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
ret_val_AdjustTokenPrivileges=AdjustTokenPrivileges(&
                        TokenHandle2, DisableAllPrivileges, NewState_structure, BufferLength, PreviousState, ReturnLength)
geterror=GetLastError()

if(ret_val_AdjustTokenPrivileges == 0 .AND. geterror == 122) then
   deallocate(PreviousState)
   BufferLength = ReturnLength
   allocate(Buffer(BufferLength))
   call C_F_POINTER(C_LOC(Buffer(1)),PreviousState)
ret_val_AdjustTokenPrivileges=AdjustTokenPrivileges(&
                        TokenHandle2, DisableAllPrivileges, NewState_structure, BufferLength, PreviousState, ReturnLength)
geterror=GetLastError()
end if
write (*,*)
write (*,*)
write (*,"('ret_val_AdjustTokenPrivileges:',i6,'   (non-zero=ok)')") ret_val_AdjustTokenPrivileges
write (*,"('LastError (Windows):          ',i6)") geterror
write (*,*)
write (*,"('PreviousState PrivilegeCount:',i6,'   (number of privileges changed)')") PreviousState%PrivilegeCount
write (*,"('Privilege:                   ',i6,'   (code of the privilege changed)')") PreviousState%Privileges%Luid%LowPart
write (*,"('(Luid High Part):            ',i6)") PreviousState%Privileges%Luid%HighPart
write (*,"('ReturnLength:                ',i6,'   (required size of PreviousState buffer)')") ReturnLength
write (*,*)
write (*,*)

call system ('pause')              ! to check SeDebugPrivilege status with third party software

end program change_token