10 FUNCTION LONG EXT_SCRIPT_INTERP(STRING SCRIPT_NAME, & SCRIPT_TYPE, LONG SCR_FILE) !====================================================================== !PROGRAM---------------------VERSION-------------------LANGUAGE-------- !EXT_SCRIPT_INTERP 8 BASIC ! !DESCRIPTION----------------------------------------------------------- !Script interpreter for EXTERNAL facility !Runs the script specified by the file SCRIPT_NAME. SCR_FILE is !channel number to use for script file. SCRIPT_TYPE indicates the type !of script being run (facility/connect/disconnect) !This routine is recursive, since the DIAL command in a script will !run a connect script. ! !====================================================================== %TITLE "Script Interpreter" %IDENT "EXT_SCRIPT_INTERP 92.11.02" %SBTTL "DOCUMENTATION SECTION" !********************************************************************** ! OPTIONS !********************************************************************** OPTION TYPE = EXPLICIT ! Explicit declarations only 100 !********************************************************************** ! DOCUMENTATION SECTION !********************************************************************** ! !====================================================================== ! MODIFICATION HISTORY !====================================================================== !VERSION--------AUTHOR------------------DATE------------APPROVAL------- ! 1 Keith Walker 88.01.25 1723 ! 2 Keith Walker 88.03.31 M102-0-23 ! 3 Keith Walker 88.10.07 1741 ! 4 Keith Walker 89.03.23 M102-0-41 ! 5 Keith Walker 89.06.09 M102_0_49 ! 6 Grant Moffat 89.06.26 M102_0_56 ! 7 John Post 91.10.24 E102ISD_0_25 ! 8 Keith Walker 92.11.02 E102ISD_0_30 ! !====================================================================== ! COMPILE/LINK INSTRUCTIONS !====================================================================== !$BASIC EXT_SCRIPT_INTERP !$LINK 102900,- ! EXT_READ_PORT_AST, EXT_UNSOL_MBX_AST,- ! EXT_PROC_BUF_AST, EXT_WRITE_TERM_AST,- ! EXT_SCRIPT_INTERP, EXT_SCREEN_HDR,- ! EXT_MENU, EXT_CONNECT_LOOP, EXT_PARSE,- ! CHKRGHTS, EXT_FT_MENU, XMODEM !====================================================================== !********************************************************************** ! FILES ACCESSED !********************************************************************** ! NAME MODE CHANNEL DESCRIPTION !-------------- ------ ------- ------------------------------- ! !********************************************************************** %PAGE %SBTTL "DECLARATION SECTION" 200 !====================================================================== ! DECLARATION SECTION !====================================================================== !********************************************************************** ! %INCLUDE FILE DECLARATIONS !********************************************************************** %INCLUDE "EXT_COMMON.BAS" !********************************************************************** ! CONSTANTS !********************************************************************** DECLARE WORD CONSTANT & N_PARAMS = 15, !max number of parameters allowed & L_SCRIPT = 100, !max length of user script & N_FLAGS = 9 !number of condition flags !********************************************************************** ! RECORDS !********************************************************************** !********************************************************************** ! MAPS !********************************************************************** !********************************************************************** ! COMMONS !********************************************************************** COMMON (DIAL_COM) & STRING DIAL_NUM = 80 !number to be dialled !********************************************************************** ! VARIABLES !********************************************************************** DECLARE WORD & END_OF_FILE, !TRUE if end of file reached & NUM_LABELS, !number of labels in user script & NUM_PARAMS, !number of parameters in current command & NUM_SCRIPT_LINES, !length of user script & SAVE_SCRIPT_LINE, ! & BUF_CHAR, ! & SAVE_LOG_FLAG, !saved log flag & SAVE_VIEW_FLAG, !saved view flag & SEND_PAUSE, !1Oths of sec. to pause between char & BREAK_STATUS(3), & MATCH_FLAG !Flag a match in user input DECLARE LONG & BAUD_RATE, !baud rate for port & ERR_CHAN, !channel for error file & FUNC_STATUS, !function return status & GI_COUNT, ! & GI_INTERVAL, ! & GI_PAR_OMITTED, ! & GI_STRING_COUNT,! & I, !miscellaneous loop control etc & J, !miscellaneous loop control etc & JUNK, !accepts function returns & PARITY_FLAGS, !flag bits to set parity & SCRIPT_PTR, ! & TERM_WRITE_CODE, ! & BREAK_COND DECLARE QUAD & BINARY_TIME DECLARE STRING & ABORT_TEXT, !text of abort message & BUF_FER, ! & CHAR_VAL, ! & DELTA_TIME, ! & ERROR_DIR, !directory for error file, & ERROR_EXT, !extension for error file & SAVE_QUOTE, ! & SCRIPT_BUF, !buffer for script text & SCRIPT_DIR, !directory for script file, & SCRIPT_EXT, !extension for script file & SNOOZE_SECS, ! & START_TIME ! !********************************************************************** ! ARRAYS !********************************************************************** DIMENSION STRING & LABEL_NAME(L_SCRIPT), !names of labels in user script & SCR_PARAM(N_PARAMS), !parameters of current command & SCR_SEP(N_PARAMS), !parameter terminators & SCRIPT(L_SCRIPT) !holds user script DIMENSION WORD & COND_FLAG(N_FLAGS), !condition flags (0 is timeout) & LABELS(L_SCRIPT), !array index for user script labels & PORT_OUT_IOSB(3), ! & SCR_PTR(N_PARAMS) !starting position of each parameter !********************************************************************** ! FUNCTIONS !********************************************************************** DECLARE WORD FUNCTION & ERRORS, !prints error message & SNOOZE !sleep mode for process DECLARE STRING FUNCTION & GET_STRING, !strips quotes from string, inserts CR & NOW !********************************************************************** ! EXTERNAL CONSTANTS !********************************************************************** EXTERNAL LONG CONSTANT & IO$_SENSEMODE, & IO$_SETMODE, & IO$_WRITEVBLK, & IO$M_BREAKTHRU, & IO$M_NOFORMAT, & RMS$_FNF, & SS$_ABORT, & SS$_NORMAL, & TT$C_BAUD_110, & TT$C_BAUD_300, & TT$C_BAUD_1200, & TT$C_BAUD_2400, & TT$C_BAUD_4800, & TT$C_BAUD_9600, & TT$C_BAUD_19200, & TT$M_ALTDISPAR, & TT$M_ALTFRAME, & TT$M_ALTRPAR, & TT$M_BREAK, & TT$M_DISPARERR, & TT$M_DS_DTR, & TT$M_EIGHTBIT, & TT$M_HOSTSYNC, & TT$M_MECHTAB, & TT$M_MODEM, & TT$M_NOBRDCST, & TT$M_NOTYPEAHD, & TT$M_ODD, & TT$M_PARITY, & TT$M_TTSYNC, & TT2$M_PASTHRU !********************************************************************** ! EXTERNAL FUNCTIONS !********************************************************************** EXTERNAL LONG FUNCTION & EXT_SCRIPT_INTERP, !this is us, for recursive call & SYS$BINTIM, & SYS$DALLOC, & SYS$DASSGN, & SYS$HIBER, & SYS$NUMTIM, & SYS$QIOW, & SYS$SCHDWK, & SYS$SETAST !********************************************************************** ! EXTERNAL SUBPROGRAMS !********************************************************************** EXTERNAL SUB & LIB$GET_SYMBOL, & LIB$SET_SYMBOL, & LIB$SYS_TRNLOG, & SYS$CANCEL, & EXT_CONNECT_LOOP, & EXT_SCREEN_HDR %PAGE %SBTTL "INITIALIZATION SECTION" 300 !====================================================================== ! INITIALIZATION SECTION !====================================================================== ON ERROR GOTO ERROR_HANDLING FUNC_STATUS = CTRLC !********************************************************************** ! PRINT USING FORMATS !********************************************************************** !********************************************************************** ! VARIABLES !********************************************************************** FUNC_STATUS = SS$_NORMAL ERR_CHAN = SCR_FILE + 1% !channel for error file FOR I = 1 TO L_SCRIPT LABELS(I) = 0 SCRIPT(I) = "" NEXT I NUM_LABELS = 0 NUM_SCRIPT_LINES = 0 CALL LIB$SYS_TRNLOG("LP_ERROR_DIR", , ERROR_DIR) CALL LIB$SYS_TRNLOG("LP_ERROR_EXT", , ERROR_EXT) CALL LIB$SYS_TRNLOG("LP_SCRIPT_DIR", , SCRIPT_DIR) CALL LIB$SYS_TRNLOG("LP_SCRIPT_EXT", , SCRIPT_EXT) IF SCRIPT_TYPE = "C" OR SCRIPT_TYPE = "D" THEN SCRIPT_EXT = "." + SCRIPT_TYPE + SEG$(SCRIPT_EXT, 2, LEN(SCRIPT_EXT)) END IF TERM_WRITE_CODE = IO$_WRITEVBLK OR IO$M_BREAKTHRU OR IO$M_NOFORMAT %PAGE %SBTTL "MAIN LOGIC SECTION" 1000 !====================================================================== ! MAIN LOGIC SECTION !====================================================================== !open the script file... WHEN ERROR IN OPEN SCRIPT_DIR + SCRIPT_NAME + SCRIPT_EXT FOR INPUT & AS FILE #SCR_FILE, & ACCESS READ, ALLOW MODIFY USE ABORT_TEXT = "Unable to find " + & SCRIPT_DIR + SCRIPT_NAME + SCRIPT_EXT CALL LIB$SET_SYMBOL("ABORT_TEXT", ABORT_TEXT, 1%) FUNC_STATUS = RMS$_FNF CONTINUE END_OF_PROGRAM END WHEN !read the script... GOSUB READ_SCRIPT !run the script... SCRIPT_PTR = 1 WHILE SCRIPT_PTR <= NUM_SCRIPT_LINES SCRIPT_BUF = SCRIPT(SCRIPT_PTR) IF POS(DEBUG_FLAG, "3", 1) > 0 THEN PRINT " Interpreting line "; SCRIPT_TYPE; SCRIPT_PTR; & ", text:" PRINT " "; SCRIPT_BUF END IF GOSUB PARSE_SCRIPT SCRIPT_PTR = SCRIPT_PTR + 1 GOSUB PROCESS_COMMAND NEXT !exit... FUNC_STATUS = SS$_NORMAL GOTO END_OF_PROGRAM %PAGE %SBTTL "SUBROUTINE DEFINITION SECTION" 15000 !====================================================================== ! SUBROUTINE DEFINITION SECTION !====================================================================== GO_ONLINE: !********************************************************************** !connects the user's terminal !********************************************************************** !prepare for online session... START_TIME = NOW TIME_ON = CUR_TIME CALL LIB$SET_SYMBOL("START_TIME", START_TIME, 1%) JUNK = RCTRLC CALL EXT_SCREEN_HDR("Connected to " + TRM$(FACILITY_NAME), & "Enter to exit") PRINT PRINT SAVE_LOG_FLAG = LOG_FLAG !remember the log flag LOG_FLAG = TRUE !log the session SAVE_VIEW_FLAG = VIEW_FLAG !remember the view flag VIEW_FLAG = TRUE !let the user see the session !set the terminal to passthru.. TERM_MODE(0) = OLD_TERM_MODE(0) TERM_MODE(1) = OLD_TERM_MODE(1) TERM_MODE(2) = OLD_TERM_MODE(2) OR TT2$M_PASTHRU JUNK = SYS$QIOW(!efn!, TERM_CHAN BY VALUE, & IO$_SETMODE BY VALUE, & ,,, & TERM_MODE(0) BY REF, & 12% BY VALUE,,,,) !now loop to copy stuff from terminal to port... CALL EXT_CONNECT_LOOP !finish off the log file... IF LOG_PTR > 0% THEN PUT #LOG_FILE, COUNT LOG_PTR LOG_PTR = 0 END IF LOG_FLAG = SAVE_LOG_FLAG VIEW_FLAG = SAVE_VIEW_FLAG RETURN GET_LINE: !************************************************** !read line from script !************************************************** WHEN ERROR IN LINPUT #SCR_FILE, SCRIPT_BUF USE END_OF_FILE = TRUE END WHEN RETURN PARSE_SCRIPT: !************************************************** !assume SCRIPT_BUF holds a line !parse line into SCR_PARAM, SCR_SEP, SCR_PTR !set NUM_PARAMS !************************************************** SCRIPT_BUF = EDIT$(SCRIPT_BUF, 408%) + " " !remove excess spaces !parse line: J = 0 FOR I = 0 TO N_PARAMS SCR_SEP(I) = "" SCR_PTR(I) = LEN(SCRIPT_BUF) + 1 SCR_PARAM(I) = "" NEXT I SCR_PTR(0) = 1 FOR I = 1 TO LEN(SCRIPT_BUF) SELECT SEG$(SCRIPT_BUF, I, I) CASE = "!" SCR_PARAM(J) = SEG$(SCRIPT_BUF, SCR_PTR(J), I) I = LEN(SCRIPT_BUF) SCR_SEP(J) = " " J = J + 1 SCR_PTR(J) = I + 1 CASE = " ", "," SCR_SEP(J) = SEG$(SCRIPT_BUF, I, I) SCR_PARAM(J) = SEG$(SCRIPT_BUF, SCR_PTR(J), I - 1) J = J + 1 I = I + 1 IF SEG$(SCRIPT_BUF, I + 1, I + 1) = " " SCR_PTR(J) = I + 1 CASE = '"', "'" SAVE_QUOTE = SEG$(SCRIPT_BUF, I, I) I = I + 1 WHILE SEG$(SCRIPT_BUF, I, I) <> SAVE_QUOTE AND & I < LEN(SCRIPT_BUF) - 1 I = I + 1 NEXT END SELECT GOTO PARSE_ENOUGH IF J > N_PARAMS NEXT I PARSE_ENOUGH: NUM_PARAMS = J - 1 SCR_PARAM(0) = EDIT$(SCR_PARAM(0), 32) !uppercase command IF POS(DEBUG_FLAG, "1", 1) > 0 THEN PRINT PRINT " "; SCRIPT_BUF PRINT "123456789 "; FOR I = 1 TO 8 PRINT FOR I = 0 TO NUM_PARAMS PRINT I, SCR_PTR(I), SCR_PARAM(I), ">"; SCR_SEP(I); "<" NEXT I END IF RETURN PROCESS_COMMAND: !************************************************** !assume SCR_PARAM, SCR_SEP, SCR_PTR hold command !processes the command !************************************************** SELECT SCR_PARAM(0) CASE = 'LABEL', '!', '' !ignore it CASE = 'BREAK' IF NUM_PARAMS < 1 THEN ! If no time parameter entered for break time, ! break time default set for 2 seconds I = 20 ELSE WHEN ERROR IN I = VAL%(SCR_PARAM(1)) !get 10ths of second USE JUNK = ERRORS("Invalid parameter value - command ignored") FUNC_STATUS = SS$_ABORT CONTINUE FORCE_ABORT !force an abort END WHEN END IF JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, & IO$_SENSEMODE BY VALUE, & BREAK_STATUS(0),,, & PORT_MODE(0) BY REF, & 12% BY VALUE,,,,) ! Determine the terminal status BREAK_COND = BREAK_STATUS(3) * 16% BREAK_COND = BREAK_COND OR TT$M_BREAK AND (NOT(TT$M_ALTFRAME)) JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, & IO$_SETMODE BY VALUE, & BREAK_STATUS(0),,, & PORT_MODE(0) BY REF, & 12% BY VALUE,,,BREAK_COND BY VALUE,) ! Turn on break JUNK = SNOOZE(I) ! Duration of break BREAK_COND = BREAK_COND AND (NOT(TT$M_BREAK)) JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, & IO$_SETMODE BY VALUE, & BREAK_STATUS(0),,, & PORT_MODE(0) BY REF, & 12% BY VALUE,,,BREAK_COND BY VALUE,) ! Turn off break CASE = 'SET' !SET option - process it IF NUM_PARAMS < 1 THEN JUNK = ERRORS("Not enough parameters - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort ELSE SCR_PARAM(1) = EDIT$(SCR_PARAM(1), 32) !upper case SELECT SCR_PARAM(1) CASE = "PAUSE" IF NUM_PARAMS < 2 THEN JUNK = ERRORS("Not enough parameters - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort ELSE WHEN ERROR IN SEND_PAUSE = VAL%(SCR_PARAM(2)) !get 10ths of second USE JUNK = ERRORS("Invalid parameter value - command ignored") FUNC_STATUS = SS$_ABORT CONTINUE FORCE_ABORT !force an abort END WHEN END IF CASE = "CENSOR" CENSOR_FLAG = TRUE CASE = "NOCENSOR" CENSOR_FLAG = FALSE CASE = "LOG" LOG_FLAG = TRUE CASE = "NOLOG" IF LOG_PTR > 0% THEN PUT #LOG_FILE, COUNT LOG_PTR LOG_PTR = 0 END IF LOG_FLAG = FALSE CASE = "VIEW" VIEW_FLAG = TRUE CASE = "NOVIEW" VIEW_FLAG = FALSE CASE = "ECHO" ECHO_FLAG = TRUE CASE = "NOECHO" ECHO_FLAG = FALSE CASE = "DATABITS" IF NUM_PARAMS < 2 THEN JUNK = ERRORS("Not enough parameters - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort ELSE PARITY_FLAGS = TT$M_ALTDISPAR OR TT$M_DISPARERR SELECT SCR_PARAM(2) CASE = "7", "SEVEN" SEVENBIT_FLAG = TRUE PARITY_SELECT = 2 !default to even parity PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTFRAME OR 7% CASE = "8", "EIGHT" SEVENBIT_FLAG = FALSE PARITY_SELECT = 0 !no parity PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTFRAME OR 8% CASE ELSE JUNK = ERRORS("Invalid databits - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort END SELECT IF NUM_PARAMS >= 3 THEN SELECT SCR_PARAM(3) CASE = "NONE", "NOPARITY" PARITY_SELECT = 0 !none PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR CASE = "ODD" PARITY_SELECT = 1 !odd PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR OR & TT$M_PARITY OR TT$M_ODD CASE = "EVEN" PARITY_SELECT = 2 !even PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR OR & TT$M_PARITY CASE = "MARK" PARITY_SELECT = 3 !mark PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR OR & TT$M_PARITY OR TT$M_ODD CASE = "SPACE" PARITY_SELECT = 4 !space PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR OR & TT$M_PARITY CASE ELSE JUNK = ERRORS("Invalid parity - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort END SELECT END IF JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, & IO$_SETMODE BY VALUE, & ,,, & PORT_MODE(0) BY REF, & 12% BY VALUE,,, & PARITY_FLAGS BY VALUE,) END IF CASE = "SPEED" IF NUM_PARAMS < 2 THEN JUNK = ERRORS("Not enough parameters - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort ELSE SELECT SCR_PARAM(2) CASE = "110" BAUD_RATE = TT$C_BAUD_110 CASE = "300" BAUD_RATE = TT$C_BAUD_300 CASE = "1200" BAUD_RATE = TT$C_BAUD_1200 CASE = "2400" BAUD_RATE = TT$C_BAUD_2400 CASE = "4800" BAUD_RATE = TT$C_BAUD_4800 CASE = "9600" BAUD_RATE = TT$C_BAUD_9600 CASE = "19200" BAUD_RATE = TT$C_BAUD_19200 CASE ELSE JUNK = ERRORS("Invalid speed - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort END SELECT JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, & IO$_SETMODE BY VALUE, & ,,, & PORT_MODE(0) BY REF, & 12% BY VALUE, & BAUD_RATE BY VALUE,,,) END IF END SELECT END IF CASE = 'GOTO' IF NUM_PARAMS < 1 THEN JUNK = ERRORS("Not enough parameters - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort ELSE FOR I = 1 TO NUM_LABELS IF LABEL_NAME(I) = EDIT$(SCR_PARAM(1), 32) THEN SCRIPT_PTR = LABELS(I) GOTO GOTO_LABEL END IF NEXT I JUNK = ERRORS("Label not found - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort GOTO_LABEL: END IF CASE = 'SEND' IF NUM_PARAMS < 1 THEN JUNK = ERRORS("Not enough parameters - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort ELSE FOR J = 1 TO NUM_PARAMS FOR I = 1 TO LEN(SCR_PARAM(J)) GOTO SEND_STRING IF SEG$(SCR_PARAM(J), I, I) < '0' OR & SEG$(SCR_PARAM(J), I, I) > '9' NEXT I WHEN ERROR IN SCR_PARAM(J) = CHR$(VAL%(SCR_PARAM(J))) USE JUNK = ERRORS("Invalid parameter value - command ignored") FUNC_STATUS = SS$_ABORT CONTINUE FORCE_ABORT !force an abort END WHEN GOTO SEND_ANY SEND_STRING: IF SCR_PARAM(J) = '#' THEN !send number saved by DIAL command: SCR_PARAM(J) = EDIT$(DIAL_NUM, 128) ELSE SCR_PARAM(J) = GET_STRING(SCR_PARAM(J), FALSE) END IF SEND_ANY: JUNK = SYS$SETAST(0% BY VALUE) !no interruptions IF LOG_PTR > 0% THEN PUT #LOG_FILE, COUNT LOG_PTR LOG_PTR = 0 END IF LOG_BUF_S = "" !clear buffer JUNK = SYS$SETAST(1% BY VALUE) !interruptions OK !copy output to port: IF SEND_PAUSE > 0 THEN FOR I = 1 TO LEN(SCR_PARAM(J)) BUF_FER = SEG$(SCR_PARAM(J), I, I) JUNK = SYS$QIOW(, PORT_CHAN BY VALUE, & TERM_WRITE_CODE BY VALUE, & PORT_OUT_IOSB() BY REF,,, & BUF_FER BY REF, & 1% BY VALUE,,,,) JUNK = SNOOZE(SEND_PAUSE) NEXT I ELSE BUF_FER = SCR_PARAM(J) FOR I = 1 TO LEN(BUF_FER) CHAR_VAL = MID$(BUF_FER,I,1) BUF_CHAR = ASCII(CHAR_VAL) IF SEVENBIT_FLAG AND (SERVED_PORT = "Y") THEN SELECT PARITY_SELECT CASE =1 ! Odd parity BUF_CHAR = ODD_PARITY(BUF_CHAR AND 127%) CASE =2 ! Even parity BUF_CHAR = EVEN_PARITY(BUF_CHAR AND 127%) CASE =3 ! Mark parity BUF_CHAR = BUF_CHAR OR 128% CASE =4 ! Space parity BUF_CHAR = BUF_CHAR AND 127% END SELECT END IF JUNK = SYS$QIOW(, PORT_CHAN BY VALUE, & TERM_WRITE_CODE BY VALUE, & PORT_OUT_IOSB() BY REF,,, & BUF_CHAR BY REF, & 1% BY VALUE,,,,) NEXT I END IF NEXT J END IF CASE = 'TYPE' IF NUM_PARAMS < 1 THEN JUNK = ERRORS("Not enough parameters - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort ELSE SCR_PARAM(1) = GET_STRING(SCR_PARAM(1), TRUE) !type it: PRINT SCR_PARAM(1); SLEEP 1 END IF CASE = 'INPUT' GOSUB GET_INPUT !read input from port & set flags CASE = 'UINPUT' GOSUB GET_USER_INPUT !Get input from user & set flags CASE = 'IF', 'IFNOT' GOSUB IF_IFNOT !process conditional CASE = 'DIAL' IF NUM_PARAMS < 1 THEN JUNK = ERRORS("Not enough parameters - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort ELSE SCR_PARAM(1) = GET_STRING(SCR_PARAM(1), FALSE) DIAL_NUM = SCR_PARAM(1) GOSUB PROCESS_DIAL !contains re-entrant call END IF CASE = 'CONNECT' GOSUB GO_ONLINE !connect the user CASE = 'ABORT' GOSUB DUMP_ERROR !dump the buffer contents ABORT_TEXT = GET_STRING(SCR_PARAM(1), FALSE) CALL LIB$SET_SYMBOL("ABORT_TEXT", EDIT$(ABORT_TEXT, 4%), 1%) FUNC_STATUS = SS$_ABORT GOTO END_OF_PROGRAM CASE = 'WAIT' IF NUM_PARAMS < 1 THEN JUNK = ERRORS("Not enough parameters - command ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort ELSE WHEN ERROR IN I = VAL%(SCR_PARAM(1)) !get 10ths of second USE JUNK = ERRORS("Invalid parameter value - command ignored") FUNC_STATUS = SS$_ABORT CONTINUE FORCE_ABORT !force an abort END WHEN JUNK = SNOOZE(I) !sleep specified time END IF CASE ELSE !nothing else allowed - ignore it JUNK = ERRORS("Illegal command - ignored") FUNC_STATUS = SS$_ABORT GOTO FORCE_ABORT !force an abort END SELECT GOTO IGNORE_CMD FORCE_ABORT: SCR_PARAM(0) = "ABORT" SCR_PARAM(1) = "Script syntax error" NUM_PARAMS = 1% GOSUB PROCESS_COMMAND !re-entrant call IGNORE_CMD: RETURN GET_INPUT: !************************************************** !get input from port !applies min & max times !sets condition flags !************************************************** !find interval & count GI_INTERVAL = -1 GI_COUNT = -1 GI_PAR_OMITTED = 0 GI_INTERVAL = VAL%(SCR_PARAM(1)) !see if max or min specified GI_COUNT = VAL%(SCR_PARAM(2)) IF GI_INTERVAL = -1 OR SCR_PARAM(1) = '' THEN !no interval spec: default 1 SECOND GI_PAR_OMITTED = GI_PAR_OMITTED + 1 GI_INTERVAL = 1 END IF IF GI_COUNT = -1 OR SCR_PARAM(2) = '' THEN !no count spec: default ONCE GI_PAR_OMITTED = GI_PAR_OMITTED + 1 GI_COUNT = 1 END IF GI_STRING_COUNT = NUM_PARAMS - 2 + GI_PAR_OMITTED !ignore excess parameters: GI_STRING_COUNT = N_FLAGS IF GI_STRING_COUNT > N_FLAGS FOR J = 3 - GI_PAR_OMITTED TO GI_STRING_COUNT + 2 - GI_PAR_OMITTED SCR_PARAM(J) = GET_STRING(SCR_PARAM(J), TRUE) NEXT J IF POS(DEBUG_FLAG, "4", 1) > 0 THEN PRINT " GET_INPUT debugging:" PRINT " "; GI_INTERVAL, GI_COUNT PRINT " "; FOR I = 1 TO GI_STRING_COUNT PRINT SCR_PARAM(I + 2 - GI_PAR_OMITTED); " "; NEXT I PRINT " parameters omitted: "; GI_PAR_OMITTED END IF !now have all parameters, so do the command: COND_FLAG(I) = FALSE FOR I = 0 TO N_FLAGS !clear flags I = 0 WHILE I < GI_COUNT SLEEP GI_INTERVAL !wait specified time I = I + 1 FOR J = 3 - GI_PAR_OMITTED TO GI_STRING_COUNT + 2 - GI_PAR_OMITTED IF POS(LOG_BUF_S, SCR_PARAM(J), 1) > 0 THEN !found a match on the Jth string COND_FLAG(J - 2 + GI_PAR_OMITTED) = TRUE JUNK = SYS$SETAST(0% BY VALUE) !no interruptions IF LOG_PTR > 0% THEN PUT #LOG_FILE, COUNT LOG_PTR LOG_PTR = 0 END IF LOG_BUF_S = "" !clear buffer JUNK = SYS$SETAST(1% BY VALUE) !interruptions OK GOTO GET_INPUT_EXIT !stop checking ELSE IF POS(DEBUG_FLAG, "4", 1) > 0 THEN PRINT " No match on string:" PRINT SCR_PARAM(J) !****************************************************************************** !This section commented out because it consumes large amounts of elapsed time, !and may interfere with script timing. It may be useful in debugging the INPUT !command. !****************************************************************************** ! PRINT LOG_PTR ! FOR JUNK = 0 TO 159 ! PRINT USING "### "; LOG_BUF(JUNK); ! PRINT IF MOD(JUNK, 20%) = 19% ! NEXT JUNK ! PRINT !****************************************************************************** END IF END IF NEXT J NEXT !drop through loop means no match; i.e. timeout COND_FLAG(0) = TRUE GET_INPUT_EXIT: IF POS(DEBUG_FLAG, "5", 1) > 0 THEN PRINT " INPUT Condition flags: "; FOR I = 0 TO N_FLAGS IF COND_FLAG(I) = TRUE THEN PRINT "T"; ELSE PRINT "F"; END IF NEXT I PRINT END IF RETURN GET_USER_INPUT: !************************************************** !get input from user !applies min & max times !sets condition flags !************************************************** !find interval & count GI_INTERVAL = -1 GI_COUNT = -1 GI_PAR_OMITTED = 0 GI_INTERVAL = VAL%(SCR_PARAM(1)) !see if max or min specified GI_COUNT = VAL%(SCR_PARAM(2)) IF GI_INTERVAL = -1 OR SCR_PARAM(1) = '' THEN !no interval spec: default 1 SECOND GI_PAR_OMITTED = GI_PAR_OMITTED + 1 GI_INTERVAL = 1 END IF IF GI_COUNT = -1 OR SCR_PARAM(2) = '' THEN !no count spec: default ONCE GI_PAR_OMITTED = GI_PAR_OMITTED + 1 GI_COUNT = 1 END IF GI_STRING_COUNT = NUM_PARAMS - 2 + GI_PAR_OMITTED !ignore excess parameters: GI_STRING_COUNT = N_FLAGS IF GI_STRING_COUNT > N_FLAGS FOR J = 3 - GI_PAR_OMITTED TO GI_STRING_COUNT + 2 - GI_PAR_OMITTED SCR_PARAM(J) = GET_STRING(SCR_PARAM(J), TRUE) NEXT J IF POS(DEBUG_FLAG, "4", 1) > 0 THEN PRINT PRINT " GET_USER_INPUT debugging:" PRINT " "; GI_INTERVAL, GI_COUNT PRINT " "; FOR I = 1 TO GI_STRING_COUNT PRINT SCR_PARAM(I + 2 - GI_PAR_OMITTED); " "; NEXT I PRINT PRINT " parameters omitted: "; GI_PAR_OMITTED END IF !Set the terminal to no passthru for entering the menu selections. This !will give the user the ability to edit their input, if required... IF OLD_TERM_MODE(0%) <> 0% OR OLD_TERM_MODE(1%) <> 0% OR & OLD_TERM_MODE(2%) <> 0% THEN JUNK = SYS$QIOW(!efn!, TERM_CHAN BY VALUE, & IO$_SETMODE BY VALUE, & ,,, & OLD_TERM_MODE(0) BY REF, & 12% BY VALUE,,,,) END IF SET NO PROMPT COND_FLAG(I) = FALSE FOR I = 0 TO N_FLAGS !clear flags MATCH_FLAG = FALSE !No matches I = 0 WHILE I < GI_COUNT I = I + 1 WAIT GI_INTERVAL WHEN ERROR IN INPUT "";USER_INPUT_BUF USE CONTINUE REDO_INPUT END WHEN WAIT 0 !Disable user input timeout, in case we have ! to get input later which doesn't require a ! timeout. USER_INPUT_BUF = EDIT$(USER_INPUT_BUF,32) FOR J = 3 - GI_PAR_OMITTED TO GI_STRING_COUNT + 2 - GI_PAR_OMITTED IF POS(USER_INPUT_BUF, EDIT$(SCR_PARAM(J),32), 1) > 0 THEN !found a match on the Jth string COND_FLAG(J - 2 + GI_PAR_OMITTED) = TRUE MATCH_FLAG = TRUE !We got a match, so we don't ! have to continue with the ! input loop. JUNK = SYS$SETAST(0% BY VALUE) !no interruptions USER_INPUT_BUF = "" !clear buffer IF LOG_PTR > 0% THEN PUT #LOG_FILE, COUNT LOG_PTR LOG_PTR = 0 END IF JUNK = SYS$SETAST(1% BY VALUE) !interruptions OK GOTO GET_USER_INPUT_EXIT !stop checking ELSE IF POS(DEBUG_FLAG, "4", 1) > 0 THEN PRINT PRINT " No match on string:" PRINT SCR_PARAM(J) PRINT PRINT LOG_PTR FOR JUNK = 0 TO 159 PRINT USING "### "; LOG_BUF(JUNK); PRINT IF MOD(JUNK, 20%) = 19% NEXT JUNK PRINT END IF END IF NEXT J IF NOT MATCH_FLAG THEN GOTO GET_USER_INPUT_EXIT !We got a match so we can ! exit the input loop. END IF REDO_INPUT: NEXT !drop through loop means no match; i.e. timeout COND_FLAG(0) = TRUE IF POS(DEBUG_FLAG, "5", 1) > 0 THEN PRINT " INPUT Condition flags: "; FOR I = 0 TO N_FLAGS IF COND_FLAG(I) = TRUE THEN PRINT "T"; ELSE PRINT "F"; END IF NEXT I PRINT END IF GET_USER_INPUT_EXIT: !Reset the terminal to passthru for continuation of the users !interactive session... TERM_MODE(0) = OLD_TERM_MODE(0) TERM_MODE(1) = OLD_TERM_MODE(1) TERM_MODE(2) = OLD_TERM_MODE(2) OR TT2$M_PASTHRU JUNK = SYS$QIOW(!efn!, TERM_CHAN BY VALUE, & IO$_SETMODE BY VALUE, & ,,, & TERM_MODE(0) BY REF, & 12% BY VALUE,,,,) RETURN IF_IFNOT: !************************************************** !checks condition flag and branches if set/not set ! !IF_IFNOT calls PROCESS_COMMAND re-entrantly ! !************************************************** IF POS(DEBUG_FLAG, "5", 1) > 0 THEN PRINT " IF/IFNOT Condition flags: "; FOR I = 0 TO N_FLAGS IF COND_FLAG(I) = TRUE THEN PRINT "T"; ELSE PRINT "F"; END IF NEXT I PRINT END IF I = -1 SELECT SCR_PARAM(1) CASE = 'ECHO' IF ((SCR_PARAM(0) = 'IF') AND (NOT ECHO_FLAG)) THEN GOTO END_IF_IFNOT !condition is false END IF IF ((SCR_PARAM(0) = 'IFNOT') AND (ECHO_FLAG)) THEN GOTO END_IF_IFNOT !condition is false END IF !condition is true... I = 2% !'goto' parameter GOTO IF_IFNOT_BRANCH CASE = 'VIEW' IF ((SCR_PARAM(0) = 'IF') AND (NOT VIEW_FLAG)) THEN GOTO END_IF_IFNOT !condition is false END IF IF ((SCR_PARAM(0) = 'IFNOT') AND (VIEW_FLAG)) THEN GOTO END_IF_IFNOT !condition is false END IF !condition is true... I = 2% !'goto' parameter GOTO IF_IFNOT_BRANCH CASE = 'CLASS' SCR_PARAM(2) = GET_STRING(SCR_PARAM(2), FALSE) IF ((SCR_PARAM(0) = 'IF') AND & (SCR_PARAM(2) <> TRM$(MODEM_CLASS))) THEN GOTO END_IF_IFNOT !condition is false END IF IF ((SCR_PARAM(0) = 'IFNOT') AND & (SCR_PARAM(2) = TRM$(MODEM_CLASS))) THEN GOTO END_IF_IFNOT !condition is false END IF I = 3% !'goto' parameter GOTO IF_IFNOT_BRANCH CASE = 'MODEM' SCR_PARAM(2) = GET_STRING(SCR_PARAM(2), FALSE) IF ((SCR_PARAM(0) = 'IF') AND & (SCR_PARAM(2) <> TRM$(MODEM_TYPE))) THEN GOTO END_IF_IFNOT !condition is false END IF IF ((SCR_PARAM(0) = 'IFNOT') AND & (SCR_PARAM(2) = TRM$(MODEM_TYPE))) THEN GOTO END_IF_IFNOT !condition is false END IF I = 3% !'goto' parameter GOTO IF_IFNOT_BRANCH CASE = 'NODE' SCR_PARAM(2) = GET_STRING(SCR_PARAM(2), FALSE) IF ((SCR_PARAM(0) = 'IF') AND & (SCR_PARAM(2) <> TRM$(NODE_NAME))) THEN GOTO END_IF_IFNOT !condition is false END IF IF ((SCR_PARAM(0) = 'IFNOT') AND & (SCR_PARAM(2) = TRM$(NODE_NAME))) THEN GOTO END_IF_IFNOT !condition is false END IF I = 3% !'goto' parameter GOTO IF_IFNOT_BRANCH CASE = 'PORT' SCR_PARAM(2) = GET_STRING(SCR_PARAM(2), FALSE) IF ((SCR_PARAM(0) = 'IF') AND & (SCR_PARAM(2) <> TRM$(PORT_NAME))) THEN GOTO END_IF_IFNOT !condition is false END IF IF ((SCR_PARAM(0) = 'IFNOT') AND & (SCR_PARAM(2) = TRM$(PORT_NAME))) THEN GOTO END_IF_IFNOT !condition is false END IF I = 3% !'goto' parameter GOTO IF_IFNOT_BRANCH CASE = 'TIMEOUT' I = 0 CASE ELSE !should be a condition flag in range 1-N_FLAGS... I = VAL%(SCR_PARAM(1)) END SELECT IF I < 0 OR I > N_FLAGS THEN JUNK = ERRORS('Condition flag out of range - command ignored') FUNC_STATUS = SS$_ABORT GOSUB PROCESS_COMMAND !force an abort GOTO END_IF_IFNOT END IF !check condition flag: IF SCR_PARAM(0) = 'IF' AND COND_FLAG(I) = FALSE THEN GOTO END_IF_IFNOT END IF IF SCR_PARAM(0) = 'IFNOT' AND COND_FLAG(I) = TRUE THEN GOTO END_IF_IFNOT END IF I = 2% !'goto' parameter IF_IFNOT_BRANCH: SCR_PARAM(0) = 'GOTO' !fake a goto IF SCR_PARAM(I) = 'GOTO' THEN SCR_PARAM(1) = SCR_PARAM(I+1) !label ELSE SCR_PARAM(1) = SCR_PARAM(I) !label END IF NUM_PARAMS = 1 GOSUB PROCESS_COMMAND !re-entrant call for GOTO END_IF_IFNOT: RETURN DUMP_ERROR: !********************************************************************** !in event of an error, dumps input buffer to file !********************************************************************** OPEN ERROR_DIR + "EXT_" + NOW + ERROR_EXT FOR OUTPUT & AS FILE #ERR_CHAN, & ORGANIZATION SEQUENTIAL FIXED, & ACCESS WRITE, & MAP LOG_BUF_MAP PUT #ERR_CHAN !dump buffer to file CLOSE #ERR_CHAN RETURN READ_SCRIPT: !************************************************** !reads specified script !************************************************** END_OF_FILE = FALSE SCRIPT_PTR = 0 WHILE NOT (END_OF_FILE) GOSUB GET_LINE GOSUB PARSE_SCRIPT IF NOT END_OF_FILE THEN SELECT SCR_PARAM(0) CASE = 'ABORT' IF SCRIPT_TYPE <> "D" THEN SAVE_SCRIPT_LINE = TRUE ELSE SAVE_SCRIPT_LINE = FALSE JUNK = ERRORS("Can't use ABORT command in " + & "disconnect script - ignored") END IF CASE = 'DIAL', 'CONNECT' IF SCRIPT_TYPE = "S" THEN SAVE_SCRIPT_LINE = TRUE ELSE SAVE_SCRIPT_LINE = FALSE JUNK = ERRORS("Can't use " + SCR_PARAM(0) + " command in " + & "connect/disconnect script - ignored") END IF CASE = 'LABEL' !save labels SAVE_SCRIPT_LINE = FALSE IF NUM_PARAMS < 1 THEN JUNK = ERRORS("Not enough parameters - label ignored") ELSE NUM_LABELS = NUM_LABELS + 1 LABEL_NAME(NUM_LABELS) = EDIT$(SCR_PARAM(1), 32) LABELS(NUM_LABELS) = SCRIPT_PTR + 1 END IF CASE = "!", "" !don't save comments or blank lines: SAVE_SCRIPT_LINE = FALSE CASE ELSE SAVE_SCRIPT_LINE = TRUE END SELECT IF SAVE_SCRIPT_LINE THEN SCRIPT_PTR = SCRIPT_PTR + 1 SCRIPT(SCRIPT_PTR) = SCRIPT_BUF END IF END IF NEXT CLOSE #SCR_FILE NUM_SCRIPT_LINES = SCRIPT_PTR IF POS(DEBUG_FLAG, "2", 1) > 0 THEN PRINT PRINT " "; SCRIPT_TYPE; "SCRIPT:" PRINT FOR I = 1 TO SCRIPT_PTR PRINT I, SCRIPT(I) NEXT I PRINT PRINT " "; SCRIPT_TYPE; "LABELS:" PRINT FOR I = 1 TO NUM_LABELS PRINT I, LABEL_NAME(I), LABELS(I) NEXT I SLEEP 3 END IF RETURN PROCESS_DIAL: !************************************************** !runs the connection (dial) script ! !PROCESS_DIAL calls PROCESS_COMMAND re-entrantly ! !************************************************** !run the connect script... JUNK = EXT_SCRIPT_INTERP(TRM$(MODEM_TYPE), "C", SCR_FILE+1%) !check for trouble... IF (JUNK AND 1%) = 0% THEN FUNC_STATUS = JUNK GOTO END_OF_PROGRAM END IF RETURN %PAGE %SBTTL "FUNCTION DEFINITION SECTION" 20000 !====================================================================== ! FUNCTION DEFINITION SECTION !====================================================================== !************************************************** !handles syntax errors !************************************************** DEF WORD ERRORS(STRING ERR_TEXT) SCR_PARAM(0) = "ABORT" !force an abort SCR_PARAM(1) = "Script Syntax Error" NUM_PARAMS = 1 PRINT PRINT "Script syntax error - Contact Computer Services" PRINT " Script line: "; SCRIPT_BUF PRINT " "; ERR_TEXT SLEEP 3 ERRORS = 0 20099 END DEF 20100 !************************************************** !accept string !strip quotes !replace "^" with CRLF !************************************************** DEF STRING GET_STRING(STRING GS_STRING, WORD GS_LINEFEED) DECLARE STRING GS_TEMP GS_TEMP = GS_STRING !strip quotes: I = LEN(GS_TEMP) IF (SEG$(GS_TEMP, 1, 1) = "'" OR & SEG$(GS_TEMP, 1, 1) = '"') AND & SEG$(GS_TEMP, I, I) = SEG$(GS_TEMP, 1, 1) THEN GS_TEMP = SEG$(GS_TEMP, 2, I - 1) END IF !insert CRs: I = POS(GS_TEMP, "^", 1) WHILE I > 0 IF GS_LINEFEED THEN GS_TEMP = SEG$(GS_TEMP, 1, I - 1) + CHR$(13) + & CHR$(10) + SEG$(GS_TEMP, I + 1, LEN(GS_TEMP)) ELSE GS_TEMP = SEG$(GS_TEMP, 1, I - 1) + CHR$(13) + & SEG$(GS_TEMP, I + 1, LEN(GS_TEMP)) END IF I = POS(GS_TEMP, "^", 1) NEXT GET_STRING = GS_TEMP 20199 END DEF 20500 !********************************************************************** ! snooze function accepts a time in 10ths of a second and places the ! process in a hibernate state for the requested length of time (max ! of 60 seconds). !********************************************************************** DEF WORD SNOOZE(WORD SNOOZE_TIME) SNOOZE_SECS = NUM1$(SNOOZE_TIME / 10) SNOOZE_SECS = SNOOZE_SECS + "." IF POS(SNOOZE_SECS, ".", 1) = 0 WHILE POS(SNOOZE_SECS, ".", 1) < 3 SNOOZE_SECS = "0" + SNOOZE_SECS NEXT WHILE LEN(SNOOZE_SECS) < 5 SNOOZE_SECS = SNOOZE_SECS + "0" NEXT DELTA_TIME = "0 00:00:" + SNOOZE_SECS ! convert input time to binary time format CALL SYS$BINTIM(DELTA_TIME, BINARY_TIME BY REF) ! set schedule wake up call CALL SYS$SCHDWK(,,BINARY_TIME BY REF,) ! place process in hibernate until wake up call CALL SYS$HIBER() SNOOZE = 0 20599 END DEF !********************************************************************** !returns current date/time as YYMMDDHHMMSS !********************************************************************** DEF STRING NOW DECLARE WORD & NOW_BUF(6) DECLARE LONG & NOW_LONG DECLARE STRING & NOW_STR CALL SYS$GETTIM(CUR_TIME) CALL SYS$NUMTIM(NOW_BUF(0), CUR_TIME) NOW_LONG = 1000000% + NOW_BUF(3) * 10000% + & NOW_BUF(4) * 100% + NOW_BUF(5) NOW_STR = SEG$(NUM1$(NOW_LONG), 2, 7) NOW_LONG = NOW_BUF(0) * 10000% + & NOW_BUF(1) * 100% + NOW_BUF(2) NOW_STR = SEG$(NUM1$(NOW_LONG), 3, 8) + NOW_STR NOW = NOW_STR END DEF %PAGE %SBTTL "ERROR HANDLING SECTION" 25000 !====================================================================== ! ERROR HANDLING SECTION !====================================================================== ERROR_HANDLING: IF ERR = 28% THEN !^C trap FUNC_STATUS = SS$_ABORT CALL LIB$SET_SYMBOL("ABORT_TEXT", "Interrupted by user") RESUME END_OF_PROGRAM END IF ON ERROR GOTO 0 !====================================================================== ! END OF PROGRAM !====================================================================== END_OF_PROGRAM: CLOSE #SCR_FILE EXIT FUNCTION FUNC_STATUS 32767 END FUNCTION