Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 6-exec/exec4.mac
There are 47 other files named exec4.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<6-EXEC>EXECVR.MAC.1054, 16-Jul-85 21:36:55, Edit by IAN
; [NIC1054] Flush weird bits from NIC BUILD stuff
;<6-EXEC>EXEC4.MAC.11,  4-Dec-84 01:20:50, Edit by LOUGHEED
; Fix ^ECREATE to default subdirectory parameters correctly if the
;  superior directory is itself a subdirectory and user is not WOPR.
;<6-EXEC>EXEC4.MAC.10, 14-Sep-84 19:10:51, Edit by LOUGHEED
; Print out "Password encrypted" on Rel 5 systems with old encryption schemes
; Remove edit 9.  It is indeed the desired default behavior, even at LOTS.
;  Login subdirectories will be created by OPEN, not by the BUILD command.
;<HEGARTY>EXEC4.MAC.9, 14-Sep-84 15:15:04, Edit by HEGARTY
; Put FILES-ONLY default setting and Default account stuff under an IFE LOTSW
;<HEGARTY>EXEC4.MAC.8, 14-Sep-84 14:45:23, Edit by HEGARTY
; Create synonyms for new LOTS BUILD commands.
;<6-EXEC>EXEC4.MAC.6, 12-Sep-84 21:47:15, Edit by STAFF.HEGARTY
; LOTS changes:
;  Allow building of mode bits CD%VOx where x is A,B,C,D, etc.
;  Bits allow validity checking of user's account on a system
;<6-EXEC>EXEC4.MAC.5,  9-Aug-84 01:04:16, Edit by LOUGHEED
; Make some SUMEX changes apply everywhere
;SCORE:<MERGED-6-EXEC>EXEC4.MAC.2, 11-Jul-84 09:52:06, Edit by JPBION
;Stanford changes:
; Remove account stuff
; ETHERNET-ACCESS bit in priv. word
;GSB changes:
; Print GSB extended meaning of "Staff" bit (no word processing restrictions)
;LOTS/SCORE changes:
; ACCOUNT-DEFAULT taken out
;LOTS changes:
; Can't build frozen
; Add USAGE-UPDATE-NEEDED
;SUMEX changes:
; Set new subdirs user-group to subdir-user-group from top level
; Set new subdirs subdir-user/dir group to same as top superior directory
; Only wheel/opr can add new groups
; More subdir code: default max-subdirs-allowed to 0 for new subdirs
; Reinstall ACCOUNT-DEFAULT FOR LOGIN in ^ECREATE
; Special code for new subdirs (files-only and acct-default for login)
;
; 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
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1980,1981,1982,1983 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	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
	 ERROR <No such directory>
	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
	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		;ARPANET WIZARD?
	ETYPE < ARPANET-WIZARD%_>
	TXZE B,SC%NAS		;ABSOLUTE ARPANET SOCKETS?
	ETYPE < ABSOLUTE-ARPANET-SOCKETS%_>
	TXZE B,SC%DNA
	ETYPE < DECNET-ACCESS%_>
	TXZE B,SC%ANA
	ETYPE < ARPANET-ACCESS%_>
IFN STANSW,<
	TXZE B,SC%ENA		;Ethernet access?
	 ETYPE < ETHERNET-ACCESS%_>
>;IFN STANSW
	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%_>
	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%_>
   >
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	TXZE B,400		;** Flush when everyone is running Rel 6
	 ETYPE < Password is encrypted%_>	;** A Release 5 anachronism
	TXNN B,CD%MRP
	 CALL F3NOT
	  TXZE B,CD%MRP
	   ETYPE < Must-Run-Program%_>
	TXNN B,CD%FAC
	 CALL F3NOT
	  TXZE B,CD%FAC
	   ETYPE < Faculty%_>
	TXNN B,CD%GST
	 CALL F3NOT
	  TXZE B,CD%GST
	   ETYPE < Guest-Account%_>
	TXNN B,CD%PRM
	 CALL F3NOT
	  TXZE B,CD%PRM
	   ETYPE < Perpetual%_>
	TXNN B,CD%STF
	 CALL F3NOT
	  TXZE B,CD%STF
IFE GSBSW,<
	   ETYPE < Staff%_>
>;IFE GSBSW
IFN GSBSW,<
           ETYPE < Staff (no word-processing restrictions)%_>
>;IFN GSBSW
	TXNN B,CD%NVD
	 CALL F3NOT
	  TXZE B,CD%NVD
	   ETYPE < Frozen%_>
	TXNN B,CD%UPD
	 CALL F3NOT
	  TXZE B,CD%UPD
	   ETYPE < Usage-update needed%_>
	TXNN B,CD%RTD
	 CALL F3NOT
	  TXZE B,CD%RTD
	   ETYPE < Root-Directory Subdirectory%_>
	TXNN B,CD%CLM
	 CALL F3NOT
	  TXZE B,CD%CLM
	   ETYPE < Charge-limited%_>
IFN LOTSW,<
	TXNN B,CD%VOA
	 CALL F3NOT
	  TXZE B,CD%VOA
	   ETYPE < Account valid on LOTS-A%_>
	TXNN B,CD%VOB
	 CALL F3NOT
	  TXZE B,CD%VOB
	   ETYPE < Account valid on LOTS-B%_>
	TXNN B,CD%VOC
	 CALL F3NOT
	  TXZE B,CD%VOC
	   ETYPE < Account valid on LOTS-C%_>
	TXNN B,CD%VOD
	 CALL F3NOT
	  TXZE B,CD%VOD
	   ETYPE < Account valid on LOTS-D%_>
>;IFN LOTSW
>;IFN STANSW and not-NICSW
	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)
	JRST [	TLNE Z,F3
		ETYPE < Never logged in%_>
				;CAN'T USE REG CASE CAUSE %D TYPES CURRENT
				;DATE FOR 0
		JRST .+2]
	ETYPE < Last LOGIN %1D %1E%%_>
	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
	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:
IFN STANSW,<
;   The purpose of this routine is to set FILES-ONLY and top level dir's
; ACCOUNT-DEFAULT (FOR LOGIN) and user/directory groups as defaults if this
; is a new subdirectory.  The defaults for old subdirectories are not changed.
;    In either case (new or old), you must have wheel/operator privs to set a
; subdir to NOT FILES-ONLY, to set its ACCOUNT-DEFAULT (FOR LOGIN) or to add
; a new user or directory group number.
;    4-Dec-84.  Fixed to handle cases such as PS:<OR.STONE.FOO> where the
; correct superior directory is OR.STONE, not OR.  Excuse the stack funnies;
; I ran out of AC's. -KSL.
	TLZ Z,F5		;ASSUME NOT A SUBDIR
	MOVE C,[POINT 7,CSTING]	;BYTE PTR TO BUILD TOP LEVEL DIR NAME
	MOVE D,KREDIR		;BYTE PTR TO WHAT USER TYPED
	PUSH P,[0]		;RAN OUT OF AC'S. BYTE POINTER TO LAST DOT.
	DO.
	  ILDB B,D		;LOOK FOR TOP LEVEL DIR NAME
	  IDPB B,C
	  CAIE B,074		;EITHER FLAVOR OF OPENING DELIMITER?
	  CAIN B,"["
	   MOVEI A,2(B)		;YES, REMEMBER CORRESPONDING CLOSING DELIMITER
	  CAIN B,"."		;ASSUME NO DOTS IN STR: (IF PRESENT)
	   MOVEM C,0(P)		;SAVE CURRENT BYTE POINTER
	  JUMPN B,TOP.
	ENDDO.
	POP P,C			;RESTORE C TO STATE OF LAST DOT
	IFN. C
	  TLO Z,F5		;FLAG THIS AS A SUBDIR
	  TLNN Z,F2		;OLD SUBDIR?
	  IFSKP.
	    DPB A,C		;TERMINATE TOP LEVEL DIR NAME
	    SETZ A,
	    IDPB A,C
	    MOVX A,RC%EMO	;EXACT MATCH ON DIR NAME
	    HRROI B,CSTING	;BYTE PTR TO TOP LEVEL DIR NAME
	    RCDIR%		;GET CORRESPONDING DIR NBR
	     ERCAL CJERRE
	    IFXN. A,RC%NOM
	      MOVEI A,CRDI23	;NO, SAY NO SUPERIOR DIRECTORY
	      LERROR <%1?>
	      CALLRET UNMDIR	;FINISH UP AND EXIT
	    ENDIF.
	    MOVE A,C		;COPY DIR NBR
	    MOVEI B,CSTING	;WHERE TO STORE TOP LEVEL DIR INFO
	    SETZM (B)		;CLEAR GTDIR BLOCK SO WE DON'T GET ANY
	    MOVSI C,(B)		; ILLEGAL WRITES CAUSED BY DINGLE IN
	    HRRI C,1(B)		; ANY OF THE ADDR/BYTE-PTR WORDS
	    MOVEI D,CSTING	;SET UP BLT END ADDR
	    BLT C,GTDLN-1(D)
	    MOVEI C,GTDLN	;SET UP LENGTH OF INFO BLOCK
	    MOVEM C,.CDLEN(B)
	    MOVE C,.CDDAC+CRBLK	;BYTE PTR (IN CRDIR BLK) TO ACCT-DFLT
	    MOVEM C,.CDDAC(B)	;SET ACCT-DFLT TO SAME AS TOP LEVEL
	    MOVE C,.CDDGP+CRBLK	;SET DIRECTORY-GROUPS TO SAME AS TOP LEVEL
	    MOVEM C,.CDDGP(B)
	    MOVEI C,DGBUFL	;SET LENGTH
	    MOVEM C,@.CDDGP(B)
	    MOVE C,.CDCUG+CRBLK	;SET SUBDIR-USER-GROUPS TO SAME AS TOP LEVEL
	    MOVEM C,.CDCUG(B)
	    MOVEI C,SGBUFL	;SET LENGTH
	    MOVEM C,@.CDCUG(B)
	    SETZ C,		;NOT INTRESTED IN PASSWORD
	    GTDIR%
	     ERCAL CJERRE
	    MOVX A,CD%DIR	;MAKE FILES-ONLY THE DEFAULT
	    IORM A,.CDMOD+CRBLK
	    SETZM .CDSDQ+CRBLK	;DEFAULT MAX-SUBDIRS-ALLOWED TO 0
	    MOVS A,.CDCUG+CRBLK	;ADDR OF SUBDIR-USER-GROUP LIST (SOURCE)
	    HRR A,.CDUGP+CRBLK	;ADDR OF USER-GROUP LIST (DESTINATION)
	    MOVE B,@.CDCUG+CRBLK	;LENGTH OF SUBDIR-USER-GROUP LIST
	    CAILE B,UGBUFL	;MORE SUBDIR-USER THAN USER GROUPS?
	     MOVEI B,UGBUFL	;YES
	    ADDI B,(A)		;SET UP ENDING ADDR +1
	    BLT A,-1(B)		;SET USER-GROUPS TO TOP LEVEL'S SUBDIR-USERS
	    TXO Q1,CD%MOD+CD%DAC+CD%SDQ+CD%UGP+CD%DGP+CD%CUG
	  ENDIF.
	ENDIF.
>;IFN STANSW
;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:	MOVE A,KREDIR		;GET POINTER TO NAME STRING
	MOVEI B,CRBLK
	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
;CREATE
;SUBCOMMAND DISPATCH TABLE
;FLAG B5 INDICATES "NOT" MAY PRECEDE THE SUBCOMMAND.

NOTF==1B5

$CREAT:	TABLE
	T ABORT,ONEWRD
	T ABSOLUTE-ARPANET-SOCKETS,NOTF,..AAS
	T ACCOUNT-DEFAULT,,.AD
   XARC <
	T ARCHIVE-ONLINE-EXPIRED-FILES,NOTF,..ARCH
   >
	T ARPANET-ACCESS,NOTF,..ANA
	T ARPANET-WIZARD,NOTF,..ANW
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T CHARGE-LIMITED,NOTF,..CHGL
>;IFN STANSW and not-NICSW
	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
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T ETHERNET-ACCESS,NOTF,..ENA
	T FACULTY,NOTF,.FACUL
>;IFN STANSW and not-NICSW
	T FILES-ONLY,NOTF,.FILES
IFN STANSW&<NICSW-1>,<		;[NIC1054]
IFE LOTSW,<
	T FROZEN,NOTF,.INVAL	;CAN'T USE FROZEN COMMAND AT LOTS
>;IFE LOTSW
>;IFN STANSW and not-NICSW
	T GENERATIONS,,..GENR
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T GUEST-ACCOUNT,NOTF,.GUEST
>;IFN STANSW and not-NICSW
	T IPCF,NOTF
	T KILL,NOTF
	T LIST,,..LIST
IFN STANSW&<NICSW-1>,<		;[NIC1054]
IFN LOTSW,<
	T LOTS-A-ACTIVE,NOTF,.VOA
	T LOTS-B-ACTIVE,NOTF,.VOB
	T LOTS-C-ACTIVE,NOTF,.VOC
	T LOTS-D-ACTIVE,NOTF,.VOD
	IT LOTSA-ACTIVE,NOTF,.VOA
	IT LOTSB-ACTIVE,NOTF,.VOB
	IT LOTSC-ACTIVE,NOTF,.VOC
	IT LOTSD-ACTIVE,NOTF,.VOD
>;IFN LOTSW
>;IFN STANSW and not-NICSW
	T MAINTENANCE,NOTF
	T MAXIMUM-SUBDIRECTORIES,,.MAXIM
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T MUST-RUN-PROGRAM,,.MRP
>;IFN STANSW and not-NICSW
	T NOT
	T NUMBER
   XARC <
	T OFFLINE-EXPIRATION-DEFAULT,,.OFFLI
	T ONLINE-EXPIRATION-DEFAULT,,.ONLIN
   >
	T OPERATOR,NOTF
	T PASSWORD
	T PERMANENT,,..LOQ
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T PERPETUAL,NOTF,.PERM
>;IFN STANSW and not-NICSW
	T PRESERVE,,...PRE
	T PROTECTION,,...PRO
	T PUSH,,...PUS
;	T REMOTE-ALIAS,NOTF,RNAALI
	T REPEAT-LOGIN-MESSAGES,NOTF,..RLM
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T STAFF,NOTF,.STAFF
>;IFN STANSW and not-NICSW
	T SUBDIRECTORY-USER-GROUP,,.SUSER
	T TOPS10-PROJECT-PROGRAMMER-NUMBER,NOTF,..TPPN
IFN STANSW&<NICSW-1>,<		;[NIC1054]
IFN LOTSW,<
	T USAGE-UPDATE-NEEDED,NOTF,.UPDAT
>;IFN LOTSW
>;IFN STANSW and not-NICSW
	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
	T ABSOLUTE-ARPANET-SOCKETS,NOTF,..AAS
   XARC <
	T ARCHIVE-ONLINE-EXPIRED-FILES,NOTF,..ARCH
   >
	T ARPANET-ACCESS,NOTF,..ANA
	T ARPANET-WIZARD,NOTF,..ANW
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T CHARGE-LIMITED,NOTF,..CHGL
>;IFN STANSW and not-NICSW
	T CONFIDENTIAL,NOTF
	T DECNET-ACCESS,NOTF,..DNA
	T DIRECTORY-GROUP,NOTF,..DIRE
	T ENQ-DEQ,NOTF,..ENQ
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T ETHERNET-ACCESS,NOTF,..ENA
	T FACULTY,NOTF,.FACUL
>;IFN STANSW and not-NICSW
	T FILES-ONLY,NOTF,.FILES
IFN STANSW&<NICSW-1>,<		;[NIC1054]
IFE LOTSW,<
	T FROZEN,NOTF,.INVAL
>;IFE LOTSW
	T GUEST-ACCOUNT,NOTF,.GUEST
>;IFN STANSW and not-NICSW
	T IPCF,NOTF
	T KILL,NOTF
IFN STANSW&<NICSW-1>,<		;[NIC1054]
IFN LOTSW,<
	T LOTS-A-ACTIVE,NOTF,.VOA
	T LOTS-B-ACTIVE,NOTF,.VOB
	T LOTS-C-ACTIVE,NOTF,.VOC
	T LOTS-D-ACTIVE,NOTF,.VOD
	IT LOTSA-ACTIVE,NOTF,.VOA
	IT LOTSB-ACTIVE,NOTF,.VOB
	IT LOTSC-ACTIVE,NOTF,.VOC
	IT LOTSD-ACTIVE,NOTF,.VOD
>;IFN LOTSW
>;IFN STANSW and not-NICSW
	T MAINTENANCE,NOTF
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T MUST-RUN-PROGRAM,,.MRP
>;IFN STANSW and not-NICSW
	T OPERATOR,NOTF
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T PERPETUAL,NOTF,.PERM
>;IFN STANSW and not-NICSW
;	T REMOTE-ALIAS,,RNAALI
	T REPEAT-LOGIN-MESSAGES,NOTF,..RLM
IFN STANSW&<NICSW-1>,<		;[NIC1054]
	T STAFF,NOTF,.STAFF
>;IFN STANSW and not-NICSW
	T SUBDIRECTORY-USER-GROUP,,.SUSER
	T TOPS10-PROJECT-PROGRAMMER-NUMBER,,..NPPN
IFN STANSW&<NICSW-1>,<		;[NIC1054]
IFN LOTSW,<
	T USAGE-UPDATE-NEEDED,NOTF,.UPDAT
>;IFN LOTSW
>;IFN STANSW and not-NICSW
	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
;TOPS10 PROJECT PROGRAMMER NUMBER

..TPPN:	NOISE <FOR COMPATIBILITY>
	OCTX <octal number in the range 10-377777>
	 CMERRX
	CAIG B,377777
	CAIGE B,10		;.LE.10 RESERVED TO DEC, BUT ALLOW 10
	ERROR <Not in the range 10-377777>
	MOVE D,B		;STASH THE PROJECT NUMBER
	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>
	 CMERRX
	CONFIRM
	CAML B,[^D1000000]	;LESS THAN A MILLION?
	HRLZI B,377777		;NO - GIVE INFINITE QUOTA
	RET

;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

IFN STANSW,<
..ENA:	MOVX A,SC%ENA		; Ethernet access.
	JRST CPRIV
>;IFN STANSW

..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

.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

IFN STANSW&<NICSW-1>,<		;[NIC1054]
.INVAL:	SKIPA A,[CD%NVD]	;NOT-VALIDATED FOR LOGIN I.E. FROZEN
.GUEST:	 MOVX A,CD%GST		;GUEST ACCOUNT
	JRST CCMODE

IFN LOTSW,<
.VOA:	SKIPA A,[CD%VOA]	;ACCOUNT VALID AT LOTS-A
.VOB:	 MOVX A,CD%VOB		;ACCOUNT VALID AT LOTS-B
	JRST CCMODE
.VOC:	SKIPA A,[CD%VOC]	;ACCOUNT VALID AT LOTS-C
.VOD:	 MOVX A,CD%VOD		;ACCOUNT VALID AT LOTS-D
	JRST CCMODE
>;IFN LOTSW

.FACUL:	SKIPA A,[CD%FAC]	;SET OR CLEAR FACULTY MODE BIT
.STAFF:	 MOVX A,CD%STF		;STAFF
	JRST CCMODE

IFN LOTSW,<
.UPDAT:	SKIPA A,[CD%UPD]	;NEEDS UPDATING
>;IFN LOTSW
.PERM:	 MOVX A,CD%PRM		;PERMANENT I.E. OVERHEAD
	JRST CCMODE

..CHGL:	SKIPA A,[CD%CLM]	;CHARGE LIMITED
.MRP:	 MOVX A,CD%MRP		;MUST-RUN-PROGRAM (NO EXEC COMMANDS FROM TTY)
	JRST CCMODE
>;IFN STANSW and not-NICSW

IFE STANSW,<
..ARCH:	SKIPA A,[CD%DAR]
.FILES:	MOVX A,CD%DIR
>;IFE STANSW
IFN STANSW,<
..ARCH:	MOVX A,CD%DAR
	JRST CCMODE

.FILES:	MOVX A,CD%DIR
	TLNE Z,F5		;NOT A SUBDIR
	TLNN Z,F1		; OR FILES-ONLY?
	IFSKP.
	  MOVX B,WHLU+OPRU	;NOT-FILES-ONLY SUBDIR, CHECK PRIVS
	  CALL PRVCK		;(WHEEL/OPER REQD FOR NOT-FILES-ONLY SUBDIR)
	   ERROR <WHEEL or OPERATOR capability required>
	ENDIF.
>;IFN STANSW

;	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
IFN STANSW,<
	MOVX B,WHLU+OPRU	;CHECK PRIVS
	CALL PRVCK
	TLNN Z,F5		;NO PRIVS, TOP LEVEL DIRECTORY?
	IFSKP.
	  MOVE C,A		;SAVE ACCT-DFLT BYTE PTR
	  MOVE B,.CDDAC+CRBLK	;BYTE PTR TO OLD/DEFAULT ACCT-DFLT
	  STCMP%		;SAME?
	  EXCH C,A		;RESTORE ACCT-DFLT BYTE PTR
	  IFN. C
	    TLNN Z,F2		;JUST ERROR IF OLD SUBDIR
	     ERROR <WHEEL or OPERATOR capability required>
	    SKIPE A,.CDDAC+CRBLK	;NEW SUBDIR, GET DEFAULT ACCT BYTE PTR
	     ILDB A,A		;GET 1ST CHAR OF ACCT-DFLT
	    SKIPE A		;(BELT AND SUSPENDERS CODE)
	     SKIPA A,.CDDAC+CRBLK	;NON-NULL ACCT, GET BYTE PTR TO IT
	      HRROI A,[ASCIZ \- none set\]
	    ERROR <WHEEL or OPERATOR capability required%_ [Account default set to %1M]>
	  ENDIF.
	ENDIF.
>;IFN STANSW
	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
IFN STANSW,<
IFN SUMXSW,<
	MOVX B,WHLU+OPRU	;ONLY WHEEL/OPR CAN ADD NEW GROUPS
	CALL PRVCK
	 ERROR <WHEEL or OPERATOR capability required>
>;IFN SUMXSW
>;IFN STANSW
	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