.TITLE	PROTEC
	.IDENT	/V01/
	.SBTTL	DESCRIPTION
;
;
;  COMPONENT:	PROTEC
;
;  DATE:	05-JUL-79
;
;  AUTHOR:	GR JOHNSON
;		BATTELLE NORTHWEST
;		P O BOX 999
;		RICHLAND WA 99352
;
;  SOURCE:	MACRO-11
;
;  CALLER:	FORTRAN IV-PLUS
;
;  CALLING SEQUENCE:
;
;		CALL PROTEC([PROTECT],[OWNER],[ISW])
;
;		PROTECT	= STRING SPECIFYING THE DEFAULT PROTECTION TO BE
;			  USED WHEN CREATING FILES.  THE STRING MUST BE
;			  TERMINATED BY AN ASCII NULL CHARACTER.
;
;			  THE DEFAULT FILE PROTECTION IS SPECIFIED IN THE
;			  FOLLOWING FORMAT:
;
;				(SYSTEM,OWNER,GROUP,WORLD)
;
;			  WHERE EACH OF THE FOUR USER CATAGORIES; SYSTEM,
;			  OWNER, GROUP AND WORLD, ARE ASSIGNED ACCESS 
;			  PRIVILEGES BY INCLUDING THE APPROPRIATE PROTEC-
;			  TION CODE(S) IN THE STRING;
;
;				R - READ
;				W - WRITE
;				E - EXTEND (EXECUTE)
;				D - DELETE
;
;			  FOR EXAMPLE, THE STRING '(RWED,RWED,RWED,R)' PROVIDES
;			  COMPLETE FILE ACCESS TO SYSTEM, OWNER AND GROUP USERS,
;			  AND READ-ONLY ACCESS TO ALL OTHERS.
;
;		OWNER	= STRING SPECIFYING THE DEFAULT FILE OWNER TO BE
;			  USED WHEN CREATING FILES.  THE STRING MUST BE
;			  TERMINATED BY AN ASCII NULL CHARACTER.
;
;			  THE DEFAULT FILE OWNER IS SPECIFIED IN THE FOLLOWING
;			  FORMAT;
;
;				[GROUP,USER]
;
;		ISW	= VARIABLE TO RECEIVE THE INTEGER STATUS WORD.
;
;			   00 = COMPLETE SUCCESS
;			  -01 = SYNTAX ERROR
;			  -02 = SET PROTECTION/OWN FAILURE
;
;
;  DESCRIPTION:
;
;	"PROTEC" SPECIFIES THE FILE PROTECTION AND OWNERSHIP TO BE ASSOCIATED
;  WITH ANY FILES CREATED BY THE PROGRAM FOLLOWING THE SUBROUTINE CALL.
;
;
;  EXAMPLE:
;
;		CALL PROTEC('(R,RWED,R,R)','[1,1]')
;		CALL OPEN(UNIT=1,NAME='READONLY.DAT',TYPE='NEW')
;
;
;  THE FILE CREATED IS OWNED BY THE SYSTEM AND MAY BE ACCESSED FOR READ-ONLY
;  BY ALL USERS OTHER THAN THE OWNER.
;
;

	.SBTTL	SYMBOL DEFINITIONS
;
;
					;
	.PSECT				;
					;
					;
DSDB:	.WORD	0,0			; DIRECTORY-STRING DESCRIPTOR BLOCK
					;
UICB:	.WORD	0			; UIC BUFFER
	.EVEN				;
					;

	.SBTTL	ENTRY POINT -- SET DEFAULT FILE PROTECTION AND OWNER
;
;
					;
PROTEC::				;
					;
PRO:	TST	2(R5)			; PROTECTION STRING SUPPLIED?
	BLT	OWN			; NO, SKIP SET PROTECTION
	MOV	2(R5),R0		; STRING ADDRESS TO R0
	CMPB	#'(,(R0)+		; '('?
	BNE	ERR1			; NO, RETURN ON SYNTAX ERROR
	CALL	PPARSE			; PARSE SYSTEM PROTECTION
	CMPB	#',,(R0)+		; ','?
	BNE	ERR1			; NO, RETURN ON SYNTAX ERROR
	CALL	PPARSE			; PARSE OWNER PROTECTION
	CMPB	#',,(R0)+		; ','?
	BNE	ERR1			; NO, RETURN ON SYNTAX ERROR
	CALL	PPARSE			; PARSE GROUP PROTECTION
	CMPB	#',,(R0)+		; ','?
	BNE	ERR1			; NO, RETURN ON SYNTAX ERROR
	CALL	PPARSE			; PARSE WORLD PROTECTION
	CMPB	#'),(R0)+		; ')'?
	BNE	ERR1			; NO, RETURN ON SYNTAX ERROR
	TSTB	(R0)			; END-OF-STRING?
	BNE	ERR1			; NO, RETURN ON SYNTAX ERROR
					;
	CALL	.WDFFP			; SET DEFAULT FILE-PROTECTION
	BCS	ERR2			; RETURN ON SET-PROTECT FAILURE
					;
					;
OWN:	CMPB	#2,(R5)			; TWO ARGUMENTS?
	BGT	ERR0			; NO, RETURN TO CALLER
	TST	4(R5)			; NULL ARGUMENT?
	BLT	ERR0			; YES RETURN TO CALLER
	CLR	R0			; CLEAR CHARACTER COUNT
	MOV	4(R5),R1		; UIC STRING ADDRESS TO R1
	MOV	#DSDB,R2		; DSDB ADDRESS TO R2
	MOV	#UICB,R3		; UIC BUFFER ADDRESS TO R3
					;
	MOV	R1,2(R2)		; STRING ADDRESS INTO DSDB
2$:	TSTB	(R1)+			; END-OF-STRING?
	BEQ	4$			; YES, BRANCH FROM SCAN
	INC	R0			; NO, INCREMENT CHARACTER COUNT
	BR	2$			; AND CONTINUE SCANNING FOR EOS
4$:	MOV	R0,(R2)			; STRING LENGTH INTO DSDB
					;
	CALL	.ASCPP			; CALL UIC CONVERSION
	BCS	ERR1			; RETURN ON SYNTAX ERROR
					;
	MOV	UICB,R1			; FILE-OWNER WORD TO R1
	CALL	.WFOWN			; SET DEFAULT FILE-OWNER
	BCS	ERR2			; RETURN ON SET-OWNER FAILURE
					;

	.SBTTL	PROCESS ERRORS AND RETURN TO CALLER
;
;
					;
ERR0:	CLR	R4			; CLEAR ISW
	BR	RTN			;
ERR1:	MOV	#-1,R4			; SYNTAX ERROR
	BR	RTN			;
ERR2:	MOV	#-2,R4			; SET PROTECT/OWNER FAILURE
					;
					;
RTN:	CMPB	#3,(R5)			; THREE ARGUMENTS?
	BGT	2$			; NO, RETURN TO CALLER
	TST	6(R5)			; NULL ARGUMENT?
	BLT	2$			; YES, RETURN TO CALLER
	MOV	R4,@6(R5)		; NO, RETURN STATUS
2$:	RTS	PC			; RETURN TO CALLER
					;

	.SBTTL	PPARSE ENTRY POINT -- PARSE PROTECTION STRING
;
;
					;
PPARSE:					;
					;
	ASR	R1			; SHIFT PROTECTION WORD
	BIS	#100000,R1		; SET PROTECTION BIT
	CMPB	#'R,(R0)		; READ ALLOWED?
	BNE	.+10			; NO, BRANCH AHEAD
	BIC	#100000,R1		; YES, CLEAR PROTECTION BIT
	INC	R0			; AND INCREMENT STRING ADDRESS
					;
	ASR	R1			; SHIFT PROTECTION WORD
	BIS	#100000,R1		; SET PROTECTION BIT
	CMPB	#'W,(R0)		; WRITE ALLOWED?
	BNE	.+10			; NO, BRANCH AHEAD
	BIC	#100000,R1		; YES, CLEAR PROTECTION BIT
	INC	R0			; AND INCREMENT STRING ADDRESS
					;
	ASR	R1			; SHIFT PROTECTION WORD
	BIS	#100000,R1		; SET PROTECTION BIT
	CMPB	#'E,(R0)		; EXTEND ALLOWED?
	BNE	.+10			; NO, BRANCH AHEAD
	BIC	#100000,R1		; YES, CLEAR PROTECTION BIT
	INC	R0			; AND INCREMENT STRING ADDRESS
					;
	ASR	R1			; SHIFT PROTECTION WORD
	BIS	#100000,R1		; SET PROTECTION BIT
	CMPB	#'D,(R0)		; DELETE ALLOWED?
	BNE	.+10			; NO, BRANCH AHEAD
	BIC	#100000,R1		; YES, CLEAR PROTECTION BIT
	INC	R0			; AND INCREMENT STRING ADDRESS
					;
	RTS	PC			; RETURN TO CALLER
					;
	.END				;