.TITLE	ISUPURDEL
	.IDENT	\ISUQUOTA 2.9\

ARG_COUNT=	0
ARG_FILESPEC=	4
ARG_KEEP=	8
ARG_DEVNAM=	12
ARG_UICMASK=	16

; ISUPURDEL PURGES/DELETES FILES ANALOGOUS TO DCL PURGE/DELETE.
; FILES WHICH DO NOT BELONG TO THE SPECIFIED UIC ARE NOT DELETED,
; BUT THE FILENAME IS INCLUDED IN THE PURGE/KEEP CALCULATION.
; DELETE IS ACCOMPLISHED BY SETTING THE KEEP PARAMETER TO ZERO.
; NOTE:
;	IT IS A POOR IDEA TO ALTER THIS PROGRAM SO IT WILL DELETE FILES
;	WHICH DO NOT BELONG TO THE SPECIFIED UIC.  IF IT RUNS IN A
;	PROGRAM WITH BYPASS PRIVILEGE - WHICH IT DOES IN ISUQUOTA SO THE
;	USER CAN NOT AVOID THE PURGE BY SETTING NO OWNER DELETE - AND
;	IF THE USER HAS BUILT POINTERS (ALIASES) TO SOMEONE ELSE'S FILES
;	THOSE FILES WILL BE DELETED.  AND THE USER CAN BUILD THOSE POINTERS
;	EVEN IF HE HAS NO ACCESS TO THE FILE.
;
;
; 
;	CALL ISUPURDEL (FILESPEC, PUR_KEEP, DEVNAM, UICMASK)
;
; WHERE
;
;  FILESPEC	- REQUIRED; ADR OF THE PURGE/DELETE FILE SPECIFICATION
;		  DESCRIPTOR.
;
;  PUR_KEEP	- REQUIRED; ADR OF LONGWORD CONTAINING NUMBER OF FILES
;		  WITH THE SAME NAME.TYP TO BE KEPT.
;
;  DEVNAM	- OPTIONAL; ADR OF DEVICE NAME DESCRIPTOR FOR THE DISK
;		  CONTAINING THE FILES TO BE PURGED/DELETED.
;		  IF SUPPLIED THEN FILES WHICH DO NOT BELONG TO THE UICMASK
;		  PARAMETER ARE NOT DELETED.
;
;  UICMASK	- OPTIONAL (REQUIRED IF DEVNAM SUPPLIED); ADR OF A LONG
;		  WORD CONTAINING THE FILE OWNER UIC MASK FOR FILES
;		  WHICH CAN BE DELETED.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		ANTHONY E. BIBLE
;		104 COMPUTER SCIENCE
;		IOWA STATE UNIVERSITY
;		AMES, IA  50011
;
;		515-294-5659
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


	.PAGE
	.SBTTL	MACROS

; SYSTEM MACROS

	$ATRDEF
	$FIBDEF
	$IODEF
	$JPIDEF
	$NAMDEF
	$RMSDEF
	$SSDEF


	.PAGE
	.SBTTL	LOCAL READ-ONLY DATA
	.PSECT	LCLRODATA,RD,NOWRT,NOEXE,LONG

WCVER:	.ASCII	\;*\

ATR_LIST:
	.WORD	ATR$S_UIC
	.WORD	ATR$C_UIC
	.LONG	FILE_OWN_UIC
	.LONG	0

DSC_FIB_DISK:
	.LONG	FIB$K_LENGTH
	.LONG	FIB_DISK

DSC_SYS$DISK:
	.ASCID	\SYS$DISK\


	.PAGE
	.SBTTL	LOCAL READ-WRITE DATA
	.PSECT	LCLRWDATA,RD,WRT,NOEXE,LONG

NAM_BUF:
	.BLKB	NAM$C_MAXRSS

DYN_PURDELSPEC:
	.LONG	0
	.LONG	10$
10$:	.BLKB	NAM$C_MAXRSS
DYN_FILESPEC_1:
	.LONG	0
	.LONG	10$
10$:	.BLKB	NAM$C_MAXRSS
DYN_FILESPEC_2:
	.LONG	0
	.LONG	10$
10$:	.BLKB	NAM$C_MAXRSS
LEN_NEWSPEC:
	.BLKL	1
LEN_OLDSPEC:
	.BLKL	1

FAB_PURGE:
	$FAB	NAM=NAM_PURGE
NAM_PURGE:
	$NAM	ESA=NAM_BUF,-
		ESS=NAM$C_MAXRSS,-
		RSS=NAM$C_MAXRSS
FAB_ERASE:
	$FAB

KEEP:	.BLKL	1
FILE_OWN_UIC:
	.BLKL	1
CHAN_DISK:
	.BLKW	1
IOSB_DISK:
	.BLKQ	1
FIB_DISK:
	.BLKB	FIB$K_LENGTH
FLG_LCLASSIGN:
	.BLKB	1


	.PAGE
	.SBTTL	CODE
	.PSECT	CODE,RD,NOWRT,EXE,LONG
	.ENTRY	ISUPURDEL,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>

	CLRB	FLG_LCLASSIGN		; INIT LOCAL ASSIGN FALSE

	CMPL	ARG_COUNT(AP),#4	; MAKE SURE ENOUGH ARGS
	BGEQ	SET_FILESPEC
	MOVL	#SS$_INSFARG,R0		; ERROR RETURN
	JMP	RET_ISUPURDEL

SET_FILESPEC:
	MOVL	ARG_FILESPEC(AP),R6	; ADR DSCR_FILESPEC
	BNEQ	10$
	MOVL	#SS$_BADPARAM,R0
	JMP	RET_ISUPURDEL

10$:	MOVC3	(R6),@4(R6),@DYN_PURDELSPEC+4	; COPY PURGE/DELETE FILESPEC
	MOVL	(R6),DYN_PURDELSPEC	; INIT LCL PURDELSPEC DESCRIPTOR
	SKPC	#^A\ \,DYN_PURDELSPEC,@DYN_PURDELSPEC+4	; SKIP LEADING BLANKS
	MOVL	R1,DYN_PURDELSPEC+4	; ADR START-OF-STRING
	MOVL	R0,DYN_PURDELSPEC	; SET NEW LENGTH
	LOCC	#^A\ \,DYN_PURDELSPEC,@DYN_PURDELSPEC+4	; FIND END-OF-STRING
	SUBL	R0,DYN_PURDELSPEC	; OMIT TRAILING BLANKS
	ADDL3	DYN_PURDELSPEC,DYN_PURDELSPEC+4,R6	; ADR EOS+1
	MOVC3	#2,WCVER,(R6)		; APPEND VERSION WILDCARD
	ADDL	#2,DYN_PURDELSPEC	; LEN+2 FOR APPENDED WILDCARD

	$FAB_STORE	FAB=FAB_PURGE,-	; STORE PURGE/DELETE WILDCARD SPEC
		FNA=@DYN_PURDELSPEC+4,-
		FNS=DYN_PURDELSPEC
	$NAM_STORE	NAM=NAM_PURGE,-	; FILL IN REST OF NAM BLOCK
		RSA=@DYN_FILESPEC_1+4
	$PARSE	FAB=FAB_PURGE		; INITIALIZE NAM BLK
	BLBS	R0,CHECK_KEEP
	JMP	RET_ISUPURDEL		; ERROR RETURN

CHECK_KEEP:
	TSTL	ARG_KEEP(AP)		; KEEP PARAM SUPPLIED?
	BNEQ	SET_CHAN		; YES
	MOVL	#SS$_BADPARAM,R0
	JMP	RET_ISUPURDEL		; ERROR RETURN

SET_CHAN:
	TSTL	ARG_DEVNAM(AP)		; DEVICE NAME SUPPLIED?
	BNEQ	10$			; YES
	CLRW	CHAN_DISK		; ZERO DISK CHANNEL MEANS NO UIC CHECK
	JMP	INIT_LOOP
10$:	TSTL	ARG_UICMASK(AP)		; UIC MASK SUPPLIED?
	BNEQ	12$			; YES
	MOVL	#SS$_BADPARAM,R0	; REQUIRED IF DEVNAM SUPPLIED
	JMP	RET_ISUPURDEL

12$:	$ASSIGN_S	CHAN=CHAN_DISK,-	; ASSIGN CHANNEL TO SYS$DISK
	DEVNAM=@ARG_DEVNAM(AP)
	BLBS	R0,20$
	JMP	RET_ISUPURDEL		; ERROR RETURN
20$:	MOVB	#1,FLG_LCLASSIGN	; LOCAL ASSIGN FLAG= TRUE

INIT_LOOP:
	MOVAQ	DYN_FILESPEC_1,R9	; ADR NEW FILESPEC DESCRIPTOR
	MOVAQ	DYN_FILESPEC_2,R8	; ADR OLD FILESPEC DESCRIPTOR
	CLRL	LEN_OLDSPEC		; INIT OLDPSEC= ""
	MOVL	@ARG_KEEP(AP),KEEP	; INIT KEEP
	MOVAL	NAM_PURGE,R10		; BASE ADR NAM BLK
	MOVAL	FIB_DISK,R11		; BASE ADR FIB

LOOP:	$SEARCH	FAB=FAB_PURGE		; GET NEXT FILE SPEC
	BLBS	R0,10$
	JMP	RET_ISUPURDEL		; END ON ERROR - HOPEFULLY RMS$_NMF

10$:	MOVZBL	NAM$B_RSL(R10),(R9)	; SET NEW FILESPEC LENGTH
	LOCC	#^A\;\,(R9),@4(R9)	; OMIT VER NUMBER
	SUBL3	R0,(R9),LEN_NEWSPEC	; LEN NEW FILESPEC OMITTING VERSION
	CMPC5	LEN_OLDSPEC,@4(R8),#^A\ \,-	; SAME FILE.TYP ?
		LEN_NEWSPEC,@4(R9)
	BEQL	20$				; YES
	PUSHL	R8				; OLD FILESPEC= NEW FILESPEC
	MOVL	R9,R8
	MOVL	LEN_NEWSPEC,LEN_OLDSPEC
	MOVL	(SP)+,R9
	$NAM_STORE	NAM=NAM_PURGE,-		; POINT NAM BLK RSA TO NEW ADR
		RSA=@4(R9)
	MOVL	@ARG_KEEP(AP),KEEP			; RESET KEEP COUNT
	JMP	CONT_LOOP

20$:	DECL	KEEP			; DECR KEEP COUNT
	BLEQ	30$			; IF KEEP <= 0  THEN DELETE CANDIDATE
	JMP	CONT_LOOP

30$:	TSTW	CHAN_DISK		; CHK FILE OWNERSHIP?
	BNEQ	CHK_FILEOWNER		; YES
	JMP	DELETE_FILE		; NO, JUST DOITTOIT

CHK_FILEOWNER:
	CLRQ	-(SP)			; WORK AREA
	MOVL	SP,R5
	LOCC	#^A\]\,(R9),@4(R9)	; SET NEW FILESPEC DESCRIPTOR
	SUBL3	#1,R0,(R5)
	ADDL3	#1,R1,4(R5)

	MOVW	NAM$W_DID_NUM(R10),-	; SET DIR FID IN DISK FIB
		FIB$W_DID_NUM(R11)
	MOVW	NAM$W_DID_SEQ(R10),-
		FIB$W_DID_SEQ(R11)
	MOVW	NAM$W_DID_RVN(R10),-
		FIB$W_DID_RVN(R11)

	$QIOW_S	CHAN=CHAN_DISK,-	; GET THE FILE OWNER UIC
		FUNC=#IO$_ACCESS,-
		IOSB=IOSB_DISK,-
		P1=DSC_FIB_DISK,-
		P2=R5,-
		P5=#ATR_LIST
	MOVAB	8(SP),SP		; RLSE WORK AREA
	BLBC	R0,30$
	MOVL	IOSB_DISK,R0		; GET STATUS
	BLBS	R0,DELETE_FILE		; CONTINUE IF SUCCESS

30$:	PUSHL	#1			; DISPLAY ERROR MESSAGE
	PUSHL	R0
	MOVL	SP,R6
	$PUTMSG_S	MSGVEC=(R6)
	JMP	CONT_LOOP		; GET NEXT FILESPEC

DELETE_FILE:
	CMPL	FILE_OWN_UIC,@ARG_UICMASK(AP)	; UICMASK OWN THIS FILE?
	BNEQ	CONT_LOOP			; NO
	$FAB_STORE	FAB=FAB_ERASE,-		; SET UP FAB FOR THIS FILE
		FNA=@4(R9),-
		FNS=(R9)
	$ERASE	FAB=FAB_ERASE		; DELETE FILE
	BRW	CONT_LOOP

CONT_LOOP:
	JMP	LOOP

RET_ISUPURDEL:
	BLBC	FLG_LCLASSIGN,10$
	$DASSGN_S	CHAN=CHAN_DISK

10$:	RET



	.END