From: bear@nuc.anu.edu.au (Bernhard Fabricius)
Subject: Re: Can I change quota entries from DCL or a program?
Reply-To: BEAR@NUC.ANU.EDU.AU
Organization: Nuclear Physics, ANU
Date: Thu, 30 Jul 92 00:36:07 GMT


In article <112125@muvms3.bitnet>, boag@muvms3.bitnet (Bob Boag) writes:
||>Does anyone know of a EASY way to read and modify the entries in the QUOTA
|>file?
|>
Bob,

Unfortunately there is no F$QUOTA lexical function, but below you'll find a
program I wrote only yesterday (before I even saw your post!) which will do
pretty much what the F$QUOTA lexical would have done, except the resulting
values are written to four logical names which you may then translate with
F$TRNLNM (F$LOG for Ye Olde VMS Hacks).

To avoid doing a SHOW QUOTA to a file, you just read the QUOTA.SYS file in the
root ([000000]) directory of the disk in question. This file contain 32 byte
records, ie 8 longwords per line. The entries of interest are:
#2:	Owner UIC identifier in longword form
#3:	Blocks in use (Integer*4)
#4:	Permanent quota (Integer*4)
#5:	Permitted overdraft (Integer*4)
The remaining fields are of no interest to this program.
The program keeps reading until it finds a Owner UIC which matches the one
you called with. It is neither elegant, nor fast, but it works.

WARNING: I use /extend_source (132 column mode) when I write FORTRAN!


	options /extend_source
	program f$quota

c	(c) Bernhard Fabricius, 29 July 1992
c	This program may be used, copied and modified freely by anyone as long as the original author is
c	acknowledged in redistributed versions.

c	Program to read the quota files (Primitive interface to emulate the missing F$QUOTA lexical function).
c	Will set the process logical names F$QUOTA_INUSE, F$QUOTA_QUOTA, F$QUOTA_OVERD and F$QUOTA_FREEQ.
c	Set QUOTA.SYS to world read (if you dare), or run only from privileged account.
c	Define F$QUOTA as a foreign command (or run with MCR)
c	Specify USERUIC as (optional) first parameter. Default is current process.
c	Specify DEVICE as (optional) second parameter. Default is current device.
c	Externally: Translate the logical names in DCL with F$TRNLNM().

	implicit	none
	character*132	foreign
	character*80	retname, user, device
	character*12	value
	integer*4	sys$idtoasc, retlen, f(8), userlen, flen, devlen, id, idr, status, vlen
	integer*4	inuse, quota, overd, freeq, comma, str$position
	include		'($jpidef)'
	include		'($ssdef)'

c	Get the foreign command
	call lib$get_foreign(foreign,,flen,)
c	First element is the USER UIC
	call str$element(user,0,' ',foreign)
c	Get the length 
	call lentrim(user,userlen)
c	Second element is the DEVICE
	call str$element(device,1,' ',foreign)
	call lentrim(device,devlen)

	if(userlen.eq.0)then					!No user specified
	  call lib$GETJPI(jpi$_uic,,,,user,userlen)		!Get user uic from lib$GETJPI
	  user(1:userlen)=user(2:userlen-1)//'  '		![NUCLEAR,GAMMA]   or [MUG]
	  userlen=userlen-2					!NUCLEAR,GAMMA     or MUG	
	  comma=str$position(user,',', )			!       8             0
	  if(comma.ne.0)then					!There was a comma - remove first identifier
	    call str$element(user,1,',',user)			!Get element no 1 (second) from comma list
	    call lentrim(user,userlen)				!Restore length
	  end if						!GAMMA             or MUG
	end if

c	Initialize the values. (See labels 200, 201 and 202 for error codes).
	inuse =  0
	quota =  0
	overd =  0
	freeq =  0

c	Open the QUOTA.SYS file on the ROOT directory of the called DEVICE as a SHARED, UNFORMATTED READONLY unit
	open(unit=1,file=DEVICE(1:devlen),defaultfile='[000000]QUOTA.SYS',status='old',readonly,shared,form='unformatted',err=200)

c	Read the entries in the quota file
100	continue						!Main loop
	read(1,err=201,end=202)f				!Read 32 bytes
	id=f(2)							!Longword id is the second field
	status=sys$idtoasc(%val(id),retlen,retname,idr,,)	!Translate to names UIC identifier
	if(status.ne.1)go to 100				!Must be SS$NORMAL, else read next
	if(retname(1:retlen).eq.user(1:userlen))then		!Just read the one we're after  ?
	  inuse =  f(3)						!3rd field is blocks in use
	  quota =  f(4)						!4th field is permanent quota
	  overd =  f(5)						!5th field is permitted overdraft
	  freeq =  quota - inuse				!Free quota is (quota - inuse)
	  go to 300						!Skip the loop
	end if
	goto 100						!Next entry

	
c	A negative F$QUOTA_QUOTA value is used to signal a failure in F$QUOTA. The code returned are muck-ups of 
c	the $ SHOW QUOTA STATUS codes (but set negative). Calling DCL may use F$MESSAGE on the absolute value:
c	$WRITE SYS$OUTPUT F$MESSAGE(-F$TRNLNM("F$QUOTA_QUOTA"))
200	continue						!OPEN error
	quota=-SS$_QFNOTACT					!%SYSTEM-F-QFNOTACT, disk quotas not enabled on this volume
	go to 300						!Set logical names
201	continue						!READ error
	quota=-SS$_BADQFILE					!%SYSTEM-F-BADQFILE, invalid disk quota file format
	go to 300						!Set logical names
202	continue						!UIC not found
	quota=-SS$_NODISKQUOTA					!%SYSTEM-F-NODISKQUOTA, no disk quota entry for this UIC

c	Set the logical names F$QUOTA_INUSE, F$QUOTA_QUOTA, F$QUOTA_OVERD and F$QUOTA_FREEQ.
300	continue
	write(value(1:12),*)inuse				!Write inuse to value string
	vlen=0							!Reset search length
	call lentrim(value,vlen)				!Trim the string (left-align)
	call lib$set_logical('F$QUOTA_INUSE',value(1:vlen),,,)	!Set logical
	write(value(1:12),*)quota				!Write quota to value string
	vlen=0							!Reset search length
	call lentrim(value,vlen)				!Trim the string (left-align)
	call lib$set_logical('F$QUOTA_QUOTA',value(1:vlen),,,)	!Set logical
	write(value(1:12),*)overd				!Write overd to value string
	vlen=0							!Reset search length
	call lentrim(value,vlen)				!Trim the string (left-align)
	call lib$set_logical('F$QUOTA_OVERD',value(1:vlen),,,)	!Set logical
	write(value(1:12),*)freeq				!Write freeq to value string
	vlen=0							!Reset search length
	call lentrim(value,vlen)				!Trim the string (left-align)
	call lib$set_logical('F$QUOTA_FREEQ',value(1:vlen),,,)	!Set logical

	end


c	----------------------------------------------------------------------------------------------------


	options    /extend_source
	subroutine lentrim(text,leng)

c	subroutine to remove (right-shift) spaces and nulls from a text string
c	text		string to trim
c	leng		On call: number of characters to search (0 for whatever's found)
c			on return: actual number of non-space characters 

	implicit	none
	character	text*(*)
	integer*4	leng, i, found, ic

	if(leng.eq.0)leng=len(text)
	
	found=0
	
	do i=leng,1,-1
	  ic=ichar(text(i:i))
	  if(ic.eq.32.or.ic.eq.0)then
	    found=found+1
	    text(i:leng-1)=text(i+1:leng)
	    text(leng:leng)=' '
	  end if
	end do
	leng=leng-found
	return
	end

--------------------------------------------------------------------------------
Dr Bernhard Fabricius              |
Academic VAX/VMS Support           |  "I am a Bear of Very Little Brain,
Department of Nuclear Physics      |           and long words Bother me."
Australian National University     |
                                   |                           - A.A. Milne
InterNet: BEAR@NUC.ANU.EDU.AU      |
    POSTMASTER@NUC.ANU.EDU.AU      |