	.title	DISKUSE - Get disk quota usage for this user
	.ident /V2.2/
;+++
;
; Facility:
;	DISKUSE
;
; Author:
;	Dave Leonard, Advanced Data Management, 12-DEC-1980
;	Joel Snyder, CompuServe Incorporated, 5-JUL-1983
;
; Revised:
;	20-may-1981, put in "day-quota-exceeded" check to not
;		cause problems with running jobs when other users login
;	5-Jul-1982, made work with VMS V3.xx and made suitable for
;		CompuServe usage. Major and massive edits and cleanups
;	11-Jul-1983, made check for BATCH or NETWORK processes and
;		quit; changed to use normal QIO syntax; more cleanliness
;	1-Aug-1983, installed system wide quota checking code
;
; Environment:
;	VAX/VMS V3.xx or greater (not checked with VMS V4.xx)
;	 requires CMKRNL privilege to look up the system DDB
;	 table. requires SYSPRV privilege if system quota file
;  	 not made world-writable (a good idea).
;
; Restricions:
;;	FIXED!
;;	1) Right now, only the users login default disk/directory
;;	are checked for quota enforcement, the routine should/could be
;;	changed to sum up all usage on all disks.  This is being fixed.
;;	FIXED!
;
;	2) All files owned by the UIC are counted towards the usage
;	count, this means all files on [0,0] (directories for example)
;	and all lost files are counted.	Thus the user may see some
;	discrepency between the number on his directory listing and
;	what the quota usage shows.  NOTE: File headers are also counted
;	in this total.  Thus one block/file surcharge is counted. Also,
;	disk quotas are enforced on ALLOCATED, not USED blocks. Take this
;	into consideration.
;
;;	FIXED IN V4.0 of VAX/VMS!!!
;;	3) There is no convient way to get a breakdown of where all
;;	the contributing files are.  i.e. what directory they are on.
;;	FIXED IN V4.0 of VAX/VMS!!!
;
;	4) This program will bomb out on a system that has no disk
;	drives whatsoever (or, no disk drives with the first character
;	"D" in their physical name.)
;
; Usage:
;	First thing to do is to set up the QUOTA files for your site.
;	See the system managers guide for more info on
;	running the DISKQUOTA utility.  Set the default([000,000]), to 
;	the max allowed, or 999999 blocks for both OVERDRAFT and PERMANANT.
;	Issue a REBUILD command, and then set the OVERDRAFT limit to
;	the actual quota assigned to each UIC.
;
;	(CAUTION - you must not have any users on your system while doing
;	the REBUILD as it write-locks the pack while it's in progress!!!)
;
;	To run this utility, you first must set the protection
;	on all the "[000000]QUOTA.SYS" files to allow write access
;	for all users.
;
;		$ SET PROTECTION ddcn:[000000]QUOTA.SYS/PROT=(WO:RW)
;
;	When this is done, the quota file IS WRITEABLE to ALL users, so
;	its a good idea to remove ALL priviledges from the image file
;	"[SYSEXE]DISKQUOTA.EXE" so users can't set their quota's up.
;
;		$ SET PROTECTION SYS$SYSTEM:DISKQUOTA.EXE/PROT=(WORLD)
;
;	Keep in mind that there needs to ba a QUOTA.SYS file set up on
;	all default login disks.
;
;	Alternately, you can install DISKUSE with SYSPRV, which
;	keeps the integrity of your quota file intact (imagine the
;	consequences of someone editing QUOTA.SYS!). [jms]
;	If you wish, you can change the protection on quota files
;	and not install DISKUSE, but my advice is to leave
;	your quota files as they are and simply install DISKUSE
;	with CMKRNL and SYSPRV. It will work without CMKRNL -- it
;	just won't check all disks (perhaps you'd rather have it
;	that way?). It will work without SYSPRV if the quota files
;	are not protected.
;
;	The constants MULTIPLIER and PERCENT are described below in
;	the actual code; please remember to set them to reasonable
;	values (and optionally comment out the code from PERCENT_START
;	to PERCENT_END).
;
; Description:
;       DISKUSE - is a routine that gets run at login time.  Usually
;	by inserting the command 
;
;		$ RUN SYS$SYSTEM:DISKUSE
;
;	in the common login file for all users.  Its purpose
;	is to check the disk space used by the running UIC and compare
;	the space used with the number in the QUOTA.SYS file.  The 
;	QUOTA.SYS file has two entries, one for PERMANANT limit and one
;	for OVERDRAFT limit.  The scheme used here is to actually use
;	the number in the OVERDRAFT slot as the actual disk quota.  The
;	PERMANANT limit is usually set to twice the OVERDRAFT limit.
;	This limit is determined by the constant MULTIPLIER. The logged
;	in quota is set equal to the OVERDRAFT quota times MULTIPLIER.
;	If the user has exceeded the disk blocks specified in the 
;	OVERDRAFT slot, his PERMANANT entry is reduced to the number
;	in the OVERDRAFT entry and the user is notified that his disk
;	usage is over the allowed limit.  This efectively lowers the boom 
;	on a user who uses a lot of temporary storage, and does not delete
;	his files after he is done.  It allows him to run up to double
;	his assigned quota before he is denied disk space.  
;
;	   At that time, when the user logs in, he is notified that he has
;	excluded his quota, and that he has one day to clean things up.
;	He will continue to get this message for one day, after that,
;	the actual diskquota will be set down to the overdraft limit.
;
;	   This scheme is considerably nicer to the user than DEC's 
;	hard and fast limits.
;
;	   If the user has logged on with excessive disk usage for more
;	than one day, he is restricted to his quota until he cleans up 
;	his directory and logs in again.  At that time, the usage is 
;	again checked, if it is below the allowed limit, (in the 
;	OVERDRAFT slot), the actual PERMANANT entry is set to twice 
;	the OVERDRAFT number and the user is notified that his quota 
;	has been lifted.
;
;	CompuServe mods:		[jms]
;		we allow the softquota to be eight times the quota
;		made to work under 3.xx
;		massive code cleanup
;		include ddb prancing code
;---

;	Change this constant to a suitable number, where the logged
;	in quota of a user is their OVERDRAFT times this number
;	(MULTIPLIER). We use eight; the default for Version 1 of
;	DISKUSE is 2. If you change the number in midstride, all your
;	users will get a message about having their quota raised
;	the first time they log in -- ignore it, it will go away.
	MULTIPLIER=^D8				; logged in quota is
						; MULTIPLIER*OVERDRAFT
;	Change this constant to a suitable number, where this represents
;	a percentage of logged out quota. When the user has exceeded
;	this percentage, and only then, will DISKUSE tell the user about
;	his quota. This eliminates the annoying habit of always blabbering
;	to users about how much disk space they have used. Please
;	comment out the code from PERCENT_START to PERCENT_END if you
;	want the usage message always (the Version 1 behavior).
	PERCENT=^D80				; percent of usage needed
						; to type out message

	.library	/SYS$LIBRARY:LIB/

	$DQFDEF		; Disk Quota File block
	$FIBDEF		; File ID Block
	$IODEF		; I/O def's
	$JPIDEF		; Job Process Info
	$SSDEF		; SS definitions
	$PCBDEF		; Process Control Block definitions

;	macros

;MACRO ERRORCK - checks R0 for error condition
	.macro	errorck,?l1
	blbs	r0,l1
	$exit_s	code = r0
l1:
	.endm	errorck

;MACRO IOERRCHK - checks R0 and R_IOSB for error condition
	.macro	ioerrchk,?l1,?l2
	blbc	r0,l1
	movzwl	iosb,r0
	blbs	r0,l2
l1:	$exit_s	code = r0
l2:
	.endm 	ioerrchk


	.psect  DISKUSE_GLOBAL_DATA,wrt

	.global disk_name,disk_length,unit_number
;+++
; DDB prancing global locations
;
; It is important that the order of these not be disturbed.
; Specifically, DISK_LENGTH,DISK_ADDRESS, and DISK_NAME must
; conform (approximately) to the format for a string descriptor
; like this:
;	+---------------------------------------------+
;	|  defined, but not used         |  length    |
;	+---------------------------------------------+
;	|               address of data               |
;	+---------------------------------------------+
;
DISK_LENGTH: 	.blkl 1
DISK_ADDRESS:	.address DISK_NAME
DISK_NAME: 	.blkb 20
UNIT_NUMBER: 	.blkw 1
;
;---


	.psect	DISKUSE_LOCAL_DATA, wrt
;+++
; $GETJPI stuff
;
items:
	.word	4
	.word	JPI$_GRP
	.address	group
	.address	group_len

	.word	4
	.word	JPI$_MEM
	.address	member
	.address	member_len

	.word	4
	.word	JPI$_STS
	.address	status_flag
	.address	status_flag_len

	.long	0

group:		.blkl	1
group_len:	.blkl	1
member:		.blkl	1
member_len:	.blkl	1
status_flag:	.blkl	1
status_flag_len:.blkl	1
;
;---

;+++
; PRIVILEGE FLAG -- set to indicate no cmkrnl
;
privilege_flag:	.long 	0
;
;---

;+++
; USAGE MESSAGE		-- stolen from SHOW QUOTA
;
faoline:
	.ascid ' User [!OB,!OB] has !SL blocks used, !SL !AC,'-
'!/ of !SL authorized and permitted overdraft of !SL blocks on !AS'
AVAIL:	.ASCIC	/available/
OVER:	.ASCIC	/OVERDRAWN/
;
;---

;+++
; $ FAO stuff
;
; DO NOT REARRANGE -- contains string descriptors
faodesc:
	.word		512
	.word		0
	.long		faobuf
faobuf:	.blkb		512
faolen:	.blkw		1
	.blkw		1
;
;---

;+++
; DATE stuff
;
; DO NOT REARRANGE -- contains date descriptors
datedesc:
	.long		11
	.address	date
date:
	.blkb	11
bindate:
	.long	0
;
;---

;+++
; MESSAGES
;
downline:
	.ascid	'!/You have exceeded your maximum allowed disk usage.!/!_' -
	 	'You may not create or extend any files until you reduce!/!_' -
		'your usage to less than !UL blocks. This enforcement!/!_' -
		'will remain in effect until you have reduced your usage.'
upline:
	.ascid	'!/!_Your disk quota has been raised to normal levels.!/' -
		'!_Please try to curb excessive space usage.'
warnline:
	.ascid	'You have exceeded your disk quota.!/!_' -
		'You have until tomorrow to reduce your usage to!/!_' -
		'less than !UL blocks.  After this grace period,!/!_' -
		'your disk quota will be lowered until you reduce!/!_' -
		'your usage.'
;
;---

;+++
;	DISK block stuff
;
; DO NOT REARRANGE -- contains string descriptors
DRIVE:	.ascid /SYS$DISK/
dkname:	.long 63
dkaddr:	.long DK
DK:	.blkb 63
dkchan:	.word 0
;
;---

;+++
;	TTY block stuff
;
; DO NOT REARRANGE -- contains string descriptors
OUTPUT:	.ascid /SYS$OUTPUT/
ttname:	.long 63
ttaddr:	.long TT
TT:	.blkb 63
ttchan:	.word 0
;
;---

;+++
; $ ACP CONTROL stuff
;
fibdesc:					; FIB descriptor
	.word		FIB$C_LENGTH		; length
	.word		0			; not used
	.address	fibblk			; address of fib block
fibblk:	.blkb		FIB$C_LENGTH		; an FIB

dqfdesc:					; disk quota file descriptor
	.word		DQF$C_LENGTH		; length
	.word		0			; not used
	.address	dqfblk			; address of dqf block
dqfblk:	.blkb		DQF$C_LENGTH		; a DQF block (only need one)

iosb:	.blkw	4				; I/O status block
;
;---

	.psect  DISKUSE_CODE,EXE,NOWRT
	.entry	DISKUSE, ^M<>

START:	$GETJPI_S	ITMLST=items		; get [group,member] and flags
	errorck					; check for errors. OK?

	bbc		#PCB$V_BATCH,status_flag,CHECKNET
	$exit_s		code=r0			; if BATCH, then EXIT
						
CHECKNET:	
	bbc		#PCB$V_NETWRK,status_flag,GETTTY
	$exit_s		code=r0			; if NETWORK, exit

GETTTY:	$trnlog_s -				; translate SYS$OUTPUT
		LOGNAM=output,-
		RSLLEN=ttname,-
		RSLBUF=ttname
	errorck					; everything OK?

	cmpb	tt,#^X1B			; if ESCape, then 
	bneq	1$
	subl 	#4,ttname			; take away header stuff
	addl 	#4,ttaddr			; ... to make a real device

1$:	$assign_s -				; assign the TTY
		devnam=ttname,-			
	 	chan=ttchan			
	errorck					; and check for good stuff

GETDATE:
	$ASCTIM_S -
		TIMBUF=datedesc 		; get today's date
	errorck					; (this better not fail!)

	movb	date, r0			; move in 10's digit
	bicl2	#^XFFFFFFF0, r0			; make digit
	mull3	#10, r0, bindate		; mul and stuff
	movb	date+1, r0			; move in 1's digit
	bicl2	#^XFFFFFFF0, r0			; make digit
	addl2	r0, bindate			; add it in

GETDISK:
	$CMKRNL_S -
		ROUTIN=get_disk			; get a disk name
	
	cmpl	r0,#SS$_NOPRIV			; ... did we forget our privs?
	beqlu	GET_DEFAULT_DISK		; if so, use SYS$DISK
	cmpl	r0,#SS$_NOSUCHDEV		; ... are there any more?
	beqlu	DONE				; if not, just go away
	cmpl	r0,#SS$_NORMAL			; ... did we exit normally?
	bnequ	DONE				; if not, die
	brw	GET_DDB_DISK			; if so, go and get disk

DONE:
	movzwl	#SS$_NORMAL,R0			; clear out R0
	$dassgn_s -				; deassign channel
		chan=ttchan			; ... for tty
	$exit_s	code=r0				; call exit

GET_DEFAULT_DISK:
	tstl	privilege_flag			; have we been here before?
	bnequ	DONE				;  if we have, we are done
	movzwl	#SS$_NORMAL,privilege_flag	;  if not, remember that fact

	$ASSIGN_S -				; assign channel to SYS$DISK
		DEVNAM=drive, -
		CHAN=dkchan
	errorck					; OK?

	$trnlog_s -				; translate SYS$DISK
		LOGNAM=drive,-			; -- we assume only one trans
		RSLLEN=dkname,-			; -- will be necessary. This
		RSLBUF=dkname			; -- can be risky.
	errorck					; everything OK?
	brw	setup_read_quota		; go to the quota read section

GET_DDB_DISK:
	movl	DISK_LENGTH,R0			; use R0 for indexing
	incl	DISK_LENGTH			; make the length correct
	movb	UNIT_NUMBER,DISK_NAME(R0)	; get the unit number there
	addw2	#48,DISK_NAME(R0)		; and make it ASCII

	$ASSIGN_S -
		DEVNAM=disk_length,-		; assign channel to disk
		CHAN=dkchan
	errorck

	movl	disk_length,R0			; get length
	addw2	#8,r0				; and make room for desc.
	movc3	R0,disk_length,dkname		; and store the disk name away
	decl	disk_length			; restore the length 
	brw	setup_read_quota		; go to the quota read section

SETUP_READ_QUOTA:
	movab	fibblk, r0
	movw	#FIB$C_EXA_QUOTA, FIB$W_CNTRLFUNC(r0)	; EXAmine quota entry

	movab	dqfblk, r11			; get UIC for exquota
						; R11 IS NOT SCRATCH ANYMORE!!!
	movw	member, DQF$L_UIC(r11)		; ... member
	movw	group, DQF$L_UIC+2(r11)		; ... and group

READ_QUOTA:
	movab	dqfdesc,r0
	$QIOW_S	-				; do the read
		CHAN=dkchan, -			; disk channel
		FUNC=#IO$_ACPCONTROL, -		; ACP function
		IOSB=iosb, -			; IO status block
		P1=fibdesc, -			; FIB descriptor
		P2=#dqfdesc, -			; Disk Quota Descriptor-IN
		P4=#dqfdesc			; Disk Quota Descriptor-OUT
	cmpl	r0,#SS$_DEVNOTMOUNT		; is disk unmounted?
	beqlu	2$				; if so, go to next
	errorck					; lets just check R0
	movzwl	iosb,r0				; get IOSB
	blbs	r0,calc_usage			; if 1, then continue
	cmpl	r0,#SS$_QFNOTACT		; ... compare to QFNOTACT
	beqlu	1$				; ... and get the next disk
	cmpl	r0,#SS$_NOQFILE			; ... compare to NOQFILE
	beqlu	1$				; ... and get the next disk
	cmpl	r0,#SS$_NODISKQUOTA		; ... compare to NODISKQUOTA
	beqlu	1$				; ... and get the next disk
	$exit_s	code=r0				; Else, quit noisily

1$:	$dassgn_s -				; deassign this disk 
		chan=dkchan			;
	errorck
2$:	brw	GETDISK				; go to next disk

CALC_USAGE:
	MOVL	DQF$L_USAGE(r11),R1		; get blocks in use
	MOVL	DQF$L_OVERDRAFT(r11),R2		; and pseudo-permanent 
	MULL3	#MULTIPLIER, R2, R5		; and the logged in quota
	MOVAB	AVAIL,R4			; assume not overdrawn
	SUBL3	R1,R2,R3			; compute number remaining
	BGEQ	PRINT_USAGE			; if geq then not overdrawn
	MNEGL	R3,R3				; make overdraft positive
	MOVAB	OVER,R4				; set keyword address

PRINT_USAGE:
;+++
; this code is used to print out the usage only in certain cases.
; It has been suggested that the quota messages are only useful when
; the user is on borderline between in quota and out of quota. This
; code, plus the constant PERCENT (defined at the top of the program)
; can be used to fix that.
;	If the amount USED is greater than PERCENT% of the QUOTA, print out
;	this message. If not, then don't bother the user.
PERCENT_START:
	MULL3	#PERCENT, R2, R6		; get PERCENT of quota
	MULL3   #100, R1, R7			; get 100% of used
	CMPL	R7, R6				; see if used is greater?
	BLSSU	CHECK_QUOTA			; if not, goto CHECK_QUOTA
PERCENT_END:
;---
	$FAO_S	-				; FORMAT ASCII OUTPUT
		CTRSTR = faoline, -		; control string
		OUTLEN = faolen, -		; output length
		OUTBUF = faodesc, -		; output descriptor
		P1=DQF$L_UIC+2(r11), -		; group
		P2=DQF$L_UIC(r11), -		; member
		P3=R1,-				; blocks used
		P4=R3,-				; blocks remaining
		P5=R4,-				; "available" or "OVERDRAWN"
		P6=R2,-				; logged out quota
		P7=R5,-				; logged in quota
		P8=#DKNAME			; on disk name
	errorck

	$OUTPUT	-				; tell user how much
		CHAN = TTCHAN, -		; ... tty
		LENGTH = FAOLEN, -		; ... FAO from previous call
		BUFFER = FAOBUF
	errorck


CHECK_QUOTA:
;	There are four possible paths from here:
;	1) we are ok (PERM = 8*OVER). In this case, we are done
;	   with this disk. If we are not OK, we go to STORE_QUOTA
;	   since that guy always stores some quota. We execute this
;	   loop if USAGE < OVER.
;	2) USAGE > OVER. There are three cases from here: 
;	2a) USAGE > OVER, we have not warned him
;	2b) USAGE > OVER, we have warned him and less than one day
;	2c) USAGE > OVER, we have warned him and more than one day
;	Therefore, there are four exits to GETDISK from here on down.
;	make sure you get them all.
;
	cmpl	DQF$L_USAGE(r11), DQF$L_OVERDRAFT(r11)	; exceede allowed ?
	bgtr	COMPUTE_QUOTA			; if usage > allowed
	mull3	#MULTIPLIER, DQF$L_OVERDRAFT(r11), r0	; mult overdraft by 8
	cmpl	r0, DQF$L_PERMQUOTA(r11)	; is this the perm?
	beql	1$				; if so, ok and move on
	movl	r0, DQF$L_PERMQUOTA(r11)	; if not, then
	brw	STORE_QUOTA			; ... set quota back up

1$:	$dassgn_s -				; deassign this disk and
		chan=dkchan			; get next disk if we are 
	brw	getdisk				; within normal limits

;
; CONDITIONS:
;
; 1) If overdraft*8 is equal to permquota, then warning message has not
; started yet,  thus - give warning, and set permquota to overdraft*8+bindate
;
; 2) If overdraft*8+bindate is equal to permquota then just give warning
; message for today and don't change anything
;
; 3) If neither of the above two apply, then this guy has been over quota for
; more than one day, thus screw him now...
;
; Note: The code is quite confusing here and the dialogue suffers
; 	a great deal. It all works, although it is a bit spaghetti-ish
;	in some places. Heed well the comments, young man!
;
COMPUTE_QUOTA:
	clrl	r8				; clear flags register
						; R8 IS NO LONGER SCRATCH !!!
	mull3	#MULTIPLIER, DQF$L_OVERDRAFT(r11), r0
						; multiply OVERDRAFT*MULTIPLIER
	cmpl	r0, DQF$L_PERMQUOTA(r11)	; CONDITION #1 ???
	bneq	1$				; nope...
	incl	r8				; set flag to 1
1$:
	addl2	bindate, r0			; add on date
	cmpl	r0, DQF$L_PERMQUOTA(r11)	; CONDITION #2 ???
	bneq	2$				; nope...
	brw	warning				; yep -- give warning
2$:
	tstl	r8				; condition 1 set ?
	beql	3$				; nope
	movb	r0, DQF$L_PERMQUOTA(r11)	; set warn date
	brb	STORE_QUOTA			; and store the quota
3$:
	movl	DQF$L_OVERDRAFT(r11), DQF$L_PERMQUOTA(r11); set quota down
	movl	#2, r8

STORE_QUOTA:
	movab	fibblk, r0
	movw	#FIB$C_MOD_QUOTA, FIB$W_CNTRLFUNC(r0)	; MODify quota entry
	bisl	#FIB$M_MOD_PERM, FIB$L_CNTRLVAL(r0)	; the perm one...

	$QIOW_S	-
		CHAN=dkchan, -
		FUNC=#IO$_ACPCONTROL, -
		IOSB=IOSB, -
		P1=fibdesc, -
		P2=#dqfdesc, -
		P4=#dqfdesc
	ioerrchk

	cmpl	#1, r8				; just give warning ?
	bneq	1$				; if not, then up or down
	brw	warning				; well give the warning
1$:
	cmpl	DQF$L_OVERDRAFT(r11), DQF$L_PERMQUOTA(r11) ; set down or up ?
	beql	down				; must be down 

UP:
;	Your disk quota has been raised to normal levels.
;	Please try to curb excessive space usage.
	$FAO_S	-
		CTRSTR = upline, -		; SET UP
		OUTLEN = faolen, -
		OUTBUF = faodesc, -
		P1=DQF$L_PERMQUOTA(r11)
	errorck
	brw	WRITE_MESSAGE			; write it and exit

down:
;	You have exceeded your maximum allowed disk usage.
;	You may not create or extend any files until you reduce
;	your usage to less than !UL blocks. This enforcement
;	will remain in effect until you have reduced your usage.
	$FAO_S	-
		CTRSTR = downline, -		; SET DOWN
		OUTLEN = faolen, -
		OUTBUF = faodesc, -
		P1=DQF$L_PERMQUOTA(r11)
	errorck
	brw	WRITE_MESSAGE

warning:
;	You have exceeded your disk quota.
;	You have until tomorrow to reduce your usage to
;	less than !UL blocks.  After this grace period,
;	your disk quota will be lowered until you reduce
;	your usage.
	$FAO_S	-
		CTRSTR = warnline, -		; GIVE WARNING
		OUTLEN = faolen, -
		OUTBUF = faodesc, -
		P1=DQF$L_OVERDRAFT(r11)

	errorck
	brw	WRITE_MESSAGE

WRITE_MESSAGE:
	$OUTPUT -				; write the message
		chan   = ttchan,-		; to the terminal
		length = faolen,-
		buffer = faobuf
	errorck

	$dassgn_s -				; deassign this disk 
		chan=dkchan			;
	errorck
	brw	GETDISK				; and go on to the next disk

	.end	DISKUSE
