10	!======================================================================
	!PROGRAM---------------------VERSION-------------------LANGUAGE--------
	!EXTERNAL			5			BASIC
	!
	!DESCRIPTION-----------------------------------------------------------
	!Program to provide users with access to external facilities.
	!Performs customized menu selection, automatic port allocation,
	!dialling and logging-on.  Keeps a log file of the session.
	!
	!======================================================================

	%TITLE "External Communications Program"
	%IDENT "EXTERNAL  88.10.11"
	%SBTTL "DOCUMENTATION SECTION"

	!**********************************************************************
	!			OPTIONS
	!**********************************************************************

	OPTION	TYPE = EXPLICIT			! Explicit declarations only

100	!**********************************************************************
	!			DOCUMENTATION SECTION
	!**********************************************************************
	!
	!======================================================================
	!			MODIFICATION HISTORY
	!======================================================================
	!VERSION--------AUTHOR------------------DATE------------APPROVAL-------
	!   1		Keith Walker		86.08.20	E-1637
	!   2		Keith Walker		86.09.03	E-1637
	!   3		Keith Walker		86.10.06	M-7407
	!   4		Keith Walker		88.02.10	1723
	!   5		Keith Walker		88.10.11	1741
	!
	!======================================================================
	!			COMPILE/LINK INSTRUCTIONS
	!======================================================================
	!$BASIC EXTERNAL
	!$LINK/NOTRACE EXTERNAL,-
	!EXT_UNSOL_MBX_AST, EXT_READ_PORT_AST,-
	!EXT_PROC_BUF_AST, EXT_WRITE_TERM_AST,-
	!EXT_SCRIPT_INTERP, EXT_SCREEN_HDR,-
	!EXT_MENU, EXT_CONNECT_LOOP, CHKRDB
	!
	!installed with ALTPRI and SYSPRV
	!======================================================================

	!**********************************************************************
	!			FILES ACCESSED
	!**********************************************************************
	!     NAME	    MODE    CHANNEL		  DESCRIPTION
	!--------------	   ------   -------	-------------------------------
	!xxxx.LOG	   WRITE    LOG_FILE	log file
	!MENU.DAT	   READ	    MENU_FILE	menu file
	!PORTS.DAT	   READ	    PORTS_FILE	ports file
	!EXTERNAL_yy.LOG   APPEND   RECORD_FILE	record file
	!xxxx.SCR	   READ	    SCRIPT_FILE	script files
	!EXT_xxx.LIS	   WRITE    variable	buffer dump on script error
	!
	!**********************************************************************

	%PAGE
	%SBTTL "DECLARATION SECTION"
200	!======================================================================
	!			DECLARATION SECTION
	!======================================================================

	!**********************************************************************
	!			DECLARATIONS FROM %INCLUDE FILES
	!**********************************************************************

	%INCLUDE "EXT_COMMON.BAS"

	!**********************************************************************
	!			CONSTANTS
	!**********************************************************************

	!**********************************************************************
	!			RECORDS
	!**********************************************************************

	!**********************************************************************
	!			MAPS
	!**********************************************************************

	MAP (PERM_LOG_MAP)	!used for writing to permanent log	&
		STRING	START_TIME = 12,&
		STRING	END_TIME = 12,	&
		STRING	FAC_NAME = 10,	&
		STRING	USER_NAME = 12,	&
		STRING	ACCOUNT_NAME = 12,	&
		STRING	MNODE_NAME = 10,	&
		STRING	MPORT_NAME = 5,	&
		STRING	MODEM_NAME = 10,	&
		STRING	MESSAGE = 50

	!**********************************************************************
	!			COMMONS
	!**********************************************************************

	!**********************************************************************
	!			VARIABLES
	!**********************************************************************

	DECLARE STRING &
		ABORT_TEXT, &
		LOG_FILE_NAME, &
		DEFAULT_VIEW

	DECLARE WORD &
		TERM_BUF, &
		TERM_IOSB(3)

	DECLARE LONG &
		BAUD_RATE, &
		I, &
		JUNK, &
		PARITY_FLAGS, &
		TERM_READ_CODE

	DECLARE QUAD &
		MODEM_CONTROL

	!**********************************************************************
	!			ARRAYS
	!**********************************************************************

	!**********************************************************************
	!			FUNCTIONS
	!**********************************************************************

	DECLARE STRING FUNCTION &
		NOW		!returns current date/time

	!**********************************************************************
	!			EXTERNAL CONSTANTS
	!**********************************************************************

	EXTERNAL LONG CONSTANT &
		IO$_SENSEMODE, &
		IO$_SETMODE, &
		IO$_WRITEVBLK, &
		IO$_READVBLK, &
		IO$M_NOECHO, &
		IO$M_TIMED, &
		IO$M_SET_MODEM, &
		IO$M_MAINT, &
		JPI$_USERNAME, &
		JPI$_ACCOUNT, &
		LIB$M_CLI_CTRLY, &
		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_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_ALTYPEAHD, &
		TT2$M_AUTOBAUD, &
		TT2$M_DRCS, &
		TT2$M_EDIT, &
		TT2$M_PASTHRU, &
		TT2$M_PRINTER

	!**********************************************************************
	!			EXTERNAL FUNCTIONS
	!**********************************************************************

	EXTERNAL WORD FUNCTION &
		CHKRDB		!checks if user holds spec. Rights ID 

	EXTERNAL LONG &
		EXT_READ_PORT_AST

	EXTERNAL LONG FUNCTION &
		SYS$CANTIM, &
		SYS$DCLAST, &
   		SYS$ASSIGN, &
		LIB$FIND_FILE, &
		LIB$FREE_EF, &
		LIB$GET_EF, &
		LIB$GET_SYMBOL, &
		LIB$SET_SYMBOL, &
		LIB$GETJPI, &
		LIB$ASN_WTH_MBX, &
		LIB$DISABLE_CTRL, &
		SYS$QIO, &
		SYS$QIOW, &
		SYS$DALLOC, &
		SYS$DASSGN, &
		EXT_SCRIPT_INTERP, &
		EXT_MENU

	!**********************************************************************
	!			EXTERNAL SUBPROGRAMS
	!**********************************************************************

	EXTERNAL SUB &
		EXT_SCREEN_HDR

	%PAGE
	%SBTTL "INITIALIZATION SECTION"
300	!======================================================================
	!			INITIALIZATION SECTION
	!======================================================================

	ON ERROR GOTO ERROR_HANDLING
	CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY)	!disable ctrl/y

	!**********************************************************************
	!			PRINT USING FORMATS
	!**********************************************************************

	!**********************************************************************
	!			VARIABLES
	!**********************************************************************

	CURRENT_BUF = 0%
	BUFS_USED = 0%
	FOR I = 0 TO MAX_BUF_CNT
	  PORT_BUF(I)::BUF_IN_USE = FALSE
	NEXT I
	LOG_PTR = 0%
	CONT_FLAG = TRUE	!not finished yet

	!should we allow the user to see scripts?...
	IF CHKRDB("EXT_SUPPORT") = 0% THEN
	  !ordinary user: no...
	  DEFAULT_VIEW = "0"
	ELSE
	  !External Support person: maybe (depends on Verify flag)...
	  JUNK = LIB$GET_SYMBOL("DEFAULT_VIEW", DEFAULT_VIEW)
	END IF

	!**********************************************************************
	!			FILE OPENS
	!**********************************************************************

	%PAGE
	%SBTTL "MAIN LOGIC SECTION"
1000	!======================================================================
	!			MAIN LOGIC SECTION
	!======================================================================

	!display menu and get selection...
	JUNK = EXT_MENU
	IF (JUNK AND 1%) = 0% THEN
	  GOTO EXIT_PROG
	END IF

	!enable ^C trap...
	JUNK = CTRLC
	CALL EXT_SCREEN_HDR("Facility selected: " + TRM$(FACILITY_NAME), &
		"Enter <CTRL/C> to abort")

	!open log file...
	LOG_FILE_NAME = "SYS$LOGIN:" + TRM$(FACILITY_CODE) + ".LOG" 
	OPEN LOG_FILE_NAME FOR OUTPUT &
		AS FILE #LOG_FILE, &
	       	ORGANIZATION SEQUENTIAL STREAM, &
		MAP LOG_BUF_MAP
	JUNK = LIB$FIND_FILE(LOG_FILE_NAME, LOG_FILE_NAME, 0%)

	!assign channels for I/O...
	JUNK = SYS$ASSIGN("SYS$OUTPUT", TERM_CHAN, , )
	IF (JUNK AND 1%) = 0% THEN
	  GOTO EXIT_PROG
	END IF
    	JUNK = LIB$ASN_WTH_MBX(TRM$(PORT_NAME), MAX_MBX_SIZE, MAX_MBX_SIZE, &
		PORT_CHAN, MBX_CHAN)
	IF (JUNK AND 1%) = 0% THEN
	  GOTO EXIT_PROG
	END IF

	!get status of terminal and port...
	JUNK = SYS$QIOW(!efn!, TERM_CHAN BY VALUE, &
	     	   		IO$_SENSEMODE BY VALUE,	&
				,,, 	&
				OLD_TERM_MODE(0) BY REF,		&
				12% BY VALUE,,,,)
	JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, &
	     	   		IO$_SENSEMODE BY VALUE,	&
				,,, 	&
				OLD_PORT_MODE(0) BY REF,		&
				12% BY VALUE,,,,)

	!set up the port...
	PORT_MODE(0) = OLD_PORT_MODE(0)
	PORT_MODE(1) = OLD_PORT_MODE(1) &
		AND (NOT TT$M_NOTYPEAHD)	!allow typeahead &
		OR TT$M_HOSTSYNC		!we can throttle the port &
		AND (NOT TT$M_TTSYNC)		!the port can't throttle us &
		AND (NOT TT$M_EIGHTBIT)		!seven bit data &
		AND (NOT TT$M_MODEM)		!we control DTR &
		OR TT$M_NOBRDCST		!don't send junk to the port
	PORT_MODE(2) = OLD_PORT_MODE(2) &
		OR TT2$M_ALTYPEAHD		!big buffer &
		OR TT2$M_PASTHRU		!let all bytes through

	!set defaults...
	PARITY_FLAGS = TT$M_ALTDISPAR OR TT$M_DISPARERR	!ignore parity on input
	PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR	!no parity on output
	PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTFRAME OR 8%	!8 bits
	BAUD_RATE = TT$C_BAUD_1200			!1200 baud

	JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, &
	     	   		IO$_SETMODE BY VALUE,	&
				,,,    	&
				PORT_MODE(0) BY REF,		&
				12% BY VALUE,	&
				BAUD_RATE BY VALUE,,	&
				PARITY_FLAGS BY VALUE,)

	GOSUB DTR_ON	!switch on DTR

	!kick off receive AST loop by reading data from the port...
	JUNK = SYS$DCLAST(EXT_READ_PORT_AST BY REF, !astprm!, !acmode!)

	!run the facility script...
	IF DEFAULT_VIEW = "1" THEN
	  !let user see script if verify is on...
	  VIEW_FLAG = TRUE
	ELSE
	  !if no verify, VIEW is off unless the script turns it on..
	  VIEW_FLAG = FALSE
	END IF
	ECHO_FLAG = FALSE	!normally, no local echo
	LOG_FLAG = FALSE	!don't log script
	JUNK = EXT_SCRIPT_INTERP(TRM$(FACILITY_CODE), "S", SCRIPT_FILE)

 ONLINE_DONE:
	!print the abort message, if any...
	JUNK = LIB$GET_SYMBOL("ABORT_TEXT", ABORT_TEXT)
	IF ABORT_TEXT <> " " THEN
	  PRINT CHR$(27); "[1m"; ABORT_TEXT; CHR$(27); "[0m"
	END IF

	CALL EXT_SCREEN_HDR("Disconnecting from " + TRM$(FACILITY_NAME), &
		"Exit in progress")

	!run the disconnect script...
	IF DEFAULT_VIEW = "1" THEN
	  !let user see script if verify is on...
	  VIEW_FLAG = TRUE
	ELSE
	  !if no verify, VIEW is off unless the script turns it on..
	  VIEW_FLAG = FALSE
	END IF
	ECHO_FLAG = FALSE	!ECHO is off unless the script turns it on
	LOG_FLAG = FALSE	!don't log script
	JUNK = EXT_SCRIPT_INTERP(TRM$(MODEM_TYPE), "D", SCRIPT_FILE)

	!record the session...
	WHEN ERROR IN
	  !note no FOR INPUT or FOR OUTPUT clause: first user of new year
	  !creates new file...
	  OPEN "LF_RECORD_LOG" AS FILE #RECORD_FILE, &
	  	ORGANIZATION SEQUENTIAL FIXED, &
		ACCESS APPEND, ALLOW MODIFY, &
		MAP PERM_LOG_MAP
	USE
	  I = I + 1%
	  SLEEP 1%
	  RETRY IF I < 10%	!keep trying a reasonable number of times
	  CONTINUE EXIT_PROG	!forget it if it takes too long
	END WHEN

	JUNK = LIB$GET_SYMBOL("START_TIME", START_TIME)
	JUNK = LIB$GET_SYMBOL("NODE", MNODE_NAME)
	END_TIME = NOW
	FAC_NAME = TRM$(FACILITY_CODE)
	I = 0%
	JUNK = LIB$GETJPI(JPI$_USERNAME, , , , USER_NAME, I)
	USER_NAME = SEG$(USER_NAME, 1, I) + SPACE$(12 - I)
	JUNK = LIB$GETJPI(JPI$_ACCOUNT, , , , ACCOUNT_NAME, I)
	ACCOUNT_NAME = SEG$(ACCOUNT_NAME, 1, I) + SPACE$(12 - I)
	MPORT_NAME = TRM$(PORT_NAME)
	MODEM_NAME = TRM$(MODEM_TYPE)
	MESSAGE = ABORT_TEXT
	PUT #RECORD_FILE
	CLOSE #RECORD_FILE
	PRINT "Log file is "; LOG_FILE_NAME

 EXIT_PROG:
	CLOSE #LOG_FILE
	JUNK = LIB$SET_SYMBOL("FACILITY_CODE", FACILITY_CODE, 1%)

	!stop the AST loop...
	CONT_FLAG = FALSE

	!reset the terminal...
	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
	GOSUB RESET_SCROLL

	!reset the port and disable typeahead...
	GOSUB DTR_OFF
	IF OLD_PORT_MODE(0%) <> 0% OR OLD_PORT_MODE(1%) <> 0% OR &
		OLD_PORT_MODE(2%) <> 0% THEN
	  OLD_PORT_MODE(1) = OLD_PORT_MODE(1) OR TT$M_NOTYPEAHD
	  PARITY_FLAGS = TT$M_ALTDISPAR OR TT$M_DISPARERR	!ignore parity on input
	  PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTRPAR		!default to none
	  PARITY_FLAGS = PARITY_FLAGS OR TT$M_ALTFRAME OR 8%	!default 8 bits
	  BAUD_RATE = TT$C_BAUD_1200
	  JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE, &
	     	   		IO$_SETMODE BY VALUE,	&
				,,,    	&
				OLD_PORT_MODE(0) BY REF,		&
				12% BY VALUE,	&
				BAUD_RATE BY VALUE,,	&
				PARITY_FLAGS BY VALUE,)

	END IF

	JUNK = SYS$CANTIM(0% BY VALUE, !acmode!)
	JUNK = SYS$DASSGN(PORT_CHAN BY VALUE)
	JUNK = SYS$DASSGN(TERM_CHAN BY VALUE)
	JUNK = SYS$DASSGN(MBX_CHAN BY VALUE)
	JUNK = SYS$DALLOC(TRM$(PORT_NAME), !acmode!)

	GOTO END_OF_PROGRAM

	%PAGE
	%SBTTL "SUBROUTINE DEFINITION SECTION"
15000	!======================================================================
	!			SUBROUTINE DEFINITION SECTION
	!======================================================================

 DTR_ON:
 	!**********************************************************************
	!toggle DTR on
	!**********************************************************************

	!	Toggle DTR on
	MODEM_CONTROL::SINGLE_BYTE(2%) = TT$M_DS_DTR
	MODEM_CONTROL::SINGLE_BYTE(3%) = 0%
	JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE,	&
		(IO$_SETMODE OR IO$M_SET_MODEM OR IO$M_MAINT) BY VALUE, &
		!iosb!, !astadr!, !astprm!, &
		MODEM_CONTROL BY REF,,,,,)
               
	RETURN

 DTR_OFF:
	!**********************************************************************
	!toggle DTR off
	!**********************************************************************

	!	Toggle DTR off
	MODEM_CONTROL::SINGLE_BYTE(2%) = 0%
	MODEM_CONTROL::SINGLE_BYTE(3%) = TT$M_DS_DTR
	JUNK = SYS$QIOW(!efn!, PORT_CHAN BY VALUE,	&
		(IO$_SETMODE OR IO$M_SET_MODEM OR IO$M_MAINT) BY VALUE, & 
		!iosb!, !astadr!, !astprm!, &
		MODEM_CONTROL BY REF,,,,,)

	RETURN

 RESET_SCROLL:
 	!**********************************************************************
	!clears VT100 scrolling region
	!**********************************************************************

	PRINT CHR$(27); "[1;24r"; CHR$(27); "[24;1H"
	RETURN

	%PAGE
	%SBTTL "FUNCTION DEFINITION SECTION"
20000	!======================================================================
	!			FUNCTION DEFINITION SECTION
	!======================================================================

	!**********************************************************************
     	!returns current date/time as YYMMDDHHMMSS
	!**********************************************************************

	DEF STRING NOW

	DECLARE WORD &
		NOW_BUF(6)

	DECLARE LONG &
		NOW_LONG

	DECLARE STRING &
		NOW_STR

	CALL SYS$NUMTIM(NOW_BUF(0), !timadr!)
	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	!ctrl/c
	  JUNK = LIB$SET_SYMBOL("ABORT_TEXT", "Interrupted by user")
	  RESUME ONLINE_DONE
	END IF
	ON ERROR GOTO 0

	!======================================================================
	!			END OF PROGRAM
	!======================================================================

 END_OF_PROGRAM:

32767	END