Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-1-exec/exec4.mac
There are 47 other files named exec4.mac in the archive. Click here to see a list.
;SRC:<6-1-EXEC>EXEC4.MAC.4, 4-Nov-85 09:44:10, Edit by KNIGHT
; Dike FROZEN command
;SRC:<6-1-EXEC>EXEC4.MAC.3, 1-Nov-85 10:11:04, Edit by KNIGHT
; Complete that flush. Missed some junk due to STANSW being on.
;SRC:<6-1-EXEC>EXEC4.MAC.2, 31-Oct-85 10:44:22, Edit by KNIGHT
;NIC changes:
; Flush Stanford-only directory bits and incantations
;<6-1-EXEC>EXEC4.MAC.20, 23-Sep-85 20:31:22, Edit by HEGARTY
; Make STAFF and CONSULTANT privileges at LOTS
;<6-1-EXEC>EXEC4.MAC.14, 4-Sep-85 06:16:42, Edit by JPBION
; GSB changes: eliminate FILES-ONLY default for subdirectories
; eliminate default setting of groups from superior directory
;<6-1-EXEC>EXEC4.MAC.13, 28-Aug-85 13:33:47, Edit by HEGARTY
; Get rid of all that LOTS valid bit stuff and fix typo in edit 4
;<6-1-EXEC.FT6>EXEC4.MAC.4, 19-Aug-85 14:59:16, Edit by WHP4
; more changes from Pierre:
; Fix clearing of CRDIR flags before calling subcommands
; Allow changing of Password Expiration date with BUILD
;<6-1-EXEC.FT6>EXEC4.MAC.2, 12-Aug-85 12:16:25, Edit by WHP4
; FT6 merge
;Stanford changes:
; Fix ^ECREATE to default subdirectory parameters correctly if the
; superior directory is itself a subdirectory and user is not WOPR.
; Print out "Password encrypted" on Rel 5 systems with old encryption schemes
; Remove account stuff
; ETHERNET-ACCESS bit in priv. word
; CHARGE-LIMITED build command
;GSB changes:
; Print GSB extended meaning of "Staff" bit (no word processing restrictions)
;LOTS/SCORE changes:
; ACCOUNT-DEFAULT taken out
;LOTS changes:
; Create synonyms for new LOTS BUILD commands.
; 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
; Can't build frozen
; Add USAGE-UPDATE-NEEDED
; Make NOT FILES-ONLY the default for new directories at LOTS
; Consultant bit
;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= 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
;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) BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 1980,1985
;ALL RIGHTS RESERVED.
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%%_>
IFN STANSW,<
MOVE B,.CDPED(P1) ;PASSWORD EXPIRATION DATE
SKIPE B
ETYPE < Password expiration date %2D%%_>
>;IFN STANSW
;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,<
IFN LOTSW,<
TXZE B,SC%CON ;Consultant?
ETYPE < CONSULTANT%_>
TXZE B,SC%STF ;LOTS Staff
ETYPE < STAFF%_>
>;IFN LOTSW
IFE NICSW,<
TXZE B,SC%ENA ;Ethernet access?
ETYPE < ETHERNET-ACCESS%_>
>;IFE NICSW
>;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%_>
>
IFE NICSW,<
IFN STANSW,<
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%PRM
CALL F3NOT
TXZE B,CD%PRM
ETYPE < Perpetual%_>
IFE LOTSW,<
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
>;IFE LOTSW
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 STANSW
>;IFE 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
IFE LOTSW!GSBSW,<
MOVX A,CD%DIR ;MAKE FILES-ONLY THE DEFAULT
>;IFE LOTSW!GSBSW
IFN LOTSW!GSBSW,<
SETZ A, ;NOT FILES-ONLY DEFAULT AT LOTS
>;IFN LOTSW!GSBSW
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
IFE GSBSW,<
TXO Q1,CD%MOD+CD%DAC+CD%SDQ+CD%UGP+CD%DGP+CD%CUG
>;IFE GSBSW
IFN GSBSW,<
TXO Q1,CD%MOD+CD%DAC+CD%SDQ ;NO GROUPS AT GSB!
>;IFN GSBW
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
HRRZS .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
T CONFIDENTIAL,NOTF
IFN STANSW&LOTSW,<
T CONSULTANT,NOTF
>;IFN STANSW&LOTSW
T DECNET-ACCESS,NOTF,..DNA
T DEFAULT-FILE-PROTECTION,,..PFIL
T DIRECTORY-GROUP,NOTF,..DIRE
T DISABLE
T ENABLE
T ENQ-DEQ,NOTF,..ENQ
IFE NICSW,<
IFN STANSW,<
T ETHERNET-ACCESS,NOTF,..ENA
T EXPIRATION-DATE,NOTF,..EXP
T FACULTY,NOTF,.FACUL
>;IFN STANSW
>;IFE NICSW
T FILES-ONLY,NOTF,.FILES
IFE NICSW,<
IFN STANSW,<
IFE LOTSW,<
T FROZEN,NOTF,.INVAL ;CAN'T USE FROZEN COMMAND AT LOTS
>;IFE LOTSW
>;IFN STANSW
>;IFE NICSW
T GENERATIONS,,..GENR
T IPCF,NOTF
T KILL,NOTF
T LIST,,..LIST
T MAINTENANCE,NOTF
T MAXIMUM-SUBDIRECTORIES,,.MAXIM
IFE NICSW,<
IFN STANSW,<
T MUST-RUN-PROGRAM,,.MRP
>;IFN STANSW
>;IFE NICSW
T NOT
T NUMBER
XARC <
T OFFLINE-EXPIRATION-DEFAULT,,.OFFLI
T ONLINE-EXPIRATION-DEFAULT,,.ONLIN
>
T OPERATOR,NOTF
T PASSWORD
T PERMANENT,,..LOQ
IFE NICSW,<
IFN STANSW,<
T PERPETUAL,NOTF,.PERM
>;IFN STANSW
>;IFE NICSW
T PRESERVE,,...PRE
T PROTECTION,,...PRO
T PUSH,,...PUS
; T REMOTE-ALIAS,NOTF,RNAALI
T REPEAT-LOGIN-MESSAGES,NOTF,..RLM
IFE NICSW,<
IFN STANSW,<
IFE LOTSW,<
T STAFF,NOTF,.STAFF
>;IFE LOTSW
IFN LOTSW,<
T STAFF,NOTF,.STAFF
>;IFN LOTSW
>;IFN STANSW
>;IFE NICSW
T SUBDIRECTORY-USER-GROUP,,.SUSER
T TOPS10-PROJECT-PROGRAMMER-NUMBER,NOTF,..TPPN
IFN STANSW,<
IFN LOTSW,<
T USAGE-UPDATE-NEEDED,NOTF,.UPDAT
>;IFN LOTSW
>;IFN STANSW
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
IFE NICSW,<
IFN STANSW,<
T CHARGE-LIMITED,NOTF,..CHGL
>;IFN STANSW
>;IFE NICSW
T CONFIDENTIAL,NOTF
IFN STANSW&LOTSW,<
T CONSULTANT,NOTF
>;IFN STANSW&LOTSW
T DECNET-ACCESS,NOTF,..DNA
T DIRECTORY-GROUP,NOTF,..DIRE
T ENQ-DEQ,NOTF,..ENQ
IFE NICSW,<
IFN STANSW,<
T ETHERNET-ACCESS,NOTF,..ENA
T EXPIRATION-DATE,NOTF,..EXP
T FACULTY,NOTF,.FACUL
>;IFN STANSW
>;IFE NICSW
T FILES-ONLY,NOTF,.FILES
IFE NICSW,<
IFN STANSW,<
IFE LOTSW,<
T FROZEN,NOTF,.INVAL
>;IFE LOTSW
>;IFN STANSW
>;IFE NICSW
T IPCF,NOTF
T KILL,NOTF
T MAINTENANCE,NOTF
IFE NICSW,<
IFN STANSW,<
T MUST-RUN-PROGRAM,,.MRP
>;IFN STANSW
>;IFE NICSW
T OPERATOR,NOTF
IFE NICSW,<
IFN STANSW,<
T PERPETUAL,NOTF,.PERM
>;IFN STANSW
>;IFE NICSW
; T REMOTE-ALIAS,,RNAALI
T REPEAT-LOGIN-MESSAGES,NOTF,..RLM
IFE NICSW,<
IFN STANSW,<
IFE LOTSW,<
T STAFF,NOTF,.STAFF
>;IFE LOTSW
IFN LOTSW,<
T STAFF,NOTF,.STAFF
>;IFN LOTSW
>;IFN STANSW
>;IFE NICSW
T SUBDIRECTORY-USER-GROUP,,.SUSER
T TOPS10-PROJECT-PROGRAMMER-NUMBER,,..NPPN
IFN STANSW,<
IFN LOTSW,<
T USAGE-UPDATE-NEEDED,NOTF,.UPDAT
>;IFN LOTSW
>;IFN STANSW
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 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
IFE NICSW,<
IFN STANSW,<
..ENA: MOVX A,SC%ENA ; Ethernet access.
JRST CPRIV
>;IFN STANSW
>;IFE NICSW
..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
IFE NICSW,<
IFN STANSW,<
.INVAL: MOVX A,CD%NVD ;NOT-VALIDATED FOR LOGIN I.E. FROZEN
JRST CCMODE
IFN LOTSW,<
.CONSU: MOVX A,SC%CON ;LOTS CONSULTANT
JRST CPRIV
>;IFN LOTSW
IFE LOTSW,<
.FACUL: SKIPA A,[CD%FAC] ;SET OR CLEAR FACULTY MODE BIT
.STAFF: MOVX A,CD%STF ;STAFF
JRST CCMODE
>;IFE LOTSW
IFN LOTSW,<
.FACUL: MOVX A,CD%FAC
JRST CCMODE
.STAFF: MOVX A,SC%STF ;LOTS STAFF
JRST CPRIV
>;IFN LOTSW
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
>;IFE 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
IFN STANSW,<
..EXP: TLNE Z,F1 ;PRECEDED BY A NOT?
IFSKP.
NOISE <OF ACCOUNT IS>
DTIVX <Expiration date>
CMERRX
CONFIRM
TLNN B,-1 ;IS IT AN INTERVAL?
IFSKP.
MOVEM B,.CDPED+CRBLK;NO, SAVE EXPIRATION DATE
ELSE.
HRLS B ;CHANGE INTERVAL INTO DAYS
GTAD ;GET CURRENT DATE AND TIME
CAME A,[-1] ;NO SYSTEM DATE AND TIME?
IFSKP.
ERROR <No system date set>
ENDIF.
ADD A,B ;ADD INTERVAL TO CURRENT TIME
MOVEM A,.CDPED+CRBLK
ENDIF.
ELSE.
CONFIRM
SETZM .CDPED+CRBLK ;NO EXPIRATION DATE
ENDIF.
MOVX B,CD%PED ;CHANGE PASSWORD EXPIRATION DATE
IORM B,.CDLEN+CRBLK
TXO Q1,CD%LEN ;INDICATE LENGTH & PASSWD EXP TO BE CONSIDERED
RET
>;IFN STANSW
.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