LOGICAL FUNCTION SCRIPT_FILE (FILES) C C This routine is used to read a script file which contains C special commands used to driving a remote interactive session. C INCLUDE 'COM.INC/NOLIST' LOGICAL GET_VAXFILE, NEXT_VAXFILE, FSS, PARSE_CMD CHARACTER*(*) FILES CHARACTER*80 WAIT_STR INTEGER*4 B, S, E, WAIT_SIZE, RETRYS DATA WAIT_SIZE /0/ ASSIGN 9910 TO ABORT ! Go here to abort. SCRIPT_FILE = .FALSE. ! Initialize to bad return. CALL REENABLE() ! Enable CTRL/C AST's. C C Parse the file names (if any). C B = 1 ! Start at first character. CALL PARSE_CMD (FILES,B,S,E) ! Parse the file name (if any). IF (.NOT. GET_VAXFILE (FILES(S:E))) THEN RETURN ! No VAX files were opened. ENDIF C C Ready to start the script file. C CALL REPORT_HOWTO() ! Tell user how to abort. CALL INIT_TIMER() ! Initialize the timer. 100 IF (CONTROLC_TYPED) GO TO ABORT ! If aborted, clean up and return. READ (FILE_UNIT, 110, END=9900) RBYTES, (XBUFFER(I),I=1,RBYTES) 110 FORMAT (Q, A1) XDESC(2) = %LOC(XBUFFER) ! Fill descriptor with address. XDESC(1) = RBYTES ! and the byte count. C C If the first character is a period (.), we presume this is a C script command. The only script command currently implemented C is the .WAIT string. C IF (XBUFFER(1) .EQ. '.') THEN IF (WAIT_CMD (XDESC, WAIT_STR, WAIT_SIZE)) GO TO 100 ENDIF C C If the first character is an up arrow (^) convert character to C a control character. Otherwise, we append a carraige return. C IF (XBUFFER(1) .EQ. '^') THEN CALL CVT_CTRL (XBUFFER(1), RBYTES) ELSE RBYTES = RBYTES + 1 ! Adjust the byte count. XBUFFER(RBYTES) = CR ! Append a carriage return. ENDIF XDESC(1) = RBYTES ! Fill descriptor with count. C C Now we write the buffer to the remote without waiting for the C write to complete so we can fall though and start our read. C STATUS = SYS$QIO (%VAL(REFN_OUT),%VAL(RCHAN_OUT), 1 %VAL(IO$_WRITELBLK + IO$M_NOFORMAT), 1 XIOSB,,,XBUFFER,%VAL(RBYTES),,,,) CALL CHECK_STATUS ('SCRIPT_WRITE', STATUS) C C Now, we read the output from the remote system. The READ_DATA C routine returns failure if the initial read timed out, if any C system service fails, or if the user typed CTRL/C to abort. C C If a wait string has been specified, we loop until either the C wait string is found, or until the remote has become idle. If C the wait string is not found, we try reading from the remote C up to the retry limit. C C If no wait string was specified, then we wait until the remote C system has become idle and then send the next record. C RETRYS = 0 ! Initialize the retry count. 200 IF (CONTROLC_TYPED) GO TO ABORT ! Stop sending if we were aborted. IF (READ_DATA (RBUFFER(1), .TRUE., RDESC, SCRIPT_TIMEOUT)) THEN IF (WAIT_SIZE .GT. 0) THEN IF (FSS (WAIT_STR(1:WAIT_SIZE), RDESC)) THEN GO TO 100 ! Read the next input line. ENDIF ENDIF GO TO 200 ! Loop until we're idle. ELSE IF (WAIT_SIZE .GT. 0) THEN ! Retry if wait string specified. RETRYS = RETRYS + 1 ! Adjust the retry count. IF (RETRYS .NE. SCRIPT_RETRYS) THEN GO TO 200 ! Go read from the remote again. ENDIF ENDIF ENDIF CALL SYS$WAITFR (%VAL(REFN_OUT))! Wait for the write to complete. IF (CONTROLC_TYPED) GO TO ABORT ! Stop sending if we were aborted. GO TO 100 ! Go read the next input record. C C Here for EOF on the input file. C 9900 IF (WATCH_FILES) THEN CALL WRITE_USER ('*** Scripting of file "'// 1 VAX_FILE(1:VSIZE)//'" is complete. ***'//SS) ENDIF 9910 CLOSE (UNIT=FILE_UNIT) ! Close the VAX file. C C Let the user know we detected their CTRL/C to abort. C IF (CONTROLC_TYPED) THEN CALL WRITE_USER ('*** Scripting of file "'//VAX_FILE(1:VSIZE)// 1 '" has been aborted. ***'//SS) GO TO 9999 ! Finish up ... ENDIF C C Check for another input file. C IF (NEXT_VAXFILE()) THEN GO TO 100 ! Go dump this file. ENDIF C C Check for another file to dump. C IF ( PARSE_CMD (FILES,B,S,E) ) THEN IF (GET_VAXFILE (FILES (S:E))) THEN GO TO 100 ! Go process this file. ENDIF ENDIF SCRIPT_FILE = .TRUE. ! Show success. 9999 CALL ELAPSED_TIME ! Display the elapsed time. RETURN END LOGICAL FUNCTION WAIT_CMD (CMD, WBUF, WSIZ) C C This routine is used to setup the wait for string for the .WAIT C command. C C Inputs: C CMD = The command line buffer. C WBUF = Buffer to store the wait string (if any). C WSIZ = The size of the wait string. C C Outputs: C Returns .FALSE. if no wait string specified. C CHARACTER*(*) CMD, WBUF, SS PARAMETER (SS = CHAR(13)//CHAR(10)) LOGICAL PARSE_CMD INTEGER*4 WSIZ, B, E, S WSIZ = 0 ! Presume no wait string. WAIT_CMD = .FALSE. ! Initialize the return status. IF (CMD(1:2) .NE. '.W') RETURN WAIT_CMD = .TRUE. ! Show wait command was found. C C Use the command parsing routine to find the beginning of the C wait string. This routine uses a space as the delimiter. C B = 3 ! Starting command position. IF ( .NOT. PARSE_CMD (CMD,B,S,E) ) THEN RETURN ! Return if no delimiter found. ENDIF WSIZ = (LEN(CMD) - S) + 1 ! Calculate the string size. WBUF(1:WSIZ) = CMD(S:LEN(CMD)) ! Copy the wait for string. C C *** Debug code *** C C CALL WRITE_USER (SS//'Wait string = '//WBUF(1:WSIZ)//SS) CALL CVT_CTRL (%REF(WBUF), WSIZ) RETURN END