MODULE DISKQUOTA (			! Disk quota maintenance utility
		LANGUAGE (BLISS32),
		MAIN = DISK_QUOTA,
		ADDRESSING_MODE (EXTERNAL = GENERAL,
				NONEXTERNAL = LONG_RELATIVE),
		IDENT = 'V03-001'
		) =
BEGIN

!++
!
! FACILITY:  VMS System Manager Utilities
!
! ABSTRACT:
!
!	This program implements the commands necessary to maintain the
!	quota file on a files-11 structure level 2 disk. Functions are
!	provided to create the quota file, enable and disable quotas,
!	add, list, modify, and remove authorization entries.
!
! ENVIRONMENT:
!
!	VAX/VMS Operating System
!
!--
!
!
! AUTHOR:  Andrew C. Goldstein,	 CREATION DATE:  19-Jun-1979  18:54
!
! MODIFIED BY:
!
!	V03-001	ACG0288		Andrew C. Goldstein,	16-Apr-1982  9:38
!		Add DO_IO entry point for REBUILD
!
!	V02-006	MLJ0058		Martin L. Jack,	4-Nov-1981  20:16
!		Extend PLIT in ACT_CREATE so that newly initialized quota file
!		does not contain garbage in last few longwords.
!
!	V02-005	STJ0055		Steven T. Jeffreys,	29-Jun-1981
!		Changed external references to use general addressing mode.
!
!	V0004	ACG0129		Andrew C. Goldstein,	25-Jan-1980  19:28
!		Use common REBUILD routine
!
!	V0003	ACG0087		Andrew C. Goldstein,
!				Steve Jeffreys,		20-Nov-1979  20:41
!		Add help facility, remove EXAMINE command, add EXIT command
!		Add overdraft limit, default values for ADD
!
!	V0002	ACG0056		Andrew C. Goldstein,	8-Aug-1979  14:49
!		Fix REBUILD function to work on non-volume sets
!
!**


LIBRARY 'SYS$LIBRARY:LIB.L32';
LIBRARY 'SYS$LIBRARY:TPAMAC.L32';


FORWARD ROUTINE
	DISK_QUOTA,			! main routine
	INV_COMMAND,			! signal invalid command
	INV_SWITCH,			! signal invalid switch
	FINISH_UIC,			! assemble and store UIC
	SAVE_KEY,			! save HELP key descriptor
	USE_DEFAULT	: NOVALUE,	! set up default device
	DEF_HANDLER	: NOVALUE,	! condition handler for above
	ACT_USE,			! USE command
	ACT_CREATE,			! CREATE command
	ACT_ENABLE,			! ENABLE command
	ACT_DISABLE,			! DISABLE command
	ACT_ADD,			! ADD command
	ACT_REMOVE,			! REMOVE command
	ACT_SHOW,			! SHOW command
	ACT_MODIFY,			! MODIFY command
	ACT_REBUILD,			! REBUILD command
	ACT_HELP,			! HELP command
	MAIN_HANDLER,			! facility condition handler
	EXIT_HANDLER	: NOVALUE,	! facility exit handler
	COMMON_IO;			! common I/O routine for DO_IO calls
!
! Structure declarations used for system defined structures to
! save typing.
!
STRUCTURE
	BBLOCK [O, P, S, E; N] =
	    [N]
	    (BBLOCK+O)<P,S,E>,

	BBLOCKVECTOR [I, O, P, S, E; N, BS] =
	    [N*BS]
	    ((BBLOCKVECTOR+I*BS)+O)<P,S,E>,

	EXIT_CTRL_BLK [I ; N] =			! exit handler descriptor
	    [(4+N)*4]				! N = # of arguments ( N <= 1)
	    (EXIT_CTRL_BLK+I*4)<0,32,0>;	! the block is a longword array

!
! Macro to generate a string descriptor.
!
MACRO
	DESCRIPTOR (STRING) =
		UPLIT (%CHARCOUNT (STRING), UPLIT BYTE (STRING))%;
!
! Macro to signal error exit.
!
MACRO
	ERR_EXIT [] =
		SIGNAL_STOP (%REMAINING)
		%;
!
! Macro to signal error message.
!
MACRO
	ERR_MESSAGE [] =
		SIGNAL (%REMAINING)
		%;
!
! Macro to declare argument list in TPARSE action routine.
!
MACRO
	TPARSE_ARGS =
		BUILTIN AP;
		BIND TPARSE_BLOCK = AP : REF BBLOCK;
		%;

!+
!
! Error messages
!
! Macro to generate each error message.
!
!-

MACRO
	ERR_TEXT (CODE, COUNT, SEVERITY, STRING) =
		LITERAL %NAME ('DSKQ$_',CODE) = MSG_CODE + FAC_CODE^16;
		SWITCHES UNAMES;
		PSECT OWN = $MSG_TEXT;
		OWN MSG_TEXT : VECTOR [%CHARCOUNT(CODE)+11+%CHARCOUNT(STRING)+2, BYTE]
			INITIAL (BYTE (COUNT,
				       %CHARCOUNT(CODE)+11+%CHARCOUNT(STRING),
				       '%DISKQ-', %STRING (SEVERITY), '-',
				       %STRING (CODE), ', ', STRING));
		PSECT OWN = $MSG_INDEX;
		OWN MSG_INDEX : INITIAL (MSG_TEXT);
		UNDECLARE MSG_TEXT, MSG_INDEX;
		SWITCHES NOUNAMES;
		%ASSIGN (MSG_CODE, MSG_CODE+8)
		PSECT OWN = $OWN$;
		%;

!
! Initialize and label the message sections.
!

PSECT
	OWN	= $MSG_TEXT (NOWRITE, ALIGN(0));
OWN
	MESSAGE_TEXT	: VECTOR [0, BYTE];
PSECT
	OWN	= $MSG_INDEX (NOWRITE, ALIGN (2));
OWN
	MESSAGE_TABLE	: VECTOR [0];

COMPILETIME
	MSG_CODE	= 0;

!
! Generate the error messages
!

LITERAL
	FAC_CODE	= 69;		! or whatever


	ERR_TEXT	(CMD_ERR,	0, F, 'I/O error reading commands');
	ERR_TEXT	(INV_CMD,	6, E, 'unrecognized command!/!AD\!AD\!AD');
	ERR_TEXT	(AMB_CMD,	6, E, 'ambiguous command!/!AD\!AD\!AD');
	ERR_TEXT	(INV_QUAL,	6, E, 'unrecognized qualifier!/!AD\!AD\!AD');
	ERR_TEXT	(AMB_QUAL,	6, E, 'ambiguous qualifier!/!AD\!AD\!AD');
	ERR_TEXT	(INV_UIC,	6, E, 'invalid UIC!/!AD\!AD\!AD');
	ERR_TEXT	(SYNTAX,	6, E, 'command syntax error!/!AD\!AD\!AD');
	ERR_TEXT	(NONLOCAL,	0, E, 'device is not a local device');
	ERR_TEXT	(NOTRAN,	0, E, 'logical name is recursively defined');
	ERR_TEXT	(NODEVICE,	0, E, 'no device currently selected');
	ERR_TEXT	(CREATERR,	0, E, 'error creating quota file');
	ERR_TEXT	(INITERR,	0, E, 'error initializing quota file');
	ERR_TEXT	(CLOSERR,	0, E, 'error closing quota file');
	ERR_TEXT	(ACTERR,	0, E, 'failed to enable quota file');
	ERR_TEXT	(DACTERR,	0, E, 'failed to disable quota file');
	ERR_TEXT	(ADDERR,	0, E, 'failed to add quota file entry');
	ERR_TEXT	(REMOVERR,	0, E, 'failed to remove quota file entry');
	ERR_TEXT	(MODIFYERR,	0, E, 'failed to modify quota file entry');
	ERR_TEXT	(EXAMINERR,	0, E, 'cannot examine quota file entry');
	ERR_TEXT	(INUSE,		3, I, '[!OW,!OW] has !UL blocks in use');
	ERR_TEXT	(LOCKERR,	0, E, 'failed to lock volume');
	ERR_TEXT	(UNLOCKERR,	0, E, 'failed to unlock volume');
	ERR_TEXT	(MAXVOLS,	0, E, 'volume set has too many volumes to handle');
	ERR_TEXT	(ACCINDEXF,	1, E, 'failed to access index file on relative volume !UW');
	ERR_TEXT	(ACCQFILE,	0, E, 'failed to access quota file');
	ERR_TEXT	(QUOTARERR,	0, E, 'I/O error reading quota file');
	ERR_TEXT	(BITMAPERR,	1, E, 'I/O error reading index file bitmap on relative volume !UW');
	ERR_TEXT	(HEADERERR,	2, W, 'I/O error reading file header !UL on relative volume !UW');
	ERR_TEXT	(MEMALLOC,	0, E, 'cannot allocate sufficient memory');
	ERR_TEXT	(HOMEBLOCK,	1, E, 'failed to read home block on relative volume !UW');
	ERR_TEXT	(HELP_INIT,	1, E, 'failed help library index init');
	ERR_TEXT	(HELP_OPEN,	1, E, 'failed to open help library');
	ERR_TEXT	(HELP_TEXT,	1, E, 'failed to access help text');

!
! Module own storage.
!
LITERAL
	COMMAND_LENGTH	= 132,
	OUTPUT_LENGTH	= 132,
	MAX_KEYS	= 14,		! 2*(max # of keys) for HELP commnad
!
! The following are indexes into the Exit Handler Control Block
!
	XHNDLR_ADDRESS	= 1,		! exit handler address
	XHNDLR_ARGCNT	= 2,		! exit handler argument count
	XHNDLR_STSADDR 	= 3;		! system exit status address

OWN
	CHANNEL		: WORD,		! channel for disk I/O
	IO_STATUS	: VECTOR [4, WORD], ! I/O status block
	COMMAND_LINE	: VECTOR [COMMAND_LENGTH, BYTE], ! command line buffer
	OUTPUT_LINE	: VECTOR [OUTPUT_LENGTH, BYTE], ! output line buffer

	COMMAND_DESC	: VECTOR [2] INITIAL (COMMAND_LENGTH, COMMAND_LINE),
					! command line descriptor
	OUTPUT_DESC	: VECTOR [2] INITIAL (OUTPUT_LENGTH, OUTPUT_LINE),
					! output line descriptor
	EXIT_HNDLR_DESC : EXIT_CTRL_BLK [1],
					! exit handler descriptor

!
! Area to zero before each command.
!
	ZERO_AREA	: VECTOR [0],
!
! Cleanup action flags
!
	CLEANUP_FLAGS	: BITVECTOR [32];

LITERAL
	CLF_UNLOCK	= 0,		! unlock volume set
	CLF_EXIT	= 1;		! exit command entered
!
! Quota file record buffers
!
OWN
	SRC_REC		: BBLOCK [DQF$C_LENGTH],
	DST_REC		: BBLOCK [DQF$C_LENGTH],
!
! FIB for quota file operations
!
	QUOTA_FIB	: BBLOCK [FIB$C_LENGTH],
!
! TPARSE action routine output
!
	UIC_GROUP,			! group number of UIC
	UIC_MEMBER,			! member number of UIC
	UIC_FLAGS	: BITVECTOR [32], ! UIC wild card flags

!
! Storage used for HELP function.
!
	KEY_VECTOR	: VECTOR [MAX_KEYS],	! use as a descriptor vector
	KEY_INDEX,

	ZERO_END	: VECTOR [0];

LITERAL
	ZERO_LENGTH	= ZERO_END - ZERO_AREA;
!
! Quota record descriptors
!
OWN
	SRCREC_DESC	: VECTOR [2] INITIAL (DQF$C_LENGTH, SRC_REC),
	DSTREC_DESC	: VECTOR [2] INITIAL (DQF$C_LENGTH, DST_REC),
	QFIB_DESC	: VECTOR [2] INITIAL (FIB$C_LENGTH, QUOTA_FIB);
!
! TPARSE interface and output
!
LITERAL
	WILD_GROUP	= $BITPOSITION (FIB$V_ALL_GRP),
	WILD_MEMBER	= $BITPOSITION (FIB$V_ALL_MEM),
	PERM_SPEC	= $BITPOSITION (FIB$V_MOD_PERM),
	OVER_SPEC	= $BITPOSITION (FIB$V_MOD_OVER);

OWN
	TPARSE_BLOCK	: BBLOCK [TPA$K_LENGTH0]
			  INITIAL (TPA$K_COUNT0, TPA$M_ABBREV);

BIND
	UIC_VALUE	= SRC_REC[DQF$L_UIC],		! full UIC
	PERM_VALUE	= SRC_REC[DQF$L_PERMQUOTA],	! permanent quota
	OVER_VALUE	= SRC_REC[DQF$L_OVERDRAFT];	! overdraft limit

PSECT	PLIT	= $OWN$;

BIND
	QFILE_NAME	= DESCRIPTOR ('QUOTA.SYS;1');	! quota file name

PSECT	PLIT	= $PLIT$;

GLOBAL ROUTINE DISK_QUOTA =

!++
!
! Functional Description:
!
!	This is the main program of the disk quota utility. It accepts
!	commands from SYS$INPUT, parses and processes them, and reports
!	errors.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

LOCAL
	STATUS,				! general status value
	P;				! general string pointer

!
! Generate translation table to convert lower case to upper case.
!
MACRO
	UPCASE_ENTRY (DUMMY) [] =
		%IF ((%COUNT AND %X'7F') GEQU 'a') AND ((%COUNT AND %X'7F') LEQU 'z')
		%THEN (%COUNT AND %X'5F')
		%ELSE (%COUNT AND %X'7F')
		%FI
		%IF %COUNT LSSU 255
		%THEN , UPCASE_ENTRY (0)
		%FI
		%;

BIND
	UPCASE_TABLE	= UPLIT BYTE (UPCASE_ENTRY (0));

EXTERNAL LITERAL
	LIB$_SYNTAXERR;			! syntax error status from TPARSE

EXTERNAL ROUTINE
	LIB$GET_INPUT	: ADDRESSING_MODE (GENERAL),	! get line from SYS$INPUT
	LIB$TPARSE	: ADDRESSING_MODE (GENERAL);	! parse and process command



!
! TPARSE state table to parse commands.
!

$INIT_STATE (STATE_TABLE, KEY_TABLE);

!
! Initial state - acquire command.
!

$STATE	(START,
	('ADD',		DO_ADD),
	('CREATE',	MORE,	ACT_CREATE),
	('DISABLE',	MORE,	ACT_DISABLE),
	('ENABLE',	MORE,	ACT_ENABLE),
	('EXIT',	TPA$_EXIT,,1^CLF_EXIT,CLEANUP_FLAGS),
	('HELP',	DO_HELP),
	('MODIFY',	DO_MODIFY),
	('REBUILD',	MORE,	ACT_REBUILD),
	('REMOVE',	DO_REMOVE),
	('SHOW',	DO_SHOW),
	('USE',		DO_USE),
	(TPA$_SYMBOL,,		INV_COMMAND),
	(TPA$_EOS,	TPA$_EXIT)
	);

!
! USE command
!

$STATE	(DO_USE,
	((DEV_SPEC), MORE, ACT_USE)
	);

!
! ADD command
!

$STATE	(DO_ADD,
	((CMD_SWIT), DO_ADD),
	((UIC), DO_ADD1)
	);

$STATE	(DO_ADD1,
	((CMD_SWIT), DO_ADD1),
	(TPA$_LAMBDA, MORE, ACT_ADD)
	);

!
! MODIFY command
!

$STATE	(DO_MODIFY,
	((CMD_SWIT), DO_MODIFY),
	((WUIC), DO_MODIFY1)
	);

$STATE	(DO_MODIFY1,
	((CMD_SWIT), DO_MODIFY1),
	(TPA$_LAMBDA, MORE, ACT_MODIFY)
	);

!
! SHOW command
!

$STATE	(DO_SHOW,
	((WUIC), MORE, ACT_SHOW)
	);

!
! REMOVE command
!

$STATE	(DO_REMOVE,
	((WUIC), MORE, ACT_REMOVE)
	);

!
! Process additional commands on line
!

$STATE	(MORE,
	(';', START),
	(TPA$_EOS, TPA$_EXIT)
	);

!
! Process command  switches
!

$STATE	(CMD_SWIT,
	('/')
	);

$STATE	(,
	('PERMQUOTA', DO_PERMQUOTA,, 1^PERM_SPEC, UIC_FLAGS),
	('OVERDRAFT', DO_OVERDRAFT,, 1^OVER_SPEC, UIC_FLAGS),
	(TPA$_SYMBOL,, INV_SWITCH)
	);

$STATE	(DO_PERMQUOTA,
	('=')
	);

$STATE	(,
	(TPA$_DECIMAL, TPA$_EXIT,,, PERM_VALUE)
	);

$STATE	(DO_OVERDRAFT,
	('=')
	);

$STATE	(,
	(TPA$_DECIMAL, TPA$_EXIT,,, OVER_VALUE)
	);

!
! Process device name
!

$STATE	(DEV_SPEC,
	(TPA$_SYMBOL)
	);

$STATE	(,
	(':', TPA$_EXIT),
	(TPA$_LAMBDA, TPA$_EXIT)
	);

!
! Process UIC
!

$STATE	(UIC,
	('[')
	);

$STATE	(,
	(TPA$_OCTAL,,,, UIC_GROUP)
	);

$STATE	(,
	(',')
	);

$STATE	(,
	(TPA$_OCTAL,,,, UIC_MEMBER)
	);

$STATE	(,
	(']', TPA$_EXIT, FINISH_UIC)
	);

!
! Process UIC with wild cards
!

$STATE	(WUIC,
	('[')
	);

$STATE	(,
	(TPA$_OCTAL,,,, UIC_GROUP),
	('*',,, 1^WILD_GROUP, UIC_FLAGS)
	);

$STATE	(,
	(',')
	);

$STATE	(,
	(TPA$_OCTAL,,,, UIC_MEMBER),
	('*',,, 1^WILD_MEMBER, UIC_FLAGS)
	);

$STATE	(,
	(']', TPA$_EXIT, FINISH_UIC)
	);

!
! HELP command
!

$STATE	(DO_HELP,
	(TPA$_STRING,	DO_HELP,SAVE_KEY),
	((DO_QUALIFIER),DO_HELP,SAVE_KEY),
	('*',		DO_HELP,SAVE_KEY),
	((ELIPSIS),		DO_HELP,SAVE_KEY),
	(TPA$_LAMBDA,	MORE,ACT_HELP)
	);

$STATE	(DO_QUALIFIER,
	('/')
	);

$STATE	(,
	('PERMQUOTA',	TPA$_EXIT),
	('OVERDRAFT',	TPA$_EXIT),
	(TPA$_STRING,	TPA$_EXIT)
	);

$STATE	(ELIPSIS,
	('.')
	);

$STATE	(,
	('.')
	);

$STATE	(,
	('.', TPA$_EXIT)
	);


!
! Set up a channel to the default disk, if it is defined.
!

ENABLE MAIN_HANDLER;

USE_DEFAULT ();

!
! Set up the exit handler descriptor and declare the handler.
!

EXIT_HNDLR_DESC[XHNDLR_ADDRESS] = EXIT_HANDLER;
EXIT_HNDLR_DESC[XHNDLR_ARGCNT]  = 1;
EXIT_HNDLR_DESC[XHNDLR_STSADDR] = EXIT_HNDLR_DESC[XHNDLR_STSADDR+1];

$DCLEXH (DESBLK=EXIT_HNDLR_DESC);

! Acquire a command line, convert to upper case, and parse it. Command
! processing is actually done by parser action routines. If a syntax error
! occurrs, output an error message. Errors occurring during the command
! processsing are signalled at that time.
!

WHILE 1 DO
BEGIN

COMMAND_DESC[0] = COMMAND_LENGTH;
STATUS = LIB$GET_INPUT (COMMAND_DESC, DESCRIPTOR ('DISKQ>'));
IF NOT .STATUS
THEN
    BEGIN
    IF .STATUS NEQ RMS$_EOF
    THEN ERR_MESSAGE (DSKQ$_CMD_ERR, .STATUS);
    RETURN 1;
    END;

CH$TRANSLATE (UPCASE_TABLE, .COMMAND_DESC[0], .COMMAND_DESC[1], 0,
		.COMMAND_DESC[0], .COMMAND_DESC[1]);
P = .COMMAND_DESC[0] + .COMMAND_DESC[1];
UNTIL CH$RCHAR (.P-1) NEQ ' '
DO P = .P - 1;
COMMAND_DESC[0] = .P - .COMMAND_DESC[1];

CH$FILL (0, ZERO_LENGTH, ZERO_AREA);
TPARSE_BLOCK[TPA$L_STRINGCNT] = .COMMAND_DESC[0];
TPARSE_BLOCK[TPA$L_STRINGPTR] = .COMMAND_DESC[1];
STATUS = LIB$TPARSE (TPARSE_BLOCK, STATE_TABLE, KEY_TABLE);
IF NOT .STATUS
THEN
    BEGIN
    IF .STATUS EQL LIB$_SYNTAXERR
    THEN STATUS = DSKQ$_SYNTAX;
    ERR_MESSAGE (.STATUS,
		 .TPARSE_BLOCK[TPA$L_TOKENPTR] - .COMMAND_DESC[1],
		 .COMMAND_DESC[1],
		 .TPARSE_BLOCK[TPA$L_TOKENCNT],
		 .TPARSE_BLOCK[TPA$L_TOKENPTR],
		 .TPARSE_BLOCK[TPA$L_STRINGCNT] - .TPARSE_BLOCK[TPA$L_TOKENCNT],
		 .TPARSE_BLOCK[TPA$L_STRINGPTR] + .TPARSE_BLOCK[TPA$L_TOKENCNT]
		);
    END;

IF .CLEANUP_FLAGS[CLF_EXIT]		! if EXIT command encountered
THEN RETURN 1				! then exit DISK_QUOTA

END;					! end of command loop

1
END;					! end of routine DISK_QUOTA

!
! Minor action routines to help out with parsing
!

!
! Give invalid command status
!

ROUTINE INV_COMMAND =

BEGIN
TPARSE_ARGS;

ERR_EXIT ((IF .TPARSE_BLOCK[TPA$V_AMBIG]
	   THEN DSKQ$_AMB_CMD
	   ELSE DSKQ$_INV_CMD),
	  .TPARSE_BLOCK[TPA$L_TOKENPTR] - .COMMAND_DESC[1],
	  .COMMAND_DESC[1],
	  .TPARSE_BLOCK[TPA$L_TOKENCNT],
	  .TPARSE_BLOCK[TPA$L_TOKENPTR],
	  .TPARSE_BLOCK[TPA$L_STRINGCNT],
	  .TPARSE_BLOCK[TPA$L_STRINGPTR]
	 )
END;

!
! Give invalid switch status
!

ROUTINE INV_SWITCH =

BEGIN
TPARSE_ARGS;

ERR_EXIT ((IF .TPARSE_BLOCK[TPA$V_AMBIG]
	   THEN DSKQ$_AMB_QUAL
	   ELSE DSKQ$_INV_QUAL),
	  .TPARSE_BLOCK[TPA$L_TOKENPTR] - .COMMAND_DESC[1],
	  .COMMAND_DESC[1],
	  .TPARSE_BLOCK[TPA$L_TOKENCNT],
	  .TPARSE_BLOCK[TPA$L_TOKENPTR],
	  .TPARSE_BLOCK[TPA$L_STRINGCNT],
	  .TPARSE_BLOCK[TPA$L_STRINGPTR]
	 )
END;

!
! Assemble and validate UIC
!

ROUTINE FINISH_UIC =

BEGIN

IF .UIC_MEMBER<16,16> NEQ 0
OR .UIC_GROUP<16,16> NEQ 0
THEN RETURN DSKQ$_INV_UIC;

UIC_VALUE<00,16> = .UIC_MEMBER<0,16>;
UIC_VALUE<16,16> = .UIC_GROUP<0,16>;
1
END;

!
! Save the HELP key descriptor in the key descriptor vector.
!

ROUTINE SAVE_KEY =

BEGIN

IF .KEY_INDEX LEQ (MAX_KEYS - 2)		! check for too many keys
THEN 						
    BEGIN
    KEY_VECTOR[.KEY_INDEX]   = .TPARSE_BLOCK[TPA$L_TOKENCNT];
    KEY_VECTOR[.KEY_INDEX+1] = .TPARSE_BLOCK[TPA$L_TOKENPTR];
    KEY_INDEX = .KEY_INDEX+2;			! increment KEY_INDEX
    END;
1
END;

GLOBAL ROUTINE USE_DEFAULT : NOVALUE =

!++
!
! Functional Description:
!
!	This routine causes a USE SYS$DISK: command to be executed, to
!	set up the channel to the default disk. If it fails, no error
!	messages are output and the channel is simply left unassigned.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

BUILTIN
	CALLG;				! linkage to action routines is CALLG


! Enable the local condition handler to swallow error signals. Then plug
! the TPARSE control block and call the USE action routine.
!

ENABLE DEF_HANDLER;

TPARSE_BLOCK[TPA$L_TOKENCNT] = %CHARCOUNT ('SYS$DISK:');
TPARSE_BLOCK[TPA$L_TOKENPTR] = UPLIT BYTE ('SYS$DISK:');
CALLG (TPARSE_BLOCK, ACT_USE);

END;					! end of routine USE_DEFAULT

GLOBAL ROUTINE DEF_HANDLER (SIGNAL, MECHANISM) : NOVALUE =

!++
!
! Functional Description:
!
!	This routine is the condition handler for the preceding routine.
!	It simply unwinds the stack on any signal.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

MAP
	SIGNAL		: REF BBLOCK,	! signal vector
	MECHANISM	: REF BBLOCK;	! mechanism vector


$UNWIND ();

END;					! end of routine DEF_HANDLER

GLOBAL ROUTINE ACT_USE =

!++
!
! Functional Description:
!
!	This action routine processes the USE command. It assigns a channel
!	to the specified device string.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

LITERAL
	BUFFER_LEN	= 64;		! string buffer length

LOCAL
	P,				! general string pointer
	STATUS,				! general status value
	NAME_DESC	: VECTOR [2],	! descriptor of logical name to translate
	RESULT		: VECTOR [2],	! descriptor of translated name
	STRING_BUFFER	: VECTOR [BUFFER_LEN, BYTE]; ! string buffer (obviously)

TPARSE_ARGS;				! declare TPARSE argument list


! Get the device name string and attempt to do logical name translation.
! We iterate on logical name translation until the service returns SS$_NOTRAN.
! Perform device name extraction by using only the part of the logical name to
! the left of the colon (if any), also checking for node names.
!

IF .CHANNEL NEQ 0
THEN $DASSGN (CHAN = .CHANNEL);
CHANNEL = 0;

RESULT[0] = BUFFER_LEN;
RESULT[1] = STRING_BUFFER;
NAME_DESC[0] = .TPARSE_BLOCK[TPA$L_TOKENCNT];		! get initial logical name
NAME_DESC[1] = STRING_BUFFER;
CH$COPY (.TPARSE_BLOCK[TPA$L_TOKENCNT], .TPARSE_BLOCK[TPA$L_TOKENPTR], 0, .RESULT[0], .RESULT[1]);

IF BEGIN
DECR N FROM 10 TO 1 DO
    BEGIN
    P = CH$FIND_CH (.NAME_DESC[0], .NAME_DESC[1], ':');
    IF NOT CH$FAIL (.P)
    THEN
	BEGIN
	IF .P - .NAME_DESC[1] LSSU .NAME_DESC[0] - 1
	AND .(.P)<0,16> EQL '::'
	THEN ERR_EXIT (DSKQ$_NONLOCAL);
	NAME_DESC[0] = .P - .NAME_DESC[1];
	END;

    IF CH$RCHAR (.NAME_DESC[1]) EQL '_'
    THEN EXITLOOP 0;

    STATUS = $TRNLOG (LOGNAM = NAME_DESC[0],
		      RSLLEN = NAME_DESC[0],
		      RSLBUF = RESULT[0]);
    IF .STATUS EQL SS$_NOTRAN THEN EXITLOOP 0;
    IF NOT .STATUS THEN ERR_EXIT (.STATUS);
    END
END
THEN ERR_EXIT (DSKQ$_NOTRAN);

RESULT[0] = .NAME_DESC[0];

! Now assign a channel to the device name.
!

STATUS = $ASSIGN (DEVNAM = RESULT[0], CHAN = CHANNEL);
IF NOT .STATUS
THEN ERR_EXIT (.STATUS);

1

END;					! end of routine ACT_USE

GLOBAL ROUTINE ACT_CREATE =

!++
!
! Functional Description:
!
!	This action routine implements the CREATE command. It creates the
!	disk quota file and activates it.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

EXTERNAL
	PIO$GW_DFPROT	: WORD ADDRESSING_MODE (ABSOLUTE);
					! default file protection word

OWN
	FILE_PROT	: WORD;		! local storage for file protection

BIND					! initial quota file entry
	QFILE_DATA	= UPLIT (1, 0, 0, 1000, 100, REP 123 OF (0));

PSECT
	PLIT		= $OWN$;

BIND					! quota file attribute list
	CREATE_ATTRIB	= UPLIT (WORD (FAT$C_LENGTH, ATR$C_RECATTR),
				UPLIT (BYTE (FAT$C_FIXED, 0), WORD (DQF$C_LENGTH),
					1^16, 2^16, WORD (0, 0, DQF$C_LENGTH, 0)),
				WORD (ATR$S_FPRO, ATR$C_FPRO),
				FILE_PROT,
				0);

PSECT
	PLIT		= $PLIT$;

LOCAL
	STATUS;				! general status value


! Verify that a channel is open.
!

IF .CHANNEL EQL 0
THEN ERR_EXIT (DSKQ$_NODEVICE);

! Create the quota file.
!

QUOTA_FIB[FIB$W_DID_NUM] = FID$C_MFD;
QUOTA_FIB[FIB$W_DID_SEQ] = FID$C_MFD;
QUOTA_FIB[FIB$W_DID_RVN] = 1;
QUOTA_FIB[FIB$L_ACCTL] = FIB$M_WRITE OR FIB$M_NOREAD;
QUOTA_FIB[FIB$W_EXCTL] = FIB$M_EXTEND OR FIB$M_ALCON OR FIB$M_FILCON;
QUOTA_FIB[FIB$L_EXSZ] = 1;
QUOTA_FIB[FIB$B_ALALIGN] = FIB$C_LBN;
QUOTA_FIB[FIB$W_LOC_RVN] = 1;
FILE_PROT = .PIO$GW_DFPROT;

STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_CREATE OR IO$M_CREATE OR IO$M_ACCESS,
		IOSB = IO_STATUS,
		P1   = QFIB_DESC,
		P2   = QFILE_NAME,
		P5   = CREATE_ATTRIB
		);
IF .STATUS THEN STATUS = .IO_STATUS[0];
IF NOT .STATUS
THEN ERR_EXIT (DSKQ$_CREATERR, .STATUS);

! Write the initial data block and close the file.
!

STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_WRITEVBLK,
		IOSB = IO_STATUS,
		P1   = QFILE_DATA,
		P2   = 512,
		P3   = 1
		);
IF .STATUS THEN STATUS = .IO_STATUS[0];
IF NOT .STATUS
THEN ERR_EXIT (DSKQ$_INITERR, .STATUS);

STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_DEACCESS,
		IOSB = IO_STATUS
		);
IF .STATUS THEN STATUS = .IO_STATUS[0];
IF NOT .STATUS
THEN ERR_EXIT (DSKQ$_CLOSERR, .STATUS);

! Now activate the quota file.
!

QUOTA_FIB[FIB$W_DID_NUM] = 0;
QUOTA_FIB[FIB$W_DID_SEQ] = 0;
QUOTA_FIB[FIB$W_DID_RVN] = 0;
QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_ENA_QUOTA;
QUOTA_FIB[FIB$L_CNTRLVAL] = 0;
STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_ACPCONTROL,
		IOSB = IO_STATUS,
		P1   = QFIB_DESC
		);
IF .STATUS THEN STATUS = .IO_STATUS[0];
IF NOT .STATUS
THEN ERR_EXIT (DSKQ$_ACTERR, .STATUS);

1
END;					! end of routine ACT_CREATE

GLOBAL ROUTINE ACT_ENABLE =

!++
!
! Functional Description:
!
!	This action routine implements the ENABLE command. It enables the
!	disk quota file.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN


LOCAL
	STATUS;				! general status value


! Verify that a channel is open.
!

IF .CHANNEL EQL 0
THEN ERR_EXIT (DSKQ$_NODEVICE);

! Now activate the quota file.
!

QUOTA_FIB[FIB$W_DID_NUM] = FID$C_MFD;
QUOTA_FIB[FIB$W_DID_SEQ] = FID$C_MFD;
QUOTA_FIB[FIB$W_DID_RVN] = 1;
QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_ENA_QUOTA;
STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_ACPCONTROL,
		IOSB = IO_STATUS,
		P1   = QFIB_DESC,
		P2   = QFILE_NAME
		);
IF .STATUS THEN STATUS = .IO_STATUS[0];
IF NOT .STATUS
THEN ERR_EXIT (DSKQ$_ACTERR, .STATUS);

1
END;					! end of routine ACT_ENABLE

GLOBAL ROUTINE ACT_DISABLE =

!++
!
! Functional Description:
!
!	This action routine implements the DISABLE command. It disables the
!	disk quota file.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN


LOCAL
	STATUS;				! general status value


! Verify that a channel is open.
!

IF .CHANNEL EQL 0
THEN ERR_EXIT (DSKQ$_NODEVICE);

! Now deactivate the quota file.
!

QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_DSA_QUOTA;
QUOTA_FIB[FIB$L_CNTRLVAL] = 0;
STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_ACPCONTROL,
		IOSB = IO_STATUS,
		P1   = QFIB_DESC
		);
IF .STATUS THEN STATUS = .IO_STATUS[0];
IF NOT .STATUS
THEN ERR_EXIT (DSKQ$_DACTERR, .STATUS);

1
END;					! end of routine ACT_DISABLE

GLOBAL ROUTINE ACT_ADD =

!++
!
! Functional Description:
!
!	This action routine implements the ADD command. It adds the
!	specified entry to the quota file.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN


LOCAL
	STATUS;				! general status value


! Verify that a channel is open.
!

IF .CHANNEL EQL 0
THEN ERR_EXIT (DSKQ$_NODEVICE);

! If either value is not specified, read the default record and copy its
! values into the unspecified fields.
!

IF NOT .UIC_FLAGS[PERM_SPEC]
OR NOT .UIC_FLAGS[OVER_SPEC]
THEN
    BEGIN
    QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_EXA_QUOTA;
    QUOTA_FIB[FIB$L_CNTRLVAL] = 0;
    QUOTA_FIB[FIB$L_WCC] = 0;
    STATUS = $QIOW (CHAN = .CHANNEL,
		    FUNC = IO$_ACPCONTROL,
		    IOSB = IO_STATUS,
		    P1   = QFIB_DESC,
		    P2   = DSTREC_DESC,
		    P4   = DSTREC_DESC
		    );
    IF NOT .UIC_FLAGS[PERM_SPEC]
    THEN PERM_VALUE = .DST_REC[DQF$L_PERMQUOTA];
    IF NOT .UIC_FLAGS[OVER_SPEC]
    THEN OVER_VALUE = .DST_REC[DQF$L_OVERDRAFT];
    END;

! Issue the ADD function call.
!

QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_ADD_QUOTA;
QUOTA_FIB[FIB$L_CNTRLVAL] = 0;
QUOTA_FIB[FIB$L_WCC] = 0;
STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_ACPCONTROL,
		IOSB = IO_STATUS,
		P1   = QFIB_DESC,
		P2   = SRCREC_DESC
		);
IF .STATUS THEN STATUS = .IO_STATUS[0];
IF NOT .STATUS
THEN ERR_EXIT (DSKQ$_ADDERR, .STATUS);

1
END;					! end of routine ACT_ADD

GLOBAL ROUTINE ACT_REMOVE =

!++
!
! Functional Description:
!
!	This action routine implements the REMOVE command. It removes the
!	specified entry from the quota file.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN


LOCAL
	STATUS;				! general status value


! Verify that a channel is open.
!

IF .CHANNEL EQL 0
THEN ERR_EXIT (DSKQ$_NODEVICE);

! Loop for all matching entries in the quota file, making a call to
! remove each.
!

QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_REM_QUOTA;
QUOTA_FIB[FIB$L_CNTRLVAL] = .UIC_FLAGS;
QUOTA_FIB[FIB$L_WCC] = 0;

INCR J FROM 0
DO
    BEGIN

    STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_ACPCONTROL,
		IOSB = IO_STATUS,
		P1   = QFIB_DESC,
		P2   = SRCREC_DESC,
		P4   = DSTREC_DESC
		);
    IF .STATUS THEN STATUS = .IO_STATUS[0];
    IF .STATUS
    THEN
	BEGIN
	IF .STATUS EQL SS$_OVRDSKQUOTA
	THEN ERR_MESSAGE (DSKQ$_INUSE,
			  .(DST_REC[DQF$L_UIC])<16,16>,
			  .(DST_REC[DQF$L_UIC])<00,16>,
			  .DST_REC[DQF$L_USAGE]);
	END
    ELSE
	BEGIN
	IF .STATUS EQL SS$_NODISKQUOTA
	AND .J NEQ 0
	THEN EXITLOOP;
	ERR_EXIT (DSKQ$_REMOVERR, .STATUS);
	END;

    IF NOT .UIC_FLAGS[WILD_GROUP]
    AND NOT .UIC_FLAGS[WILD_MEMBER]
    THEN EXITLOOP;			! done if no wild cards

    END;				! end of loop

1
END;					! end of routine ACT_REMOVE

GLOBAL ROUTINE ACT_SHOW =

!++
!
! Functional Description:
!
!	This action routine implements the SHOW command. It lists
!	UIC, quota, and usage of the indicated entries to SYS$OUTPUT.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

BIND
	LISTING_HEADER	= DESCRIPTOR ('     UIC          Usage        Permanent Quota   Overdraft Limit'),
	MULTI_FORMAT	= DESCRIPTOR ('!18<[!OW,!OW]!>!13<!UL!>!18<!UL!>!13<!UL!>'),
	SINGLE_FORMAT	= DESCRIPTOR ('UIC [!OW,!OW] has !UL blocks used!/of !UL authorized, !UL permitted overdraft.');


LOCAL
	STATUS;				! general status value

EXTERNAL ROUTINE
	LIB$PUT_OUTPUT	: ADDRESSING_MODE (GENERAL);


! Verify that a channel is open.
!

IF .CHANNEL EQL 0
THEN ERR_EXIT (DSKQ$_NODEVICE);

! Loop for all matching entries in the quota file, making a call to
! examine each.
!

QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_EXA_QUOTA;
QUOTA_FIB[FIB$L_CNTRLVAL] = .UIC_FLAGS;
QUOTA_FIB[FIB$L_WCC] = 0;

IF .UIC_FLAGS[WILD_GROUP]
OR .UIC_FLAGS[WILD_MEMBER]
THEN LIB$PUT_OUTPUT (LISTING_HEADER);

INCR J FROM 0
DO
    BEGIN

    STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_ACPCONTROL,
		IOSB = IO_STATUS,
		P1   = QFIB_DESC,
		P2   = SRCREC_DESC,
		P4   = DSTREC_DESC
		);
    IF .STATUS THEN STATUS = .IO_STATUS[0];
    IF NOT .STATUS
    THEN
	BEGIN
	IF .STATUS EQL SS$_NODISKQUOTA
	AND .J NEQ 0
	THEN EXITLOOP;
	ERR_EXIT (DSKQ$_EXAMINERR, .STATUS);
	END;

! Format a listing line and output it.
!

    OUTPUT_DESC[0] = OUTPUT_LENGTH;
    $FAO (
	(
	IF .UIC_FLAGS[WILD_GROUP]
	OR .UIC_FLAGS[WILD_MEMBER]
	THEN MULTI_FORMAT
	ELSE SINGLE_FORMAT),
	OUTPUT_DESC[0],
	OUTPUT_DESC[0],
	.(DST_REC[DQF$L_UIC])<16,16>,
	.(DST_REC[DQF$L_UIC])<00,16>,
	.DST_REC[DQF$L_USAGE],
	.DST_REC[DQF$L_PERMQUOTA],
	.DST_REC[DQF$L_OVERDRAFT]
	);

    LIB$PUT_OUTPUT (OUTPUT_DESC[0]);

    IF NOT .UIC_FLAGS[WILD_GROUP]
    AND NOT .UIC_FLAGS[WILD_MEMBER]
    THEN EXITLOOP;			! done if no wild cards

    END;				! end of loop

1
END;					! end of routine ACT_SHOW

GLOBAL ROUTINE ACT_MODIFY =

!++
!
! Functional Description:
!
!	This action routine implements the MODIFY command. It modifies the
!	specified entry of the quota file as specified.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN


LOCAL
	STATUS;				! general status value


! Verify that a channel is open.
!

IF .CHANNEL EQL 0
THEN ERR_EXIT (DSKQ$_NODEVICE);

! Loop for all matching entries in the quota file, making a call to
! modify each.
!

QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_MOD_QUOTA;
QUOTA_FIB[FIB$L_CNTRLVAL] = .UIC_FLAGS;
QUOTA_FIB[FIB$L_WCC] = 0;

INCR J FROM 0
DO
    BEGIN

    STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_ACPCONTROL,
		IOSB = IO_STATUS,
		P1   = QFIB_DESC,
		P2   = SRCREC_DESC,
		P4   = DSTREC_DESC
		);
    IF .STATUS THEN STATUS = .IO_STATUS[0];
    IF .STATUS
    THEN
	BEGIN
	IF .STATUS EQL SS$_OVRDSKQUOTA
	THEN ERR_MESSAGE (DSKQ$_INUSE,
			  .(DST_REC[DQF$L_UIC])<16,16>,
			  .(DST_REC[DQF$L_UIC])<00,16>,
			  .DST_REC[DQF$L_USAGE]);
	END
    ELSE
	BEGIN
	IF .STATUS EQL SS$_NODISKQUOTA
	AND .J NEQ 0
	THEN EXITLOOP;
	ERR_EXIT (DSKQ$_MODIFYERR, .STATUS);
	END;

    IF NOT .UIC_FLAGS[WILD_GROUP]
    AND NOT .UIC_FLAGS[WILD_MEMBER]
    THEN EXITLOOP;			! done if no wild cards

    END;				! end of loop

1
END;					! end of routine ACT_MODIFY

GLOBAL ROUTINE ACT_REBUILD =

!++
!
! Functional Description:
!
!	This routine implements the REBUILD command. It scans the index file
!	of each volume in the volume set and constructs a table of UIC's
!	and blocks used. It then updates the usage data in the quota file,
!	creating entries as needed so that all UIC's using blocks are listed.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

LOCAL
	STATUS;						! general status value

EXTERNAL ROUTINE
	REBUILD		: ADDRESSING_MODE (GENERAL);	! routine to do actual rebuild


! Verify that a channel is open.
!

IF .CHANNEL EQL 0
THEN ERR_EXIT (DSKQ$_NODEVICE);

! Enable the quota file, just in case it is off.
!

QUOTA_FIB[FIB$W_DID_NUM] = FID$C_MFD;
QUOTA_FIB[FIB$W_DID_SEQ] = FID$C_MFD;
QUOTA_FIB[FIB$W_DID_RVN] = 1;
QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_ENA_QUOTA;
STATUS = $QIOW (CHAN = .CHANNEL,
		FUNC = IO$_ACPCONTROL,
		IOSB = IO_STATUS,
		P1   = QFIB_DESC,
		P2   = QFILE_NAME
		);
IF .STATUS THEN STATUS = .IO_STATUS[0];
IF NOT .STATUS
AND .STATUS NEQ SS$_QFACTIVE
THEN ERR_EXIT (DSKQ$_ACTERR, .STATUS);

! Now call the rebuild routine.
!

REBUILD (.CHANNEL, 1);

1
END;					! end of routine ACT_REBUILD

GLOBAL ROUTINE ACT_HELP =
!++
!
! Functional Description:
!
!	This routine is the DISKQUOTA help facility, and will display
!	useful and informative explanations of the DISKQUOTA facility.
!
!	To speed things up, the help library is opened only once, and
!	is closed by the OS during image rundown.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!
!	This routine expects the keys used to access the help text to
!	be in KEY_VECTOR[0..MAX_KEYS].
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!
!	The help text will be printed on SYS$OUTPUT.
!
! Routines Called:
!
!	LBR$INI_CONTROL
!	LBR$OPEN
!	LBR$GET_HELP
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

EXTERNAL ROUTINE

	LBR$INI_CONTROL	: ADDRESSING_MODE(GENERAL),
	LBR$OPEN	: ADDRESSING_MODE(GENERAL),
	LBR$GET_HELP	: ADDRESSING_MODE(GENERAL);

BIND

	HELP_DEFNAME	= DESCRIPTOR ('SYS$HELP:.HLB'),	! default helpfile name
	LIBRARY_NAME	= DESCRIPTOR ('DISKQUOTA');	! HELP text library

OWN

	HELP_FUNCTION	: INITIAL (LBR$C_READ),
	HELP_TYPE	: INITIAL (LBR$C_TYP_HLP),	! declare lib a HELP lib
	HELP_LIBINDEX	: LONG,				! pointer to lib index
	LIBRARY_OPEN	: LONG;				! used as a boolean

LOCAL

	STATUS;						! used as boolean

!
! Check to see if HELPLIB is already OPENed.  If it is, skip the
! OPENing code and get right to the HELP text retrieval.
!

IF NOT (.LIBRARY_OPEN) 
THEN
    BEGIN
    IF NOT (STATUS = LBR$INI_CONTROL (HELP_LIBINDEX, HELP_FUNCTION, HELP_TYPE))
    THEN
	ERR_EXIT (DSKQ$_HELP_INIT, .STATUS);

    IF NOT (STATUS = LBR$OPEN (HELP_LIBINDEX, LIBRARY_NAME, 0, HELP_DEFNAME))
    THEN
	ERR_EXIT (DSKQ$_HELP_OPEN, .STATUS);

    LIBRARY_OPEN = 1;					! flag library open
    END;

!
! Get and display the HELP text.  LBR$GET_HELP will call LIB$PUT_OUTPUT
! to print the HELP text.
!
IF NOT (STATUS = LBR$GET_HELP (HELP_LIBINDEX, 0, 0, 0, KEY_VECTOR[0],
						       KEY_VECTOR[2],
					               KEY_VECTOR[4],
						       KEY_VECTOR[6],
						       KEY_VECTOR[8],
						       KEY_VECTOR[10],
						       KEY_VECTOR[12]))
THEN
    ERR_EXIT (DSKQ$_HELP_TEXT, .STATUS);

1
END;						! end of routine ACT_HELP

GLOBAL ROUTINE MAIN_HANDLER (SIGNAL_VEC, MECHANISM) =

!++
!
! Functional Description:
!
!	This routine is the main condition handler for the DISKQUOTA utility.
!	It receives a signal which is either an internal error code or a
!	standard system status. If the former, the appropriate message is
!	formatted and printed. For the latter, the condition is simply
!	resignalled.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

MAP
	SIGNAL_VEC		: REF BBLOCK,	! signal vector arg
	MECHANISM	: REF BBLOCK;	! mechanism vector arg

LOCAL
	FORMAT_DESC	: VECTOR [2],	! string descriptor for message format
	P		: REF VECTOR [,BYTE], ! string pointer
	ERR_CODE	: BBLOCK [4];	! error status code

EXTERNAL ROUTINE
	LIB$PUT_OUTPUT	: ADDRESSING_MODE (GENERAL);


! Get the signal code. If it is one of ours, get the message string and
! do formatting as necessary.
!

ERR_CODE = .SIGNAL_VEC[CHF$L_SIG_NAME];
IF .ERR_CODE[STS$V_FAC_NO] EQL FAC_CODE
THEN
    BEGIN
    ERR_CODE = .ERR_CODE[STS$V_MSG_NO];
    P = .MESSAGE_TABLE[.ERR_CODE];
    FORMAT_DESC[0] = .P[1];
    FORMAT_DESC[1] = .P + 2;
    OUTPUT_DESC[0] = OUTPUT_LENGTH;

    $FAOL (CTRSTR = FORMAT_DESC[0],
	   OUTLEN = OUTPUT_DESC[0],
	   OUTBUF = OUTPUT_DESC[0],
	   PRMLST = SIGNAL_VEC[CHF$L_SIG_ARG1]
	   );
    LIB$PUT_OUTPUT (OUTPUT_DESC);

! If there is a signal argument remaining, it is a system error status.
! Convert its severity to error and signal it.
!

    ERR_CODE = 0;
    IF .SIGNAL_VEC[CHF$L_SIG_ARGS] GTRU .P[0] + 3
    THEN
	BEGIN
	ERR_CODE = .VECTOR [SIGNAL_VEC[CHF$L_SIG_ARG1], .P[0]];
	END;
    END;

IF .ERR_CODE NEQ 0
THEN
    BEGIN
    ERR_CODE[STS$V_SEVERITY] = STS$K_ERROR;
    SIGNAL (.ERR_CODE);
    END;

MECHANISM[CHF$L_MCH_SAVR0] = 1;
IF .BBLOCK [SIGNAL_VEC[CHF$L_SIG_NAME], STS$V_SEVERITY] EQL STS$K_SEVERE
THEN
    BEGIN
    $QIOW (CHAN = .CHANNEL,
	   FUNC = IO$_DEACCESS);

    $UNWIND (DEPADR = MECHANISM[CHF$L_MCH_DEPTH]);
    END;

RETURN SS$_CONTINUE;

END;					! end of routine MAIN_HANDLER

GLOBAL ROUTINE EXIT_HANDLER: NOVALUE =

!++
!
! Fucntional Description:
!
!	This routine is called by the OS on exit (for whatever reason) from
!	the DISKQUOTA utility.  This routine must ensure that DISKQUOTA did
!	not leave things in an awkward state.
!
! Calling Sequence:
!	standard
!
! Input Parameters:
!	none
!
! Implicit Inputs:
!	none
!
! Output Parameters:
!	none
!
! Implicit Outputs:
!	none
!
! Routines Called:
!	none
!
! Routine Value:
!	none
!
! Signals:
!	none
!
! Side Effects:
!	none
!
!--

BEGIN

!
! Make sure that DISKQUOTA did not leave a volume LOCKED.
!

IF .CLEANUP_FLAGS[CLF_UNLOCK]
THEN
    BEGIN
    CH$FILL (0, FIB$C_LENGTH, QUOTA_FIB);
    QUOTA_FIB[FIB$W_CNTRLFUNC] = FIB$C_UNLK_VOL;
    $QIOW (CHAN = .CHANNEL,
       FUNC = IO$_ACPCONTROL,
       P1   = QFIB_DESC
       );
    END;

END;					! end of routine EXIT_HANDLER

GLOBAL ROUTINE COMMON_IO (EFN,CHAN,FUNC,IOSTS,ASTADR,ASTPRM,P1,P2,P3,P4,P5,P6)=

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine simply executes a $QIOW call with the parameters
!	supplied.
!
! CALLING SEQUENCE:
!	COMMON_IO (EFN,CHAN,FUNC,IOSTS,ASTADR,ASTPRM,P1,P2,P3,P4,P5,P6)
!
! INPUT PARAMETERS:
!	As to $QIOW
!
! IMPLICIT INPUTS:
!	NONE
!
! OUTPUT PARAMETERS:
!	NONE
!
! IMPLICIT OUTPUTS:
!	NONE
!
! ROUTINE VALUE:
!	As to $QIOW
!
! SIDE EFFECTS:
!	As to $QIOW
!
!--

BEGIN

BUILTIN
	AP,
	CALLG;

EXTERNAL ROUTINE
	SYS$QIOW	: ADDRESSING_MODE (GENERAL);


! We simply pass the call and its parameters along to $QIOW.
!

CALLG (.AP, SYS$QIOW)

END;					! End of routine COMMON_IO

END
ELUDOM