! ----- SET_PROTECTION.FUN -----
	!
	! ----- FUNCTION TO SET SPECIFIC PROTECTION ON FILE(S) -----
	!
	! ---------- PASSED: ----------
	!
	! -----		THE_FILES = Filespec to set protection on (Default
	! -----			    device of SYS$DISK)
	!
	! -----		PROTECTION_MASK = Protection Mask to be applied to file
	!
	!		----- THE MASK CONTAINS 16 BITS IN THE FOLLOWING -----
	!		----- FORMAT: -----
	!
	!		 D  E  W  R |  D  E  W  R |  D  E  W  R |  D  E  W  R
	!		<---WORLD-->|<---GROUP--->|<---OWNER--->|<--SYSTEM-->
	!		15 14 13 12 | 11 10  9  8 |  7  6  5  4 |  3  2  1  0
	!
	!		----- SETTING THE BIT DENIES THE CORRESPONDING -----
	!		----- ACCESS -----
	!
	! ---------- RETURNED: ----------
	!
	! -----		SET_PROTECTION returns system service exit status
	! -----				(SS$_NORMAL if successful)
	!
	! ----- Last Change 07/07/93 by Brian Lomasky -----
	!
	FUNCTION LONG SET_PROTECTION(STRING THE_FILES, WORD PROTECTION_MASK)

		%INCLUDE "NUSER.INC"
	%INCLUDE "$ATRDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$FABDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$FIBDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$IODEF"  %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$NAMDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$RMSDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"

		! ----- SYSTEM SERVICE ERROR CODES AND FUNCTION VALUES -----
		EXTERNAL LONG CONSTANT					&
			IO$_ACCESS		! ACP QIO ACCESS FUNCTION CODE
		EXTERNAL LONG CONSTANT					&
			IO$_MODIFY		! ACP QIO MODIFY FUNCTION CODE

		! ----- ATTRIBUTE LIST TEMPLATE -----
		RECORD ATTR_CONTROL_BLOCK
			WORD	ATTRIBUTE_SIZE	! NUMBER OF BYTES TO TRANSFER
			WORD	ATTRIBUTE_TYPE	! ATTRIBUTE TYPE TO READ/WRITE
			LONG	BUFFER_ADDRESS	! BUFFER ADDRESS OF ATTRIBUTE
			LONG	LIST_TERMINATOR	! ATTRIB CONTROL BLK TERMINATOR
		END RECORD ATTR_CONTROL_BLOCK

		! ----- FILE INFORMATION BLOCK (FIB) TEMPLATE -----
		RECORD FIB
			VARIANT
			CASE
				LONG	FIB$L_ACCTL	! ACCESS CONTROL FLAGS
			CASE
				STRING	FIB$$FILL_1 = 3%
				BYTE	FIB$B_WSIZE ! SIZE OF THE FILE WINDOW
			END VARIANT
			WORD	FIB$W_FID(2%)	! SPECIFIES THE FILE ID
			WORD	FIB$W_DID(2%)	! FILE ID OF THE DIRECTORY
			LONG	FIB$L_WCC	! MAINTAINS POSITION CONTEXT
			WORD	FIB$W_NMCTL	! FLAG BITS TO CONTROL NAME STR
		END RECORD FIB

		! ----- ACP-QIO ATTRIBUTE TEMPLATE FOR FILE PROTECTION -----
		RECORD FPRO
			WORD	THE_PROTECTION
		END RECORD FPRO

		DECLARE STRING A_FILE		! A SINGLE FILE SPECIFICATION
		DECLARE ATTR_CONTROL_BLOCK ATTR	! ATTRIBUTE LIST FOR PROTECTION
		DECLARE WORD CHAN		! I/O CHANNEL
		DECLARE STRING DEVICE_NAME	! DEVICE NAME WHERE FILE RESIDES
		DECLARE FABDEF FAB		! DEFINE THE FAB BLOCK
		DECLARE FPRO FILE_PROT		! FILE PROTECTION ATTRIBUTE
		DECLARE LONG FUNC		! FUNCTION CODE
		DIM WORD IOSB(3%)		! I/O STATUS BLOCK
		DECLARE LONG LOCAL_STATUS	! LOCAL SYSTEM SERVICE STATUS
		DECLARE NAMDEF NAM		! DEFINE THE NAM BLOCK
		DECLARE WORD RESULT_LEN		! LENGTH OF RESULT_SPEC
		DECLARE WORD TEMP		! TEMPORARY WORD VARIABLE

		! ----- MAP THE FIB STRUCTURE -----
		MAP (FIB_BUFFER) FIB	USER_FIB! SPECIFIES FORMAT OF FIB
		MAP (FIB_BUFFER) STRING	FIB_BUFF = 22%	! USED IN QIOW CALL

		! ----- FIXED-LENGTH STRINGS PASSED TO/FROM RMS -----
		MAP (FPARSE)	STRING SEARCH_SPEC = 255%,		&
				STRING EXPANDED_SPEC = 255%,		&
				STRING RESULT_SPEC = 255%

		EXTERNAL LONG FUNCTION GETFID(STRING BY DESC,		&
			WORD DIM() BY REF)	! GET FILE-ID SUBPROGRAM
		EXTERNAL LONG FUNCTION					&
			SYS$ASSIGN		! ASSIGN I/O CHANNEL TO A DEVICE
		EXTERNAL LONG FUNCTION					&
			SYS$DASSGN		! DEASSIGN I/O CHANNEL
		EXTERNAL LONG FUNCTION					&
			SYS$PARSE		! $PARSE SYSTEM SERVICE
		EXTERNAL LONG FUNCTION SYS$QIOW	! QUEUE I/O REQUEST AND WAIT
		EXTERNAL LONG FUNCTION					&
			SYS$SEARCH		! $SEARCH SYSTEM SERVICE

		! ----- INITIALIZE THE FILE PROTECTION ATTRIBUTES LIST -----
		ATTR::ATTRIBUTE_SIZE	= ATR$S_FPRO	! SIZE OF ATR$C_FPRO
		ATTR::ATTRIBUTE_TYPE	= ATR$C_FPRO	! RETURNS FILE PROT
		ATTR::BUFFER_ADDRESS	= LOC(FILE_PROT)! BUFFER TO STORE PROT
		ATTR::LIST_TERMINATOR	= 0%		! LIST TERMINATOR

		! ----- ASSIGN A CHANNEL TO THE DISK FOR THE $QIO CALL -----
		TEMP = POS(THE_FILES, ":", 1%)	! LOCATE ANY COLON
		IF TEMP = 0% THEN
			DEVICE_NAME = "SYS$DISK:"
		ELSE
			DEVICE_NAME = LEFT(THE_FILES, TEMP)
		END IF
		LOCAL_STATUS = SYS$ASSIGN(DEVICE_NAME, CHAN, , )
		IF LOCAL_STATUS <> SS$_NORMAL THEN
			PRINT "Error from SET_PROTECTION SYS$ASSIGN" + BEL
			! ----- RETURN ERROR STATUS -----
			SET_PROTECTION = LOCAL_STATUS
			EXIT FUNCTION
		END IF

		! ----- PERFORM A DIRECTORY LOOKUP FOR EACH OF THE -----
		! ----- PASSED FILES -----
		SEARCH_SPEC = THE_FILES		! STORE FILESPEC TO SEARCH FOR
		EXPANDED_SPEC = ""		! CLEAR EXPANDED FILESPEC
		RESULT_SPEC = ""		! CLEAR RESULTING FILESPEC

		! ----- SET UP THE FAB BLOCK -----
		FAB::FAB$B_BID = FAB$C_BID	! FAB BLOCK IDENTIFIER
		FAB::FAB$B_BLN = FAB$C_BLN	! FAB BLOCK LENGTH
		! ----- LOCATION OF FILESPEC TO SEARCH -----
		FAB::FAB$L_FNA = LOC(SEARCH_SPEC)
		FAB::FAB$B_FNS = LEN(THE_FILES)	! LENGTH OF FILESPEC TO SEARCH
		FAB::FAB$L_NAM = LOC(NAM)	! LOCATION OF NAM BLOCK

		! ----- SET UP THE NAM BLOCK -----
		NAM::NAM$B_BID = NAM$C_BID	! NAM BLOCK IDENTIFIER
		NAM::NAM$B_BLN = NAM$C_BLN	! NAM BLOCK LENGTH
		IF NAM$C_MAXRSS > 127% THEN
			! ----- SIZE OF RESULTING SPEC -----
			NAM::NAM$B_RSS = NAM$C_MAXRSS - 256%
		ELSE
			! ----- SIZE OF RESULTING SPEC -----
			NAM::NAM$B_RSS = NAM$C_MAXRSS
		END IF
		! ----- LOCATION OF RESULTING SPEC -----
		NAM::NAM$L_RSA = LOC(RESULT_SPEC)
		IF NAM$C_MAXRSS > 127% THEN
			! ----- SIZE OF EXPANDED SPEC -----
			NAM::NAM$B_ESS = NAM$C_MAXRSS - 256%
		ELSE
			! ----- SIZE OF EXPANDED SPEC -----
			NAM::NAM$B_ESS = NAM$C_MAXRSS
		END IF
		! ----- LOCATION OF EXPANDED SPEC -----
		NAM::NAM$L_ESA = LOC(EXPANDED_SPEC)

		LOCAL_STATUS = SYS$PARSE(FAB)	! GET INITIAL FILE INFORMATION
		IF LOCAL_STATUS <> RMS$_DNF THEN! IF DIRECTORY WAS FOUND:
			IF (LOCAL_STATUS AND 1%) = 0% THEN
				PRINT "Error from SET_PROTECTION" +	&
					" SYS$PARSE" + BEL
				! ----- RETURN ERROR STATUS -----
				SET_PROTECTION = LOCAL_STATUS
				EXIT FUNCTION
			END IF
			LOCAL_STATUS = RMS$_NORMAL! SO LOOP WILL WORK
		END IF
		WHILE LOCAL_STATUS = RMS$_NORMAL
			LOCAL_STATUS = SYS$SEARCH(FAB)

			! ----- DONE IF NO MORE FILES -----
			ITERATE IF LOCAL_STATUS = RMS$_NMF OR		&
				LOCAL_STATUS = RMS$_FNF

			IF LOCAL_STATUS <> RMS$_NORMAL THEN
				PRINT "Error from SET_PROTECTION" +	&
					" SYS$SEARCH" + BEL
				! ----- RETURN ERROR STATUS -----
				SET_PROTECTION = LOCAL_STATUS
				EXIT FUNCTION
			END IF

			! ----- EXTRACT THE RETURNED FILESPEC -----
			RESULT_LEN = NAM::NAM$B_RSL
			RESULT_LEN = RESULT_LEN + 256% IF RESULT_LEN < 0%
			A_FILE = LEFT(RESULT_SPEC, RESULT_LEN)

			IF DEBUG_MODE THEN
				PRINT "DEBUG>File: " + A_FILE
			END IF

			! ----- GET THE FILE-ID FOR THE FILE TO BE -----
			! ----- MODIFIED -----
			LOCAL_STATUS = GETFID(A_FILE, USER_FIB::FIB$W_FID())
			IF LOCAL_STATUS <> SS$_NORMAL THEN
				PRINT "Error " + NUM1$(LOCAL_STATUS) +	&
					" from GETFID for " + A_FILE + BEL
				! ----- SET SO LOOP WILL WORK -----
				LOCAL_STATUS = RMS$_NORMAL
				! ----- CONTINUE WITH NEXT FILE -----
				ITERATE
			END IF

			! ----- INITIATE A READ ATTRIBUTES OPERATION -----
			FUNC = IO$_ACCESS
			LOCAL_STATUS = SYS$QIOW( ,! EVENT FLAG		&
				CHAN BY VALUE,	! DEVICE I/O CHANNEL	&
				FUNC BY VALUE,	! DEVICE FUNCTION CODE	&
				IOSB() BY REF,	! I/O STATUS BLOCK	&
				,		! AST ADDRESS		&
				,		! AST PARAMETER		&
				FIB_BUFF BY DESC, ! ADDRESS OF FIB DESC	&
				,		! FILENAME STRING DESC	&
				,		! FILENAME STRING LENGTH&
				,		! FILENAME STRING DESC	&
				ATTR BY REF,	! ATTR CONTROL BLK ADDR	&
				)		! N/A
			LOCAL_STATUS = IOSB(0%) IF (LOCAL_STATUS AND 1%) = 1%
			IF (LOCAL_STATUS AND 1%) = 0% THEN
				PRINT "Error from SET_PROTECTION SYS$QIOW" + BEL
				! ----- RETURN ERROR STATUS -----
				SET_PROTECTION = LOCAL_STATUS
				EXIT FUNCTION
			END IF

			IF DEBUG_MODE THEN
				PRINT "DEBUG>File protection was ";	&
					FILE_PROT::THE_PROTECTION
			END IF

			! ----- SET THE FILE PROTECTION TO THE SPECIFIED -----
			! ----- PASSED PROTECTION MASK -----
			!
			FILE_PROT::THE_PROTECTION = PROTECTION_MASK

			FUNC = IO$_MODIFY
			LOCAL_STATUS = SYS$QIOW( ,! EVENT FLAG		&
				CHAN BY VALUE,	! DEVICE I/O CHANNEL	&
				FUNC BY VALUE,	! DEVICE FUNCTION CODE	&
				IOSB() BY REF,	! I/O STATUS BLOCK	&
				,		! AST ADDRESS		&
				,		! AST PARAMETER		&
				FIB_BUFF BY DESC, ! ADDRESS OF FIB DESC	&
				,		! FILENAME STRING DESC	&
				,		! FILENAME STRING LENGTH&
				,		! FILENAME STRING DESC	&
				ATTR BY REF,	! ATTR CONTROL BLK ADDR	&
				)		! N/A
			LOCAL_STATUS = IOSB(0%) IF (LOCAL_STATUS AND 1%) = 1%
			IF (LOCAL_STATUS AND 1%) = 0% THEN
				PRINT "Error from SET_PROTECTION" +	&
					" SYS$QIOW MODIFY" + BEL
				! ----- RETURN ERROR STATUS -----
				SET_PROTECTION = LOCAL_STATUS
				EXIT FUNCTION
			END IF

			IF DEBUG_MODE THEN
				PRINT "DEBUG>File protection has been"	&
					+ " changed to ";		&
					FILE_PROT::THE_PROTECTION
			END IF

			! ----- SET SO LOOP WILL WORK -----
			LOCAL_STATUS = RMS$_NORMAL
		NEXT

		! ----- DEASSIGN THE I/O CHANNEL -----
		LOCAL_STATUS = SYS$DASSGN(CHAN BY VALUE)
		IF LOCAL_STATUS <> SS$_NORMAL THEN
			PRINT "Error from SET_PROTECTION SYS$DASSGN" + BEL
			! ----- RETURN ERROR STATUS -----
			SET_PROTECTION = LOCAL_STATUS
			EXIT FUNCTION
		END IF

		SET_PROTECTION = SS$_NORMAL	! RETURN SUCCESS STATUS
	END FUNCTION