C 
C Subroutines to find device and directory for a user
C 
C 		Pick one of the following two: UAF to use SYSUAF.DAT, or
C 		LIST to use SYSUAF.LIS (LIST can be made available to
C 		users by protection, but is a pain to keep updated.  UAF
C		is always up-to-date, but only available to managers)
C 
C	    Call DM_UserName_UAF  (Nbytes,AtStat)
C	    Call DM_UserName_List (Nbytes,AtStat)
C 		NOTE: New_Device is passed in common
	
	
	Subroutine DM_UserName_List (NBytes,AtStat)
C 
C 		Dale E. Coy
C 		19-DEC-1987 
C 
C 	New_Device(:NBytes) = '@Username'
C 	Returns with New_Device(:NBytes) = Login Directory for this user
C 	(AtStat = .false. and error message written if unknown or
C 		no privilege to access sys$system:sysuaf.lis)
C 
C 	NOTE: This routine assumes that SYS$SYSTEM:SYSUAF.LIS exists, 
C 	and was created using LIST/BRIEF from Authorize.  It is specific
C 	to the format created by LIST/BRIEF in VMS 4.6, and the routine
C 	must be edited if the format of this listing changes with future
C 	versions of VMS.  If I have guessed right, only the parameter
C 	statements will have to be edited.
	
	IMPLICIT INTEGER (A-Z)
	Logical AtStat
	Parameter (DirPosn  = 70)
	Parameter (UserPosn = 22)
	
	Integer*2	NBytes
	Integer		Dirstring_Size
	
	Include 'Common.Dat'

	AtStat = .FALSE.	! Assume failure
	If (NBytes .LT. 2) Return
	If (NBytes .GT. (User_Length + 1)) Return
	Requested_UserName = New_Device (2:NBytes)
	New_Device (1:NBytes) = New_Device (2:NBytes)
	NBytes = NBytes - 1
	
        Open(Unit=2, File= 'SYS$SYSTEM:SYSUAF.LIS',
	1	Access = 'SEQUENTIAL', 
	2	RecordType = 'VARIABLE',
	3	Status='OLD', READONLY, Shared, 
	4	IOSTAT = IOX, ERR= 100)  

C 		First two lines are headers
	Read (2,50,End=200,Err=200)
	Read (2,50,End=200,Err=200)
50	Format (T<UserPosn>,A<User_Length>,T<DirPosn>,Q,A)
	
60	Continue	! Do Forever	
	Read (2,50,End=200,Err=200) This_UserName, Dirstring_Size, Dirstring
	If (This_UserName .EQ. Requested_UserName) Go To 300
	GoTo 60
	
100	Continue	! Error on Open IOX=30 open fail, 29 file not found
	Call Mess_Wait (
	1	'  No Privilege For This Operation  (File Not Found) ')
	GoTo 9999
	
200	Continue	! End or Error
	Call Mess_Wait (
	1	'  Account '//New_Device(:NBytes)//' Was Not Found  ')
	GoTo 9998
	
300	Continue	! Success
	New_Device = Dirstring
	NBytes = Dirstring_Size
	AtStat = .TRUE.
	Go To 9998	
	
9998	Close (Unit=2)
9999	Return
	
	End

C ---------------------------------------------------------------------
	Subroutine DM_UserName_UAF (NBytes,AtStat)
C 
C 	Get default (login) directory for a user, directly from UAF
C 
C 		Dale E. Coy
C 		20-FEB-1988 
C 
C 	New_Device(:NBytes) = '@Username'
C 	Returns with New_Device(:NBytes) = Login Directory for this user
C 	(AtStat = .false. and error message written if unknown or
C 		no privilege to access sys$system:sysuaf.dat)
C 
	
	IMPLICIT INTEGER (A-Z)
	Logical AtStat
	
	Integer		Dirstring_Size
	
	Include 'Common.Dat'
	Include	'($UAIDEF)'

	Integer*2	NBytes
	
	Parameter (Uaf_Device_Length = 64)
	Byte	Uaf_dev(Uaf_Device_Length +1), 
	1	Uaf_device(Uaf_Device_Length), Uaf_dev_Len

	Parameter (Uaf_Directory_Length = 256)
	Byte	Uaf_Dir(Uaf_Directory_Length +1), 
	1	Uaf_Directory(Uaf_Directory_Length), Uaf_Dir_Len
	
	
	Integer*2 	Dvlen,Drlen
	
	Equivalence 	(Uaf_dev(2),Uaf_device(1))
	Equivalence 	(Uaf_dev(1),Uaf_dev_Len)
	Equivalence 	(Uaf_Dir(2),Uaf_Directory(1))
	Equivalence 	(Uaf_Dir(1),Uaf_Dir_Len)
                                                
	structure /item_list/
	  integer*2 buflen,code
	  integer*4 address,retlen
	end structure

	record /item_list/ list(3)


C -------------------------------------------------------------------------
	
	AtStat = .FALSE.	! Assume failure
	If (NBytes .LT. 2) Return
	If (NBytes .GT. (User_Length + 1)) Return
	Requested_UserName = New_Device (2:NBytes)
	New_Device (1:NBytes) = New_Device (2:NBytes)
	NBytes = NBytes - 1
	
c
c	Get SYSTEM info
c

	list(1).buflen = Uaf_Device_Length 
	list(1).code = uai$_defdev
	list(1).address = %loc(Uaf_dev)
	list(1).retlen = %loc(Dvlen)

	list(2).buflen = Uaf_Directory_Length
	list(2).code = uai$_defdir
	list(2).address = %loc(Uaf_Dir)
	list(2).retlen = %loc(Drlen)

	list(3).buflen = 0
	list(3).code = 0


	status = sys$getuai(,,Requested_UserName,list,,,)
	if (.NOT. Status) Go To 10468		! Error
	
	Dirstring = ' '
	
	Do 50 K = 1, Uaf_dev_Len
		Dirstring(K:K) = Char(Uaf_device(K))
50	Continue
	
	Dirstring_Size = Uaf_dev_Len
	Do 60 K = 1, Uaf_Dir_Len
		Dirstring_Size = Dirstring_Size + 1
		Dirstring(Dirstring_Size:Dirstring_Size) = 
	1			Char(Uaf_Directory(K))
60	Continue
	
300	Continue	! Success
	New_Device = Dirstring(:Dirstring_Size)
	NBytes = Dirstring_Size
	AtStat = .TRUE.
	Go To 9999	
	
C ERROR Exits
10468	Continue
	If (Status .EQ. 10468) Go To 100	! No Priv
C 		10524 seems to be "same group but not same UIC"
C 		Act like it's "no priv"
	If (Status .EQ. 10524) Go To 100	! No Priv
C 		98994 is "does not exist", and is returned for any user.
C 		If you are concerned about the security implications, 
C 		change this to point to 100 instead of 200.
	If (Status .EQ. 98994) Go To 200	! User does not exist
	Go To 250				! Some other error
		
100	Continue	! Error on Access
	Call Mess_Wait ('  No Privilege For This Operation  ')
	GoTo 9999
	
200	Continue	! End or Error
	Call Mess_Wait (
	1	'  Account '//New_Device(:NBytes)//' Was Not Found  ')
	GoTo 9999
	
250	Continue	! End or Error
	Call Mess_Wait (
	1	'  Error finding Account '//New_Device(:NBytes)//'  ')
	GoTo 9999
	
	
9999	Return
	
	End
	
