home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / vmsnet / sources / 309 < prev    next >
Encoding:
Internet Message Format  |  1992-08-21  |  47.1 KB
  1. Path: sparky!uunet!usc!elroy.jpl.nasa.gov!ames!network.ucsd.edu!mvb.saic.com!vmsnet-sources
  2. From: munroe@dmc.com (Dick Munroe)
  3. Newsgroups: vmsnet.sources
  4. Subject: UBBS, part 07/12
  5. Message-ID: <7868482@MVB.SAIC.COM>
  6. Date: Fri, 21 Aug 1992 20:21:02 GMT
  7. Organization: Doyle, Munroe Consultants, Inc., Hudson, MA
  8. Lines: 1406
  9. Approved: Mark.Berryman@Mvb.Saic.Com
  10.  
  11. Submitted-by: munroe@dmc.com (Dick Munroe)
  12. Posting-number: Volume 3, Issue 115
  13. Archive-name: ubbs/part07
  14. -+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+
  15. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  16. Vcccc
  17. X`09implicit none
  18. X`09include 'bbs_inc.for/nolist'
  19. X
  20. X`09character*(*) module_name
  21. X
  22. X`09integer data_size,data_index,checksum_index
  23. X`09parameter (module_name = 'get_xmodem')
  24. XC`09parameter (data_size = 128)`09`09! Number of data bytes.
  25. X`09parameter (data_index = 4)`09`09! Index to 1st data byte.
  26. X`09parameter (checksum_index = 132)`09! Index to checksum byte.
  27. X`09logical report_error, received_eof,crc
  28. X`09integer i, index, size, read_byte
  29. X`09integer block_expected, previous_block, block_comp, checksum, rec_size
  30. X`09integer xmodem_checksum
  31. X`09integer high,low
  32. X`09byte highbyte,lowbyte
  33. X`09common /crcval/high,low
  34. X`09equivalence (high,highbyte)
  35. X`09equivalence (low,lowbyte)
  36. X
  37. X`09get_xmodem = .false.`09`09`09! Initialize to bad return.
  38. X`09data_size = 128`09`09`09`09! Initialize to standard Xmodem
  39. X
  40. X`09block_expected = 1`09`09`09! Initialize the block number.
  41. X`09previous_block = block_expected`09`09! Initialize the previous block.
  42. X`09received_eof = .false.`09`09`09! Initialize the EOF flag.
  43. X`09rec_size = 0`09`09`09`09! Initialize the record size.
  44. X`09error_count = 0
  45. X
  46. Xc`09Synchronize with remote XMODEM and determine if the transfer is
  47. Xc`09to be CRC or checksum.  Try CRC for 3 times before giving up and
  48. Xc`09using checksum.
  49. X
  50. X`09crc = .true.`09`09`09!Assume CRC until proven otherwise
  51. X 0010`09call send_c
  52. X`09rbuffer(1) = read_byte (10)`09`09! Read the first byte.
  53. X`09if (liosb(1) .ne. ss$_normal) then
  54. X`09    error_count = error_count + 1
  55. X`09    if (error_count.gt.4) then
  56. X`09`09error_count = 0
  57. X`09`09go to 99
  58. X`09`09end if
  59. X`09    go to 10
  60. X`09    end if
  61. X`09if (rbuffer(1) .eq. eot) then
  62. X`09    go to 700`09`09`09`09! End of transmission.
  63. X`09else if (rbuffer(1) .eq. soh) then
  64. X`09    data_size = 128
  65. X`09    go to 101`09`09`09`09! Standard Xmodem
  66. X`09else if (rbuffer(1) .eq. stx) then
  67. X`09    data_size = 1024
  68. X`09    go to 101`09`09`09`09! Ymodem variant
  69. X`09else
  70. X`09    go to 10
  71. X`09end if
  72. X
  73. Xc`09CRC failed, try for checksum
  74. X
  75. X 0099`09continue
  76. X`09crc = .false.
  77. X`09call send_nak()`09`09`09! Send NAK to synchronize.
  78. X
  79. Xc`09Loop, waiting for the first byte from the remote.
  80. Xc
  81. Xc`09We expect an SOH, STX, or EOT byte at this point.
  82. X
  83. X
  84. X 0100`09continue
  85. X`09rbuffer(1) = read_byte (10)`09`09! Read the first byte.
  86. X`09if (liosb(1) .ne. ss$_normal) go to 600 ! Report error/NAK.
  87. X`09
  88. X`09if (rbuffer(1) .eq. soh) then
  89. X`09    data_size = 128
  90. X`09else if (rbuffer(1) .eq. stx) then
  91. X`09    data_size=1024
  92. X`09else if (rbuffer(1) .eq. eot) then
  93. X`09    go to 700`09`09`09`09! End of transmission.
  94. X`09else
  95. X`09    go to 100`09`09`09`09! Unrecognized lead-in
  96. X`09end if
  97. X
  98. Xc`09We received the SOH or STX byte, read the rest of the block.
  99. Xc
  100. Xc`09Format:  <SOH/STX><block #><comp block #>
  101. Xc`09`09 < 128/1024 data bytes ><checksum/CRC>
  102. X
  103. X 0101`09continue
  104. X`09if (crc) then
  105. X`09    call raw_read(rbuffer(2),data_size+(data_index),
  106. X`091`09timeout_count,noterm)
  107. X`09else
  108. X`09    call raw_read(rbuffer(2),data_size+(data_index-1),
  109. X`091`09timeout_count,noterm)
  110. X`09end if
  111. X
  112. X`09block_received = rbuffer(2) .and. bitmask ! Copy the block number.
  113. X`09block_comp = rbuffer(3)`09.and. bitmask`09! Copy complemented block #.
  114. X`09if (block_received .ne. block_expected) go to 550
  115. X`09if ( (block_received + block_comp) .ne. bitmask) go to 600
  116. X`09if (crc) then
  117. X`09    call clrcrc
  118. Xc`09    These must be added to clear the buffer if a longer block
  119. Xc`09    has been used before.
  120. X`09    rbuffer(data_size+data_index+data_index-1)=0
  121. X`09    rbuffer(data_size+data_index+data_index-2)=0
  122. X`09    call updcrc(rbuffer(data_index), data_size+data_index)
  123. X`09    if(highbyte.ne.0.or.lowbyte.ne.0) go to 600
  124. X`09else
  125. X`09    checksum = xmodem_checksum (rbuffer(data_index), data_size)
  126. X`09    if (checksum.ne.(rbuffer(checksum_index).and.bitmask)) go to 600
  127. X`09end if
  128. X`09block_count = block_count + 1`09`09! Adjust the block count.
  129. X
  130. Xc`09Copy the receive buffer and break at CR/LF if text mode.
  131. X
  132. X`09if(file_type .eq. binary) go to 300
  133. X
  134. X`09do 200 i = data_index,data_size+(data_index-1)
  135. X`09rec_size = rec_size + 1`09`09`09! Update the record size.
  136. X`09lbuffer(rec_size) = rbuffer(i)`09`09! Copy the receive buffer.
  137. X`09if (lbuffer(rec_size) .eq. SUB) then
  138. X`09    rec_size = rec_size - 1`09`09! Don't write the CTRL/Z.
  139. X`09    received_eof = .true.`09`09! Show EOF was received.
  140. X`09    write (file_unit,401,err=999) (lbuffer(index),index=1,rec_size)
  141. X`09    go to 700`09`09`09`09! And go write the buffer.
  142. X`09endif
  143. X`09if (rec_size .gt. 1) then
  144. X`09    if ( (lbuffer(rec_size-1) .eq. cr) .and.
  145. X`091`09`09(lbuffer(rec_size) .eq. lf) ) then
  146. X`09`09rec_size = rec_size - 2`09`09! Adjust for the CR/LF.
  147. X`09`09write (file_unit,401,err=999) (lbuffer(index),index=1,rec_size)
  148. X 0401`09format(<rec_size>a1)
  149. X`09`09call xmodem_totals (rec_size)`09! Update the file totals.
  150. X                retry_count=0
  151. X`09`09rec_size = 0
  152. X`09    endif
  153. X`09endif
  154. X200`09continue
  155. X
  156. Xc`09Check for too many bytes in the output buffer.
  157. X
  158. X`09if (rec_size .gt. out_size) then
  159. X`09    call check_display()
  160. X`09    call send_can()`09`09`09! Cancel the transmission.
  161. X`09    call write_user ('*** The output record is too large, '//
  162. X`091`09'are you sure this is an ASCII file ? ***'//crlf(:cl))
  163. X`09    go to 9999`09`09`09! And report the abortion.
  164. X`09endif
  165. X`09go to 500
  166. X
  167. X 0300`09continue
  168. Xc
  169. Xc`09Write the buffer to the output file.
  170. Xc
  171. X`09lbufferc = rbufferc(data_index:data_size+data_index-1)
  172. X`09rec_size = data_size`09`09`09! Update the record size.
  173. X
  174. X`09do while (rec_size .gt. 0)
  175. X`09    write (file_unit,400,err=999) lbufferc(1:128)
  176. X 0400`09    format (a128)
  177. X`09    call xmodem_totals (128)`09! Update the totals.
  178. X            retry_count=0
  179. X`09    lbufferc = lbufferc(129:)
  180. X`09    rec_size = rec_size - 128`09`09! Initialize the record size.
  181. X`09end do
  182. X
  183. X500`09previous_block = block_expected`09`09! Copy the current block #.
  184. X`09block_expected = mod (block_expected+1,256) .and. bitmask
  185. X`09call send_ack()`09`09`09`09! Send an ACKnowlegment.
  186. X`09go to 100`09`09`09`09! Go read the next block.
  187. X
  188. Xc`09We come here when the block number don't match.
  189. X
  190. X550`09if (block_received .eq. previous_block) then
  191. X`09    call send_ack()`09`09`09! ACK previous block number.
  192. X`09    go to 100`09`09`09`09! Go read the next block.
  193. X`09else
  194. X`09    call check_display()
  195. X`09    call sys$fao ('*** Phase error -- received block is !UL ***!/',
  196. X`091`09`09size, scratch, %val(block_received) )
  197. X`09    call write_user (scratch(1:size))
  198. X`09    call sys$fao ('***      While the expected block is !UL. ***!/',
  199. X`091`09`09size, scratch, %val(block_expected) )
  200. X`09    call write_user (scratch(1:size))
  201. X`09    call send_can()`09`09`09! Cancel the transmission.
  202. X`09    go to 9999
  203. X`09endif
  204. Xc
  205. Xc`09We come here to send a NAK for a tranmission error.
  206. Xc
  207. X600`09continue
  208. Xc`09call clear_typeahead`09`09! Wait until remote is idle.
  209. X`09if (report_error(.true.)) then`09! Report the transmission error.
  210. X`09    call send_nak()`09`09! Tell remote to resend last record.
  211. X`09    go to 100`09`09`09! And try again.
  212. X`09else
  213. X`09    call send_can()`09`09! Limit exceeded, abort transmission.
  214. X`09    go to 9999`09`09`09! Report the abortion ...
  215. X`09endif
  216. Xc
  217. Xc`09We come here to process end of file.
  218. Xc
  219. X700`09close (unit=file_unit)`09`09! Close the input file
  220. X`09call send_ack()`09`09`09! Tell remote XMODEM we got EOT.
  221. X`09call report_success()`09`09! Report the transmission success.
  222. X`09get_xmodem = .true.`09`09! Return success.
  223. X`09return
  224. Xc
  225. Xc`09We come here if an error occurs writing the output file.
  226. Xc
  227. X999`09call rms_error (module_name)`09! Report the RMS error message.
  228. X`09call send_can()`09`09`09! Cancel the transmission & exit.
  229. Xc
  230. Xc`09We come here to report failure.
  231. Xc
  232. X9999`09close (unit=file_unit)`09`09! Close the input file.
  233. X`09call report_abort()`09`09! Report the aborted transmission.
  234. X`09return
  235. X`09end
  236. X`0C
  237. X`09logical function send_xmodem
  238. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  239. Vcccc
  240. Xc
  241. Xc`09UBBS subroutines - SEND_XMODEM.FOR
  242. Xc`09This routine is used transfer a file to the remote system from
  243. Xc`09the VAX using the XMODEM protocol.
  244. Xc
  245. Xc`09Dale Miller - UALR
  246. Xc
  247. Xc`09Rev. 4.13 04-Jul-1987
  248. Xc`09Rev. 5.6  03-Mar-1988
  249. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  250. Vcccc
  251. X`09implicit none
  252. X`09include 'bbs_inc.for/nolist'
  253. X
  254. X`09character*(*) module_name
  255. X`09parameter (module_name = 'Send_Xmodem')
  256. X`09integer data_index,data_size,block_size
  257. X`09parameter (data_index = 4)`09`09! Index to 1st data byte.
  258. X`09logical report_error, at_eof, crc
  259. X`09integer bytes, xmit_size, checksum, dindex, i
  260. X`09integer xmodem_checksum, read_byte
  261. X`09integer high,low
  262. X`09byte highbyte,lowbyte
  263. X`09common /crcval/high,low
  264. X`09equivalence (high,highbyte)
  265. X`09equivalence (low,lowbyte)
  266. X
  267. X`09send_xmodem = .false.`09`09`09! Initialize to bad return.
  268. X`09at_eof = .false.`09`09`09! Show not at end of file.
  269. X`09block_xmitted = 1`09`09`09! Initialize the block #.
  270. X`09xmit_size = data_index - 1`09`09! Initialize the XMIT size.
  271. X`09if (protocol .eq. ymodem) then
  272. X`09    data_size = 1024`09`09`09! Number of data bytes.
  273. X`09else
  274. X`09    data_size = 128`09`09`09! Standard Xmodem
  275. X`09end if
  276. X`09block_size = data_size + 3`09`09! Size of block - checksum.
  277. Xc
  278. Xc`09Wait until the remote XMODEM sends us a NAK or 'C'.
  279. Xc
  280. X`09call clear_typeahead()`09`09`09! Clear any garbage.
  281. X0010`09rbuffer(1) = read_byte (timeout_count)`09! Read the first byte.
  282. X`09if(rbuffer(1).eq.nak) then
  283. X`09    crc=.false.
  284. X`09else if(rbuffer(1).eq.'C') then
  285. X`09    crc=.true.
  286. X`09else if (report_error(.true.)) then`09! Report transmission error.
  287. X`09    go to 10`09`09`09`09! And try again.
  288. X`09else
  289. X`09    call send_can()`09`09`09! Limit exceeded, abort.
  290. X`09    go to 9999`09`09`09`09! Report the abortion ...
  291. X`09endif
  292. X
  293. X 0099`09error_count=0`09`09`09`09! Don't penalize him for startup
  294. X
  295. Xc
  296. Xc`09Read a record from the input file.
  297. Xc
  298. X100`09dindex = 1`09`09`09`09! Index into input record.
  299. X`09read (file_unit,110,end=9900,err=9990) bytes,(lbuffer(i),i=1,bytes)
  300. X110`09format (q,<bytes+1>a1)
  301. X`09call xmodem_totals (bytes)`09`09! Update the file totals.
  302. X        retry_count=0
  303. Xc
  304. Xc`09If we're in text mode, append a CR/LF sequence.
  305. Xc
  306. X`09if (file_type .eq. ascii) then
  307. X`09    lbuffer(bytes+1) = cr`09`09! Append a carraige return
  308. X`09    lbuffer(bytes+2) = lf`09`09!`09and a line feed.
  309. X`09    bytes = bytes + 2`09`09`09! Adjust the byte count.
  310. X`09endif
  311. X`09if (bytes .eq. 0) go to 100`09`09! Blank binary record.
  312. X
  313. Xc`09Prepare the buffer to transmit.
  314. Xc
  315. Xc`09Format:  <SOH/STX><block #><comp block #>< 128/1024 data bytes >
  316. Xc`09`09 <checksum/CRC>
  317. X
  318. X200`09do 300 i = dindex,bytes
  319. X`09xmit_size = xmit_size + 1`09`09! Adjust the XMIT buffer size.
  320. X`09xbuffer(xmit_size) = lbuffer(i) .and. bitmask ! Copy the next byte.
  321. X`09if (xmit_size .eq. block_size) go to 400 ! Go transmit this block.
  322. X300`09continue
  323. X`09go to 100`09`09`09`09! Go read the next record.
  324. X
  325. Xc`09Calculate the checksum or CRC and transmit this block.
  326. X
  327. X 0400`09dindex = i + 1`09`09`09`09! Save index into record.
  328. X`09if(protocol .eq. ymodem) then
  329. X`09    xbuffer(1) = stx`09`09`09! Indicate long block
  330. X`09else
  331. X`09    xbuffer(1) = soh`09`09`09! Start with the SOH byte.
  332. X`09end if
  333. X`09xbuffer(2) = block_xmitted`09`09! Fill in the block number.
  334. X`09xbuffer(3) = (255 - block_xmitted) .and. bitmask ! Comp. block number.
  335. X
  336. X`09if (crc) then
  337. X`09    call clrcrc
  338. X`09    xmit_size=xmit_size+2
  339. X`09    xbuffer(xmit_size-1) = 0
  340. X`09    xbuffer(xmit_size)   = 0
  341. X`09    call updcrc (xbuffer(4), xmit_size-3)
  342. X`09    xbuffer(xmit_size-1) = highbyte
  343. X`09    xbuffer(xmit_size)   = lowbyte
  344. X`09else
  345. X`09    checksum = xmodem_checksum (xbuffer(data_index), data_size)
  346. X`09    xmit_size = xmit_size + 1`09`09! Point to checksum byte.
  347. X`09    xbuffer(xmit_size) = checksum`09! Fill in the checksum.
  348. X`09endif
  349. X
  350. X`09block_xmitted = mod (block_xmitted+1,256) .and. bitmask
  351. X`09block_count = block_count + 1`09`09! Adjust the block count.
  352. X
  353. Xc`09Write the buffer to the remote.
  354. X
  355. X600`09call raw_write (xbuffer, xmit_size)`09! Write this block of data.
  356. X
  357. Xc`09Now, we must wait for an ACKnowlegment.
  358. X
  359. X`09rbuffer(1) = read_byte (timeout_count)`09! Read response from remote.
  360. X`09if (liosb(1) .ne. ss$_normal) go to 700 ! Report transmission error.
  361. X`09if (rbuffer(1) .eq. can) go to 9999`09! Transmission is cancelled.
  362. X`09if (rbuffer(1) .eq. ack) go to 800`09! Block successfully sent.
  363. Xc
  364. Xc`09Report the transmission error.
  365. Xc
  366. X700`09if (report_error(.true.)) then`09`09! Report transmission error.
  367. X`09    go to 600`09`09`09`09! And try again.
  368. X`09else
  369. X`09    call send_can()`09`09`09! Limit exceeded, abort.
  370. X`09    go to 9999`09`09`09`09! Report the abortion ...
  371. X`09endif
  372. Xc
  373. Xc`09Now we're ready to finish the previous record or read the next.
  374. Xc
  375. X800`09if (xbuffer(1) .eq. eot) go to 9910`09! Our EOT has been ACKed.
  376. X        retry_count=0
  377. X900`09if (at_eof) then
  378. X`09    xmit_size = 1`09`09`09! Set size of XMIT buffer.
  379. X`09    xbuffer(xmit_size) = eot`09`09! Get ready to send EOT.
  380. X`09    go to 600`09`09`09`09! Send end of transmission.
  381. X`09endif
  382. X`09xmit_size = data_index - 1`09`09! Reinitialize the XMIT size.
  383. X`09if (dindex .le. bytes) then
  384. X`09    go to 200`09`09`09`09! Finish the previous record.
  385. X`09else
  386. X`09    go to 100`09`09`09`09! Read the next record.
  387. X`09endif
  388. Xc
  389. Xc`09We come here for end of file on input file.
  390. Xc
  391. X9900`09at_eof = .true.`09`09`09`09! Show we're at end of file.
  392. X`09if ( (file_type .eq. binary) .and.
  393. X`091`09(xmit_size .eq. data_index-1) ) GO TO 900 ! Send EOT only.
  394. Xc
  395. Xc`09This is the last block, so we pad it with EOF bytes.
  396. Xc
  397. X`09do 9901 i = 1,block_size
  398. X`09xmit_size = xmit_size + 1`09`09! Bump the XMIT buffer size.
  399. X`09xbuffer(xmit_size) = sub`09`09! Fill buffer with EOF's.
  400. X`09if (xmit_size .eq. block_size) go to 400 ! Go transmit this block.
  401. X9901`09continue
  402. Xc
  403. Xc`09Transmission complete.
  404. Xc
  405. X9910    close (unit=file_unit)`09`09`09! Close the input file.
  406. X`09call report_success()`09`09`09! Report transmission success.
  407. X`09send_xmodem = .true.`09`09`09! Show success.
  408. X`09return
  409. Xc
  410. Xc`09We come here if an error occurs writing the output file.
  411. Xc
  412. X9990`09call rms_error (module_name)`09`09! Report the RMS error message.
  413. X`09call send_can()`09`09`09`09! Cancel the transmission.
  414. Xc
  415. Xc`09Here to report failure.
  416. Xc
  417. X9999`09close (unit=file_unit)`09`09`09! Close the output file.
  418. X`09if (at_eof) then
  419. X`09    call check_display()
  420. X`09    call write_user('*** Remote not responding on completion. ***'//
  421. X`091`09crlf(:cl))
  422. X`09endif
  423. X`09call report_abort()`09`09`09! Report aborted transmission.
  424. X`09return
  425. X`09end
  426. X`0C
  427. X`09integer function xmodem_checksum (buffer, bytes)
  428. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  429. Vcccc
  430. Xc
  431. Xc`09UBBS subroutines - XMODEM_CHECKSUM.FOR
  432. Xc`09This routine is used to calculate the checksum with the XMODEM
  433. Xc`09protocol.
  434. Xc`09read.
  435. Xc`09Dale Miller - UALR
  436. Xc
  437. Xc`09Rev. 4.13 04-Jul-1987
  438. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  439. Vcccc
  440. X`09implicit none
  441. X`09include 'bbs_inc.for/nolist'
  442. X
  443. X`09logical*1 buffer(1)
  444. X`09integer bytes,i
  445. X
  446. X`09xmodem_checksum = 0`09`09`09! Initialize the checksum.
  447. X`09if (bytes .gt. 0) then
  448. X`09    do i=1,bytes
  449. X`09`09xmodem_checksum = (xmodem_checksum + buffer(i)) .and. bitmask
  450. X`09`09end do
  451. X`09    endif
  452. X`09return
  453. X`09end
  454. X`0C
  455. X`09subroutine updcrc(bbyte,n)
  456. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  457. Vcccc
  458. Xc
  459. Xc`09UBBS subroutines - UPDCRC.FOR
  460. Xc`09updates the Cyclic Redundancy Code
  461. Xc`09uses x`5E16 + x`5E12 + x`5E5 + 1 as recommended by CCITT
  462. Xc`09and as used by CRCSUBS version 1.20 for 8080 microprocessor
  463. Xc`09and incorporated into the MODEM7 protocol of the CP/M user's group
  464. Xc`09result to send is low byte of high and low in that order.
  465. Xc`09see Computer Networks, Andrew S. Tanenbaum, Prentiss-Hall, 1981
  466. Xc
  467. Xc`09J. James Belonis II - University of Washington, Seattle
  468. Xc
  469. Xc`09Rev. 4.13 04-Jul-1987
  470. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  471. Vcccc
  472. X`09implicit none
  473. X`09byte bbyte(*)
  474. X`09integer n,i,j
  475. Xc  must declare integer to allow shifting
  476. X`09integer byte,newbyte
  477. X`09integer bit,bitl,bith
  478. X
  479. X        integer high,low
  480. X`09byte highbyte,lowbyte
  481. X        common /crcval/high,low
  482. X`09equivalence (high,highbyte)
  483. X`09equivalence (low,lowbyte)
  484. X
  485. X`09do i=1,n
  486. X`09    byte=bbyte(i)
  487. X
  488. X`09    do j=1,8
  489. Xc  get high bits of bytes so we don't lose them when shift
  490. Xc  positive is left shift
  491. X`09`09bit =ishft( iand(128,byte), -7)
  492. X`09`09bitl=ishft( iand(128,low),  -7)
  493. X`09`09bith=ishft( iand(128,high), -7)
  494. X`09`09newbyte=ishft(byte,1)`09! Get ready for next iteration
  495. X`09`09byte=newbyte`09`09! Introduced dummy variable newbyte
  496. X`09`09`09`09`09!  to avoid "access violation"
  497. X`09`09low =ishft(low ,1)+bit`09! Shift those bits in
  498. X`09`09high=ishft(high,1)+bitl
  499. X
  500. X`09`09if(bith.eq.1) then
  501. X`09`09    high=ieor(16,high)
  502. X`09`09    low=ieor(33,low)
  503. X`09`09    endif
  504. X`09`09enddo
  505. X`09    enddo
  506. X        return
  507. X        end
  508. X`0C
  509. X`09subroutine clrcrc
  510. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  511. Vcccc
  512. Xc
  513. Xc`09UBBS subroutines - CLRCRC.FOR
  514. Xc`09Clears the Cyclic Redundancy Code for use by UPDCRC
  515. Xc`09J. James Belonis II - University of Washington, Seattle
  516. Xc
  517. Xc`09Rev. 4.13 04-Jul-1987
  518. Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  519. Vcccc
  520. X`09integer high,low
  521. X`09byte highbyte,lowbyte
  522. X`09common /crcval/high,low
  523. X`09equivalence (high,highbyte)
  524. X`09equivalence (low,lowbyte)
  525. X
  526. X`09high=0
  527. X`09low=0
  528. X`09return
  529. X`09end
  530. X`0C
  531. X`09SUBROUTINE SET_TERMINATOR(PTR,TBL,TBYTE)
  532. XC
  533. XC`09This routine is used to set the terminator character for reads
  534. XC`09in the terminator table.  This table which has 256 bits for
  535. XC`09this entire character set, must have a bit set for each character
  536. XC`09used to terminate a read (i.e., <CR>).  Currently, I presume
  537. XC`09only one character is used to terminate the read (table is cleared).
  538. XC
  539. XC`09Inputs:
  540. XC`09`09PTR - address of table pointer.
  541. XC`09`09TBL - address of terminator table.
  542. XC`09`09TBYTE - byte to set into table.
  543. XC
  544. X`09IMPLICIT INTEGER*4 (A-Z)
  545. X
  546. X`09INTEGER*4 PTR(2), TBL(8)
  547. X`09LOGICAL*1 TBYTE(1)
  548. X
  549. X`09DO 100 I=1,8
  550. X`09TBL(I) = 0`09`09`09! Clear the entire table.
  551. X100`09CONTINUE
  552. X`09I = ((TBYTE(1)/32) + 1)`09`09! Offset into table.
  553. X`09BIT = (TBYTE(1) - ((I-1)*32)) `09! Bit to set in longword.
  554. X`09PTR(1) = I*4`09`09`09! Terminator table size.
  555. X`09PTR(2) = %LOC(TBL)`09`09! Fill in the table address.
  556. X`09CALL LIB$INSV(1,BIT,1,TBL(I))`09! Set the terminator bit.
  557. X`09RETURN
  558. X`09END
  559. X`0C
  560. X`09LOGICAL FUNCTION KERMIT_RECEIVE (FBUFF, RDATA, SDATA)
  561. XC
  562. XC`09This function is used to receive file(s) from a remote KERMIT.
  563. XC
  564. XC`09Inputs:
  565. XC`09`09FBUFF`09The file output buffer.`09`09`09(By Descriptor)
  566. XC`09`09RDATA`09The receive data buffer.`09`09(By Reference)
  567. XC`09`09SDATA`09The send data buffer.`09`09`09(By Reference)
  568. XC
  569. XC`09Outputs:
  570. XC`09`09True/False = Success/Failure.
  571. XC
  572. X`09IMPLICIT NONE
  573. X`09INCLUDE 'kermit_inc.for'
  574. X`09INCLUDE 'bbs_inc.for'
  575. X
  576. X`09CHARACTER*(*) FBUFF
  577. X`09BYTE RDATA (MAXDATASIZ), SDATA (MAXDATASIZ)
  578. X
  579. X`09CHARACTER*(*) MODULE_NAME
  580. X`09PARAMETER (MODULE_NAME = 'KERMIT_RECEIVE')
  581. X
  582. X`09INTEGER RECEIVE_INIT, RECEIVE_FILE, RECEIVE_DATA
  583. XC
  584. XC`09In server mode, we must start the transmission by sending an
  585. XC`09initialize "I" packet to the remote.  In non-server mode, we
  586. XC`09simply wait for the send-init packet from the remote.
  587. XC
  588. X`09STATE = 'R'`09`09`09`09! State = "Receive-Init"
  589. X`09RETRY_COUNT = 0`09`09`09`09! Initialize retry count.
  590. X`09PAKNUM = 0`09`09`09`09! Initialize packet number.
  591. X`09CALL CLEAR_TYPEAHEAD`09`09`09! Clear typeahead buffer.
  592. X
  593. XC
  594. XC`09Dispatch on the receive state.
  595. XC
  596. X`09DO WHILE (.TRUE.)
  597. X`09    IF (STATE .EQ. 'A') THEN`09`09! "Abort" state.
  598. Xc`09`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Limit exceeded?
  599. Xc`09`09    CALL REPORT_RETRYS()`09! Yes, tell the user.
  600. Xc`09`09ENDIF
  601. X`09`09CALL REPORT_ABORT()`09`09! Tell user about it.
  602. X`09`09KERMIT_RECEIVE= .FALSE.`09`09! Set failure status.
  603. X`09`09RETURN
  604. X`09    ELSEIF (STATE .EQ. 'C') THEN`09! Complete state.
  605. X`09`09KERMIT_RECEIVE = .TRUE.`09`09! Set success status.
  606. X`09`09RETURN
  607. X`09    ELSEIF (STATE .EQ. 'D') THEN`09! Receive-Data.
  608. X`09`09STATE = RECEIVE_DATA (FBUFF, RDATA, SDATA)
  609. X`09    ELSEIF (STATE .EQ. 'F') THEN`09! Receive-File.
  610. X`09`09STATE = RECEIVE_FILE (RDATA, SDATA)
  611. X`09    ELSEIF (STATE .EQ. 'R') THEN`09! Receive-Init.
  612. X`09`09STATE = RECEIVE_INIT (RDATA, SDATA)
  613. X`09    ELSE
  614. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, STATE)
  615. X`09`09KERMIT_RECEIVE = .FALSE.`09! Set failure status.
  616. X`09`09RETURN
  617. X`09    ENDIF
  618. X`09ENDDO
  619. X`09END
  620. X`0C
  621. X`09INTEGER FUNCTION RECEIVE_DATA (FBUFF, RDATA, SDATA)
  622. XC
  623. XC`09This function is used to receive the file data.
  624. XC
  625. XC`09Inputs:
  626. XC`09`09FBUFF`09The output file buffer.
  627. XC`09`09RDATA`09The receive data buffer.
  628. XC`09`09SDATA`09The send data buffer.
  629. XC
  630. XC`09Outputs:
  631. XC`09`09Return value is the next state.
  632. XC
  633. X`09IMPLICIT NONE
  634. X`09INCLUDE 'kermit_inc.for'
  635. X`09INCLUDE 'bbs_inc.for'
  636. X
  637. X`09CHARACTER*(*) FBUFF
  638. X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ)
  639. X`09BYTE`09R_STATE, R_LEN, R_NUM
  640. X`09INTEGER RECEIVE_PACKET
  641. X
  642. X`09LOGICAL`09KERMIT_UNPACK
  643. X`09CHARACTER*(*) MODULE_NAME
  644. X`09PARAMETER (MODULE_NAME = 'RECEIVE_DATA')
  645. X
  646. X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count.
  647. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ?
  648. X`09    CLOSE (UNIT=FILE_UNIT)`09`09! Close the VAX file.
  649. X`09    RECEIVE_DATA = 'A'`09`09`09! Set "Abort" state.
  650. X`09    RETURN
  651. X`09ENDIF
  652. XC
  653. XC`09Read and decode the incoming packet.
  654. XC
  655. X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM)
  656. X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet?
  657. X`09`09RECEIVE_DATA = R_STATE`09`09! Return "Abort" state.
  658. X`09`09RETURN
  659. X`09ELSEIF (R_STATE .EQ. 'D') THEN`09`09! Get Data packet ?
  660. X`09    IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ?
  661. X`09`09PACKET_COUNT = PACKET_COUNT + 1`09! Adjust the packet count.
  662. X`09`09TOTAL_PACKETS = TOTAL_PACKETS+1`09! Update the total packets.
  663. X`09`09IF (.NOT. KERMIT_UNPACK (FBUFF, RDATA, R_LEN)) THEN
  664. X`09`09    CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'A')
  665. X`09`09    CLOSE (UNIT=FILE_UNIT)`09! Close the VAX file.
  666. X`09`09    RECEIVE_DATA = 'A'`09`09! Set "Abort" state.
  667. X`09`09    RETURN
  668. X`09`09ENDIF
  669. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Y') ! Send ACK.
  670. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  671. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet.
  672. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number.
  673. X`09`09RECEIVE_DATA = STATE`09`09! Stay in this state.
  674. X`09`09RETURN
  675. X`09    ELSEIF (R_NUM .EQ. PREPAK) THEN`09! Previous packet ?
  676. X`09`09CALL KSEND_PACKET (SDATA, 0, PREPAK, 'Y') ! Re-ACK it.
  677. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  678. X`09`09RECEIVE_DATA = STATE`09`09! Stay in this state.
  679. X`09`09RETURN
  680. X`09    ELSE
  681. X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state.
  682. X`09`09RETURN
  683. X`09    ENDIF
  684. X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet.
  685. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text.
  686. X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state.
  687. X`09`09RETURN
  688. X`09ELSEIF (R_STATE .EQ. 'F') THEN`09`09! File-Header packet ?
  689. X`09    IF (R_NUM .EQ. PREPAK) THEN`09`09! Previous packet ?
  690. XC
  691. XC`09The ACK for the file header was missed, resend the ACK.
  692. XC
  693. X`09`09CALL KSEND_PACKET (SDATA, 0, PREPAK, 'Y') ! Re-ACK it.
  694. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  695. X`09`09RECEIVE_DATA = STATE`09`09! Stay in this state.
  696. X`09`09RETURN
  697. X`09    ELSE
  698. X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state.
  699. X`09`09RETURN
  700. X`09    ENDIF
  701. X`09ELSEIF (R_STATE .EQ. 'Z') THEN`09`09! End-of-file packet ?
  702. X`09    IF (R_NUM .EQ. PAKNUM) THEN`09`09! Previous packet ?
  703. X`09`09IF (RBYTES .GT. 0) THEN`09`09! Something to write ?
  704. X`09`09    CALL KERMIT_WRITE (FBUFF(1:RBYTES))
  705. X`09`09ENDIF
  706. X`09`09CLOSE (UNIT=FILE_UNIT)`09`09! Close the VAX file.
  707. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Y') ! ACK EOF.
  708. X`09`09CALL REPORT_SUCCESS()`09`09! Report transmit success.
  709. X`09`09CALL COUNT_FILES()`09`09! Count files transferred.
  710. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet.
  711. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number.
  712. X`09`09RECEIVE_DATA = 'F'`09`09! "Receive-File" state.
  713. X`09`09RETURN
  714. X`09    ELSE
  715. X`09`09CLOSE (UNIT=FILE_UNIT)`09`09! Close the VAX file.
  716. X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state.
  717. X`09`09RETURN
  718. X`09    ENDIF
  719. X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet.
  720. X`09`09CALL REPORT_ERROR (.TRUE.)`09! Show user the error.
  721. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'N') ! Send a NAK.
  722. X`09`09RECEIVE_DATA = STATE`09`09! Return current state.
  723. X`09`09RETURN
  724. X`09ELSE
  725. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE)
  726. X`09`09RECEIVE_DATA = 'A'`09`09! Return "Abort" state.
  727. X`09`09RETURN
  728. X`09ENDIF
  729. X`09END
  730. X`0C
  731. X`09INTEGER FUNCTION RECEIVE_FILE (RDATA, SDATA)
  732. XC
  733. XC`09This function is used to receive the file name.
  734. XC
  735. XC`09Inputs:
  736. XC`09`09RDATA`09The receive data buffer.
  737. XC`09`09SDATA`09The send data buffer.
  738. XC
  739. XC`09Outputs:
  740. XC`09`09Return value is the next state.
  741. XC
  742. X`09IMPLICIT NONE
  743. X`09INCLUDE 'kermit_inc.for'
  744. X`09INCLUDE 'bbs_inc.for'
  745. X
  746. X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ)
  747. X`09BYTE`09R_STATE, R_LEN, R_NUM
  748. X`09INTEGER RECEIVE_PACKET
  749. X
  750. Xc`09LOGICAL KERMIT_OPENR
  751. X`09CHARACTER*(*) MODULE_NAME
  752. X`09PARAMETER (MODULE_NAME = 'RECEIVE_FILE')
  753. X
  754. X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count.
  755. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ?
  756. X`09    RECEIVE_FILE = 'A'`09`09`09! Set "Abort" state.
  757. X`09    RETURN
  758. X`09ENDIF
  759. XC
  760. XC`09Read and decode the incoming packet.
  761. XC
  762. X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM)
  763. X`09IF (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet?
  764. X`09`09RECEIVE_FILE = R_STATE`09`09! Return "Abort" state.
  765. X`09`09RETURN
  766. X`09ELSEIF (R_STATE .EQ. 'B') THEN`09`09! Break packet ?
  767. X`09    IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ?
  768. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Y') ! Send ACK.
  769. X`09`09RECEIVE_FILE = 'C'`09`09! Return "Complete" state.
  770. X`09`09RETURN
  771. X`09    ELSE
  772. X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state.
  773. X`09`09RETURN
  774. X`09    ENDIF
  775. X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet.
  776. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text.
  777. X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state.
  778. X`09`09RETURN
  779. X`09ELSEIF (R_STATE .EQ. 'F') THEN`09`09! File-Header packet ?
  780. X`09    IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ?
  781. Xc`09`09IF (.NOT. KERMIT_OPENR (RDATA, R_LEN)) THEN
  782. Xc`09`09    CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'A')
  783. Xc`09`09    RECEIVE_FILE = 'A'`09`09! Return "Abort" state.
  784. Xc`09`09    RETURN
  785. Xc`09`09ENDIF
  786. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Y') ! Send ACK.
  787. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  788. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet.
  789. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number.
  790. X`09`09RBYTES = 0`09`09`09! The record byte count.
  791. X`09`09RECEIVE_FILE = 'D'`09`09! Return Data state.
  792. X`09`09RETURN
  793. X`09    ELSE
  794. X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state.
  795. X`09`09RETURN
  796. X`09    ENDIF
  797. X`09ELSEIF (R_STATE .EQ. 'S') THEN`09`09! Send-init packet.
  798. X`09    IF (R_NUM .EQ. PREPAK) THEN`09`09! Previous packet ?
  799. XC
  800. XC`09The ACK for the file header was missed, resend our parameters.
  801. XC
  802. X`09`09CALL KSEND_PARAMETERS (SDATA)`09! Yes, resend our params.
  803. X`09`09CALL KSEND_PACKET (SDATA, ISIZE, PREPAK, 'Y') ! Re-ACK it.
  804. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  805. X`09`09RECEIVE_FILE = STATE`09`09! Stay in this state.
  806. X`09`09RETURN
  807. X`09    ELSE
  808. X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state.
  809. X`09`09RETURN
  810. X`09    ENDIF
  811. X`09ELSEIF (R_STATE .EQ. 'Z') THEN`09`09! End-of-file packet ?
  812. X`09    IF (R_NUM .EQ. PREPAK) THEN`09`09! Previous packet ?
  813. X`09`09CALL KSEND_PACKET (SDATA, 0, PREPAK, 'Y') ! Resend ACK.
  814. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  815. X`09`09RECEIVE_FILE = STATE`09`09! Stay in this state.
  816. X`09`09RETURN
  817. X`09    ELSE
  818. X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state.
  819. X`09`09RETURN
  820. X`09    ENDIF
  821. X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet.
  822. X`09`09CALL REPORT_ERROR (.TRUE.)`09! Show user the error.
  823. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'N') ! Send a NAK.
  824. X`09`09RECEIVE_FILE = STATE`09`09! Return current state.
  825. X`09`09RETURN
  826. X`09ELSE
  827. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE)
  828. X`09`09RECEIVE_FILE = 'A'`09`09! Return "Abort" state.
  829. X`09`09RETURN
  830. X`09ENDIF
  831. X`09END
  832. X`0C
  833. X`09INTEGER FUNCTION RECEIVE_INIT (RDATA, SDATA)
  834. XC
  835. XC`09This function is used to receive the initial packet.
  836. XC
  837. XC`09Inputs:
  838. XC`09`09RDATA`09The receive data buffer.
  839. XC`09`09SDATA`09The send data buffer.
  840. XC
  841. XC`09Outputs:
  842. XC`09`09Return value is the next state.
  843. XC
  844. X`09IMPLICIT NONE
  845. X`09INCLUDE 'kermit_inc.for'
  846. X`09INCLUDE 'bbs_inc.for'
  847. X
  848. X`09BYTE`09R_STATE, R_LEN, R_NUM
  849. X`09BYTE    RDATA(MAXDATASIZ), SDATA(MAXDATASIZ)
  850. X`09INTEGER RECEIVE_PACKET
  851. X
  852. X`09CHARACTER*(*) MODULE_NAME
  853. X`09PARAMETER (MODULE_NAME = 'RECEIVE_INIT')
  854. X
  855. X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count.
  856. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ?
  857. X`09    RECEIVE_INIT = 'A'`09`09`09! Set "Abort" state.
  858. X`09    RETURN
  859. X`09ENDIF
  860. XC
  861. XC`09Read and decode the incoming packet.
  862. XC
  863. X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM)
  864. X`09IF     (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet?
  865. X`09`09RECEIVE_INIT = R_STATE`09`09! Return "Abort" state.
  866. X`09`09RETURN
  867. X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet.
  868. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text.
  869. X`09`09RECEIVE_INIT = 'A'`09`09! Set the "Abort" state.
  870. X`09`09RETURN
  871. X`09ELSEIF (R_STATE .EQ. 'S') THEN`09`09! Send-init packet.
  872. X`09   `09CALL RECEIVE_PARAMETERS (RDATA, R_LEN) ! Set receive params.
  873. X`09`09CALL KSEND_PARAMETERS (SDATA)`09! Set our init params.
  874. X`09`09CALL KSEND_PACKET (SDATA, ISIZE, PAKNUM, 'Y')
  875. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  876. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet.
  877. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number.
  878. X`09`09RECEIVE_INIT = 'F'`09`09! Set File-Receive state.
  879. X`09`09RETURN
  880. X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet.
  881. X`09`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'N') ! Send a NAK.
  882. X`09`09RECEIVE_INIT = STATE`09`09! Return current state.
  883. X`09`09RETURN
  884. X`09ELSE
  885. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE)
  886. X`09`09RECEIVE_INIT = 'A'`09`09! Return "Abort" state.
  887. X`09`09RETURN
  888. X`09ENDIF
  889. X`09END
  890. X`0C
  891. X`09LOGICAL FUNCTION KERMIT_SEND (FBUFF, RDATA, SDATA)
  892. XC
  893. XC`09This function is used to send file(s) to a remote KERMIT.
  894. XC
  895. XC`09Inputs:
  896. XC`09`09FBUFF`09Buffer for file writes.`09`09`09(By Descriptor)
  897. XC`09`09RDATA`09The receive data buffer.`09`09(By Reference)
  898. XC`09`09SDATA`09The send data buffer.`09`09`09(By Reference)
  899. XC
  900. XC`09Outputs:
  901. XC`09`09True/False = Success/Failure.
  902. XC
  903. X`09IMPLICIT NONE
  904. X`09INCLUDE 'kermit_inc.for'
  905. X`09include 'bbs_inc.for'
  906. X
  907. X`09CHARACTER*(*) FBUFF
  908. X`09BYTE RDATA (MAXDATASIZ), SDATA (MAXDATASIZ)
  909. X
  910. X`09CHARACTER*(*) MODULE_NAME
  911. X`09PARAMETER (MODULE_NAME = 'KERMIT_SEND')
  912. X
  913. X`09BYTE S_LEN`09`09`09`09! The send data length.
  914. X`09INTEGER KSEND_INIT, KSEND_FILE, KSEND_DATA, KSEND_EOF, KSEND_BREAK
  915. X
  916. X`09STATE = 'S'`09`09`09`09! Start state = Send-Init.
  917. X`09RETRY_COUNT = 0`09`09`09`09! Initialize retry count.
  918. X`09PAKNUM = 0`09`09`09`09! Initialize packet number.
  919. X`09END_OF_FILE = .FALSE.`09`09`09! Show not at end of file.
  920. X`09call clear_typeahead`09`09`09! Clear typeahead buffer.
  921. XC
  922. XC`09Loop on the send state.
  923. XC
  924. X`09DO WHILE (.TRUE.)
  925. X`09    IF (STATE .EQ. 'A') THEN`09`09! "Abort" state.
  926. Xc`09`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Limit exceeded?
  927. Xc`09`09    CALL REPORT_RETRYS()`09! Yes, tell the user.
  928. Xc`09`09ENDIF
  929. X`09`09CALL REPORT_ABORT()`09`09! Tell user about it.
  930. X`09`09CLOSE (UNIT=FILE_UNIT)`09`09! Close the VAX file.
  931. X`09`09KERMIT_SEND = .FALSE.`09`09! Set failure status.
  932. X`09`09RETURN
  933. X`09    ELSEIF (STATE .EQ. 'B') THEN`09! Send-Break state.
  934. X`09`09STATE = KSEND_BREAK (RDATA, SDATA)
  935. X`09    ELSEIF (STATE .EQ. 'C') THEN`09! Complete state.
  936. X`09`09KERMIT_SEND = .TRUE.`09`09! Set success status.
  937. X`09`09RETURN
  938. X`09    ELSEIF (STATE .EQ. 'D') THEN`09! Send-Data state.
  939. X`09`09STATE = KSEND_DATA (FBUFF, RDATA, SDATA, S_LEN)
  940. X`09    ELSEIF (STATE .EQ. 'F') THEN`09! Send-File state.
  941. X`09`09STATE = KSEND_FILE (FBUFF, RDATA, SDATA, S_LEN)
  942. X`09    ELSEIF (STATE .EQ. 'S') THEN`09! Send-Init state.
  943. X`09`09STATE = KSEND_INIT (RDATA, SDATA)
  944. X`09    ELSEIF (STATE .EQ. 'Z') THEN`09! Send-End-Of-File.
  945. X`09`09STATE = KSEND_EOF (RDATA, SDATA)
  946. X`09    ELSE
  947. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, STATE)
  948. X`09`09KERMIT_SEND = .FALSE.`09`09! Set failure status.
  949. X`09`09RETURN
  950. X`09    ENDIF
  951. X`09ENDDO
  952. X`09END
  953. X`0C
  954. X`09INTEGER FUNCTION KSEND_BREAK (RDATA, SDATA)
  955. XC
  956. XC`09This function is used to send a break (EOT).
  957. XC
  958. XC`09Inputs:
  959. XC`09`09RDATA`09The receive data buffer.
  960. XC`09`09SDATA`09The send data buffer.
  961. XC
  962. XC`09Outputs:
  963. XC`09`09Return value is the next state.
  964. XC
  965. X`09IMPLICIT NONE
  966. X`09INCLUDE 'kermit_inc.for'
  967. X`09INCLUDE 'bbs_inc.for'
  968. X
  969. X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ)
  970. X`09BYTE`09R_STATE, R_LEN, R_NUM
  971. X`09INTEGER RECEIVE_PACKET
  972. X
  973. X`09CHARACTER*(*) MODULE_NAME
  974. X`09PARAMETER (MODULE_NAME = 'KSEND_BREAK')
  975. X
  976. X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count.
  977. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ?
  978. X`09    KSEND_BREAK = 'A'`09`09`09! Set "Abort" state.
  979. X`09    RETURN
  980. X`09ENDIF
  981. XC
  982. XC`09Send the break (EOT) packet to the remote.
  983. XC
  984. X`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'B')
  985. XC
  986. XC`09Read and decode the incoming packet.
  987. XC
  988. X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM)
  989. X`09IF     (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet?
  990. X`09`09KSEND_BREAK = R_STATE`09`09! Return "Abort" state.
  991. X`09`09RETURN
  992. X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet.
  993. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text.
  994. X`09`09KSEND_BREAK = 'A'`09`09! Set the "Abort" state.
  995. X`09`09RETURN
  996. X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received.
  997. X`09`09KSEND_BREAK = STATE`09`09! Stay in this state.
  998. X`09`09RETURN
  999. X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ?
  1000. X`09    IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ?
  1001. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  1002. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet.
  1003. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number.
  1004. X`09`09KSEND_BREAK = 'C'`09`09! Set "Complete" state.
  1005. X`09`09RETURN
  1006. X`09    ELSE
  1007. X`09`09KSEND_BREAK = STATE`09`09! Stay in this state.
  1008. X`09`09RETURN
  1009. X`09    ENDIF
  1010. X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet.
  1011. X`09`09KSEND_BREAK = STATE`09`09! Stay in this state.
  1012. X`09`09RETURN
  1013. X`09ELSE
  1014. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE)
  1015. X`09`09KSEND_BREAK = 'A'`09`09! Return "Abort" state.
  1016. X`09`09RETURN
  1017. X`09ENDIF
  1018. X`09END
  1019. X`0C
  1020. X`09INTEGER FUNCTION KSEND_DATA (FBUFF, RDATA, SDATA, S_LEN)
  1021. XC
  1022. XC`09This function is used to send the file data.
  1023. XC
  1024. XC`09Inputs:
  1025. XC`09`09FBUFF`09The input file buffer.
  1026. XC`09`09RDATA`09The receive data buffer.
  1027. XC`09`09SDATA`09The send data buffer.
  1028. XC`09`09S_LEN`09The send data length.
  1029. XC
  1030. XC`09Outputs:
  1031. XC`09`09Return value is the next state.
  1032. XC
  1033. X`09IMPLICIT NONE
  1034. X`09INCLUDE 'kermit_inc.for'
  1035. X`09INCLUDE 'bbs_inc.for'
  1036. X
  1037. X`09CHARACTER*(*) FBUFF
  1038. X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ)
  1039. X`09BYTE`09R_STATE, R_LEN, R_NUM, S_LEN
  1040. X`09LOGICAL`09KERMIT_PACK
  1041. X`09INTEGER RECEIVE_PACKET
  1042. X
  1043. X`09CHARACTER*(*) MODULE_NAME
  1044. X`09PARAMETER (MODULE_NAME = 'KSEND_DATA')
  1045. X
  1046. X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count.
  1047. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ?
  1048. X`09    KSEND_DATA = 'A'`09`09`09! Set "Abort" state.
  1049. X`09    RETURN
  1050. X`09ENDIF
  1051. XC
  1052. XC`09Send a data packet to the remote.
  1053. XC
  1054. X`09CALL KSEND_PACKET (SDATA, S_LEN, PAKNUM, 'D')
  1055. XC
  1056. XC`09Read and decode the incoming packet.
  1057. XC
  1058. X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM)
  1059. X`09IF     (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet?
  1060. X`09`09KSEND_DATA = R_STATE`09`09! Return "Abort" state.
  1061. X`09`09RETURN
  1062. X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet.
  1063. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text.
  1064. X`09`09KSEND_DATA = 'A'`09`09! Set the "Abort" state.
  1065. X`09`09RETURN
  1066. X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received.
  1067. X`09`09KSEND_DATA = STATE`09`09! Stay in this state.
  1068. X`09`09RETURN
  1069. X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ?
  1070. X`09    IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ?
  1071. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  1072. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet.
  1073. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number.
  1074. X`09`09PACKET_COUNT = PACKET_COUNT + 1`09! Count the data packets.
  1075. X`09`09TOTAL_PACKETS = TOTAL_PACKETS+1`09! Update the total packets.
  1076. X`09`09CALL KERMIT_REPORT()`09`09! Update screen display.
  1077. XC
  1078. XC`09`09Fill the next data packet to send.
  1079. XC
  1080. X`09`09IF (KERMIT_PACK (FBUFF, SDATA, S_LEN)) THEN
  1081. X`09`09    KSEND_DATA = STATE`09`09! Stay in "Data" state.
  1082. X`09`09ELSE
  1083. X`09`09    KSEND_DATA = 'Z'`09`09! Set "End-of-file" state.
  1084. X`09`09ENDIF
  1085. X`09`09RETURN
  1086. X`09    ELSE
  1087. X`09`09KSEND_DATA = STATE`09`09! Stay in this state.
  1088. X`09`09RETURN
  1089. X`09    ENDIF
  1090. X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet.
  1091. X`09`09KSEND_DATA = STATE`09`09! Stay in this state.
  1092. X`09`09RETURN
  1093. X`09ELSE
  1094. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE)
  1095. X`09`09KSEND_DATA = 'A'`09`09! Return "Abort" state.
  1096. X`09`09RETURN
  1097. X`09ENDIF
  1098. X`09END
  1099. X`0C
  1100. X`09INTEGER FUNCTION KSEND_EOF (RDATA, SDATA)
  1101. XC
  1102. XC`09This function is used to send the end of file.
  1103. XC
  1104. XC`09Inputs:
  1105. XC`09`09RDATA`09The receive data buffer.
  1106. XC`09`09SDATA`09The send data buffer.
  1107. XC
  1108. XC`09Outputs:
  1109. XC`09`09Return value is the next state.
  1110. XC
  1111. X`09IMPLICIT NONE
  1112. X`09INCLUDE 'kermit_inc.for'
  1113. X`09INCLUDE 'bbs_inc.for'
  1114. X
  1115. X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ)
  1116. X`09BYTE`09R_STATE, R_LEN, R_NUM
  1117. Xc`09LOGICAL NEXT_REMFILE
  1118. X`09INTEGER RECEIVE_PACKET
  1119. X
  1120. X`09CHARACTER*(*) MODULE_NAME
  1121. X`09PARAMETER (MODULE_NAME = 'KSEND_EOF')
  1122. X
  1123. X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count.
  1124. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ?
  1125. X`09    KSEND_EOF = 'A'`09`09`09! Set "Abort" state.
  1126. X`09    RETURN
  1127. X`09ENDIF
  1128. XC
  1129. XC`09Send an end of file packet to the remote.
  1130. XC
  1131. X`09CALL KSEND_PACKET (SDATA, 0, PAKNUM, 'Z')
  1132. XC
  1133. XC`09Read and decode the incoming packet.
  1134. XC
  1135. X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM)
  1136. X`09IF     (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet?
  1137. X`09`09KSEND_EOF = R_STATE`09`09! Return "Abort" state.
  1138. X`09`09RETURN
  1139. X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet.
  1140. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text.
  1141. X`09`09KSEND_EOF = 'A'`09`09`09! Set the "Abort" state.
  1142. X`09`09RETURN
  1143. X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received.
  1144. X`09`09KSEND_EOF = STATE`09`09! Stay in this state.
  1145. X`09`09RETURN
  1146. X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ?
  1147. X`09    IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ?
  1148. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  1149. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet.
  1150. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number.
  1151. X`09`09CALL REPORT_SUCCESS()`09`09! Report success message.
  1152. Xc`09`09IF (NEXT_REMFILE()) THEN`09! Check for another file.
  1153. Xc`09`09    CALL COUNT_FILES()`09`09! Count files transferred.
  1154. Xc`09`09    KSEND_EOF = 'F'`09`09! Set "File-Header" state.
  1155. Xc`09`09    END_OF_FILE = .FALSE.`09! Reset end of file flag.
  1156. Xc`09`09ELSE`09`09`09`09! No more files to send.
  1157. X`09`09    KSEND_EOF = 'B'`09`09! Switch to "Break" state.
  1158. Xc`09`09ENDIF
  1159. X`09`09RETURN
  1160. X`09    ELSE
  1161. X`09`09KSEND_EOF = STATE`09`09! Stay in this state.
  1162. X`09`09RETURN
  1163. X`09    ENDIF
  1164. X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet.
  1165. X`09`09KSEND_EOF = STATE`09`09! Stay on this state.
  1166. X`09`09RETURN
  1167. X`09ELSE
  1168. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE)
  1169. X`09`09KSEND_EOF = 'A'`09`09`09! Return "Abort" state.
  1170. X`09`09RETURN
  1171. X`09ENDIF
  1172. X`09END
  1173. X`0C
  1174. X`09INTEGER FUNCTION KSEND_FILE (FBUFF, RDATA, SDATA, S_LEN)
  1175. XC
  1176. XC`09This function is used to send the file name.  Upon switching to
  1177. XC`09the Data State, the send data buffer is filled with the first
  1178. XC`09packet data from the input file.
  1179. XC
  1180. XC`09Inputs:
  1181. XC`09`09FBUFF`09The input file buffer.
  1182. XC`09`09RDATA`09The receive data buffer.
  1183. XC`09`09SDATA`09The send data buffer.
  1184. XC`09`09S_LEN`09The send data length.
  1185. XC
  1186. XC`09Outputs:
  1187. XC`09`09Return value is the next state.
  1188. XC
  1189. XC`09If Data State:
  1190. XC`09`09SDATA`09The first data packet.
  1191. XC`09`09S_LEN`09The data packet length.
  1192. XC
  1193. XC
  1194. X`09IMPLICIT NONE
  1195. X`09INCLUDE 'kermit_inc.for'
  1196. X`09INCLUDE 'bbs_inc.for'
  1197. X
  1198. X`09CHARACTER*(*) FBUFF
  1199. X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ)
  1200. X`09BYTE`09R_STATE, R_LEN, R_NUM, S_LEN
  1201. X`09LOGICAL`09KERMIT_PACK
  1202. X`09INTEGER`09RECEIVE_PACKET
  1203. X`09INTEGER RSIZE,ISTAT,STR$TRIM
  1204. X
  1205. X`09CHARACTER*(*) MODULE_NAME
  1206. X`09PARAMETER (MODULE_NAME = 'KSEND_FILE')
  1207. X
  1208. X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count.
  1209. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ?
  1210. X`09    KSEND_FILE = 'A'`09`09`09! Set "Abort" state.
  1211. X`09    RETURN
  1212. X`09ENDIF
  1213. XC
  1214. XC`09Send the file header packet to the remote.
  1215. XC
  1216. X`09istat = str$trim (remote_file,remote_file,rsize)
  1217. X`09CALL KSEND_PACKET (%REF(REMOTE_FILE), RSIZE, PAKNUM, 'F')
  1218. XC
  1219. XC`09Read and decode the incoming packet.
  1220. XC
  1221. X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM)
  1222. X`09IF     (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet?
  1223. X`09`09KSEND_FILE = R_STATE`09`09! Return "Abort" state.
  1224. X`09`09RETURN
  1225. X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet.
  1226. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text.
  1227. X`09`09KSEND_FILE = 'A'`09`09! Set the "Abort" state.
  1228. X`09`09RETURN
  1229. X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received.
  1230. X`09`09KSEND_FILE = STATE`09`09! Stay in this state.
  1231. X`09`09RETURN
  1232. X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ?
  1233. X`09    IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ?
  1234. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  1235. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet.
  1236. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number.
  1237. XC
  1238. XC`09`09Fill the send packet with the first packet data.
  1239. XC
  1240. X`09`09RBYTES = 0`09`09`09! The record byte count.
  1241. X`09`09IF (KERMIT_PACK (FBUFF, SDATA, S_LEN)) THEN
  1242. X`09`09    KSEND_FILE = 'D'`09`09! Set "Data" state.
  1243. X`09`09ELSE
  1244. X`09`09    KSEND_FILE = 'Z'`09`09! Set "End-of-file" state.
  1245. X`09`09ENDIF
  1246. X`09`09RETURN
  1247. X`09    ELSE
  1248. X`09`09KSEND_FILE = STATE`09`09! Stay in this state.
  1249. X`09`09RETURN
  1250. X`09    ENDIF
  1251. X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet.
  1252. X`09`09KSEND_FILE = STATE`09`09! Stay in this state.
  1253. X`09`09RETURN
  1254. X`09ELSE
  1255. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE)
  1256. X`09`09KSEND_FILE = 'A'`09`09! Return "Abort" state.
  1257. X`09`09RETURN
  1258. X`09ENDIF
  1259. X`09END
  1260. X`0C
  1261. X`09INTEGER FUNCTION KSEND_INIT (RDATA, SDATA)
  1262. XC
  1263. XC`09This function is used to send the initial parameters.
  1264. XC
  1265. XC`09Inputs:
  1266. XC`09`09RDATA`09The receive data buffer.
  1267. XC`09`09SDATA`09The send data buffer.
  1268. XC
  1269. XC`09Outputs:
  1270. XC`09`09Return value is the next state.
  1271. XC
  1272. X`09IMPLICIT NONE
  1273. X`09INCLUDE 'kermit_inc.for'
  1274. X`09INCLUDE 'bbs_inc.for'
  1275. X
  1276. X`09BYTE`09RDATA (MAXDATASIZ), SDATA (MAXDATASIZ)
  1277. X`09BYTE`09R_STATE, R_LEN, R_NUM
  1278. X`09INTEGER RECEIVE_PACKET
  1279. X
  1280. X`09CHARACTER*(*) MODULE_NAME
  1281. X`09PARAMETER (MODULE_NAME = 'KSEND_INIT')
  1282. X
  1283. X`09RETRY_COUNT = RETRY_COUNT + 1`09`09! Adjust the retry count.
  1284. X`09IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN`09! Retry limit exceeded ?
  1285. X`09    KSEND_INIT = 'A'`09`09`09! Set "Abort" state.
  1286. X`09    RETURN
  1287. X`09ENDIF
  1288. XC
  1289. XC`09Send our init parameters to the remote.
  1290. XC
  1291. X`09CALL KSEND_PARAMETERS (SDATA)`09`09! Set our init params.
  1292. X`09CALL KSEND_PACKET (SDATA, ISIZE, PAKNUM, 'S')
  1293. XC
  1294. XC`09Read and decode the incoming packet.
  1295. XC
  1296. X`09R_STATE = RECEIVE_PACKET (RDATA, R_LEN, R_NUM)
  1297. X`09IF     (R_STATE .EQ. 'A') THEN`09`09! "Abort" packet?
  1298. X`09`09KSEND_INIT = R_STATE`09`09! Return "Abort" state.
  1299. X`09`09RETURN
  1300. X`09ELSEIF (R_STATE .EQ. 'E') THEN`09`09! Error received packet.
  1301. X`09`09CALL KERMIT_ERROR (RDATA, R_LEN)! Display the error text.
  1302. X`09`09KSEND_INIT = 'A'`09`09! Set the "Abort" state.
  1303. X`09`09RETURN
  1304. X`09ELSEIF (R_STATE .EQ. 'N') THEN`09`09! NAK packet received.
  1305. X`09`09KSEND_INIT = STATE`09`09! Stay in this state.
  1306. X`09`09RETURN
  1307. X`09ELSEIF (R_STATE .EQ. 'Y') THEN`09`09! Get expected ACK ?
  1308. X`09    IF (R_NUM .EQ. PAKNUM) THEN`09`09! Get expected packet ?
  1309. X`09   `09CALL RECEIVE_PARAMETERS (RDATA, R_LEN) ! Set receive params.
  1310. X`09`09RETRY_COUNT = 0`09`09`09! Init the retry count.
  1311. X`09`09PREPAK = PAKNUM`09`09`09! Save previous packet.
  1312. X`09`09PAKNUM = MOD (PAKNUM+1, 64)`09! Adjust packet number.
  1313. X`09`09KSEND_INIT = 'F'`09`09! Set File-Receive state.
  1314. X`09`09RETURN
  1315. X`09    ELSE
  1316. X`09`09KSEND_INIT = STATE`09`09! Stay in this state.
  1317. X`09`09RETURN
  1318. X`09    ENDIF
  1319. X`09ELSEIF (R_STATE .EQ. .FALSE.) THEN`09! Didn't get a packet.
  1320. X`09`09KSEND_INIT = STATE`09`09! Stay in this state.
  1321. X`09`09RETURN
  1322. X`09ELSE
  1323. X`09`09CALL UNEXPECTED_STATE (MODULE_NAME, R_STATE)
  1324. X`09`09KSEND_INIT = 'A'`09`09! Return "Abort" state.
  1325. X`09`09RETURN
  1326. X`09ENDIF
  1327. X`09END
  1328. X`0C
  1329. X`09INTEGER FUNCTION KERMIT_CHECKSUM (P_DATA, P_SIZE)
  1330. XC
  1331. XC`09This function is used to calculate the KERMIT checksum.
  1332. XC
  1333. XC`09Inputs:
  1334. XC`09`09P_DATA`09The data buffer.
  1335. XC`09`09P_SIZE`09The data size.
  1336. XC
  1337. XC`09Outputs:
  1338. XC`09`09Returns the calculated checksum.
  1339. XC
  1340. X`09IMPLICIT NONE
  1341. X`09INCLUDE 'kermit_inc.for'
  1342. X
  1343. X`09BYTE P_DATA (MAXPACKSIZ)
  1344. X`09INTEGER P_SIZE, CHECKSUM, I
  1345. X
  1346. X`09CHECKSUM = 0`09`09`09! Initialize the checksum.
  1347. X`09DO I = 1, P_SIZE
  1348. X`09    CHECKSUM = CHECKSUM + P_DATA(I) ! Accumulate the checksum.
  1349. X`09ENDDO
  1350. X`09CHECKSUM = ( (ISHFT (CHECKSUM .AND. "300, -6) + CHECKSUM) .AND. "077)
  1351. X`09KERMIT_CHECKSUM = CHECKSUM`09! Return the checksum.
  1352. X`09RETURN
  1353. X`09END
  1354. X`0C
  1355. X`09SUBROUTINE KERMIT_ERROR (P_DATA, P_LEN)
  1356. XC
  1357. XC`09This function is used to report an error message received from the
  1358. XC`09remote in an error packet.
  1359. XC
  1360. XC`09Inputs:
  1361. XC`09`09P_DATA`09Packet data with error text.
  1362. XC`09`09P_LEN`09The packet data length.
  1363. XC
  1364. XC`09Outputs:
  1365. XC`09`09None.
  1366. XC
  1367. X`09IMPLICIT NONE
  1368. X`09INCLUDE 'kermit_inc.for'
  1369. X`09INCLUDE 'bbs_inc.for'
  1370. X
  1371. X`09BYTE`09P_DATA (MAXDATASIZ)
  1372. X`09BYTE`09P_LEN
  1373. X
  1374. X`09INTEGER SIZE
  1375. X`09CALL WRITE_USER (SS//
  1376. X`091  '*** Aborting with this error from the remote KERMIT: ***'//SS)
  1377. X`09SIZE = P_LEN`09`09`09`09! Convert to longword value.
  1378. Xc`09CALL WRITE_BUFFER (P_DATA, SIZE)`09! Write the error text.
  1379. Xc`09CALL WRITE_USER (SS)`09`09`09! Single space the output.
  1380. X`09RETURN
  1381. X`09END
  1382. X`0C
  1383. X`09LOGICAL FUNCTION KERMIT_OPENR (P_DATA, P_LEN)
  1384. XC
  1385. XC`09This function is used to open the VAX file when receiving a file.
  1386. XC
  1387. XC`09Inputs:
  1388. XC`09`09P_DATA`09Packet data with file name.
  1389. XC`09`09P_LEN`09The packet data length.
  1390. XC
  1391. XC`09Outputs:
  1392. XC`09`09Return .TRUE./.FALSE. = Success/Failure.
  1393. XC
  1394. X`09IMPLICIT NONE
  1395. X`09INCLUDE 'kermit_inc.for'
  1396. X`09include 'bbs_inc.for'
  1397. X
  1398. X`09BYTE`09P_DATA (MAXDATASIZ)
  1399. X`09BYTE`09P_LEN
  1400. X
  1401. X`09INTEGER I
  1402. X`09CHARACTER*(*) MODULE_NAME
  1403. X`09PARAMETER (MODULE_NAME = 'KERMIT_OPENR')
  1404. XC
  1405. XC`09Open the VAX file for output.
  1406. XC
  1407. X`09IF (FILE_TYPE.EQ.BINARY) THEN
  1408. X`09    OPEN (UNIT=FILE_UNIT, TYPE='NEW', NAME=VAX_FILE(1:VSIZE),
  1409. X`091`09`09RECORDSIZE=OUT_SIZE, CARRIAGECONTROL='NONE',
  1410. X`091`09`09BUFFERCOUNT=2, ERR=9900)
  1411. X`09ELSE
  1412. X`09    OPEN (UNIT=FILE_UNIT, TYPE='NEW', NAME=VAX_FILE(1:VSIZE),
  1413. X`091`09`09RECORDSIZE=OUT_SIZE, CARRIAGECONTROL='LIST',
  1414. X`091`09`09BUFFERCOUNT=2, ERR=9900)
  1415. X`09ENDIF
  1416. +-+-+-+-+-+-+-+-  END  OF PART 7 +-+-+-+-+-+-+-+-
  1417.