-+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+ Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for/nolist' X X`09character*(*) module_name X X`09integer data_size,data_index,checksum_index X`09parameter (module_name = 'get_xmodem') XC`09parameter (data_size = 128)`09`09! Number of data bytes. X`09parameter (data_index = 4)`09`09! Index to 1st data byte. X`09parameter (checksum_index = 132)`09! Index to checksum byte. X`09logical report_error, received_eof,crc X`09integer i, index, size, read_byte X`09integer block_expected, previous_block, block_comp, checksum, rec_size X`09integer xmodem_checksum X`09integer high,low X`09byte highbyte,lowbyte X`09common /crcval/high,low X`09equivalence (high,highbyte) X`09equivalence (low,lowbyte) X X`09get_xmodem = .false.`09`09`09! Initialize to bad return. X`09data_size = 128`09`09`09`09! Initialize to standard Xmodem X X`09block_expected = 1`09`09`09! Initialize the block number. X`09previous_block = block_expected`09`09! Initialize the previous block. X`09received_eof = .false.`09`09`09! Initialize the EOF flag. X`09rec_size = 0`09`09`09`09! Initialize the record size. X`09error_count = 0 X Xc`09Synchronize with remote XMODEM and determine if the transfer is Xc`09to be CRC or checksum. Try CRC for 3 times before giving up and Xc`09using checksum. X X`09crc = .true.`09`09`09!Assume CRC until proven otherwise X 0010`09call send_c X`09rbuffer(1) = read_byte (10)`09`09! Read the first byte. X`09if (liosb(1) .ne. ss$_normal) then X`09 error_count = error_count + 1 X`09 if (error_count.gt.4) then X`09`09error_count = 0 X`09`09go to 99 X`09`09end if X`09 go to 10 X`09 end if X`09if (rbuffer(1) .eq. eot) then X`09 go to 700`09`09`09`09! End of transmission. X`09else if (rbuffer(1) .eq. soh) then X`09 data_size = 128 X`09 go to 101`09`09`09`09! Standard Xmodem X`09else if (rbuffer(1) .eq. stx) then X`09 data_size = 1024 X`09 go to 101`09`09`09`09! Ymodem variant X`09else X`09 go to 10 X`09end if X Xc`09CRC failed, try for checksum X X 0099`09continue X`09crc = .false. X`09call send_nak()`09`09`09! Send NAK to synchronize. X Xc`09Loop, waiting for the first byte from the remote. Xc Xc`09We expect an SOH, STX, or EOT byte at this point. X X X 0100`09continue X`09rbuffer(1) = read_byte (10)`09`09! Read the first byte. X`09if (liosb(1) .ne. ss$_normal) go to 600 ! Report error/NAK. X`09 X`09if (rbuffer(1) .eq. soh) then X`09 data_size = 128 X`09else if (rbuffer(1) .eq. stx) then X`09 data_size=1024 X`09else if (rbuffer(1) .eq. eot) then X`09 go to 700`09`09`09`09! End of transmission. X`09else X`09 go to 100`09`09`09`09! Unrecognized lead-in X`09end if X Xc`09We received the SOH or STX byte, read the rest of the block. Xc Xc`09Format: Xc`09`09 < 128/1024 data bytes > X X 0101`09continue X`09if (crc) then X`09 call raw_read(rbuffer(2),data_size+(data_index), X`091`09timeout_count,noterm) X`09else X`09 call raw_read(rbuffer(2),data_size+(data_index-1), X`091`09timeout_count,noterm) X`09end if X X`09block_received = rbuffer(2) .and. bitmask ! Copy the block number. X`09block_comp = rbuffer(3)`09.and. bitmask`09! Copy complemented block #. X`09if (block_received .ne. block_expected) go to 550 X`09if ( (block_received + block_comp) .ne. bitmask) go to 600 X`09if (crc) then X`09 call clrcrc Xc`09 These must be added to clear the buffer if a longer block Xc`09 has been used before. X`09 rbuffer(data_size+data_index+data_index-1)=0 X`09 rbuffer(data_size+data_index+data_index-2)=0 X`09 call updcrc(rbuffer(data_index), data_size+data_index) X`09 if(highbyte.ne.0.or.lowbyte.ne.0) go to 600 X`09else X`09 checksum = xmodem_checksum (rbuffer(data_index), data_size) X`09 if (checksum.ne.(rbuffer(checksum_index).and.bitmask)) go to 600 X`09end if X`09block_count = block_count + 1`09`09! Adjust the block count. X Xc`09Copy the receive buffer and break at CR/LF if text mode. X X`09if(file_type .eq. binary) go to 300 X X`09do 200 i = data_index,data_size+(data_index-1) X`09rec_size = rec_size + 1`09`09`09! Update the record size. X`09lbuffer(rec_size) = rbuffer(i)`09`09! Copy the receive buffer. X`09if (lbuffer(rec_size) .eq. SUB) then X`09 rec_size = rec_size - 1`09`09! Don't write the CTRL/Z. X`09 received_eof = .true.`09`09! Show EOF was received. X`09 write (file_unit,401,err=999) (lbuffer(index),index=1,rec_size) X`09 go to 700`09`09`09`09! And go write the buffer. X`09endif X`09if (rec_size .gt. 1) then X`09 if ( (lbuffer(rec_size-1) .eq. cr) .and. X`091`09`09(lbuffer(rec_size) .eq. lf) ) then X`09`09rec_size = rec_size - 2`09`09! Adjust for the CR/LF. X`09`09write (file_unit,401,err=999) (lbuffer(index),index=1,rec_size) X 0401`09format(a1) X`09`09call xmodem_totals (rec_size)`09! Update the file totals. X retry_count=0 X`09`09rec_size = 0 X`09 endif X`09endif X200`09continue X Xc`09Check for too many bytes in the output buffer. X X`09if (rec_size .gt. out_size) then X`09 call check_display() X`09 call send_can()`09`09`09! Cancel the transmission. X`09 call write_user ('*** The output record is too large, '// X`091`09'are you sure this is an ASCII file ? ***'//crlf(:cl)) X`09 go to 9999`09`09`09! And report the abortion. X`09endif X`09go to 500 X X 0300`09continue Xc Xc`09Write the buffer to the output file. Xc X`09lbufferc = rbufferc(data_index:data_size+data_index-1) X`09rec_size = data_size`09`09`09! Update the record size. X X`09do while (rec_size .gt. 0) X`09 write (file_unit,400,err=999) lbufferc(1:128) X 0400`09 format (a128) X`09 call xmodem_totals (128)`09! Update the totals. X retry_count=0 X`09 lbufferc = lbufferc(129:) X`09 rec_size = rec_size - 128`09`09! Initialize the record size. X`09end do X X500`09previous_block = block_expected`09`09! Copy the current block #. X`09block_expected = mod (block_expected+1,256) .and. bitmask X`09call send_ack()`09`09`09`09! Send an ACKnowlegment. X`09go to 100`09`09`09`09! Go read the next block. X Xc`09We come here when the block number don't match. X X550`09if (block_received .eq. previous_block) then X`09 call send_ack()`09`09`09! ACK previous block number. X`09 go to 100`09`09`09`09! Go read the next block. X`09else X`09 call check_display() X`09 call sys$fao ('*** Phase error -- received block is !UL ***!/', X`091`09`09size, scratch, %val(block_received) ) X`09 call write_user (scratch(1:size)) X`09 call sys$fao ('*** While the expected block is !UL. ***!/', X`091`09`09size, scratch, %val(block_expected) ) X`09 call write_user (scratch(1:size)) X`09 call send_can()`09`09`09! Cancel the transmission. X`09 go to 9999 X`09endif Xc Xc`09We come here to send a NAK for a tranmission error. Xc X600`09continue Xc`09call clear_typeahead`09`09! Wait until remote is idle. X`09if (report_error(.true.)) then`09! Report the transmission error. X`09 call send_nak()`09`09! Tell remote to resend last record. X`09 go to 100`09`09`09! And try again. X`09else X`09 call send_can()`09`09! Limit exceeded, abort transmission. X`09 go to 9999`09`09`09! Report the abortion ... X`09endif Xc Xc`09We come here to process end of file. Xc X700`09close (unit=file_unit)`09`09! Close the input file X`09call send_ack()`09`09`09! Tell remote XMODEM we got EOT. X`09call report_success()`09`09! Report the transmission success. X`09get_xmodem = .true.`09`09! Return success. X`09return Xc Xc`09We come here if an error occurs writing the output file. Xc X999`09call rms_error (module_name)`09! Report the RMS error message. X`09call send_can()`09`09`09! Cancel the transmission & exit. Xc Xc`09We come here to report failure. Xc X9999`09close (unit=file_unit)`09`09! Close the input file. X`09call report_abort()`09`09! Report the aborted transmission. X`09return X`09end X`0C X`09logical function send_xmodem Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS subroutines - SEND_XMODEM.FOR Xc`09This routine is used transfer a file to the remote system from Xc`09the VAX using the XMODEM protocol. Xc Xc`09Dale Miller - UALR Xc Xc`09Rev. 4.13 04-Jul-1987 Xc`09Rev. 5.6 03-Mar-1988 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for/nolist' X X`09character*(*) module_name X`09parameter (module_name = 'Send_Xmodem') X`09integer data_index,data_size,block_size X`09parameter (data_index = 4)`09`09! Index to 1st data byte. X`09logical report_error, at_eof, crc X`09integer bytes, xmit_size, checksum, dindex, i X`09integer xmodem_checksum, read_byte X`09integer high,low X`09byte highbyte,lowbyte X`09common /crcval/high,low X`09equivalence (high,highbyte) X`09equivalence (low,lowbyte) X X`09send_xmodem = .false.`09`09`09! Initialize to bad return. X`09at_eof = .false.`09`09`09! Show not at end of file. X`09block_xmitted = 1`09`09`09! Initialize the block #. X`09xmit_size = data_index - 1`09`09! Initialize the XMIT size. X`09if (protocol .eq. ymodem) then X`09 data_size = 1024`09`09`09! Number of data bytes. X`09else X`09 data_size = 128`09`09`09! Standard Xmodem X`09end if X`09block_size = data_size + 3`09`09! Size of block - checksum. Xc Xc`09Wait until the remote XMODEM sends us a NAK or 'C'. Xc X`09call clear_typeahead()`09`09`09! Clear any garbage. X0010`09rbuffer(1) = read_byte (timeout_count)`09! Read the first byte. X`09if(rbuffer(1).eq.nak) then X`09 crc=.false. X`09else if(rbuffer(1).eq.'C') then X`09 crc=.true. X`09else if (report_error(.true.)) then`09! Report transmission error. X`09 go to 10`09`09`09`09! And try again. X`09else X`09 call send_can()`09`09`09! Limit exceeded, abort. X`09 go to 9999`09`09`09`09! Report the abortion ... X`09endif X X 0099`09error_count=0`09`09`09`09! Don't penalize him for startup X Xc Xc`09Read a record from the input file. Xc X100`09dindex = 1`09`09`09`09! Index into input record. X`09read (file_unit,110,end=9900,err=9990) bytes,(lbuffer(i),i=1,bytes) X110`09format (q,a1) X`09call xmodem_totals (bytes)`09`09! Update the file totals. X retry_count=0 Xc Xc`09If we're in text mode, append a CR/LF sequence. Xc X`09if (file_type .eq. ascii) then X`09 lbuffer(bytes+1) = cr`09`09! Append a carraige return X`09 lbuffer(bytes+2) = lf`09`09!`09and a line feed. X`09 bytes = bytes + 2`09`09`09! Adjust the byte count. X`09endif X`09if (bytes .eq. 0) go to 100`09`09! Blank binary record. X Xc`09Prepare the buffer to transmit. Xc Xc`09Format: < 128/1024 data bytes > Xc`09`09 X X200`09do 300 i = dindex,bytes X`09xmit_size = xmit_size + 1`09`09! Adjust the XMIT buffer size. X`09xbuffer(xmit_size) = lbuffer(i) .and. bitmask ! Copy the next byte. X`09if (xmit_size .eq. block_size) go to 400 ! Go transmit this block. X300`09continue X`09go to 100`09`09`09`09! Go read the next record. X Xc`09Calculate the checksum or CRC and transmit this block. X X 0400`09dindex = i + 1`09`09`09`09! Save index into record. X`09if(protocol .eq. ymodem) then X`09 xbuffer(1) = stx`09`09`09! Indicate long block X`09else X`09 xbuffer(1) = soh`09`09`09! Start with the SOH byte. X`09end if X`09xbuffer(2) = block_xmitted`09`09! Fill in the block number. X`09xbuffer(3) = (255 - block_xmitted) .and. bitmask ! Comp. block number. X X`09if (crc) then X`09 call clrcrc X`09 xmit_size=xmit_size+2 X`09 xbuffer(xmit_size-1) = 0 X`09 xbuffer(xmit_size) = 0 X`09 call updcrc (xbuffer(4), xmit_size-3) X`09 xbuffer(xmit_size-1) = highbyte X`09 xbuffer(xmit_size) = lowbyte X`09else X`09 checksum = xmodem_checksum (xbuffer(data_index), data_size) X`09 xmit_size = xmit_size + 1`09`09! Point to checksum byte. X`09 xbuffer(xmit_size) = checksum`09! Fill in the checksum. X`09endif X X`09block_xmitted = mod (block_xmitted+1,256) .and. bitmask X`09block_count = block_count + 1`09`09! Adjust the block count. X Xc`09Write the buffer to the remote. X X600`09call raw_write (xbuffer, xmit_size)`09! Write this block of data. X Xc`09Now, we must wait for an ACKnowlegment. X X`09rbuffer(1) = read_byte (timeout_count)`09! Read response from remote. X`09if (liosb(1) .ne. ss$_normal) go to 700 ! Report transmission error. X`09if (rbuffer(1) .eq. can) go to 9999`09! Transmission is cancelled. X`09if (rbuffer(1) .eq. ack) go to 800`09! Block successfully sent. Xc Xc`09Report the transmission error. Xc X700`09if (report_error(.true.)) then`09`09! Report transmission error. X`09 go to 600`09`09`09`09! And try again. X`09else X`09 call send_can()`09`09`09! Limit exceeded, abort. X`09 go to 9999`09`09`09`09! Report the abortion ... X`09endif Xc Xc`09Now we're ready to finish the previous record or read the next. Xc X800`09if (xbuffer(1) .eq. eot) go to 9910`09! Our EOT has been ACKed. X retry_count=0 X900`09if (at_eof) then X`09 xmit_size = 1`09`09`09! Set size of XMIT buffer. X`09 xbuffer(xmit_size) = eot`09`09! Get ready to send EOT. X`09 go to 600`09`09`09`09! Send end of transmission. X`09endif X`09xmit_size = data_index - 1`09`09! Reinitialize the XMIT size. X`09if (dindex .le. bytes) then X`09 go to 200`09`09`09`09! Finish the previous record. X`09else X`09 go to 100`09`09`09`09! Read the next record. X`09endif Xc Xc`09We come here for end of file on input file. Xc X9900`09at_eof = .true.`09`09`09`09! Show we're at end of file. X`09if ( (file_type .eq. binary) .and. X`091`09(xmit_size .eq. data_index-1) ) GO TO 900 ! Send EOT only. Xc Xc`09This is the last block, so we pad it with EOF bytes. Xc X`09do 9901 i = 1,block_size X`09xmit_size = xmit_size + 1`09`09! Bump the XMIT buffer size. X`09xbuffer(xmit_size) = sub`09`09! Fill buffer with EOF's. X`09if (xmit_size .eq. block_size) go to 400 ! Go transmit this block. X9901`09continue Xc Xc`09Transmission complete. Xc X9910 close (unit=file_unit)`09`09`09! Close the input file. X`09call report_success()`09`09`09! Report transmission success. X`09send_xmodem = .true.`09`09`09! Show success. X`09return Xc Xc`09We come here if an error occurs writing the output file. Xc X9990`09call rms_error (module_name)`09`09! Report the RMS error message. X`09call send_can()`09`09`09`09! Cancel the transmission. Xc Xc`09Here to report failure. Xc X9999`09close (unit=file_unit)`09`09`09! Close the output file. X`09if (at_eof) then X`09 call check_display() X`09 call write_user('*** Remote not responding on completion. ***'// X`091`09crlf(:cl)) X`09endif X`09call report_abort()`09`09`09! Report aborted transmission. X`09return X`09end X`0C X`09integer function xmodem_checksum (buffer, bytes) Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS subroutines - XMODEM_CHECKSUM.FOR Xc`09This routine is used to calculate the checksum with the XMODEM Xc`09protocol. Xc`09read. Xc`09Dale Miller - UALR Xc Xc`09Rev. 4.13 04-Jul-1987 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09include 'bbs_inc.for/nolist' X X`09logical*1 buffer(1) X`09integer bytes,i X X`09xmodem_checksum = 0`09`09`09! Initialize the checksum. X`09if (bytes .gt. 0) then X`09 do i=1,bytes X`09`09xmodem_checksum = (xmodem_checksum + buffer(i)) .and. bitmask X`09`09end do X`09 endif X`09return X`09end X`0C X`09subroutine updcrc(bbyte,n) Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS subroutines - UPDCRC.FOR Xc`09updates the Cyclic Redundancy Code Xc`09uses x`5E16 + x`5E12 + x`5E5 + 1 as recommended by CCITT Xc`09and as used by CRCSUBS version 1.20 for 8080 microprocessor Xc`09and incorporated into the MODEM7 protocol of the CP/M user's group Xc`09result to send is low byte of high and low in that order. Xc`09see Computer Networks, Andrew S. Tanenbaum, Prentiss-Hall, 1981 Xc Xc`09J. James Belonis II - University of Washington, Seattle Xc Xc`09Rev. 4.13 04-Jul-1987 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09implicit none X`09byte bbyte(*) X`09integer n,i,j Xc must declare integer to allow shifting X`09integer byte,newbyte X`09integer bit,bitl,bith X X integer high,low X`09byte highbyte,lowbyte X common /crcval/high,low X`09equivalence (high,highbyte) X`09equivalence (low,lowbyte) X X`09do i=1,n X`09 byte=bbyte(i) X X`09 do j=1,8 Xc get high bits of bytes so we don't lose them when shift Xc positive is left shift X`09`09bit =ishft( iand(128,byte), -7) X`09`09bitl=ishft( iand(128,low), -7) X`09`09bith=ishft( iand(128,high), -7) X`09`09newbyte=ishft(byte,1)`09! Get ready for next iteration X`09`09byte=newbyte`09`09! Introduced dummy variable newbyte X`09`09`09`09`09! to avoid "access violation" X`09`09low =ishft(low ,1)+bit`09! Shift those bits in X`09`09high=ishft(high,1)+bitl X X`09`09if(bith.eq.1) then X`09`09 high=ieor(16,high) X`09`09 low=ieor(33,low) X`09`09 endif X`09`09enddo X`09 enddo X return X end X`0C X`09subroutine clrcrc Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc Xc Xc`09UBBS subroutines - CLRCRC.FOR Xc`09Clears the Cyclic Redundancy Code for use by UPDCRC Xc`09J. James Belonis II - University of Washington, Seattle Xc Xc`09Rev. 4.13 04-Jul-1987 Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc Vcccc X`09integer high,low X`09byte highbyte,lowbyte X`09common /crcval/high,low X`09equivalence (high,highbyte) X`09equivalence (low,lowbyte) X X`09high=0 X`09low=0 X`09return X`09end X`0C X`09SUBROUTINE SET_TERMINATOR(PTR,TBL,TBYTE) XC XC`09This routine is used to set the terminator character for reads XC`09in the terminator table. This table which has 256 bits for XC`09this entire character set, must have a bit set for each character XC`09used to terminate a read (i.e., ). Currently, I presume XC`09only one character is used to terminate the read (table is cleared). XC XC`09Inputs: XC`09`09PTR - address of table pointer. XC`09`09TBL - address of terminator table. XC`09`09TBYTE - byte to set into table. XC X`09IMPLICIT INTEGER*4 (A-Z) X X`09INTEGER*4 PTR(2), TBL(8) X`09LOGICAL*1 TBYTE(1) X X`09DO 100 I=1,8 X`09TBL(I) = 0`09`09`09! Clear the entire table. X100`09CONTINUE X`09I = ((TBYTE(1)/32) + 1)`09`09! Offset into table. X`09BIT = (TBYTE(1) - ((I-1)*32)) `09! Bit to set in longword. X`09PTR(1) = I*4`09`09`09! Terminator table size. X`09PTR(2) = %LOC(TBL)`09`09! Fill in the table address. X`09CALL LIB$INSV(1,BIT,1,TBL(I))`09! Set the terminator bit. X`09RETURN X`09END X`0C X`09LOGICAL FUNCTION KERMIT_RECEIVE (FBUFF, RDATA, SDATA) XC XC`09This function is used to receive file(s) from a remote KERMIT. XC XC`09Inputs: XC`09`09FBUFF`09The file output buffer.`09`09`09(By Descriptor) XC`09`09RDATA`09The receive data buffer.`09`09(By Reference) XC`09`09SDATA`09The send data buffer.`09`09`09(By Reference) XC XC`09Outputs: XC`09`09True/False = Success/Failure. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09CHARACTER*(*) FBUFF X`09BYTE RDATA (MAXDATASIZ), SDATA (MAXDATASIZ) X X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'KERMIT_RECEIVE') X X`09INTEGER RECEIVE_INIT, RECEIVE_FILE, RECEIVE_DATA XC XC`09In server mode, we must start the transmission by sending an XC`09initialize "I" packet to the remote. In non-server mode, we XC`09simply wait for the send-init packet from the remote. XC X`09STATE = 'R'`09`09`09`09! State = "Receive-Init" X`09RETRY_COUNT = 0`09`09`09`09! Initialize retry count. X`09PAKNUM = 0`09`09`09`09! Initialize packet number. X`09CALL CLEAR_TYPEAHEAD`09`09`09! Clear typeahead buffer. X XC XC`09Dispatch on the receive state. XC X`09DO WHILE (.TRUE.) X`09 IF (STATE .EQ. 'A') THEN`09`09! "Abort" state. Xc`09`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Limit exceeded? Xc`09`09 CALL REPORT_RETRYS()`09! Yes, tell the user. Xc`09`09ENDIF X`09`09CALL REPORT_ABORT()`09`09! Tell user about it. X`09`09KERMIT_RECEIVE= .FALSE.`09`09! Set failure status. X`09`09RETURN X`09 ELSEIF (STATE .EQ. 'C') THEN`09! Complete state. X`09`09KERMIT_RECEIVE = .TRUE.`09`09! Set success status. X`09`09RETURN X`09 ELSEIF (STATE .EQ. 'D') THEN`09! Receive-Data. X`09`09STATE = RECEIVE_DATA (FBUFF, RDATA, SDATA) X`09 ELSEIF (STATE .EQ. 'F') THEN`09! Receive-File. X`09`09STATE = RECEIVE_FILE (RDATA, SDATA) X`09 ELSEIF (STATE .EQ. 'R') THEN`09! Receive-Init. X`09`09STATE = RECEIVE_INIT (RDATA, SDATA) X`09 ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, STATE) X`09`09KERMIT_RECEIVE = .FALSE.`09! Set failure status. X`09`09RETURN X`09 ENDIF X`09ENDDO X`09END X`0C X`09INTEGER FUNCTION RECEIVE_DATA (FBUFF, RDATA, SDATA) XC XC`09This function is used to receive the file data. XC XC`09Inputs: XC`09`09FBUFF`09The output file buffer. XC`09`09RDATA`09The receive data buffer. XC`09`09SDATA`09The send data buffer. XC XC`09Outputs: XC`09`09Return value is the next state. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09CHARACTER*(*) FBUFF X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ) X`09BYTE`09R_STATE, R_LEN, R_NUM X`09INTEGER RECEIVE_PACKET X X`09LOGICAL`09KERMIT_UNPACK X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'RECEIVE_DATA') X X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ? X`09 CLOSE (UNIT=FILE_UNIT)`09`09! Close the VAX file. X`09 RECEIVE_DATA = 'A'`09`09`09! Set "Abort" state. X`09 RETURN X`09ENDIF XC XC`09Read and decode the incoming packet. XC X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM) X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet? X`09`09RECEIVE_DATA = R_STATE`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'D') THEN`09`09! Get Data packet ? X`09 IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ? X`09`09PACKET_COUNT = PACKET_COUNT + 1`09! Adjust the packet count. X`09`09TOTAL_PACKETS = TOTAL_PACKETS+1`09! Update the total packets. X`09`09IF (.NOT. KERMIT_UNPACK (FBUFF, RDATA, R_LEN)) THEN X`09`09 CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'A') X`09`09 CLOSE (UNIT=FILE_UNIT)`09! Close the VAX file. X`09`09 RECEIVE_DATA = 'A'`09`09! Set "Abort" state. X`09`09 RETURN X`09`09ENDIF X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Y') ! Send ACK. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number. X`09`09RECEIVE_DATA = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ELSEIF (R_NUM .EQ. PREPAK) THEN`09! Previous packet ? X`09`09CALL KSEND_PACKET (SDATA, 0, PREPAK, 'Y') ! Re-ACK it. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09RECEIVE_DATA = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ELSE X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text. X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'F') THEN`09`09! File-Header packet ? X`09 IF (R_NUM .EQ. PREPAK) THEN`09`09! Previous packet ? XC XC`09The ACK for the file header was missed, resend the ACK. XC X`09`09CALL KSEND_PACKET (SDATA, 0, PREPAK, 'Y') ! Re-ACK it. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09RECEIVE_DATA = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ELSE X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. 'Z') THEN`09`09! End-of-file packet ? X`09 IF (R_NUM .EQ. PAKNUM) THEN`09`09! Previous packet ? X`09`09IF (RBYTES .GT. 0) THEN`09`09! Something to write ? X`09`09 CALL KERMIT_WRITE (FBUFF(1:RBYTES)) X`09`09ENDIF X`09`09CLOSE (UNIT=FILE_UNIT)`09`09! Close the VAX file. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Y') ! ACK EOF. X`09`09CALL REPORT_SUCCESS()`09`09! Report transmit success. X`09`09CALL COUNT_FILES()`09`09! Count files transferred. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number. X`09`09RECEIVE_DATA = 'F'`09`09! "Receive-File" state. X`09`09RETURN X`09 ELSE X`09`09CLOSE (UNIT=FILE_UNIT)`09`09! Close the VAX file. X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet. X`09`09CALL REPORT_ERROR (.TRUE.)`09! Show user the error. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'N') ! Send a NAK. X`09`09RECEIVE_DATA = STATE`09`09! Return current state. X`09`09RETURN X`09ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE) X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09ENDIF X`09END X`0C X`09INTEGER FUNCTION RECEIVE_FILE (RDATA, SDATA) XC XC`09This function is used to receive the file name. XC XC`09Inputs: XC`09`09RDATA`09The receive data buffer. XC`09`09SDATA`09The send data buffer. XC XC`09Outputs: XC`09`09Return value is the next state. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ) X`09BYTE`09R_STATE, R_LEN, R_NUM X`09INTEGER RECEIVE_PACKET X Xc`09LOGICAL KERMIT_OPENR X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'RECEIVE_FILE') X X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ? X`09 RECEIVE_FILE = 'A'`09`09`09! Set "Abort" state. X`09 RETURN X`09ENDIF XC XC`09Read and decode the incoming packet. XC X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM) X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet? X`09`09RECEIVE_FILE = R_STATE`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'B') THEN`09`09! Break packet ? X`09 IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ? X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Y') ! Send ACK. X`09`09RECEIVE_FILE = 'C'`09`09! Return "Complete" state. X`09`09RETURN X`09 ELSE X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text. X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'F') THEN`09`09! File-Header packet ? X`09 IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ? Xc`09`09IF (.NOT. KERMIT_OPENR (RDATA, R_LEN)) THEN Xc`09`09 CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'A') Xc`09`09 RECEIVE_FILE = 'A'`09`09! Return "Abort" state. Xc`09`09 RETURN Xc`09`09ENDIF X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Y') ! Send ACK. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number. X`09`09RBYTES = 0`09`09`09! The record byte count. X`09`09RECEIVE_FILE = 'D'`09`09! Return Data state. X`09`09RETURN X`09 ELSE X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. 'S') THEN`09`09! Send-init packet. X`09 IF (R_NUM .EQ. PREPAK) THEN`09`09! Previous packet ? XC XC`09The ACK for the file header was missed, resend our parameters. XC X`09`09CALL KSEND_PARAMETERS (SDATA)`09! Yes, resend our params. X`09`09CALL KSEND_PACKET (SDATA, ISIZE, PREPAK, 'Y') ! Re-ACK it. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09RECEIVE_FILE = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ELSE X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. 'Z') THEN`09`09! End-of-file packet ? X`09 IF (R_NUM .EQ. PREPAK) THEN`09`09! Previous packet ? X`09`09CALL KSEND_PACKET (SDATA, 0, PREPAK, 'Y') ! Resend ACK. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09RECEIVE_FILE = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ELSE X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet. X`09`09CALL REPORT_ERROR (.TRUE.)`09! Show user the error. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'N') ! Send a NAK. X`09`09RECEIVE_FILE = STATE`09`09! Return current state. X`09`09RETURN X`09ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE) X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09ENDIF X`09END X`0C X`09INTEGER FUNCTION RECEIVE_INIT (RDATA, SDATA) XC XC`09This function is used to receive the initial packet. XC XC`09Inputs: XC`09`09RDATA`09The receive data buffer. XC`09`09SDATA`09The send data buffer. XC XC`09Outputs: XC`09`09Return value is the next state. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09BYTE`09R_STATE, R_LEN, R_NUM X`09BYTE RDATA(MAXDATASIZ), SDATA(MAXDATASIZ) X`09INTEGER RECEIVE_PACKET X X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'RECEIVE_INIT') X X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ? X`09 RECEIVE_INIT = 'A'`09`09`09! Set "Abort" state. X`09 RETURN X`09ENDIF XC XC`09Read and decode the incoming packet. XC X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM) X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet? X`09`09RECEIVE_INIT = R_STATE`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text. X`09`09RECEIVE_INIT = 'A'`09`09! Set the "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'S') THEN`09`09! Send-init packet. X`09 `09CALL RECEIVE_PARAMETERS (RDATA, R_LEN) ! Set receive params. X`09`09CALL KSEND_PARAMETERS (SDATA)`09! Set our init params. X`09`09CALL KSEND_PACKET (SDATA, ISIZE, PAKNUM, 'Y') X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number. X`09`09RECEIVE_INIT = 'F'`09`09! Set File-Receive state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'N') ! Send a NAK. X`09`09RECEIVE_INIT = STATE`09`09! Return current state. X`09`09RETURN X`09ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE) X`09`09RECEIVE_INIT = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09ENDIF X`09END X`0C X`09LOGICAL FUNCTION KERMIT_SEND (FBUFF, RDATA, SDATA) XC XC`09This function is used to send file(s) to a remote KERMIT. XC XC`09Inputs: XC`09`09FBUFF`09Buffer for file writes.`09`09`09(By Descriptor) XC`09`09RDATA`09The receive data buffer.`09`09(By Reference) XC`09`09SDATA`09The send data buffer.`09`09`09(By Reference) XC XC`09Outputs: XC`09`09True/False = Success/Failure. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09include 'bbs_inc.for' X X`09CHARACTER*(*) FBUFF X`09BYTE RDATA (MAXDATASIZ), SDATA (MAXDATASIZ) X X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'KERMIT_SEND') X X`09BYTE S_LEN`09`09`09`09! The send data length. X`09INTEGER KSEND_INIT, KSEND_FILE, KSEND_DATA, KSEND_EOF, KSEND_BREAK X X`09STATE = 'S'`09`09`09`09! Start state = Send-Init. X`09RETRY_COUNT = 0`09`09`09`09! Initialize retry count. X`09PAKNUM = 0`09`09`09`09! Initialize packet number. X`09END_OF_FILE = .FALSE.`09`09`09! Show not at end of file. X`09call clear_typeahead`09`09`09! Clear typeahead buffer. XC XC`09Loop on the send state. XC X`09DO WHILE (.TRUE.) X`09 IF (STATE .EQ. 'A') THEN`09`09! "Abort" state. Xc`09`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Limit exceeded? Xc`09`09 CALL REPORT_RETRYS()`09! Yes, tell the user. Xc`09`09ENDIF X`09`09CALL REPORT_ABORT()`09`09! Tell user about it. X`09`09CLOSE (UNIT=FILE_UNIT)`09`09! Close the VAX file. X`09`09KERMIT_SEND = .FALSE.`09`09! Set failure status. X`09`09RETURN X`09 ELSEIF (STATE .EQ. 'B') THEN`09! Send-Break state. X`09`09STATE = KSEND_BREAK (RDATA, SDATA) X`09 ELSEIF (STATE .EQ. 'C') THEN`09! Complete state. X`09`09KERMIT_SEND = .TRUE.`09`09! Set success status. X`09`09RETURN X`09 ELSEIF (STATE .EQ. 'D') THEN`09! Send-Data state. X`09`09STATE = KSEND_DATA (FBUFF, RDATA, SDATA, S_LEN) X`09 ELSEIF (STATE .EQ. 'F') THEN`09! Send-File state. X`09`09STATE = KSEND_FILE (FBUFF, RDATA, SDATA, S_LEN) X`09 ELSEIF (STATE .EQ. 'S') THEN`09! Send-Init state. X`09`09STATE = KSEND_INIT (RDATA, SDATA) X`09 ELSEIF (STATE .EQ. 'Z') THEN`09! Send-End-Of-File. X`09`09STATE = KSEND_EOF (RDATA, SDATA) X`09 ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, STATE) X`09`09KERMIT_SEND = .FALSE.`09`09! Set failure status. X`09`09RETURN X`09 ENDIF X`09ENDDO X`09END X`0C X`09INTEGER FUNCTION KSEND_BREAK (RDATA, SDATA) XC XC`09This function is used to send a break (EOT). XC XC`09Inputs: XC`09`09RDATA`09The receive data buffer. XC`09`09SDATA`09The send data buffer. XC XC`09Outputs: XC`09`09Return value is the next state. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ) X`09BYTE`09R_STATE, R_LEN, R_NUM X`09INTEGER RECEIVE_PACKET X X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'KSEND_BREAK') X X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ? X`09 KSEND_BREAK = 'A'`09`09`09! Set "Abort" state. X`09 RETURN X`09ENDIF XC XC`09Send the break (EOT) packet to the remote. XC X`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'B') XC XC`09Read and decode the incoming packet. XC X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM) X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet? X`09`09KSEND_BREAK = R_STATE`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text. X`09`09KSEND_BREAK = 'A'`09`09! Set the "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received. X`09`09KSEND_BREAK = STATE`09`09! Stay in this state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ? X`09 IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ? X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number. X`09`09KSEND_BREAK = 'C'`09`09! Set "Complete" state. X`09`09RETURN X`09 ELSE X`09`09KSEND_BREAK = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet. X`09`09KSEND_BREAK = STATE`09`09! Stay in this state. X`09`09RETURN X`09ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE) X`09`09KSEND_BREAK = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09ENDIF X`09END X`0C X`09INTEGER FUNCTION KSEND_DATA (FBUFF, RDATA, SDATA, S_LEN) XC XC`09This function is used to send the file data. XC XC`09Inputs: XC`09`09FBUFF`09The input file buffer. XC`09`09RDATA`09The receive data buffer. XC`09`09SDATA`09The send data buffer. XC`09`09S_LEN`09The send data length. XC XC`09Outputs: XC`09`09Return value is the next state. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09CHARACTER*(*) FBUFF X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ) X`09BYTE`09R_STATE, R_LEN, R_NUM, S_LEN X`09LOGICAL`09KERMIT_PACK X`09INTEGER RECEIVE_PACKET X X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'KSEND_DATA') X X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ? X`09 KSEND_DATA = 'A'`09`09`09! Set "Abort" state. X`09 RETURN X`09ENDIF XC XC`09Send a data packet to the remote. XC X`09CALL KSEND_PACKET (SDATA, S_LEN, PAKNUM, 'D') XC XC`09Read and decode the incoming packet. XC X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM) X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet? X`09`09KSEND_DATA = R_STATE`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text. X`09`09KSEND_DATA = 'A'`09`09! Set the "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received. X`09`09KSEND_DATA = STATE`09`09! Stay in this state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ? X`09 IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ? X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number. X`09`09PACKET_COUNT = PACKET_COUNT + 1`09! Count the data packets. X`09`09TOTAL_PACKETS = TOTAL_PACKETS+1`09! Update the total packets. X`09`09CALL KERMIT_REPORT()`09`09! Update screen display. XC XC`09`09Fill the next data packet to send. XC X`09`09IF (KERMIT_PACK (FBUFF, SDATA, S_LEN)) THEN X`09`09 KSEND_DATA = STATE`09`09! Stay in "Data" state. X`09`09ELSE X`09`09 KSEND_DATA = 'Z'`09`09! Set "End-of-file" state. X`09`09ENDIF X`09`09RETURN X`09 ELSE X`09`09KSEND_DATA = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet. X`09`09KSEND_DATA = STATE`09`09! Stay in this state. X`09`09RETURN X`09ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE) X`09`09KSEND_DATA = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09ENDIF X`09END X`0C X`09INTEGER FUNCTION KSEND_EOF (RDATA, SDATA) XC XC`09This function is used to send the end of file. XC XC`09Inputs: XC`09`09RDATA`09The receive data buffer. XC`09`09SDATA`09The send data buffer. XC XC`09Outputs: XC`09`09Return value is the next state. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ) X`09BYTE`09R_STATE, R_LEN, R_NUM Xc`09LOGICAL NEXT_REMFILE X`09INTEGER RECEIVE_PACKET X X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'KSEND_EOF') X X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ? X`09 KSEND_EOF = 'A'`09`09`09! Set "Abort" state. X`09 RETURN X`09ENDIF XC XC`09Send an end of file packet to the remote. XC X`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Z') XC XC`09Read and decode the incoming packet. XC X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM) X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet? X`09`09KSEND_EOF = R_STATE`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text. X`09`09KSEND_EOF = 'A'`09`09`09! Set the "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received. X`09`09KSEND_EOF = STATE`09`09! Stay in this state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ? X`09 IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ? X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number. X`09`09CALL REPORT_SUCCESS()`09`09! Report success message. Xc`09`09IF (NEXT_REMFILE()) THEN`09! Check for another file. Xc`09`09 CALL COUNT_FILES()`09`09! Count files transferred. Xc`09`09 KSEND_EOF = 'F'`09`09! Set "File-Header" state. Xc`09`09 END_OF_FILE = .FALSE.`09! Reset end of file flag. Xc`09`09ELSE`09`09`09`09! No more files to send. X`09`09 KSEND_EOF = 'B'`09`09! Switch to "Break" state. Xc`09`09ENDIF X`09`09RETURN X`09 ELSE X`09`09KSEND_EOF = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet. X`09`09KSEND_EOF = STATE`09`09! Stay on this state. X`09`09RETURN X`09ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE) X`09`09KSEND_EOF = 'A'`09`09`09! Return "Abort" state. X`09`09RETURN X`09ENDIF X`09END X`0C X`09INTEGER FUNCTION KSEND_FILE (FBUFF, RDATA, SDATA, S_LEN) XC XC`09This function is used to send the file name. Upon switching to XC`09the Data State, the send data buffer is filled with the first XC`09packet data from the input file. XC XC`09Inputs: XC`09`09FBUFF`09The input file buffer. XC`09`09RDATA`09The receive data buffer. XC`09`09SDATA`09The send data buffer. XC`09`09S_LEN`09The send data length. XC XC`09Outputs: XC`09`09Return value is the next state. XC XC`09If Data State: XC`09`09SDATA`09The first data packet. XC`09`09S_LEN`09The data packet length. XC XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09CHARACTER*(*) FBUFF X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ) X`09BYTE`09R_STATE, R_LEN, R_NUM, S_LEN X`09LOGICAL`09KERMIT_PACK X`09INTEGER`09RECEIVE_PACKET X`09INTEGER RSIZE,ISTAT,STR$TRIM X X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'KSEND_FILE') X X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ? X`09 KSEND_FILE = 'A'`09`09`09! Set "Abort" state. X`09 RETURN X`09ENDIF XC XC`09Send the file header packet to the remote. XC X`09istat = str$trim (remote_file,remote_file,rsize) X`09CALL KSEND_PACKET (%REF(REMOTE_FILE), RSIZE, PAKNUM, 'F') XC XC`09Read and decode the incoming packet. XC X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM) X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet? X`09`09KSEND_FILE = R_STATE`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text. X`09`09KSEND_FILE = 'A'`09`09! Set the "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received. X`09`09KSEND_FILE = STATE`09`09! Stay in this state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ? X`09 IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ? X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number. XC XC`09`09Fill the send packet with the first packet data. XC X`09`09RBYTES = 0`09`09`09! The record byte count. X`09`09IF (KERMIT_PACK (FBUFF, SDATA, S_LEN)) THEN X`09`09 KSEND_FILE = 'D'`09`09! Set "Data" state. X`09`09ELSE X`09`09 KSEND_FILE = 'Z'`09`09! Set "End-of-file" state. X`09`09ENDIF X`09`09RETURN X`09 ELSE X`09`09KSEND_FILE = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet. X`09`09KSEND_FILE = STATE`09`09! Stay in this state. X`09`09RETURN X`09ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE) X`09`09KSEND_FILE = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09ENDIF X`09END X`0C X`09INTEGER FUNCTION KSEND_INIT (RDATA, SDATA) XC XC`09This function is used to send the initial parameters. XC XC`09Inputs: XC`09`09RDATA`09The receive data buffer. XC`09`09SDATA`09The send data buffer. XC XC`09Outputs: XC`09`09Return value is the next state. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ) X`09BYTE`09R_STATE, R_LEN, R_NUM X`09INTEGER RECEIVE_PACKET X X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'KSEND_INIT') X X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ? X`09 KSEND_INIT = 'A'`09`09`09! Set "Abort" state. X`09 RETURN X`09ENDIF XC XC`09Send our init parameters to the remote. XC X`09CALL KSEND_PARAMETERS (SDATA)`09`09! Set our init params. X`09CALL KSEND_PACKET (SDATA, ISIZE, PAKNUM, 'S') XC XC`09Read and decode the incoming packet. XC X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM) X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet? X`09`09KSEND_INIT = R_STATE`09`09! Return "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text. X`09`09KSEND_INIT = 'A'`09`09! Set the "Abort" state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received. X`09`09KSEND_INIT = STATE`09`09! Stay in this state. X`09`09RETURN X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ? X`09 IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ? X`09 `09CALL RECEIVE_PARAMETERS (RDATA, R_LEN) ! Set receive params. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number. X`09`09KSEND_INIT = 'F'`09`09! Set File-Receive state. X`09`09RETURN X`09 ELSE X`09`09KSEND_INIT = STATE`09`09! Stay in this state. X`09`09RETURN X`09 ENDIF X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet. X`09`09KSEND_INIT = STATE`09`09! Stay in this state. X`09`09RETURN X`09ELSE X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE) X`09`09KSEND_INIT = 'A'`09`09! Return "Abort" state. X`09`09RETURN X`09ENDIF X`09END X`0C X`09INTEGER FUNCTION KERMIT_CHECKSUM (P_DATA, P_SIZE) XC XC`09This function is used to calculate the KERMIT checksum. XC XC`09Inputs: XC`09`09P_DATA`09The data buffer. XC`09`09P_SIZE`09The data size. XC XC`09Outputs: XC`09`09Returns the calculated checksum. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X X`09BYTE P_DATA (MAXPACKSIZ) X`09INTEGER P_SIZE, CHECKSUM, I X X`09CHECKSUM = 0`09`09`09! Initialize the checksum. X`09DO I = 1, P_SIZE X`09 CHECKSUM = CHECKSUM + P_DATA(I) ! Accumulate the checksum. X`09ENDDO X`09CHECKSUM = ( (ISHFT (CHECKSUM .AND. "300, -6) + CHECKSUM) .AND. "077) X`09KERMIT_CHECKSUM = CHECKSUM`09! Return the checksum. X`09RETURN X`09END X`0C X`09SUBROUTINE KERMIT_ERROR (P_DATA, P_LEN) XC XC`09This function is used to report an error message received from the XC`09remote in an error packet. XC XC`09Inputs: XC`09`09P_DATA`09Packet data with error text. XC`09`09P_LEN`09The packet data length. XC XC`09Outputs: XC`09`09None. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09INCLUDE 'bbs_inc.for' X X`09BYTE`09P_DATA (MAXDATASIZ) X`09BYTE`09P_LEN X X`09INTEGER SIZE X`09CALL WRITE_USER (SS// X`091 '*** Aborting with this error from the remote KERMIT: ***'//SS) X`09SIZE = P_LEN`09`09`09`09! Convert to longword value. Xc`09CALL WRITE_BUFFER (P_DATA, SIZE)`09! Write the error text. Xc`09CALL WRITE_USER (SS)`09`09`09! Single space the output. X`09RETURN X`09END X`0C X`09LOGICAL FUNCTION KERMIT_OPENR (P_DATA, P_LEN) XC XC`09This function is used to open the VAX file when receiving a file. XC XC`09Inputs: XC`09`09P_DATA`09Packet data with file name. XC`09`09P_LEN`09The packet data length. XC XC`09Outputs: XC`09`09Return .TRUE./.FALSE. = Success/Failure. XC X`09IMPLICIT NONE X`09INCLUDE 'kermit_inc.for' X`09include 'bbs_inc.for' X X`09BYTE`09P_DATA (MAXDATASIZ) X`09BYTE`09P_LEN X X`09INTEGER I X`09CHARACTER*(*) MODULE_NAME X`09PARAMETER (MODULE_NAME = 'KERMIT_OPENR') XC XC`09Open the VAX file for output. XC X`09IF (FILE_TYPE.EQ.BINARY) THEN X`09 OPEN (UNIT=FILE_UNIT, TYPE='NEW', NAME=VAX_FILE(1:VSIZE), X`091`09`09RECORDSIZE=OUT_SIZE, CARRIAGECONTROL='NONE', X`091`09`09BUFFERCOUNT=2, ERR=9900) X`09ELSE X`09 OPEN (UNIT=FILE_UNIT, TYPE='NEW', NAME=VAX_FILE(1:VSIZE), X`091`09`09RECORDSIZE=OUT_SIZE, CARRIAGECONTROL='LIST', X`091`09`09BUFFERCOUNT=2, ERR=9900) X`09ENDIF +-+-+-+-+-+-+-+- END OF PART 7 +-+-+-+-+-+-+-+-