FORTRAN $GETUAI question

User avatar

Topic author
charles.williams1@covance.com
Member
Posts: 5
Joined: Wed May 03, 2023 10:08 am
Reputation: 0
Location: US - Ohio
Status: Offline

FORTRAN $GETUAI question

Post by charles.williams1@covance.com » Wed May 03, 2023 1:30 pm

Greetings:

In trying to save the last few OpenVMS systems my company has, I have created a couple of virtualized instances of OpenVMS 9 x86. During my port of a large ALPHA FORTRAN based application, I discovered a utility executable that several DCL command procedures are using in various capacities. This program was created by Frank Nagy in 1985. Sorry to say Frank passed away around 2017.

In my attempt to create a new FORTRAN program to perform the same functions, I am having a few issues I need some help with. If I can get this utility completed, I intend on posting it, along with an associated CLD and HLP file to share with others. A reduced section of my code is listed below with comments.

Code: Select all

!+
!  Currently getting a buffer overflow when making the $GETUAI system service call.
!  The UAI flags are NOT returning correctly.
!  I think the uai_return_flags (a longword bit vector) definition is the issue as I have never created one before.
!
!  Additionally the ASTM limit is also NOT returning correctly.
!
!  The UAI account "owner" IS returning correctly.
!
!  Still trying to blow the rust off of my FORTRAN skills...  Any help would be very much appreciated!
!-
        PROGRAM LWBV

        IMPLICIT NONE

!       INCLUDE '($SYSSRVNAM)'          ! Let's reduce bloating and define our single system srv call below
        INCLUDE '($UAIDEF)'

        CHARACTER*32    OWNER           /''/
        CHARACTER*12    USERNAME      /'DEFAULT'/
        INTEGER*2       ASTLM                 /0/
        INTEGER*2       ASTLM_LEN         /0/
        INTEGER         CONTEXT             /-1/
        INTEGER         OWNER_LEN        /0/
        INTEGER         USERNAME_LEN   /0/
        INTEGER         STATUS                 /0/
        INTEGER         SYS$GETUAI
        INTEGER*4       UAI_RET_FLAGS   /0/
        BYTE            A               /0/     ! Testing...
        BYTE            B               /0/     ! Testing...
        BYTE            C               /0/     ! Testing...
 
        INTEGER   :: I                          ! Array pointer
        INTEGER*4 :: ARRAY1(1)                  ! 1D INTEGER ARRAY OF 1 ELEMENT

! Testing - Longword bit array testing.  Lets practice how we create arrays
!       INTEGER*4 :: ARRAY1                     ! 1D INTEGER DYNAMIC ARRAY
!       INTEGER   :: ARRAY1(10)                 ! 1D INTEGER ARRAY OF 10 ELEMENT
!       INTEGER   :: ARRAY2(10, 10)             ! 2D INTEGER ARRAY OF 100 ELEMENTS
!       INTEGER   :: ARRAY3(10, 10, 10)         ! 3D INTEGER ARRAY OF 1000 ELEMENTS

        STRUCTURE /ITEM_LIST/ 
           INTEGER*2 BUFLEN, ITMCOD
           INTEGER*4 BUFADR, RETADR
        END STRUCTURE

        RECORD /ITEM_LIST/ ITEMLIST(4)

!+
! Testing...
!       array1 = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] ! Array constructor
!       array1 = [(i, i = 1, 32)]                ! Implied do loop constructor
        array1(:) = 0                            ! Set all elements to zero
!       array1(1:5) = 1                          ! Set first five elements to one
!       array1(6:) = 1                           ! Set all elements after five to one

        TYPE *,'Displaying the array before the call.'
        print *, array1(1:29)                   ! Print out elements 
!       print *, array1(1:10:2)                 ! Print out elements at odd indices
!       print *, array2(:,1)                    ! Print out the first column in a 2D array
!       print *, array1(29:1:-1)                ! Print an array in reverse
!-

! Stuff the structure then make the call to $GETUAI
        ItemList(1).ITMCOD = UAI$_ASTLM       ! This item is NOT comming back correctly.
!       ItemList(1).BUFLEN =  LEN(ASTLM)
        ItemList(1).BUFADR = %LOC(ASTLM)
       ItemList(1).RETADR = %LOC(ASTLM_LEN)

        ItemList(2).ITMCOD = UAI$_OWNER         !This item is coming back correctly,
        ItemList(2).BUFLEN =  LEN(OWNER)
        ItemList(2).BUFADR = %LOC(OWNER)
        ItemList(2).RETADR = %LOC(OWNER_LEN)

!+ Testing in progress
!  When you specify UAI$_FLAGS, $GETUAI returns, as a longword bit vector, the various login flags set
!  for the user. Each flag is represented by a bit. The $UAIDEF macro defines the following symbolic names for these
!  flags.
!-
        ItemList(3).ITMCOD = UAI$_FLAGS
!       ItemList(3).BUFLEN =  LEN(UAI_RET_FLAGS)
        ItemList(3).BUFADR = %LOC(ARRAY1(:))
!       ItemList(3).RETADR = %LOC(UAI_RET_FAGS_LEN)

        ItemList(4).ITMCOD = 0     !List Terminator
        ItemList(4).BUFLEN = 0     !Optional terminator
        ItemList(4).BUFADR = 0     !Optional terminator
        ItemList(4).RETADR = 0     !Optional terminator

!       %REF / %VAL  / %DESCR / %LOC
!        Status = SYS$GETUAI (,%REF(CONTEXT),%DESCR(USERNAME),ITEMLIST,,,)      ! Errors out on context?
        Status = SYS$GETUAI (,,%DESCR(USERNAME),%REF(ITEMLIST),,,)     
!        IF (.NOT. STATUS) CALL LIB$Signal (%VAL (STATUS))
        CALL LIB$Signal (%VAL (STATUS))                                         ! For testing display STATUS always

        TYPE *,'Displaying the array elements after the call.'                  ! For testing
        PRINT *, ARRAY1(1:29)                                                   ! Referencing the array elements
        TYPE *,'Displaying the array after the call.'                           ! For testing
        PRINT *, ARRAY1(:)                                                      ! Referencing the array

        TYPE *,'Username      : ',USERNAME
        TYPE *,'Owner         : ',OWNER(1:OWNER_LEN)
        TYPE *,'ASTLM is      : ',ASTLM
        TYPE *,'UAI$M_DISACNT : ',UAI$M_DISACNT         !to diagnose the issue 
        TYPE *,'UAI$S_DISACNT : ',UAI$S_DISACNT         !to diagnose the issue 
        TYPE *,'UAI$V_DISACNT : ',UAI$V_DISACNT         !to diagnose the issue 
        TYPE *,'ARRAY1(UAI$V_DISACNT) is: ',Array1(UAI$V_DISACNT)               !to diagnose the issue 

! More testing....The FIELD account flags are currently set to both captive and disusered.
! (Still not working correctly)
        A = IBITS(UAI_RET_FLAGS,UAI$V_DISACNT,1)
        B = IBITS(UAI_RET_FLAGS,UAI$V_DISACNT-1,1)
        C = IBITS(UAI_RET_FLAGS,UAI$V_DISACNT+1,1)
        TYPE *, '********************: 12345678'
        TYPE *, 'Byte VALUE DISACNT   : ',A
        TYPE *, 'Byte VALUE DISACNT-1 : ',B
        TYPE *, 'Byte VALUE DISACNT+1 : ',C

        IF (UAI$M_DISACNT == 1) THEN
           TYPE *,'Account is disusered.'
        ELSE
           TYPE *,'Account is NOT disusered.'
        END IF

        IF (UAI$M_CAPTIVE == 1) THEN
           TYPE *,'Account is captive.'
        ELSE
           TYPE *,'Account is NOT captive.'
        END IF

999     END PROGRAM LWBV
Attachments
GETUAI.zip
(90.79 KiB) Downloaded 271 times
Last edited by marty.stu on Fri Jun 02, 2023 4:40 pm, edited 1 time in total.

User avatar

arne_v
Master
Posts: 308
Joined: Fri Apr 17, 2020 7:31 pm
Reputation: 0
Location: Rhode Island, USA
Status: Offline
Contact:

Re: FORTRAN $GETUAI question

Post by arne_v » Wed May 03, 2023 3:36 pm

For ASTLM try:

ItemList(1).ITMCOD = UAI$_ASTLM
ItemList(1).BUFLEN = 2
ItemList(1).BUFADR = %LOC(ASTLM)
ItemList(1).RETADR = 0

Added in 2 minutes 24 seconds:
For FLAGS try:

ItemList(3).ITMCOD = UAI$_FLAGS
ItemList(3).BUFLEN = 4
ItemList(3).BUFADR = %LOC(UAI_RET_FLAGS)
ItemList(3).RETADR = 0

Added in 12 minutes 26 seconds:
Keeping them as INTEGER*2 and INTEGER*4.
Arne
arne@vajhoej.dk
VMS user since 1986

User avatar

Topic author
charles.williams1@covance.com
Member
Posts: 5
Joined: Wed May 03, 2023 10:08 am
Reputation: 0
Location: US - Ohio
Status: Offline

Re: FORTRAN $GETUAI question

Post by charles.williams1@covance.com » Wed May 03, 2023 4:28 pm

Thank you very much! That immediately resolved my buffer overflow condition and now the return status is normal.
Any ideas on the $GETUAI UAI$_FLAGS issue of returning as a "longword bit vector", and associating it with the $UAIDEF macro definitions. I've never worked with a "longword bit vector" and have searched many places for a FORTRAN example with no luck.


hein
Active Contributor
Posts: 41
Joined: Fri Dec 25, 2020 5:20 pm
Reputation: 0
Status: Offline

Re: FORTRAN $GETUAI question

Post by hein » Wed May 03, 2023 5:08 pm

The xxx$M_yyyy constants are 'bit masks'.
You must .AND. them with the returned vector to test whether a bit is set.
Be sure to read up in - https://vmssoftware.com/docs/VSI_FORTRAN_USER.pdf - search for $M_

The xxx$V_uuu constants are 'bit numbers' starting at 0 = mask value 1, bit 1 = mask value 2, bit 2 = mask value 4 and so on.
You can use them with IBITS to extract 1 bit and then test it as a logical.
Be sure to read up in - https://vmssoftware.com/docs/VSI_FORTRAN_REF.pdf - search for $V_

Hope this helps,
Hein
Last edited by hein on Wed May 03, 2023 5:45 pm, edited 1 time in total.

User avatar

Topic author
charles.williams1@covance.com
Member
Posts: 5
Joined: Wed May 03, 2023 10:08 am
Reputation: 0
Location: US - Ohio
Status: Offline

Re: FORTRAN $GETUAI question

Post by charles.williams1@covance.com » Wed May 03, 2023 5:21 pm

Guys - THANK YOU VERY MUCH !!!
The program is now working .
When the code is finished I'll post it all.

User avatar

arne_v
Master
Posts: 308
Joined: Fri Apr 17, 2020 7:31 pm
Reputation: 0
Location: Rhode Island, USA
Status: Offline
Contact:

Re: FORTRAN $GETUAI question

Post by arne_v » Wed May 03, 2023 9:46 pm

"longword bit vector" is just a 32 bit integer intended to be used for testing or setting bits in.
Arne
arne@vajhoej.dk
VMS user since 1986

User avatar

charleswilliams
Newbie
Posts: 3
Joined: Wed May 31, 2023 12:30 pm
Reputation: 0
Location: US - Ohio
Status: Offline

Re: FORTRAN $GETUAI question

Post by charleswilliams » Fri Jun 02, 2023 4:55 pm

As promised, attached is my current work in progress. As time permitts I will add additional features. Hopefully this exercise will help out someone who needs this utility. Regards - Charles
Attachments
GETUAI.zip
(90.79 KiB) Downloaded 220 times


elementyl
Newbie
Posts: 4
Joined: Wed May 10, 2023 10:44 pm
Reputation: 0
Status: Offline

Re: FORTRAN $GETUAI question

Post by elementyl » Mon Jun 05, 2023 2:54 am

A suggestion - consider adding the CLD to the program rather than relying on adding it to the process command table. This makes the utility a little more self contained like the C version.

User avatar

charleswilliams
Newbie
Posts: 3
Joined: Wed May 31, 2023 12:30 pm
Reputation: 0
Location: US - Ohio
Status: Offline

Re: FORTRAN $GETUAI question

Post by charleswilliams » Tue Jun 06, 2023 8:53 am

Thanks for the tip! I have included a getuai.cld in the attached getuai.zip file to use, but personally elected against adding the GETUAI command verb to the system-wide DCL tables because I have no current business justification for my normal users to access this utility at this time.

User avatar

arne_v
Master
Posts: 308
Joined: Fri Apr 17, 2020 7:31 pm
Reputation: 0
Location: Rhode Island, USA
Status: Offline
Contact:

Re: FORTRAN $GETUAI question

Post by arne_v » Tue Jun 06, 2023 7:06 pm

I believe the requests was not to add the CLD to SYS$LIBRARY:DCLTABLES but to use foreign command and CLI$DCL_PARSE.

Code: Select all

$ copy sys$input z1.for
      PROGRAM Z1
      INTEGER*4 STAT,L,I
      CHARACTER*80 S
      INTEGER*4 CLI$GET_VALUE
      LOGICAL*4 ODD
      ODD(I)=(I.AND.1).EQ.1
      STAT=CLI$GET_VALUE('P1',S,L)
      IF(ODD(STAT)) THEN
        WRITE(*,*) S(1:L)
      ELSE
        WRITE(*,*) '<none>'
      ENDIF
      END
$
$ fortran z1
$ link z1
$ copy sys$input z1.cld
define verb z1
   image "sys$disk:[]z1.exe"
   parameter p1
$
$ set command z1
$ z1 hello
HELLO
$ z1
<none>
$ copy sys$input z2.for
      PROGRAM Z2
      INTEGER*4 STAT,L,I
      CHARACTER*80 S
      INTEGER*4 CLI$DCL_PARSE,CLI$GET_VALUE
      EXTERNAL Z2CLD
      LOGICAL*4 ODD
      ODD(I)=(I.AND.1).EQ.1
      STAT=LIB$GET_FOREIGN(S,,L,)
      STAT=CLI$DCL_PARSE('Z1 '//S(1:L),Z2CLD,,,)
      STAT=CLI$GET_VALUE('P1',S,L)
      IF(ODD(STAT)) THEN
        WRITE(*,*) S(1:L)
      ELSE
        WRITE(*,*) '<none>'
      ENDIF
      END
$
$ fortran z2
$ copy sys$input z2cld.cld
module z2cld
define verb z1
   parameter p1
$
$ set command/object z2cld
$ link z2+z2cld
$ z2:==$sys$disk:[]z2.exe
$ z2 hello
HELLO
$ z2
<none>
Added in 1 minute 33 seconds:
PS: BTW the above example is one I created in 1995. :-)
Arne
arne@vajhoej.dk
VMS user since 1986

Post Reply