IDENT MLSEXEC,MLSEXEC
ABS
SST
SYSCOM B1
ENTRY SETFAL
ENTRY SETJAL
ENTRY SETPFAC
ENTRY SETPFAL
ENTRY RFL=
ENTRY SDM=
ENTRY SSJ=
TITLE MLSEXEC - SECURITY COMMAND PROCESSOR.
*COMMENT MLSEXEC - SECURITY COMMAND PROCESSOR.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4,10
*** MLSEXEC - SECURITY COMMAND PROCESSOR.
* M. S. PESCHMAN. 82/08/20.
* P. J. ENGLE. 82/10/01.
SPACE 4,10
*** MLSEXEC PROCESSES MULTI-LEVEL SECURITY COMMANDS FOR ALTERING
* A JOB OR FILE ACCESS LEVELS AND CATEGORIES.
*
* COMMAND DESCRIPTION
*
* SETFAL SET FILE ACCESS LEVEL.
* SETJAL SET JOB ACCESS LEVEL.
* SETPFAC SET PERMANENT FILE ACCESS CATEGORIES.
* SETPFAL SET PERMANENT FILE ACCESS LEVEL.
SETFAL SPACE 4,10
*** SETFAL COMMAND CALL.
*
* SETFAL,LFN,AL=LEVEL.
*
* LFN = LOCAL FILE NAME.
*
* LEVEL = ACCESS LEVEL. VALID ACCESS LEVEL NAMES
* ARE DEFINED IN *COMSMLS*.
SETJAL SPACE 4,10
*** SETJAL COMMAND CALL.
*
* SETJAL,AL=LEVEL.
*
* LEVEL = ACCESS LEVEL. VALID ACCESS LEVEL NAMES
* ARE DEFINED IN *COMSMLS*.
SETPFAC SPACE 4,30
*** SETPFAC COMMAND CALL.
*
* SETPFAC,PFN,AC=CAT1,CAT2,...,CATN/PN=PACKNAM,R=DEVICE,NA,WB.
*
* PFN = PERMANENT FILE NAME.
*
* CATX = ACCESS CATEGORIES. VALID ACCESS CATEGORIES NAMES
* ARE DEFINED IN *COMSMLS*. WHEN THE CATEGORY NAME
* IS PREFACED BY A MINUS (-) THE CATEGORY IS DELETED
* FROM THE FILE. IF THE CATEGORY NAME IS PREFACED
* BY A PLUS (+) THE CATEGORY IS ADDED TO THE FILE.
* IF THE FIRST CATEGORY SPECIFIED IS *0* ALL CATEGORIES
* WILL INITIALLY BE CLEARED.
*
* PACKNAM = OPTIONAL AUXILIARY PACK NAME.
*
* DEVICE = DEVICE TYPE OF AUXILIARY PACK.
*
* NA = NO ABORT OPTION. IF SET PROGRAM WILL NOT
* ABORT. IF THE FILE IS BUSY THE JOB
* WILL BE SUSPENDED UNTIL THE FILE IS
* AVAILABLE. FOR ALL OTHER CONDITIONS,
* THE ERROR MESSAGE WILL BE ISSUED AND
* THE PROGRAM WILL CONTINUE. *NA* CANNOT BE
* SPECIFIED TOGETHER WITH *WB*.
*
* WB = WAIT BUSY OPTION. IF SET, PROGRAM WILL
* WAIT FOR BUSY FILES AND PACK MOUNTS, BUT
* ALL OTHER ERRORS WILL CAUSE ABORTS. *WB*
* CANNOT BE SPECIFIED TOGETHER WITH *NA*.
SETPFAL SPACE 4,40
*** SETPFAL COMMAND CALL.
*
* SETPFAL,PFN,AL=LEVEL/PN=PACKNAM,R=DEVICE,NA,WB.
*
* PFN = PERMANENT FILE NAME.
*
* LEVEL = ACCESS LEVEL. VALID ACCESS LEVEL NAMES ARE
* DEFINED IN *COMSMLS*.
*
* PACKNAM = OPTIONAL AUXILARY PACK NAME.
*
* DEVICE = DEVICE TYPE OF AUXILIARY PACK.
*
* NA = NO ABORT OPTION. IF SET PROGRAM WILL NOT
* ABORT. IF THE FILE IS BUSY THE JOB
* WILL BE SUSPENDED UNTIL THE FILE IS
* AVAILABLE. FOR ALL OTHER CONDITIONS,
* THE ERROR MESSAGE WILL BE ISSUED AND
* THE PROGRAM WILL CONTINUE. *NA* CANNOT BE
* SPECIFIED TOGETHER WITH *WB*.
*
* WB = WAIT BUSY OPTION. IF SET, PROGRAM WILL
* WAIT FOR BUSY FILES AND PACK MOUNTS, BUT
* ALL OTHER ERRORS WILL CAUSE ABORTS. *WB*
* CANNOT BE SPECIFIED TOGETHER WITH *NA*.
SPACE 4,15
*** DAYFILE MESSAGES.
*
* * UNKNOWN ACCESS CATEGORY NAME.* = THE COMMAND
* CONTAINS AN UNKNOWN ACCESS CATEGORY NAME.
*
* * UNKNOWN ACCESS LEVEL NAME.* = THE COMMAND
* CONTAINS AN UNKNOWN ACCESS LEVEL NAME.
*
* * INCORRECT ARGUMENT.* = THE COMMAND CONTAINS
* AN INCORRECT ARGUMENT.
SPACE 4,10
* COMMON DECKS.
*CALL COMCMAC
*CALL COMSMLS
*CALL COMSPFM
*CALL COMSSSJ
SPACE 4,10
**** ASSEMBLY CONSTANTS.
FBUFL EQU 201B FILE BUFFER LENGTH
****
SPACE 4,10
SDM= EQU 0 SUPPRESS DAYFILE MESSAGE
SSJ= EQU 0 SPECIAL SYSTEM JOB (*SETPFAC* ONLY)
TITLE FETS AND RESERVED LOCATIONS.
ORG 120B
MLSEXEC BSS 0
SPACE 4,10
* FETS.
F FILEB FBUF,FBUFL,FET=CFLM FET FOR *LFM* AND *PFM* REQUESTS
.F BSS 0
ORG F+1
VFD 13/0,1/1,22/0,6/CFLM-5,18/FBUF
ORG .F
SPACE 4,10
* RESERVED LOCATIONS.
ACAT CON 0 ACCESS CATEGORIES
ALVL CON 0 ACCESS LEVEL
FNAM CON 0 FILE NAME
NABT CON 0 NO ABORT FLAG
NONZ CON 1 NON-ZERO WORD
PKNM CON 0 PACK NAME
RESD CON 0 RESIDENCE OF FILE
SCFL CON 0 SET/CLEAR FLAG
WBSY CON 0 WAIT WHILE BUSY FLAG
ZERO CON 0 ZERO WORD FOR *ARG* DEFAULT
TITLE SETFAL - SET FILE ACCESS LEVEL.
** SETFAL,LFN,AL=LEVEL.
*
* SET THE SECURITY ACCESS LEVEL OF FILE *LFN* TO LEVEL *AL*.
SETFAL BSS 0 ENTRY
SB1 1
DISSJ DISABLE *SSJ=*
RJ IDM ISSUE DAYFILE MESSAGE
SB2 B0+ SET FIRST PARAMETER NOT TO BE EQUIVALENCED
SB5 TARG+5 SET ARGUMENT TABLE ADDRESS
RJ PRP PROCESS PARAMETERS
SB2 B0+
SA1 ALVL
RJ VLC VALIDATE ACCESS LEVEL
SX5 ALER
NG X2,ABT IF UNKNOWN ACCESS LEVEL NAME
BX6 X2
SA6 ALVL SAVE ACCESS LEVEL
SETFAL F,ALVL SET FILE ACCESS LEVEL
ENDRUN
TITLE SETJAL - SET JOB ACCESS LEVEL.
** SETJAL,AL=LEVEL.
*
* SET THE SECURITY ACCESS LEVEL OF THE JOB TO LEVEL *AL*.
SETJAL BSS 0 ENTRY
SB1 1
DISSJ DISABLE *SSJ=*
RJ IDM ISSUE DAYFILE MESSAGE
SB2 1 SET FIRST PARAMETER TO BE EQUIVALENCED
SB5 TARG+5 SET ARGUMENT TABLE ADDRESS
RJ PRP PROCESS PARAMETERS
SB2 B0+
SA1 ALVL ACCESS LEVEL TO VALIDATE
RJ VLC VALIDATE ACCESS LEVEL
SX5 ALER
NG X2,ABT IF UNKNOWN ACCESS LEVEL NAME
BX6 X2
SA6 ALVL SAVE ACCESS LEVEL
SETJAL ALVL SET JOB ACCESS LEVEL
ENDRUN
TITLE SETPFAC - SET PERMANENT FILE ACCESS CATEGORY.
** SETPFAC,PFN,AC=CAT1,CAT2,...,CATN/PN=PACKNAM,R=DEVICE,NA,WB.
*
* CHANGE THE ACCESS CATEGORIES OF THE PERMANENT FILE *PFN*.
*
* PFN = PERMANENT FILE NAME.
* AC = ACCESS CATEGORIES.
* PN = OPTIONAL AUXILIARY PACK NAME.
* R = DEVICE TYPE OF AUXILIARY PACK.
* NA = THE NO ABORT OPTION.
* WB = THE WAIT-IF-BUSY OPTION.
SETPFAC BSS 0 ENTRY
SB1 1
RJ IDM ISSUE DAYFILE MESSAGE
* SAVE FILE NAME.
SA1 ARGR GET FIRST ARGUMENT
SX5 IAER
ZR X1,ABT IF NO ARGUMENTS
MX0 42 SAVE FILE NAME
BX6 X0*X1
SA6 FNAM
SX2 3 SET FET COMPLETE
BX6 X2+X6
SA6 F
BX2 -X0*X1
NZ X2,ABT IF ILLEGAL SEPARATOR
* CHECK THAT *AC* PARAMETER IS SPECIFIED.
SA2 SACA
SA1 A1+B1
BX2 X2-X1
NZ X2,ABT IF INCORRECT ARGUMENT
* CHECK IF ANY OPTIONAL PARAMETERS SPECIFIED.
SAC1 SA1 A1+1 SEARCH FOR DELIMITER */*
ZR X1,SAC2 IF END OF ARGUMENTS
SX2 X1-1R/
NZ X2,SAC1 IF NOT */*
SA2 ACTR GET ARGUMENT COUNT
SX3 A1-ARGR+1
IX3 X2-X3
SB4 X3 SET ARGUMENT COUNT
SA4 A1+1 SET FIRST ARGUMENT
SB5 TARG SET ARGUMENT TABLE
RJ ARG PROCESS ARGUMENTS
SX5 IAER
NZ X1,ABT IF INCORRECT ARGUMENT
SA1 A1 SIGNAL END OF CATEGORIES TO CHECK
MX0 42
BX6 X0*X1
SA6 A1
SX6 B0+
SA6 A1+1
RJ PNA PROCESS *NA* AND *WB* OPTIONS
* GET CURRENT ACCESS CATEGORIES.
SAC2 CATLIST F,FNAM,,,PKNM,RESD
DISSJ DISABLE *SSJ=*
SA1 F+1 GET ADDRESS OF BUFFER
SA1 X1+FCFC GET ACCESS CATEGORIES
MX0 -32
BX6 -X0*X1
SA6 ACAT STORE ACCESS CATEGORIES
* CHECK IF CLEAR ALL CATEGORIES.
SA1 ARGR+2
SA2 =1L0
BX6 X2-X1
NZ X6,SAC3 IF NOT *0*
SA6 ACAT
SA1 A1+1 GET FIRST CATEGORY
ZR X1,SAC8 IF NO CATEGORIES
* CHECK SPECIFIED CATEGORIES.
SAC3 MX0 42
BX2 X0*X1
NZ X2,SAC6 IF CATEGORY NAME
* CHECK IF CATEGORY TO BE SET OR CLEARED.
BX3 -X0*X1 ISOLATE SEPARATOR
SX4 X3-1R-
NZ X4,SAC4 IF NOT *-*
SX6 -1 SIGNAL CATEGORY CLEAR
SA6 SCFL
EQ SAC5 CLEAR CATEGORY
SAC4 SX4 X3-1R+
ZR X4,SAC5 IF *+*
SX5 IAER
EQ ABT PROCESS ILLEGAL SEPARATOR
* VALIDATE ACCESS CATEGORY.
SAC5 SA1 A1+1 POSITION TO CATEGORY NAME
SAC6 BX3 -X0*X1
SB2 B1 SIGNAL VALIDATE ACCESS CATEGORY
SX5 IAER
NZ X3,ABT IF ILLEGAL SEPARATOR
RJ VLC VALIDATE ACCESS CATEGORY
SX5 ACER
NG X2,ABT IF UNKNOWN ACCESS CATEGORY
SX0 1
SB2 X2
LX2 X0,B2
SA3 ACAT GET CURRENT ACCESS CATEGORIES
SA4 SCFL GET SET/CLEAR FLAG
BX6 -X2*X3 CLEAR ACCESS CATEGORY
NG X4,SAC7 IF CLEAR ACCESS CATEGORY
BX6 X6+X2 SET ACCESS CATEGORY
SAC7 SA6 ACAT
* CHECK IF MORE CATEGORIES TO PROCESS
SX6 B0+ RESET SET/CLEAR FLAG
SA6 SCFL
SA1 A1+1 GET NEXT CATEGORY
NZ X1,SAC3 IF MORE CATEGORIES
* SET PERMANENT FILE ACCESS CATEGORY.
SAC8 SETPFAC F,,ACAT,PKNM,RESD SET FILE ACCESS CATEGORIES
RJ CES CHECK ERROR STATUS
ZR X6,SAC9 IF FILE BUSY
ENDRUN
SAC9 ROLLOUT ZERO ROLL OUT UNTIL FILE AVAILABLE
EQ SAC8 RETRY AFTER ROLLED IN
SACA VFD 12/2LAC,42/0,6/1L=
TITLE SETPFAL - SET PERMANENT FILE ACCESS LEVEL.
** SETPFAL,PFN,AL=LEVEL/PN=PACKNAME,R=TYPE,NA,WB.
*
* CHANGE THE ACCESS LEVEL OF THE PERMANENT FILE *PFN*.
*
* PFN = PERMANENT FILE NAME.
* AL = ACCESS LEVEL.
* PN = OPTIONAL AUXILIARY PACK NAME.
* R = DEVICE TYPE.
* NA = THE NO ABORT OPTION.
* WB = THE WAIT-IF-BUSY OPTION.
SETPFAL BSS 0 ENTRY
SB1 1
DISSJ DISABLE *SSJ=*
RJ IDM ISSUE DAYFILE MESSAGE
SB2 B0+ SET FIRST PARAMETER NOT TO BE EQUIVALENCED
SB5 TARG SET ARGUMENT TABLE
RJ PRP PROCESS PARAMETERS
RJ PNA PROCESS *NA* AND *WB* OPTIONS
SB2 B0+
SA1 ALVL ACCESS LEVEL TO CHECK
RJ VLC VALIDATE ACCESS LEVEL
SX5 ALER
NG X2,ABT IF UNKNOWN ACCESS LEVEL NAME
BX6 X2
SA6 ALVL
SAL1 SETPFAL F,,ALVL,PKNM,RESD SET PERMANENT FILE ACCESS LEVEL
RJ CES CHECK ERROR STATUS
ZR X6,SAL2 IF FILE BUSY
ENDRUN
SAL2 ROLLOUT ZERO ROLL OUT UNTIL FILE AVAILABLE
EQ SAL1 RETRY AFTER ROLLED IN
TITLE SUBROUTINES.
ABT SPACE 4,10
** ABT - ABORT JOB.
*
* ISSUE DAYFILE MESSAGE THEN ABORT.
*
* ENTRY (X5) = ADDRESS OF ERROR MESSAGE.
*
* MACROS ABORT, MESSAGE.
ABT BSS 0 ENTRY
MESSAGE X5 ISSUE DAYFILE MESSAGE
ABORT ABORT JOB
ACER DATA C* UNKNOWN ACCESS CATEGORY NAME.*
ALER DATA C* UNKNOWN ACCESS LEVEL NAME.*
IAER DATA C* INCORRECT ARGUMENT.*
CES SPACE 4,15
** CES - CHECK ERROR STATUS.
*
* ABORT IF *WAIT BUSY* WAS SPECIFIED, AND AN ERROR
* OTHER THAN *FILE BUSY* IS DETECTED.
*
* ENTRY (X2) = FET ADDRESS.
*
* EXIT (X6) = 0 IF *FILE BUSY* ERROR.
*
* USES X - 1, 6.
* A - 1, 6.
*
* MACROS ABORT.
CES SUBR ENTRY/EXIT
MX6 -8 CHECK ERROR STATUS FIELD
SA1 X2
AX1 10
BX1 -X6*X1
ZR X1,CESX IF NO ERROR
SX6 X1-/ERRMSG/FBS
ZR X6,CESX IF *FILE BUSY* STATUS
SA1 WBSY
ZR X1,CESX IF *NA* RATHER THAN *WB*
ABORT ABORT (ERROR MESSAGE ISSUED BY *PFM*)
IDM SPACE 4,20
** IDM - ISSUE SECURED DAYFILE MESSAGE.
*
* REMOVE SECURITY ACCESS LEVEL VALUE FROM THE COMMAND
* AND ISSUE THE COMMAND TO THE JOB AND TO THE
* SYSTEM DAYFILE.
*
* EXIT COMMAND ISSUED TO DAYFILE.
*
* USES X - 4, 5.
* A - 4, 5.
* B - 2, 6.
*
* CALLS RSP.
*
* MACROS MESSAGE.
IDM SUBR ENTRY/EXIT
* FORMAT PARAMETER REGISTERS FOR *RSP*.
SA4 TARG SET ARGUMENT TABLE
SA5 CCDR CONTROL CARD FWA
SB2 B0+ NO PARAMETERS TO SKIP
SB6 IDMA PARAMETER TO BE REMOVED
* REMOVE PARAMETER AND ISSUE DAYFILE MESSAGE.
RJ RSP REMOVE SECURITY PARAMETER
MESSAGE CCDR,0,R ISSUE DAYFILE MESSAGE
EQ IDMX RETURN
IDMA CON 0LAL PARAMETER TO BE REMOVED BY *RSP*
CON 0 END OF ARGUMENT TABLE
PNA SPACE 4,10
** PNA - PROCESS *NO ABORT* AND *WAIT BUSY* OPTIONS.
*
* ENTRY (NABT) = 1 IF *NO ABORT* SPECIFIED.
* (WBSY) = 1 IF *WAIT BUSY* REQUESTED.
*
* EXIT ERROR PROCESSING BIT SET IF REQUIRED.
* TO *ABT* IF BOTH *NA* AND *WB* SPECIFIED.
*
* USES X - 1, 2, 5, 6.
* A - 1, 2, 6.
PNA SUBR ENTRY/EXIT
SA1 NABT
SA2 WBSY
IX1 X1+X2
ZR X1,PNAX IF NEITHER *NA* OR *WB* SPECIFIED
SX1 X1-2
SX5 IAER
ZR X1,ABT IF BOTH *NA* AND *WB* SPECIFIED
SA1 F+1 SET ERROR PROCESSING BIT
SX6 B1
LX6 44
BX6 X1+X6
SA6 A1
EQ PNAX RETURN
PRP SPACE 4,15
** PRP - PROCESS CONTROL CARD PARAMETERS.
*
* ENTRY (B2).NE.0 IF FIRST PARAMETER TO BE EQUIVALENCED.
* (B5) = ADDRESS OF ARGUMENT TABLE IN *ARG* FORMAT.
*
* EXIT CONTROL CARD PARAMETERS PROCESSED.
* TO *ABT* IF ERROR.
*
* USES X - 0, 1, 2, 4, 5, 6, 7.
* A - 1, 4, 6.
* B - 4.
*
* CALLS ARG.
PRP SUBR ENTRY/EXIT
SA1 ACTR
SB4 X1
R= A4,ARGR
SX5 IAER
ZR B4,ABT IF NO ARGUMENTS
SX7 X4-1R=
ZR X7,PRP1 IF FIRST PARAMETER IS EQUIVALENCED
NZ B2,ABT IF FIRST PARAMETER SHOULD BE EQUIVALENCED
MX0 42
BX6 X0*X4 SET FIRST PARAMETER AS FILE NAME
SX2 3
BX6 X2+X6 SET FET COMPLETE
SA6 F
SA4 A4+B1
SB4 B4-B1
ZR X4,ABT IF NO MORE PARAMETERS
EQ PRP2 PROCESS REMAINING ARGUMENTS
PRP1 ZR B2,ABT IF FIRST PARAMETER SHOULD BE UNEQUIVALENCED
PRP2 RJ ARG PROCESS EQUIVALENCED PARAMETERS
NZ X1,ABT IF INCORRECT ARGUMENT
EQ PRPX RETURN
TARG BSS 0 ARGUMENT TABLE
PN ARG ZERO,PKNM
R ARG ZERO,RESD
NA ARG -NONZ,NABT
WB ARG -NONZ,WBSY
AC ARG ZERO,ACAT,400B
AL ARG ZERO,ALVL,400B
ARG END OF TABLE
SPACE 4,10
* COMMON DECKS.
*CALL COMCARG
*CALL COMCCPM
*CALL COMCLFM
*CALL COMCPFM
*CALL COMCRSP
*CALL COMCSYS
*CALL COMCVLC
SPACE 4,10
USE LITERALS
FBUF EQU * FILE BUFFER
RFL= EQU FBUF+FBUFL
END