Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/exec/exec4.mac
There are 47 other files named exec4.mac in the archive. Click here to see a list.
;121 (OZ) support for CD%ASO in BUILD and INFO DIR.
;
;713 add literals label
; use new configuration swicthes
;712 DEC release version
; UPD ID= 120, SNARK:<5.EXEC>EXECIN.MAC.21, 28-Dec-81 11:14:01 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 35, SNARK:<5.EXEC>EXEC4.MAC.3, 14-Aug-81 19:12:47 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
;<4.EXEC>EXEC4.MAC.49, 14-Sep-79 16:06:41, Edit by LCAMPBELL
; Account for DTIVX skip returning
;<4.EXEC>EXEC4.MAC.48, 12-Sep-79 10:36:05, EDIT BY OSMAN
;Use LERROR at NODIR instead of ERSTR
;<4.EXEC>EXEC4.MAC.44, 13-Jul-79 15:46:33, EDIT BY OSMAN
;TCO 4.2327 - PREVENT ?EXEC FREE SPACE EXHAUSTED - INFO DIR PS:[*]
;<4.EXEC>EXEC4.MAC.43, 21-Jun-79 13:36:15, EDIT BY OSMAN
;REMOVE EXTRANEOUS REF TO RLJFNS
;<4.EXEC>EXEC4.MAC.42, 7-Jun-79 14:15:20, EDIT BY EKLUND
;tco 4.2277 - add repeat-login-messages subcommand to build (again!)
;<4.EXEC>EXEC4.MAC.41, 6-Jun-79 10:40:14, EDIT BY HELLIWELL
;CHANGE WHLUO & OPRUO TO WHLU & OPRU IN "PRESERVE" SUBCOMMAND (NOSHIP)
;<4.EXEC>EXEC4.MAC.39, 1-May-79 11:20:10, EDIT BY OSMAN
;CHANGE GTJFN TO CALL GTJFS SO THAT ^C CAN'T LEAVE JFN AROUND
;<4.EXEC>EXEC4.MAC.38, 12-Mar-79 17:51:10, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXEC4.MAC.37, 28-Feb-79 11:05:02, EDIT BY OSMAN
;REMOVE REFS TO CTYPE (USE ETYPE INSTEAD)
;<4.EXEC>EXEC4.MAC.36, 7-Feb-79 13:51:39, EDIT BY OSMAN
;FIX PRINTOUT (GET RID OF _)
;<4.EXEC>EXEC4.MAC.34, 23-Jan-79 10:36:21, EDIT BY OSMAN
;CLEAR F1 ("NOT") BEFORE EACH "BUILD" SUBCOMMAND
;<4.EXEC>EXEC4.MAC.30, 18-Jan-79 18:08:55, EDIT BY OSMAN
;CHANGE THOSE SEMIS TO XARC
;<4.EXEC>EXEC4.MAC.27, 22-Dec-78 09:38:02, EDIT BY OSMAN
;put semicolons in front of all offline-exp/online-exp/archive-online stuff
;because we're not doing that stuff for r4
;<4.EXEC>EXEC4.MAC.26, 9-Nov-78 14:44:12, EDIT BY OSMAN
;TCO 4.2086 - FIX GRPCHK
;GET RID OF REFS TO UGBUF ETC. (MAKE THEM LOCAL REFS)
;<4.EXEC>EXEC4.MAC.17, 27-Sep-78 14:00:47, EDIT BY OSMAN
;CHANGE "B5" REFS TO 1B5 (VIA SYMBOL "NOTF")
;<4.EXEC>EXEC4.MAC.13, 15-Sep-78 23:21:51, EDIT BY OSMAN
;REMOVE ALL REFS TO CSBUFP
;<4.EXEC>EXEC4.MAC.12, 14-Sep-78 14:10:08, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXEC4.MAC.11, 13-Aug-78 14:00:27, Edit by HELLIWELL
;MAKE PRESERVE SUBCOMMAND CALL PRVCK
;<4.EXEC>EXEC4.MAC.10, 29-Jul-78 14:49:17, Edit by HELLIWELL
;ALWAYS CONVERT DIRECTORY NAME TO CONONICAL FORM AT CRET1
;<4.EXEC>EXEC4.MAC.7, 17-Jul-78 10:55:52, EDIT BY OSMAN
;GET RID OF GTBUF (USE LOCAL BLOCK IN PLACES WHERE ITS REFERENCED)
;<4.EXEC;MAKE DFBUF BE LOCAL
;<4.EXEC>EXEC4.MAC.4, 11-Jul-78 16:39:41, EDIT BY OSMAN
;MAKE ^EPRINT AND ^ECREATE USE LOCAL STORAGE
;<4.EXEC>EXEC4.MAC.3, 9-Jun-78 18:05:29, EDIT BY OSMAN
;CHANGE CALLS TO FIELD TO FLDSKP
;<4.EXEC>EXEC4.MAC.2, 6-Jan-78 12:18:11, EDIT BY HELLIWELL
;<4.EXEC>EXEC4.MAC.1, 6-Jan-78 12:08:14, EDIT BY HELLIWELL
;ADD "PRESERVE (SUPERIOR QUOTAS)" SUBCOMMAND TO CREATE/BUILD
;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 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::MOVEI A,[ASCIZ/INFORM/] ;7 setup for program name setup
HRROM A,COMAND ;7
.INDIR::TRVAR <<EPBLK,GTDLN>,EPFLG,EPDIR,EPWLS> ;7 label moved from IN
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
; FOR "PRINT" COMMAND AND FOR "LIST" SUBCOMMAND OF "CREATE".
;
; ACCEPTS: Z/ F3 ON, PRINT NON-DEFAULT VALUES
; F4 ON, PRINT NAME ONLY
; A/ DIR NUMBER OR POINTER TO DIR NAME STRING
; 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
CAIE A,0 ;NAME IS NOT IN BLOCK FOR "PRINT".
ETYPE < Name %1R%%_>
TLNE Z,F4 ;PRINT NAME ONLY?
RET ;YES, EXIT
TLNN Z,F3 ;7 print password message only in verbose
JRST PR2A ;7
TYPE < Password not available> ;7 never print them out ;121
DELETE,<TYPE < Password > ;7 old code here
SKIPN A,.CDPSW(P1)
JRST [TYPE <- not available>
JRST PR2]
MOVE B,A ;SEE IF THERE IS A PASSWORD
ILDB B,B ;GET FIRST CHARACTER OF STRING
JUMPE B,[TYPE <- none set>
JRST PR2]
ETYPE <%1M>
> ;7 end DELETE
PR2: ETYPE<%_>
PR2A: SETZB A,C ;GET DEFAULT INFO
MOVX B,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM B,.CDLEN+DFBUF ;IN FIRST WORD OF BUFFER
MOVEI B,DFBUF
GTDIR
ERCAL JERRE
MOVX 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%LSA ;7 user can create NOT FILES-ONLY dirs
CALL F3NOT ;7
TXZE B,SC%LSA ;7
ETYPE < Creator of login-directories%_> ;7
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%_>
ARPA,< TXZE B,SC%ANA ;713
ETYPE < Arpanet-access%_>
TXZE B,SC%NAS ;ABSOLUTE ARPANET SOCKETS?
ETYPE < Absolute-arpanet-sockets%_>
TXZE B,SC%NWZ ;ARPANET WIZARD?
ETYPE < Arpanet-wizard%_>
> ;713
CHA,< TXZE B,SC%CHA ;7 CHAOSnet capability
ETYPE < Chaosnet-access%_> ;7
> ;7
DECN,< TXZE B,SC%DNA ;713
ETYPE < Decnet-access%_>
> ;713
CAIE B,0 ;NO MORE PRIVILEGES
ETYPE < Other capabilities %2O%%_>
;DIRPNT...
;MODE
MOVE B,.CDMOD(P1)
TXNN B,CD%DIR
CALL F3NOT
NOOZ, TXZE B,CD%DIR ;121
OZ, TXNE B,CD%DIR ;121
ETYPE < Files-only%_>
OZ,< ;121
TXZE B,CD%DIR ;121 Do this only if account is loginable
IFSKP. ;121
TXNN B,1B9 ;121 CD%ASO
CALL F3NOT ;121
TXZE B,1B9 ;121 Can't think of a better name at the
ETYPE < Turned-off-account%_> ;121 moment which avoids conflict
ENDIF. ;121 with BUILD subcommands.
> ;121
TXNN B,CD%LSA ;7 NOT FILES-ONLY subdirectories allowed
CALL F3NOT ;7
TXZE B,CD%LSA ;7
ETYPE < Login-subdirectories-allowed%_> ;7
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%_>
>
CAIE B,0 ;TEST FOR ADDITIONAL MODE BITS
ETYPE < Other mode bits %2O%%_>
SKIPN B,.CDNUM(P1)
JRST [TLNE Z,F3
ETYPE < No directory number%_>
JRST .+2] ;0: NOT ASSIGNED YET ("CREATE" CASE)
ETYPE < Number of directory %2O%%_>
MOVE B,.CDFPT(P1)
TXZ 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
CAIN B,0 ;IS THERE AN ACCOUNT DEFAULT?
SKIPA B,[TXTPTR <- none set>]
MOVE B,DACTPR ;YES, GET POINTER TO ACCOUNT STRING
ETYPE < Account default for LOGIN %2M%%_>
MOVE B,.CDDPT(P1)
TXZ 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
JRST .+2] ; FOR 0
ETYPE < Last LOGIN %1D %1E%%_>
MOVE A,.CDUGP(P1)
MOVEI B,[ASCIZ/User 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>
ETYPE<%_>
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)
ETYPE < - 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
CAIN B,UGBUFL ;CHECK FOR *POSSIBLE* OVERFLOW
ETYPE < User group buffer overflow%_>
MOVE B,@.CDDGP(A) ;SAME FOR OTHER GROUP BUFFERS
CAIN B,DGBUFL
ETYPE < Directory group buffer overflow%_>
MOVE B,@.CDCUG(A)
CAIN B,SGBUFL
ETYPE < 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?
ABSKP ;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
;"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.
;
; ACS: B/ POINTER TO BLOCK FOR CRDIR
; Q1/ LH: FLAGS SET BY USER
; RH: OTHER FLAGS
.CREAT::MOVEI A,[ASCIZ/BUILD/] ;7 setup for program name setup
HRROM A,COMAND ;7
.BUILD::NOISE <directory name> ;7 add global label
TRVAR <CRPASS,<CSTING,FILWDS>,<CRBLK,GTDLN>,KREDIR>
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,,<an old directory name being
modified>,,[
FLDDB. .CMDIR,CM%PO+CM%SDH,,<a 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 CJERRE ;7 makes more sense
;7 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
MOVX B,GTDLN ;SET UP LENGTH OF BUFFER
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
MOVX B,1 ;MAKE EMPTY GROUP BUFFERS
MOVEM B,@.CDUGP(A)
MOVEM B,@.CDDGP(A)
MOVEM B,@.CDCUG(A)
MOVX B,CD%DIR ;7 put FILES-ONLY default in .CDMOD
IORM B,.CDMOD(A) ;7
TXO Q1,CD%LIQ!CD%MOD!CD%LOQ!CD%FPT!CD%DPT!CD%RET ;7 add CD%MOD
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
MOVX B,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM B,.CDLEN+CRBLK ;IN FIRST WORD OF BUFFER
MOVEI B,CRBLK
SETZ C, ;7 try w/o password first
;7 HRROI C,CSTING ;PASSWORD GOES HERE (POINTER STORED IN BUFFER
; BY GTDIR)
MOVE D,.CDDAC(B) ;GET POINTER TO WHERE ACCOUNT WILL GO
GTDIR
ERCAL CJERRE
MOVEM D,.CDDAC(B) ;RESTORE ACCOUNT POINTER TO POINT AT BEGINNING
;7 HRROI A,CSTING ;POINT TO PASSWORD
;7 CALL BUFFS ;ISOLATE IT
;7 SKIPE .CDPSW+CRBLK ;NO POINTER STORED MEANS PASSWORD NOT AVAILABLE
;7 MOVEM A,.CDPSW+CRBLK ;STORE POINTER TO ISOLATED PASSWORD
MOVEI A,CRBLK ;GET ADDRESS OF BLOCK
CALL GRPCHK ;CHECK FOR GROUP OVERFLOW
;CREATE
;INPUT PASSWORD.
;FOR OLD DIRECTORY, THIS PASSWORD REPLACES OLD ONE - IS THAT GOOD?
;7 not anymore - purpose of inline password is to gain access
CRET1A: CALL PASWD ;7 get password
MOVEM A,CRPASS ;7 save password pointer
ILDB A,A ;7 is it a null password?
CAIN A,0 ;7
SETZM CRPASS ;7 yes - indicate no password
DELETE,<NOISE <password> ;7 old code here
WORDX <Password>
CMERRX
CALL BUFFF
LDB B,[FIRCHR 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
> ;7 end DELETE
CREAT3: COMMAX <Optional comma, then carriage return to go into subcommand
mode>
NOP ;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
CRDIR ;CREATE DIRECTORY!
ERJMP NODIR ;FAILED, LET USER FIX SUBCOMMANDS AND TRY AGAIN
CALLRET UNMDIR
;GET TO HERE IF CRDIR FAILED. TELL USER, LET HIM FIX SUBCOMMANDS AND TRY AGAIN.
NODIR: 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
ETYPE <[New]%_>
TLNN Z,F2
ETYPE <[Old]%_>
RET
;CREATE...
;SUBCOMMAND DISPATCH TABLE
; FLAG B5 INDICATES "NOT" MAY PRECEDE THE SUBCOMMAND.
NOTF==1B5
$CREAT: TABLE
T abort,ONEWRD
ARPA,< T absolute-arpanet-sockets,NOTF,..AAS> ;713
T account-default,,.AD
XARC,< T archive-online-expired-files,NOTF,..ARCH>
ARPA,< T ARPAnet-access,NOTF,..ANA ;713
T ARPAnet-wizard,NOTF,..ANW
> ;713
CHA,< T CHAOSnet-access,NOTF,..CHA> ;713
T confidential,NOTF
T creator-of-login-directories,NOTF,..CLD ;7
DECN,< T DECnet-access,NOTF,..DNA> ;713
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 login-subdirectories-allowed,NOTF,..LSA ;7
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 repeat-login-messages,NOTF,..RLM
T subdirectory-user-group,,.SUSER
OZ,< T turn-off,NOTF,.TURNO> ;121
T user-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
ARPA,< T absolute-arpanet-sockets,NOTF,..AAS> ;713
XARC,< T archive-online-expired-files,NOTF,..ARCH>
ARPA,< T ARPAnet-access,NOTF,..ANA ;713
T ARPAnet-wizard,NOTF,..ANW ;713
> ;713
CHA,< T CHAOSnet-access,NOTF,..CHA> ;7
T confidential,NOTF
T creator-of-login-directories,NOTF,..CLD ;7
DECN,< T DECnet-access,NOTF,..DNA> ;713
T directory-group,NOTF,..DIRE
T enq-deq,NOTF,..ENQ
T files-only,NOTF,.FILES
T ipcf,NOTF
T kill,NOTF
T login-subdirectories-allowed,NOTF,..LSA ;7
T maintenance,NOTF
T operator,NOTF
T repeat-login-messages,NOTF,..RLM
T subdirectory-user-group,,.SUSER
OZ,< T turn-off,NOTF,.TURNO > ;121
T user-group,NOTF,.USER
T wheel,NOTF
TEND
;ROUTINES FOR THE INDIVIDUAL SUBCOMMANDS
;PASSWORD
; CURRENTLY REDUNDANT EXCEPT THAT IT ALLOWS TYPIN IN A FORMAT MORE LIKE WHAT
; "PRINT" PUTS OUT AND ALLOWS GIVING A NULL STRING (USEFUL?).
;7 not true anymore - since we never print out passwords
.PASSW: WORDX <1 to 39 alphanumeric characters or hyphens>
CMERRX
CONFIRM
CALL BUFFF
MOVEM A,.CDPSW+CRBLK
TXO Q1,CD%PSW
RET
;"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>
CALL DECIML ;7 allow "infinity" also
;7 DECX <Decimal number of pages>
CMERRX
CONFIRM
MOVE B,A ;7 move number to B
;7 CAML B,[^D1000000] ;LESS THAN A MILLION?
;7 HRLZI B,377777 ;NO - GIVE INFINITE QUOTA
RET
;SUBCOMMANDS FOR SPECIFIC PRIVILEGES AND MODES.
;
; ACS: Z/ F1 ON, IF PRECEDED BY "NOT".
; A/ MASK INDICATING BITS TO SET (F1 OFF), OR CLEAR (F1 ON).
ARPA,< ;713
..AAS: SKIPA A,[SC%NAS] ;ABSOLUTE ARPANET SOCKETS
..ANW: MOVX A,SC%NWZ ;ARPANET WIZARD
JRST CPRIV
..ANA: MOVX A,SC%ANA
JRST CPRIV
> ;713
CHA,< ;7 CHAOSnet access
..CHA: MOVX A,SC%CHA ;7
JRST CPRIV ;7
> ;7
DECN,< ;713
..DNA: MOVX A,SC%DNA
JRST CPRIV
> ;713
..CLD: SKIPA A,[SC%LSA] ;7 user can create NOT FILES-ONLY dirs
..ENQ: MOVX A,SC%ENQ
JRST CPRIV
.IPCF: SKIPA A,[SC%IPC]
.MAINT: MOVX A,SC%MNT
JRST CPRIV
.WHEEL: SKIPA A,[SC%WHL]
.OPERA: MOVX A,SC%OPR
JRST CPRIV
.CONFI: NOISE <information access capability>
SKIPA A,[SC%CNF]
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
OZ,< ;121
.TURNO: NOISE <logins on this account> ;121
MOVX A,1B9 ;121 CD%ASO
JRST CCMODE ;121
> ;121
..LSA: SKIPA A,[CD%LSA] ;7 directory can have NOT FILES-ONLY subdirs
..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
ABSKP ;NOT IN USE
ERROR <Number already in use>
NUMBE1: CONFIRM
MOVEM B,.CDNUM+CRBLK
CAIE B,0
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?
;7 make it take 8 digits instead of 6 (first two for superior directory)
...PRO: NOISE <of directory>
OCTX <8-digit octal number> ;7 change help message
;7 OCTX <6-digit octal number>
CMERRX
CONFIRM
TLNE B,777700 ;7 allow upto 8 digits
;7 TLNE B,777777 ;ALLOW TALT+TSPC+TEOL
ERROR <8-digit value only> ;7 change error message
;7 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,[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...
;SUBDIRECTORIES
;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
;7 probably can't RET since in subcommand
;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
ETYPE < 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
LITS4: ;713 debugging aid: literals label
END