Google
 

Trailing-Edge - PDP-10 Archives - bb-m081w-sm_t20_v7_0_02_exec_src_mod - exec/exec4.mac
There are 47 other files named exec4.mac in the archive. Click here to see a list.
; Edit= 4429 to EXEC4.MAC on 25-Sep-89 by GSCOTT
;Change references from "ARPANET" to "INTERNET", keeping old commands around
;with the invisible bit for CMDs, CTLs, and habitual users.
; Edit= 4423 to EXEC4.MAC on 9-Mar-89 by GSCOTT
;Make user change password on next login if password changed with BUILD. 
; Edit= 4412 to EXEC4.MAC on 13-Dec-88 by RASPUZZI
;Add new commands, features and support for security enhancements.
; UPD ID= 4110, RIP:<7.EXEC>EXEC4.MAC.5,   7-Mar-88 18:21:29 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 4091, RIP:<7.EXEC>EXEC4.MAC.4,  19-Jan-88 15:34:55 by EVANS
; TCO 7.1189 - EXEC Cleanup. Allow BUILD/^ECREATE using logical name
;		for non-existent directory.
; UPD ID= 36, RIP:<7.EXEC>EXEC4.MAC.3,  21-Oct-87 13:16:18 by WONG
; TCO 7.1077 Implement setting and removing SEMI-OPERATOR privilege for
; directories via the ^ECREATE and BUILD command.
; Also, change INFORMATION DIRECTORY to display SEMI-OPERATOR if applicable.
; This edit must be accompanied by a MONSYM edit which defines the new
; SEMI-OPERATOR privilege bit, SC%SEM, to be 28.
; *** Edit 3024 to EXEC4.MAC by WAGNER on 19-Dec-85, for SPR #20844
; Allow EPRINT to pass back error on INFORMATION DIRECTORY if structure is not
; mounted. 
; Edit 3004 to EXEC4.MAC by PRATT on 26-Jul-85, for SPR #20730 (TCO 6-1-1495)
; WHEELs and OPRs cannot set project numbers of TOPS-10 PPN during directory
; builds 
; UPD ID= 220, SNARK:<6.1.EXEC>EXEC4.MAC.5,  10-Jun-85 08:42:47 by DMCDANIEL
; UPD ID= 164, SNARK:<6.1.EXEC>EXEC4.MAC.4,   3-May-85 08:29:43 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 123, SNARK:<6.1.EXEC>EXEC4.MAC.3,   9-Jan-85 14:24:09 by EVANS
;TCO 6.1.1124 - Comment out reporting of REMOTE ALIAS on INFO DIR VERBOSE
; UPD ID= 30, SNARK:<6.1.EXEC>EXEC4.MAC.2,   3-Oct-84 16:10:57 by PRATT
;TCO 6.1.1020 - Allow INFINITY to BUILD, WORK/PERM subcommands
; UPD ID= 292, SNARK:<6.EXEC>EXEC4.MAC.19,  30-Jun-83 13:10:31 by CHALL
;More TCO 6.1623
; UPD ID= 286, SNARK:<6.EXEC>EXEC4.MAC.18,  20-May-83 14:42:46 by MCINTEE
;Comment out the REMOTE-ALIAS subcommand
; UPD ID= 284, SNARK:<6.EXEC>EXEC4.MAC.17,  12-May-83 10:09:30 by CHALL
;More TCO 6.1623
; UPD ID= 279, SNARK:<6.EXEC>EXEC4.MAC.16,   5-May-83 13:18:45 by CHALL
;TCO 6.1643 - Change syntax of TOPS10 PPN commands and output
; UPD ID= 278, SNARK:<6.EXEC>EXEC4.MAC.15,  21-Apr-83 05:32:42 by FLEMMING
;TCO 6.1618 - Add support for TOPS10 PPNs to BUILD
; UPD ID= 268, SNARK:<6.EXEC>EXEC4.MAC.14,  19-Apr-83 11:52:47 by LEACHE
;TCO 6.1623 - remove password display code
; UPD ID= 237, SNARK:<6.EXEC>EXEC4.MAC.13,  15-Jan-83 19:24:05 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 193, SNARK:<6.EXEC>EXEC4.MAC.12,  11-Nov-82 21:49:55 by CHALL
;TCO 6.1367 $CREAT- $$CREA- CHANGE BUILD SUBCMD "USER-GROUP" TO "USER-OF-GROUP"
; UPD ID= 181, SNARK:<6.EXEC>EXEC4.MAC.11,   8-Oct-82 20:32:10 by CHALL
;MORE TCO 6.1270 - CORRECT PROBLEMS WITH REMOTE-ALIAS subcommand.
; UPD ID= 166, SNARK:<6.EXEC>EXEC4.MAC.10,  30-Sep-82 16:33:28 by MCINTEE
;TCO 6.1270 - REMOTE-ALIAS subcommand.
; UPD ID= 159, SNARK:<6.EXEC>EXEC4.MAC.9,  15-Sep-82 13:42:05 by TSANG
;TCO 6.1254 FIX THE NUMBER OF USER GROUP
; UPD ID= 135, SNARK:<6.EXEC>EXEC4.MAC.8,   4-Aug-82 17:15:02 by LEACHE
;TCO 6.1209 Fix invocations of ETYPE
; UPD ID= 88, SNARK:<6.EXEC>EXEC4.MAC.6,   8-Jan-82 15:47:44 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 28, SNARK:<6.EXEC>EXEC4.MAC.3,  17-Aug-81 10:37:40 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
;<HELLIWELL.EXEC.5>EXEC4.MAC.1, 14-May-81 13:08:54, EDIT BY HELLIWELL
; UPD ID= 591, SNARK:<5.EXEC>EXEC4.MAC.5,   3-Jun-80 09:33:13 by OSMAN
;<5.EXEC>EXEC4.MAC.4,  2-Jun-80 16:41:52, EDIT BY OSMAN
;tco 5.1057 - Allow ENABLE, DISABLE, and PUSH under BUILD
;<5.EXEC>EXEC4.MAC.3,  8-May-80 14:03:45, EDIT BY OSMAN
;Remove R.L.5 and R.GE.5 macro calls and contents
; UPD ID= 424, SNARK:<4.1.EXEC>EXEC4.MAC.6,   9-Apr-80 14:02:16 by OSMAN
;tco 4.1.1141 - Fix ACCOUNT handling
; UPD ID= 413, SNARK:<4.1.EXEC>EXEC4.MAC.5,   4-Apr-80 17:42:29 by LYONS
;ADD CODE FOR ARPANET ACCESS AND DECNET ACCESS
; UPD ID= 200, SNARK:<4.1.EXEC>EXEC4.MAC.4,  10-Jan-80 14:44:43 by OSMAN
;tco 4.1.1064 - Ask for password after BUILD subcommands if needed.
; UPD ID= 194, SNARK:<4.1.EXEC>EXEC4.MAC.3,   8-Jan-80 14:28:44 by OSMAN
; UPD ID= 191, SNARK:<4.1.EXEC>EXEC4.MAC.2,   8-Jan-80 14:06:56 by OSMAN
;tco 4.1.1060 - Warn about non-accessed directories under INFO DIR

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
	SEARCH EXECDE
	TTITLE EXEC4

;THIS FILE CONTAINS THE PRIVILEGED COMMANDS '^EPRINT' AND '^ECREATE'
;^E PRINT (NAME) <DIRECTORY NAME> [VERBOSE]
;"VERBOSE" MAY ONLY BE ENTERED AS A SUBCOMMAND.  4/21/77 EO

;PRINTS ALL OF THE CHARACTERISTICS ASSOCIATED WITH A DIRECTORY:
; PASSWORD, PRIVILEGES, MODE, SPECIAL RESOURCE INFO, DIRECTORY NUMBER,
;     DEFAULT FILE PROT, DIREC PROT, FILE RETENTION SPECS,
;     DIRECTORY & USER GROUPS.
;ADD'L KEYWORD "VERBOSE" OR SUBCOMMAND "VERBOSE" CAUSES ALL TO
;BE PRINTED, OTHERWISE ONLY NON-DEFAULT FIELDS.

EPRINT::TRVAR <<EPBLK,GTDLN>,EPFLG,EPDIR,EPWLS>
	SETZM EPBLK		;NO BLOCK TO RELEASE YET
	NOISE <DIRECTORY NAME>
	TLZ Z,F1		;ALLOW CURRENT DIR AS DEFAULT
	CALL CURNMS		;INPUT DIRECTORY NAME, GET # AND BITS IN A
	 CALL CJERRE		;[3024] ERROR, FIND OUT WHICH AND RETURN IT
	MOVEM A,EPFLG		;SAVE THE FLAGS FROM RCDIR
	MOVEM B,EPWLS		;SAVE THE POINTER TO THE STRING
	MOVEM C,EPDIR		;SAVE THE DIR #
	TLZ Z,F3!F4		;INITIALIZE FLAGS
	CALL SPRTR		;ANALYZE & CHECK TERMINATOR
	 SUBCOM $PRINT		;READ SUBCOMMANDS
EPR1:	MOVEI A,EPBLK
	SKIPE EPBLK		;IS THERE A PREVIOUS BLOCK?
	CALL RELDIR		;YES, RELEASE FREE SPACE USED
	MOVE A,EPDIR		;GET THE DIR NUMBER
	TLNE Z,F4		;NAME-ONLY?
	JRST EPR3		;YES, DONT DO THE GETDIR
	MOVEI C,EPBLK		;BLOCK INTO WHICH TO READ THE INFO
	CALL GETDIR		;DO THE GTDIR JSYS
	 JRST [	MOVE A,EPDIR	;GET DIRECTORY NUMBER THAT FAILED
		ETYPE <%%%%? - %1R%%_>	;SAY WHY THE FAILURE
		JRST EPR2]	;DO REST IN SET
	MOVEI A,EPBLK		;GET ADDRESS OF BLOCK
	CALL GRPCHK		;CHECK FOR GROUP OVERFLOWS
EPR3:	MOVE A,EPDIR		;GET THE DIR NUMBER FOR DIRPNT
	MOVEI B,EPBLK		;GET BLOCK ADDRESS
	CALL DIRPNT
EPR2:	MOVE A,EPDIR		;NOW STEP TO THE NEXT DIR (IF ANY)
	MOVE B,EPWLS		;GET POINTER TO ORIGINAL STRING
	MOVE C,EPFLG		;GET FLAGS
	TXNE C,RC%WLD		;ANY WILD CARD CHARACTERS IN STRING?
	CALL STPDIR		;YES, GO STEP THE DIR NUMBER
	 JRST UNMDIR		;NO MORE DIRS, UNMAP DIR PAGES
	MOVEM A,EPDIR		;SAVE THE NEW DIR NUMBER
	JRST EPR1		;LOOP BACK FOR THE OTHER DIRS
;DIRPNT
;PRINT DIRECTORY DESCRIPTION FROM GTDIR-FORMAT BLOCK THAT Q1 POINTS TO.
;OMITS DEFAULT VALUES UNLESS BIT F3 IN LH Z IS ON.
;PRINTS THE DIR NAME ONLY IF F4 IN LH Z IS ON.
;FOR "PRINT" COMMAND AND FOR "LIST" SUBCOMMAND OF "CREATE".
;ACCEPTS IN A/	DIR NUMBER OR POINTER TO DIR NAME STRING
;ACCEPTS IN B/ ADDRESS OF CRDIR-FORMAT BLOCK CONTAINING INFO

DIRPNT:	SAVEAC <P1>		;GET A PERMANENT AC TO USE FOR ADDRESS
	STKVAR <DACTPR,<DFBUF,GTDLN>>
	MOVE C,.CDDAC(B)	;GET ACCOUNT POINTER
	MOVEM C,DACTPR		;REMEMBER POINTER TO ACCOUNT
	MOVE P1,B		;SAVE ADDRESS OF BLOCK
	SETZM .CDPED+DFBUF	;[4412] Init this
	SETZM .CDNLD+DFBUF	;[4412] Clear this for old monitors
	SETZM .CDFPA+DFBUF	;[4412] ANd this one too
	SKIPE A			;NAME IS NOT IN BLOCK FOR "PRINT".
	ETYPE < Name %1R%%_>
	TLNE Z,F4		;PRINT NAME ONLY?
	RET			;YES, EXIT
PR2:	SETZB A,C		;GET DEFAULT INFO
	MOVEI B,GTDLN-1		;SET UP LENGTH OF BUFFER (NO REMOTE ALIASES)
	MOVEM B,.CDLEN+DFBUF	;IN FIRST WORD OF BUFFER
	MOVEI B,DFBUF
	GTDIR
	 ERCAL JERRE
PR2A:	MOVSI B,(<7B2>)		;CLEAR EXTRA BITS
	ANDCAM B,.CDFPT+DFBUF
	ANDCAM B,.CDDPT+DFBUF
	MOVE B,.CDLIQ(P1)	;LOGGED IN QUOTA
	ETYPE < Working disk storage page limit %2Q%%_>
	MOVE B,.CDLOQ(P1)	;LOGGED OUT QUOTA
	ETYPE < Permanent disk storage page limit %2Q%%_>
;PRIVILEGES

	MOVE B,.CDPRV(P1)
	TXNN B,SC%WHL
	CALL F3NOT
	TXZE B,SC%WHL
	ETYPE < WHEEL%_>
	TXNN B,SC%OPR
	CALL F3NOT
	TXZE B,SC%OPR
	ETYPE < OPERATOR%_>
	TXNN B,SC%CNF
	CALL F3NOT
	TXZE B,SC%CNF
	ETYPE < CONFIDENTIAL INFORMATION ACCESS%_>
	TXNN B,SC%MNT
	CALL F3NOT
	TXZE B,SC%MNT
	ETYPE < MAINTENANCE%_>
	TXNN B,SC%IPC
	CALL F3NOT
	TXZE B,SC%IPC
	ETYPE < IPCF%_>
	TXNN B,SC%ENQ
	CALL F3NOT
	TXZE B,SC%ENQ
	ETYPE < ENQ-DEQ%_>
	TXZE B,SC%NWZ		;[4429] Internet wizard?
	ETYPE < INTERNET-WIZARD%_> ;[4429] Wow
	TXZE B,SC%NAS		;[4429] Absolute internet sockets?
	ETYPE < ABSOLUTE-INTERNET-SOCKETS%_> ;[4429] Impressive
	TXZE B,SC%DNA
	ETYPE < DECNET-ACCESS%_>
	TXZE B,SC%ANA		;[4429] Internet access?
	ETYPE < INTERNET-ACCESS%_> ;[4429] Yep
	TXZE B,SC%SEM		;[7.1077]SEMI-OPR?
	ETYPE < SEMI-OPERATOR%_> ;[7.1077]YES
	JUMPE B,.+2		;NO MORE PRIVILEGES
	ETYPE < Other capabilities %2O%%_>
;DIRPNT
;MODE

	MOVE B,.CDMOD(P1)
	TXNN B,CD%DIR
	CALL F3NOT
	TXZE B,CD%DIR
	ETYPE < FILES-ONLY%_>
	TXNN B,CD%SEC		;[4412] Is directory secure?
	CALL F3NOT		;[4412] No, say "not" if supposed to
	TXZE B,CD%SEC		;[4412] Is directory secure?
	ETYPE < SECURE%_>	;[4412] Yes, say so
	TXZ B,CD%ANA		;IGNORE ALPHA NUMERIC BIT
	TXZE B,CD%RLM
	ETYPE < Repeat LOGIN messages%_>
XARC <
	TXZE B,CD%DAR		;DEFAULT ARCHIVE ONLINE-EXPIRED?
	ETYPE < Archive online expired files%_>
   >
	JUMPE B,.+2		;TEST FOR ADDITIONAL MODE BITS
	ETYPE < Other mode bits %2O%%_>

	SKIPN B,.CDNUM(P1)
	JRST [	TLNE Z,F3
		ETYPE < No directory number%_>
				;0: NOT ASSIGNED YET ("CREATE" CASE)
		JRST .+2]
	ETYPE < Number of directory %2O%%_>
	MOVE B,.CDFPT(P1)
	TLZ B,(<7B2>)
	TLNN Z,F3
	CAME B,.CDFPT+DFBUF	;DON'T PRINT IF STANDARD
	ETYPE < Default file protection %2O%%_>
	MOVE B,DACTPR		;GET POINTER TO ACCOUNT STRING
	ILDB B,B		;GET FIRST CHARACTER
	SKIPN B			;IS THERE AN ACCOUNT DEFAULT?
	SKIPA B,[-1,,[ASCIZ /- none set/]]
	MOVE B,DACTPR		;YES, GET POINTER TO ACCOUNT STRING
	ETYPE < Account default for LOGIN %2M%%_>
	MOVE B,.CDDPT(P1)
	TLZ B,(<7B2>)
	TLNN Z,F3
	CAME B,.CDDPT+DFBUF
	ETYPE < Protection of directory %2O%%_>
;DIRPNT

	MOVE B,.CDRET(P1)		;DEFAULT # VERSIONS TO KEEP
	MOVE A,.CDRET+DFBUF		;DEFAULT VALUE
	TLNN Z,F3
	CAME B,A
	ETYPE < Generations to keep %2Q%%_>
	MOVE B,.CDSDQ(P1)		;NUMBER OF SUBDIRECTORIES
	MOVE A,.CDSDQ+DFBUF		;DEFAULT VALUE
	TLNN Z,F3
	CAME B,A
	ETYPE < Maximum subdirectories allowed %2Q%%_>
	SKIPN A,.CDLLD(P1)
	IFSKP.			;[4412] If so,
	  ETYPE < Last interactive login %1D %1E%%_> ;[4412]
	ELSE.			;[4412]
	  TLNE Z,F3		;[4412] Verbose?
	  ETYPE < Never logged in interactively%_>
	ENDIF.			;[4412]
	SKIPN A,.CDNLD(P1)	;[4412] Ever logged in like in batch?
	IFSKP.			;[4412] If so,
	  ETYPE < Last non-interactive login %1D %1E%%_> ;[4412]
	ELSE.			;[4412]
	  TLNE Z,F3		;[4412] Being verbose?
	  ETYPE < Never logged in non-interactively%_>
	ENDIF.			;[4412]
	SKIPN A,.CDPED(P1)	;[4412] Does this password have an expiration?
	IFSKP.			;[4412] If so,
	  IFG. A		;[4412] If a real value
	    ETYPE < Password expires on %1D %1E%%_> ;[4412]
	  ELSE.			;[4412] Else, say something meaningful
	    ETYPE < Password has EXPIRED%_> ;[4412] Spit it out, man
	  ENDIF.		;[4412]
	ELSE.			;[4412] If none set,
	  TLNE Z,F3		;[4412] See if words wanted
	  ETYPE < Password expiration date not set%_> ;[4412]
	ENDIF.			;[4412]
	HLRZ A,.CDFPA(P1)	;[4412] Get interactive failures
	SKIPN A			;[4412] Any failures?
	IFSKP.			;[4412] If so,
	  ETYPE < Number of interactive login failures %1Q%%_> ;[4412]
	ELSE.			;[4412] Else, check for verbose
	  TLNE Z,F3		;[4412] Want verbiage?
	  ETYPE < No interactive login failures%_> ;[4412]
	ENDIF.			;[4412]
	HRRZ A,.CDFPA(P1)	;[4412] Get non-interactive failures
	SKIPN A			;[4412] Any failures?
	IFSKP.			;[4412] If so,
	  ETYPE < Number of non-interactive login failures %1Q%%_> ;[4412]
	ELSE.			;[4412] Else, check for verbose
	  TLNE Z,F3		;[4412] Want verbiage?
	  ETYPE < No non-interactive login failures%_> ;[4412]
	ENDIF.			;[4412]
	MOVE A,.CDUGP(P1)
	MOVEI B,[ASCIZ /User of groups/]
	CALL GRPPNT
	MOVE A,.CDDGP(P1)
	MOVEI B,[ASCIZ /Directory groups/]
	CALL GRPPNT
	MOVE A,.CDCUG(P1)	;POINTER TO ALLOWABLE SUBDIRECTORY USER GROUPS
	MOVEI B,[ASCIZ /Subdirectory user groups allowed/]
	CALL GRPPNT
	MOVE A,.CDDNE+DFBUF
	MOVE B,.CDDNE(P1)
	MOVEI C,[ASCIZ / Online expiration default /]
XARC <
	CALL EXPPNT
   >
	MOVE A,.CDDFE+DFBUF
	MOVE B,.CDDFE(P1)
	MOVEI C,[ASCIZ / Offline expiration default /]
XARC <
	CALL EXPPNT
   >
       ;MOVE A,.CDDRN(P1)	;REMOTE ALIAS BLOCK
       ;MOVEI B,[ASCIZ/ Remote aliases/]
       ;CALL RNALST		;YES. PRINT IT OUT.
	HLRZ A,.CDPPN+DFBUF	;PROJECT NUMBER
	HLRZ B,.CDPPN(P1)
	JUMPE B,DNOPPN
	HRRZ C,.CDPPN(P1)
	ETYPE < TOPS10 project-programmer number %2O%,%3O%%_%%_>
	RET

DNOPPN:	ETYPE < TOPS10 project-programmer number - none set%_%%_>
	RET
GRPPNT:	PUSH P,B
	JUMPE A,GRPPN0
	MOVN B,(A)		;GET COUNT
	AOJGE B,GRPPN0		;COUNT = 1 IS NO GROUPS
	HRL A,B
	PRINT " "
	POP P,B
	UTYPE (B)
	PRINT " "
	AOSA A			;NOW WE HAVE AN AOBJN POINTER
GRPPN1:	TYPE <, >
	MOVE B,(A)
	ETYPE <%2Q>
	AOBJN A,GRPPN1
	ETYPE <%_>
	RET

GRPPN0:	POP P,B
	TLNN Z,F3
	RET
	PRINT " "
	UTYPE (B)
	TYPE < - none set
>
	RET
;ROUTINE TO CHECK FOR LOST INFO DUE TO RESTRICTED SUBBLOCK LENGTHS.  PASS
;THIS ROUTINE ADDRESS OF GTDIR/CRDIR BLOCK IN A.

GRPCHK:	MOVE B,@.CDUGP(A)		;GET NUMBER OF WORDS RETURNED
	CAIL B,UGBUFL			;CHECK FOR *POSSIBLE* OVERFLOW
	TYPE < User group buffer overflow
>
	MOVE B,@.CDDGP(A)		;SAME FOR OTHER GROUP BUFFERS
	CAIL B,DGBUFL
	TYPE < Directory group buffer overflow
>
	MOVE B,@.CDCUG(A)
	CAIL B,SGBUFL
	TYPE < Subdirectory user group buffer overflow
>
	RET

;SUBROUTINE TO TYPE " NOT" AND SKIP IF F3 ON

F3NOT:	TLNN Z,F3
	RET
	TYPE < not>
	RETSKP

EXPPNT:	TLNN Z,F3		;VERBOSE?
	CAME A,B		;SAME AS DEFAULT?
	CAIA			;EITHER VERBOSE OR NOT DEFAULT VALUE
	RET			;YES, DON'T PRINT IT
	UTYPE (C)		;WHAT IT IS
	TLNN B,-1		;INTERVAL OR DATE & TIME?
	JRST EXPPN1
	ETYPE <%2D
>				;PRINT DATE & TIME
	RET

EXPPN1:	CAIN B,1
	ETYPE <%2Q Day
>
	CAIE B,1
	ETYPE <%2Q Days
>
	RET
;Routine to print out node alias list
;CALL RNALST
; A/ address of node alias list.
; B/ address of header
; returns +1 always

RNALST:	SAVEAC <Q1,Q2,Q3,P1,P2>
	SKIPN Q1,(A) 		;GET LIST IN PRESERVED AC - IS THERE ONE?
	JRST RNALS0		;NO - DONE
	UTYPE (B)		;YES - PRINT HEADER.
	ETYPE <%_>		; AND CARRIAGE RETURN

;OUTER LOOP

RNALS1:	MOVE Q2,.CDNXT(Q1)    	;REMEMBER NEXT SUBBLOCK
	HRRZ Q3,.CDSIZ(Q1)	;SIZE OF SUBBLOCK
	MOVE C,.CDSIZ(Q1)	;SIZE AND FLAGS
	ADDI Q1,.CDNOD		;STEP TO NODE ENTRY
	SUBI Q3,.CDNOD		;UPDATE COUNT
	MOVEI P1,RNATTL		;REMOTE ALIAS HEADINGS
	SETO P2,		;NO ENTRIES YET PRINTED FOR THIS SUBBLOCK

;INNER LOOP, FOR EACH ENTRY IN SUBBLOCK

RNALS2:	SKIPN A,(Q1)		;GET ENTRY BYTE POINTER - IS THERE ONE ?
	JRST RNLS2L		;NO - SKIP THIS

	MOVEI B,[ASCIZ /, /]	;YES - ASSUME IT'S NOT THE FIRST NON-NULL ENTRY
	AOJN P2,RNLS2A		;JUMP IF IT'S NOT; IF IT IS NEXT ONE WON'T BE
	TXNN C,CD%KIL		;DELETING THIS ENTRY ?
	SKIPA B,[[ASCIZ /     /]] ;NO - SPACE OVER
	MOVEI B,[ASCIZ /  D  /]	  ;YES - MARK AS SUCH
RNLS2A:	UTYPE (B)		;OUTPUT THE RIGHT STRING
	MOVE B,(P1)		;GET BYTE POINTER TO HEADING
	ETYPE <%2M - %1M> 	;PRINT HEADING & ENTRY.
RNLS2L:	SOJLE Q3,RNALS3		;IF DONE WITH THIS SUBBLOCK, EXIT INNER LOOP
	AOJ P1,			;ELSE STEP TO NEXT ENTRY
	AOJA Q1,RNALS2

;END INNER LOOP

RNALS3:	ETYPE <%_>		;END OF LINE
RNALS4:	SKIPE Q1,Q2 		;STEP TO NEXT SUBBLOCK, IF ANY
	JRST RNALS1    		;THERE ARE MORE SUBBLOCKS, CONTINUE.

;END OUTER LOOP

	RET			;END ROUTINE
;HEADINGS FOR REMOTE ALIASES

RNATTL:	POINT 7,[ASCIZ \Node\]
	POINT 7,[ASCIZ \Userid\]
	POINT 7,[ASCIZ \Password\]
	POINT 7,[ASCIZ \Account\]

;NO REMOTE ALIAS LIST - CHECK FOR VERBOSE

RNALS0:	TLNN Z,F3		;VERBOSE ?
	RET			;NO - DONE
	UTYPE (B)		;YES - TALK ABOUT IT
	TYPE < - none set
>
	RET

;"PRINT" SUBCOMMAND TABLE AND ROUTINES

$PRINT:	TABLE
	T FAST,ONEWRD,..FAST
	T NAME-ONLY,ONEWRD,..NAME
	T VERBOSE,ONEWRD,..VERB
	TEND

..FAST:	TLZA Z,F3
..VERB:	TLO Z,F3
	TLZ Z,F4		;GET WHOLE LISTING
	RET

..NAME:	TLO Z,F4		;NAME ONLY
	RET
;^E CREATE (NAME) <DIRECTORY NAME> (PASSWORD) --
;EITHER FIELD CAN BE TERMINATED WITH COMMA TO INITIATE SUBCOMMANDS.
;CAN CREATE NEW DIRECTORIES OR MODIFY INFO ASSOCIATED WITH OLD ONES.
;Q1 HOLDS FLAGS AND BLOCK POINTER WHICH WILL BE IN B FOR CRDIR.
;FLAGS IN LH Q1 ARE SET ONLY FOR FIELDS EXPLICITLY INPUT BY USER,
;  BUT ALL INFO IS IN BLOCK FOR "LIST" SUBCOMMAND.

.CREAT::NOISE <DIRECTORY NAME>
	TRVAR <CRPASS,<CSTING,FILWDS>,<CRBLK,GTDLN>,KREDIR,SUBBLK>
	SETZM CRPASS		;NO PASSWORD YET
	MOVX Q1,CD%LEN		;ALWAYS ENABLE .CDLEN ENTRY
	MOVEI A,CRBLK		;ADDRESS OF BLOCK TO INITIALIZE
	CALL DIRINI		;INIT BUFFER FOR GTDIR
;CREATE
;INPUT NAME AND TYPE [OLD/NEW] AND GET CURRENT INFO FOR OLD.

	MOVEI B,[FLDDB. .CMDIR,CM%SDH,,<Old directory name being modified>,,[
		 FLDDB. .CMDIR,CM%PO+CM%SDH,,<New directory name being created>,,]]
	CALL FLDSKP		;READ DIRECTORY NAME
	 CMERRX
	MOVE A,.CMFNP(C)	;GET FUNCTION FLAGS TO DETERMINE IF DIRECTORY EXISTS OR NOT
	TLZ Z,F2		;ASSUME OLD NAME
	TXNN A,CM%PO		;PARSE-ONLY?
	JRST CRET1		;NO
	TLO Z,F2		;YES, NEW NAME
 	CALL BUFFF		;GET STRING
	CALL LOGCHK		;[7.1189] ( /A) Is this a logical name?
	MOVEM A,KREDIR		;SAVE POINTER TO DIRECTORY NAME STRING
	DEXTX <>		;CLEAR GTJFN BLOCK
	HRROI A,[ASCIZ /FOO/]	;NAME IS ARBITRARY
	MOVEM A,CJFNBK+.GJNAM	;STORE NAME TO USE
	MOVE A,[.NULIO,,.NULIO]	;DON'T LET GTJFN READ ANY MORE INPUT
	MOVEM A,CJFNBK+.GJSRC	;STORE NON-JFN'S
	MOVX A,GJ%OFG		;WE WANT PARSE ONLY
	MOVEM A,CJFNBK+.GJGEN	;STORE FLAGS
	MOVEI A,CJFNBK		;POINT GTJFN AT ARG BLOCK
	MOVE B,KREDIR		;GET POINTER TO STRUCTURE AND DIRECTORY
	CALL GTJFS		;GET DEVICE NAME
	 CALL JERR		;SHOULDN'T EVER FAIL
	MOVE B,A		;PUT IN B FOR GETTING DEVICE NAME
	HRROI A,CSTING		;AREA INTO WHICH TO WRITE DEVICE NAME
	MOVX C,FLD(.JSAOF,JS%DEV) ;WE ONLY WANT DEVICE FIELD
	JFNS			;GET DEVICE NAME
	HRROI A,CSTING		;NOTE THAT WE COULDN'T JUST DO STDEV
				;BECAUSE IN COMMON CASE, USER WILL
				;TYPE "^ECREATE [FOO]", AND HENCE DEVICE
				;NAME WILL BE NULL.  UNFORTUNATELY,
				;STDEV DOESN'T HAVE A SPECIAL ERROR CODE
				;SAYING "DEVICE NAME WAS NOT SPECIFIED",
				;NOR DOES IT RETURN UPDATED STRING POINTER
				;IN AC1.  OTHERWISE THE GTJFN,JFNS WOULD
				;HAVE BEEN UNNECESSARY.  NOTE THAT LEAVING
				;OUT ALL THIS CODE IS BAD TOO, BECAUSE
				;USER MIGHT SAY "^ECREATE ABC:[FOO]"
				;WHERE ABC: IS NOT MOUNTED, AND EXEC WOULD
				;JUST WAIT FOR ALL THE SUBCOMMANDS, AND
				;THEN BOMB OUT, A VERY FRUSTRATING
				;SITUATION.
	MOVE C,A		;LEAVE POINTER IN 3 FOR ERROR MESSAGE
	STDEV 			;MAKE SURE STRUCTURE IS MOUNTED
	 ERCAL [ERROR <Structure %3M: not mounted>]
	SETZB A,C		;USE DIRECTORY 0
	MOVEI B,GTDLN-1		;SET UP LENGTH OF BUFFER (NO REMOTE ALIASES)
	MOVEM B,.CDLEN+CRBLK	;IN FIRST WORD OF BUFFER
	MOVEI B,CRBLK		;POINT TO BUFFER
	GTDIR			;GET DEFAULTS
	MOVEI A,CRBLK		;GET ADRESS OF ENTIRE CRDIR BLOCK
	MOVEI B,1		;MAKE EMPTY GROUP BUFFERS
	MOVEM B,@.CDUGP(A)
	MOVEM B,@.CDDGP(A)
	MOVEM B,@.CDCUG(A)
	TXO Q1,CD%LIQ!CD%LOQ!CD%FPT!CD%DPT!CD%RET
	JRST CRET1A

CRET1:	MOVEM B,KREDIR		;REMEMBER DIRECTORY NUMBER
	HRROI A,CSTING		;GET STRING STORAGE POINTER
	DIRST
	 ERCAL CJERRE
	HRROI A,CSTING		;GET TO BEGINNING OF STRING AGAIN
	CALL BUFFS		;SAVE STRING
	EXCH A,KREDIR		;RESTORE DIR # AND SAVE STR
				;GET CURRENT INFORMATION FOR OLD DIRECTORY
	MOVEI B,GTDLN		;SET UP LENGTH OF BUFFER
	MOVEM B,.CDLEN+CRBLK	;IN FIRST WORD OF BUFFER
	MOVEI B,CRBLK
	HRROI C,CSTING		;PASSWORD GOES HERE (POINTER STORED IN BUFFER GTDIR)
	MOVE D,.CDDAC(B)	;GET POINTER TO WHERE ACCOUNT WILL GO
	AOS .CDDRN(B)		;FOR REMOTE ALIAS BLOCK, FIRST WORD NOT USED
				; BY GTDIR
	GTDIR
	  ERCAL CJERRE
	HLRZ A,@.CDDRN(B)	;GET USED COUNT FOR GTDIR BLOCK
	SOS .CDDRN(B)		;REMOTE ALIAS BLOCK - RECOVER ENTIRE BLOCK
	CAIG A,1		;ANY ALIASES RETURNED ?
	JRST CRET1B		;NO.
	MOVE A,.CDDRN(B)	;YES. MAKE FIRST WORD OF REMOTE ALIAS BLOCK
	ADDI A,2		; TO POINT
	MOVEM A,@.CDDRN(B)	;  TO ALIAS LIST.
CRET1B: MOVEM D,.CDDAC(B)	;RESTORE ACCOUNT POINTER TO POINT AT BEGINNING
	HRROI A,CSTING		;POINT TO PASSWORD
	CALL BUFFS		;ISOLATE IT
	SKIPE .CDPSW+CRBLK	;NO POINTER STORED MEANS PASSWORD NOT AVAILABLE
	MOVEM A,.CDPSW+CRBLK	;STORE POINTER TO ISOLATED PASSWORD
	MOVEI A,CRBLK		;GET ADDRESS OF BLOCK
	CALL GRPCHK		;CHECK FOR GROUP OVERFLOW
CRET1A:
;CREATE
;INPUT PASSWORD.
;FOR OLD DIRECTORY, THIS PASSWORD REPLACES OLD ONE - IS THAT GOOD?

	NOISE <PASSWORD>
	WORDX <Password>
	 CMERRX
	CALL BUFFF
	LDB B,[350700,,ATMBUF]	;SEE IF ANY PASSWORD TYPED
	JUMPE B,CREAT3		;JUMP IF NONE
	MOVEM A,.CDPSW+CRBLK	;PASSWD STRING PTR TO PARAMETER BLOCK
	TXO Q1,CD%PSW		;TELL CRDIR TO SET PASSWORD
CREAT3:	COMMAX <Optional comma, then carriage return to go into subcommand mode>
	 JFCL			;NO COMMA REQUIRED
	CONFIRM			;GET LINE CONFIRMATION
	CALL NORO		;TYPE NEW OR OLD

;CHECK, CONFIRM, EXECUTE

	SETZM .CDLEN+CRBLK	;CLEAR CRDIR BITS
CRSUB:	SUBCOM $CREAT,[TLZ Z,F1
		       RET]	;GET SUBCOMMANDS, CLEAR "NOT" BEFORE EACH ONE

CRSUB1:	MOVX B,CD%PED		;[4423] Load set password expiration date flag
	TXNE Q1,CD%PSW		;[4423] Setting password?
	TDNE B,.CDLEN+CRBLK	;[4423] Yes, setting password exp date?
	IFSKP.			;[4423] Setting password but not the date
	  IORM B,.CDLEN+CRBLK	;[4423] Greg wants the date to be zero here
	  SETZM .CDPED+CRBLK	;[4423]  so that user must change pwd at login
	ENDIF.			;[4423] Not setting password or setting date

	MOVE A,KREDIR		;GET POINTER TO NAME STRING
	MOVEI B,GTDLN		;[4412] Get argument block length
	HRRM B,.CDLEN+CRBLK	;[4412] Slam it in CRDIR% argument block
	MOVEI B,CRBLK		;[4412] Get argument block address
	HLL B,Q1		;XWD FLAGS, PARAMETER BLOCK ADDRESS
	MOVE C,CRPASS		;GET 0 OR POINTER TO PASSWORD
	MOVE D,@.CDDRN(B)	;GET ADDRESS OF REMOTE ALIAS LIST
	EXCH D,.CDDRN(B)	;PUT LIST ADDR IN BLOCK, SAVE ADDR OF BLOCK
	CRDIR			;CREATE DIRECTORY !
	 ERJMP NODIR		;FAILED, LET USER FIX SUBCOMMANDS AND TRY AGAIN
	MOVEM D,.CDDRN(B)	;RESTORE ADDRESS OF REMOTE ALIAS BLOCK
	CALLRET UNMDIR
;GET TO HERE IF CRDIR FAILED.  TELL USER, LET HIM FIX SUBCOMMANDS AND
;TRY AGAIN.

NODIR:	MOVEM D,.CDDRN(B)	;RESTORE ADDRESS OF REMOTE ALIAS BLOCK
	CALL DGETER		;SEE WHY IT FAILED
	CAIN A,ACESX3		;PASSWORD REQUIRED?
	JRST CRSUB2		;GET PASSWORD AND TRY AGAIN
	CAIN A,CNDIX1		;WRONG PASSWORD?
	JRST [	LERROR <%?%%_>	;YES, TELL HIM
		JRST CRSUB2]	;GET  ANOTHER PASSWORD AND TRY AGAIN
	LERROR <%?.%_Please fix incorrect subcommands.%_>
	JRST CRSUB		;GO BACK INTO SUBCOMMAND MODE

;GET TO HERE IF CRDIR FAILS DUE TO PASSWORD MISSING OR WRONG.  INPUT THE
;PASSWORD AND TRY CRDIR AGAIN.  THIS IS DONE RATHER THAN BOMBING OUT, TO TRY
;TO SAVE THE USER FROM HAVING TO DO ANOTHER BUILD WITH ALL THE PARAMETERS.

CRSUB2:	CALL PASLIN		;YES, GET ONE
	MOVEM A,CRPASS		;REMEMBER IT
	JRST CRSUB1		;GO TRY AGAIN
;TYPE "[NEW]" OR "[OLD]" DEPENDING ON WHETHER DIRECTORY IS NEW OR OLD

NORO:	TLNE Z,F2
	TYPE <[New]
>
	TLNN Z,F2
	TYPE <[Old]
>
	RET
;[7.1189]
;SUBROUTINE TO EXAMINE ATMBUF AND SEE IF WE HAVE A LOGICAL NAME
;IF SO, REMOVE THE ":" AND USE LNMST% TO TRANSLATE. 
;
;IF NOT, RETURN WITHOUT CHANGING ANYTHING. 
;THE POINTER TO THE BUFFERED STRING WILL STILL BE IN AC1.
;
;  CALL LOGCHK
;
; RETURNS +1 always
;
LOGCHK:	MOVE B,A		;[7.1189] pointer to string
LOGCK1: ILDB C,B		;[7.1189] Get a character
	JUMPE C,LOGCK2		;[7.1189] done if null
      	CAIE C,":"		;[7.1189] colon?
	JRST LOGCK1		;[7.1189] no, keep looking
	ILDB C,B		;[7.1189] found a colon - get next char
	CAIE C,"<"		;[7.1189] left bracket?
	CAIN C,"["		;[7.1189] maybe square?
	JRST LOGCK2		;[7.1189] yes, so not a logical name
        SETO D,   		;[7.1189] minus one
	ADJBP D,B		;[7.1189] back up to colon
	SETZ C,			;[7.1189] ...
        DPB C,D	                ;[7.1189] and replace with a null for LNMST%
        MOVE B,A		;[7.1189] point
        SETZ A,		        ;[7.1189] job-wide
        MOVE C,CSBUFP	        ;[7.1189] where we want it
        LNMST%		        ;[7.1189] translate it
         ERJMP JERRE		;[7.1189] couldn't
        MOVE A,CSBUFP	        ;[7.1189] pointer's here
LOGCK2: RET
;CREATE
;SUBCOMMAND DISPATCH TABLE
;FLAG B5 INDICATES "NOT" MAY PRECEDE THE SUBCOMMAND.

NOTF==1B5

$CREAT:	TABLE
	T ABORT,ONEWRD
	TA ABS,..ABSO		;[4429]
	IT ABSOLUTE-ARPANET-SOCKETS,NOTF,..AAS ;[4429]
..ABSO:	T ABSOLUTE-INTERNET-SOCKETS,NOTF,..AAS ;[4429]
	T ACCOUNT-DEFAULT,,.AD
   XARC <
	T ARCHIVE-ONLINE-EXPIRED-FILES,NOTF,..ARCH
   >
	IT ARPANET-ACCESS,NOTF,..ANA ;[4429]
	IT ARPANET-WIZARD,NOTF,..ANW ;[4429]
	T CONFIDENTIAL,NOTF
	T DECNET-ACCESS,NOTF,..DNA
	T DEFAULT-FILE-PROTECTION,,..PFIL
	T DIRECTORY-GROUP,NOTF,..DIRE
	T DISABLE
	T ENABLE
	T ENQ-DEQ,NOTF,..ENQ
	T EXPIRATION-OF-PASSWORD,NOTF,GETPEX ;[4412] Set password expiration
	T EXPIRE,,EXPPAS	;[4412] Expire user
	T FILES-ONLY,NOTF,.FILES
	T GENERATIONS,,..GENR
	T INTERNET-ACCESS,NOTF,..ANA ;[4429]
	T INTERNET-WIZARD,NOTF,..ANW ;[4429]
	T IPCF,NOTF
	T KILL,NOTF
	T LIST,,..LIST
	T MAINTENANCE,NOTF
	T MAXIMUM-SUBDIRECTORIES,,.MAXIM
	T NOT
	T NUMBER
   XARC <
	T OFFLINE-EXPIRATION-DEFAULT,,.OFFLI
	T ONLINE-EXPIRATION-DEFAULT,,.ONLIN
   >
	T OPERATOR,NOTF
	T PASSWORD
	T PERMANENT,,..LOQ
	T PRESERVE,,...PRE
	T PROTECTION,,...PRO
	T PUSH,,...PUS
;	T REMOTE-ALIAS,NOTF,RNAALI
	T REPEAT-LOGIN-MESSAGES,NOTF,..RLM
	T SECURE,NOTF,.SDSEC	;[4412] Build secure
	T SEMI-OPERATOR,NOTF,..SOPR ;[7.1077]ADD NEW KEYWORD
	T SUBDIRECTORY-USER-GROUP,,.SUSER
	T TOPS10-PROJECT-PROGRAMMER-NUMBER,NOTF,..TPPN
	T USER-OF-GROUP,NOTF,.USER
	T WHEEL,NOTF
	T WORKING,,..LIQ
	TEND
;CREATE
;"NOT" CAN PRECEDE THOSE SUBCOMMANDS WHICH HAVE B5 SET IN TABLE.
;DISPATCH IS TO SAME ROUTINE BUT WITH "F1" SET TO REVERSE EFFECT.

.NOT:	KEYWD $$CREA
	 0
	 JRST CERR
	MOVE P4,P3
	TLO Z,F1
	JRST (P3)

$$CREA:	TABLE
	TA AB,...ABS		;[4429]
	IT ABSOLUTE-ARPANET-SOCKETS,NOTF,..AAS ;[4429]
...ABS:	T ABSOLUTE-INTERNET-SOCKETS,NOTF,..AAS ;[4429]
   XARC <
	T ARCHIVE-ONLINE-EXPIRED-FILES,NOTF,..ARCH
   >
	IT ARPANET-ACCESS,NOTF,..ANA ;[4429]
	IT ARPANET-WIZARD,NOTF,..ANW ;[4429]
	T CONFIDENTIAL,NOTF
	T DECNET-ACCESS,NOTF,..DNA
	T DIRECTORY-GROUP,NOTF,..DIRE
	T ENQ-DEQ,NOTF,..ENQ
	T EXPIRATION-OF-PASSWORD,NOTF,GETPEX ;[4412] Set no password expiration
	T FILES-ONLY,NOTF,.FILES
	T INTERNET-ACCESS,NOTF,..ANA ;[4429]
	T INTERNET-WIZARD,NOTF,..ANW ;[4429]
	T IPCF,NOTF
	T KILL,NOTF
	T MAINTENANCE,NOTF
	T OPERATOR,NOTF
;	T REMOTE-ALIAS,,RNAALI
	T REPEAT-LOGIN-MESSAGES,NOTF,..RLM
	T SECURE,NOTF,.SDSEC	;[4412] Build SECURE directory
	T SEMI-OPERATOR,NOTF,..SOPR ;[7.1077]ADD NEW KEYWORD
	T SUBDIRECTORY-USER-GROUP,,.SUSER
	T TOPS10-PROJECT-PROGRAMMER-NUMBER,,..NPPN
	T USER-OF-GROUP,NOTF,.USER
	T WHEEL,NOTF
	TEND
;ROUTINES FOR THE INDIVIDUAL SUBCOMMANDS

;PASSWORD
;CURRENTLY REDUNDANT EXCEPT THAT IT ALLOWS TYPE-IN IN A FORMAT MORE LIKE
; WHAT "PRINT" PUTS OUT AND ALLOWS GIVING A NULL STRING (USEFUL?).

.PASSW:	WORDX <1 to 39 alphanumeric characters or hyphens>
	 CMERRX
	CONFIRM
	CALL BUFFF
	MOVEM A,.CDPSW+CRBLK
	TXO Q1,CD%PSW
	RET
;[4412]
;Making the directory SECURE

.SDSEC:	MOVX A,CD%SEC		;Flag that we are trying to make it secure
	CALLRET CCMODE		;And join common folk

;[4412]
;Set password expiration date and time
GETPEX:	TLNN Z,F1		;Has not been typed?
	IFSKP.			;If clearing password expiration,
	  SETZ B,		;Clear this out
	ELSE.			;Else,
	  DTX <Expiration date and time for password>
	   CMERRX		;Handle error
	ENDIF.
	CONFIRM			;Parse an EOL
	MOVEM B,.CDPED+CRBLK	;Save password expiration date and time
GETPX1:	MOVX B,CD%PED		;Get flag
	IORM B,.CDLEN+CRBLK	;Set it in argument block
	TXO Q1,CD%LEN		;And say length is in argumnet block
	RET			;Back to subcommand mode

;[4412]
;Here to expire a naughty user
EXPPAS:	NOISE <USER PASSWORD>	;A little guidance
	CONFIRM 		;Get that ever present EOL
	SETOM .CDPED+CRBLK	;Expire the password
	CALLRET GETPX1		;And join common code
;TOPS10 PROJECT PROGRAMMER NUMBER

..TPPN:	NOISE <FOR COMPATIBILITY>
	OCTX <octal number in the range 10-377777>
	 CMERRX
	MOVE D,B		;[3004] SAVE THE PROJECT NUMBER
	JUMPLE B,.TPPNR		;[3004] NO NEGATIVE OR ZERO NUMBERS
	CAIG B,377777		;[3004]
	CAIGE B,10		;[3004] .LE.10 RESERVED TO DEC, BUT ALLOW 10
	IFNSK.			;[3004] 
	 MOVEI A,.FHSLF		;[3004] NOT IN RANGE, SEE IF WHOPR
	 RPCAP			;[3004] GET CAPABILITIES
	  ERJMP JERRE		;[3004] 
	 TXNE C,SC%WHL!SC%OPR	;[3004] WHOPR ?
	  CAILE D,377777	;[3004] YES - DO RANGE CHECK AGAIN
.TPPNR:	   ERROR <Not in the range 10-377777> ;[3004] NO - THEN ERROR
	ENDIF.
	COMMAX <Comma to separate project and programmer numbers>
	 CMERRX
	OCTX <6-digit octal number>
	 CMERRX
	CONFIRM
	TLNE B,777777
	ERROR <Not a 6-digit octal number>
	HRL B,D			;PUT IN THE PROJECT NUMBER
	MOVEM B,.CDPPN+CRBLK	;STORE THE ENTIRE PPN
	TXO Q1,CD%PPN		;SET PPN IN DIRECTORY
	RET

;HERE ON NO-TOPS10-PROJECT-PROGRAMMER-NUMBER

..NPPN:	CONFIRM
	SETZM B,.CDPPN+CRBLK	;CLEAR THE PPN FIELD
	TXO Q1,CD%PPN		;CLEAR PPN IN DIRECTORY
	RET			;DONE

;"CREATE" SUBCOMMANDS

;LOGGED-IN (STORAGE LIMIT) <DECIMAL>

..LIQ:	CALL ..DISK
	MOVEM B,.CDLIQ+CRBLK
	TXO Q1,CD%LIQ
	RET

;LOGGED-OUT (STORAGE LIMIT) <DECIMAL>

..LOQ:	CALL ..DISK
	MOVEM B,.CDLOQ+CRBLK
	TXO Q1,CD%LOQ
	RET

..DISK:	NOISE <DISK STORAGE PAGE LIMIT>
	DECX <Decimal number of pages or INFINITY for no limit>
	IFNSK.
	 KEYWD $INFQ		;DIDN'T GET A NUMBER - SEE IF KEYWORD
	  0
	  CMERRX
	 CALL (P3)		;HANDLE THE KEYWORD
	ENDIF.
	CONFIRM
	CAML B,[^D1000000]	;LESS THAN A MILLION?
	HRLZI B,377777		;NO - GIVE INFINITE QUOTA
	RET

..INFD:	MOVE B,[^D1000000]	;SET INFINITY
	RET


$INFQ:	TABLE
	T INFINITY,,..INFD
	TEND


;SUBCOMMANDS FOR SPECIFIC PRIVILEGES AND MODES.
;F1 ON AT ENTRY IF PRECEDED BY "NOT".

;AC USE: A: MASK INDICATING BITS TO SET (F1 OFF), OR CLEAR (F1 ON).

..AAS:	SKIPA A,[SC%NAS]	;ABSOLUTE ARPANET SOCKETS
..ANW:	MOVEI A,SC%NWZ		;ARPANET WIZARD
	JRST CPRIV

..ANA:	SKIPA A,[SC%ANA]
..DNA:	MOVEI A,SC%DNA
	JRST CPRIV

..ENQ:	MOVEI A,SC%ENQ
	JRST CPRIV
.IPCF:	SKIPA A,[SC%IPC]
.MAINT:	MOVEI A,SC%MNT
	JRST CPRIV

.WHEEL:	SKIPA A,[SC%WHL]
.OPERA:	MOVEI A,SC%OPR
	JRST CPRIV

..SOPR:	MOVEI A,SC%SEM	        ;[7.1077]GET THE SEMI-OPERATOR BIT
	JRST CPRIV		;[7.1077]GO AND SET IT IN THE CRDIR BLOCK

.CONFI:	NOISE <INFORMATION ACCESS CAPABILITY>
	MOVEI A,1B20
	JRST CPRIV1

CPRIV:	NOISE <CAPABILITY>
CPRIV1:	CONFIRM
	IORM A,.CDPRV+CRBLK	;SET BITS IN QUESTION
	TLNE Z,F1		;BUT IF SUBCOMMAND PRECEDED BY "NOT",
	ANDCAM A,.CDPRV+CRBLK	;CLEAR THE BITS.
	TXO Q1,CD%PRV
	RET

..RLM:	MOVX A,CD%RLM		;CHANGE REPEAT LOGIN MESSAGE BIT
	JRST CCMODE

..ARCH:	SKIPA A,[CD%DAR]
.FILES:	MOVX A,CD%DIR
;	JRST CCMODE		;(FALL INTO CCMODE)

CCMODE:	CONFIRM
	IORM A,.CDMOD+CRBLK	;SET BIT
	TLNE Z,F1		;PRECEDED BY "NOT"?
	ANDCAM A,.CDMOD+CRBLK	;YES, CLEAR BIT.
	TXO Q1,CD%MOD
	RET
;"CREATE" SUBCOMMANDS

;NUMBER <OCTAL>. SPECIFIES DIRECTORY NUMBER

.NUMBE:	NOISE <OF DIRECTORY>
	OCTX <Octal directory number>
	 CMERRX
	TLNN Z,F2
	JRST [	CAME B,.CDNUM+CRBLK
		ERROR <You can't change the number of an old directory>
		JRST NUMBE1]

;CHECK THAT THE NUMBER ISN'T IN USE BY TRYING TO CONVERT IT TO STRING.

	HRROI A,CSTING
	DIRST
	 CAIA			;NOT IN USE
	ERROR <Number already in use>
NUMBE1:	CONFIRM
	MOVEM B,.CDNUM+CRBLK
	SKIPE B
	TXO Q1,CD%NUM
	RET

.OFFLI:	NOISE <IS>
	DTIVX <Expiration date>
	 CMERRX
	CONFIRM
	MOVEM B,.CDDFE+CRBLK	;SAVE OFFLINE FLAG
	MOVX B,CD%FED		;CHANGE OFFLINE FLAG
	IORM B,.CDLEN+CRBLK
	TXO Q1,CD%LEN		;INDICATE LENGTH & OFF/ON EXP TO BE CONSIDERED
	RET

.ONLIN:	NOISE <IS>
	DTIVX <Expiration date>
	 CMERRX
	CONFIRM
	MOVEM B,.CDDNE+CRBLK	;SAVE ONLINE FLAG
	MOVX B,CD%NED		;CHANGE ONLINE FLAG
	IORM B,.CDLEN+CRBLK
	TXO Q1,CD%LEN		;INDICATE LENGTH & OFF/ON EXP TO BE CONSIDERED
	RET
;"CREATE" SUBCOMMANDS

;PROTECTION (OF DIRECTORY) <OCTAL>. LATER ALSO ALLOW NAMED PROT?

...PRO:	NOISE <OF DIRECTORY>
	OCTX <6-digit octal number>
	 CMERRX
	CONFIRM
	TLNE B,777777		;ALLOW TALT+TSPC+TEOL
	ERROR <6-digit value only>
	TLO B,500000
	MOVEM B,.CDDPT+CRBLK
	TXO Q1,CD%DPT
	RET

;PRESERVE (SUPERIOR QUOTAS)

...PRE:	NOISE <SUPERIOR QUOTAS>
	MOVX B,WHLU+OPRU
	CALL PRVCK		;MUST HAVE PRIVS FOR THIS FCN
	 ERROR <WHEEL or OPERATOR capability required>
	CONFIRM
	MOVX B,CD%NSQ		;NO SUBTRACT QUOTAS BIT
	IORM B,.CDLEN+CRBLK	;ASSUME ON
	TLNE Z,F1		;"NOT" ?
	ANDCAM B,.CDLEN+CRBLK	;YES
	RET

;ACCOUNT-DEFAULT

.AD:	NOISE <FOR LOGIN>
	LINEX <Default account for users logging into this directory>
	 CMERRX
	CONFIRM
	CALL BUFFF
	MOVEM A,.CDDAC+CRBLK	;REMEMBER NEW ACCOUNT
	TXO Q1,CD%DAC		;SAY TO SET STRING
	RET
..PFIL:	NOISE <NUMBER>
	OCTX <6-digit octal number>
	 CMERRX
	CONFIRM
	TLNE B,777777		;ALLOW TALT+TSPC+TEOL
	ERROR <6-digit value only>
	TLO B,500000
	MOVEM B,.CDFPT+CRBLK
	TXO Q1,CD%FPT
	RET

..GENR:	NOISE <TO KEEP>
	DECX <Decimal number of generations to retain per file>
	 CMERRX
	MOVE A,B		;LEAVE NUMBER IN A
	CONFIRM
	DMOVE B,[EXP 0,FB%RET]	;GET MASK FOR RETENTION COUNT FIELD
GENR1:	JUMPE C,GENR2		;IT'S RIGHT-JUSTIFIED WHEN C CONTAINS 0
	LSHC B,1		;DO A SHIFT
	JRST GENR1
GENR2:	JFFO B,.+1		;GET NUMBER OF BITS TO LEFT OF RIGHT-JUSTIFIED FIELD
	CAIL A,0
	CAMLE A,B		;MAKE SURE NUMBER IS IN RANGE
	ERROR <Must be 0-%2Q>
	MOVEM A,.CDRET+CRBLK	;STORE NEW GNERATION RET COUNT DEFAULT
	TXO Q1,CD%RET
	RET
;"CREATE" SUBCOMMANDS

;SUBDIRECTORY

;SUBDIRECTORY MAXIMUM

.MAXIM:	NOISE <ALLOWED>
	DECX <Decimal number of subdirectories allowed under this directory>
	 CMERRX			;INVALID NUMBER OF SUBDIRECTORIES
	CONFIRM
	MOVEM B,.CDSDQ+CRBLK	;REMEMBER NUMBER SPECIFIED
	TXO Q1,CD%SDQ		;REMEMBER TO SET THIS PARAMETER
	RET

;[NOT] SUBDIRECTORY USER

.SUSER:	NOISE <ALLOWED>
	MOVE A,.CDCUG+CRBLK	;ADDRESS OF SUBDIRECTORY USER GROUPS ALLOWED BUFFER
	HRLI A,SGBUFL		;SPECIFY LENGTH
	TXO Q1,CD%CUG
	CALLRET .GROUP		;CALL GROUP AND RETURN

;[NOT] USER (GROUP) <DECIMAL GROUP NUMBER 1-2**18>
;F1 ON IF PRECEDED BY "NOT"

.USER:	NOISE <NUMBER>
	MOVE A,.CDUGP+CRBLK	;USER GROUP BUFFER ADDRESS
	HRLI A,UGBUFL		;SPECIFY LENGTH OF BLOCK
	TXO Q1,CD%UGP		;SET USER GROUP FLAG
	CALLRET .GROUP		;CALL GROUP AND RETURN

;[NOT] DIRECTORY (GROUP) <DECIMAL GROUP NUMBER 1-2**18>

..DIRE:	NOISE <NUMBER>
	MOVE A,.CDDGP+CRBLK	;GET ADDRESS OF DIRECTORY GROUP BUFFER
	HRLI A,DGBUFL		;SPECIFY LENGTH
	TXO Q1,CD%DGP		;SET DIRECTORY GROUP FLAG; FALL INTO .GROUP
;	CALLRET .GROUP		;(FALL INTO .GROUP)
;SUBROUTINE TO ADD OR DELETE GROUP NUMBER FROM BUFFER IN A

.GROUP:	PUSH P,A		;SAVE BUFFER POINTER
	DECX <Decimal group number>
	 CMERRX
	CONFIRM
	MOVE A,B
	JUMPLE A,GRPER1		;OUT OF RANGE
	CAILE A,777777		;MUST FIT IN HALFWORD
GRPER1:	ERROR <Group numbers must be between 1 and 262143.>
	POP P,B			;GET BUFFER POINTER BACK
	MOVN C,(B)
	AOJGE C,GRPNX1		;JUMP IF EMPTY GROUP
	HRLZ C,C
	HRRI C,1(B)		;MAKE AOBJN PTR
GRPFN1:	CAMN A,(C)
	JRST GRPFN2
	AOBJN C,GRPFN1
GRPNX1:	TLNE Z,F1
	JRST [	ETYPE <%%No group to remove%_>
		RET]
	HLRZ C,B
	CAMG C,(B)		;BUFFER FULL YET?
	ERROR <Can't add new group; buffer full>
	AOS C,(B)		;COUNT ANOTHER ENTRY
	ADDI C,-1(B)		;POINT TO NEW ENTRY
	MOVEM A,(C)
	RET

GRPFN2:	TLNN Z,F1
	JRST [	ETYPE <%%Group already exists%_>
		RET]
	HRRI A,(C)		;DESTINATION
	HRLI A,1(C)		;SOURCE
	SOS C,(B)
	ADDI C,-1(B)		;LAST WORD TO STORE
	BLT A,(C)
	SETZM 1(C)		;CLEAR LAST WORD FOR CLEANLINESS
	RET
;"CREATE" SUBCOMMANDS

;KILL (THIS DIRECTORY)

.KILL:	NOISE <THIS DIRECTORY>
	CONFIRM
	TLNN Z,F1
	CALL FCONF		;FORCED CONFIRMATION IF KILL
	TXO Q1,CD%DEL
	TLNE Z,F1
	TXZ Q1,CD%DEL		;"NOT KILL" REVERSES EFFECT.
	RET

;ABORT: ABORT THIS CREATE. REDUNDANT FOR ^C.

.ABORT:	MOVEI A,RERET
	MOVEM A,CERET
	CALL UNMDIR
	JRST CMDIN4		;GO GET NEXT EXEC COMMAND
;LIST. PRINTS WHAT "PRINT" WILL PRINT IF THIS "CREATE" IS COMPLETED.
;"LIST VERBOSE" PRINTS AS "PRINT" WITH VERBOSE SUBCOMMAND

..LIST:	KEYWD $.LIST
	T FAST,,0		;DEFAULT IS "FAST"
	 JRST CERR
	TLZ Z,F3!F4
	CONFIRM
	TRNE P3,F4
	TLO Z,F4
	TRNE P3,F3
	TLO Z,F3
	MOVE A,KREDIR		;GET POINTER TO STRING FOR DIRPNT
	MOVEI B,CRBLK		;GET BLOCK ADDRESS
	TXNN Q1,CD%DEL
	JRST DIRPNT		;GO ACT LIKE "PRINT" COMMAND
	TYPE < Killed
>
	RET

;PUSH ALLOWS THE BUILDER TO PUSH OUT OF THE BUILD COMMAND, WHICH IS USEFUL
;IF ANOTHER BUILD COMMAND IS REQUIRED SUCCESSFULLY TO COMPLETE THE CURRENT
;ONE, OR IF ANOTHER COMMAND IS NECESSARY.

...PUS:	CALL .PUSH		;DO THE PUSH
	MOVE A,KREDIR		;GET POINTER TO DIRECTORY
	ETYPE <[Continuing BUILD of directory %1R]%_>
	RET

$.LIST:	TABLE
	T FAST,,0
	T NAME-ONLY,,F4
	T VERBOSE,,F3
	TEND
;BUILD SUBCOMMAND - REMOTE-ALIAS
;change remote node alias information
;The CRDIR/GTDIR remote alias block format:
;  word 0: pointer to remote alias list
;  word 1: used word,,total words (NOT including word 0) used by GTDIR
;  word 2-N: used for string and subblock storage.
;For GTDIR block, offset .CDDRN points to word 1 of remote alias block.
;For CRDIR block, offset .CDDRN points to CONTENTS (word 0)
; of remote alias block.
;The rest of the time, offset .CDDRN points to word 0 of remote alias block.

RNAALI:	CALL RNAGND		;ASK FOR THE NODE NAME; SAVE IN CSTING
	TLNE Z,F1		;WANT TO ELIMINATE AN ALIAS?
	JRST RNADEL		;YES - HANDLE SEPARATELY
	KEYWD $RNTAB		;NO - PREPARE TO SET SOMETHING
	 T USERID,,RNAUSR	;DEFAULT TO USERID
	 CMERRX			;ERROR
	JRST (P3)		;ELSE DISPATCH TO ROUTINE AND RETURN

;TABLE FOR REMOTE-ALIAS SUBCOMMAND (ABOVE)

$RNTAB:	TABLE
	T ACCOUNT,,RNAACT
	T PASSWORD,,RNAPAS
	T USERID,,RNAUSR
	TEND
;Subroutine to parse a node name and save it in CSTING
;returns +1

RNAGND:	NOISE <FOR NODE>
	FNODEX <Node name>	;PARSE NODE NAME
	 CMERRX
	MOVE B,[-4,,ATMBUF]	;MOVE 4 WORDS OF THE ATOM BUFFER
	MOVEI C,CSTING		;INTO CSTING
RNGND1:	MOVE A,(B)
	MOVEM A,(C)
	AOJ C,
	AOBJN B,RNGND1
	RET			;DONE FOR NOW
;Subroutine search for a remote alias block with the node name in CSTING,
;allocating and initializing it if it does not exist
;CALL RNANOD
;returns +1 with A/ address of subblock

RNANOD:	HRRZ A,.CDLEN+CRBLK	;MAKE CRDIR BLOCK LONG ENOUGH
	CAIGE A,GTDLN		; SO REMOTE ALIASES WILL BE SEEN
	MOVEI A,GTDLN
	HRRM A,.CDLEN+CRBLK
	MOVX A,CD%RNA		;SET THE REMOTE NODE ALIAS FLAG, ALSO.
	IORM A,.CDLEN+CRBLK
	HRRI C,CSTING		;MAKE POINTER TO PARSED NODE NAME
	HRLI C,(POINT 7,)	;MAKE POINTER TO PARSED NODE NAME
	MOVE D,@.CDDRN+CRBLK	;GET ADDRESS OF REMOTE ALIAS LIST
	JUMPE D,RNAND2		;IF LIST IS NULL, GO ALLOCATE

;SEARCH LIST FOR BLOCK WITH NODE NAME

RNAND1:	MOVE A,C		;PARSED NODE BYTE POINTER
	MOVE B,.CDNOD(D)	;NEXT NODE BYTE POINTER IN ALIAS LIST
	STCMP%			;COMPARE THE TWO STRINGS
	JUMPN A,RNAD1A		;JUMP IF NOT THE SAME
	MOVE A,D		;ELSE GET ADDRESS OF BLOCK
	RET   			; AND DONE

RNAD1A:	SKIPE D,.CDNXT(D)	;STEP TO NEXT BLOCK
	JRST RNAND1		; AND CONTINUE, IF ANY ARE THERE.

;NODE NOT IN CURRENT LIST, ALLOCATE FROM REMOTE ALIAS BLOCK

RNAND2:	CALL RNNBUF		;(/A) PUT NODE NAME IN REMOTE ALIAS BLOCK
	 ERROR <Allocation failure> ;NO ROOM.
	MOVE C,A		;SAVE BYTE POINTER TO NEW NODE NAME
	MOVE D,.CDDRN+CRBLK	;GET ADDRESS OF HEADER
	AOJ D,
	HRRZ B,(D)         	;GET SIZE OF BLOCK
	HLRZ A,(D)           	;GET USED SIZE
	ADDI A,RNASIZ		;COMPUTE NEW USED SIZE
	CAMLE A,B		;WILL IT FIT ?
	 ERROR <Allocation failure> ;NO ROOM.
	HRLM A,(D)            	;YES. PUT USED SIZE IN BLOCK HEADER
	SUBI A,RNASIZ		;COMPUTE ADDRESS OF SUBBLOCK
	ADD A,D
	MOVEI B,RNASIZ		;PUT SIZE IN SUBBLOCK
	HRRZM B,.CDSIZ(A)
	MOVE B,@.CDDRN+CRBLK	;GET ADDRESS OF REMOTE NODE ALIAS LIST
	MOVEM A,@.CDDRN+CRBLK	;INSERT THIS SUBBLOCK
	MOVEM B,.CDNXT(A)
	MOVEM C,.CDNOD(A)	;INSERT NODE NAME BYTE POINTER
	SETZM .CDUSR(A)		;INITIALIZE THE REST OF THE BLOCK
	SETZM .CDPAS(A)
	SETZM .CDACC(A)
	RET   			;DONE.
;copy string in atom buffer to remote alias buffer
;CALL RNABUF
;returns +2 on success with A/ new byte pointer
;returns +1 on failure.
;preserves all ACs but A

RNABUF:	SKIPA A,[ATMBUF]	;GET A BYTE POINTER TO LATEST-TYPED ATOM
RNNBUF:	MOVEI A,CSTING		;GET A BYTE POINTER TO THE NODE NAME
	SAVEAC <B,C,D,Q1,Q2>
	HRLI A,(POINT 7,0)	;MAKE THE ADDRESS A BYTE POINTER
	MOVE Q1,A		;SAVE IT
	CALL BCOUNT		;(A/A,B) COMPUTE LENGTH OF STRING.
	MOVE C,B		;BYTE COUNT FOR SOUT
	MOVE Q2,.CDDRN+CRBLK	;GET TO HEADER
	AOJ Q2,
	HLRZ D,(Q2)		;GET OLD USED WORD COUNT
	HRRZ B,(Q2)		;GET TOTAL COUNT
	ADD A,D			;COMPUTE NEW USED WORD COUNT
	CAMLE A,B		;IS THERE ROOM ?
	RET			;NO. FAIL.
	HRLM A,(Q2)		;YES. UPDATE USED WORD COUNT.
	MOVE A,Q2		;BYTE POINTER TO DESTINATION
	ADD A,D
	HRLI A,(POINT 7,0)
	MOVE Q2,A		;SAVE IT
	MOVE B,Q1		;BYTE POINTER TO SOURCE
	SETZ D,			;NULL TERMINATOR
	SOUT%			;TRANSFER
	MOVE A,Q2		;RESTORE DESTINATION BYTE POINTER
	RETSKP
;routine to add a "create" remote alias subblock to the list
;a new userid implies a new alias.
;CALL RNAUSR
;returns +1 on failure
;returns +2 on success
;uses A & B

RNAUSR:	NOISE <IS>
	LINEX <Userid>		;GET USERID (WANT TO ALLOW ".")
	 CMERRX
	CONFIRM
	CALL RNANOD		;FIND OR CREATE REMOTE ALIAS SUBBLOCK
	MOVEM A,SUBBLK		;SAVE THE ADDRESS OF THE SUBBLOCK
	CALL RNABUF		;STASH USERID IN REMOTE ALIAS SUBBLOCK
	 ERROR <Allocation failure> ;NO ROOM.
	MOVE B,SUBBLK		;RESTORE SUBBLOCK ADDRESS
	MOVEM A,.CDUSR(B)	;SAVE USERID BYTE POINTER
	MOVX A,CD%NEW		;SET CREATE FLAG
	HLLM A,.CDSIZ(B)	;  CLEARING ALL OTHERS
	RET
;routine to add a "change password" remote alias subblock to the list
;CALL RNAPAS
;returns +1 on success
;uses A & B

RNAPAS:	NOISE <IS>
	WORDX <Password>	;GET PASSWORD.
	 CMERRX
	CONFIRM
	CALL RNANOD		;FIND OR CREATE REMOTE ALIAS SUBBLOCK
	MOVEM A,SUBBLK		;SAVE THE ADDRESS OF THE SUBBLOCK
	CALL RNABUF		;STASH THE PASSWORD
	 ERROR <Allocation failure> ;NO ROOM.
	MOVE B,SUBBLK		;RESTORE SUBBLOCK ADDRESS
	MOVEM A,.CDPAS(B)	;PUT PASSWORD BYTE POINTER INTO BLOCK
	MOVE A,.CDSIZ(B)	;IS THIS A NEW BLOCK ?
	TXNE A,CD%NEW
	RET            		;YES. DONE.
	MOVX A,CD%PAS		;NO. CHANGING EXISTING PASSWORD
	IORM A,.CDSIZ(B)
	MOVX A,CD%KIL		;CLEAR DELETE FLAG
	ANDCAM A,.CDSIZ(B)	; (IF SET)
	RET
;routine to add a "change account" remote alias subblock to the list
;CALL RNAACT
;returns +1 on success
;uses A & B

RNAACT:	NOISE <IS>
	WORDX <Account>		;GET ACCOUNT.
	 CMERRX
	CONFIRM
	CALL RNANOD		;FIND OR CREATE REMOTE ALIAS SUBBLOCK
	MOVEM A,SUBBLK		;SAVE THE ADDRESS OF THE SUBBLOCK
	CALL RNABUF		;STASH THE ACCOUNT
	 ERROR <Allocation failure> ;NO ROOM.
	MOVE B,SUBBLK
	MOVEM A,.CDACC(B)	;SAVE ACCOUNT BYTE POINTER
	MOVE A,.CDSIZ(B)	;IS THIS A NEW BLOCK ?
	TXNE A,CD%NEW
	RET            		;YES. DONE.
	MOVX A,CD%ACC		;NO. CHANGING EXISTING ACCOUNT
	IORM A,.CDSIZ(B)
	MOVX A,CD%KIL		;CLEAR DELETE FLAG
	ANDCAM A,.CDSIZ(B)	; (IF SET)
	RET
;routine to add a "delete" remote alias subblock to the list
;CALL RNADEL
;returns +1 on success
;uses A & B

RNADEL:	CONFIRM
	CALL RNANOD		;(/A) FIND OR CREATE REMOTE ALIAS SUBBLOCK
	MOVX B,CD%KIL		;SET DELETE FLAG (CLEARING ALL OTHERS)
	HLLM B,.CDSIZ(A)
	RET
	END