LOGICAL FUNCTION GET_VAXFILE(FILE) C C This function is used to get the file name of the file C on the VAX and then open it for either read or write. C C Inputs: C FILE - string descriptor with the file name (if any). C INCLUDE 'COM.INC/NOLIST' INCLUDE '($RMSDEF)/NOLIST' LOGICAL NEXT_VAXFILE, OPEN_CMDFILE CHARACTER*(*) FILE, VAXQ, MODULE_NAME PARAMETER (MODULE_NAME = 'GET_VAXFILE') PARAMETER (VAXQ = 'Enter the name of the VAX file: ') ASSIGN 100 TO VAX_PROMPT GET_VAXFILE = .FALSE. ! Initialize to bad return. C C If we were passed a file name, use it. C IF (LEN(FILE) .GT. 0) THEN VAX_FILE = FILE ! Copy the file name VSIZE = LEN(FILE) ! and the file size. GO TO 200 ! Go try to open it. ENDIF C C Get the name of the file on the VAX. C 100 IF (CONTROLC_TYPED) RETURN ! Abort VAX file prompt. CALL PROMPT_USER(VAXQ,%REF(VAX_FILE),LEN(VAX_FILE)) IF (BACKUP .OR. LIOSB(1) .NE. SS$_NORMAL) THEN IF (.NOT. DUMP_MODE) CALL SEND_CAN ! Tell remote to abort. RETURN ENDIF IF (WANTS_HELP) THEN IF (FLOW .EQ. TO_VAX) THEN CALL GET_HELP('GET VAX') ! Send a file to the VAX. ELSE CALL GET_HELP('SEND VAX') ! Send a file to the REMOTE. ENDIF GO TO VAX_PROMPT ENDIF VSIZE = LBYTE_COUNT ! Copy the byte count. C C Sending a file to the remote. C C Vaxnet> SEND vax_file remote_file C 200 IF (FLOW .EQ. TO_VAX) GO TO 500 ! Send a file to the VAX. IF (VSIZE .EQ. 0) GO TO VAX_PROMPT ! Must specify a file name. C C Check for command file input. C CMD_MODE = .FALSE. ! Presume no command files. IF (VAX_FILE(1:1) .EQ. '@') THEN IF (.NOT. OPEN_CMDFILE(VAX_FILE, VSIZE)) THEN GO TO VAX_PROMPT ELSE GO TO 400 ! Go open the file. ENDIF ENDIF C C Look up the VAX file name specified. C 300 IF (.NOT. FIND_FILE (VAX_FILE, VSIZE)) THEN GO TO VAX_PROMPT ! Prompt for file name again. ENDIF C C Open the file for read. C 400 OPEN (UNIT=FILE_UNIT, TYPE='OLD', READONLY, SHARED, 1 FILE=VAX_FILE(1:VSIZE), ERR=9900) GET_VAXFILE = .TRUE. ! Return success. RETURN C C Getting a file from the REMOTE. C C Vaxnet> GET remote_file vax_file C 500 IF ( (VSIZE .EQ. 0) .OR. (VAX_FILE(1:1) .EQ. '*') ) THEN VAX_FILE = REMOTE_FILE(1:RSIZE) ! Copy the remote file name. VSIZE = RSIZE ! And the remote file size. ENDIF C C Open the file for write. C OPEN (UNIT=FILE_UNIT, TYPE='NEW', NAME=VAX_FILE(1:VSIZE), 1 RECORDSIZE=OUT_SIZE, CARRIAGECONTROL='LIST', 1 BUFFERCOUNT=2, ERR=9900) GET_VAXFILE = .TRUE. ! Return success. RETURN 9900 CALL RMS_ERROR (MODULE_NAME) ! Report the RMS error. 9910 IF (VAX_WILD .OR. CMD_MODE) THEN CALL REPORT_VAXFILE() ! Report the VAX file name. IF (FIND_NEXT (VAX_FILE, VSIZE)) THEN GO TO 400 ! Try to open this file. ENDIF IF (NEXT_CMDFILE (VAX_FILE, VSIZE)) THEN GO TO 400 ! Try to open this file. ENDIF ENDIF GO TO VAX_PROMPT ! Request file name again. END LOGICAL FUNCTION NEXT_VAXFILE C C This routine is used to find the next file when wildcards are active. C INCLUDE 'COM.INC/NOLIST' INCLUDE '($RMSDEF)/NOLIST' CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = 'NEXT_VAXFILE') LOGICAL FIND_NEXT, NEXT_CMDFILE NEXT_VAXFILE = .FALSE. ! Presume no more files. 100 IF (CONTROLC_TYPED) RETURN ! Abort further lookups. C C Check for more wildcards first. C IF (FIND_NEXT (VAX_FILE, VSIZE)) THEN GO TO 200 ! Try to open this file. ENDIF C C Now check for command file input. C IF (NEXT_CMDFILE (VAX_FILE, VSIZE)) THEN GO TO 200 ! Try to open this file. ENDIF RETURN ! Return failure. C C We have another file, open it for read. C 200 OPEN (UNIT=FILE_UNIT, TYPE='OLD', READONLY, SHARED, 1 FILE=VAX_FILE(1:VSIZE), ERR=9900) NEXT_VAXFILE = .TRUE. ! Return success. RETURN 9900 CALL RMS_ERROR (MODULE_NAME) ! Report the RMS error. 9910 IF (VAX_WILD .OR. CMD_MODE) THEN CALL REPORT_VAXFILE() ! Report the VAX file name. GO TO 100 ! Try the next file name. ENDIF RETURN END INTEGER FUNCTION FIND_FILE (FILE,SIZE) C C This function is used to lookup a file spec containing wildcards. C C Inputs: C FILE - The file spec to lookup. C SIZE - The file spec size. C C Outputs: C Any error from LIB$FIND_FILE. C INCLUDE 'COM.INC/NOLIST' INCLUDE '($RMSDEF)/NOLIST' CHARACTER*(*) FILE, MODULE_NAME CHARACTER*128 FILE_NAME PARAMETER (MODULE_NAME = 'FIND_FILE') LOGICAL WILD_CARDS INTEGER FIND_CONTEXT, FILE_SIZE, SIZE, DFLAG, SON FILE_NAME = FILE(1:SIZE) ! Copy the file specification. FILE_SIZE = SIZE ! Copy the file size. FIND_CONTEXT = 0 ! Initialize the file context. VAX_WILD = WILD_CARDS(FILE(1:SIZE)) ! Set the wildcards flag. C C Set flag to determine if device and/or directory is specified. C DFLAG = INDEX (FILE(1:SIZE), ':') IF (DFLAG .EQ. 0) THEN DFLAG = INDEX (FILE(1:SIZE), '[') ENDIF GO TO 100 ! Go find the specified file(s). ENTRY FIND_NEXT (FILE, SIZE) C C Find the first/next file name. C FIND_NEXT = RMS$_NMF ! Initialize to "No more files" IF (.NOT. VAX_WILD) RETURN ! Wildcards are not active. 100 STATUS = LIB$FIND_FILE (FILE_NAME(1:FILE_SIZE), FILE, FIND_CONTEXT) FIND_NEXT = STATUS ! Pass back the status. C C If no device/directory was specified (i.e., *.COM) then pass back C only the file name, otherwise pass back the entire file name. C SIZE = INDEX (FILE, ' ') - 1 ! End of expanded file name. IF (DFLAG .EQ. 0) THEN SON = INDEX (FILE(1:SIZE), ']') + 1 ! Start of the file name. FILE = FILE(SON:SIZE) ! Copy only the file name. SIZE = (SIZE - SON) + 1 ! Calculate the file name size. ENDIF C C Return the file name size minus the spaces it's padded with. C SIZE = INDEX (FILE, ' ') - 1 ! Return the file name size. IF (.NOT. STATUS) THEN IF (STATUS .NE. RMS$_NMF) THEN CALL CHECK_STATUS (MODULE_NAME, STATUS) IF (VAX_WILD .OR. CMD_MODE) THEN CALL REPORT_VAXFILE() ! Report the VAX file name. IF (VAX_WILD) THEN IF (STATUS .EQ. RMS$_PRV) THEN GO TO 100 ! Next file on privilege violation. ENDIF ENDIF ENDIF ELSE VAX_WILD = .FALSE. ! Wildcards are no longer active. ENDIF ENDIF RETURN END LOGICAL FUNCTION WILD_CARDS (FILE_SPEC) C C This routine is used to scan the file specification for wildcard C characters and returns .TRUE. if any are found. C IMPLICIT NONE CHARACTER*(*) FILE_SPEC INTEGER INDEX IF (INDEX (FILE_SPEC, '*') .GT. 0) THEN WILD_CARDS = .TRUE. ! Show wildcards in the file name. ELSEIF (INDEX (FILE_SPEC, '%') .GT. 0) THEN WILD_CARDS = .TRUE. ! Show wildcards in the file name. ELSEIF (INDEX (FILE_SPEC, '...') .GT. 0) THEN WILD_CARDS = .TRUE. ! Show wildcards in the file name. ELSE WILD_CARDS = .FALSE. ! Show no wildcards specified. ENDIF RETURN END LOGICAL FUNCTION GET_REMFILE (FILE) C C This function is used to get/open the file name on the remote. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 CODE(1) LOGICAL GET_RESPONSE, WILD_CARDS, SEND_REMFILE CHARACTER*(*) DIRQ, REMQ, FILE PARAMETER (REMQ = 'Enter the name of the REMOTE file: ') PARAMETER (DIRQ = 'Enter the name of the REMOTE directory: ') GET_REMFILE = .FALSE. ! Initialize to bad return. ASSIGN 100 TO REMOTE_PROMPT C C If we were passed a file name, use it. C IF (LEN(FILE) .GT. 0) THEN TEMP_FILE = FILE ! Copy the file name TSIZE = LEN(FILE) ! and the file size. GO TO 200 ! Go try to open it. ENDIF C C Get name of file on VAX. C 100 IF (VAX_WILD) THEN CALL PROMPT_USER (DIRQ, %REF(TEMP_FILE), LEN(TEMP_FILE)) ELSE CALL PROMPT_USER (REMQ, %REF(TEMP_FILE), LEN(TEMP_FILE)) ENDIF IF (BACKUP .OR. LIOSB(1) .NE. SS$_NORMAL) THEN CALL SEND_CAN() ! Tell remote to exit. RETURN ENDIF IF (WANTS_HELP) THEN IF (FLOW .EQ. TO_VAX) THEN CALL GET_HELP('GET REMOTE') ! Send a file to the VAX. ELSE CALL GET_HELP('SEND REMOTE') ! Send a file to REMOTE. ENDIF GO TO REMOTE_PROMPT ENDIF TSIZE = LBYTE_COUNT ! Copy the byte count. C C Sending a file to the remote. C C Vaxnet> SEND vax_file remote_file C 200 IF (FLOW .EQ. TO_VAX) GO TO 500 ! Sending a file to the VAX. CALL MAKE_FILENAME (VAX_FILE(1:VSIZE), TEMP_FILE(1:TSIZE), 1 REMOTE_FILE, RSIZE) GO TO 1000 ! Send the file to the remote. C C Getting a file from the REMOTE. C C Vaxnet> GET remote_file vax_file C 500 IF (TSIZE .EQ. 0) GO TO REMOTE_PROMPT ! Must specify a file name. REMOTE_FILE = TEMP_FILE(1:TSIZE) ! Copy the remote file name. RSIZE = TSIZE ! And the remote file size. REMOTE_WILD = WILD_CARDS(REMOTE_FILE(1:RSIZE)) ! Set wildcards flag. C C Send the file to the remote system. C 1000 IF (.NOT. SEND_REMFILE (REMOTE_FILE(1:RSIZE))) THEN GO TO REMOTE_PROMPT ! Failure on remote file. ENDIF GET_REMFILE = .TRUE. ! Show remote file is open. RETURN END LOGICAL FUNCTION NEXT_REMFILE C C This routine sends the next file specification to the remote C if VAX wildcards are active. C INCLUDE 'COM.INC/NOLIST' LOGICAL NEXT_VAXFILE, SEND_REMFILE NEXT_REMFILE = .FALSE. ! Presume no more files. IF (NEXT_VAXFILE()) THEN ! Another VAX file found. CALL MAKE_FILENAME (VAX_FILE(1:VSIZE), TEMP_FILE(1:TSIZE), 1 REMOTE_FILE, RSIZE) IF (SEND_REMFILE (REMOTE_FILE(1:RSIZE))) THEN NEXT_REMFILE = .TRUE. ! We have another file to send. ENDIF ENDIF RETURN END SUBROUTINE MAKE_FILENAME (IFILE, TFILE, OFILE, OSIZE) C C Make the file name to for the VAX/REMOTE system. C C If we're sending to the remote, we only send the file name if C if no remote file name is given. For wildcards, we do: C C or * - Use the input file name only. C [*], [*...], [*,*] - Use the [directory] and file name. Anything C before the [*] is appended to the file name. C [directory...] - Replace top VAX directory with specified. C device:[directory] - Else append the file name to specified directory. C C Inputs: C IFILE = The input file specification. C TFILE = The output file specification. C C Outputs: C OFILE = The output file name. C OSIZE = The output file size. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) IFILE, TFILE, OFILE INTEGER ISIZE, OSIZE INTEGER SOD, EOD, SON, EON, SOS, TSOD, TEOD, TDOT C C Setup pointers to the input files' directory and file name. C ISIZE = LEN(IFILE) ! Size of input file. SOD = INDEX (IFILE, '[') ! Start of the directory EOD = INDEX (IFILE, ']') ! End of the directory. SON = EOD + 1 ! Start of the file name. EON = INDEX (IFILE, ';') - 1 ! End of the file name. IF (EON .LT. 0) EON = ISIZE ! Point to end of file name. SOS = INDEX (IFILE(1:EOD), '.') ! Start of sub-directory. IF (SOS .EQ. 0) SOS = EOD ! Point to end of directory. C C Setup pointers to the temp files' directory (if any). C TSIZE = LEN(TFILE) ! Size of temporary file. TSOD = INDEX (TFILE, '[') ! Start of the directory. TEOD = INDEX (TFILE, ']') ! End of the directory. TDOT = INDEX (TFILE, '...') - 1 ! Start of dots. IF ( (TSIZE .EQ. 0) .OR. (TFILE .EQ. '*') ) THEN OFILE = IFILE(SON:EON) ! Copy the file name. OSIZE = (EON - SON) + 1 ! Setup the file size. ELSEIF (TFILE(TSOD:TSOD+1) .EQ. '[*') THEN OSIZE = 0 IF (TSOD .GT. 1) THEN OFILE = TFILE(1:TSOD-1) ! Copy anything before "[". OSIZE = TSOD - 1 ! Setup the initial size. ENDIF OFILE(OSIZE+1:) = IFILE(SOD:EON) ! Copy directory/name. OSIZE = OSIZE + (EON - SOD) + 1 ! Setup the file size. ELSEIF (TDOT .GT. 0) THEN OFILE = TFILE(1:TDOT)//IFILE(SOS:EON) ! Generate the file name. OSIZE = TDOT + (EON - SOS) + 1 ! Calculate the file size. ELSE C C If wildcards are active or only an output directory was specified, C then append the input file name to the device/directory. C IF ( VAX_WILD .OR. (TEOD .EQ. TSIZE) ) THEN OFILE = TFILE//IFILE(SON:EON) ! Append the file name. OSIZE = TSIZE + (EON - SON) + 1 ! Setup the file size. ELSE OFILE = TFILE ! Use the specified name. OSIZE = TSIZE ! Setup the file size. ENDIF ENDIF RETURN END LOGICAL FUNCTION SEND_REMFILE (FILE) C C This routine is used to send the remote a file name and to get C its' ressponse. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) FILE LOGICAL*1 CODE(1) SEND_REMFILE = .TRUE. ! Presume success. CALL WRITE_REMOTE (%REF(FILE), LEN(FILE)) CALL GET_RESPONSE (CODE, .FALSE.) ! Get response from remote. IF (CODE(1) .EQ. CAN) RETURN ! Cancel the transmission. IF (CODE(1) .NE. ACK) THEN IF (FLOW .EQ. TO_VAX) THEN ! Couldn't open input file. CALL WRITE_USER (SS// 1 '*** Error on remote input file "'//FILE//'" ***'//BELL//SS) ELSE ! Couldn't open output file. CALL WRITE_USER (SS// 1 '*** Error on remote output file "'//FILE//'" ***'//BELL//SS) ENDIF SEND_REMFILE = .FALSE. ! Show failure. ENDIF RETURN END LOGICAL FUNCTION OPEN_CMDFILE (FILE, SIZE) C C This routine is used to open a command file, and read the first C record into the VAX_FILE buffer for normal file open. C C Inputs: C FILE = The name of the command file (plus the @ sign). C C Outputs: C FILE = The file name from the command file. C SIZE = The size of the file name. C INCLUDE 'COM.INC/NOLIST' INCLUDE '($RMSDEF)/NOLIST' CHARACTER*(*) MODULE_NAME, FILE PARAMETER (MODULE_NAME = 'OPEN_CMDFILE') LOGICAL FIND_FILE, FIND_NEXT INTEGER SIZE OPEN_CMDFILE = .FALSE. ! Presume no command file. C C If the command file is open, close it first. C IF (CMD_MODE) THEN CLOSE (UNIT=CMD_UNIT) ! Close the command file. ENDIF CMD_FILE = FILE(2:SIZE) ! Copy the command file name. CMD_SIZE = SIZE - 1 ! Setup the comand file size. CMD_MODE = .FALSE. ! Show not in a command file. C C Append a .COM extension if none was specified. C SON = INDEX (FILE, ']') + 1 ! Point to start of file name. IF (INDEX (FILE(SON:CMD_SIZE), '.') .EQ. 0) THEN CMD_FILE = CMD_FILE(1:CMD_SIZE)//'.COM' ! Append the extension. CMD_SIZE = CMD_SIZE + 4 ! Adjust the file name size. ENDIF C C Open the command file for input. C OPEN (UNIT=CMD_UNIT, TYPE='OLD', READONLY, SHARED, 1 FILE=CMD_FILE(1:CMD_SIZE), ERR=9900) CMD_MODE = .TRUE. ! Show a command file is open. ENTRY NEXT_CMDFILE (FILE, SIZE) C C Read the a record from the command file. C NEXT_CMDFILE = .FALSE. ! Presume no more files. IF (.NOT. CMD_MODE) RETURN ! We're not in command mode. 100 READ (CMD_UNIT, 200, END=500, ERR=9900) SIZE, FILE 200 FORMAT (Q,A) IF (SIZE .EQ. 0) GO TO 100 ! Read another record. IF ( (FILE(1:1) .EQ. '!') .OR. (FILE(1:1) .EQ. ';') ) THEN GO TO 100 ! This is a comment line. ENDIF SIZE = INDEX (FILE, ' ') - 1 ! Adjust for trailing spaces. C C Try to find the VAX file. C 300 IF (CONTROLC_TYPED) GO TO 500 ! Go close the command file. STATUS = FIND_FILE (FILE, SIZE) ! Try to find the VAX file. IF (.NOT. STATUS) THEN IF (STATUS .NE. RMS$_FNF) THEN IF (VAX_WILD) THEN IF (FIND_NEXT (FILE, SIZE)) THEN GO TO 400 ! Found the next wildcard. ENDIF ENDIF IF (STATUS .NE. RMS$_NMF) THEN GO TO 500 ! Must be a bad command file. ENDIF ENDIF GO TO 100 ! Read the next file name. ENDIF 400 NEXT_CMDFILE = .TRUE. ! Return success. RETURN C C Here for end of file. C 500 CLOSE (UNIT=CMD_UNIT) ! Close the command file. CMD_MODE = .FALSE. ! Show not in command mode. RETURN 9900 CALL RMS_ERROR (MODULE_NAME) ! Report the RMS error. RETURN END SUBROUTINE RMS_ERROR (MODULE) C C This routine is called to report an RMS error. C C CALL ERRSNS(num,rmssts,rmsstv,iunit,) C C Where: num = fortran error code, C rmssts = RMS completion status code. C rmsstv = RMS status code. C iunit = logical unit number. C IMPLICIT NONE INTEGER*4 FERR, RMSSTS, RMSSTV, LUN, CHECK_STATUS, ERROR CHARACTER*(*) MODULE CALL ERRSNS (FERR,RMSSTS,RMSSTV,LUN,) ! Get the last error code. ERROR = RMSSTS ! Copy the RMS error code. IF (ERROR .EQ. 0) ERROR = FERR ! Use the FORTRAN error code. CALL CHECK_STATUS (MODULE, ERROR) ! Go report the error message. RETURN END