! ----- NUSER_OTHER.FUN ----- ! ! ----- PERFORMS ALL OTHER NON-STANDARD NUSER PROCESSING ----- ! ! ----- Restriction: This subroutine must be changed whenever the ----- ! ----- MANMAN SYSDB database record layout is ----- ! ----- changed ----- ! ! ---------- PASSED: ---------- ! ! ----- OTHER_ACTION = Action to be performed. One of: ! ----- ADD_DB_USER = Try to add a user to the MANMAN ! ----- MANMAN Security Database (Ignore ! ----- error if user already exists) ! ----- CHANGE_DB_USER = Change a user's template in the ! ----- MANMAN Security Database ! ----- (Ignore error if user does not ! ----- already exist) ! ----- CHANGE_SYSDB = Change the username in each of ! ----- the SYSDB databases that this ! ----- user has access to ! ----- COMMIT = COMMIT/UNBIND the current database ! ----- DBMSUSER = See if user is allowed to access ! ----- and/or 4GL ! ----- DELETE_DB_USER = Try to remove a user from the ! ----- MANMAN Security Database ! ----- (Ignore error if user does not ! ----- exist) ! ----- GET_4GL_ACCESS = See if 4GL access is to be ! ----- granted to this user ! ----- GET_DIVISIONAL_IDENT = Prompt for divisional ! ----- file access for this user ! ----- GET_OTHER_DATABASE = Get any other ! ----- or 4GL ! ----- databases to access ! ----- GET_TEMPLATE = Get Security Database Template ! ----- to grant for this user (if this ! ----- division has a Default Database) ! ----- LIST_TEMPLATES = Display all MANMAN Security ! ----- database templates ! ----- ROLLBACK = ROLLBACK/UNBIND the current database ! ----- VALIDATE_TEMPLATE = Validate template against ! ----- MANMAN Security Database ! ! ----- OTHER_PARAM1 = Parameter 1 for the associated action: ! ----- For "ADD_DB_USER": Database number to grant ! ----- access to ! ----- For "CHANGE_DB_USER": Database number to change ! ----- access for ! ----- For "CHANGE_SYSDB": Old Username to change from ! ----- For "DELETE_DB_USER": Database number to remove ! ----- access from ! ----- For "GET_4GL_ACCESS": "Y" if user is allowed to ! ----- access the 4GL ! ----- For "GET_OTHER_DATABASE" or "GET_TEMPLATE": ! ----- "Y" if user is allowed to access ! ----- or 4GL ! ----- For "LIST_TEMPLATES": Database to access ! ----- For "VALIDATE_TEMPLATE": Database to access ! ! ----- OTHER_PARAM2 = Parameter 2 for the associated action: ! ----- For "ADD_DB_USER": Security Database Template to ! ----- be used ! ----- For "CHANGE_DB_USER": New Database and Security ! ----- Database Template to be ! ----- used (format of ! ----- nnntttttttttttt) ! ----- For "CHANGE_SYSDB": New Username to change to ! ----- For "GET_OTHER_DATABASE": List of nodes that ! ----- this user is on ! ----- For "VALIDATE_TEMPLATE": Template name to check ! ! ----- ENTERED_USERNAME = For "ADD_DB_USER": Username to grant ! ----- access to ! ----- For "CHANGE_DB_USER": Username to ! ----- change access ! ----- for ! ----- For "DELETE_DB_USER": Username to ! ----- remove access ! ----- from ! ! ----- ACTION_INDEX = User-entered program action array index ! ! ----- BACKWARDS = TRUE if we're moving backwards thru prompts ! ! ----- DBMS_EXISTS = TRUE if DBMS application is installed ! ! ----- DBMS_PREFIX = For all database functions: 3-char ! ----- identifier prefix for the database ! ----- product ! ! ----- DBMS_PRODUCT = For all database functions: Description ! ----- of database product ! ! ----- DEBUG_MODE = TRUE if Debug Mode was enabled ! ! ----- DEFAULT_DB = For "GET_TEMPLATE" or "GET_4GL_ACCESS": ! ----- Default Database Number ("0" if none) ! ! ----- DIV = User-entered division for this user ! ! ----- DIV_INDEX = Index into DIVISION_NAMES() array ! ! ----- DIVISION_CTR = For "GET_OTHER_DATABASE": Count of valid ! ----- divisions ! ! ----- DIVISION_NAMES() = For "GET_OTHER_DATABASE": List of all ! ----- valid divisions ! ! ----- FOUR_GL = For "DBMSUSER" or "GET_4GL_ACCESS": Name of ! ----- installed 4GL product ! ! ----- FOUR_GL_EXISTS = For "GET_4GL_ACCESS": TRUE if 4GL ! ----- product exists on system ! ! ----- FOUR_GL_PREFIX = For "GET_4GL_ACCESS" and ! ----- "GET_OTHER_DATABASE": 4-char ! ----- identifier prefix for the 4GL ! ! ----- HELD_DIVS() = For "GET_OTHER_DATABASE": List of all held ! ----- divisional identifiers ! ! ----- HELD_DIVS_CTR = For "GET_OTHER_DATABASE": Count of held ! ----- divisional identifiers ! ! ----- INVALID_DIVISION = For "GET_OTHER_DATABASE": TRUE if ! ----- invalid division ! ! ----- NODE_COUNTER = For "GET_OTHER_DATABASE": Number of nodes ! ----- that user is on ! ! ----- PLEASE_TRY_AGAIN = "Please Try Again" error message ! ! ----- PRIVILEGED = For "GET_OTHER_DATABASE": TRUE if user has ! ----- SETPRV privilege ! ! ----- SYSUAF_COUNTER = For ""CHANGE_SYSDB": Count of ! ----- SYSUAF.DAT files ! ! ----- SYSUAF_SPECS() = For ""CHANGE_SYSDB": List of SYSUAF.DAT ! ----- files (blank if not accessible) ! ! ----- USER_ACTIONS(ACTION_INDEX) = Main Program action ! ! ---------- RETURNED: ---------- ! ! ----- NUSER_OTHER is FALSE if successful, otherwise TRUE. ! ----- (For VALIDATE_TEMPLATE, returns TRUE if valid ! ----- template, FALSE if invalid template) ! ! ----- ACTION_SEQ = Next User Input Sequence routine (999 if ! ----- done with all user prompting) ! ! ----- BACKWARDS = TRUE if we're moving backwards thru prompts ! ! ----- DEFAULT_DB = For "DBMSUSER": Default Database Number ! ----- ("0" if none) ! ! ----- GRANT_DENY_OTHER_NODES = For "GET_OTHER_DATABASE": ! ----- TRUE if Cluster-Wide Grant/Deny ! ! ----- OTHER_IDENTS() = For "GET_OTHER_DATABASE": List of ! ----- other databases or 4GL identifiers to grant ! ! ----- OTHER_IDENTS_CTR = For "GET_OTHER_DATABASE": Count of ! ----- other databases or 4GL identifiers to grant ! ! ----- OTHER_IDENTS_DB() = For "GET_OTHER_DATABASE": ! ----- List of database numbers whose templates are to ! ----- be used when granting access to the other ! ----- OTHER_IDENTS() database ! ! ----- OTHER_IDENTS_TEMPLATE() = For "GET_OTHER_DATABASE": ! ----- List of templates to use when granting the ! ----- other databases ! ! ----- OTHER_PARAM1 = For "DBMSUSER": "Y" if user is allowed to ! ----- access or ! ----- 4GL ! ----- For "GET_4GL_ACCESS": "Y" if user should ! ----- be granted 4GL ! ----- access ! ----- For "GET_DIVISIONAL_IDENT": 4-char ! ----- divisional identifier to be ! ----- granted to this user ! ! ----- TEMPLATE = For "GET_TEMPLATE": Security Database ! ----- Template to grant to this user ! ----- (if this division has a Default ! ----- Database) ! ! ----- Last Change 09/23/93 by Brian Lomasky ----- ! FUNCTION WORD NUSER_OTHER(STRING OTHER_ACTION, & STRING OTHER_PARAM1, STRING OTHER_PARAM2) %INCLUDE "NUSER.INC" %INCLUDE "$LNMDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB" # INVOKE SY_SUBSCHEMA WITHIN SYSDB.SYSDB FOR MM$SYSBASE:SYSDB ON STREAM 4 ! ----- MAXIMUM NUMBER OF MANMAN ELEMENTS ----- DECLARE WORD CONSTANT MAX_SY = 500% ! ----- MISCELLANEOUS CONSTANTS ----- DECLARE STRING CONSTANT PRECEDE_DESC = & " (Precede the template with a database" + & " number to use that database's template)" ! ----- RECORD FOR SYS$CRELNM ----- RECORD CREITM WORD BUFFER_LENGTH WORD ITEM_CODE LONG BUFFER_ADDRESS LONG RETURN_LENGTH_ADDRESS LONG TERMINATOR END RECORD CREITM DECLARE LONG CTR_CMD ! COUNT OF STORED CMD ELEMENTS DECLARE LONG CTR_SCN ! COUNT OF STORED SCN ELEMENTS DECLARE LONG CTR_SEC ! COUNT OF STORED SEC ELEMENTS DECLARE LONG CTR_UPC ! COUNT OF STORED UPC ELEMENTS DECLARE STRING DB_ACCESS ! OTHER DATABASE TO ACCESS DECLARE LONG DD ! CURRENT DAY DECLARE WORD EQVNAM_LENGTH ! LENGTH OF EQVNAM DECLARE WORD FORCE_READONLY ! TRUE TO FORCE READONLY TEMPLT DECLARE WORD FOUND_A_TEMPLATE ! TRUE IF TEMPLATE FOUND DECLARE WORD GET_CMD ! TRUE TO FETCH NEXT SY_CMDREC DECLARE WORD GET_SCN ! TRUE TO FETCH NEXT SY_SCNREC DECLARE WORD GET_SEC ! TRUE TO FETCH NEXT SY_SECREC DECLARE WORD GET_UPC ! TO FETCH NEXT SY_UPCPLTREC DECLARE STRING HELD_IDENT ! ONE HELD IDENTIFIER DECLARE LONG HELD_IDENT_INDEX ! HELD IDENTIFIER ARRAY INDEX DECLARE WORD I_O_CHNL_SYSUAF ! SYSUAF I/O CHANNEL TO ACCESS DECLARE CREITM ITMLST ! DEFINE ITEM LIST FOR $CRELNM DECLARE LONG LOCAL_STATUS ! LOCAL SYSTEM SERVICE EXIT STAT DECLARE WORD MATCH_FOUND ! TRUE IF MATCH FOUND DECLARE LONG MM ! CURRENT MONTH DECLARE STRING OTHER_DB ! OTHER DATABASE NUMBER DECLARE STRING OTHER_DIV ! OTHER IDENTIFIER DIVISION DECLARE LONG OTHER_INDEX ! OTHER IDENTIFIER ARRAY INDEX DECLARE STRING OTHER_TEMPLATE ! OTHER IDENTIFIER TEMPLATE DECLARE STRING PREV_TEMPLATE_DB ! PREVIOUS TEMPLATE DATABASE DECLARE WORD RECORD_FOUND ! TRUE IF MATCHING RECORD FOUND DECLARE WORD TEMP ! TEMPORARY WORD VARIABLE DECLARE STRING TEMP_STRING ! TEMPORARY STRING DECLARE STRING TEMP_STRING2 ! TEMPORARY STRING DECLARE STRING TEMPLATE_DB ! DATABASE TO USE FOR TEMPLATE DECLARE STRING THE_DB ! DATABASE NUMBER DECLARE STRING TRANSLATED_NAME ! LOGICAL_NAME TRANSLATION DECLARE WORD VALID_ENTRY ! TRUE IF VALID ENTRY DECLARE LONG YY ! CURRENT YEAR EXTERNAL WORD FUNCTION BAD_ASK_STATUS_VALUE( & STRING) ! CHECK ASK_STATUS_nnn VALUE EXTERNAL LONG FUNCTION & DBQ$INTERPRET_STREAM ! DBMS STREAM INTERFACE EXTERNAL LONG FUNCTION & LIB$MATCH_COND ! COMPARE CONDITION CODES EXTERNAL LONG FUNCTION LOGICAL_NAME(STRING, & STRING) ! TRANSLATE LOGICAL NAME EXTERNAL WORD FUNCTION NUMERIC( & STRING) ! CHECK FOR NUMERIC STRING EXTERNAL LONG FUNCTION & SYS$CRELNM ! CREATE LOGICAL NAME EXTERNAL WORD FUNCTION & VALIDATE_IDENTIFIER ! FALSE IF IDENTIFIER EXISTS ! ----- FIXED-LENGTH STRING FOR THE $CRELNM SYSTEM SERVICE ----- MAP (CREMAP) STRING EQVNAM = 6% ! EQUIVALENCE NAME TO DEFINE ! ----- FIXED-LENGTH VARIABLES FOR STORING MANMAN USER ----- ! ----- INFO ----- MAP (MYSYMAP) STRING UPCPLTCODE(MAX_SY) = 10%, & STRING UPCPACKMASK(MAX_SY) = 30%, & STRING UPCADDPLTPRV(MAX_SY) = 1%, & STRING UPCDEFPRIVS(MAX_SY) = 1%, & STRING UPCWAREHOUSE(MAX_SY) = 10%, & STRING UPCSVREGION(MAX_SY) = 10%, & STRING CMDNAME(MAX_SY) = 6%, & STRING CMDPLTCODE(MAX_SY) = 10%, & STRING SCNPLTCODE(MAX_SY) = 10%, & STRING SCNCMD(MAX_SY) = 6%, & STRING SCNACTFLD(MAX_SY) = 10%, & STRING SCNASKTDMSREQ(MAX_SY) = 20%, & STRING SCNUSRTDMSREQ(MAX_SY) = 20%, & STRING SECPLTCODE(MAX_SY) = 10%, & STRING SECNAME(MAX_SY) = 6%, & STRING PREVIOUS_PLANT_CODE = 10% ! ----- LOCAL FUNCTION TO DO THE READY FOR THE PASSED ----- ! ----- DATABASE (UPDATE_MODE: FALSE=RETRIEVAL, ----- ! ----- TRUE=UPDATE) ----- DEF WORD READY_PROCESSING(STRING DEBUG_DESC, & STRING DB_TO_ACCESS, WORD UPDATE_MODE) READY_PROCESSING = 0% ! ALWAYS RETURN ZERO IF DEBUG_MODE THEN PRINT "DEBUG>---------- Enter" + & " READY_PROCESSING ----------" PRINT "DEBUG>READY_PROCESSING: READY " & + DB_TO_ACCESS + " FOR " + & NUM1$(UPDATE_MODE) PRINT "DEBUG>NUSER_FLAG1="; NUSER_FLAG1 PRINT "DEBUG>NUSER_FLAG2="; NUSER_FLAG2 END IF IF NUSER_FLAG1 THEN ! IF DATABASE ALREADY READIED: IF DEBUG_MODE THEN PRINT "DEBUG>" + DEBUG_DESC + & " Database " + & DB_TO_ACCESS + & " is already readied" END IF IF DEBUG_MODE THEN PRINT "DEBUG>---------- Exit" + & " READY_PROCESSING ----------" END IF EXIT DEF END IF IF DEBUG_MODE THEN PRINT "DEBUG>" + DEBUG_DESC + & " Database " + DB_TO_ACCESS + & " is not yet readied" END IF ! ----- CREATE USER-MODE LOGICAL NAME SO THE BIND ----- ! ----- WORKS ----- ITMLST::BUFFER_LENGTH = LEN(EQVNAM) ITMLST::ITEM_CODE = LNM$_STRING ITMLST::BUFFER_ADDRESS = LOC(EQVNAM) ITMLST::RETURN_LENGTH_ADDRESS = LOC(EQVNAM_LENGTH) ITMLST::TERMINATOR = 0% EQVNAM = DBMS_PREFIX + DB_TO_ACCESS IF DEBUG_MODE THEN PRINT "DEBUG>CREATE LOGICAL FOR>" + EQVNAM + "<" END IF LOCAL_STATUS = SYS$CRELNM(, "LNM$PROCESS", & "MM$SYSBASE", , ITMLST) IF DEBUG_MODE THEN PRINT "DEBUG>LOCAL_STATUS="; LOCAL_STATUS END IF IF (LOCAL_STATUS AND 1%) = 0% THEN PRINT "Unexpected error from SYS$CRELNM" + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END IF IF UPDATE_MODE THEN ! ----- READY THE ASK/MANMAN SECURITY ----- ! ----- DATABASE FOR UPDATE ----- IF DEBUG_MODE THEN PRINT "DEBUG>Ready for writing" END IF # READY SYUSRAREA SYUPCAREA SYCMDAREA - CONCURRENT UPDATE (TRAP ERROR) ELSE ! ----- READY THE ASK/MANMAN SECURITY ----- ! ----- DATABASE FOR READING ----- IF DEBUG_MODE THEN PRINT "DEBUG>Ready for reading" PRINT "DEBUG>DBM_COND BEFORE" + & " READY=" + NUM1$(DBM_COND) END IF # READY SYUSRAREA SYUPCAREA SYCMDAREA - CONCURRENT RETRIEVAL (TRAP ERROR) END IF IF DML$VALUE = DML$K_ERROR THEN PRINT "Can't READY " + DB_TO_ACCESS + & " database - Aborting..." + BEL PRINT " (DBM_COND=" + NUM1$(DBM_COND) + ")" CALL DBM$SIGNAL END IF NUSER_FLAG1 = TRUE ! SET "DATABASE READIED" FLAG NUSER_FLAG2 = TRUE ! SET "DATABASE BOUND" FLAG IF DEBUG_MODE THEN PRINT "DEBUG>---------- Exit" + & " READY_PROCESSING ----------" END IF END DEF ! ----- LOCAL FUNCTION TO ROLLBACK/UNBIND THE CURRENT ----- ! ----- DATABASE ----- DEF WORD NUSER_OTHER_ROLLBACK NUSER_OTHER_ROLLBACK = 0% IF NUSER_FLAG1 THEN ! IF DBMS DATABASE READIED: IF DEBUG_MODE THEN PRINT "DEBUG>Rollback" END IF # ROLLBACK ! ----- INIT "DATABASE READIED" FLAG ----- NUSER_FLAG1 = FALSE ELSE IF DEBUG_MODE THEN PRINT "DEBUG>---Skip Rollback" & + " due to un-readied" & + " database---" END IF END IF IF NUSER_FLAG2 THEN ! IF BOUND TO DATABASE: ! ----- UNBIND FROM THIS DATABASE ----- NUSER_FLAG2 = FALSE LOCAL_STATUS = DBQ$INTERPRET_STREAM( & "UNBIND", DBMUWA BY REF) IF (LOCAL_STATUS AND 1%) = 0% THEN PRINT "Error while unbinding" + & " from SYSDB database" + BEL ! ----- EXIT WITH ERROR STATUS ----- CALL LIB$STOP(LOCAL_STATUS BY VALUE) END IF ELSE IF DEBUG_MODE THEN PRINT "DEBUG>---Skip Rollback" & + " Unbind due to" + & " un-bound database---" END IF END IF END DEF ! ----- LOCAL FUNCTION TO DISPLAY ALL SECURITY DATABASE ----- ! ----- TEMPLATES ----- DEF WORD NUSER_OTHER_LIST_TEMPLATES(STRING DB_TO_ACCESS) NUSER_OTHER_LIST_TEMPLATES = 0% IF DEBUG_MODE THEN PRINT "DEBUG>LIST TEMPLATES FOR" + & " DATABASE " + DB_TO_ACCESS END IF ! ----- SEE IF DIFFERENT TEMPLATE DATABASE ----- IF PREV_TEMPLATE_DB <> DB_TO_ACCESS THEN ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK PREV_TEMPLATE_DB = DB_TO_ACCESS END IF ! ----- READY DATABASE FOR RETRIEVAL ----- TEMP = READY_PROCESSING("LIST_TEMPLATES:", & DB_TO_ACCESS, FALSE) # FREE ALL CURRENT PRINT PRINT TAB(20%); "List of all " + & TRM$(DBMS_PRODUCT) + " Security" + & " Database Templates" PRINT FOUND_A_TEMPLATE = FALSE WHILE TRUE # FETCH NEXT SY_USRREC WITHIN SY_USRHSHSET - (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END ! END-OF-COLLECTION: # FREE ALL CURRENT IF NOT FOUND_A_TEMPLATE THEN PRINT "Warning - No " + & TRM$( & DBMS_PRODUCT) + & " Security" + & " Database" + & " Templates" + & " found in" + & " database #" + & DB_TO_ACCESS + BEL END IF PRINT EXIT DEF CASE DML$K_ERROR! UNEXPECTED ERROR: PRINT "Unexpected error from" + & " FETCH NEXT SY_USRREC" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END SELECT ! ----- SKIP IF NOT A TEMPLATE ----- ITERATE IF LEFT(SY_USRNAME, 1%) <> "*" PRINT TAB(20%); TRM$(SY_USRNAME) FOUND_A_TEMPLATE = TRUE NEXT END DEF ! ----- LOCAL FUNCTION TO VALIDATE TEMPLATE AGAINST ----- ! ----- SECURITY DATABASE ----- DEF WORD NUSER_OTHER_VALIDATE_TEMPLATE( & STRING DB_TO_ACCESS, STRING TEMPLATE_TO_VALIDATE) IF DEBUG_MODE THEN PRINT "DEBUG>NUSER_OTHER_VALIDATE_" + & "TEMPLATE: VALIDATE " + & DB_TO_ACCESS + "|" + & TRM$(TEMPLATE_TO_VALIDATE) + " TEMPLATE" END IF ! ----- SEE IF DIFFERENT TEMPLATE DATABASE ----- IF PREV_TEMPLATE_DB <> DB_TO_ACCESS THEN ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK PREV_TEMPLATE_DB = DB_TO_ACCESS END IF ! ----- READY DATABASE FOR RETRIEVAL ----- TEMP = READY_PROCESSING("VALIDATE_TEMPLATE:", & DB_TO_ACCESS, FALSE) ! ----- LOOKUP AND VERIFY THE SECURITY DATABASE ----- ! ----- TEMPLATE ----- IF DEBUG_MODE THEN PRINT "DEBUG>VALIDATE TEMPLATE: LOOKUP" END IF SY_USRNAME = TEMPLATE_TO_VALIDATE # FETCH FIRST SY_USRREC WITHIN SY_USRHSHSET USING - SY_USRNAME (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END ! END-OF-COLLECTION: # FREE ALL CURRENT IF DEBUG_MODE THEN PRINT "DEBUG>VALIDATE" + & " TEMPLATE: BAD TEMPLATE" END IF ! ----- RETURN "INVALID TEMPLATE" STATUS ----- NUSER_OTHER_VALIDATE_TEMPLATE = FALSE EXIT DEF ! TEMPLATE DOES NOT EXIST CASE DML$K_ERROR ! UNEXPECTED ERROR: PRINT "Unexpected error from FETCH" + & " FIRST SY_USRREC" + BEL CALL DBM$SIGNAL ! DISPLAY ERROR AND ABORT END SELECT # FREE ALL CURRENT IF DEBUG_MODE THEN PRINT "DEBUG>VALIDATE TEMPLATE: GOOD TEMPLATE" END IF ! ----- RETURN "VALID TEMPLATE" STATUS ----- NUSER_OTHER_VALIDATE_TEMPLATE = TRUE END DEF ! ----- LOCAL FUNCTION TO VALIDATE FOR A 4GL DATABASE ----- DEF WORD VALID_4GL_DATABASE(STRING DB_TO_VALIDATE) ! ----- ASSUME INVALID 4GL DATABASE STATUS ----- VALID_4GL_DATABASE = TRUE IF DEBUG_MODE THEN PRINT "DEBUG>CALL VALID_4GL_DATABASE" END IF IF LEFT(DB_TO_VALIDATE, 1%) <> "F" OR & USER_ACTIONS(ACTION_INDEX) = "T" THEN PRINT PRINT "Error - Invalid response" + & TRM$(PLEASE_TRY_AGAIN) PRINT EXIT DEF END IF OTHER_DB = RIGHT(DB_TO_VALIDATE, 2%) ! ----- BETTER BE A DIFFERENT DATABASE NUMBER ----- TEMP = 0% MATCH_FOUND = FALSE WHILE TEMP < OTHER_IDENTS_CTR AND NOT MATCH_FOUND TEMP = TEMP + 1% IF OTHER_IDENTS(TEMP) = DB_TO_VALIDATE THEN MATCH_FOUND = TRUE END IF NEXT IF MATCH_FOUND THEN PRINT SELECT USER_ACTIONS(ACTION_INDEX) CASE "G", "X" PRINT "You have already" + & " entered " + & TRM$(FOUR_GL) + & " database " + OTHER_DB & + TRM$(PLEASE_TRY_AGAIN) CASE ELSE PRINT "This user already has" + & " access to " + & TRM$(FOUR_GL) + & " database " + OTHER_DB & + TRM$(PLEASE_TRY_AGAIN) END SELECT PRINT EXIT DEF END IF ! ----- TRY TO TRANSLATE ANY 4GL IDENTIFIER ----- ! ----- LOGICAL NAME ----- TEMP_STRING = FOUR_GL_PREFIX + OTHER_DB IF DEBUG_MODE THEN PRINT "DEBUG>TRANSLATE " + TEMP_STRING END IF LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING, & TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM ! IF NO LOGICAL EQUIVALENT: ! ----- CLEAR ERROR CONDITION ----- LOCAL_STATUS = SS$_NORMAL PRINT PRINT "Error - Invalid " + & TRM$(FOUR_GL) + & " database number: " + OTHER_DB + BEL PRINT EXIT DEF CASE <> SS$_NORMAL PRINT "Unexpected error while trying" + & " to translate " + TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT ! ----- ENSURE THAT THE 4GL IDENTIFIER EXISTS ----- THE_IDENT = FOUR_GL_PREFIX + OTHER_DB IF DEBUG_MODE THEN PRINT "DEBUG>CALL VALIDATE_IDENTIFIER" & + " FOR " + THE_IDENT END IF ! ----- SEE IF THE IDENTIFIER DOES NOT EXIST ----- IF VALIDATE_IDENTIFIER THEN PRINT PRINT "Error - Invalid " + & TRM$(FOUR_GL) + & " database identifier: " + & OTHER_DB + BEL PRINT EXIT DEF END IF ! ----- TRANSLATE ANY 4GL STATUS LOGICAL NAME ----- TEMP_STRING = FOUR_GL_PREFIX + "STATUS_" + OTHER_DB IF DEBUG_MODE THEN PRINT "DEBUG>TRANSLATE " + TEMP_STRING END IF LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING, & TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM ! IF NO LOGICAL EQUIVALENT: ! ----- CLEAR ERROR CONDITION ----- LOCAL_STATUS = SS$_NORMAL PRINT PRINT "Error - Invalid " + & TRM$(FOUR_GL) + " access for " & + OTHER_DB + BEL PRINT EXIT DEF CASE SS$_NORMAL SELECT TRANSLATED_NAME CASE "ONLINE", "BATCH" CASE ELSE PRINT PRINT "Error - " + & TRM$(FOUR_GL) + & " database " + OTHER_DB & + " is currently" + & " unavailable" + & TRM$(PLEASE_TRY_AGAIN) PRINT EXIT DEF END SELECT CASE ELSE PRINT "Unexpected error while trying" + & " to translate " + TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT ! ----- RETURN VALID 4GL DATABASE STATUS ----- VALID_4GL_DATABASE = FALSE IF DEBUG_MODE THEN PRINT "DEBUG>EXIT VALID_4GL_DATABASE" END IF END DEF ! ----- LONG FUNCTION TO VALIDATE FOR A MANMAN DATABASE ----- DEF WORD VALID_MANMAN_DB(STRING OTHER_DB, WORD DISPLAY_ERROR) ! ----- ASSUME ERROR STATUS ----- VALID_MANMAN_DB = TRUE ! ----- TRY TO TRANSLATE ANY DATABASE LOGICAL NAME ----- TEMP_STRING = DBMS_PREFIX + OTHER_DB LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING, & TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM ! IF NO LOGICAL EQUIVALENT: ! ----- CLEAR ERROR CONDITION ----- LOCAL_STATUS = SS$_NORMAL EXIT DEF IF NOT DISPLAY_ERROR PRINT PRINT "Error - Invalid " + & TRM$(DBMS_PRODUCT) + & " database number: " + OTHER_DB + BEL PRINT EXIT DEF CASE <> SS$_NORMAL PRINT "Unexpected error while trying" + & " to translate " + TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT ! ----- ENSURE THAT THE DATABASE IDENTIFIER EXISTS ----- THE_IDENT = DBMS_PREFIX + OTHER_DB ! ----- SEE IF THE IDENTIFIER DOES NOT EXIST ----- IF VALIDATE_IDENTIFIER THEN EXIT DEF IF NOT DISPLAY_ERROR PRINT PRINT "Error - Invalid " + & TRM$(DBMS_PRODUCT) + & " database identifier: " + & OTHER_DB + BEL PRINT EXIT DEF END IF ! ----- TRANSLATE ANY DISK_nnn LOGICAL NAME ----- TEMP_STRING = "DISK_" + OTHER_DB LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING, & TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM ! IF NO LOGICAL EQUIVALENT: ! ----- CLEAR ERROR CONDITION ----- LOCAL_STATUS = SS$_NORMAL EXIT DEF IF NOT DISPLAY_ERROR PRINT PRINT "Error - Invalid " + & TRM$(DBMS_PRODUCT) + & " database disk for " + OTHER_DB + BEL PRINT EXIT DEF CASE <> SS$_NORMAL PRINT "Unexpected error while trying" + & " to translate " + TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT ! ----- TRANSLATE ANY ASK_STATUS_nnn LOGICAL NAME ----- TEMP_STRING = "ASK_STATUS_" + OTHER_DB LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING, & TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM ! IF NO LOGICAL EQUIVALENT: ! ----- CLEAR ERROR CONDITION ----- LOCAL_STATUS = SS$_NORMAL EXIT DEF IF NOT DISPLAY_ERROR PRINT PRINT "Error - Invalid " + & TRM$(DBMS_PRODUCT) + & " access for " + OTHER_DB + BEL PRINT EXIT DEF CASE SS$_NORMAL SELECT TRANSLATED_NAME CASE "ONLINE", "BATCH" CASE ELSE EXIT DEF IF NOT DISPLAY_ERROR PRINT PRINT "Error - " + & TRM$(DBMS_PRODUCT) + & " database " + OTHER_DB & + " is currently" + & " unavailable" + & TRM$(PLEASE_TRY_AGAIN) PRINT EXIT DEF END SELECT CASE ELSE PRINT "Unexpected error while trying" + & " to translate " + TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT ! ----- RETURN SUCCESS STATUS ----- VALID_MANMAN_DB = FALSE END DEF ! ----- LOCAL FUNCTION TO VALIDATE FOR A DATABASE ----- DEF WORD VALID_DB_DATABASE(STRING DB_TO_VALIDATE) ! ----- ASSUME INVALID DATABASE STATUS ----- VALID_DB_DATABASE = TRUE IF DEBUG_MODE THEN PRINT "DEBUG>CALL VALID_DB_DATABASE" END IF OTHER_DB = DB_TO_VALIDATE IF DIV <> "OTH" THEN SELECT USER_ACTIONS(ACTION_INDEX) CASE "G", "X", "T" CASE ELSE ! ----- BETTER BE A DIFFERENT ----- ! ----- DATABASE NUMBER THAN THE ----- ! ----- DEFAULT DATABASE ----- IF OTHER_DB = DEFAULT_DB THEN PRINT PRINT "This user" + & " already has" +& " access to " + & TRM$( & DBMS_PRODUCT) + & " database " + & OTHER_DB + & TRM$(PLEASE_TRY_AGAIN) PRINT EXIT DEF END IF END SELECT END IF ! ----- BETTER NOT BE A DUPLICATE ENTRY ----- TEMP = 0% MATCH_FOUND = FALSE WHILE TEMP < OTHER_IDENTS_CTR AND NOT MATCH_FOUND TEMP = TEMP + 1% IF OTHER_IDENTS(TEMP) = OTHER_DB THEN MATCH_FOUND = TRUE END IF NEXT IF MATCH_FOUND THEN PRINT SELECT USER_ACTIONS(ACTION_INDEX) CASE "G", "X", "T" PRINT "You have already" + & " entered " + & TRM$(DBMS_PRODUCT) + & " database " + OTHER_DB & + TRM$(PLEASE_TRY_AGAIN) CASE ELSE PRINT "This user already has" + & " access to " + & TRM$(DBMS_PRODUCT) + & " database " + OTHER_DB & + TRM$(PLEASE_TRY_AGAIN) END SELECT PRINT EXIT DEF END IF ! ----- VALIDATE FOR A MANMAN DATABASE ----- ! ----- (DISPLAY MESSAGES IF ANY ERROR) ----- EXIT DEF IF VALID_MANMAN_DB(OTHER_DB, TRUE) ! ----- RETURN VALID DATABASE STATUS ----- VALID_DB_DATABASE = FALSE END DEF ! ----- LOCAL FUNCTION TO ADD A USER TO THE SECURITY ----- ! ----- DATABASE (RETURNS TRUE TO ROLLBACK, FALSE TO ----- ! ----- COMMIT) ----- DEF WORD NUSER_OTHER_ADD_USER(STRING DB_TO_ACCESS, & STRING TEMPLATE_DB_TO_USE, STRING TEMPLATE_TO_USE) ! ----- ASSUME ERROR STATUS ----- NUSER_OTHER_ADD_USER = TRUE CTR_CMD = 0% ! COUNT OF STORED CMD ARRAY ELEMENTS CTR_SCN = 0% ! COUNT OF STORED SCN ARRAY ELEMENTS CTR_SEC = 0% ! COUNT OF STORED SEC ARRAY ELEMENTS CTR_UPC = 0% ! COUNT OF STORED UPC ARRAY ELEMENTS ! ----- SEE IF TEMPLATE DATABASE DIFFERENT THAN ----- ! ----- THE DATABASE THAT WE'RE UPDATING ----- IF TEMPLATE_DB_TO_USE <> DB_TO_ACCESS THEN ! ----- READY DATABASE FOR RETRIEVAL ----- TEMP = READY_PROCESSING( & "ADD_DB_USER_TEMPLATE:", & TEMPLATE_DB_TO_USE, FALSE) ELSE ! ----- READY DATABASE FOR UPDATE ----- TEMP = READY_PROCESSING("ADD_DB_USER:", & DB_TO_ACCESS, TRUE) END IF ! ----- GET THE TEMPLATE DATABASE RECORD ----- IF DEBUG_MODE THEN PRINT "DEBUG>Fetch Template " + & TRM$(TEMPLATE_TO_USE) + " record" END IF SY_USRNAME = TEMPLATE_TO_USE # FETCH FIRST SY_USRREC WITHIN SY_USRHSHSET USING - SY_USRNAME (TRAP END, ERROR) IF DEBUG_MODE THEN PRINT "DEBUG>DBM_COND after FETCH" + & " SY_USRREC="; DBM_COND END IF IF (LIB$MATCH_COND(DBM_COND, DBM$_END)) THEN ! ----- END-OF-COLLECTION: ----- PRINT " Error - Non-existent Security" & + " Database Template: " + & TRM$(TEMPLATE_TO_USE) SELECT USER_ACTIONS(ACTION_INDEX) CASE "T" ! IF CHANGING TEMPLATE: PRINT " Skipping" + & " change to database " & + DB_TO_ACCESS + & " for user " + & TRM$(ENTERED_USERNAME) & + "..." + BEL CASE ELSE PRINT " Skipping" + & " access to database " & + DB_TO_ACCESS + & " for user " + & TRM$(ENTERED_USERNAME) & + "..." + BEL END SELECT ! ----- RETURN ERROR STATUS SO THAT THE ----- ! ----- CALLING ROUTINE WILL ROLLBACK ----- EXIT DEF ! TEMPLATE DOES NOT EXIST END IF IF (LIB$MATCH_COND(DBM_COND, DBM$_CSTYP_NULL)) THEN ! ----- NULL SET TYPE CURRENCY ----- IF DEBUG_MODE THEN PRINT "DEBUG>Null currency" + & " for SY_USRHSHSET" END IF PRINT " Error - Non-existent Security" & + " Database Template: " + & TRM$(TEMPLATE_TO_USE) SELECT USER_ACTIONS(ACTION_INDEX) CASE "T" ! IF CHANGING TEMPLATE: PRINT " Skipping" + & " change to database " & + DB_TO_ACCESS + & " for user " + & TRM$(ENTERED_USERNAME) & + "..." + BEL CASE ELSE PRINT " Skipping" + & " access to database " & + DB_TO_ACCESS + & " for user " + & TRM$(ENTERED_USERNAME) & + "..." + BEL END SELECT ! ----- RETURN ERROR STATUS SO THAT THE ----- ! ----- CALLING ROUTINE WILL ROLLBACK ----- EXIT DEF ! TEMPLATE DOES NOT EXIST END IF IF DML$VALUE = DML$K_ERROR THEN ! ----- UNEXPECTED ERROR: ----- PRINT "Unexpected error from FETCH" + & " FIRST SY_USRREC" + & " (ADD_DB_USER)" + BEL CALL DBM$SIGNAL ! DISPLAY ERROR AND ABORT END IF GET_UPC = TRUE ! TO FETCH NEXT SY_UPCREC WHILE GET_UPC IF DEBUG_MODE THEN PRINT "DEBUG>Fetch SY_UPCREC" END IF # FETCH NEXT SY_UPCREC WITHIN SY_USRUPCSET - (TRAP END, ERROR) IF DEBUG_MODE THEN PRINT "DEBUG>DBM_COND after" + & " FETCH SY_UPCREC="; DBM_COND END IF IF (LIB$MATCH_COND(DBM_COND, DBM$_END)) THEN ! ----- END-OF-COLLECTION: ----- # FREE ALL CURRENT ! ----- SO AS TO EXIT LOOP ----- GET_UPC = FALSE ITERATE ! ALL DONE END IF IF (LIB$MATCH_COND(DBM_COND, DBM$_CSTYP_NULL)) THEN ! ----- NULL SET TYPE CURRENCY ----- # FREE ALL CURRENT ! ----- SO AS TO EXIT LOOP ----- GET_UPC = FALSE ITERATE ! ALL DONE END IF IF DML$VALUE = DML$K_ERROR THEN ! ----- UNEXPECTED ERROR: ----- PRINT "Unexpected error from" + & " FETCH NEXT SY_UPCREC" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END IF ! ----- STORE SY_UPCPLTREC IN MEMORY ----- CTR_UPC = CTR_UPC + 1% UPCPLTCODE(CTR_UPC) = DB_TO_ACCESS UPCPACKMASK(CTR_UPC) = SY_UPCPACKMASK UPCADDPLTPRV(CTR_UPC) = SY_UPCADDPLTPRV UPCDEFPRIVS(CTR_UPC) = SY_UPCDEFPRIVS UPCWAREHOUSE(CTR_UPC) = SY_UPCWAREHOUSE UPCSVREGION(CTR_UPC) = SY_UPCSVREGION GET_CMD = TRUE ! TO FETCH NEXT SY_CMDREC WHILE GET_CMD IF DEBUG_MODE THEN PRINT "DEBUG>Fetch SY_CMDREC" END IF # FETCH NEXT SY_CMDREC WITHIN - SY_UPCCMDSET (TRAP END, ERROR) IF DEBUG_MODE THEN PRINT "DEBUG>DBM_COND" & + " after" + & " FETCH" + & " SY_CMDREC="; DBM_COND END IF IF (LIB$MATCH_COND(DBM_COND, DBM$_END)) THEN ! ----- END-OF-COLLECTION: ----- # FREE ALL CURRENT ! ----- SO AS TO EXIT LOOP ----- GET_CMD = FALSE ITERATE ! DONE WITH SY_CMDREC's END IF IF (LIB$MATCH_COND(DBM_COND, & DBM$_CSTYP_NULL)) THEN ! ----- NULL SET TYPE ----- ! ----- CURRENCY ----- # FREE ALL CURRENT ! ----- SO AS TO EXIT LOOP ----- GET_CMD = FALSE ITERATE ! DONE WITH SY_CMDREC's END IF IF DML$VALUE = DML$K_ERROR THEN PRINT "Unexpected" + & " error from" + & " FETCH NEXT" + & " SY_CMDREC" + BEL ! ----- DISPLAY ERROR AND ----- ! ----- ABORT ----- CALL DBM$SIGNAL END IF ! ----- STORE SY_CMDREC IN MEMORY ----- CTR_CMD = CTR_CMD + 1% CMDNAME(CTR_CMD) = SY_CMDNAME CMDPLTCODE(CTR_CMD) = DB_TO_ACCESS NEXT GET_SCN = TRUE ! TO FETCH NEXT SY_SCNREC WHILE GET_SCN IF DEBUG_MODE THEN PRINT "DEBUG>Fetch SY_SCNREC" END IF # FETCH NEXT SY_SCNREC WITHIN - SY_UPCSCNSET (TRAP END, ERROR) IF DEBUG_MODE THEN PRINT "DEBUG>DBM_COND" & + " after" + & " FETCH" + & " SY_SCNREC="; DBM_COND END IF IF (LIB$MATCH_COND(DBM_COND, DBM$_END)) THEN ! ----- END-OF-COLLECTION: ----- # FREE ALL CURRENT ! ----- SO AS TO EXIT LOOP ----- GET_SCN = FALSE ITERATE ! DONE WITH SY_SCNREC's END IF IF (LIB$MATCH_COND(DBM_COND, & DBM$_CSTYP_NULL)) THEN ! ----- NULL SET TYPE ----- ! ----- CURRENCY ----- # FREE ALL CURRENT ! ----- SO AS TO EXIT LOOP ----- GET_SCN = FALSE ITERATE ! DONE WITH SY_SCNREC's END IF IF DML$VALUE = DML$K_ERROR THEN PRINT "Unexpected" + & " error from" + & " FETCH NEXT" + & " SY_SCNREC" + BEL ! ----- DISPLAY ERROR AND ----- ! ----- ABORT ----- CALL DBM$SIGNAL END IF ! ----- STORE SY_SCNREC IN MEMORY ----- CTR_SCN = CTR_SCN + 1% SCNPLTCODE(CTR_SCN) = DB_TO_ACCESS SCNCMD(CTR_SCN) = SY_SCNCMD SCNACTFLD(CTR_SCN) = SY_SCNACTFLD SCNASKTDMSREQ(CTR_SCN) = & SY_SCNASKTDMSREQ SCNUSRTDMSREQ(CTR_SCN) = & SY_SCNUSRTDMSREQ NEXT GET_SEC = TRUE ! TO FETCH NEXT SY_SECREC WHILE GET_SEC IF DEBUG_MODE THEN PRINT "DEBUG>Fetch SY_SECREC" END IF # FETCH NEXT SY_SECREC WITHIN - SY_UPCSECSET (TRAP END, ERROR) IF DEBUG_MODE THEN PRINT "DEBUG>DBM_COND" & + " after" + & " FETCH" + & " SY_SECREC="; DBM_COND END IF IF (LIB$MATCH_COND(DBM_COND, DBM$_END)) THEN ! ----- END-OF-COLLECTION: ----- # FREE ALL CURRENT ! ----- SO AS TO EXIT LOOP ----- GET_SEC = FALSE ITERATE ! DONE WITH SY_SECREC's END IF IF (LIB$MATCH_COND(DBM_COND, & DBM$_CSTYP_NULL)) THEN ! ----- NULL SET TYPE ----- ! ----- CURRENCY ----- # FREE ALL CURRENT ! ----- SO AS TO EXIT LOOP ----- GET_SEC = FALSE ITERATE ! DONE WITH SY_SECREC's END IF IF DML$VALUE = DML$K_ERROR THEN PRINT "Unexpected" + & " error from" + & " FETCH NEXT" + & " SY_SECREC" + BEL ! ----- DISPLAY ERROR AND ----- ! ----- ABORT ----- CALL DBM$SIGNAL END IF ! ----- STORE SY_SECREC IN MEMORY ----- CTR_SEC = CTR_SEC + 1% SECPLTCODE(CTR_SEC) = DB_TO_ACCESS SECNAME(CTR_SEC) = SY_SECNAME NEXT NEXT ! ----- DONE READING IN ALL OF THE TEMPLATE DATA ----- ! ----- SEE IF TEMPLATE DATABASE DIFFERENT THAN ----- ! ----- THE DATABASE THAT WE'RE UPDATING ----- IF TEMPLATE_DB_TO_USE <> DB_TO_ACCESS THEN ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK ! ----- STORE THE NEW PLANT CODE ----- SY_USRDEFPLT = DB_TO_ACCESS ! ----- READY DATABASE FOR UPDATE ----- TEMP = READY_PROCESSING("ADD_DB_USER:", & DB_TO_ACCESS, TRUE) END IF ! ----- SEE IF THIS USER'S DATABASE RECORD ----- ! ----- ALREADY EXISTS ----- SY_USRNAME = ENTERED_USERNAME IF DEBUG_MODE THEN PRINT "DEBUG>Fetch SY_USRREC" END IF # FIND FIRST SY_USRREC WITHIN SY_USRHSHSET USING - SY_USRNAME (TRAP END, ERROR) IF (LIB$MATCH_COND(DBM_COND, DBM$_END)) THEN ! ----- IGNORE END-OF-COLLECTION ERROR ----- IF DEBUG_MODE THEN PRINT "DEBUG>User " + & TRM$(ENTERED_USERNAME) & + " does not have" + & " access to this database" END IF ELSE IF DML$VALUE = DML$K_ERROR THEN PRINT "Unexpected error from" + & " FETCH FIRST" + & " SY_USRREC" + & " (ADD_DB_USER)" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END IF ! ----- DONE IF ANY EXISTING USER RECORD ----- PRINT "Warning - User " + & TRM$(ENTERED_USERNAME) + & " already has access to" + & " database " + DB_TO_ACCESS + "..." ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER_ADD_USER = FALSE EXIT DEF END IF ! ----- STORE THE NEW USERNAME TO BE GRANTED ----- ! ----- ACCESS ----- SY_USRNAME = ENTERED_USERNAME ! ----- STORE THE USERNAME WHO IS RUNNING THIS ----- ! ----- PROGRAM ----- SY_USRADDREC = LEFT(THE_USERNAME, USERNAME_LENGTH) ! ----- GET CURRENT DATE FROM SYSTEM ----- CALL FOR$JDATE(MM, DD, YY) ! ----- CALCULATE AND STORE THE CURRENT DATE ----- ! ----- (AS YYYYMMDD) ----- IF YY >= 50% THEN ! CHANGE 0-50 TO 2000's SY_USRADDDAT = 19000000% + YY * 10000% & + MM * 100% + DD ELSE ! CHANGE 51-99 TO 1900's SY_USRADDDAT = 20000000% + YY * 10000% & + MM * 100% + DD END IF ! ----- STORE THE USER'S DATABASE RECORD ----- IF DEBUG_MODE THEN PRINT "DEBUG>Store new user for " + & TRM$(ENTERED_USERNAME) END IF # STORE SY_USRREC (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END, DML$K_ERROR ! UNEXPECTED ERROR: PRINT "Unexpected error from" + & " STORE SY_USRREC" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END SELECT ! ----- STORE USER PLANT CODE LIST ----- SY_UPCUSRNAME = SY_USRNAME TEMP = 0% WHILE TEMP < CTR_UPC TEMP = TEMP + 1% SY_UPCPLTCODE = UPCPLTCODE(TEMP) SY_UPCPACKMASK = UPCPACKMASK(TEMP) SY_UPCADDPLTPRV = UPCADDPLTPRV(TEMP) SY_UPCDEFPRIVS = UPCDEFPRIVS(TEMP) SY_UPCWAREHOUSE = UPCWAREHOUSE(TEMP) SY_UPCSVREGION = UPCSVREGION(TEMP) IF DEBUG_MODE THEN PRINT "DEBUG>Store SY_UPCREC" END IF # STORE SY_UPCREC (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END, DML$K_ERROR ! UNEXPECTED ERROR: PRINT "Unexpected error from" + & " STORE SY_UPCPLTREC" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END SELECT NEXT ! ----- STORE USER PLANT CODE COMMAND LIST ----- PREVIOUS_PLANT_CODE = '***' SY_CMDUSRNAME = SY_USRNAME TEMP = 0% WHILE TEMP < CTR_CMD TEMP = TEMP + 1% SY_CMDNAME = CMDNAME(TEMP) SY_CMDPLTCODE = CMDPLTCODE(TEMP) IF PREVIOUS_PLANT_CODE <> SY_CMDPLTCODE THEN SY_UPCPLTCODE = SY_CMDPLTCODE IF DEBUG_MODE THEN PRINT "DEBUG>Fetch" + & " first SY_UPCREC" END IF # FIND FIRST SY_UPCREC WITHIN - SY_UPCHSHSET USING - SY_UPCUSRNAME SY_UPCPLTCODE - (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END ! END-OF-COLLECTION: PRINT "Unexpected" + & " end-of-" + & "collection" + & " error from" + & " FIND FIRST" + & " SY_UPCREC" + BEL ! ----- DISPLAY ERROR AND ----- ! ----- ABORT ----- CALL DBM$SIGNAL CASE DML$K_ERROR! UNEXPECTED ERROR: PRINT "Unexpected" + & " error from" + & " FIND FIRST" + & " SY_UPCREC" + BEL ! ----- DISPLAY ERROR AND ----- ! ----- ABORT ----- CALL DBM$SIGNAL END SELECT END IF PREVIOUS_PLANT_CODE = SY_UPCPLTCODE IF DEBUG_MODE THEN PRINT "DEBUG>Store SY_CMDREC" END IF # STORE SY_CMDREC (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END, DML$K_ERROR ! UNEXPECTED ERROR: PRINT "Unexpected error from" + & " STORE SY_CMDREC" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END SELECT NEXT ! ----- STORE USER PLANT CODE TDMS PRIVILEGE LIST ----- PREVIOUS_PLANT_CODE = '***' TEMP = 0% WHILE TEMP < CTR_SCN TEMP = TEMP + 1% SY_UPCPLTCODE = SCNPLTCODE(TEMP) SY_SCNCMD = SCNCMD(TEMP) SY_SCNACTFLD = SCNACTFLD(TEMP) SY_SCNASKTDMSREQ = SCNASKTDMSREQ(TEMP) SY_SCNUSRTDMSREQ = SCNUSRTDMSREQ(TEMP) IF PREVIOUS_PLANT_CODE <> SY_UPCPLTCODE THEN IF DEBUG_MODE THEN PRINT "DEBUG>Fetch" + & " first SY_UPCREC" END IF # FIND FIRST SY_UPCREC WITHIN - SY_UPCHSHSET USING - SY_UPCUSRNAME SY_UPCPLTCODE - (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END ! END-OF-COLLECTION: PRINT "Unexpected" + & " end-of-" + & "collection" + & " error from" + & " FIND FIRST" + & " SY_UPCREC" + BEL ! ----- DISPLAY ERROR AND ----- ! ----- ABORT ----- CALL DBM$SIGNAL CASE DML$K_ERROR! UNEXPECTED ERROR: PRINT "Unexpected" + & " error from" + & " FIND FIRST" + & " SY_UPCREC" + BEL ! ----- DISPLAY ERROR AND ----- ! ----- ABORT ----- CALL DBM$SIGNAL END SELECT END IF PREVIOUS_PLANT_CODE = SY_UPCPLTCODE IF DEBUG_MODE THEN PRINT "DEBUG>Store SY_SCNREC" END IF # STORE SY_SCNREC (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END, DML$K_ERROR ! UNEXPECTED ERROR: PRINT "Unexpected error from" + & " STORE SY_SCNREC" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END SELECT NEXT ! ----- STORE USER PLANT CODE MANUFACTURING SCREEN ----- ! ----- LIST ----- PREVIOUS_PLANT_CODE = '***' TEMP = 0% WHILE TEMP < CTR_SEC TEMP = TEMP + 1% SY_UPCPLTCODE = SECPLTCODE(TEMP) SY_SECNAME = SECNAME(TEMP) IF PREVIOUS_PLANT_CODE <> SY_UPCPLTCODE THEN IF DEBUG_MODE THEN PRINT "DEBUG>Fetch" + & " first SY_UPCREC" END IF # FIND FIRST SY_UPCREC WITHIN - SY_UPCHSHSET USING - SY_UPCUSRNAME SY_UPCPLTCODE - (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END ! END-OF-COLLECTION: PRINT "Unexpected" + & " end-of-" + & "collection" + & " error from" + & " FIND FIRST" + & " SY_UPCREC" + BEL ! ----- DISPLAY ERROR AND ----- ! ----- ABORT ----- CALL DBM$SIGNAL CASE DML$K_ERROR! UNEXPECTED ERROR: PRINT "Unexpected" + & " error from" + & " FIND FIRST" + & " SY_UPCREC" + BEL ! ----- DISPLAY ERROR AND ----- ! ----- ABORT ----- CALL DBM$SIGNAL END SELECT END IF PREVIOUS_PLANT_CODE = SY_UPCPLTCODE IF DEBUG_MODE THEN PRINT "DEBUG>Store SY_SECREC" END IF # STORE SY_SECREC (TRAP END, ERROR) SELECT DML$VALUE CASE DML$K_END, DML$K_ERROR ! UNEXPECTED ERROR: PRINT "Unexpected error from" + & " STORE SY_SECREC" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END SELECT NEXT SELECT USER_ACTIONS(ACTION_INDEX) CASE "T" ! IF CHANGING TEMPLATE: PRINT " User " + & TRM$(ENTERED_USERNAME) + & " successfully changed in" + & " database " + DB_TO_ACCESS + "..." CASE ELSE PRINT " User " + & TRM$(ENTERED_USERNAME) + & " successfully added to" + & " database " + DB_TO_ACCESS + "..." END SELECT ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER_ADD_USER = FALSE END DEF ! ----- LOCAL FUNCTION TO COMMIT/UNBIND FROM THE CURRENT ----- ! ----- DATABASE ----- DEF WORD NUSER_OTHER_COMMIT IF NUSER_FLAG1 THEN ! IF DBMS DATABASE READIED: IF DEBUG_MODE THEN PRINT "DEBUG>Commit" END IF # COMMIT (TRAP END, ERROR) ! ----- INIT "DATABASE READIED" FLAG ----- NUSER_FLAG1 = FALSE SELECT DML$VALUE CASE DML$K_END ! END-OF-COLLECTION: IF DEBUG_MODE THEN PRINT "DEBUG>Rollback" END IF # ROLLBACK PRINT "Unexpected End-of-" + & "collection error" + & " occurred during COMMIT" + BEL CASE DML$K_ERROR! UNEXPECTED ERROR: PRINT "Unexpected error from" + & " COMMIT" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END SELECT ELSE IF DEBUG_MODE THEN PRINT "DEBUG>---Skip Commit" + & " due to un-readied database---" END IF END IF IF NUSER_FLAG2 THEN ! IF BOUND TO DATABASE: ! ----- UNBIND FROM THIS DATABASE ----- NUSER_FLAG2 = FALSE LOCAL_STATUS = DBQ$INTERPRET_STREAM( & "UNBIND", DBMUWA BY REF) IF (LOCAL_STATUS AND 1%) = 0% THEN PRINT "Error while unbinding" + & " from SYSDB database" + BEL ! ----- EXIT WITH ERROR STATUS ----- CALL LIB$STOP(LOCAL_STATUS BY VALUE) END IF ELSE IF DEBUG_MODE THEN PRINT "DEBUG>---Skip Commit" + & " Unbind due to" + & " un-bound database---" END IF END IF ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER_COMMIT = FALSE END DEF ! ----- LOCAL FUNCTION TO READY, REMOVE A USER FROM THE ----- ! ----- SECURITY DATABASE, AND THEN COMMIT (OR ROLLBACK IF ----- ! ----- ANY ERROR OR USER DOES NOT EXIST) ----- DEF WORD NUSER_OTHER_DELETE_USER(STRING DB_TO_ACCESS) ! ----- ASSUME ERROR STATUS ----- NUSER_OTHER_DELETE_USER = TRUE ! ----- READY DATABASE FOR UPDATE ----- TEMP = READY_PROCESSING("DELETE_DB_USER:", & DB_TO_ACCESS, TRUE) ! ----- GET THE USER'S DATABASE RECORD ----- SY_USRNAME = ENTERED_USERNAME IF DEBUG_MODE THEN PRINT "DEBUG>Fetch SY_USRREC" END IF # FETCH FIRST SY_USRREC WITHIN SY_USRHSHSET USING - SY_USRNAME (TRAP END, ERROR) IF DEBUG_MODE THEN PRINT "DEBUG>DBM_COND after FETCH" + & " SY_USRREC="; DBM_COND PRINT "DEBUG>DML$VALUE after FETCH" + & " SY_USRREC="; DML$VALUE PRINT "DEBUG>DML$K_ERROR="; DML$K_ERROR PRINT "DEBUG>DBM$_END="; DBM$_END END IF IF (LIB$MATCH_COND(DBM_COND, DBM$_END)) THEN ! ----- END-OF-COLLECTION: ----- PRINT " User " + & TRM$(ENTERED_USERNAME) + & " does not have access to this database" ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK EXIT DEF END IF IF DML$VALUE = DML$K_ERROR THEN PRINT "Unexpected error from FETCH" + & " FIRST SY_USRREC" + & " (DELETE_DB_USER)" + BEL CALL DBM$SIGNAL ! DISPLAY ERROR AND ABORT END IF ! ----- ERASE CURRENT RECORD AND ALL SETS OWNED ----- ! ----- BY IT ----- IF DEBUG_MODE THEN PRINT "DEBUG>Erase All" END IF # ERASE ALL SY_USRREC (TRAP END, ERROR) IF DEBUG_MODE THEN PRINT "DEBUG>DBM_COND after" + & " ERASE SY_USRREC="; DBM_COND PRINT "DEBUG>DML$VALUE after ERASE" + & " SY_USRREC="; DML$VALUE END IF SELECT DML$VALUE CASE DML$K_END ! END-OF-COLLECTION: PRINT "Unexpected End-of-collection" + & " error occurred" + BEL ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK EXIT DEF CASE DML$K_ERROR ! UNEXPECTED ERROR: PRINT "Unexpected error from ERASE" + & " ALL SY_USRREC" + & " (DELETE_DB_USER)" + BEL CALL DBM$SIGNAL ! DISPLAY ERROR AND ABORT END SELECT PRINT " User " + TRM$(ENTERED_USERNAME) + & " successfully deleted from database " & + DB_TO_ACCESS + "..." ! ----- COMMIT/UNBIND THE CURRENT DATABASE ----- TEMP = NUSER_OTHER_COMMIT ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER_DELETE_USER = FALSE END DEF IF DEBUG_MODE THEN PRINT "NUSER_OTHER DEBUG>OTHER_ACTION="; OTHER_ACTION PRINT "NUSER_OTHER DEBUG>OTHER_PARAM1="; OTHER_PARAM1 PRINT "NUSER_OTHER DEBUG>OTHER_PARAM2="; OTHER_PARAM2 END IF SELECT OTHER_ACTION CASE "DBMSUSER" ! ----- SEE IF USER IS ALLOWED TO ACCESS ----- ! ----- AND/OR 4GL ----- IF NOT DBMS_EXISTS AND NOT FOUR_GL_EXISTS THEN DEFAULT_DB = "0" OTHER_PARAM1 = "N" IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ELSE ACTION_SEQ = ACTION_SEQ + 1% END IF ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF IF DIV = "OTH" THEN DEFAULT_DB = "0" ELSE ! ----- EXTRACT DEFAULT DATABASE NUMBER, ----- ! ----- IF ANY ----- DEFAULT_DB = NUM1$(DIVISION_OTHER(DIV_INDEX)) END IF ! ----- SEE IF THIS USER IS ALLOWED TO ACCESS ----- ! ----- ----- IF DEFAULT_DB = "0" AND DIV <> "PGM" THEN VALID_ENTRY = FALSE ! ----- NOT MOVING BACK THRU PROMPTS ----- BACKWARDS = FALSE ELSE IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF ! ----- NON-PGM DIVISION USERS WHICH HAVE ----- ! ----- A DEFAULT DATABASE ARE ALLOWED TO ----- ! ----- ACCESS ----- OTHER_PARAM1 = "Y" VALID_ENTRY = TRUE END IF WHILE NOT VALID_ENTRY RECORD_FOUND = TRUE IF FOUR_GL_EXISTS THEN PRINT "Is this user allowed" + & " to access " + & TRM$(DBMS_PRODUCT) + & " or " + TRM$(FOUR_GL) & + " (Y or N)" ELSE PRINT "Is this user allowed" + & " to access " + & TRM$(DBMS_PRODUCT) + " (Y or N)" END IF WHEN ERROR IN LINPUT #98%, & " (Default of N): "; & OTHER_PARAM1 USE RECORD_FOUND = FALSE CONTINUE END WHEN IF NOT RECORD_FOUND THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF ! ----- UPPERCASE AND DISCARD ANY GARBAGE ----- ! ----- CHARS ----- OTHER_PARAM1 = EDIT$(OTHER_PARAM1, 38%) OTHER_PARAM1 = "N" IF OTHER_PARAM1 = "" IF OTHER_PARAM1 = "B" THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF IF OTHER_PARAM1 <> "Y" AND OTHER_PARAM1 <> "N" THEN PRINT PRINT "Error - Invalid" + & " response" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END IF VALID_ENTRY = TRUE NEXT ! ----- CONTINUE WITH DESIRED PROMPT ----- ACTION_SEQ = ACTION_SEQ + 1% CASE "GET_4GL_ACCESS" ! ----- SEE IF 4GL ACCESS IS TO BE GRANTED TO ----- ! ----- THIS USER ----- IF NOT FOUR_GL_EXISTS THEN OTHER_PARAM1 = "N" IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ELSE ACTION_SEQ = ACTION_SEQ + 1% END IF ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF IF DEBUG_MODE THEN PRINT "DEBUG>GET 4GL ACCESS" END IF ! ----- IF THIS DIVISION HAS A DEFAULT DB AND USER ----- ! ----- IS ALLOWED TO ACCESS THE 4GL: ----- IF DEFAULT_DB <> "0" AND OTHER_PARAM1 = "Y" THEN VALID_ENTRY = FALSE ! ----- TRANSLATE ANY 4GL LOGICAL NAME ----- TEMP_STRING = FOUR_GL_PREFIX + DEFAULT_DB LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING,& TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS ----- ! ----- STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = TRUE OTHER_PARAM1 = "N" CASE <> SS$_NORMAL PRINT "Unexpected error" + & " while trying to" + & " translate " + & TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT ! ----- ENSURE THAT THE 4GL IDENTIFIER ----- ! ----- EXISTS ----- THE_IDENT = FOUR_GL_PREFIX + DEFAULT_DB ! ----- SEE IF THE IDENTIFIER DOES NOT ----- ! ----- EXIST ----- IF VALIDATE_IDENTIFIER THEN IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS ----- ! ----- STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = TRUE OTHER_PARAM1 = "N" END IF ELSE IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = TRUE OTHER_PARAM1 = "N" END IF WHILE NOT VALID_ENTRY ! ----- NOT MOVING BACK THRU PROMPTS ----- BACKWARDS = FALSE RECORD_FOUND = TRUE PRINT PRINT "Do you want to allow this" + & " user to access the " + & TRM$(FOUR_GL) + " " + & DEFAULT_DB + " database?" WHEN ERROR IN LINPUT #98%, & "Enter Y or N (Default of N): "; & OTHER_PARAM1 USE RECORD_FOUND = FALSE CONTINUE END WHEN IF NOT RECORD_FOUND THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF ! ----- UPPERCASE AND DISCARD ANY GARBAGE ----- ! ----- CHARS ----- OTHER_PARAM1 = EDIT$(OTHER_PARAM1, 38%) OTHER_PARAM1 = "N" IF OTHER_PARAM1 = "" IF OTHER_PARAM1 = "B" THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF IF OTHER_PARAM1 <> "Y" AND OTHER_PARAM1 <> "N" THEN PRINT PRINT "Error - Invalid" + & " response" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END IF VALID_ENTRY = TRUE NEXT ! ----- CONTINUE WITH DESIRED PROMPT ----- ACTION_SEQ = ACTION_SEQ + 1% CASE "GET_DIVISIONAL_IDENT" IF DIV = "OTH" THEN IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = TRUE OTHER_PARAM1 = DIV + "U" ELSE ! ----- TRY TO TRANSLATE ANY divOPR ----- ! ----- IDENTIFIER LOGICAL NAME ----- TEMP_STRING = DIV + "OPR" IF DEBUG_MODE THEN PRINT "DEBUG>TRANSLATE " + TEMP_STRING END IF LOCAL_STATUS = LOGICAL_NAME( & TEMP_STRING, TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM ! ----- IF NO LOGICAL EQUIVALENT ----- VALID_ENTRY = TRUE OTHER_PARAM1 = DIV + "U" CASE SS$_NORMAL VALID_ENTRY = FALSE CASE ELSE PRINT "Unexpected error" + & " while trying to" + & " translate " + & TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT END IF WHILE NOT VALID_ENTRY ! ----- WE ARE NOT GOING BACKWARDS ----- BACKWARDS = FALSE RECORD_FOUND = TRUE PRINT PRINT "What kind of access does this" + & " user require to the" + & " directories containing the" PRINT DIV + " division's User-Controlled files?" PRINT " Enter W for READ/WRITE" + & " access, R for READ access," & + " or N for no access" PRINT PRINT "Notes: Responding with a W" + & " will allow:" PRINT " READ access to " + & DIV + "OPR, " + DIV + "COM, " + & DIV + "CUS, and " + DIV + & "-division report files" PRINT " READ/WRITE/DELETE" + & " access to " + DIV + & "FOC and " + DIV + "USR files" PRINT " Responding with an R" + & " will allow READ access to" + & " all of the above files" PRINT " Responding with an N" + & " will allow no access to all" & + " of the above files" PRINT WHEN ERROR IN IF DIV = "PGM" THEN LINPUT #98%, & "Enter W, R, or N (Default of W): "; & OTHER_PARAM1 ELSE LINPUT #98%, & "Enter W, R, or N (Default of R): "; & OTHER_PARAM1 END IF USE RECORD_FOUND = FALSE CONTINUE END WHEN IF NOT RECORD_FOUND THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF ! ----- UPPERCASE AND DISCARD ANY GARBAGE ----- ! ----- CHARS ----- OTHER_PARAM1 = EDIT$(OTHER_PARAM1, 38%) IF DIV = "PGM" THEN OTHER_PARAM1 = "W" IF OTHER_PARAM1 = "" ELSE OTHER_PARAM1 = "R" IF OTHER_PARAM1 = "" END IF IF OTHER_PARAM1 = "B" THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF SELECT OTHER_PARAM1 CASE "R" OTHER_PARAM1 = DIV + "R" CASE "W" OTHER_PARAM1 = DIV + "W" CASE "N" OTHER_PARAM1 = DIV + "U" CASE ELSE PRINT PRINT "Error - Invalid" + & " response" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END SELECT VALID_ENTRY = TRUE NEXT ! ----- CONTINUE WITH DESIRED PROMPT ----- ACTION_SEQ = ACTION_SEQ + 1% ! ----- DONE IF WE ARE CHANGING ACCESS TO ----- ! ----- DIVISION-SPECIFIC FILES IF USER_ACTIONS(ACTION_INDEX) = "F" THEN ACTION_SEQ = 999% END IF CASE "GET_OTHER_DATABASE" ! ----- SEE IF ANY OTHER AND/OR 4GL ----- ! ----- DATABASE ACCESS IS WANTED ----- PREV_TEMPLATE_DB = "@" OTHER_IDENTS_CTR = 0% IF NOT DBMS_EXISTS AND NOT FOUR_GL_EXISTS THEN IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ELSE ACTION_SEQ = ACTION_SEQ + 1% END IF ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF IF DEBUG_MODE THEN PRINT "DEBUG>ENTER GET_OTHER_DATABASE" PRINT "DEBUG>DBMS_EXISTS="; DBMS_EXISTS PRINT "DEBUG>FOUR_GL_EXISTS="; FOUR_GL_EXISTS PRINT "DEBUG>OTHER_PARAM1="; OTHER_PARAM1 PRINT "DEBUG>ACTION_INDEX="; ACTION_INDEX PRINT "DEBUG>USER_ACTION="; & USER_ACTIONS(ACTION_INDEX) END IF IF OTHER_PARAM1 = "N" THEN VALID_ENTRY = TRUE ELSE VALID_ENTRY = FALSE END IF WHILE NOT VALID_ENTRY RECORD_FOUND = TRUE PRINT SELECT USER_ACTIONS(ACTION_INDEX) CASE "X" ! ----- IF DBMS + 4GL INSTALLED: ----- IF DBMS_EXISTS AND FOUR_GL_EXISTS THEN PRINT "Enter any" + & " 3-digit" + & " database" + & " number to" + & " be denied access, or" PRINT " Fnnn " + & TRM$(FOUR_GL) + & " database to" & + " be denied access:" ELSE IF DBMS_EXISTS THEN PRINT "Enter any" + & " 3-digit" + & " database" + & " number to" + & " be denied" + & " access:" ELSE PRINT "Enter any" + & " Fnnn " + & TRM$(FOUR_GL) & + " database" & + " to be" + & " denied" + & " access:" END IF END IF CASE "T" PRINT "Enter the 3-digit" + & " database number whose"& + " access is to be changed:" CASE ELSE ! ----- IF DBMS + 4GL INSTALLED: ----- IF DBMS_EXISTS AND FOUR_GL_EXISTS THEN PRINT "Enter any" + & " additional" + & " 3-digit" + & " database" + & " number to be" & + " granted access, or" PRINT " Fnnn " + & TRM$(FOUR_GL) + & " database to" & + " be granted access:" ELSE IF DBMS_EXISTS THEN PRINT "Enter any" + & " additional" & + " 3-digit" + & " database" + & " number to" + & " be granted" & + " access:" ELSE PRINT "Enter any" + & " additional" & + " Fnnn " + & TRM$(FOUR_GL) & + " database" & + " to be" + & " granted" + & " access:" END IF END IF END SELECT WHEN ERROR IN LINPUT #98%, & " (Enter E when done): "; & DB_ACCESS USE RECORD_FOUND = FALSE CONTINUE END WHEN IF NOT RECORD_FOUND THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF ! ----- UPPERCASE AND DISCARD ANY GARBAGE ----- ! ----- CHARS ----- DB_ACCESS = EDIT$(DB_ACCESS, 38%) ITERATE IF DB_ACCESS = "" ! ----- SEE IF ALL DONE ----- IF DB_ACCESS = "E" THEN IF DEBUG_MODE THEN PRINT "DEBUG>EXIT" + & " GET_OTHER_DATABASE" END IF ! ----- SET FLAG TO EXIT LOOP ----- VALID_ENTRY = TRUE ITERATE END IF IF DB_ACCESS = "B" THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF SELECT LEN(DB_ACCESS) CASE 3% IF NOT DBMS_EXISTS THEN PRINT PRINT "Error -" + & " Invalid" + & " response" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END IF ! ----- VALIDATE FOR A DATABASE ----- IF VALID_DB_DATABASE(DB_ACCESS) THEN ITERATE END IF OTHER_DB = DB_ACCESS CASE 4% IF NOT FOUR_GL_EXISTS THEN PRINT PRINT "Error -" + & " Invalid" + & " response" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END IF ! ----- VALIDATE FOR A 4GL ----- ! ----- DATABASE ----- IF VALID_4GL_DATABASE(DB_ACCESS) THEN ITERATE END IF OTHER_DB = RIGHT(DB_ACCESS, 2%) CASE ELSE PRINT PRINT "Error - Invalid" + & " response" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END SELECT ! ----- TRANSLATE ANY DIV_nnn LOGICAL NAME ----- TEMP_STRING = "DIV_" + OTHER_DB IF DEBUG_MODE THEN PRINT "DEBUG>TRANSLATE " + TEMP_STRING END IF LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING,& TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM ! IF NO LOGICAL EQUIVALENT: PRINT PRINT "Error - Invalid" + & " division for " + & OTHER_DB + BEL PRINT ITERATE CASE SS$_NORMAL IF LEN(TRANSLATED_NAME) <> 6% THEN PRINT PRINT "Error -" + & " Invalid" + & " division" + & " length for " & + OTHER_DB + BEL PRINT ITERATE END IF ! ----- EXTRACT THE DIVISION CODE ----- ! ----- FOR THIS DATABASE ----- OTHER_DIV = LEFT(TRANSLATED_NAME, 3%) FORCE_READONLY = FALSE ! ----- VALIDATE THE DIVISION CODE ----- MATCH_FOUND = FALSE IF PRIVILEGED THEN ! ----- LOCATE MATCHING ----- ! ----- DIVISION INFO IN ----- ! ----- THE PROGRAM'S ----- ! ----- ARRAYS ----- ! ----- -1 ALLOWS PGM ----- ! ----- DIVISION ----- OTHER_INDEX = -1% WHILE OTHER_INDEX < & DIVISION_CTR & AND NOT MATCH_FOUND OTHER_INDEX = & OTHER_INDEX + 1% IF DIVISION_NAMES( & OTHER_INDEX) & = OTHER_DIV THEN MATCH_FOUND = & TRUE END IF NEXT ELSE ! ----- VALIDATE AGAINST ----- ! ----- HELD DIVISION ----- ! ----- IDENTIFIERS IF NOT ----- ! ----- PRIVILEGED ----- TEMP = 0% WHILE TEMP < HELD_DIVS_CTR & AND NOT MATCH_FOUND TEMP = TEMP + 1% IF HELD_DIVS(TEMP) = & OTHER_DIV THEN MATCH_FOUND = & TRUE END IF NEXT ! ----- VALIDATE AGAINST ----- ! ----- HELD DATABASE ----- ! ----- IDENTIFIERS IF NO ----- ! ----- MATCHING DIVISION ----- IF NOT MATCH_FOUND THEN TEMP = 0% WHILE TEMP < & HELD_DIVS_CTR & AND NOT & MATCH_FOUND TEMP = TEMP + 1% IF HELD_DIVS( & TEMP) & = & OTHER_DB THEN MATCH_FOUND& = TRUE END IF NEXT ! ----- FORCE ----- ! ----- *READONLY ----- ! ----- TEMPLATE ----- ! ----- IF ----- ! ----- GRANTING ----- ! ----- ACCESS TO ----- ! ----- A DATABASE ----- ! ----- WHOSE ----- ! ----- DIVISION ----- ! ----- NOR ----- ! ----- DATABASE ----- ! ----- IDENTIFIER ----- ! ----- IS HELD BY ----- ! ----- THIS USER, ----- ! ----- UNLESS THE ----- ! ----- USER IS IN ----- ! ----- A DIFFERENT ---- ! ----- DIVISION ----- ! ----- THAN ANY ----- ! ----- MASTER_DIV ----- ! ----- WHICH IS ----- ! ----- HELD ----- IF NOT MATCH_FOUND THEN IF NOT & INVALID_DIVISION THEN FORCE_READONLY & = TRUE MATCH_FOUND = & TRUE END IF END IF END IF END IF IF NOT MATCH_FOUND THEN PRINT IF PRIVILEGED THEN PRINT "Error -" & + " Invalid" + & " Division (" & + OTHER_DIV + & ") for this" + & " database" + & TRM$( & PLEASE_TRY_AGAIN) PRINT " Valid" & + " Divisions"& + " are: "; OTHER_INDEX = -1% WHILE OTHER_INDEX < & DIVISION_CTR OTHER_INDEX = & OTHER_INDEX & + 1% IF OTHER_INDEX & = 0% THEN PRINT & DIVISION_NAMES& (OTHER_INDEX); ELSE PRINT "," + & DIVISION_NAMES& (OTHER_INDEX); END IF NEXT PRINT ELSE SELECT USER_ACTIONS( & ACTION_INDEX) CASE "G", "A" TEMP_STRING = & "grant" CASE "T" TEMP_STRING = & "change" CASE "X" TEMP_STRING = & "deny" END SELECT PRINT "Error -" & + " You are " & + "not" + & " authorized" & + " to " + & TEMP_STRING + & " access for" & + " the " + & OTHER_DB + & " database" PRINT " " + & TRM$( & PLEASE_TRY_AGAIN) END IF PRINT ITERATE END IF CASE ELSE PRINT "Unexpected error while" & + " trying to translate " + & TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT ! ----- IF GRANTING OR CHANGING ACCESS TO ----- ! ----- A DATABASE, ALSO PROMPT FOR AND ----- ! ----- GET THE TEMPLATE ----- IF DEBUG_MODE THEN PRINT "DEBUG>USER ACTION=" + & USER_ACTIONS(ACTION_INDEX) END IF SELECT USER_ACTIONS(ACTION_INDEX) CASE "X" OTHER_TEMPLATE = "" TEMPLATE_DB = "" VALID_ENTRY = TRUE CASE "G", "T", "A" ! ----- SEE IF *READONLY TEMPLATE ----- ! ----- IS FORCED ----- IF FORCE_READONLY THEN IF DEBUG_MODE THEN PRINT "DEBUG>" +& "FORCE_READONLY" END IF OTHER_TEMPLATE = "*READONLY" TEMPLATE_DB = OTHER_DB VALID_ENTRY = TRUE IF LEN(DB_ACCESS) = 3% THEN PRINT PRINT " Using" & + " the " + & "*READONLY " & + TRM$( & DBMS_PRODUCT) & + " Security" & + " Database" & + " Template" SELECT USER_ACTIONS( & ACTION_INDEX) CASE "G", "A" TEMP_STRING = & "granting" CASE "T" TEMP_STRING = & "changing" END SELECT PRINT " when " + & TEMP_STRING + & " this user " & + "access to" & + " the " + & DB_ACCESS + & " database..." PRINT END IF ELSE IF LEN(DB_ACCESS) = 3% THEN VALID_ENTRY = FALSE ELSE OTHER_TEMPLATE = "" TEMPLATE_DB = "" VALID_ENTRY = TRUE END IF END IF CASE ELSE IF LEN(DB_ACCESS) = 3% THEN VALID_ENTRY = FALSE ELSE OTHER_TEMPLATE = "" TEMPLATE_DB = "" VALID_ENTRY = TRUE END IF END SELECT IF DEBUG_MODE THEN PRINT "DEBUG>BEFORE TEMPLATE" + & " GET - VALID_ENTRY="; & VALID_ENTRY END IF IF NOT VALID_ENTRY THEN ! ----- ENSURE THE DATABASE HAS ----- ! ----- NO ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK END IF WHILE NOT VALID_ENTRY RECORD_FOUND = TRUE WHEN ERROR IN PRINT SELECT USER_ACTIONS( & ACTION_INDEX) CASE "G", "A" TEMP_STRING = "granting" CASE "T" TEMP_STRING = "changing" END SELECT PRINT " Enter the " + & TRM$( & DBMS_PRODUCT) + & " Security" + & " Database" + & " Template" + & " to be" + & " used when " + & TEMP_STRING + & " this user" PRINT " access to the "& + DB_ACCESS + & " database: " IF PRIVILEGED THEN PRINT PRECEDE_DESC END IF PRINT " (Or type" + & " LIST to" + & " list all" + & " Security" + & " Database Templates)" LINPUT #98%, & " (Default of *READONLY) ==> "; & OTHER_TEMPLATE USE RECORD_FOUND = FALSE CONTINUE END WHEN IF NOT RECORD_FOUND THEN ! ----- RETURN SUCCESS ----- ! ----- STATUS ----- NUSER_OTHER = FALSE ! ----- (EXIT WITH ----- ! ----- ACTION_SEQ ----- ! ----- UNCHANGED SO THAT ----- ! ----- WE WILL CALL THIS ----- ! ----- SAME FUNCTION ----- ! ----- AGAIN) ----- EXIT FUNCTION END IF IF DEBUG_MODE THEN PRINT "DEBUG>OTHER_" + & "TEMPLATE=" + & OTHER_TEMPLATE + "*" END IF ! ----- UPPERCASE AND DISCARD ANY ----- ! ----- GARBAGE CHARS ----- OTHER_TEMPLATE = & EDIT$(OTHER_TEMPLATE, 38%) IF OTHER_TEMPLATE = "B" THEN ! ----- RETURN SUCCESS ----- ! ----- STATUS ----- NUSER_OTHER = FALSE ! ----- (EXIT WITH ----- ! ----- ACTION_SEQ ----- ! ----- UNCHANGED SO THAT ----- ! ----- WE WILL CALL THIS ----- ! ----- SAME FUNCTION ----- ! ----- AGAIN) ----- EXIT FUNCTION END IF ! ----- SEE IF TEMPLATE DATABASE ----- ! ----- WAS SPECIFIED ----- IF PRIVILEGED THEN IF NUMERIC(LEFT( & OTHER_TEMPLATE, 3%)) THEN TEMPLATE_DB = & LEFT( & OTHER_TEMPLATE,& 3%) ! ----- VALIDATE ----- ! ----- FOR A ----- ! ----- MANMAN ----- ! ----- DATABASE ----- ! ----- (NO MSG IF ----- ! ----- ANY ERROR) ----- IF VALID_MANMAN_DB( & TEMPLATE_DB, & FALSE) THEN TEMPLATE_DB = & OTHER_DB ELSE OTHER_TEMPLATE & = RIGHT(& OTHER_TEMPLATE& , 4%) END IF ELSE TEMPLATE_DB = OTHER_DB END IF ELSE TEMPLATE_DB = OTHER_DB END IF OTHER_TEMPLATE = "*READONLY" & IF OTHER_TEMPLATE = "" IF DEBUG_MODE THEN PRINT "DEBUG>TEMPLATE" +& "_DB=" + TEMPLATE_DB PRINT "DEBUG>OTHER_" + & "TEMPLATE(2)=" +& OTHER_TEMPLATE + "*" END IF IF OTHER_TEMPLATE = "LIST" THEN ! ----- DISPLAY ALL ----- ! ----- SECURITY DATABASE ----- ! ----- TEMPLATES ----- IF NUSER_OTHER_LIST_TEMPLATES( & TEMPLATE_DB) THEN ITERATE END IF END IF IF LEFT(OTHER_TEMPLATE, 1%) <> & "*" OR & LEN(OTHER_TEMPLATE) < & 2% OR LEN(OTHER_TEMPLATE) > 12% THEN PRINT PRINT "Error -" + & " Invalid" + & " template" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END IF ! ----- VALIDATE TEMPLATE AGAINST ----- ! ----- SECURITY DATABASE TEMPLATE ----- ! ----- (RETURNS TRUE IF VALID ----- ! ----- TEMPLATE) ----- IF NOT NUSER_OTHER_VALIDATE_TEMPLATE( & TEMPLATE_DB, OTHER_TEMPLATE) THEN PRINT PRINT "Error - Invalid" & + " template" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END IF IF DEBUG_MODE THEN PRINT "DEBUG>VALID" + & " OTHER_TEMPLATE" END IF VALID_ENTRY = TRUE NEXT ! ----- DO ANY ROLLBACK/UNBIND FOR THIS ----- ! ----- DATABASE ----- TEMP = NUSER_OTHER_ROLLBACK PRINT IF LEN(DB_ACCESS) = 3% VALID_ENTRY = FALSE ! ----- ADD TO LIST OF OTHER IDENTIFIERS ----- ! ----- TO GRANT ACCESS ----- IF DEBUG_MODE THEN PRINT "DEBUG>OTHER_IDENTS(" + & NUM1$(OTHER_IDENTS_CTR & + 1%) + ")=" + DB_ACCESS PRINT "DEBUG>" + & "OTHER_IDENTS_TEMPLATE("& + NUM1$( & OTHER_IDENTS_CTR + 1%) & + ")=" + OTHER_TEMPLATE PRINT "DEBUG>" + & "OTHER_IDENTS_DB(" & + NUM1$( & OTHER_IDENTS_CTR + 1%) & + ")=" + TEMPLATE_DB END IF OTHER_IDENTS_CTR = OTHER_IDENTS_CTR + 1% OTHER_IDENTS(OTHER_IDENTS_CTR) = DB_ACCESS OTHER_IDENTS_TEMPLATE(OTHER_IDENTS_CTR) & = OTHER_TEMPLATE OTHER_IDENTS_DB(OTHER_IDENTS_CTR) = TEMPLATE_DB NEXT IF DEBUG_MODE THEN PRINT "DEBUG>DONE WITH" + & " GET_OTHER_DATABASE -" + & " OTHER_IDENTS_CTR="; OTHER_IDENTS_CTR END IF ! ----- SEE IF WE SHOULD ALSO GRANT OR REVOKE ----- ! ----- THE IDENTIFIER ON OTHER NODES ----- GRANT_DENY_OTHER_NODES = FALSE IF PRIVILEGED AND OTHER_IDENTS_CTR <> 0% AND & NODE_COUNTER > 1% THEN SELECT USER_ACTIONS(ACTION_INDEX) CASE "G", "X" VALID_ENTRY = FALSE WHILE NOT VALID_ENTRY RECORD_FOUND = TRUE WHEN ERROR IN PRINT SELECT USER_ACTIONS( & ACTION_INDEX) CASE "G" TEMP_STRING = & "grant" TEMP_STRING2 = & "to" CASE "X" TEMP_STRING = & "deny" TEMP_STRING2 & = "from" END SELECT PRINT " This user" + & " has an" + & " account" + & " on the" + & " following" + & " nodes: " + & LEFT( & OTHER_PARAM2, & LEN( & OTHER_PARAM2) & - 1%) PRINT PRINT " Do you also" +& " want to " + & TEMP_STRING + & " the" +& " identifiers "& + TEMP_STRING2 & + " this user" & + " on ALL" + & " of the above" PRINT " nodes?" LINPUT #98%, & " Enter Y or N (Default of N) ==> "; & TEMP_STRING USE RECORD_FOUND = FALSE CONTINUE END WHEN IF NOT RECORD_FOUND THEN ! ----- RETURN ----- ! ----- SUCCESS ----- ! ----- STATUS ----- NUSER_OTHER = FALSE ! ----- (EXIT WITH ----- ! ----- ACTION_SEQ ----- ! ----- UNCHANGED ----- ! ----- SO THAT WE ----- ! ----- WILL CALL ----- ! ----- THIS SAME ----- ! ----- FUNCTION ----- ! ----- AGAIN) ----- EXIT FUNCTION END IF ! ----- UPPERCASE AND ----- ! ----- DISCARD ANY ----- ! ----- GARBAGE CHARS ----- TEMP_STRING = & EDIT$(TEMP_STRING, 38%) IF TEMP_STRING = "B" THEN ! ----- RETURN ----- ! ----- SUCCESS ----- ! ----- STATUS ----- NUSER_OTHER = FALSE ! ----- (EXIT WITH ----- ! ----- ACTION_SEQ ----- ! ----- UNCHANGED ----- ! ----- SO THAT WE ----- ! ----- WILL CALL ----- ! ----- THIS SAME ----- ! ----- FUNCTION ----- ! ----- AGAIN) ----- EXIT FUNCTION END IF TEMP_STRING = "N" IF & TEMP_STRING = "" SELECT TEMP_STRING CASE "Y" GRANT_DENY_OTHER_NODES & = TRUE CASE "N" GRANT_DENY_OTHER_NODES & = FALSE CASE ELSE PRINT PRINT "Error -" + & " Invalid" + & " response" + & TRM$( & PLEASE_TRY_AGAIN) PRINT ITERATE END SELECT VALID_ENTRY = TRUE NEXT END SELECT END IF ! ----- CONTINUE WITH DESIRED PROMPT ----- ACTION_SEQ = ACTION_SEQ + 1% CASE "GET_TEMPLATE" ! ----- GET SECURITY DATABASE TEMPLATE TO GRANT ----- ! ----- FOR THIS USER ----- PREV_TEMPLATE_DB = "@" IF NOT DBMS_EXISTS THEN IF DEBUG_MODE THEN PRINT "DEBUG>DBMS DOES NOT EXIST" END IF TEMPLATE = "" IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ELSE ACTION_SEQ = ACTION_SEQ + 1% END IF ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF ! ----- DONE IF NO DEFAULT DATABASE ----- IF DEFAULT_DB = "0" OR OTHER_PARAM1 = "N" THEN IF DEBUG_MODE THEN PRINT "DEBUG>NO DEFAULT DATABASE" END IF IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF TEMPLATE = "" ! ----- CONTINUE WITH DESIRED PROMPT ----- ACTION_SEQ = ACTION_SEQ + 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = FALSE ! ASSUME WE NEED THE TEMPLATE ! ----- TRANSLATE ANY DATABASE LOGICAL NAME ----- TEMP_STRING = DBMS_PREFIX + DEFAULT_DB IF DEBUG_MODE THEN PRINT "DEBUG>TRANSLATE " + TEMP_STRING END IF LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING, & TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM TEMPLATE = "" IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = TRUE PRINT PRINT "Error - There is no " + & TEMP_STRING + " logical name -" & + " Skipping " + & TRM$(DBMS_PRODUCT) + " access..." + BEL CASE <> SS$_NORMAL PRINT PRINT "Unexpected error while trying" + & " to translate " + TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT ! ----- ENSURE THAT THE DATABASE IDENTIFIER EXISTS ----- THE_IDENT = DBMS_PREFIX + DEFAULT_DB IF DEBUG_MODE THEN PRINT "DEBUG>SEE IF IDENT EXISTS: " + THE_IDENT END IF ! ----- SEE IF THE IDENTIFIER DOES NOT EXIST ----- IF VALIDATE_IDENTIFIER THEN TEMPLATE = "" IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = TRUE PRINT PRINT "Error - There is no " + & TRM$(THE_IDENT) + " identifier" & + " - Skipping " + & TRM$(DBMS_PRODUCT) + " access..." + BEL END IF ! ----- TRANSLATE ANY DISK_nnn LOGICAL NAME ----- TEMP_STRING = "DISK_" + DEFAULT_DB IF DEBUG_MODE THEN PRINT "DEBUG>TRANSLATE " + TEMP_STRING END IF LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING, & TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM ! IF NO LOGICAL EQUIVALENT: TEMPLATE = "" IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = TRUE PRINT PRINT "Error - There is no " + & TEMP_STRING + & " logical name - Skipping " + & TRM$(DBMS_PRODUCT) + & " access..." + BEL CASE <> SS$_NORMAL PRINT PRINT "Unexpected error while trying" + & " to translate " + TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT ! ----- TRANSLATE ANY ASK_STATUS_nnn LOGICAL NAME ----- TEMP_STRING = "ASK_STATUS_" + DEFAULT_DB IF DEBUG_MODE THEN PRINT "DEBUG>TRANSLATE " + TEMP_STRING END IF LOCAL_STATUS = LOGICAL_NAME(TEMP_STRING, & TRANSLATED_NAME) SELECT LOCAL_STATUS CASE SS$_NOLOGNAM ! IF NO LOGICAL EQUIVALENT: TEMPLATE = "" IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = TRUE PRINT PRINT "Error - There is no " + & TEMP_STRING + & " logical name - Skipping " + & TRM$(DBMS_PRODUCT) + " access..." + BEL CASE SS$_NORMAL SELECT TRANSLATED_NAME CASE "ONLINE", "BATCH" CASE ELSE TEMPLATE = "" IF BACKWARDS THEN ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS ----- ! ----- STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF VALID_ENTRY = TRUE PRINT PRINT "Warning - Skipping" + & " database " + & DEFAULT_DB + & " which is set to " + & TRANSLATED_NAME + "..." + BEL END SELECT CASE ELSE PRINT PRINT "Unexpected error while" + & " trying to translate " + & TEMP_STRING + BEL CALL LIB$STOP(LOCAL_STATUS BY VALUE) END SELECT IF NOT VALID_ENTRY THEN PRINT PRINT "This user is allowed to" + & " access the " + DIV + & " database #" + DEFAULT_DB PRINT ! ----- ENSURE THE DATABASE HAS NO ACTIVE ----- ! ----- TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK END IF WHILE NOT VALID_ENTRY ! ----- WE ARE NOT GOING BACKWARDS ----- BACKWARDS = FALSE RECORD_FOUND = TRUE PRINT " Enter the " + & TRM$(DBMS_PRODUCT) + & " Security" + & " Database Template to be" + & " used when granting this user" PRINT " access to the " + DEFAULT_DB + & " database: " PRINT " (Or type LIST to list all" + & " Security Database Templates)" WHEN ERROR IN LINPUT #98%, & " (Default of *READONLY) ==> "; & TEMPLATE USE RECORD_FOUND = FALSE CONTINUE END WHEN IF NOT RECORD_FOUND THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF ! ----- UPPERCASE AND DISCARD ANY GARBAGE ----- ! ----- CHARS ----- TEMPLATE = EDIT$(TEMPLATE, 38%) IF DEBUG_MODE THEN PRINT "DEBUG>TEMPLATE=" + & TRM$(TEMPLATE) + "*" END IF IF TEMPLATE = "B" THEN ! ----- MOVING BACK THRU PROMPTS ----- BACKWARDS = TRUE ACTION_SEQ = ACTION_SEQ - 1% ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF TEMPLATE = "*READONLY" IF TEMPLATE = "" IF DEBUG_MODE THEN PRINT "DEBUG>TEMPLATE(2)=" + & TRM$(TEMPLATE) + "*" END IF IF TEMPLATE = "LIST" THEN ! ----- DISPLAY ALL SECURITY ----- ! ----- DATABASE TEMPLATES ----- PREV_TEMPLATE_DB = "@" TEMP = NUSER_OTHER_LIST_TEMPLATES( & DEFAULT_DB) END IF IF LEFT(TEMPLATE, 1%) <> "*" OR & LEN(TRM$(TEMPLATE)) < 2% OR & LEN(TRM$(TEMPLATE)) > 12% THEN PRINT PRINT "Error - Invalid" + & " template" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END IF ! ----- VALIDATE TEMPLATE AGAINST ----- ! ----- SECURITY DATABASE TEMPLATE ----- ! ----- (RETURNS TRUE IF VALID TEMPLATE) ----- IF NOT NUSER_OTHER_VALIDATE_TEMPLATE( & DEFAULT_DB, TEMPLATE) THEN PRINT PRINT "Error - Invalid" + & " template" + & TRM$(PLEASE_TRY_AGAIN) PRINT ITERATE END IF IF DEBUG_MODE THEN PRINT "DEBUG>VALID TEMPLATE" END IF VALID_ENTRY = TRUE NEXT ! ----- DO THE ROLLBACK/UNBIND FOR THIS DATABASE ----- TEMP = NUSER_OTHER_ROLLBACK IF DEBUG_MODE THEN PRINT "DEBUG>EXIT TEMPLATE LOOP" END IF NUSER_OTHER = FALSE ! RETURN SUCCESS STATUS ! ----- CONTINUE WITH DESIRED PROMPT ----- ACTION_SEQ = ACTION_SEQ + 1% CASE "ROLLBACK" TEMP = NUSER_OTHER_ROLLBACK NUSER_OTHER = FALSE ! RETURN SUCCESS STATUS CASE "COMMIT" ! ----- COMMIT/UNBIND THE CURRENT DATABASE ----- TEMP = NUSER_OTHER_COMMIT NUSER_OTHER = FALSE ! RETURN SUCCESS STATUS CASE "VALIDATE_TEMPLATE" ! ----- RETURN "VALID/INVALID TEMPLATE" STATUS ----- PREV_TEMPLATE_DB = "@" NUSER_OTHER = NUSER_OTHER_VALIDATE_TEMPLATE( & OTHER_PARAM1, OTHER_PARAM2) CASE "LIST_TEMPLATES" ! ----- DISPLAY ALL SECURITY DATABASE TEMPLATES ----- PREV_TEMPLATE_DB = "@" TEMP = NUSER_OTHER_LIST_TEMPLATES(OTHER_PARAM1) NUSER_OTHER = FALSE ! RETURN SUCCESS STATUS CASE "ADD_DB_USER" ! ----- TRY TO ADD A USER TO THE SECURITY ----- ! ----- DATABASE (IGNORE ERROR IF USER ALREADY ----- ! ----- EXISTS) ----- IF NUSER_OTHER_ADD_USER(OTHER_PARAM1, & OTHER_PARAM1, OTHER_PARAM2) THEN ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK ELSE ! ----- COMMIT/UNBIND THE CURRENT DATABASE ----- TEMP = NUSER_OTHER_COMMIT END IF NUSER_OTHER = FALSE ! RETURN SUCCESS STATUS CASE "DELETE_DB_USER" ! ----- TRY TO REMOVE A USER FROM THE SECURITY ----- ! ----- DATABASE (IGNORE ERROR IF USER DOES NOT ----- ! ----- EXIST) ----- TEMP = NUSER_OTHER_DELETE_USER(OTHER_PARAM1) NUSER_OTHER = FALSE ! RETURN SUCCESS STATUS CASE "CHANGE_DB_USER" ! ----- TRY TO CHANGE THIS USER TO THE NEW ----- ! ----- SECURITY DATABASE TEMPLATE (IGNORE ERROR ----- ! ----- IF USER ALREADY EXISTS OR TEMPLATE DOES ----- ! ----- NOT EXIST) ----- ! ----- SEE IF TEMPLATE DATABASE DIFFERENT THAN ----- ! ----- THE DATABASE THAT WE'RE UPDATING ----- IF LEFT(OTHER_PARAM2, 3%) <> OTHER_PARAM1 THEN ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK END IF ! ----- READY DATABASE FOR UPDATE ----- TEMP = READY_PROCESSING("CHANGE_DB_USER:", & OTHER_PARAM1, TRUE) ! ----- GET THE USER'S DATABASE RECORD ----- SY_USRNAME = ENTERED_USERNAME IF DEBUG_MODE THEN PRINT "DEBUG>Fetch SY_USRREC" END IF # FETCH FIRST SY_USRREC WITHIN SY_USRHSHSET USING - SY_USRNAME (TRAP END, ERROR) IF DEBUG_MODE THEN PRINT "DEBUG>DBM_COND after FETCH" + & " SY_USRREC="; DBM_COND PRINT "DEBUG>DML$VALUE after FETCH" + & " SY_USRREC="; DML$VALUE PRINT "DEBUG>DML$K_ERROR="; DML$K_ERROR PRINT "DEBUG>DBM$_END="; DBM$_END END IF IF (LIB$MATCH_COND(DBM_COND, DBM$_END)) THEN ! ----- IGNORE END-OF-COLLECTION ERROR ----- IF DEBUG_MODE THEN PRINT "DEBUG>User " + & TRM$(ENTERED_USERNAME) & + " did not have" + & " access to this database" END IF ELSE IF DML$VALUE = DML$K_ERROR THEN PRINT "Unexpected error from" + & " FETCH FIRST" + & " SY_USRREC" + & " (CHANGE_DB_USER)" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END IF ! ----- ERASE CURRENT RECORD AND ALL SETS ----- ! ----- OWNED BY IT ----- IF DEBUG_MODE THEN PRINT "DEBUG>Erase All" END IF # ERASE ALL SY_USRREC (TRAP END, ERROR) IF DEBUG_MODE THEN PRINT "DEBUG>DBM_COND after" + & " ERASE SY_USRREC="; DBM_COND PRINT "DEBUG>DML$VALUE after" + & " ERASE SY_USRREC="; DML$VALUE END IF SELECT DML$VALUE CASE DML$K_END ! END-OF-COLLECTION: PRINT "Unexpected" + & " End-of-collection" + & " error occurred" + BEL ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK NUSER_OTHER = FALSE EXIT FUNCTION CASE DML$K_ERROR! UNEXPECTED ERROR: PRINT "Unexpected error from" + & " ERASE ALL SY_USRREC" & + " (CHANGE_DB_USER)" + BEL ! ----- DISPLAY ERROR AND ABORT ----- CALL DBM$SIGNAL END SELECT END IF ! ----- EXTRACT TEMPLATE DATABASE NUMBER ----- TEMP_STRING = LEFT(OTHER_PARAM2, 3%) IF NOT NUMERIC(TEMP_STRING) THEN PRINT PRINT "Error - Invalid Database" + & " Number: " + TEMP_STRING PRINT " User access was" + & " deleted but not added -" + & " Fix and Retry operation" + BEL PRINT ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE END IF ! ----- SEE IF TEMPLATE DATABASE DIFFERENT THAN ----- ! ----- THE DATABASE THAT WE'RE UPDATING ----- IF TEMP_STRING <> OTHER_PARAM1 THEN ! ----- COMMIT/UNBIND THE CURRENT DATABASE ----- TEMP = NUSER_OTHER_COMMIT END IF ! ----- EXTRACT TEMPLATE NAME ----- TEMP_STRING2 = RIGHT(OTHER_PARAM2, 4%) ! ----- ADD THIS USER TO THE SECURITY DATABASE ----- IF NUSER_OTHER_ADD_USER(OTHER_PARAM1, & TEMP_STRING, TEMP_STRING2) THEN ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK ELSE ! ----- COMMIT/UNBIND THE CURRENT DATABASE ----- TEMP = NUSER_OTHER_COMMIT END IF NUSER_OTHER = FALSE ! RETURN SUCCESS STATUS CASE "CHANGE_SYSDB" ! ----- CHANGE THE USERNAME IN EACH OF THE SYSDB ----- ! ----- DATABASES THAT THIS USER HAS ACCESS TO ----- IF DEBUG_MODE THEN PRINT PRINT "DEBUG>PERFORM SYSDB MODIFICATIONS" PRINT END IF ! ----- ACCUMULATE ALL DIFFERENT HELD IDENTIFIERS ----- ! ----- FOR THIS USERNAME, FOR EACH OPEN SYSUAF ----- ! ----- FILE: ----- I_O_CHNL_SYSUAF = 0% HELD_IDENTS_CTR = 0% ! ASSUME NO HELD IDENTIFIERS WHILE I_O_CHNL_SYSUAF < SYSUAF_COUNTER I_O_CHNL_SYSUAF = I_O_CHNL_SYSUAF + 1% IF DEBUG_MODE THEN PRINT "DEBUG>---Process" + & " SYSUAF file #" + & NUM1$(I_O_CHNL_SYSUAF) + "---" END IF ! ----- SKIP IF SYSUAF UNAVAILABLE ----- ITERATE IF TRM$(SYSUAF_SPECS( & I_O_CHNL_SYSUAF)) = "" ! ----- STORE USERNAME TO SEARCH FOR ----- USER_NAME = OTHER_PARAM2 ! ----- LOCATE DIVISION THIS USER IS IN ----- ! ----- AND EXTRACT IDENTIFIERS HELD BY ----- ! ----- THIS USER ----- CALL FIND_IDENTIFIER(I_O_CHNL_SYSUAF) ! ----- FIND_IDENTIFIER returns: ----- ! ----- DIV = Extracted 3-char Division Code ! ----- (Blank if none or error) ! ----- DIVISION_ACCESS = Extracted Divisional ! ----- Access letter (Blank ! ----- if none or error) ! ----- HELD_IDENTS() = List of held values ! ----- HELD_IDENTS_CTR = Count of held idents ! ----- HELD_IDENTS_STR() = List of held ! ----- identifier strings NEXT ! ----- FOR EACH DATABASE THAT THIS USER HAS ----- ! ----- ACCESS TO: ----- HELD_IDENT_INDEX = 0% WHILE HELD_IDENT_INDEX < HELD_IDENTS_CTR HELD_IDENT_INDEX = HELD_IDENT_INDEX + 1% HELD_IDENT = & TRM$(HELD_IDENTS_STR(HELD_IDENT_INDEX)) ! ----- SKIP IF NOT A DATABASE IDENTIFIER ----- ITERATE IF LEN(HELD_IDENT) <> 6% ITERATE IF LEFT(HELD_IDENT, 3%) <> DBMS_PREFIX ! ----- EXTRACT DATABASE NUMBER ----- THE_DB = RIGHT(HELD_IDENT, 4%) ! ----- SKIP IF "ASK_STATUS_nnn" IS NOT ----- ! ----- ONLINE NOR BATCH ----- ITERATE IF BAD_ASK_STATUS_VALUE(THE_DB) ! ----- COPY THE OLD USERNAME'S ACCESS TO ----- ! ----- THE NEW USERNAME ----- ENTERED_USERNAME = OTHER_PARAM2 IF DEBUG_MODE THEN PRINT "DEBUG>Adding user" + & " access for " + & OTHER_PARAM2 + & " to the " + THE_DB + & " database..." END IF ! ----- ADD THIS USER TO THE SECURITY ----- ! ----- DATABASE (USING THE OLD USERNAME ----- ! ----- AS THE TEMPLATE) ----- IF NUSER_OTHER_ADD_USER(THE_DB, THE_DB, & OTHER_PARAM1) THEN ! ----- ENSURE THE DATABASE HAS NO ----- ! ----- ACTIVE TRANSACTION ----- TEMP = NUSER_OTHER_ROLLBACK ! ----- RETURN SUCCESS STATUS ----- NUSER_OTHER = FALSE EXIT FUNCTION END IF ! ----- DELETE THE OLD USERNAME FROM THE ----- ! ----- DATABASE ----- ENTERED_USERNAME = OTHER_PARAM1 IF DEBUG_MODE THEN PRINT "DEBUG>Removing user" + & " access for " + & OTHER_PARAM1 + & " from the " + & THE_DB + " database..." END IF ! ----- TRY TO REMOVE THIS USER FROM THE ----- ! ----- SECURITY DATABASE (IGNORE ----- ! ----- ERROR IF USER DOES NOT EXIST) ----- TEMP = NUSER_OTHER_DELETE_USER(THE_DB) NEXT NUSER_OTHER = FALSE ! RETURN SUCCESS STATUS CASE ELSE PRINT "Error - Invalid option passed to" + & " NUSER_OTHER: " + OTHER_ACTION + BEL ! ----- EXIT WITH ERROR STATUS ----- CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE) END SELECT END FUNCTION