integer*4 function IOSUAF (unit, option) !++ Source: LIB:UAF#IOSUAF - Performs I/O to the UAF FILE ! ! Created: ??-???-1985 by Troy Frericks - ISUCC Accounting ! !+++ Function: Given a file number, and a function number (as ! defined in lib:include#ios) this procedure will ! OPEN/READ/WRITE the UAF file. Messages can be !--- supressed by including a negative option number. ! ! Modified: 28-May-1986 by Troy Frericks - ISUCC Accounting ! Report error messages with octal UIC, rather ! than decimal. ! !-- implicit none include 'LIB:INCLUDE(UAF)' include 'LIB:INCLUDE(IOS)' c include 'LIB:INCLUDE(USER)' include 'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)' include 'LIB:COMMON(CTRLC)' integer*4 i ! used for error messages character*5 group ! used for error messages character*5 member ! used for error messages integer*4 unit,option,status,opt integer*4 locked integer*4 message_l /0/ character*80 message /' '/ logical*2 message_f /.TRUE./ integer*4 isu_TRIM, isu_UNSIGN2, isu_FMTO ! external functions 1 format (q,a) locked = 0 status = 0 opt = option if (opt .lt. 0) then opt = opt * -1 ! make positive message_f = .FALSE. ! do not display error msgs endif 100 continue c c sequential read c if (opt .eq. seql) then read (unit=unit,fmt=1,err=200,iostat=status) uaf_size,uaf_rec if (uaf_record$t_username(1:1) .eq. '<') goto 100 ! record that contain things like system password from_username = uaf_record$t_username(:12) from_uic = uaf_record$l_uic c c indexed read (KEYEQ) c elseif (opt .eq. keyeq) then if (from_flag .eq. 0) then read (unit=unit,fmt=1,keyeq=from_username,keyid=0, 1 err=200,iostat=status) uaf_size,uaf_rec elseif (from_flag .gt. 0) then read (unit=unit,fmt=1,keyeq=from_uic,keyid=1, 1 err=200,iostat=status) uaf_size,uaf_rec elseif (from_flag .lt. 0) then read (unit=unit,fmt=1,keyeq=from_group,keyid=2, 1 err=200,iostat=status) uaf_size,uaf_rec endif from_username = uaf_record$t_username(:12) from_uic = uaf_record$l_uic c c indexed read (KEYGT) c elseif (opt .eq. keygt) then if (from_flag .eq. 0) then read (unit=unit,fmt=1,keygt=from_username,keyid=0, 1 err=200,iostat=status) uaf_size,uaf_rec elseif (from_flag .gt. 0) then read (unit=unit,fmt=1,keygt=from_uic,keyid=1, 1 err=200,iostat=status) uaf_size,uaf_rec elseif (from_flag .lt. 0) then read (unit=unit,fmt=1,keygt=from_group,keyid=2, 1 err=200,iostat=status) uaf_size,uaf_rec endif from_username = uaf_record$t_username(:12) from_uic = uaf_record$l_uic c c indexed read (KEYGE) c elseif (opt .eq. keyge) then if (from_flag .eq. 0) then read (unit=unit,fmt=1,keyge=from_username,keyid=0, 1 err=200,iostat=status) uaf_size,uaf_rec elseif (from_flag .gt. 0) then read (unit=unit,fmt=1,keyge=from_uic,keyid=1, 1 err=200,iostat=status) uaf_size,uaf_rec elseif (from_flag .lt. 0) then read (unit=unit,fmt=1,keyge=from_group,keyid=2, 1 err=200,iostat=status) uaf_size,uaf_rec endif from_username = uaf_record$t_username(:12) from_uic = uaf_record$l_uic c c rewite c elseif (opt .eq. rewrite) then rewrite (unit=unit,fmt=1,err=200,iostat=status) 1 uaf_rec(:uaf_size) c c write c elseif (opt .eq. write) then write (unit=unit,fmt=1,err=200,iostat=status) 1 uaf_rec(:uaf_size) c c delete c elseif (opt .eq. delete) then delete (unit=unit,err=200,iostat=status) c c open_keyed_ro c elseif (opt .eq. open_keyed_ro) then open (unit=unit, iostat=status, access='keyed', 1 organization='indexed', name='sysuaf', status='old', 2 form='formatted', shared, readonly) c c open_seql_ro c elseif (opt .eq. open_seql_ro) then open (unit=unit, iostat=status, access='sequential', 1 organization='indexed', name='sysuaf', status='old', 2 form='formatted', shared, readonly) c c open_keyed c elseif (opt .eq. open_keyed) then open (unit=unit, iostat=status, access='keyed', 1 organization='indexed', name='sysuaf', status='old', 2 form='formatted', shared) c c open_seql c elseif (opt .eq. open_seql) then open (unit=unit, iostat=status, access='sequential', 1 organization='indexed', name='sysuaf', status='old', 2 form='formatted', shared) c c open_new c elseif (opt .eq. open_new) then open (unit=unit, iostat=status, access='sequential', 1 organization='indexed', name='newuaf', status='new', 2 form='formatted', recordtype='variable', 3 key=(4:35:character, 36:39:integer, 38:39:integer), 4 recl=1412, blocksize=3, carriagecontrol='none') else status = 2 ! fake an error endif c c check for errors c 200 if (locked .ne. 0) then if (status .eq. 0 .and. message_f) then print *, '?IOSUAF-S-UNLOCKED: I/O completed' endif endif if (status .ne. 0) then if (status .eq. FOR$IOS_SPERECLOC .and. locked .le. 35) then if (message_f .and. locked .eq. 0) then if (uaf_record$t_username .eq. ' ') 1 uaf_record$t_username = '<>' print *, '?IOSUAF-W-LOCKED: waiting..., 35 tries '// 2 'max - Previous UserID = \' // 3 uaf_record$t_username(:isu_TRIM(uaf_record$t_username)) 4 // '\' elseif (message_f) then print *, '?IOSUAF-W-LOCKED: waiting... tries '// 1 'so far =', locked endif locked = locked + 1 call isu_SLEEP(locked) ! wait 1 second after first read, 2 after second, 22 after 22nd ect goto 100 endif if (opt .eq. keygt .and. status .eq. 36) then ! if keygt and error=no more records status = err_eof endif if (status .ne. err_eof) then call ERRSNS (,,,,status) call getmsg (status, message, message_l) if (message_f) then if (uaf_record$t_username .eq. ' ') 1 uaf_record$t_username = '<>' if (opt .le. err_inv) then print *, '?IOSUAF-E-INVOPTION: OPTION =', opt else if (opt .le. keyge) then print *, '?IOSUAF-E-READ: ' // message(:message_l) else if (opt .eq. rewrite) then print *, '?IOSUAF-E-REWRITE: ' // message(:message_l) else if (opt .eq. write) then print *, '?IOSUAF-E-WRITE: ' // message(:message_l) else if (opt .le. open_new) then print *, '?IOSUAF-E-OPEN: ' // message(:message_l) else print *, '?IOSUAF-E-INVOPTION: OPTION =', opt endif if (opt .eq. seql) then print *, '-IOSUAF-E-READSEQL: can not read - KEY ' 1 // 'before I/O = \' // 2 uaf_record$t_username(:isu_TRIM(uaf_record$t_username)) 3 // '\' elseif (opt .ge. keyeq .and. opt .le. keyge) then if (from_flag .eq. 0) then print *, '-IOSUAF-E-READINFO: ' // 1 'Attempt to read \' // 2 from_username(:isu_TRIM(from_username)) // '\' else if (from_flag .eq. 1) then i = isu_FMTO(-5, group, isu_unsign2(from_group) ) i = isu_FMTO(-6, member, isu_unsign2(from_member) ) print *, '-IOSUAF-E-READINFO: ' // 1 'Attempt to read \[', group, ',', member, ']\' else if (from_flag .eq. -1) then i = isu_FMTO(-5, group, isu_unsign2(from_group) ) print *, '-IOSUAF-E-READINFO: ' // 1 'Attempt to read \[', group, 2 ', * ]\' endif endif endif endif else status = 1 endif IOSUAF = status return end