Article View: vmsnet.sources
Article #75UBBS, part 07/12
From: Dick Munroe
Date: Fri, 21 Aug 1992 20:21
Date: Fri, 21 Aug 1992 20:21
1406 lines
49653 bytes
49653 bytes
Submitted-by: munroe@dmc.com (Dick Munroe)
Posting-number: Volume 3, Issue 115
Archive-name: ubbs/part07
-+-+-+-+-+-+-+-+ 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: <SOH/STX><block #><comp block #>
Xc`09`09 < 128/1024 data bytes ><checksum/CRC>
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(<rec_size>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,<bytes+1>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: <SOH/STX><block #><comp block #>< 128/1024 data bytes >
Xc`09`09 <checksum/CRC>
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., <CR>). 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 +-+-+-+-+-+-+-+-
Technical Details
Message-ID:
<7868482@MVB.SAIC.COM>Path:
arc1-ca.pugleaf.net!sparky!uunet!usc!elroy.jpl.nasa.gov!ames!network.ucsd.edu!mvb.saic.com!vmsnet-sourcesShow Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!sparky!uunet!usc!elroy.jpl.nasa.gov!ames!network.ucsd.edu!mvb.saic.com!vmsnet-sources From: munroe@dmc.com (Dick Munroe) Newsgroups: vmsnet.sources Subject: UBBS, part 07/12 Message-ID: <7868482@MVB.SAIC.COM> Date: Fri, 21 Aug 1992 20:21:02 GMT Organization: Doyle, Munroe Consultants, Inc., Hudson, MA Lines: 1406 Approved: Mark.Berryman@Mvb.Saic.Com