Trailing-Edge
-
PDP-10 Archives
-
bb-gs97b-sm
-
exec-sources/exec4.mac
There are 47 other files named exec4.mac in the archive. Click here to see a list.
; 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
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%_>
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%_>
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)
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
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: 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
;[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
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
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 FILES-ONLY,NOTF,.FILES
T GENERATIONS,,..GENR
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 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
T ABSOLUTE-ARPANET-SOCKETS,NOTF,..AAS
XARC <
T ARCHIVE-ONLINE-EXPIRED-FILES,NOTF,..ARCH
>
T ARPANET-ACCESS,NOTF,..ANA
T ARPANET-WIZARD,NOTF,..ANW
T CONFIDENTIAL,NOTF
T DECNET-ACCESS,NOTF,..DNA
T DIRECTORY-GROUP,NOTF,..DIRE
T ENQ-DEQ,NOTF,..ENQ
T FILES-ONLY,NOTF,.FILES
T IPCF,NOTF
T KILL,NOTF
T MAINTENANCE,NOTF
T OPERATOR,NOTF
; T REMOTE-ALIAS,,RNAALI
T REPEAT-LOGIN-MESSAGES,NOTF,..RLM
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
;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