LOGICAL FUNCTION AUTO_LOGIN C C This routine is used to login at the remote system. C INCLUDE 'COM.INC/NOLIST' CHARACTER*80 LOGIN_PROMPT, LOGIN_START CHARACTER*32 LOGIN_TRYS, PROMPT_TRYS, START_TRYS CHARACTER*32 LOGIN_DELAY, LOGIN_TMO, AFTER_TMO CHARACTER*80 LOGIN_ERROR, PASS_PROMPT INTEGER*4 DSIZE, ESIZE, PSIZE, PPSIZE, LCOUNT, PCOUNT, SCOUNT INTEGER*4 LTRYS, PTRYS, STRYS, TMO, ATMO DATA LTRYS, PTRYS, STRYS, TMO, ATMO /3,0,10,30,1/ AUTO_LOGIN = .TRUE. ! Presume success. ASSIGN 9900 TO ABORT ! Go here to abort. C C The user can define several symbols to overide the normal C start, prompt, and login maximum retrys. They are: C START_TRYS, PROMPT_TRYS, AND LOGIN_TRYS. C IF (GET_SYMBOL('LOGIN_TRYS',LOGIN_TRYS,SIZE)) THEN IF (.NOT. CVT_DTB(LOGIN_TRYS(1:SIZE),LTRYS)) GO TO ABORT ENDIF IF (GET_SYMBOL('PROMPT_TRYS',PROMPT_TRYS,SIZE)) THEN IF (.NOT. CVT_DTB(PROMPT_TRYS(1:SIZE),PTRYS)) GO TO ABORT ENDIF IF (GET_SYMBOL('START_TRYS',START_TRYS,SIZE)) THEN IF (.NOT. CVT_DTB(START_TRYS(1:SIZE),STRYS)) GO TO ABORT ENDIF C C The symbol LOGIN_TMO can also be used to override the normal C read timeout count. For system that are very busy, the default C timeout count is too short. C IF (GET_SYMBOL('LOGIN_TMO',LOGIN_TMO,SIZE)) THEN IF (.NOT. CVT_DTB(LOGIN_TMO(1:SIZE),TMO)) GO TO ABORT ENDIF C C Some systems such as VMS, require some a character to be sent C get the login prompt. The symbol LOGIN_START defines the C characters to send to get the login prompt. We sit in this C loop sending the defined characters every second until the remote C system sends us something back. C 25 SCOUNT = 0 ! Initialize start retry counter. IF (GET_SYMBOL('LOGIN_START',LOGIN_START,START_SIZE)) THEN IF (START_SIZE .GT. 0) THEN 50 CALL WRITE_CTRL(%REF(LOGIN_START),START_SIZE) CALL WAITABIT('01.00') ! Wait for a second. IF (CHECK_TYPEAHEAD() .EQ. 0) THEN SCOUNT = SCOUNT + 1 ! Count our retrys. IF (SCOUNT .NE. STRYS) THEN GO TO 50 ! Try again. ELSE GO TO ABORT ! Tell'em we're aborting. ENDIF ENDIF ENDIF ENDIF C C For some systems we need to delay for several seconds because C there is a break between the header message and the login prompt. C The symbol LOGIN_DELAY defines the number of seconds to delay. C IF (GET_SYMBOL('LOGIN_DELAY',LOGIN_DELAY,DSIZE)) THEN IF (DSIZE .GT. 0) THEN CALL WAITABIT(LOGIN_DELAY(1:DELAY_SIZE)) ENDIF ENDIF C C If there is no login prompt or if it is defined as null, return. C We don't want to loop forever looking for a prompt not defined. C IF (.NOT. GET_SYMBOL('LOGIN_PROMPT',LOGIN_PROMPT,PSIZE)) RETURN IF (PSIZE .GT. 0) THEN CALL CVT_CTRL(%REF(LOGIN_PROMPT),PSIZE) ELSE RETURN ENDIF C C Now, go read the login prompt. C PCOUNT = 0 ! Initialize prompt retry counter. 100 IF (.NOT. READ_DATA(RBUFFER(1),.TRUE.,RDESC,TMO)) GO TO ABORT C C See if we got the correct prompt. C C For some systems which output a header message, it will take C several trys before we get the login prompt. C IF (FIND_SUBSTRING(LOGIN_PROMPT(1:PSIZE),RDESC) .EQ. 0) THEN PCOUNT = PCOUNT + 1 ! Count our retrys. IF (PCOUNT .NE. PTRYS) THEN GO TO 100 ! Try again. ELSE GO TO ABORT ! Tell user we're aborting. ENDIF ENDIF C C If there is no login command or if it is defined as null, return. C IF (.NOT. GET_SYMBOL('LOGIN_CMD',LOGIN_CMD,LOGIN_SIZE)) RETURN IF (LOGIN_SIZE .EQ. 0) RETURN C C We got the prompt, now send the login command. C 200 CALL WRITE_DATA(%REF(LOGIN_CMD),LOGIN_SIZE) C C On some systems, the prompt is redisplayed if the login command C was invalid. If the prompt is redisplayed, we presume it got C garbled and try several times. C IF (.NOT. READ_DATA(RBUFFER(1),.TRUE.,RDESC,TMO)) GO TO ABORT IF (FIND_SUBSTRING(LOGIN_PROMPT(1:PSIZE),RDESC) .GT. 0) THEN LCOUNT = LCOUNT + 1 ! Count our trys. IF (LCOUNT .NE. LTRYS) THEN GO TO 200 ! Try again. ELSE GO TO ABORT ! Tell user we're aborting. ENDIF ENDIF C C For a system like VMS, we must next send the password. The C symbol PASSWORD defines the password to send. If there is C a PASS_PROMPT symbol, then we make sure this prompt exists C before sending the password. C IF (GET_SYMBOL('PASSWORD',PASSWORD,PASSWORD_SIZE)) THEN IF (GET_SYMBOL('PASS_PROMPT',PASS_PROMPT,PPSIZE)) THEN CALL CVT_CTRL(%REF(PASS_PROMPT),PPSIZE) 300 IF (FIND_SUBSTRING(PASS_PROMPT(1:PPSIZE),RDESC) .EQ. 0) THEN PCOUNT = PCOUNT + 1 ! Count our retrys. IF (PCOUNT .NE. PTRYS) THEN IF (READ_DATA(RBUFFER(1),.TRUE.,RDESC,TMO)) THEN GO TO 300 ! Loop waiting for password prompt. ENDIF ENDIF GO TO ABORT ! Tell user we're aborting. ENDIF ENDIF IF (PASSWORD_SIZE .GT. 0) THEN CALL WRITE_DATA(%REF(PASSWORD),PASSWORD_SIZE) IF (.NOT. READ_DATA(RBUFFER(1),.TRUE.,RDESC,TMO)) THEN GO TO ABORT ENDIF ENDIF ENDIF C C Now we will check for a login error if the symbol LOGIN_ERROR C is defined. If a login error occured, we will retry several times. C IF (GET_SYMBOL('LOGIN_ERROR',LOGIN_ERROR,ESIZE)) THEN IF (ESIZE .GT. 0) THEN IF (FIND_SUBSTRING(LOGIN_ERROR(1:ESIZE),RDESC) .GT. 0) THEN LCOUNT = LCOUNT + 1 ! Count our retrys. IF (LCOUNT .NE. LTRYS) THEN GO TO 25 ! Start login sequence again. ELSE GO TO ABORT ! Tell the user we're aborting. ENDIF ENDIF ENDIF ENDIF C C If the remote system requires a second login prompt, the symbol C LOGIN_PROMPT2 must be defined with the prompt to wait for. C Otherwise, we go to the routine to wait until the remote is idle. C IF (.NOT. GET_SYMBOL('LOGIN_PROMPT2',LOGIN_PROMPT,PSIZE)) GO TO 2400 IF (PSIZE .GT. 0) THEN CALL CVT_CTRL(%REF(LOGIN_PROMPT),PSIZE) ELSE GO TO 2400 ENDIF C C Now, go read the 2nd login prompt. C PCOUNT = 0 ! Init prompt retry counter. LCOUNT = 0 ! Init login retry counter. 1000 IF (.NOT. READ_DATA(RBUFFER(1),.TRUE.,RDESC,TMO)) GO TO ABORT IF (FIND_SUBSTRING(LOGIN_PROMPT(1:PSIZE),RDESC) .EQ. 0) THEN PCOUNT = PCOUNT + 1 ! Count our retrys. IF (PCOUNT .NE. PTRYS) THEN GO TO 1000 ! Try again. ELSE GO TO ABORT ! Tell user we're aborting. ENDIF ENDIF C C If there is a second login command, the symbol LOGIN_CMD2 must C be defined with the login command. Otherwise, we go to the C routine to wait until the remote becomes idle. C IF (.NOT. GET_SYMBOL('LOGIN_CMD2',LOGIN_CMD,LOGIN_SIZE)) GO TO 2400 IF (LOGIN_SIZE .EQ. 0) GO TO 2400 C C We got the prompt, now send the login command. C 2000 CALL WRITE_DATA(%REF(LOGIN_CMD),LOGIN_SIZE) C C See if they got the login command OK. If not, retry. C IF (.NOT. READ_DATA(RBUFFER(1),.TRUE.,RDESC,TMO)) GO TO ABORT IF (FIND_SUBSTRING(LOGIN_PROMPT(1:PSIZE),RDESC) .GT. 0) THEN LCOUNT = LCOUNT + 1 ! Count our trys. IF (LCOUNT .NE. LTRYS) THEN GO TO 2000 ! Try again. ELSE GO TO ABORT ! Tell user we're aborting. ENDIF ENDIF C C If the symbol PASSWORD2 is defined, we send another password. C IF (GET_SYMBOL('PASSWORD2',PASSWORD,PASSWORD_SIZE)) THEN IF (GET_SYMBOL('PASS_PROMPT2',PASS_PROMPT,PPSIZE)) THEN CALL CVT_CTRL(%REF(PASS_PROMPT),PPSIZE) 2300 IF (FIND_SUBSTRING(PASS_PROMPT(1:PPSIZE),RDESC) .EQ. 0) THEN PCOUNT = PCOUNT + 1 ! Count our retrys. IF (PCOUNT .NE. PTRYS) THEN IF (READ_DATA(RBUFFER(1),.TRUE.,RDESC,TMO)) THEN GO TO 2300 ! Loop waiting for password prompt. ENDIF ENDIF GO TO ABORT ! Tell user we're aborting. ENDIF ENDIF IF (PASSWORD_SIZE .GT. 0) THEN CALL WRITE_DATA(%REF(PASSWORD),PASSWORD_SIZE) IF (.NOT. (READ_DATA(RBUFFER(1),.TRUE.,RDESC,TMO))) THEN GO TO ABORT ENDIF ENDIF ENDIF C C Now we will check for a login error if the symbol LOGIN_ERROR2 C is defined. If a login error occured, we will retry several times. C IF (GET_SYMBOL('LOGIN_ERROR2',LOGIN_ERROR,ESIZE)) THEN IF (ESIZE .GT. 0) THEN IF (FIND_SUBSTRING(LOGIN_ERROR(1:ESIZE),RDESC) .GT. 0) THEN LCOUNT = LCOUNT + 1 ! Count our retrys. IF (LCOUNT .NE. LTRYS) THEN GO TO 1000 ! Start 2nd login sequence again. ELSE GO TO ABORT ! Tell the user we're aborting. ENDIF ENDIF ENDIF ENDIF C C Now, we simply loop reading from the remote until we are idle. C The symbol AFTER_TMO can be defined to specify the timeout count C for the read function. The reason for this looping here is to C read any login messages which may be displayed after logging in. C 2400 IF (GET_SYMBOL('AFTER_TMO',AFTER_TMO,SIZE)) THEN IF (.NOT. CVT_DTB(AFTER_TMO(1:SIZE),ATMO)) GO TO ABORT ENDIF 2410 IF (READ_DATA(RBUFFER(1),.TRUE.,RDESC,ATMO)) GO TO 2410 RETURN C C Let the user know something went wrong. C 9900 CALL WRITE_USER(SS// 1 '*** Auto login aborted... ***'//SS) AUTO_LOGIN = .FALSE. ! Show we failed. RETURN END LOGICAL FUNCTION READ_DATA(BUFFER,ECHO_DATA,DESC,TMO) C C This routine reads the incoming data from the remote. C C Inputs: C BUFFER = buffer to read data into. C ECHO_DATA = logical to determine if received data C should be echoed at the terminal. C DESC = address of descriptor to fill in. C TMO = the initial read timeout. C C Outputs: C Returns failure if CTRL/C typed, the initial read C timed out, or on any system service or I/O error. C Otherwise, returns success with the descriptor filled C out with the buffer address and bytes read. C INCLUDE 'COM.INC/NOLIST' INCLUDE 'TTDEF.FOR/NOLIST' CHARACTER*(*) MODULE_NAME CHARACTER*32 IDLE_TMO PARAMETER (MODULE_NAME = 'READ_DATA') LOGICAL ECHO_DATA LOGICAL*1 BUFFER(1), BUFF(1) INTEGER*4 DESC(2), TMO, ITMO DATA ITMO /1/ ! Default idle timeout. READ_DATA = .FALSE. ! Presume failure. DESC(1) = 0 ! Initialize the count DESC(2) = %LOC(BUFFER) ! and the address. C C First we wait for a single character to be received to let us C know something is coming. If nothing is received in after the C TMO count, we presume somthing has gone wrong and return failure. C STATUS = SYS$QIOW(%VAL(REFN_IN),%VAL(RCHAN_IN), 1 %VAL(IO$_TTYREADALL + IO$M_NOECHO + IO$M_TIMED), 1 RIOSB,,,BUFFER(1),%VAL(1),%VAL(TMO),NOTERM,,) IF (CONTROLC_TYPED) RETURN ! Return if aborted. IF (.NOT. CHECK_STATUS(MODULE_NAME,STATUS)) RETURN STATUS = RIOSB(1) ! Copy the I/O status code. IF (.NOT. STATUS) THEN IF (STATUS .NE. SS$_TIMEOUT) THEN CALL CHECK_STATUS('MODULE_NAME',STATUS) ENDIF RETURN ENDIF C C The symbol IDLE_TMO can also be used to override the normal C read timeout count. The idle timeout is the amount of time C to wait between reading characters from the remote. C IF (GET_SYMBOL('IDLE_TMO',IDLE_TMO,SIZE)) THEN CALL CVT_DTB(IDLE_TMO(1:SIZE),ITMO) ELSE IF (BAUD_RATE .LT. TT$C_BAUD_1200) THEN ITMO = 2 ! Increase TMO at low speeds. ENDIF ENDIF C C After we get the first character, issue a read with a short C timeout to read any other characters that may be coming in. C The timeout is the time allowed between receiving characters. C STATUS = SYS$QIOW(%VAL(REFN_IN),%VAL(RCHAN_IN), 1 %VAL(IO$_TTYREADALL + IO$M_NOECHO + IO$M_TIMED), 1 RIOSB,,,BUFFER(2),%VAL(READ_SIZE-1),%VAL(ITMO),NOTERM,,) IF (CONTROLC_TYPED) RETURN ! We've been aborted. IF (.NOT. CHECK_STATUS(MODULE_NAME,STATUS)) RETURN STATUS = RIOSB(1) ! Copy the I/O status code. NBYTES = RIOSB(2) + 1 ! Copy the byte count (+1 for above). IF (.NOT. STATUS) THEN ! Timeout is only error expected. IF (STATUS .NE. SS$_TIMEOUT) THEN CALL CHECK_STATUS(MODULE_NAME,STATUS) RETURN ENDIF ENDIF C C Now strip the parity bit (if any) to prevent compare problems. C DO 300 I=1,NBYTES BUFFER(I) = BUFFER(I) .AND. "177 ! Strip the parity bit. 300 CONTINUE C C Display the data if requested. C IF (ECHO_DATA) 1 CALL WRITE_BUFFER(BUFFER(1),NBYTES) ! Echo received data. DESC(1) = NBYTES ! Fill in the byte count. C C Now convert the received data to uppercase. C CALL STR$UPCASE(DESC,DESC) ! Convert to uppercase. READ_DATA = .TRUE. ! Show we got some data. RETURN END SUBROUTINE WRITE_DATA(BUFF,SIZE) C C This routine is used to write data to the remote. It the C local echo flag is enabled, we also display it locally. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 BUFF(1) INTEGER*4 SIZE CALL WRITE_REMOTE(BUFF,SIZE) ! Write buffer to remote. IF (LOCAL_ECHO) THEN BUFF(SIZE+1) = CR ! Add a carriage return. CALL WRITE_BUFFER(BUFF,SIZE+1) ! Display locally also. ENDIF RETURN END SUBROUTINE WRITE_CTRL(BUFF,SIZE) C C This routine is used to convert and write a buffer to the remote. C Characters of the form "^char" to control character before the C buffer is written. C C Inputs: C BUFF - address of buffer to send. C SIZE - the buffer byte count. C C Outputs: C BUFF - converted to control characters. C SIZE - the new buffer size. C LOGICAL*1 BUFF(1) INTEGER*4 SIZE IF (SIZE .GT. 0) THEN CALL CVT_CTRL(BUFF,SIZE) ! Convert control characters. CALL WRITE_BYTE(BUFF,SIZE) ! Write buffer to the remote. ENDIF RETURN END