SUBROUTINE SSEND (ALIN) C C **************************************************************** C C KERMIT for the MODCOMP MAXIV operating system C C Compliments of: C C SETPOINT, Inc. C 10245 Brecksville Rd. C Brecksville, Ohio 44141 C C C KERMIT is a copyrighted protocol of Columbia Univ. The authors C of this version hereby grant permission to copy this software C provided that it is not used for an explicitly commercial C purpose and that proper credit be given. SETPOINT, Inc. makes C no warranty whatsoever regarding the accuracy of this package C and will assume no liability resulting from it's use. C C **************************************************************** C C Abstract: Send a file or group of files to a remote Kermit. C C C MODIFICATION HISTORY C C BY DATE REASON PROGRAMS AFFECTED C C **************************************************************** C C Author: Rick Burke Version: A.0 Date: Aug-86 C C Calling Parameters: C C R ALIN - Command line with name of file or group C of files to be sent. C C **************************************************************** C C Messages generated by this module : None C C **************************************************************** C C Subroutines called directly : ASSGN4, CTA4, ISCAN, ISHFT C PACK, POSUSL, READ4, REW4, C SENDSW, SKIPBL, WAIT, WEOF4 C C **************************************************************** C C Files referenced : None C C **************************************************************** C C Local variable definitions : C C A1 - Character pointer into ALIN C BEGENT - Index to 1st entry in directory sector C BKPTR - Pointer to previous sector C CH - UFT number for directory reads C ERR - Error indicator for CTA4 C FILEOK - Success flag from POSUSL, file was found C FRPTR - Forward pointer to next directory sector C I - Index variable C IDX - Index variable C IND - Error indicator from WAIT call C JUSL - CAN code of directory name to be sent to C the remote Kermit C MXENT - Number of directory entries per sector C SCRLUN - LUN of file for file name list C SCRUFT - UFT number of file to be used for temporary C storage of file names to be sent to remote C SECTOR - Directory partition file position index to read C STATUS - Function value returned by SENDSW C TCOUNT - Index variable C X - Dummy argument required by SENDSW function C DIRBUF(128) - Buffer for directory sector C DIRNAM(132) - Buffer for ASCII name of directory to send C ENTRY(9,14) - Table of directory entries for a sector C FILNME(4) - ASCII file name (packed 2 chars per word) C TLINE(12) - File name buffer (unpacked ASCII) C C **************************************************************** C C Commons referenced : KER, KERPAR, and UFTTBL local commons C C **************************************************************** C C (*$END.DOCUMENT*) C C **************************************************************** C * * C * D I M E N S I O N S T A T E M E N T S * C * * C **************************************************************** C IMPLICIT INTEGER (A-Z) INTEGER*2 ALIN(1), DIRNAM(132), ENTRY(9,14), DIRBUF(128) INTEGER*2 FILNME(4), TLINE(12) C C **************************************************************** C * * C * T Y P E S T A T E M E N T S * C * * C **************************************************************** C LOGICAL*2 FILEOK C C **************************************************************** C * * C * C O M M O N S T A T E M E N T S * C * * C **************************************************************** C INCLUDE USL/KERCOM INCLUDE USL/KERPMC INCLUDE USL/UFTTBC C C **************************************************************** C * * C * E Q U I V A L E N C E S T A T E M E N T S * C * * C **************************************************************** C EQUIVALENCE (DIRBUF(1),BKPTR), (DIRBUF(2),FRPTR) EQUIVALENCE (DIRBUF(3),ENTRY(1,1)) C C **************************************************************** C * * C * D A T A S T A T E M E N T S * C * * C **************************************************************** C DATA MXENT /14/, SCRUFT / 9/ C C **************************************************************** C C Code starts here : C C-----> If we're in HOST mode, issue binary READ. C IF (HOSTON .NE. YES) GO TO 5 CURCHN = 1 CALL READ4 (IUFT(1,4),BLIN(1,CURCHN),132,.FALSE.) 5 CONTINUE C C-----> Initialize the logical unit for the file name list. C SCRLUN = IUFT(2,SCRUFT) C C-----> Position character pointer to start of file specification. C A1 = 1 CALL SKIPBL(ALIN,A1) IF (ALIN(A1) .NE. LF) GO TO 10 WRITE (LOCALO,1000) 1000 FORMAT (' PROPER FORMAT IS "SEND FILENAME" OR ',/ > ' "SEND @FILENAME"') RETURN 10 CONTINUE C C-----> Check for "@" as next character. If so then the request is C-----> to send an entire directory of files. C IF (ALIN(A1) .NE. ATSIGN) GO TO 90 A1 = A1 + 1 C C-----> Extract the directory name from the command line and C-----> convert it to CAN code. C DIRNAM(1) = 4Z2020 DIRNAM(2) = 4Z2020 DIRNAM(3) = 4Z2020 CALL PACK (ALIN(A1),DIRNAM) JUSL = ISCAN (DIRNAM) C C-----> Set up the UFT for reading the directory. C CH = 7 IUFT(3,CH) = 4Z9400 CALL ASSGN4 (IUFT(1,CH),JUSL) C C-----> Rewind the scratch file that will contain the names of the C-----> files to be sent. C CALL REW4 (IUFT(1,SCRUFT)) C C-----> Read a directory and put the file names into the scratch file. C FRPTR = 0 20 CONTINUE IUFT(4,CH) = FRPTR SECTOR = FRPTR CALL READ4 (IUFT(1,CH),DIRBUF,256) IF (SECTOR .NE. 0) GO TO 30 C C-----> Was the directory found? C IF (BKPTR .EQ. -1) GO TO 30 WRITE (1,1010) (DIRNAM(I),I=1,4) 1010 FORMAT (' DIRECTORY NOT FOUND ON ',3A2) RETURN C C-----> Loop through this sector to find a file entry. C 30 CONTINUE BEGENT = 1 IF (SECTOR .EQ. 0) BEGENT = 2 DO 40 IDX=BEGENT,MXENT IF (ENTRY(1,IDX) .NE. 0 .AND. > ENTRY(1,IDX) .NE. 4ZFEFE ) GO TO 50 40 CONTINUE C C-----> Entry not found, go read the next sector unless this C-----> sector was the last (FRPTR = -1). C IF (FRPTR .LT. 0) GO TO 80 GO TO 20 50 CONTINUE IF (ENTRY(1,IDX) .EQ. 4ZFFFF) GO TO 80 IF (ENTRY(1,IDX) .EQ. 0 .OR. > ENTRY(1,IDX) .EQ. 4ZFEFE ) GO TO 75 C C-----> Got a file entry, so convert the file C-----> name into the unpacked ASCII string for C-----> DPUTLIN. C CALL CTA4 (ENTRY(1,IDX),TLINE(1),ERR) CALL CTA4 (ENTRY(2,IDX),TLINE(4),ERR) CALL CTA4 (ENTRY(3,IDX),TLINE(7),ERR) DO 55 I=1,9 TLINE(I) = ISHFT (TLINE(I),-8) 55 CONTINUE C C-----> Remove trailing blanks. C DO 60 I=1,9 TCOUNT = 10 - I IF (TLINE(TCOUNT) .NE. 0 .AND. > TLINE(TCOUNT) .NE. BLANK ) GO TO 70 60 CONTINUE TCOUNT = 0 70 CONTINUE C C-----> Add CR/EOS at the end. C TLINE(TCOUNT+1) = LF TLINE(TCOUNT+2) = EOS C C-----> Write the file name out to the scratch file. C FILNME(1) = ' ' FILNME(2) = ' ' FILNME(3) = ' ' FILNME(4) = ' ' CALL PACK (TLINE,FILNME) WRITE (SCRLUN,1050) FILNME 1050 FORMAT (4A2) 75 CONTINUE C C-----> Loop back to get another file name. C IDX = IDX + 1 IF (IDX .LE. MXENT) GO TO 50 GO TO 20 80 CONTINUE C C-----> Write an EOF after the last name in the scratch partition. C CALL WEOF4 (IUFT(1,SCRUFT)) GO TO 110 90 CONTINUE C C-----> Write the file name in the command line to the scratch C-----> partition. C C-----> First, try to position to the file. C CH = 7 CALL ASSGN4 (IUFT(1,CH),SUSL) FILNME(1) = ' ' FILNME(2) = ' ' FILNME(3) = ' ' FILNME(4) = ' ' CALL PACK (ALIN(A1),FILNME) CALL POSUSL (IUFT(2,CH),FILNME,FILEOK) IF (FILEOK) GO TO 100 WRITE (LOCALO,1020) 1020 FORMAT (' REQUESTED SOURCE FILE NOT FOUND.',//) RETURN 100 CONTINUE C C-----> Put the file name at the beginning of the scratch. C CALL REW4 (IUFT(1,SCRUFT)) WRITE (SCRLUN,1050) FILNME CALL WEOF4 (IUFT(1,SCRUFT)) 110 CONTINUE C C-----> Send the file(s) to the remote Kermit. C CALL REW4 (IUFT(1,SCRUFT)) CALL WAIT (DELAY,2,IND) STATUS = SENDSW (X) IF (STATUS .EQ. YES) WRITE (LOCALO,1030) 1030 FORMAT (' FILE TRANSFER COMPLETED.',//) IF (STATUS .NE. YES) WRITE (LOCALO,1040) 1040 FORMAT (' FILE TRANSFER FAILED.',//) RETURN END