;THE FOLLOWING PROCEDURE USES AN UNSUPPORTED VMS INTERFACE.  SEVERAL BITS
;  IN A FILE'S HEADER UNUSED BY FILES-11 AT THIS WRITING ARE MODIFIED; THEY
;  MAY BE USED BY FILES-11 IN FUTURE RELEASES
;
	.TITLE	CLASSPROC
;
;CLASSPROC.MAR	-	Procedure to return a status code to indicate the
;			classification of a disk file as TOP_SECRET, SECRET,
;			or CONFIDENTIAL.  The User Characteristics longword
;			in the file header is used to hold the class-
;			ification in bits 24 and 25 as follows:
;				TOP SECRET	=  11
;				SECRET		=  10
;				CONFIDENTIAL	=  01
;				UNCLASSIFIED	=  00
;
;			This procedure can be called from any supported VAX
;			language.
;
;	INPUTS:		argument	Address of the character string
;					descriptor for the file for which the
;					classification is to be returned.
;
;	OUTPUTS:	R0  (or function value in FORTRAN) (hex values shown)
;
;				08000001	UNCLASSIFIED
;				08000003	CONFIDENTIAL
;				08000005	SECRET
;				08000007	TOP_SECRET
;
;				The setting of bit 27 in the above status codes
;				  guarantees no conflict with VMS status codes.
;
;
;	NOTES: 	a. These bits are currently not being used by Files-11.
;		They may be used in future releases.  Bits 0-17 are currently
;		in use as NO BACKUP, etc.  Their use for this purpose is 
;		very UNSUPPORTED.
;
;		b. The CLASSIFY image (used in conjunction with CLASSIFY.CLD)
;		will classify the file as TOP_SECRET, SECRET, CONFIDENTIAL or
;		UNCLASSIFIED and display the classification of the file.`
;
;		Written by:	Clair Garman
;				Educational Services
;				Lanham, MD
;
;
	$FIBDEF			;Define offsets into File Information Block
	$ATRDEF			;Define offsets in the Attribute Control Block
;
	CLASSIFIC_POS  =  24	;Define the field for Classification in the
	CLASSIFIC_SIZ  =  2	;   User Characteristics longword of the header
;
	UNCLASSIFIED   =  ^B00	;Define values for the classifications
	CONFIDENTIAL   =  ^B01
	SECRET	       =  ^B10
	TOP_SECRET     =  ^B11
;
	UNCL_FILE	=  ^X08000001
	CONF_FILE	=  ^X08000003
	SECR_FILE	=  ^X08000005
	TOPS_FILE	=  ^X08000007
;
	.PSECT	DATA	PIC,NOEXE,LONG,NOSHR,WRT
;
FAB:		$FAB	NAM=NAMBLK
NAMBLK:		$NAM	RSA=FILNAM,RSS=80
;
FILE_FIB_DESC:	.LONG	16
		.LONG	FILE_FIB
FILE_FIB:	.LONG	FIB$M_WRITE  ;Write access
		.BLKW	3	;Unused output - File ID
		.BLKW	3	;Input - File ID for directory
;
ATR_DESC:	.WORD	4		;4 bytes to be modified
		.WORD	ATR$C_UCHAR	;User characteristics
		.ADDRESS  UCHAR_BUFFER
		.LONG	0		;Terminator
UCHAR_BUFFER:	.LONG	0
;
FILNAM_DESC:	.LONG
		.LONG
FILNAM:		.BLKB	80
DEVNAM:		.LONG
		.ADDRESS	NAMBLK+NAM$T_DVI+1
;
IOSB:		.BLKL	2
CHAN:		.WORD
;
	.PSECT	CODE	PIC,EXE,LONG,SHR,NOWRT
;
CLASSPROC::	.WORD	^M<R2>
;
;Move the file specification from INPUT into the FAB
;
	MOVL	4(AP),R2
	MOVB	(R2),FAB+FAB$B_FNS
	MOVL	4(R2),FAB+FAB$L_FNA
;
;Open the file using RMS in order to get the directory file ID
;
	$OPEN	FAB=FAB
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
;
;Store in the appropriate descriptors the length of the device name
;	and the length and address of the file name, type and version
;
	MOVB	NAMBLK+NAM$T_DVI,DEVNAM
	MOVB	NAMBLK+NAM$B_NAME,FILNAM_DESC
	ADDB2	NAMBLK+NAM$B_TYPE,FILNAM_DESC
	ADDB2	NAMBLK+NAM$B_VER,FILNAM_DESC
	MOVL	NAMBLK+NAM$L_NAME,FILNAM_DESC+4
;
;Move the directory file ID into the FIB and close the file
;

	MOVC3	#6,NAMBLK+NAM$W_DID,FILE_FIB+FIB$W_DID
	$CLOSE	FAB=FAB
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
;
;Assign a channel number to the disk for the $QIOs to follow
;
	$ASSIGN_S	CHAN=CHAN,DEVNAM=DEVNAM
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
;
;Access the file to obtain the current setting of UCHAR bits
;
	$QIOW_S	CHAN=CHAN,FUNC=#IO$_ACCESS!IO$M_ACCESS,IOSB=IOSB,-
			P1=FILE_FIB_DESC,P2=#FILNAM_DESC,P5=#ATR_DESC
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
		CMPW	#1,L^IOSB
			BEQL	.+15
			MOVZWL	L^IOSB,-(SP)
 			CALLS	#1,G^LIB$STOP
;
;Deaccess the file
;
	$QIOW_S	CHAN=CHAN,FUNC=#IO$_DEACCESS,IOSB=IOSB,-
			P1=FILE_FIB_DESC,P5=#ATR_DESC
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
		CMPW	#1,L^IOSB
			BEQL	.+15
			MOVZWL	L^IOSB,-(SP)
 			CALLS	#1,G^LIB$STOP
;
;Determine the classification of the file
;
	CMPZV	#CLASSIFIC_POS,#CLASSIFIC_SIZ,-	;Is file CONFIDENTIAL?
		   UCHAR_BUFFER,#CONFIDENTIAL
	BNEQ	10$				;Branch if not
		MOVL	#CONF_FILE,R0
		BRB	DONE
10$:	CMPZV	#CLASSIFIC_POS,#CLASSIFIC_SIZ,-	;Is the file SECRET?
		   UCHAR_BUFFER,#SECRET
	BNEQ	20$				;Branch if not
		MOVL	#SECR_FILE,R0
		BRB	DONE
20$:	CMPZV	#CLASSIFIC_POS,#CLASSIFIC_SIZ,-	;Is the file TOP_SECRET?
		   UCHAR_BUFFER,#TOP_SECRET
	BNEQ	30$				;Branch if not
		MOVL	#TOPS_FILE,R0
		BRB	DONE
30$:	MOVL	#UNCL_FILE,R0			;Then it must be UCLASSIFIED
;
DONE:	RET					;Exit CLASSPROC
;
	.END