home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
decpro300.zip
/
promsg.bli
< prev
next >
Wrap
Text File
|
1988-08-16
|
148KB
|
6,525 lines
%TITLE 'KERMSG - Kermit message processing'
MODULE KERMSG (IDENT = '3.0.041'
) =
BEGIN
SWITCHES LANGUAGE (COMMON);
!<BLF/WIDTH:100>
!++
! FACILITY:
! Kermit-10, VMS Kermit, Pro/Kermit
!
! ABSTRACT:
! KERMSG is the message processing routines for Kermit-10, VMS Kermit,
! and PRO/Kermit.
! This module is written in common BLISS, so that it can be
! transported for the DECsystem-10 and VAX/VMS systems.
!
! ENVIRONMENT:
! User mode
!
! AUTHOR: Robert C. McQueen, CREATION DATE: 24-January-1983
!
! MODIFIED BY:
!
!--
%SBTTL 'Table of Contents'
!+
!.pag.lit
! Table of Contents for KERMSG
!
!
! Section Page
! 1. Revision History . . . . . . . . . . . . . . . . . . . 3
! 2. Interface requirements . . . . . . . . . . . . . . . . 4
! 3. Declarations
! 3.1. Forward definitions . . . . . . . . . . . . . 5
! 4. Require files. . . . . . . . . . . . . . . . . . . . . 28
! 5. Macro definitions. . . . . . . . . . . . . . . . . . . 29
! 6. KERMIT Protocol Definitions. . . . . . . . . . . . . . 30
! 6.1. Packet offsets. . . . . . . . . . . . . . . . 31
! 6.2. Message dependent field . . . . . . . . . . . 32
! 6.3. SEND initiate packet. . . . . . . . . . . . . 33
! 7. KERMIT Protocol States . . . . . . . . . . . . . . . . 34
! 8. Internal constants . . . . . . . . . . . . . . . . . . 35
! 9. Storage - External . . . . . . . . . . . . . . . . . . 36
! 10. Storage - Local. . . . . . . . . . . . . . . . . . . . 37
! 11. External references. . . . . . . . . . . . . . . . . . 38
! 12. MSG_INIT . . . . . . . . . . . . . . . . . . . . . . . 39
! 13. SND_ERROR. . . . . . . . . . . . . . . . . . . . . . . 40
! 14. SERVER - Server mode . . . . . . . . . . . . . . . . . 41
! 15. SEND_SWITCH. . . . . . . . . . . . . . . . . . . . . . 42
! 16. REC_SWITCH . . . . . . . . . . . . . . . . . . . . . . 43
! 17. Server
! 17.1. DO_GENERIC - Execute a generic command. . . . 44
! 18. DO_TRANSACTION - Main loop for FSM . . . . . . . . . . 45
! 19. REC_SERVER_IDLE - Idle server state. . . . . . . . . . 46
! 20. SEND_SERVER_INIT . . . . . . . . . . . . . . . . . . . 47
! 21. SEND_DATA. . . . . . . . . . . . . . . . . . . . . . . 48
! 22. SEND_FILE. . . . . . . . . . . . . . . . . . . . . . . 49
! 23. SEND_EOF . . . . . . . . . . . . . . . . . . . . . . . 50
! 24. SEND_INIT. . . . . . . . . . . . . . . . . . . . . . . 51
! 25. SEND_OPEN_FILE - Open file for sending . . . . . . . . 52
! 26. SEND_GENCMD. . . . . . . . . . . . . . . . . . . . . . 53
! 27. SEND_BREAK . . . . . . . . . . . . . . . . . . . . . . 54
! 28. REC_INIT . . . . . . . . . . . . . . . . . . . . . . . 55
! 29. REC_FILE . . . . . . . . . . . . . . . . . . . . . . . 56
! 30. REC_DATA . . . . . . . . . . . . . . . . . . . . . . . 57
! 31. SERVER - Generic commands. . . . . . . . . . . . . . . 58
! 32. HOST_COMMAND - perform a host command. . . . . . . . . 59
! 33. CALL_SY_RTN - handle operating system dependent functions 60
! 34. Message processing
! 34.1. PRS_SEND_INIT - Parse send init params. . . . 61
! 35. SET_SEND_INIT. . . . . . . . . . . . . . . . . . . . . 62
! 36. SEND_PACKET. . . . . . . . . . . . . . . . . . . . . . 63
! 37. REC_MESSAGE - Receive a message. . . . . . . . . . . . 64
! 38. REC_PACKET . . . . . . . . . . . . . . . . . . . . . . 65
! 39. CALC_BLOCK_CHECK . . . . . . . . . . . . . . . . . . . 66
! 40. NORMALIZE_FILE - Put file name into normal form. . . . 67
! 41. Buffer filling
! 41.1. Main routine. . . . . . . . . . . . . . . . . 68
! 42. BFR_EMPTY. . . . . . . . . . . . . . . . . . . . . . . 69
! 43. Buffer filling and emptying subroutines. . . . . . . . 70
! 44. Add parity routine . . . . . . . . . . . . . . . . . . 71
! 45. Parity routine . . . . . . . . . . . . . . . . . . . . 72
! 46. Per transfer
! 46.1. Initialization. . . . . . . . . . . . . . . . 73
! 47. Statistics
! 47.1. Finish message transfer . . . . . . . . . . . 74
! 48. Status type out
! 48.1. STS_OUTPUT. . . . . . . . . . . . . . . . . . 75
! 49. TYPE_CHAR - Type out a character . . . . . . . . . . . 76
! 50. Debugging
! 50.1. DBG_SEND. . . . . . . . . . . . . . . . . . . 77
! 50.2. DBG_RECEIVE . . . . . . . . . . . . . . . . . 78
! 50.3. DBG_MESSAGE . . . . . . . . . . . . . . . . . 79
! 51. End of KERMSG. . . . . . . . . . . . . . . . . . . . . 80
!.end lit.pag
!-
%SBTTL 'Revision History'
!++
! Start of version 1.
!
! 1.0.000 By: Robert C. McQueen On: 4-Jan-1983
! Create this program.
!
! 1.0.001 By: Robert C. McQueen On: 30-Apr-1983
! Change PAR_xxx to be PR_xxx, so that they can be used for
! KERMIT-10.
!
! 1.0.002 By: Robert C. McQueen On: 1-May-1983
! Add DO_GENERIC routine to cause a generic Kermit command to
! be executed on the remote Kermit.
!
! 1.0.003 By: Robert C. McQueen On: 3-May-1983
! Fix message number incrementing.
!
! 1.0.004 By: Robert C. McQueen On: 4-May-1983
! Allow RECEIVE file-specification to work correctly.
!
! 1.0.005 By: Robert C. McQueen On: 6-May-1983
! Add more stats support.
!
! 1.0.006 By: Nick Bush On: 13-June-1983
! Fix SEND_PACKET to copy correct characters when fixing
! parity bits.
!
! 1.1.007 By: Nick Bush On: 15-July-1983
! Correct SEND-INIT message handling to do the right things
! with the protocol version 3 items.
!
! 1.1.010 By: Robert C. McQueen On: 20-July-1983
! Make PARITY a global routine, so that it can be called by
! CONNECT processing. Change the name from PARITY to GEN_PARITY
! add a new routine to generate the parity, since it is not
! part of the checksum.
!
! 1.1.011 By: Robert C. McQueen On: 28-July-1983
! KER_TIMEOUT errors in the SERVER loop would cause
! KER_UNISRV error messages to be returned to the remote.
! Check for receive failures and send NAKs instead.
!
! 1.2.012 By: Robert C. McQueen On: 23-August-1983
! Don't abort if we get a message that is just an end of line
! character. It could be noise on the line.
!
! 1.2.013 By: Nick Bush On: 7-September-1983
! Fix several problems with the SEND_xxx parameters
!
! 1.2.014 By: Robert C. McQueen On: 15-September-1983
! Add routine calls to XFR_STATUS to tell the user on the
! number of packets have changed.
!
! 1.2.015 By: Nick Bush On: 5-October-1983
! Add 2 and 3 character checksum (block check) support.
! Add support for data within acknowledgement packets
! and withing end-of-file packets to allow for file
! transmission to be aborted. Also add support for
! "I" packet to allow server parameters to be initialized.
!
! 1.2.016 By: Nick Bush On: 19-October-1983
! Add repeat character support.
!
! 2.0.017 Release TOPS-10 Kermit-10 version 2.0
! Release VAX/VMS Kermit-32 version 2.0
!
! 2.0.018 By: Robert C. McQueen On: 16-November-1983
! Fix four checks on the message number that were not
! mod 64.
!
! 2.0.019 By: Robert C. McQueen On: 16-November-1983
! Remove the CLEAR routine. It is not really needed.
!
! 2.0.020 By: Nick Bush On: 12-Dec-1983
! Fix SEND_DATA and BFR_FILL to handle empty files and
! files which happen to end just on a message boundary.
! This would sometimes produce extra nulls.
!
! 2.0.021 By: Nick Bush On: 15-Dec-1983
! Fix some problems with REC_MESSAGE which would cause
! aborts when a message timed out.
!
! 2.0.022 By: Robert C. McQueen 19-Dec-1983
! Make STATUS a local for most routines and remove FILE_DUMP
! as it is nolonger needed.
!
! 2.0.023 By: Nick Bush On: 3-Jan-1984
! Change FIL_NORMAL_FORM to contain not just a flag, but
! a file name type instead.
!
! 2.0.024 By: Nick Bush On: 11-Jan-1984
! Fix REC_MESSAGE to send NAK for packet we expect, not
! previous packet.
!
! 2.0.025 By: Nick Bush On: 23-Jan-1984
! Re-enable server-init packet and complete code so that
! parameters set by it will remain set.
! Fix file name copying to use BFR_FILL or BFR_EMPTY
! so that all quoting/compression is done properly.
!
! 2.0.026 By: Nick Bush On: 15-Feb-1984
! Add code for generic command support (both directions).
! There is now only one state dispatch loop, entered
! in various states for different functions.
!
! 2.0.027 By: Robert C. McQueen On: 16-Feb-1984
! At some point SEND_TIMEOUT became global, but it was not moved
! to KERGLB. This edit moves it to KERGLB.BLI.
!
! 2.0.030 By: Nick Bush On: 2-March-1984
! Fix BFR_FILL to handle case of last repeated character
! not fitting within a packet. It was forgetting to
! send the characters at all.
!
! 2.0.031 By: Nick Bush On: 6-March-1984
! Make sure FILE_OPEN_FLAG is set properly when advancing
! to next file of a wild-card send. The file was not
! being set true, leading to problems after a couple files.
!
! 2.0.032 By: Nick Bush On: 9-March-1984
! Fix UNPACK_DATA in SERVER_GENERIC to properly store
! new string pointer.
!
! 2.0.033 By: Robert C. McQueen On: 12-March-1984
! If NEXT_FILE fails with anything other than a NOMORFILES
! it should change state to STATE_A not STATE_SB. This
! fixes a problem caused by Pro/Kermit and KERFIL (VMS).
!
! 2.0.034 By: Nick Bush On: 15-March-1984
! Put file spec into X packet as well as F packet. This
! makes wild card TYPE's work nicer.
!
! 2.0.035 By: Nick Bush On: 20-March-1984
! Fix send/receive quoting to conform to the way the
! protocol manual says it should be done, rather
! than the way we (and Kermit-20) have always done it.
!
! 2.0.036 By: Nick Bush On: 28-March-1984
! Make SERVER_GENERIC more defensive against badly
! constructed packets. If an argument has negative
! length, punt the request. Also put angle brackets
! around data from "X" packet header, so file names will
! stick out.
!
! 3.0.037 Start of version 3.
!
! 3.0.040 By: Nick Bush On: 2-April-1984
! Add separate server timeout. This allows stopping the
! server NAK's without affecting the normal packet timeout.
!
! 3.0.041 By: Nick Bush On: 12-April-1984
! Fix block check calculation to account for the fact
! that the parity bits are put onto the message when
! it is sent (in place), so that if a retransmission is
! done without refilling the buffer (as is normal with
! data messages), the parity bits will be there. Make
! sure we strip them out for block check calculation.
!--
%SBTTL 'Interface requirements'
!++
! Interface requirements
!
! The following routines and data locations are rquired for a correct
! implementation of KERMIT.
!
! File routines:
!
! FILE_OPEN (Function)
! This routine will open a file for reading or writting. It
! will assume that FILE_SIZE contains the number of bytes
! and FILE_NAME contains the file name of length FILE_SIZE.
! The function that is passed is either FNC_READ or FNC_WRITE.
!
! FILE_CLOSE ()
! This routine will close the currently open file. This
! routine will return the status of the operation.
!
! GET_FILE (Character)
! This routine will get a character from the currently open file
! and store it in the location specified by "Character". There
! will be a true/false value returned by the routine to determine
! if there was an error.
!
! PUT_FILE (Character)
! This routine will output a character to the currently open
! file. It will return a true/false value to determine if the
! routine was successful.
!
! NEXT_FILE ()
! This routine will advance to the next file. This routine
! will return false if there are no more files to process.
!
! Communications line routines:
!
! RECEIVE (Buffer address, Address of var to store length into)
! This routine will receive a message from the remote Kermit.
!
! SEND (Buffer address, Length in characters)
! This routine will send a message to the remote Kermit.
!
! GEN_CRC (Buffer address, length in characters)
! This routine will calculate the CRC-CCITT for the characters
! in the buffer.
!
! Operating system routines:
!
! SY_DISMISS (Seconds)
! This routine will cause Kermit to sleep for the specified
! number of seconds. It is used to handle the DELAY parameter.
!
! SY_LOGOUT ()
! Log the job off of the system. (Kill the process).
!
! SY_TIME ()
! This routine will return the starting time milliseconds.
! It can be the start of Kermit, the system, etc, so long
! as it always is incrementing.
!
! Status routines:
!
! XFR_STATUS (Type, Subtype);
! This routine is called to indicate the occurance of
! a significant event that the user interface may wish
! to inform the user about. The arguments indicate the
! type of event.
! Type: "S" - Send, "R" - Receive
! Subtype: "P" - Packet
! "N" - NAK
! "T" - timeout
! For type = "I" (initiate), "T" (terminate):
! Subtype: "S" - a file send
! "R" - a file receive
! "G" - a generic command
! "I" - for "T" only, returning to server idle
! For type = "F" (file operation):
! Subtype: "S" - open for sending
! "R" - open for receiving
! "C" - closing file OK
! "X" - aborting file by user request
! "Z" - aborting group by user request
! "D" - aborting file, but saving due to disposition
! "A" - aborting file due to protocol error
!
! Error processing:
!
! KRM_ERROR (Error parameter)
! This routine will cause an error message to be issued.
! The error parameter is defined by KERERR. This may cause
! SND_ERROR to be called to send an "E" message to the remote.
!
! Terminal I/O routines:
!
! TERM_DUMP (Buffer, Count)
! DBG_DUMP (Buffer, Count)
! This routine will dump the buffer onto the user's terminal.
! The routine is supplied with the count of the characters
! and the address of the buffer.
! These may be the same routine or different. DBG_DUMP
! is only called for debugging output.
!
!
! ENTRY POINTS
!
! KERMSG contains the following entry points for the KERMIT.
!
! SERVER ()
! This routine will cause KERMIT go enter server mode.
!
! SEND_SWITCH ()
! This routine will send a file. It expects that the user
! has stored the text of the file name into FILE_NAME and
! the length of the text into FILE_SIZE.
!
! REC_SWITCH ()
! This routine will receive a file. It expects that the default
! file name is set up in FILE_NAME and the length is in
! FILE_SIZE.
!
! GEN_PARITY (Character)
! This routine will return the character with the proper parity
! on the character.
!
! SND_ERROR (COUNT, ADDRESS)
! This routine will send the text of an error to the remote
! Kermit.
!
! DO_GENERIC (TYPE)
! This routine will cause a generic function to be sent to
! the remote Kermit. This routine will then do all of the
! necessary hand shaking to handle the local end of the generic
! Kermit command.
!
!
! GLOBAL Storage
!
! The following are the global storage locations that are used to interface
! to KERMSG. These locations contains the various send and receive parameters.
!
! Receive parameters:
!
! RCV_PKT_SIZE
! Receive packet size.
! RCV_NPAD
! Padding length
! RCV_PADCHAR
! Padding character
! RCV_TIMEOUT
! Time out
! RCV_EOL
! End of line character
! RCV_QUOTE_CHR
! Quote character
! RCV_8QUOTE_CHR
! 8-bit quoting character
! RCV_SOH
! Start of header character
!
! Send parameters (Negative values denote the default, positive user supplied):
!
! SND_PKT_SIZE
! Send packet size
! SND_NPAD
! Padding length
! SND_PADCHAR
! Padding character
! SND_TIMEOUT
! Time out
! SND_EOL
! End of line character
! SND_QUOTE_CHR
! Quote character
! SND_SOH
! Start of header character (normally 001)
!
! Statistics:
!
! SND_TOTAL_CHARS
! Total characters sent for this Kermit session
! RCV_TOTAL_CHARS
! Total characters received for this Kermit session
! SND_DATA_CHARS
! Total number of data characters sent for this Kermit session
! RCV_DATA_CHARS
! Total number of data characters received for this Kermit session
! SND_COUNT
! Total number of packets that have been sent
! RCV_COUNT
! Total number of packets that have been received.
! SMSG_TOTAL_CHARS
! Total characters sent for this file transfer
! RMSG_TOTAL_CHARS
! Total characters received for this file transfer
! SMSG_DATA_CHARS
! Total data characters sent for this file transfer
! RMSG_DATA_CHARS
! Total data characters received for this file transfer
! SMSG_NAKS
! Total number of NAKs sent for this file transfer
! RMSG_NAKS
! Total number of NAKs received for this file transfer
! XFR_TIME
! Amount of time the last transfer took in milliseconds.
! TOTAL_TIME
! Total amount of time spend transfering data.
!
! Misc constants:
!
! LAST_ERROR
! ASCIZ of the last error message issued.
! FILE_NAME
! Vector containing the ASCII characters of the file name.
! FILE_SIZE
! Number of characters in the FILE_NAME vector.
! DELAY
! Amount of time to delay
! DUPLEX
! DP_HALF or DP_FULL to denote either half duplex or full duplex.
! [Currently only DP_FULL is supported]
! PKT_RETRIES
! Number of retries to attempt to read a message.
! SI_RETRIES
! Number of retries to attempt on send inits
! DEBUG_FLAG
! Debugging mode on/off
! WARN_FLAG
! File warning flag
! IBM_FLAG
! True if talking to an IBM system, else false.
! ECHO_FLAG
! Local echo flag
! CONNECT_FLAG
! Connected flag; True if terminal and SET LINE are the same
! PARITY_TYPE
! Type of parity to use on sends.
! DEV_PARITY_FLAG
! Device will add parity to message. True if device adds
! parity and false if we must do it.
!
!--
%SBTTL 'Declarations -- Forward definitions'
!<BLF/NOFORMAT>
!
! Forward definitions
!
FORWARD ROUTINE
! Main loop for a complete transaction
DO_TRANSACTION, ! Perform a complete transaction
! Send processing routines
SEND_SERVER_INIT, ![026] Send a server init packet
SEND_DATA, ! Send data to the micro
SEND_FILE, ! Send file name
SEND_OPEN_FILE, ! Open file for sending
SEND_GENCMD, ! Send generic command
SEND_EOF, ! Send EOF
SEND_INIT, ! Send initialization msg
SEND_BREAK, ! Send break end of transmission
! Receive processing routines
REC_SERVER_IDLE, ! Wait for message while server is idle
REC_INIT, ! Receive initialization
REC_FILE, ! Receive file information
REC_DATA, ! Receive data
!
! Server processing routines
!
SERVER_GENERIC, ! Process generic KERMIT commands
HOST_COMMAND, ! Process host command
KERMIT_COMMAND, ! Process Kermit command
CALL_SY_RTN, ! Handle calling system routine and returning result
!
! Statistic gathering routines
!
END_STATS : NOVALUE, ! End of a message processing stats routine
! Low level send/receive routines
CALC_BLOCK_CHECK, ! Routine to calculate the block check value
SET_SEND_INIT : NOVALUE, ! Set up the MSG_SND_INIT parameters.
PRS_SEND_INIT, ! Parse MSG_SND_INIT parameters.
DO_PARITY : NOVALUE, ! Routine to generate parity for a message
GEN_PARITY, ! Routine to add parity to a character
SEND_PACKET, ! Send a packet to the remote
REC_MESSAGE, ! Receive a message with retry processing
REC_PACKET, ! Receive a packet from the remote
! Utility routines
NORMALIZE_FILE : NOVALUE, ! Force file name into normal form
BFR_EMPTY, ! Empty the data buffer
BFR_FILL, ! Fill the data buffer from a file
SET_STRING, ![025] Routine to set alternate get/put routines
! for use with in memory strings
TYPE_CHAR, ! Type a character from a packet
INIT_XFR : NOVALUE, ! Initialize the per transfer processing
STS_OUTPUT : NOVALUE, ! Output current transfer status
!
! Debugging routines
!
DBG_MESSAGE : NOVALUE, ! Type out a formatted message
DBG_SEND : NOVALUE, ! Send message debugging routine
DBG_RECEIVE : NOVALUE; ! Receive message debugging routine
%SBTTL 'Require files'
!
!<BLF/FORMAT>
!
! REQUIRE FILES:
!
%IF %BLISS (BLISS32)
%THEN
LIBRARY 'SYS$LIBRARY:STARLET';
%FI
REQUIRE 'KERCOM';
REQUIRE 'KERERR';
%SBTTL 'Macro definitions'
!
! MACROS:
!
MACRO
CTL (C) =
((C) XOR %O'100')%,
CHAR (C) =
((C) + %O'40')%,
UNCHAR (C) =
((C) - %O'40')%;
%SBTTL 'KERMIT Protocol Definitions'
!++
! The following describes the various items that are found in the
! KERMIT messages. A complete and through desription of the protocol can be
! found in the KERMIT PROTOCOL MANUAL.
!
!
! All KERMIT messages have the following format:
!
! <Mark><CHAR(Count)><CHAR(Seq)><Message-dependent information><Check><EOL>
!
! <MARK>
! Normally SOH (Control-A, octal 001).
!
! <CHAR(Count)>
! Count of the number of characters following this position.
! Character counts of ONLY 0 to 94 are valid.
!
! <CHAR(Seq)>
! Packet sequence number, modulo 100 (octal).
!
! <MESSAGE-DEPENDENT INFORMATION>
! This field contains the message dependent information. There can
! be multiple fields in this section. See the KERMIT Protocol document
! for a complete description of this.
!
! <Check>
! A block check on the characters in the packet between, but not
! including, the mark and the checksum itself. It may be one to three
! characters, depending upon the type agreed upon.
!
! 1. Single character arithmetic sum equal to:
! chksum = (s + ((s AND 300)/100)) AND 77
! Character sent is CHAR(chksum).
!
! 2. Two character arithmetic sum. CHAR of bits 6-11 are the first
! character, CHAR of bits 0-5 are the second character.
!
! 3. Three character CRC-CCITT. First character is CHAR of bits 12-15,
! second is CHAR of bits 6-11, third is CHAR of bits 0-5.
!
!
! <EOL>
! End of line. Any line terminator that may be required by the host.
!--
%SBTTL 'KERMIT Protocol Definitions -- Packet offsets'
!++
! The following define the various offsets of the standard KERMIT
! packets.
!--
LITERAL
PKT_MARK = 0, ! <MARK>
PKT_COUNT = 1, ! <CHAR(Count)>
PKT_SEQ = 2, ! <CHAR(Seq)>
PKT_TYPE = 3, ! <Message type>
PKT_MSG = 4, ! <MESSAGE-DEPENDENT INFORMATION>
PKT_MAX_MSG = 94 - 5, ! Maximum size of the message dependent
! information
PKT_CHKSUM = 0, ! <CHAR(Chksum)> offset from end of
! Message dependent information
PKT_EOL = 1, ! <Eol> offset from end of data
PKT_OVR_HEAD_B = 2, ! Header overhead
PKT_OVR_HEAD_E = 1, ! Overhead at the end
PKT_OVR_HEAD = 3, ! Overhead added to data length
PKT_TOT_OVR_HEAD = 6; ! Total overhead of the message
%SBTTL 'KERMIT Protocol Definitions -- Message dependent field'
!++
! The MESSAGE-DEPENDENT information field of the message contains at
! least one part. That is the type of message. The remainder of the message
! MESSAGE-DEPENDENT field is different depending on the message.
!
! <TYPE><TYPE-DEPENDENT-INFORMATION>
!
! <TYPE>
! The type defines the type of message that is being processed.
!
!--
! Protocol version 1.0 message types
LITERAL
MSG_DATA = %C'D', ! Data packet
MSG_ACK = %C'Y', ! Acknowledgement
MSG_NAK = %C'N', ! Negative acknowledgement
MSG_SND_INIT = %C'S', ! Send initiate
MSG_BREAK = %C'B', ! Break transmission
MSG_FILE = %C'F', ! File header
MSG_EOF = %C'Z', ! End of file (EOF)
MSG_ERROR = %C'E'; ! Error
! Protocol version 2.0 message types
LITERAL
MSG_RCV_INIT = %C'R', ! Receive initiate
MSG_COMMAND = %C'C', ! Host command
MSG_GENERIC = %C'G', ! Generic KERMIT command.
MSG_KERMIT = %C'K'; ! Perform KERMIT command (text)
! Protocol version 4.0 message types
LITERAL
MSG_SER_INIT = %C'I', ! Server initialization
MSG_TEXT = %C'X'; ! Text header message
!++
! Generic KERMIT commands
!--
LITERAL
MSG_GEN_LOGIN = %C'I', ! Login
MSG_GEN_EXIT = %C'F', ! Finish (exit to OS)
MSG_GEN_CONNECT = %C'C', ! Connect to a directory
MSG_GEN_LOGOUT = %C'L', ! Logout
MSG_GEN_DIRECTORY = %C'D', ! Directory
MSG_GEN_DISK_USAGE = %C'U', ! Disk usage
MSG_GEN_DELETE = %C'E', ! Delete a file
MSG_GEN_TYPE = %C'T', ! Type a file specification
! MSG_GEN_SUBMIT = %C'S', ! Submit
! MSG_GEN_PRINT = %C'P', ! Print
MSG_GEN_WHO = %C'W', ! Who's logged in
MSG_GEN_SEND = %C'M', ! Send a message to a user
MSG_GEN_HELP = %C'H', ! Help
MSG_GEN_QUERY = %C'Q', ! Query status
MSG_GEN_RENAME = %C'R', ! Rename file
MSG_GEN_COPY = %C'K', ! Copy file
MSG_GEN_PROGRAM = %C'P', ! Run program and pass data
MSG_GEN_JOURNAL = %C'J', ! Perform journal functions
MSG_GEN_VARIABLE = %C'V'; ! Return/set variable state
!
! Acknowledgement modifiers (protocol 4.0)
!
LITERAL
MSG_ACK_ABT_CUR = %C'X', ! Abort current file
MSG_ACK_ABT_ALL = %C'Z'; ! Abort entire stream of files
!
! End of file packet modifier
!
LITERAL
MSG_EOF_DISCARD = %C'D'; ! Discard data from previous file
%SBTTL 'KERMIT Protocol Definitions -- SEND initiate packet'
!++
!
! The following describes the send initiate packet. All fields in the message
! data area are optional.
!
! <"S"><CHAR(Bufsiz)><CHAR(Timeout)><CHAR(npad)><CTL(pad)><CHAR(Eol)><Quote>
! <8-bit-quote><Check-type><Repeat-count-processing><Reserved><Reserved>
!
! BUFSIZ
! Sending Kermit's maximum buffer size.
!
! Timeout
! Number of seconds after which the sending Kermit wishes to be timed out
!
! Npad
! Number of padding caracters the sending Kermit needs preceding each
! packet.
!
! PAD
! Padding character.
!
! EOL
! A line terminator required on all packets set by the receiving
! Kermit.
!
! Quote
! The printable ASCII characer the sending Kermit will use when quoting
! the control cahracters. Default is "#".
!
! 8-bit-quote
! Specify quoting mecanism for 8-bit quantities. A quoting mecanism is
! mecessary when sending to hosts which prevent the use of the 8th bit
! for data. When elected, the quoting mechanism will be used by both
! hosts, and the quote character must be in the range of 41-76 or 140-176
! octal, but different from the control-quoting character. This field is
! interpreted as follows:
!
! "Y" - I agree to 8-bit quoting if you request it.
! "N" - I will not do 8-bit quoting.
! "&" - (or any other character in the range of 41-76 or 140-176) I want
! to do 8-bit quoting using this character (it will be done if the
! other Kermit puts a "Y" in this field.
! Anything else: Quoting will not be done.
!
! Check-type
! Type of block check. The only values presently allowed in this
! field are "1", "2" or "3". Future implementations may allow other
! values. Interpretation of the values is:
!
! "1" - Single character checksum. Default value if none specified.
! "2" - Double character checksum.
! "3" - Three character CRC.
!
! Repeat-count-processing
! The prefix character to be used to indicate a repeated character.
! This can be any printable cahracter other than blank (which denotes
! no repeat count).
!
! Fields 10 to 11 reserved.
!--
LITERAL
P_SI_BUFSIZ = 0, ! Buffersize
MY_PKT_SIZE = 80, ! My packet size
P_SI_TIMOUT = 1, ! Time out
MY_TIME_OUT = 15, ! My time out
P_SI_NPAD = 2, ! Number of padding characters
MY_NPAD = 0, ! Amount of padding I require
P_SI_PAD = 3, ! Padding character
MY_PAD_CHAR = 0, ! My pad character
P_SI_EOL = 4, ! End of line character
MY_EOL_CHAR = %O'015', ! My EOL cahracter
P_SI_QUOTE = 5, ! Quote character
MY_QUOTE_CHAR = %C'#', ! My quoting character
P_SI_8QUOTE = 6, ! 8-bit quote
MY_8BIT_QUOTE = %C'&', ! Don't do it
P_SI_CHKTYPE = 7, ! Checktype used
MY_CHKTYPE = CHK_1CHAR, ! Use single character checksum
P_SI_REPEAT = 8, ! Repeat character
MY_REPEAT = %C'~', ! My repeat character
P_SI_LENGTH = 9; ! Length of the message
%SBTTL 'KERMIT Protocol States'
!++
! The following are the various states that KERMIT can be in.
! The state transitions are defined in the KERMIT Protocol manual.
!--
LITERAL
STATE_MIN = 1, ! Min state number
STATE_S = 1, ! Send init state
STATE_SF = 2, ! Send file header
STATE_SD = 3, ! Send file data packet
STATE_SZ = 4, ! Send EOF packet
STATE_SB = 5, ! Send break
STATE_R = 6, ! Receive state (wait for send-init)
STATE_RF = 7, ! Receive file header packet
STATE_RD = 8, ! Receive file data packet
STATE_C = 9, ! Send complete
STATE_A = 10, ! Abort
STATE_SX = 11, ! Send text header
STATE_SG = 12, ! Send generic command
STATE_SI = 13, ! Send server init
STATE_ID = 14, ! Server idle loop
STATE_II = 15, ! Server idle after server init
STATE_FI = 16, ! Server should exit
STATE_LG = 17, ! Server should logout
STATE_OF = 18, ! Send - open first input file
STATE_EX = 19, ! Exit back to command parser
STATE_ER = 20, ! Retries exceeded error
STATE_MAX = 20; ! Max state number
%SBTTL 'Internal constants'
!++
! The following represent various internal KERMSG constants.
!--
LITERAL
MAX_PKT_RETRIES = 16, ! Maximum packet retries
MAX_SI_RETRIES = 5; ! Maximum send init retries
%SBTTL 'Storage - External'
!
! OWN STORAGE:
!
EXTERNAL
!
! Receive parameters
!
RCV_PKT_SIZE, ! Receive packet size
RCV_NPAD, ! Padding length
RCV_PADCHAR, ! Padding character
RCV_TIMEOUT, ! Time out
RCV_EOL, ! EOL character
RCV_QUOTE_CHR, ! Quote character
RCV_SOH, ! Start of header character
RCV_8QUOTE_CHR, ! 8-bit quoting character
!
! Miscellaneous parameters
!
SET_REPT_CHR, ! Repeat character
!
! Send parameters
!
SND_PKT_SIZE, ! Send packet size
SND_NPAD, ! Padding length
SND_PADCHAR, ! Padding character
SND_TIMEOUT, ! Time out
SND_EOL, ! EOL character
SND_QUOTE_CHR, ! Quote character
SND_SOH, ! Start of header character
SEND_TIMEOUT, ! Time to wait for receiving message
!
! Server parameters
!
SRV_TIMEOUT, ! Time between NAK's when server is idle
!
! Statistics
!
SND_TOTAL_CHARS, ! Total characters sent
RCV_TOTAL_CHARS, ! Total characters received
SND_DATA_CHARS, ! Total number of data characters sent
RCV_DATA_CHARS, ! Total number of data characters received
SND_NAKS, ! Total NAKs sent
RCV_NAKS, ! Total NAKs received
SND_COUNT, ! Count of total number of packets
RCV_COUNT, ! Count of total number packets received
SMSG_COUNT, ! Total number of packets sent
RMSG_COUNT, ! Total number of packets received
SMSG_TOTAL_CHARS, ! Total chars sent this file xfer
RMSG_TOTAL_CHARS, ! Total chars rcvd this file xfer
SMSG_DATA_CHARS, ! Total data chars this file xfer
RMSG_DATA_CHARS, ! Total data chars this file xfer
SMSG_NAKS, ! Total number of NAKs this file xfer
RMSG_NAKS, ! Total number of NAKs received
XFR_TIME, ! Amount of time last xfr took
TOTAL_TIME, ! Total time of all xfrs
! this file xfer
LAST_ERROR : VECTOR [CH$ALLOCATION (MAX_MSG + 1)], ! Last error message
!
! Misc constants.
!
FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
FILE_SIZE,
SI_RETRIES, ! Send init retries to attempt
PKT_RETRIES, ! Number of retries to try for a message
DELAY, ! Amount of time to delay
DUPLEX, ! Type of connection (half or full)
PARITY_TYPE, ! Type of parity to use
DEV_PARITY_FLAG, ! True if output device does
! parity, false if we do it
CHKTYPE, ! Type of block check desired
ABT_FLAG, ! True if aborted file should be discarded
DEBUG_FLAG, ! Debugging mode on/off
WARN_FLAG, ! File warning flag
IBM_FLAG, ! Talking to an IBM system
IBM_CHAR, ! Turnaround character for IBM mode
ECHO_FLAG, ! Local echo flag
CONNECT_FLAG, ! Connected flag; True if
! terminal and SET LINE are
! the same
ABT_CUR_FILE, ! Abort current file
ABT_ALL_FILE, ! Abort all files in stream
TYP_STS_FLAG, ! Type status next message
TY_FIL, ! Type file specs
TY_PKT, ! Type packet info
FIL_NORMAL_FORM, ! If true, file names should be normalized
GEN_1DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Data for generic command
GEN_1SIZE, ! Size of data in GEN_1DATA
GEN_2DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Second argument for generic command
GEN_2SIZE, ! Size of data in GEN_2DATA
GEN_3DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Third arg for generic command
GEN_3SIZE; ! Size of data in GEN_3DATA
%SBTTL 'Storage - Local'
!
! LOCAL OWN STORAGE:
!
OWN
!
! Receive parameters
!
RECV_8QUOTE_CHR, ! 8th-bit quoting character
REPT_CHR, ! Repeat prefix character
!
! Send parameters
!
SEND_PKT_SIZE, ! Send packet size
SEND_NPAD, ! Padding length
SEND_PADCHAR, ! Padding character
SEND_EOL, ! EOL character
SEND_QUOTE_CHR, ! Quote character
SEND_8QUOTE_CHR, ! 8-bit quoting character
!
! Misc parameters
!
INI_CHK_TYPE, ! Type of block checking from init message
BLK_CHK_TYPE, ! Type of block check to use
FLAG_8QUOTE, ! Flag to determine if doing 8bit quoting
FLAG_REPEAT, ! True if doing repeated character compression
STATE, ! Current state
SIZE, ! Size of the current message
OLD_RETRIES, ! Saved number of retries done.
NUM_RETRIES, ! Number of retries
MSG_NUMBER, ! Current message number
REC_SEQ, ! Sequence number of msg in REC_MSG
REC_LENGTH, ! Length of the message recv'd
REC_TYPE, ! Type of the message received.
REC_MSG : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)], ! Message received
SND_MSG : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)], ! Message sent
FILE_OPEN_FLAG, ! File is opened.
FILE_CHARS, ! Number of characters sent or received
TEXT_HEAD_FLAG, ! Text header received, not file header
NO_FILE_NEEDED, ! Don't open a file
INIT_PKT_SENT, ! Server-init sent and ACKed
GEN_TYPE, ! Command message type
GEN_SUBTYPE, ! Generic command subtype
GET_CHR_ROUTINE, ![025] Address of routine to get a character for BFR_FILL
PUT_CHR_ROUTINE; ![025] Address of routine to put a character for BFR_EMPTY
%SBTTL 'External references'
!
! EXTERNAL REFERENCES:
!
! Packet I/O routines
EXTERNAL ROUTINE
SEND, ! Send a packet to the remote
IBM_WAIT, ! Wait for IBM turnaround
RECEIVE; ! Receive a packet from the remote
!
! Terminal I/O routines
!
EXTERNAL ROUTINE
TERM_DUMP : NOVALUE, ! Normal terminal output
DBG_DUMP : NOVALUE, ! Debugging output
TT_SET_OUTPUT, ! Set output routine
TT_CHAR : NOVALUE, ! Output a single character
TT_CRLF : NOVALUE, ! Output a CRLF
TT_NUMBER : NOVALUE, ! Output a three digit number to the
! terminal
TT_TEXT : NOVALUE, ! Output a string to the user's
TT_OUTPUT : NOVALUE; ! Force buffered output to terminal
! Operating system routines and misc routines
EXTERNAL ROUTINE
CRCCLC, ! Calculate a CRC-CCITT
XFR_STATUS : NOVALUE, ! Routine to tell the user the
! status of a transfer
KRM_ERROR : NOVALUE, ! Issue an error message
SY_LOGOUT : NOVALUE, ! Log the job off
SY_GENERIC, ! Perform a generic command
SY_TIME, ! Return elapsed time in milliseconds
SY_DISMISS : NOVALUE; ! Routine to dismiss for n seconds.
!
! External file processing routines
!
EXTERNAL ROUTINE
FILE_OPEN, ! Open a file for reading/writing
FILE_CLOSE, ! Close an open file
NEXT_FILE, ! Determine if there is a next file
! and open it for reading.
GET_FILE, ! Get a byte from the file
PUT_FILE; ! Put a byte in the file.
%SBTTL 'MSG_INIT'
GLOBAL ROUTINE MSG_INIT : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will initialize the message processing for
! KERMIT-32/36.
!
! CALLING SEQUENCE:
!
! MSG_INIT();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
!
! Initialize some variables
!
! Receive parameters first
!
RCV_PKT_SIZE = MY_PKT_SIZE;
RCV_NPAD = MY_NPAD;
RCV_PADCHAR = MY_PAD_CHAR;
RCV_TIMEOUT = MY_TIME_OUT;
RCV_EOL = MY_EOL_CHAR;
RCV_QUOTE_CHR = MY_QUOTE_CHAR;
RCV_SOH = CHR_SOH;
RCV_8QUOTE_CHR = MY_8BIT_QUOTE;
SET_REPT_CHR = MY_REPEAT;
!
! Send parameters.
!
SND_PKT_SIZE = -MY_PKT_SIZE;
SND_NPAD = -MY_NPAD;
SND_PADCHAR = -MY_PAD_CHAR;
SND_TIMEOUT = -MY_TIME_OUT;
SND_EOL = -MY_EOL_CHAR;
SND_QUOTE_CHR = -MY_QUOTE_CHAR;
SND_SOH = CHR_SOH;
!
! Server parameters
!
SRV_TIMEOUT = 5*MY_TIME_OUT;
!
! Other random parameters
!
PKT_RETRIES = MAX_PKT_RETRIES; ! Number of retries per message
SI_RETRIES = MAX_SI_RETRIES; ! Number of retries on send inits
DELAY = INIT_DELAY;
DUPLEX = DP_FULL; ! Use full duplex
DEBUG_FLAG = FALSE;
WARN_FLAG = FALSE;
ECHO_FLAG = FALSE;
BLK_CHK_TYPE = CHK_1CHAR; ! Start using single char checksum
CHKTYPE = MY_CHKTYPE; ! Desired block check type
INI_CHK_TYPE = .CHKTYPE; ! Same as default for now
DEV_PARITY_FLAG = FALSE; ! We generate parity
PARITY_TYPE = PR_NONE; ! No parity
ABT_FLAG = TRUE; ! Discard incomplete files
FILE_OPEN_FLAG = FALSE;
IBM_FLAG = FALSE; ! Not talking to an IBM
IBM_CHAR = CHR_DC1; ! XON is IBM turnaround character
TY_FIL = TRUE; ! Default to typing files
TY_PKT = FALSE; ! But not packet numbers
FIL_NORMAL_FORM = FNM_NORMAL; ! Default to normal form names
GET_CHR_ROUTINE = GET_FILE; ![025] Initialize the get-a-char routine
PUT_CHR_ROUTINE = PUT_FILE; ![025] And the put-a-char
END; ! End of MSG_INIT
%SBTTL 'SND_ERROR'
GLOBAL ROUTINE SND_ERROR (COUNT, ADDRESS) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will send an error packet to the remote KERMIT. It
! is called with the count of characters and the address of the text.
!
! CALLING SEQUENCE:
!
! SND_ERROR(COUNT, %ASCII 'Error text');
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
!
!--
BEGIN
!
! Pack the message into the buffer
!
SET_STRING (CH$PTR (.ADDRESS), .COUNT, TRUE);
BFR_FILL (TRUE);
SET_STRING (0, 0, FALSE);
!
! Save the last error message also
!
IF .COUNT GTR MAX_MSG THEN COUNT = MAX_MSG;
CH$COPY (.COUNT, CH$PTR (.ADDRESS), 0, MAX_MSG + 1, CH$PTR (LAST_ERROR));
IF NOT SEND_PACKET (MSG_ERROR, .SIZE, .MSG_NUMBER) THEN RETURN KER_ABORTED;
END; ! End of SND_ERROR
%SBTTL 'SERVER - Server mode'
GLOBAL ROUTINE SERVER =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle the server function in the v2.0 protocol
! for KERMIT. This routine by it's nature will call various operating
! system routines to do things like logging off the system.
!
! CALLING SEQUENCE:
!
! EXIT_FLAG = SERVER();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS; ! Status returned by various routines
DO
BEGIN
INIT_XFR ();
XFR_STATUS (%C'T', %C'I'); ! Now idle
STATUS = DO_TRANSACTION (STATE_ID);
END
UNTIL .STATUS EQL KER_EXIT OR .STATUS EQL KER_ABORTED;
RETURN .STATUS;
END; ! End of GLOBAL ROUTINE SERVER
%SBTTL 'SEND_SWITCH'
GLOBAL ROUTINE SEND_SWITCH =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is the state table switcher for sending files. It
! loops until either it is finished or an error is encountered. The
! routines called by SEND_SWITCH are responsible for changing the state.
!
! CALLING SEQUENCE:
!
! SEND_SWITCH();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! Returns:
! TRUE - File sent correctly.
! FALSE - Aborted sending the file.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS; ! Status result
IF .CONNECT_FLAG THEN SY_DISMISS (.DELAY); ! Sleep if the user wanted us to
INIT_XFR (); ! Initialize for this transfer
TEXT_HEAD_FLAG = FALSE; ! Set text flag correctly
XFR_STATUS (%C'I', %C'S'); ! Start of file send
STATUS = DO_TRANSACTION (STATE_S); ! Call routine to do real work
XFR_STATUS (%C'T', %C'S'); ! Done with send
RETURN .STATUS; ! Return the result
END;
%SBTTL 'REC_SWITCH'
GLOBAL ROUTINE REC_SWITCH =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will cause file(s) to be received by the remote
! KERMIT. This routine contains the main loop for the sending of the
! data.
!
! CALLING SEQUENCE:
!
! REC_SWITCH();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! FILE_DESC - Descriptor describing the file to be received by
! the remote KERMIT.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! True - File received correctly.
! FALSE - File transfer aborted.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
INIT_STATE, ! State to start up DO_TRANSACTION in
STATUS; ! Status returned by various routines
INIT_STATE = STATE_R; ! Initialize the state
MSG_NUMBER = 0;
INIT_XFR (); ! Initialize the per transfer info
!
! Determine if they said REC <file-spec>
! Send MSG_RCV_INIT and then receive the file
!
IF .FILE_SIZE GTR 0
THEN
BEGIN
GEN_TYPE = MSG_RCV_INIT; ! Use receive-init message
CH$MOVE (.FILE_SIZE, CH$PTR (FILE_NAME), CH$PTR (GEN_1DATA));
GEN_1SIZE = .FILE_SIZE; ! Save the length
INIT_STATE = STATE_SI; ! Start out with server init
END;
!
! Now receive the file normally
!
XFR_STATUS (%C'I', %C'R'); ! Start of a file receive
STATUS = DO_TRANSACTION (.INIT_STATE);
XFR_STATUS (%C'T', %C'R'); ! End of file receive
RETURN .STATUS; ! Return the result
END; ! End of REC_SWITCH
%SBTTL 'Server -- DO_GENERIC - Execute a generic command'
GLOBAL ROUTINE DO_GENERIC (TYPE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will send a generic command to the remote Kermit.
! it will do all the processing required for the generic command
! that was executed. It will return to the caller after the
! command has be executed.
!
! CALLING SEQUENCE:
!
! STATUS = DO_GENERIC (Command-type);
!
! INPUT PARAMETERS:
!
! Command-type -- Command type to be executed.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
INIT_STATE; ! Initial state for FSM
!
! Set up the per transfer items
!
INIT_XFR ();
NUM_RETRIES = 0;
MSG_NUMBER = 0;
!
! These are all generic commands
!
GEN_TYPE = MSG_GENERIC;
!
! Assume we will not need server init
!
INIT_STATE = STATE_SG;
CASE .TYPE FROM GC_MIN TO GC_MAX OF
SET
[GC_EXIT] :
GEN_SUBTYPE = MSG_GEN_EXIT;
[GC_LOGOUT] :
GEN_SUBTYPE = MSG_GEN_LOGOUT;
[GC_DIRECTORY] :
BEGIN
INIT_STATE = STATE_SI; ! We will need server-init
GEN_SUBTYPE = MSG_GEN_DIRECTORY;
END;
[GC_DISK_USAGE] :
BEGIN
INIT_STATE = STATE_SI; ! We will need server-init
GEN_SUBTYPE = MSG_GEN_DISK_USAGE;
END;
[GC_DELETE] :
GEN_SUBTYPE = MSG_GEN_DELETE;
[GC_TYPE] :
BEGIN
INIT_STATE = STATE_SI; ! We will need server-init
GEN_SUBTYPE = MSG_GEN_TYPE;
END;
[GC_HELP] :
BEGIN
INIT_STATE = STATE_SI; ! We will need server-init
GEN_SUBTYPE = MSG_GEN_HELP;
END;
[GC_LGN] :
GEN_SUBTYPE = MSG_GEN_LOGIN; ! Login just gets ACK
[GC_CONNECT] :
GEN_SUBTYPE = MSG_GEN_CONNECT; ! CWD just gets ACK
[GC_RENAME] :
GEN_SUBTYPE = MSG_GEN_RENAME; ! Rename file just needs ACK
[GC_COPY] :
GEN_SUBTYPE = MSG_GEN_COPY; ! Copy file just needs ACK
[GC_WHO] :
BEGIN
INIT_STATE = STATE_SI; ! May get large response
GEN_SUBTYPE = MSG_GEN_WHO;
END;
[GC_SEND_MSG] :
GEN_SUBTYPE = MSG_GEN_SEND; ! Just need an ACK
[GC_STATUS] :
BEGIN
INIT_STATE = STATE_SI; ! May get large response
GEN_SUBTYPE = MSG_GEN_QUERY;
END;
[GC_COMMAND] :
BEGIN
INIT_STATE = STATE_SI; ! Large response likely
GEN_TYPE = MSG_COMMAND; ! This is host command
END;
[GC_KERMIT] :
GEN_TYPE = MSG_KERMIT; ! Perform Kermit command (short response)
[GC_PROGRAM] :
BEGIN
INIT_STATE = STATE_SI; ! Assume large response
GEN_SUBTYPE = MSG_GEN_PROGRAM; ! Generic program command
END;
[GC_JOURNAL] :
GEN_SUBTYPE = MSG_GEN_JOURNAL; ! Do journal function (short reply)
[GC_VARIABLE] :
GEN_SUBTYPE = MSG_GEN_VARIABLE; ! Set or get a variable value
[INRANGE, OUTRANGE] :
BEGIN
KRM_ERROR (KER_UNIMPLGEN);
RETURN STATE_A;
END;
TES;
RETURN DO_TRANSACTION (.INIT_STATE); ! Go do the command
END; ! End of DO_GENERIC
%SBTTL 'DO_TRANSACTION - Main loop for FSM'
ROUTINE DO_TRANSACTION (INIT_STATE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This is the main routine for performing a Kermit transaction.
! It is structured as a finite state machine with each state
! determining the next based upon the packet which is received.
! It is supplied with the initial state by the caller.
!
! CALLING SEQUENCE:
!
! Status = DO_TRANSACTION(.INIT_STATE);
!
! INPUT PARAMETERS:
!
! INIT_STATE - Initial state.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
RETURN_VALUE;
NUM_RETRIES = 0; ! Initialize the number of retries
STATE = .INIT_STATE; ! Initialize the state
WHILE TRUE DO
CASE .STATE FROM STATE_MIN TO STATE_MAX OF
SET
!
! Send states
!
[STATE_ID] :
!
! Server while idle. Set the timeout to twice the normal wait
! and wait for something to show up
!
BEGIN
LOCAL
SAVED_TIMEOUT;
SAVED_TIMEOUT = .SEND_TIMEOUT;
IF .SEND_TIMEOUT NEQ 0 THEN SEND_TIMEOUT = .SRV_TIMEOUT;
STATE = REC_SERVER_IDLE ();
SEND_TIMEOUT = .SAVED_TIMEOUT;
END;
[STATE_II] :
!
! Here while server idle after having received a server-init packet
!
STATE = REC_SERVER_IDLE ();
[STATE_FI, STATE_LG] :
!
! Here when we are supposed to exit
!
RETURN KER_EXIT;
[STATE_SD] :
STATE = SEND_DATA ();
[STATE_SF] :
STATE = SEND_FILE ();
[STATE_SZ] :
STATE = SEND_EOF ();
[STATE_S] :
STATE = SEND_INIT ();
[STATE_OF] :
STATE = SEND_OPEN_FILE ();
[STATE_SI] :
STATE = SEND_SERVER_INIT ();
[STATE_SG] :
STATE = SEND_GENCMD ();
[STATE_SB] :
STATE = SEND_BREAK ();
!
! Receiving of the data and the end of file message.
!
[STATE_RD] :
STATE = REC_DATA ();
!
! Receiving the FILE information of the break to end the transfer of
! one or more files
!
[STATE_RF] :
STATE = REC_FILE ();
!
! Initialization for the receiving of a file
!
[STATE_R] :
STATE = REC_INIT ();
!
! Here if we have completed the receiving of the file
!
[STATE_C] :
BEGIN
RETURN_VALUE = TRUE;
EXITLOOP;
END;
!
! Here if we aborted the transfer or we have gotten into some random
! state (internal KERMSG problem).
!
[STATE_A, STATE_EX, STATE_ER, INRANGE, OUTRANGE] :
BEGIN
RETURN_VALUE = FALSE;
IF .STATE EQL STATE_EX THEN RETURN_VALUE = KER_ABORTED;
!
! Determine if the file is still open and if so close it
!
IF .FILE_OPEN_FLAG
THEN
BEGIN
FILE_OPEN_FLAG = FALSE;
IF ( NOT .CONNECT_FLAG) AND .TY_FIL
THEN
BEGIN
TT_TEXT (UPLIT (%ASCIZ' [Aborted]'));
TT_CRLF ();
END;
FILE_CLOSE (.ABT_FLAG AND (.STATE EQL STATE_A OR .STATE EQL STATE_EX OR .STATE
EQL STATE_ER));
XFR_STATUS (%C'F', %C'A');
END;
!
! Give error if aborted due to too many retries
!
IF .STATE EQL STATE_ER THEN KRM_ERROR (KER_RETRIES);
EXITLOOP;
END;
TES;
!
! End the stats and return to the caller
!
END_STATS ();
!
RETURN .RETURN_VALUE;
END; ! End of DO_TRANSACTION
%SBTTL 'REC_SERVER_IDLE - Idle server state'
ROUTINE REC_SERVER_IDLE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called from DO_TRANSACTION when is the server idle
! state. It will receive a message and properly dispatch to the new
! state.
!
! CALLING SEQUENCE:
!
! STATE = REC_SERVER_IDLE ();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! Almost everything.
!
! OUPTUT PARAMETERS:
!
! Routine value is new state for FSM
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS;
STATUS = REC_PACKET ();
!
! Now determine what to do by the type of message we have receive.
!
IF .STATUS EQL KER_ABORTED THEN RETURN STATE_EX;
IF .STATUS
THEN
BEGIN
SELECTONE .REC_TYPE OF
SET
!
! Server initialization message received. ACK the
! message and continue.
!
[MSG_SER_INIT] :
BEGIN
IF (STATUS = PRS_SEND_INIT ())
THEN
BEGIN
SET_SEND_INIT ();
IF (STATUS = SEND_PACKET (MSG_ACK, P_SI_LENGTH, .REC_SEQ))
THEN
BEGIN
SND_PKT_SIZE = -.SEND_PKT_SIZE;
SND_TIMEOUT = -.SEND_TIMEOUT;
SND_NPAD = -.SEND_NPAD;
SND_PADCHAR = -.SEND_PADCHAR;
SND_EOL = -.SEND_EOL;
SND_QUOTE_CHR = -.SEND_QUOTE_CHR;
RCV_8QUOTE_CHR = .SEND_8QUOTE_CHR;
CHKTYPE = .INI_CHK_TYPE;
SET_REPT_CHR = .REPT_CHR;
RETURN STATE_II; ! Now idle after INIT
END;
END;
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
!
! Send init message received. We must ACK the message and
! then attempt to receive a file from the remote.
!
[MSG_SND_INIT] :
BEGIN
MSG_NUMBER = (.REC_SEQ + 1) AND %O'77';
IF (STATUS = PRS_SEND_INIT ())
THEN
BEGIN
SET_SEND_INIT ();
!
! ACK the message then receive everything.
!
IF SEND_PACKET (MSG_ACK, P_SI_LENGTH, .REC_SEQ)
THEN
BEGIN
BLK_CHK_TYPE = .INI_CHK_TYPE; ! Switch to desired form of block check
XFR_STATUS (%C'I', %C'R'); ! Start of file receive
RETURN STATE_RF;
END;
END;
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
!
! Here if we receive a receive init message.
! We will be sending a file to the other end.
!
[MSG_RCV_INIT] :
BEGIN
!
! Move the file specification if we received one
!
SET_STRING (CH$PTR (FILE_NAME), MAX_FILE_NAME, TRUE);
BFR_EMPTY ();
FILE_SIZE = SET_STRING (0, 0, FALSE);
CH$WCHAR (CHR_NUL, CH$PTR (FILE_NAME, .FILE_SIZE));
IF .FILE_SIZE GTR 0
THEN
BEGIN
XFR_STATUS (%C'I', %C'S'); ! Start of a file send
RETURN STATE_S;
END;
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
!
! Generic KERMIT commands
!
[MSG_GENERIC] :
RETURN SERVER_GENERIC ();
!
! Host command
!
[MSG_COMMAND] :
RETURN HOST_COMMAND ();
!
! Kermit command
!
[MSG_KERMIT] :
RETURN KERMIT_COMMAND ();
!
! Unimplimented server routines
!
[OTHERWISE] :
BEGIN
KRM_ERROR (KER_UNISRV);
RETURN STATE_A;
END;
TES;
END;
!
! If we get here, we must have gotten something random. Therefore,
! just send a NAK and remain in the current state (unless we have done this
! too many times).
!
NUM_RETRIES = .NUM_RETRIES + 1;
IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_A;
IF SEND_PACKET (MSG_NAK, 0, 0) THEN RETURN .STATE ELSE RETURN STATE_EX;
END; ! End of REC_SERVER_IDLE
%SBTTL 'SEND_SERVER_INIT'
ROUTINE SEND_SERVER_INIT =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will send a server initialization message to the
! remote KERMIT.
!
! CALLING SEQUENCE:
!
! STATE = SEND_SERVER_INIT();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! RECV_xxx - desired receive parameters
!
! OUTPUT PARAMETERS:
!
! New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
! SEND_xxx - Other Kermit's desired parameters
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
OLD_OUTPUT, ! Saved terminal output routine
STATUS; ! Status returned by various routines
![026] Local routine to ignore error message output
ROUTINE IGNORE_ERROR (ADDRESS, LENGTH) =
BEGIN
RETURN TRUE;
END;
SET_SEND_INIT ();
![026] If too many tries, just give up. Maybe the other Kermit doesn't
![026] know what to do with this packet.
IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_ER;
![026]
![026] Count the number of times we try this
![026]
NUM_RETRIES = .NUM_RETRIES + 1;
IF NOT SEND_PACKET (MSG_SER_INIT, P_SI_LENGTH, .MSG_NUMBER) THEN RETURN STATE_A;
![026]
![026] Determine if we received a packet it good condition. If we timed out
![026] just try again. If we get an error packet back, ignore it and
![026] just continue. The other Kermit must not support this packet.
![026]
OLD_OUTPUT = TT_SET_OUTPUT (IGNORE_ERROR);
STATUS = REC_PACKET ();
TT_OUTPUT ();
TT_SET_OUTPUT (.OLD_OUTPUT);
IF .STATUS EQL KER_ERRMSG THEN RETURN STATE_SG;
IF NOT .STATUS
THEN
IF NOT ((.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL
KER_CHKSUMERR))
THEN
RETURN STATE_EX
ELSE
RETURN .STATE;
!
! Determine if the packet is good.
!
IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ EQL .MSG_NUMBER
THEN
BEGIN
!
! Here if we have an ACK for the initialization message that was just sent
! to the remote KERMIT.
!
IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A;
NUM_RETRIES = 0;
INIT_PKT_SENT = TRUE; ! We have exchanged init's
RETURN STATE_SG;
END;
!
! If we haven't returned yet, we must have gotten an invalid response.
! Just stay in the same state so we try again
!
RETURN .STATE;
END;
%SBTTL 'SEND_DATA'
ROUTINE SEND_DATA =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will send a data message to the remote KERMIT.
!
! CALLING SEQUENCE:
!
! STATE = SEND_DATA();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
SUB_TYPE, ! Subtype for XFR_STATUS call
STATUS; ! Status returned by various routines
!
! If there is nothing in the data packet, we should not bother to send it.
! Instead, we will just call BFR_FILL again to get some more data
!
IF .SIZE GTR 0
THEN
BEGIN
!
! Check to see if the number of retries have been exceeded.
!
IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;
!
! Not exceeded yet. Increment the number of retries we have attempted
! on this message.
!
NUM_RETRIES = .NUM_RETRIES + 1;
!
! Attempt to send the packet and abort if the send fails.
!
IF NOT SEND_PACKET (MSG_DATA, .SIZE, .MSG_NUMBER) THEN RETURN STATE_EX;
!
! Attempt to receive a message from the remote KERMIT.
!
STATUS = REC_PACKET ();
IF NOT .STATUS
THEN
BEGIN
IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL
KER_CHKSUMERR)
THEN
RETURN .STATE
ELSE
RETURN STATE_EX;
END;
!
! Determine if the message is a NAK and the NAK is for the message number
! that we are current working on. If the NAK is for the next packet then
! treat it like an ACK for this packet
!
IF .REC_TYPE EQL MSG_NAK AND (.REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77'))
THEN
RETURN .STATE;
!
! Make sure we have a NAK or ACK
!
IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK)
THEN
!
! Not an ACK or NAK, abort.
!
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
!
! Is this for this message?
!
IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;
!
! It was. Set up for sending the next data message to the remote KERMIT
! and return.
!
!
! Check for data field in ACK indicating abort file or stream
!
!
IF .REC_TYPE EQL MSG_ACK AND .REC_LENGTH EQL 1
THEN
SELECTONE CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE)) OF
SET
[MSG_ACK_ABT_CUR] :
ABT_CUR_FILE = TRUE;
[MSG_ACK_ABT_ALL] :
ABT_ALL_FILE = TRUE;
TES;
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
END; ! End of IF .SIZE GTR 0
IF (BFR_FILL (FALSE) EQL KER_NORMAL) AND NOT (.ABT_CUR_FILE OR .ABT_ALL_FILE)
THEN
RETURN STATE_SD
ELSE
BEGIN
IF ( NOT .CONNECT_FLAG) AND .TY_FIL
THEN
BEGIN
IF .ABT_ALL_FILE
THEN
TT_TEXT (UPLIT (%ASCIZ' [Group interrupted]'))
ELSE
IF .ABT_CUR_FILE
THEN
TT_TEXT (UPLIT (%ASCIZ' [Interrupted]'))
ELSE
TT_TEXT (UPLIT (%ASCIZ' [OK]'));
TT_CRLF ();
END;
IF .FILE_OPEN_FLAG THEN FILE_CLOSE (FALSE);
SUB_TYPE = %C'C'; ! Assume ok
IF .ABT_ALL_FILE
THEN
SUB_TYPE = %C'Z'
ELSE
IF .ABT_CUR_FILE THEN SUB_TYPE = %C'X';
XFR_STATUS (%C'F', .SUB_TYPE);
FILE_OPEN_FLAG = FALSE;
RETURN STATE_SZ;
END;
END;
%SBTTL 'SEND_FILE'
ROUTINE SEND_FILE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will send the file specification that is being
! transfered, or it will send a text header message.
!
! CALLING SEQUENCE:
!
! STATE = SEND_FILE();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! TEXT_HEAD_FLAG - If true, send text header instead of file header
!
! OUTPUT PARAMETERS:
!
! New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
M_TYPE, ! Message type to send
STATUS; ! Status returned by various routines
!
! Flag we don't want to abort yet
!
ABT_CUR_FILE = FALSE;
ABT_ALL_FILE = FALSE;
!
! First determine if we have exceed the number of retries that are
! allowed to attempt to send this message.
!
IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;
!
! The number of retries are not exceeded. Increment the number and then
! attempt to send the packet again.
!
NUM_RETRIES = .NUM_RETRIES + 1;
SIZE = 0; ! Assume no name
IF .TEXT_HEAD_FLAG THEN M_TYPE = MSG_TEXT ELSE M_TYPE = MSG_FILE;
IF .FILE_SIZE NEQ 0 AND NOT .NO_FILE_NEEDED
THEN
BEGIN
![025] CH$MOVE (.FILE_SIZE, CH$PTR (FILE_NAME),
![025] CH$PTR (SND_MSG, PKT_MSG,
![025] CHR_SIZE));
![025]
![025] Fill packet with file name
![025]
SET_STRING (CH$PTR (FILE_NAME), .FILE_SIZE, TRUE);
BFR_FILL (TRUE);
SET_STRING (0, 0, FALSE);
END;
IF NOT SEND_PACKET (.M_TYPE, .SIZE, .MSG_NUMBER) THEN RETURN STATE_EX;
!
! Now get the responce from the remote KERMIT.
!
STATUS = REC_PACKET ();
IF NOT .STATUS
THEN
BEGIN
IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
THEN
RETURN .STATE
ELSE
RETURN STATE_EX;
END;
!
! Determine if the packet is good.
!
IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK)
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
!
! If this is a NAK and the message number is not the one we just send
! treat this like an ACK, otherwise resend the last packet.
!
IF .REC_TYPE EQL MSG_NAK AND (.REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77')) THEN RETURN .STATE;
IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;
!
! If all is ok, bump the message number and fill first buffer
!
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
IF BFR_FILL (TRUE) THEN RETURN STATE_SD ELSE RETURN STATE_A;
END; ! End of SEND_FILE
%SBTTL 'SEND_EOF'
ROUTINE SEND_EOF =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will send the end of file message to the remote
! KERMIT. It will then determine if there are more files to
! send to the remote.
!
! CALLING SEQUENCE:
!
! STATE = SEND_EOF();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! Sets up for the next file to be processed if there is one.
!
!--
BEGIN
LOCAL
STATUS, ! Status returned by various routines
EOF_MSG_LEN; ! Length of EOF message to send
!
! First determine if we have exceed the number of retries that are
! allowed to attempt to send this message.
!
IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;
!
! The number of retries are not exceeded. Increment the number and then
! attempt to send the packet again.
!
NUM_RETRIES = .NUM_RETRIES + 1;
!
! Store character in packet to indicate discard of file
! Character will only be sent if file should be discarded
!
CH$WCHAR (MSG_EOF_DISCARD, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE));
IF .ABT_CUR_FILE OR .ABT_ALL_FILE THEN EOF_MSG_LEN = 1 ELSE EOF_MSG_LEN = 0;
IF NOT SEND_PACKET (MSG_EOF, .EOF_MSG_LEN, .MSG_NUMBER) THEN RETURN STATE_EX;
!
! Now get the responce from the remote KERMIT.
!
STATUS = REC_PACKET ();
IF NOT .STATUS
THEN
BEGIN
IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
THEN
RETURN .STATE
ELSE
RETURN STATE_EX;
END;
!
! Determine if the packet is good.
!
IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK)
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
!
! If this is a NAK and the message number is not the one we just send
! treat this like an ACK, otherwise resend the last packet.
!
IF .REC_TYPE EQL MSG_NAK AND (.REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77')) THEN RETURN .STATE;
IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;
!
! Here to determine if there is another file to send.
!
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
IF NOT .ABT_ALL_FILE THEN STATUS = NEXT_FILE () ELSE STATUS = KER_NOMORFILES;
IF ( NOT .STATUS) OR (.STATUS EQL KER_NOMORFILES)
THEN
BEGIN
IF (.STATUS NEQ KER_NOMORFILES) THEN RETURN STATE_A ELSE RETURN STATE_SB;
END
ELSE
BEGIN
FILE_OPEN_FLAG = TRUE; ! Have a file open again
IF .FIL_NORMAL_FORM THEN NORMALIZE_FILE (FILE_NAME, FILE_SIZE, -1, -1);
XFR_STATUS (%C'F', %C'S'); ! Inform display routine
IF ( NOT .CONNECT_FLAG) AND .TY_FIL
THEN
BEGIN
TT_TEXT (UPLIT (%ASCIZ'Sending: '));
TT_TEXT (FILE_NAME);
TT_OUTPUT ();
END;
FILE_CHARS = 0; ! No characters sent yet
RETURN STATE_SF;
END;
END; ! End of SEND_EOF
%SBTTL 'SEND_INIT'
ROUTINE SEND_INIT =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will send the initialization packet to the remote
! KERMIT. The message type sent is S.
!
! CALLING SEQUENCE:
!
! STATE = SEND_INIT();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS; ! Status returned by various routines
SET_SEND_INIT ();
IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_ER;
!
! Count the number of times we try this
!
NUM_RETRIES = .NUM_RETRIES + 1;
IF NOT SEND_PACKET (MSG_SND_INIT, P_SI_LENGTH, .MSG_NUMBER) THEN RETURN STATE_EX;
!
! Determine if we received a packet it good condition. If we timed out or
! got an illegal message, just try again.
!
STATUS = REC_PACKET ();
IF NOT .STATUS
THEN
BEGIN
IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
THEN
RETURN .STATE
ELSE
RETURN STATE_EX;
END;
!
! Determine if the packet is good.
!
IF .REC_TYPE NEQ MSG_ACK THEN RETURN .STATE;
IF .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;
!
! Here if we have an ACK for the initialization message that was just sent
! to the remote KERMIT.
!
IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A;
BLK_CHK_TYPE = .INI_CHK_TYPE; ! We now use agreed upon block check type
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
RETURN STATE_OF; ! Now need to open the file
END;
%SBTTL 'SEND_OPEN_FILE - Open file for sending'
ROUTINE SEND_OPEN_FILE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called from DO_TRANSACTION when the first input file
! needs to be opened.
!
! CALLING SEQUENCE:
!
! STATE = SEND_OPEN_FILE ();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! FILE_NAME, FILE_SIZE, etc.
!
! OUPTUT PARAMETERS:
!
! New state for FSM.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
IF ( NOT .CONNECT_FLAG) AND .TY_FIL
THEN
BEGIN
TT_TEXT (UPLIT (%ASCIZ'Sending: '));
TT_OUTPUT ();
END;
FILE_CHARS = 0; ! No characters sent yet
IF NOT .NO_FILE_NEEDED
THEN
IF NOT FILE_OPEN (FNC_READ) THEN RETURN STATE_A ELSE FILE_OPEN_FLAG = TRUE;
![023]
![023] If we want normalized file names, beat up the name now
![023]
IF .FIL_NORMAL_FORM THEN NORMALIZE_FILE (FILE_NAME, FILE_SIZE, -1, -1);
XFR_STATUS (%C'F', %C'S'); ! Inform display routine
IF ( NOT .CONNECT_FLAG) AND .TY_FIL
THEN
BEGIN
TT_TEXT (FILE_NAME);
TT_OUTPUT ();
END;
RETURN STATE_SF;
END; ! End of FSM_OPEN_FILE
%SBTTL 'SEND_GENCMD'
ROUTINE SEND_GENCMD =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will send a command packet to the server Kermit.
! The new state will depend upon the response. If a send-init
! is received, it will process it and switch to STATE_RF.
! If a text-header is received it will switch to STATE_RD.
! If an ACK is received, it will type the data portion and
! switch to STATE_C.
!
! CALLING SEQUENCE:
!
! STATE = SEND_GENCMD();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! GEN_TYPE - Message type to send (normally MSG_GENERIC)
! GEN_SUBTYPE - Message subtype (only if MSG_GENERIC)
! GEN_1DATA - First argument string
! GEN_1SIZE - Size of first argument
! GEN_2DATA - Second argument string
! GEN_2SIZE - Size of second argument
! GEN_3DATA - Third argument string
! GEN_3SIZE - Size of third argument
!
! OUTPUT PARAMETERS:
!
! New state for the finite state machine.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
POINTER, ! Pointer at DATA_TEXT
DATA_TEXT : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Data buffer
DATA_SIZE, ! Length of data buffer used
STATUS; ! Status returned by various routines
ROUTINE PACK_DATA (POINTER, LENGTH, SRC_ADDR, SRC_LEN) =
!
! Routine to pack an argument into the buffer.
!
BEGIN
IF .SRC_LEN GTR MAX_MSG - .LENGTH - 1 THEN SRC_LEN = MAX_MSG - .LENGTH - 1;
LENGTH = .LENGTH + .SRC_LEN + 1;
CH$WCHAR_A (CHAR (.SRC_LEN), .POINTER);
.POINTER = CH$MOVE (.SRC_LEN, CH$PTR (.SRC_ADDR), ..POINTER);
RETURN .LENGTH;
END;
!
! First determine if we have exceed the number of retries that are
! allowed to attempt to send this message.
!
IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;
!
! The number of retries are not exceeded. Increment the number and then
! attempt to send the packet again.
!
NUM_RETRIES = .NUM_RETRIES + 1;
!
! Build the packet data field
!
POINTER = CH$PTR (DATA_TEXT);
DATA_SIZE = 0;
IF .GEN_TYPE EQL MSG_GENERIC
THEN
BEGIN
CH$WCHAR_A (.GEN_SUBTYPE, POINTER);
DATA_SIZE = 1;
IF .GEN_1SIZE GTR 0 OR .GEN_2SIZE GTR 0 OR .GEN_3SIZE GTR 0
THEN
BEGIN
DATA_SIZE = PACK_DATA (POINTER, .DATA_SIZE, GEN_1DATA, .GEN_1SIZE);
IF .GEN_2SIZE GTR 0 OR .GEN_3SIZE GTR 0
THEN
BEGIN
DATA_SIZE = PACK_DATA (POINTER, .DATA_SIZE, GEN_2DATA, .GEN_2SIZE);
IF .GEN_3SIZE GTR 0
THEN
BEGIN
DATA_SIZE = PACK_DATA (POINTER, .DATA_SIZE, GEN_3DATA, .GEN_3SIZE);
END;
END;
END;
END
ELSE
BEGIN
IF .GEN_1SIZE GTR MAX_MSG THEN GEN_1SIZE = MAX_MSG;
DATA_SIZE = .GEN_1SIZE;
CH$MOVE (.GEN_1SIZE, CH$PTR (GEN_1DATA), .POINTER);
END;
SET_STRING (CH$PTR (DATA_TEXT), .DATA_SIZE, TRUE);
BFR_FILL (TRUE);
SET_STRING (0, 0, FALSE);
!
! Send the packet
!
IF NOT SEND_PACKET (.GEN_TYPE, .SIZE, .MSG_NUMBER) THEN RETURN STATE_EX;
!
! Now get the responce from the remote KERMIT.
!
STATUS = REC_PACKET ();
IF NOT .STATUS
THEN
BEGIN
IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
THEN
RETURN .STATE
ELSE
RETURN STATE_EX;
END;
! Did we get a send-init?
SELECTONE .REC_TYPE OF
SET
[MSG_SND_INIT] :
BEGIN
MSG_NUMBER = .REC_SEQ; ! Initialize sequence numbers
! Determine if the parameters are ok. If not, give up
IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN .STATUS;
SET_SEND_INIT (); ! Set up our acknowledgement to the send-init
SEND_PACKET (MSG_ACK, P_SI_LENGTH, .MSG_NUMBER); ! Send it
BLK_CHK_TYPE = .INI_CHK_TYPE; ! Can now use agreed upon type
OLD_RETRIES = .NUM_RETRIES;
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
RETURN STATE_RF; ! Now expect file header
END;
[MSG_TEXT] :
!
! If we just got a text header, set up for typing on the terminal and
! shift to receiving data
!
BEGIN
TEXT_HEAD_FLAG = TRUE; ! We want terminal output
PUT_CHR_ROUTINE = TYPE_CHAR; ! Set up the put a character routine
IF .REC_LENGTH GTR 0
THEN
BEGIN
TT_TEXT (UPLIT (%ASCIZ'<<')); ! Make sure file name sticks out
BFR_EMPTY (); ! Dump the packet data to the terminal
TT_TEXT (UPLIT (%ASCIZ'>>')); ! So user can tell where name ends
TT_CRLF (); ! And a CRLF
END;
SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER); ! Send an ACK
OLD_RETRIES = .NUM_RETRIES;
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
RETURN STATE_RD; ! We now want data
END;
[MSG_ACK] :
!
! If we get an ACK, just type the data on the terminal and complete the
! transaction.
!
BEGIN
PUT_CHR_ROUTINE = TYPE_CHAR; ! Dump to terminal
BFR_EMPTY (); ! Do it
IF .REC_LENGTH GTR 0 THEN TT_CRLF ();
RETURN STATE_C; ! And go idle
END;
[MSG_NAK] :
!
! If we get a NAK, stay in the same state. We will re-transmit the
! packet again.
!
RETURN .STATE;
TES;
!
! If we get here, we didn't get anything resembling an acceptable
! packet, so we will abort.
!
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
%SBTTL 'SEND_BREAK'
ROUTINE SEND_BREAK =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will send the break (end of transmission) message
! to the remote KERMIT. On an ACK the state becomes STATE_C.
!
! CALLING SEQUENCE:
!
! STATE = SEND_BREAK();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! New state for the finite state machine.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS; ! Status returned by various routines
!
! First determine if we have exceed the number of retries that are
! allowed to attempt to send this message.
!
IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;
!
! The number of retries are not exceeded. Increment the number and then
! attempt to send the packet again.
!
NUM_RETRIES = .NUM_RETRIES + 1;
IF NOT SEND_PACKET (MSG_BREAK, 0, .MSG_NUMBER) THEN RETURN STATE_EX;
!
! Now get the responce from the remote KERMIT.
!
STATUS = REC_PACKET ();
IF NOT .STATUS
THEN
BEGIN
IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
THEN
RETURN .STATE
ELSE
RETURN STATE_EX;
END;
!
! Determine if the packet is good.
!
IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK)
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
!
! If this is a NAK and the message number is not the one we just send
! treat this like an ACK, otherwise resend the last packet.
!
IF .REC_TYPE EQL MSG_NAK AND .REC_SEQ NEQ 0 THEN RETURN .STATE;
IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;
!
! Here to determine if there is another file to send.
!
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
RETURN STATE_C;
END;
%SBTTL 'REC_INIT'
ROUTINE REC_INIT =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will process an initialization message received from
! the remote KERMIT.
!
! CALLING SEQUENCE:
!
! STATE = REC_INIT();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! New machine state.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS; ! Status returned by various routines
ROUTINE CHECK_INIT =
BEGIN
IF .REC_TYPE EQL MSG_SND_INIT THEN RETURN TRUE ELSE RETURN FALSE;
END;
IF NOT (STATUS = REC_MESSAGE (CHECK_INIT))
THEN
IF .STATUS NEQ KER_ABORTED THEN RETURN STATE_A ELSE RETURN STATE_EX;
MSG_NUMBER = .REC_SEQ;
IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A;
SET_SEND_INIT ();
SEND_PACKET (MSG_ACK, P_SI_LENGTH, .MSG_NUMBER);
BLK_CHK_TYPE = .INI_CHK_TYPE; ! Can now use agreed upon type
OLD_RETRIES = .NUM_RETRIES;
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
RETURN STATE_RF;
END; ! End of REC_INIT
%SBTTL 'REC_FILE'
ROUTINE REC_FILE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine expects to receive an MSG_FILE packet from the remote
! KERMIT. If the message is correct this routine will change the state
! to STATE_RD.
!
! This routine also expects MSG_SND_INIT, MSG_EOF, or MSG_BREAK.
!
! CALLING SEQUENCE:
!
! STATE = REC_FILE();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! New state.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS;
ROUTINE CHECK_FILE =
BEGIN
IF (.REC_TYPE EQL MSG_SND_INIT) OR (.REC_TYPE EQL MSG_EOF) OR (.REC_TYPE EQL MSG_FILE) OR (
.REC_TYPE EQL MSG_BREAK) OR (.REC_TYPE EQL MSG_TEXT)
THEN
RETURN TRUE
ELSE
RETURN FALSE;
END;
!
! Initialize the abort flags
!
ABT_CUR_FILE = FALSE;
ABT_ALL_FILE = FALSE;
!
! Get a message
!
IF NOT (STATUS = REC_MESSAGE (CHECK_FILE))
THEN
IF .STATUS NEQ KER_ABORTED THEN RETURN STATE_A ELSE RETURN STATE_EX;
SELECTONE .REC_TYPE OF
SET
[MSG_SND_INIT] :
BEGIN
IF .OLD_RETRIES GTR .SI_RETRIES THEN RETURN STATE_ER;
OLD_RETRIES = .OLD_RETRIES + 1;
IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ
THEN
BEGIN
SET_SEND_INIT ();
BLK_CHK_TYPE = CHK_1CHAR; ! Must use 1 character CHKSUM
SEND_PACKET (MSG_ACK, P_SI_LENGTH, .REC_SEQ);
BLK_CHK_TYPE = .INI_CHK_TYPE; ! Back to agreed upon type
NUM_RETRIES = 0;
RETURN .STATE;
END
ELSE
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
END;
[MSG_EOF] :
BEGIN
IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;
OLD_RETRIES = .OLD_RETRIES + 1;
IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ
THEN
BEGIN
SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
NUM_RETRIES = 0;
RETURN .STATE;
END
ELSE
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
END;
[MSG_FILE] :
BEGIN
IF .MSG_NUMBER NEQ .REC_SEQ THEN RETURN STATE_ER;
IF .REC_LENGTH EQL 0
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
![025]
![025] Get file name from packet with all quoting undone
![025]
SET_STRING (CH$PTR (FILE_NAME), MAX_FILE_NAME, TRUE);
BFR_EMPTY ();
FILE_SIZE = SET_STRING (0, 0, FALSE);
CH$WCHAR (CHR_NUL, CH$PTR (FILE_NAME, .FILE_SIZE));
![025] FILE_SIZE = .REC_LENGTH;
![025] CH$COPY (.REC_LENGTH, CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE), CHR_NUL, MAX_FILE_NAME,
![025] CH$PTR (FILE_NAME));
IF ( NOT .CONNECT_FLAG) AND .TY_FIL
THEN
BEGIN
TT_TEXT (UPLIT (%ASCIZ'Receiving: '));
TT_TEXT (FILE_NAME);
TT_OUTPUT ();
END;
![023]
![023] Force file name into normal form if desired
![023]
IF .FIL_NORMAL_FORM THEN NORMALIZE_FILE (FILE_NAME, FILE_SIZE, 9, 3);
FILE_CHARS = 0; ! No characters received yet
IF NOT FILE_OPEN (FNC_WRITE) THEN RETURN STATE_A;
XFR_STATUS (%C'F', %C'R'); ! Tell display routine
TEXT_HEAD_FLAG = FALSE; ! Got an F, not an X
FILE_OPEN_FLAG = TRUE;
SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER);
OLD_RETRIES = .NUM_RETRIES;
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
RETURN STATE_RD;
END;
[MSG_TEXT] :
!
! If we get a text header, we will want to type the data on
! the terminal. Set up the put a character routine correctly.
!
BEGIN
IF .MSG_NUMBER NEQ .REC_SEQ
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
TEXT_HEAD_FLAG = TRUE; ! Got an X, not an F
PUT_CHR_ROUTINE = TYPE_CHAR; ! Empty buffer on terminal
IF .REC_LENGTH GTR 0
THEN
BEGIN
TT_TEXT (UPLIT (%ASCIZ'<<')); ! Make file name stick out
BFR_EMPTY (); ! Do the header data
TT_TEXT (UPLIT (%ASCIZ'>>'));
TT_CRLF (); ! And a crlf
END;
SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER);
OLD_RETRIES = .NUM_RETRIES;
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
RETURN STATE_RD;
END;
[MSG_BREAK] :
BEGIN
IF .MSG_NUMBER NEQ .REC_SEQ
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
RETURN STATE_C;
END;
[OTHERWISE] :
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
TES;
END; ! End of REC_FILE
%SBTTL 'REC_DATA'
ROUTINE REC_DATA =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will accept data messages and write them to disk.
! It will also accept MSG_FILE, MSG_TEXT and MSG_EOF messages.
!
! CALLING SEQUENCE:
!
! STATE = REC_DATA();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! New state for the finite state machine.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS;
ROUTINE CHECK_DATA =
BEGIN
IF .REC_TYPE EQL MSG_DATA OR (.REC_TYPE EQL MSG_FILE AND NOT .TEXT_HEAD_FLAG) OR .REC_TYPE
EQL MSG_EOF OR (.REC_TYPE EQL MSG_TEXT AND .TEXT_HEAD_FLAG)
THEN
RETURN TRUE
ELSE
RETURN FALSE;
END;
LOCAL
SUB_TYPE, ! Subtype for XFR_STATUS
DISCARD_FILE_FLAG, ! Sender requested discard
ACK_MSG_LEN; ! Length of ACK to send
!
! First get a message
!
IF NOT (STATUS = REC_MESSAGE (CHECK_DATA))
THEN
IF .STATUS NEQ KER_ABORTED THEN RETURN STATE_A ELSE RETURN STATE_EX;
SELECTONE .REC_TYPE OF
SET
[MSG_DATA] :
BEGIN
IF .MSG_NUMBER NEQ .REC_SEQ
THEN
BEGIN
IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;
OLD_RETRIES = .OLD_RETRIES + 1;
IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ
THEN
BEGIN
SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
NUM_RETRIES = 0;
RETURN .STATE;
END
ELSE
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
END;
!
! Here if we have a message with a valid message number
!
IF NOT BFR_EMPTY () THEN RETURN STATE_A;
!
! Check if we wish to abort for some reason
!
IF .ABT_CUR_FILE
THEN
BEGIN
CH$WCHAR (MSG_ACK_ABT_CUR, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE));
ACK_MSG_LEN = 1;
END
ELSE
IF .ABT_ALL_FILE
THEN
BEGIN
CH$WCHAR (MSG_ACK_ABT_ALL, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE));
ACK_MSG_LEN = 1;
END
ELSE
ACK_MSG_LEN = 0;
!
! Now send the ACK
!
SEND_PACKET (MSG_ACK, .ACK_MSG_LEN, .REC_SEQ);
OLD_RETRIES = .NUM_RETRIES;
NUM_RETRIES = 0;
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
RETURN STATE_RD;
END;
[MSG_FILE, MSG_TEXT] :
BEGIN
IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;
OLD_RETRIES = .OLD_RETRIES + 1;
IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ
THEN
BEGIN
SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
NUM_RETRIES = 0;
RETURN .STATE;
END
ELSE
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
END;
[MSG_EOF] :
BEGIN
IF .MSG_NUMBER NEQ .REC_SEQ
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
IF NOT .TEXT_HEAD_FLAG
THEN
BEGIN
FILE_OPEN_FLAG = FALSE;
DISCARD_FILE_FLAG = FALSE; ! Assume we want file
IF .REC_LENGTH EQL 1
THEN
IF CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE)) EQL MSG_EOF_DISCARD
THEN
DISCARD_FILE_FLAG = TRUE;
IF ( NOT .CONNECT_FLAG) AND .TY_FIL
THEN
BEGIN
IF .DISCARD_FILE_FLAG
THEN
IF .ABT_FLAG
THEN
TT_TEXT (UPLIT (%ASCIZ' [Interrupted]'))
ELSE
TT_TEXT (UPLIT (%ASCIZ' [Interrupted, partial file saved]'))
ELSE
TT_TEXT (UPLIT (%ASCIZ' [OK]'));
TT_CRLF ();
END;
IF NOT FILE_CLOSE (.DISCARD_FILE_FLAG AND .ABT_FLAG) THEN RETURN STATE_A;
IF .DISCARD_FILE_FLAG
THEN
IF .ABT_FLAG THEN SUB_TYPE = %C'X' ELSE SUB_TYPE = %C'D'
ELSE
SUB_TYPE = %C'C';
END
ELSE
BEGIN
TT_CRLF (); ! Make sure we have a CRLF
TT_OUTPUT (); ! And make sure all output is sent
END;
XFR_STATUS (%C'F', .SUB_TYPE);
MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
RETURN STATE_RF;
END;
[OTHERWISE] :
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN STATE_A;
END;
TES;
END; ! End of REC_DATA
%SBTTL 'SERVER - Generic commands'
ROUTINE SERVER_GENERIC =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle the generic server messages.
! The generic server messages include FINISH, LOGOUT.
!
! CALLING SEQUENCE:
!
! STATE = SERVER_GENERIC();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! Generic message receive in REC_MSG.
!
! OUTPUT PARAMETERS:
!
! Returns new state for FSM
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS, ! Returned status
G_FUNC, ! Generic command function
POINTER, ! Character pointer
DATA_TEXT : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Unpacked message
DATA_SIZE; ! Actual size of data
ROUTINE UNPACK_DATA (POINTER, SIZE, DST_ADDR, DST_LEN) =
!
! Routine to unpack an argument.
! This will copy the argument data to the desired buffer.
!
BEGIN
IF .SIZE GTR 0 ! If we have something to unpack
THEN
BEGIN
.DST_LEN = UNCHAR (CH$RCHAR_A (.POINTER));
IF ..DST_LEN LSS 0
THEN
BEGIN
KRM_ERROR (KER_PROTOERR); ! Someone screwed up
..DST_LEN = 0;
RETURN -1;
END;
IF ..DST_LEN GTR .SIZE - 1 THEN .DST_LEN = .SIZE - 1;
CH$COPY (..DST_LEN, ..POINTER, CHR_NUL, MAX_MSG, CH$PTR (.DST_ADDR));
.POINTER = CH$PLUS (..POINTER, ..DST_LEN);
RETURN .SIZE - ..DST_LEN - 1;
END
ELSE
!
! If nothing left in buffer, return the current size (0)
!
RETURN .SIZE;
END;
!
! First unpack the message data into its various pieces
!
SET_STRING (CH$PTR (DATA_TEXT), MAX_MSG, TRUE); ! Initialize for unpacking
BFR_EMPTY (); ! Unpack the data
DATA_SIZE = SET_STRING (0, 0, FALSE); ! All done, get size
IF .DATA_SIZE LEQ 0
THEN
BEGIN
KRM_ERROR (KER_PROTOERR); ! Someone screwed up
RETURN STATE_A; ! Since no subtype
END;
!
! Get the arguments from the unpacked data (if any)
!
GEN_1SIZE = 0; ! Assume no args
GEN_2SIZE = 0; ! none at all
GEN_3SIZE = 0;
CH$WCHAR (CHR_NUL, CH$PTR (GEN_1DATA)); ! Ensure all are null terminated
CH$WCHAR (CHR_NUL, CH$PTR (GEN_2DATA));
CH$WCHAR (CHR_NUL, CH$PTR (GEN_3DATA));
POINTER = CH$PTR (DATA_TEXT, 1); ! Point at second character
DATA_SIZE = .DATA_SIZE - 1; ! Account for subtype
IF .DATA_SIZE GTR 0 ! Room for first arg?
THEN
BEGIN
DATA_SIZE = UNPACK_DATA (POINTER, .DATA_SIZE, GEN_1DATA, GEN_1SIZE);
IF .DATA_SIZE LSS 0 THEN RETURN STATE_A; ! Punt if bad arguments
IF .DATA_SIZE GTR 0 ! Second argument present?
THEN
BEGIN
DATA_SIZE = UNPACK_DATA (POINTER, .DATA_SIZE, GEN_2DATA, GEN_2SIZE);
IF .DATA_SIZE LSS 0 THEN RETURN STATE_A; ! Punt if bad arguments
IF .DATA_SIZE GTR 0 ! Third argument here?
THEN
BEGIN
DATA_SIZE = UNPACK_DATA (POINTER, .DATA_SIZE, GEN_3DATA, GEN_3SIZE);
IF .DATA_SIZE LSS 0 THEN RETURN STATE_A; ! Punt if bad arguments
END;
END;
END;
SELECTONE CH$RCHAR (CH$PTR (DATA_TEXT)) OF
SET
!
! EXIT command, just return the status to the upper level
!
[MSG_GEN_EXIT] :
BEGIN
SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
RETURN STATE_FI;
END;
!
! LOGOUT command, ACK the message then call the system routine to
! kill the process (log the job out, etc.)
!
[MSG_GEN_LOGOUT] :
BEGIN
SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
SY_LOGOUT ();
RETURN STATE_LG;
END;
!
! For a type command, just set up a transfer flagging we want a text header
! instead of a file header.
!
[MSG_GEN_TYPE] :
BEGIN
CH$COPY (.GEN_1SIZE, CH$PTR (GEN_1DATA), CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME));
FILE_SIZE = .GEN_1SIZE;
TEXT_HEAD_FLAG = TRUE; ! Now want text header
XFR_STATUS (%C'I', %C'G'); ! Tell display routine we are doing a command
IF .STATE EQL STATE_II AND .BLK_CHK_TYPE EQL .INI_CHK_TYPE
THEN
RETURN STATE_OF ! Must open the file
ELSE
RETURN STATE_S; ! Start the transaction with a send
END;
[MSG_GEN_DIRECTORY] :
G_FUNC = GC_DIRECTORY;
[MSG_GEN_DISK_USAGE] :
G_FUNC = GC_DISK_USAGE;
[MSG_GEN_DELETE] :
G_FUNC = GC_DELETE;
[MSG_GEN_HELP] :
G_FUNC = GC_HELP;
[MSG_GEN_LOGIN] :
G_FUNC = GC_LGN;
[MSG_GEN_CONNECT] :
G_FUNC = GC_CONNECT;
[MSG_GEN_RENAME] :
G_FUNC = GC_RENAME;
[MSG_GEN_COPY] :
G_FUNC = GC_COPY;
[MSG_GEN_WHO] :
G_FUNC = GC_WHO;
[MSG_GEN_SEND] :
G_FUNC = GC_SEND_MSG;
[MSG_GEN_QUERY] :
G_FUNC = GC_STATUS;
[MSG_GEN_PROGRAM] :
G_FUNC = GC_PROGRAM;
[MSG_GEN_JOURNAL] :
G_FUNC = GC_JOURNAL;
[MSG_GEN_VARIABLE] :
G_FUNC = GC_VARIABLE;
!
! Here if we have a function that is not implemented in KERMSG.
!
[OTHERWISE] :
BEGIN
KRM_ERROR (KER_UNIMPLGEN);
RETURN STATE_A;
END;
TES;
!
! If we get here, we have gotten a known type of generic message that
! we need to have our operating system dependent routine handle.
!
RETURN CALL_SY_RTN (.G_FUNC);
END; ! End of SERVER_GENERIC
%SBTTL 'HOST_COMMAND - perform a host command'
ROUTINE HOST_COMMAND =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle the host command packet.
! It will set up the data for the call to the system routine.
!
! CALLING SEQUENCE:
!
! STATE = HOST_COMMAND();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! Generic message receive in REC_MSG.
!
! OUTPUT PARAMETERS:
!
! Returns new state for FSM
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
GEN_1SIZE = 0;
GEN_2SIZE = 0;
GEN_3SIZE = 0;
IF .REC_LENGTH LEQ 0
THEN
BEGIN
KRM_ERROR (KER_PROTOERR); ! Return an error
RETURN STATE_A; ! Just abort
END;
SET_STRING (CH$PTR (GEN_1DATA), MAX_MSG, TRUE); ! Start writing to buffer
BFR_EMPTY (); ! Dump the text
GEN_1SIZE = SET_STRING (0, 0, FALSE); ! Get the result
RETURN CALL_SY_RTN (GC_COMMAND);
END; ! End of HOST_COMMAND
%SBTTL 'KERMIT_COMMAND - perform a KERMIT command'
ROUTINE KERMIT_COMMAND =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle the KERMIT command packet.
! It will set up the data for the call to the system routine.
!
! CALLING SEQUENCE:
!
! STATE = KERMIT_COMMAND();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! Generic message receive in REC_MSG.
!
! OUTPUT PARAMETERS:
!
! Returns new state for FSM
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
GEN_1SIZE = 0;
GEN_2SIZE = 0;
GEN_3SIZE = 0;
IF .REC_LENGTH LEQ 0
THEN
BEGIN
KRM_ERROR (KER_PROTOERR); ! Return an error
RETURN STATE_A; ! Just abort
END;
SET_STRING (CH$PTR (GEN_1DATA), MAX_MSG, TRUE); ! Start writing to buffer
BFR_EMPTY (); ! Dump the text
GEN_1SIZE = SET_STRING (0, 0, FALSE); ! Get the result
RETURN CALL_SY_RTN (GC_KERMIT);
END; ! End of KERMIT_COMMAND
%SBTTL 'CALL_SY_RTN - handle operating system dependent functions'
ROUTINE CALL_SY_RTN (G_FUNC) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle calling the operating system dependent routine
! for a server function and returning the response.
!
! CALLING SEQUENCE:
!
! STATE = CALL_SY_RTN(.G_FUNC);
!
! INPUT PARAMETERS:
!
! G_FUNC - Generic function code
!
! IMPLICIT INPUTS:
!
! Generic message data in GEN_1DATA
!
! OUTPUT PARAMETERS:
!
! Returns new state for FSM
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STRING_ADDRESS, ! Address of string result
STRING_LENGTH, ! Length of string result
GET_CHR_SUBROUTINE, ! Routine to get a response character
STATUS; ! Status value
!
! Call the routine with the desired type of command.
!
STRING_LENGTH = 0; ! Initialize for no string
GET_CHR_SUBROUTINE = 0; ! And no subroutine
IF NOT SY_GENERIC (.G_FUNC, STRING_ADDRESS, STRING_LENGTH, GET_CHR_SUBROUTINE)
THEN
RETURN STATE_A; ! And abort
IF .STRING_LENGTH GTR 0
THEN
BEGIN
SET_STRING (CH$PTR (.STRING_ADDRESS), .STRING_LENGTH, TRUE);
IF .STRING_LENGTH LSS .SEND_PKT_SIZE - PKT_OVR_HEAD
THEN
BEGIN
BFR_FILL (TRUE); ! If it should fit, pack it in
IF SET_STRING (0, 0, FALSE) GEQ .STRING_LENGTH
THEN ! It fit, so just send the ACK
IF SEND_PACKET (MSG_ACK, .SIZE, .REC_SEQ) THEN RETURN STATE_C ELSE RETURN STATE_EX;
!
! It didn't fit, reset the pointers to the beginning
!
SET_STRING (CH$PTR (.STRING_ADDRESS), .STRING_LENGTH, TRUE);
END;
NO_FILE_NEEDED = TRUE; ! Don't need a file
END
ELSE
IF .GET_CHR_SUBROUTINE NEQ 0 ! If we got a subroutine back
THEN
BEGIN
GET_CHR_ROUTINE = .GET_CHR_SUBROUTINE;
NO_FILE_NEEDED = TRUE;
END;
TEXT_HEAD_FLAG = TRUE; ! Send to be typed
XFR_STATUS (%C'I', %C'G'); ! Doing a generic command
IF .STATE EQL STATE_II AND .BLK_CHK_TYPE EQL .INI_CHK_TYPE
THEN
RETURN STATE_OF
ELSE
RETURN STATE_S; ! Send the response
END; ! End of CALL_SY_RTN
%SBTTL 'Message processing -- PRS_SEND_INIT - Parse send init params'
ROUTINE PRS_SEND_INIT =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will parse the SEND_INIT parameters that were sent by
! the remote Kermit. The items will be stored into the low segment.
!
! CALLING SEQUENCE:
!
! PRS_SEND_INIT ();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! Message stored in REC_MSG.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
! The following section of code will parse the various send parameters
! that are found in the send-init message. The following code will store
! the following as the value.
!
! If the user specified a value then the user supplied value will be used else
! the value in the message and if none in the message then the default value.
!
! User supplied values are denoted as positive values in SND_xxxxxxx.
!
! Parse the packet size
!
SEND_PKT_SIZE = (IF .SND_PKT_SIZE GEQ 0 THEN .SND_PKT_SIZE ELSE
BEGIN
IF .REC_LENGTH GTR P_SI_BUFSIZ
THEN
UNCHAR (CH$RCHAR (CH$PTR (REC_MSG,
PKT_MSG + P_SI_BUFSIZ, CHR_SIZE)))
ELSE
ABS (.SND_PKT_SIZE)
END
);
!
! Parse the time out value
!
SEND_TIMEOUT = (IF .SND_TIMEOUT GEQ 0 THEN .SND_TIMEOUT ELSE
BEGIN
IF .REC_LENGTH GTR P_SI_TIMOUT
THEN
UNCHAR (CH$RCHAR (CH$PTR (REC_MSG,
PKT_MSG + P_SI_TIMOUT, CHR_SIZE)))
ELSE
ABS (.SND_TIMEOUT)
END
);
!
! Parse the number of padding characters supplied
!
SEND_NPAD = (IF .SND_NPAD GEQ 0 THEN .SND_NPAD ELSE
BEGIN
IF .REC_LENGTH GTR P_SI_NPAD
THEN
UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_NPAD,
CHR_SIZE)))
ELSE
ABS (.SND_NPAD)
END
);
!
! Parse the padding character
!
SEND_PADCHAR = (IF .SND_PADCHAR GEQ 0 THEN .SND_PADCHAR ELSE
BEGIN
IF .REC_LENGTH GTR P_SI_PAD
THEN
CTL (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_PAD,
CHR_SIZE)))
ELSE
ABS (.SND_PADCHAR)
END
);
!
! Parse the end of line character
!
SEND_EOL = (IF .SND_EOL GEQ 0 THEN .SND_EOL ELSE
BEGIN
IF .REC_LENGTH GTR P_SI_EOL
THEN
UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_EOL,
CHR_SIZE)))
ELSE
ABS (.SND_EOL)
END
);
!
! Parse the quoting character
!
SEND_QUOTE_CHR = (IF .SND_QUOTE_CHR GEQ 0 THEN .SND_QUOTE_CHR ELSE
BEGIN
IF .REC_LENGTH GTR P_SI_QUOTE
THEN
CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_QUOTE,
CHR_SIZE))
ELSE
ABS (.SND_QUOTE_CHR)
END
);
!
! Parse the 8-bit quoting character
!
! If the character was not included in the packet, assume no eight-bit
! quoting allowed (we are probably talking to an old version of Kermit).
!
SEND_8QUOTE_CHR = (IF .REC_LENGTH GTR P_SI_8QUOTE THEN CH$RCHAR (CH$PTR (REC_MSG,
PKT_MSG + P_SI_8QUOTE, CHR_SIZE)) ELSE %C'N' ! Assume no 8-bit quoting allowed
);
!
! Parse the checksum type
!
IF .REC_LENGTH GTR P_SI_CHKTYPE
THEN
BEGIN
LOCAL
REQ_CHK_TYPE;
REQ_CHK_TYPE = CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_CHKTYPE, CHR_SIZE));
IF .REC_TYPE NEQ MSG_ACK
THEN
IF .REQ_CHK_TYPE GEQ CHK_1CHAR AND .REQ_CHK_TYPE LEQ CHK_CRC
THEN
INI_CHK_TYPE = .REQ_CHK_TYPE
ELSE
INI_CHK_TYPE = CHK_1CHAR
ELSE
IF .REQ_CHK_TYPE NEQ .CHKTYPE
THEN
INI_CHK_TYPE = CHK_1CHAR
ELSE
INI_CHK_TYPE = .REQ_CHK_TYPE
END
ELSE
INI_CHK_TYPE = CHK_1CHAR; ! Only single character checksum if not specified
!
! Parse the repeat character
!
REPT_CHR = (IF .REC_LENGTH GTR P_SI_REPEAT THEN CH$RCHAR (CH$PTR (REC_MSG,
PKT_MSG + P_SI_REPEAT, CHR_SIZE)) ELSE %C' ');
!
! Check for a valid quoting character. If it is not valid, then we have
! a protocol error
!
IF NOT ((.SEND_QUOTE_CHR GEQ %O'41' AND .SEND_QUOTE_CHR LEQ %O'76') OR (.SEND_QUOTE_CHR GEQ %O
'140' AND .SEND_QUOTE_CHR LEQ %O'176'))
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN KER_PROTOERR;
END;
!
! Check for a valid 8 bit quoting and set the 8 bit quoting flag as needed
!
IF ( NOT ((.SEND_8QUOTE_CHR GEQ %O'041' AND .SEND_8QUOTE_CHR LEQ %O'076') OR (.SEND_8QUOTE_CHR
GEQ %O'140' AND .SEND_8QUOTE_CHR LEQ %O'176') OR (.SEND_8QUOTE_CHR EQL %C'N') OR (
.SEND_8QUOTE_CHR EQL %C'Y'))) OR .SEND_8QUOTE_CHR EQL .SEND_QUOTE_CHR OR .SEND_8QUOTE_CHR
EQL .RCV_QUOTE_CHR
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN KER_PROTOERR;
END;
IF .SEND_8QUOTE_CHR EQL %C'Y' THEN SEND_8QUOTE_CHR = .RECV_8QUOTE_CHR;
IF .SEND_8QUOTE_CHR NEQ %C'N' AND .SEND_8QUOTE_CHR NEQ %C'Y'
THEN
FLAG_8QUOTE = TRUE
ELSE
FLAG_8QUOTE = FALSE;
!
! Check the repeat character and set flags
!
IF ( NOT ((.REPT_CHR GEQ %O'41' AND .REPT_CHR LEQ %O'76') OR (.REPT_CHR GEQ %O'140' AND
.REPT_CHR LEQ %O'176')) OR .REPT_CHR EQL .SEND_QUOTE_CHR OR .REPT_CHR EQL .SEND_8QUOTE_CHR
OR .REPT_CHR EQL .RCV_QUOTE_CHR) AND .REPT_CHR NEQ %C' '
THEN
BEGIN
KRM_ERROR (KER_PROTOERR);
RETURN KER_PROTOERR;
END;
IF .REPT_CHR NEQ %C' ' THEN FLAG_REPEAT = TRUE ELSE FLAG_REPEAT = FALSE;
RETURN KER_NORMAL;
END; ! End of PRS_SEND_INIT
%SBTTL 'SET_SEND_INIT'
ROUTINE SET_SEND_INIT : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will initialize the various parameters for the
! MSG_SND_INIT message.
!
! CALLING SEQUENCE:
!
! SET_SEND_INIT();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! SND_MSG parameters set up.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
CH$WCHAR (CHAR (.RCV_PKT_SIZE), CH$PTR (SND_MSG, PKT_MSG + P_SI_BUFSIZ, CHR_SIZE));
CH$WCHAR (CHAR (.RCV_TIMEOUT), CH$PTR (SND_MSG, PKT_MSG + P_SI_TIMOUT, CHR_SIZE));
CH$WCHAR (CHAR (.RCV_NPAD), CH$PTR (SND_MSG, PKT_MSG + P_SI_NPAD, CHR_SIZE));
CH$WCHAR (CTL (.RCV_PADCHAR), CH$PTR (SND_MSG, PKT_MSG + P_SI_PAD, CHR_SIZE));
CH$WCHAR (CHAR (.RCV_EOL), CH$PTR (SND_MSG, PKT_MSG + P_SI_EOL, CHR_SIZE));
CH$WCHAR (.RCV_QUOTE_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_QUOTE, CHR_SIZE));
CH$WCHAR (.SEND_8QUOTE_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_8QUOTE, CHR_SIZE));
CH$WCHAR (.INI_CHK_TYPE, CH$PTR (SND_MSG, PKT_MSG + P_SI_CHKTYPE, CHR_SIZE));
CH$WCHAR (.REPT_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_REPEAT, CHR_SIZE));
END; ! End of SET_SEND_INIT
%SBTTL 'SEND_PACKET'
ROUTINE SEND_PACKET (TYPE, LENGTH, MN) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will cause a packet to be sent over the line
! that has been opened by OPEN_TERMINAL.
!
! CALLING SEQUENCE:
!
! SEND_PACKET(Type, Length);
!
! INPUT PARAMETERS:
!
! TYPE - Type of packet to send.
!
! LENGTH - Length of the packet being sent.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
FILLER : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)],
TOT_MSG_LEN, ! Length of message including all characters
CHKSUM, ! Checksum for the message we calculate
POINTER; ! Pointer to the information in the message
!
! Do any filler processing that the remote KERMIT requires.
!
IF .SEND_NPAD NEQ 0
THEN
BEGIN
CH$FILL (.SEND_PADCHAR, MAX_MSG, CH$PTR (FILLER, 0, CHR_SIZE));
!
! Update the send stats
!
SMSG_TOTAL_CHARS = .SMSG_TOTAL_CHARS + .SEND_NPAD;
!
! Send the fill
!
DO_PARITY (FILLER, .SEND_NPAD + PKT_TOT_OVR_HEAD);
SEND (FILLER, .SEND_NPAD + PKT_TOT_OVR_HEAD);
END;
!
! Store the header information into the message.
!
CH$WCHAR (.TYPE, CH$PTR (SND_MSG, PKT_TYPE, CHR_SIZE));
CH$WCHAR (.SND_SOH, CH$PTR (SND_MSG, PKT_MARK, CHR_SIZE));
CH$WCHAR (CHAR (.LENGTH + PKT_OVR_HEAD + (.BLK_CHK_TYPE - CHK_1CHAR)),
CH$PTR (SND_MSG,
PKT_COUNT, CHR_SIZE));
CH$WCHAR (CHAR ((IF .MN LSS 0 THEN 0 ELSE .MN)), CH$PTR (SND_MSG, PKT_SEQ, CHR_SIZE));
!
! Calculate the block check value
!
POINTER = CH$PTR (SND_MSG, PKT_MARK + 1, CHR_SIZE);
CHKSUM = CALC_BLOCK_CHECK (.POINTER, .LENGTH + PKT_OVR_HEAD);
TOT_MSG_LEN = .LENGTH + PKT_TOT_OVR_HEAD;
!
! Store the checksum into the message
!
POINTER = CH$PTR (SND_MSG, .LENGTH + PKT_OVR_HEAD + 1, CHR_SIZE);
CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF
SET
[CHK_1CHAR] :
CH$WCHAR_A (CHAR (.CHKSUM), POINTER);
[CHK_2CHAR] :
BEGIN
CH$WCHAR_A (CHAR (.CHKSUM<6, 6>), POINTER);
CH$WCHAR_A (CHAR (.CHKSUM<0, 6>), POINTER);
TOT_MSG_LEN = .TOT_MSG_LEN + 1;
END;
[CHK_CRC] :
BEGIN
CH$WCHAR_A (CHAR (.CHKSUM<12, 4>), POINTER);
CH$WCHAR_A (CHAR (.CHKSUM<6, 6>), POINTER);
CH$WCHAR_A (CHAR (.CHKSUM<0, 6>), POINTER);
TOT_MSG_LEN = .TOT_MSG_LEN + 2;
END;
TES;
!
! Store in the end of line character
!
CH$WCHAR_A (.SEND_EOL, POINTER);
!
! If we are debugging then type out the message we are sending.
!
DBG_SEND (SND_MSG, (.TOT_MSG_LEN));
!
! Update the stats for total characters and the data characters
!
SMSG_TOTAL_CHARS = .SMSG_TOTAL_CHARS + .TOT_MSG_LEN;
! Make data characters really be that, not just characters in data field
! SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .LENGTH;
IF .TYPE EQL MSG_NAK
THEN
BEGIN
SMSG_NAKS = .SMSG_NAKS + 1;
XFR_STATUS (%C'S', %C'N');
END
ELSE
BEGIN
SMSG_COUNT = .SMSG_COUNT + 1;
XFR_STATUS (%C'S', %C'P');
END;
!
! Check if we are in IBM mode and need to wait for an XON first
! We will not wait if this is a packet which might be going out
! without previous traffic (generic commands, init packets).
IF .IBM_FLAG AND NOT (.TYPE EQL MSG_SND_INIT OR .TYPE EQL MSG_SER_INIT OR .TYPE EQL MSG_RCV_INIT
OR .TYPE EQL MSG_COMMAND OR .TYPE EQL MSG_GENERIC)
THEN
IF NOT IBM_WAIT () THEN RETURN KER_ABORTED;
!
! Now call the O/S routine to send the message out to the remote KERMIT
!
DO_PARITY (SND_MSG, .TOT_MSG_LEN);
RETURN SEND (SND_MSG, .TOT_MSG_LEN);
END; ! End of SEND_PACKET
%SBTTL 'REC_MESSAGE - Receive a message'
ROUTINE REC_MESSAGE (CHK_ROUTINE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle the retry processing for the various
! messages that can be received.
!
! CALLING SEQUENCE:
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! KER_NORMAL - Normal return
! KER_RETRIES - Too many retries
! (What ever REC_PACKET returns).
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS; ! Status returned by various routines
RETURN
WHILE TRUE DO
BEGIN
IF .NUM_RETRIES GTR .PKT_RETRIES
THEN
BEGIN
KRM_ERROR (KER_RETRIES); ! Report the error
RETURN KER_RETRIES;
END;
NUM_RETRIES = .NUM_RETRIES + 1;
STATUS = REC_PACKET ();
IF NOT .STATUS AND .STATUS NEQ KER_CHKSUMERR AND .STATUS NEQ KER_TIMEOUT
THEN
RETURN .STATUS;
IF NOT .STATUS
THEN
SEND_PACKET (MSG_NAK, 0, .MSG_NUMBER) ![024]
ELSE
BEGIN
![021]
![021] If the packet type is not acceptable by our caller, nak it so the
![021] other end tries again, and abort the current operation. This is so
![021] we will return to server mode (if we are running that way) quickly
![021] when the other Kermit has been aborted and then restarted, and should
![021] also make restarting quick, since we will not need to wait for the
![021] other Kermit to time this message out before retransmitting.
![021]
IF NOT (.CHK_ROUTINE) ()
THEN
BEGIN
SEND_PACKET (MSG_NAK, 0, .REC_SEQ);
RETURN FALSE; ! Just indicate an error
END
ELSE
EXITLOOP KER_NORMAL;
END;
END;
END; ! End of REC_PARSE
%SBTTL 'REC_PACKET'
ROUTINE REC_PACKET =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will do the oppoiste of SEND_PACKET. It will wait
! for the message to be read from the remote and then it will
! check the message for validity.
!
! CALLING SEQUENCE:
!
! Flag = REC_PACKET();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! REC_MSG - Contains the message received.
!
! COMPLETION CODES:
!
! True - Packet receive ok.
! False - Problem occured during the receiving of the packet.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
BIND
ATTEMPT_TEXT = UPLIT (%ASCIZ'Attempting to receive');
LOCAL
STATUS, ! Status returned by various routines
MSG_LENGTH,
ERR_POINTER, ! Pointer to the error buffer
POINTER,
CHKSUM; ! Checksum of the message
!
! Attempt to read the message from the remote.
!
! DO
! BEGIN
IF .DEBUG_FLAG
THEN
BEGIN
LOCAL
OLD_RTN;
OLD_RTN = TT_SET_OUTPUT (DBG_DUMP);
TT_TEXT (ATTEMPT_TEXT);
TT_CRLF ();
TT_SET_OUTPUT (.OLD_RTN);
END;
!
! If status type out requested, do it once
!
IF .TYP_STS_FLAG
THEN
BEGIN
STS_OUTPUT ();
TYP_STS_FLAG = FALSE;
END;
!
! Receive the message from the remote Kermit
!
STATUS = RECEIVE (REC_MSG, MSG_LENGTH);
!
! Check for timeouts
!
IF .STATUS EQL KER_TIMEOUT THEN XFR_STATUS (%C'R', %C'T');
!
! If it failed return the status to the upper level
!
IF NOT .STATUS
THEN
BEGIN
IF .STATUS NEQ KER_ABORTED AND .STATUS NEQ KER_TIMEOUT THEN KRM_ERROR (.STATUS);
! Report error
RETURN .STATUS;
END;
!
! Determine if we got a good message
!
IF .MSG_LENGTH LSS PKT_TOT_OVR_HEAD - 1
THEN
BEGIN
RETURN KER_ZEROLENMSG;
END;
!
! Update the stats on the total number of characters received.
!
RMSG_TOTAL_CHARS = .RMSG_TOTAL_CHARS + .MSG_LENGTH;
!
! Initialize the checksum and others
!
REC_TYPE = CH$RCHAR (CH$PTR (REC_MSG, PKT_TYPE, CHR_SIZE));
!
! Now break the message apart byte by byte.
!
REC_LENGTH = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNT, CHR_SIZE))) - PKT_OVR_HEAD - (
.BLK_CHK_TYPE - CHK_1CHAR);
REC_SEQ = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_SEQ, CHR_SIZE)));
!
! Typed the packet if we are debugging
!
DBG_RECEIVE (REC_MSG);
!
! Now compute the final checksum and make sure that it is identical
! to what we received from the remote KERMIT
!
POINTER = CH$PTR (REC_MSG, PKT_MARK + 1, CHR_SIZE);
CHKSUM = CALC_BLOCK_CHECK (.POINTER, .REC_LENGTH + PKT_OVR_HEAD);
POINTER = CH$PTR (REC_MSG, .REC_LENGTH + PKT_OVR_HEAD + 1, CHR_SIZE);
STATUS = KER_NORMAL; ! Assume good checksum
CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF
SET
[CHK_1CHAR] :
IF .CHKSUM NEQ UNCHAR (CH$RCHAR_A (POINTER)) THEN STATUS = KER_CHKSUMERR;
[CHK_2CHAR] :
IF (.CHKSUM<6, 6> NEQ UNCHAR (CH$RCHAR_A (POINTER))) OR (.CHKSUM<0, 6> NEQ UNCHAR (
CH$RCHAR_A (POINTER)))
THEN
STATUS = KER_CHKSUMERR;
[CHK_CRC] :
IF (.CHKSUM<12, 4> NEQ UNCHAR (CH$RCHAR_A (POINTER))) OR (.CHKSUM<6, 6> NEQ UNCHAR (
CH$RCHAR_A (POINTER))) OR (.CHKSUM<0, 6> NEQ UNCHAR (CH$RCHAR_A (POINTER)))
THEN
STATUS = KER_CHKSUMERR;
TES;
!
! If we have a bad checksum, check for the special cases when we might be out
! of sync with the sender. This can occur if the sender is retransmitting
! a send-init (because our ACK got lost), and we have agreed on multi-char
! checksums, or because the sender is a server who has aborted back to being
! idle without telling us.
! Note that in either case, we return back to using single character checksums
!
IF .STATUS EQL KER_CHKSUMERR
THEN
BEGIN
IF (.BLK_CHK_TYPE NEQ CHK_1CHAR AND .REC_SEQ EQL 0) AND (.REC_LENGTH LSS 1 - (.BLK_CHK_TYPE
- CHK_1CHAR) AND .REC_TYPE EQL MSG_NAK) OR (.REC_TYPE EQL MSG_SND_INIT)
THEN
BEGIN
LOCAL
SAVE_BLK_CHK_TYPE;
SAVE_BLK_CHK_TYPE = .BLK_CHK_TYPE; ! Remember what we are using
BLK_CHK_TYPE = CHK_1CHAR;
POINTER = CH$PTR (REC_MSG, PKT_MARK + 1, CHR_SIZE);
CHKSUM = CALC_BLOCK_CHECK (.POINTER, .REC_LENGTH + PKT_OVR_HEAD);
POINTER = CH$PTR (REC_MSG, .REC_LENGTH + PKT_OVR_HEAD + 1, CHR_SIZE);
IF .CHKSUM NEQ UNCHAR (CH$RCHAR_A (POINTER))
THEN
BEGIN
BLK_CHK_TYPE = .SAVE_BLK_CHK_TYPE;
RETURN KER_CHKSUMERR;
END;
END
ELSE
RETURN KER_CHKSUMERR;
END;
!
! Update the stats
!
! RMSG_DATA_CHARS = .RMSG_DATA_CHARS + .REC_LENGTH;
IF .REC_TYPE EQL MSG_NAK
THEN
BEGIN
RMSG_NAKS = .RMSG_NAKS + 1;
XFR_STATUS (%C'R', %C'N');
END
ELSE
BEGIN
RMSG_COUNT = .RMSG_COUNT + 1;
XFR_STATUS (%C'R', %C'P');
END;
!
! Now check to see if we have an E type (Error) packet.
!
IF .REC_TYPE NEQ MSG_ERROR THEN RETURN KER_NORMAL;
!
! Here to process an error packet. Call the user routine to output the
! error message to the terminal.
!
!
![026] Use decoding routine to fetch the error text
!
CH$FILL (CHR_NUL, MAX_MSG + 1, CH$PTR (LAST_ERROR));
SET_STRING (CH$PTR (LAST_ERROR), MAX_MSG, TRUE);
BFR_EMPTY ();
SET_STRING (0, 0, FALSE);
![026] ERR_POINTER = CH$PTR (LAST_ERROR);
![026] POINTER = CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE);
![026]
![026] INCR I FROM 1 TO .REC_LENGTH DO
![026] CH$WCHAR_A (CH$RCHAR_A (POINTER), ERR_POINTER);
![026]
![026] CH$WCHAR (CHR_NUL, ERR_POINTER);
TT_TEXT (LAST_ERROR);
TT_CRLF ();
RETURN KER_ERRMSG;
END; ! End of REC_PACKET
%SBTTL 'CALC_BLOCK_CHECK'
ROUTINE CALC_BLOCK_CHECK (POINTER, LENGTH) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will calculate the proper value for the block check
! for a given message. The value it returns is dependant upon the
! type of block check requested in BLK_CHK_TYPE.
!
! CALLING SEQUENCE:
!
! CHKSUM = CALC_BLOCK_CHECK (.POINTER, .LENGTH);
!
! INPUT PARAMETERS:
!
! POINTER - A character pointer to the first character to be
! included in the block check.
!
! LENGTH - The number of characters to be included.
!
! IMPLICIT INPUTS:
!
! BLK_CHK_TYPE - The type of block check to generate.
!
! OUPTUT PARAMETERS:
!
! The value is the block check.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
CHAR_MASK, ! Mask for stripping bits
BLOCK_CHECK; ! To build initial block check value
BLOCK_CHECK = 0; ! Start out at 0
!
! Set mask for characters so that we calculate the block check correctly
!
CHAR_MASK = (IF .PARITY_TYPE EQL PR_NONE THEN %O'377' ELSE %O'177');
CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF
SET
[CHK_1CHAR, CHK_2CHAR] :
INCR I FROM 1 TO .LENGTH DO
BLOCK_CHECK = .BLOCK_CHECK + (CH$RCHAR_A (POINTER) AND .CHAR_MASK);
[CHK_CRC] :
BEGIN
!
! Ensure that the calculation is done with correct type of characters
!
LOCAL
TMP_PTR; ! Temp pointer for copying chars
TMP_PTR = .POINTER;
IF .PARITY_TYPE EQL PR_NONE
THEN
INCR I FROM 1 TO .LENGTH DO
CH$WCHAR_A ((CH$RCHAR (.TMP_PTR) AND %O'177'), TMP_PTR);
BLOCK_CHECK = CRCCLC (.POINTER, .LENGTH);
END;
TES;
IF .BLK_CHK_TYPE EQL CHK_1CHAR
THEN
BLOCK_CHECK = (.BLOCK_CHECK + ((.BLOCK_CHECK AND %O'300')/%O'100')) AND %O'77';
RETURN .BLOCK_CHECK; ! Return the correct value
END; ! End of CALC_BLOCK_CHK
%SBTTL 'NORMALIZE_FILE - Put file name into normal form'
ROUTINE NORMALIZE_FILE (FILE_ADDRESS, FILE_LENGTH, NAME_LENGTH, TYPE_LENGTH) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will ensure that a file specification is in normal
! form. It does this by replacing all non-alphanumeric characters
! (except the first period) with "X". It will also ensure that
! the resulting specification (of form name.type) has only
! a specified number of characters in the name portion and type portion.
!
! CALLING SEQUENCE:
!
! NORMALIZE_FILE (FILE_ADDRESS, FILE_LENGTH, NAME_LENGTH, TYPE_LENGTH);
!
! INPUT PARAMETERS:
!
! FILE_ADDRESS - Address of file specification string to be normalized
!
! FILE_LENGTH - Length of file specification
!
! NAME_LENGTH - Maximum length desired for "name" portion.
!
! TYPE_LENGTH - Maximum length desired for "type" portion.
!
! With both NAME_LENGTH and TYPE_LENGTH, a negative value indicates
! unlimited lenght.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUPTUT PARAMETERS:
!
! FILE_LENGTH - The length of the resulting file spec
!
! NAME_LENGTH - The actual length of the resulting file name
!
! TYPE_LENGTH - The actual length of the resulting file type
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
CH, ! Character being processed
POINTER, ! Pointer to file spec
WRT_POINTER, ! Pointer to write file spec
WRT_SIZE,
FIRST_PERIOD, ! Flag we have seen a period
IGNORE_BAD, ! Flag we should ignore bad characters
BAD_CHAR, ! Flag this character was bad
FILE_CTR, ! Counter for overall length
NAME_CTR, ! Counter for name characters
TYPE_CTR; ! Counter for type characters
FILE_CTR = 0;
NAME_CTR = 0;
TYPE_CTR = 0;
WRT_SIZE = 0;
FIRST_PERIOD = FALSE; ! No periods yet
POINTER = CH$PTR (.FILE_ADDRESS); ! Set up pointer to file name
WRT_POINTER = .POINTER;
IF .NAME_LENGTH EQL 0 THEN FIRST_PERIOD = TRUE; ! Pretend we did name already
IGNORE_BAD = FALSE;
IF .NAME_LENGTH GTR 0
THEN
BEGIN
DECR I FROM ..FILE_LENGTH TO 0 DO
IF CH$RCHAR_A (POINTER) EQL %C'.'
THEN
BEGIN
IGNORE_BAD = TRUE;
EXITLOOP;
END;
END;
POINTER = .WRT_POINTER;
WHILE .FILE_CTR LSS ..FILE_LENGTH DO
BEGIN
CH = CH$RCHAR_A (POINTER); ! Get a character
FILE_CTR = .FILE_CTR + 1;
IF (.CH LSS %C'0' AND (.CH NEQ %C'.' OR .FIRST_PERIOD)) OR .CH GTR %C'z' OR (.CH GTR %C'9'
AND .CH LSS %C'A') OR (.CH GTR %C'Z' AND .CH LSS %C'a')
THEN
BEGIN
BAD_CHAR = TRUE;
CH = %C'X';
END
ELSE
BEGIN
BAD_CHAR = FALSE;
IF .CH GEQ %C'a' THEN CH = .CH - (%C'a' - %C'A');
END;
IF .CH EQL %C'.'
THEN
BEGIN
FIRST_PERIOD = TRUE;
CH$WCHAR_A (.CH, WRT_POINTER);
WRT_SIZE = .WRT_SIZE + 1;
END
ELSE
IF NOT .BAD_CHAR OR NOT .IGNORE_BAD
THEN
IF NOT .FIRST_PERIOD
THEN
BEGIN
IF .NAME_LENGTH LSS 0 OR .NAME_CTR LSS .NAME_LENGTH
THEN
BEGIN
NAME_CTR = .NAME_CTR + 1;
WRT_SIZE = .WRT_SIZE + 1;
CH$WCHAR_A (.CH, WRT_POINTER);
END;
END
ELSE
IF .TYPE_LENGTH LSS 0 OR .TYPE_CTR LSS .TYPE_LENGTH
THEN
BEGIN
TYPE_CTR = .TYPE_CTR + 1;
WRT_SIZE = .WRT_SIZE + 1;
CH$WCHAR_A (.CH, WRT_POINTER);
END;
END;
.FILE_LENGTH = .WRT_SIZE;
CH$WCHAR_A (CHR_NUL, WRT_POINTER);
END; ! End of NORMALIZE_FILE
%SBTTL 'Buffer filling -- Main routine'
ROUTINE BFR_FILL (FIRST_FLAG) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will fill the buffer with data from the file. It
! will do all the quoting that is required.
!
! CALLING SEQUENCE:
!
! EOF_FLAG = BFR_FILL(.FIRST_FLAG);
!
! INPUT PARAMETERS:
!
! FIRST_FLAG - Flag whether first call for this file
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! True - Buffer filled may be at end of file.
! False - At end of file.
!
! IMPLICIT OUTPUTS:
!
! Number of characters stored in the buffer.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LITERAL
NO_CHAR = -1, ! No character next
EOF_CHAR = -2; ! EOF seen
LOCAL
I, ! Temp loop index
MAX_SIZE, ! Maximum size of data
POINTER; ! Pointer into the message buffer
OWN
NEXT_CHR, ! Saved character
STATUS, ! Status value
REPEAT_COUNT, ! Number of times character repeated
CHAR_8_BIT, ! 8 bit character from file
CHRS : VECTOR [5], ! String needed to represent character
CHR_IDX, ! Index into CHRS
OLD_CHAR_8_BIT, ! Previous 8-bit character
OLD_CHRS : VECTOR [5], ! String for previous character
OLD_CHR_IDX; ! Index for previous character
ROUTINE GET_QUOTED_CHAR =
!
! This routine gets a character from the file and returns both
! the character and the string needed to represent the character
! if it needs quoting.
!
BEGIN
IF .NEXT_CHR GEQ 0
THEN
BEGIN
CHAR_8_BIT = .NEXT_CHR;
NEXT_CHR = NO_CHAR;
STATUS = KER_NORMAL;
END
ELSE
IF .NEXT_CHR EQL NO_CHAR
THEN
STATUS = (.GET_CHR_ROUTINE) (CHAR_8_BIT)
ELSE
STATUS = KER_EOF;
IF .STATUS EQL KER_NORMAL
THEN
BEGIN
!
! Determine if we should just quote the character
! Either:
! Character is a delete (177 octal)
! or Character is a control character (less than 40 octal)
! or Character is a quote character
! or Character is the repeat character and doing repeat compression
! or Character is an eight bit quote character and doing eight bit
! quoting.
!
IF ((.CHAR_8_BIT AND %O'177') LSS %C' ') OR ((.CHAR_8_BIT AND %O'177') EQL CHR_DEL) OR (
(.CHAR_8_BIT AND %O'177') EQL .RCV_QUOTE_CHR) OR (.FLAG_REPEAT AND ((.CHAR_8_BIT AND
%O'177') EQL .REPT_CHR)) OR (.FLAG_8QUOTE AND ((.CHAR_8_BIT AND %O'177') EQL
.SEND_8QUOTE_CHR))
THEN
BEGIN
!
! If the character is a control character or delete we must do a CTL(Character)
! so it is something that we can be sure we can send.
!
IF ((.CHAR_8_BIT AND %O'177') LSS %C' ') OR ((.CHAR_8_BIT AND %O'177') EQL CHR_DEL)
THEN
CHRS [0] = CTL (.CHAR_8_BIT)
ELSE
CHRS [0] = .CHAR_8_BIT;
CHR_IDX = 1;
CHRS [1] = .RCV_QUOTE_CHR; ![035] Use character we said we would send
END
ELSE
BEGIN
CHR_IDX = 0;
CHRS [0] = .CHAR_8_BIT;
END;
END
ELSE
IF .STATUS NEQ KER_EOF THEN KRM_ERROR (.STATUS); ! Report error
RETURN .STATUS;
END;
ROUTINE GET_8_QUOTED_CHAR =
!
! This routine will get the quoted representation of a character
! (by calling GET_QUOTED_CHAR), and return the 8th-bit quoted
! representation.
!
BEGIN
IF (STATUS = GET_QUOTED_CHAR ()) EQL KER_NORMAL
THEN
BEGIN
!
! Determine if we must quote the eighth bit (parity bit on)
!
IF (((.CHRS [0] AND %O'177') NEQ .CHRS [0]) AND .FLAG_8QUOTE)
THEN
BEGIN
CHRS [0] = .CHRS [0] AND %O'177';
CHR_IDX = .CHR_IDX + 1;
CHRS [.CHR_IDX] = .SEND_8QUOTE_CHR;
END;
END;
RETURN .STATUS;
END;
!
! Start of code for BFR_FILL
!
! Initialize pointer and count
!
SIZE = 0;
POINTER = CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE);
MAX_SIZE = .SEND_PKT_SIZE - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR);
!
! If last call got an error or eof, return it now
!
IF NOT .FIRST_FLAG AND (.STATUS NEQ KER_NORMAL) THEN RETURN .STATUS;
!
! If first time for a file prime the pump with the first character.
!
IF .FIRST_FLAG
THEN
BEGIN
FIRST_FLAG = FALSE;
NEXT_CHR = -1; ! No backed up character
IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR ();
IF .STATUS NEQ KER_NORMAL THEN RETURN .STATUS;
OLD_CHAR_8_BIT = .CHAR_8_BIT;
INCR OLD_CHR_IDX FROM 0 TO .CHR_IDX DO
OLD_CHRS [.OLD_CHR_IDX] = .CHRS [.OLD_CHR_IDX];
OLD_CHR_IDX = .CHR_IDX;
REPEAT_COUNT = 0; ! Character was not repeated yet
! Will always be incremented
END;
!
! Otherwise, loop until we fill buffer
!
WHILE .SIZE LSS .MAX_SIZE DO ! Normal exit is via an EXITLOOP
BEGIN
!
! Check if we are doing run compression
!
IF .FLAG_REPEAT
THEN
BEGIN
!
! Here with previous character in OLD_xxx. As long as we
! are getting the same character, just count the run.
!
WHILE (.CHAR_8_BIT EQL .OLD_CHAR_8_BIT) AND (.REPEAT_COUNT LSS 94) DO
BEGIN
REPEAT_COUNT = .REPEAT_COUNT + 1;
IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR ();
IF .STATUS NEQ KER_NORMAL
THEN
IF .STATUS NEQ KER_EOF
THEN
CHAR_8_BIT = NO_CHAR
ELSE
BEGIN
CHAR_8_BIT = EOF_CHAR;
CHR_IDX = -1;
END;
END;
IF .OLD_CHR_IDX + 1 + 2 LSS ((.OLD_CHR_IDX + 1)*.REPEAT_COUNT)
THEN
BEGIN
IF .SIZE + .OLD_CHR_IDX + 1 + 2 GTR .MAX_SIZE
THEN
BEGIN
IF .CHAR_8_BIT EQL .OLD_CHAR_8_BIT
THEN
BEGIN
NEXT_CHR = .CHAR_8_BIT;
REPEAT_COUNT = .REPEAT_COUNT - 1;
END;
IF .CHAR_8_BIT EQL EOF_CHAR
THEN
BEGIN
NEXT_CHR = EOF_CHAR; ! Remember EOF for next time
STATUS = KER_NORMAL; ! And give good return now
END;
EXITLOOP;
END;
OLD_CHRS [.OLD_CHR_IDX + 1] = CHAR (.REPEAT_COUNT);
OLD_CHRS [.OLD_CHR_IDX + 2] = .REPT_CHR;
OLD_CHR_IDX = .OLD_CHR_IDX + 2;
!
! Count the number of file characters this represents
!
SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .REPEAT_COUNT - 1;
FILE_CHARS = .FILE_CHARS + .REPEAT_COUNT - 1;
REPEAT_COUNT = 1; ! Only one time for this string
END;
!
! If we don't have enough room for this character, wait till next
! time.
!
IF .SIZE + (.OLD_CHR_IDX + 1)*.REPEAT_COUNT GTR .MAX_SIZE
THEN
BEGIN
! If the next character is the same, the count will get incremented
! next time we enter, so back it off now.
IF .CHAR_8_BIT EQL .OLD_CHAR_8_BIT
THEN
BEGIN
NEXT_CHR = .CHAR_8_BIT;
REPEAT_COUNT = .REPEAT_COUNT - 1;
END;
EXITLOOP;
END;
SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .REPEAT_COUNT;
FILE_CHARS = .FILE_CHARS + .REPEAT_COUNT;
DECR REPEAT_COUNT FROM .REPEAT_COUNT TO 1 DO
DECR I FROM .OLD_CHR_IDX TO 0 DO
BEGIN
CH$WCHAR_A (.OLD_CHRS [.I], POINTER);
SIZE = .SIZE + 1;
END;
!
! If we got an error (or EOF) then exit
!
IF (.STATUS NEQ KER_NORMAL) THEN EXITLOOP;
!
! Otherwise, copy the character which broke the run
!
OLD_CHAR_8_BIT = .CHAR_8_BIT;
INCR OLD_CHR_IDX FROM 0 TO .CHR_IDX DO
OLD_CHRS [.OLD_CHR_IDX] = .CHRS [.OLD_CHR_IDX];
OLD_CHR_IDX = .CHR_IDX;
REPEAT_COUNT = 0;
END
ELSE
!
! Here if we are not doing run compression. We can do things much
! easier.
!
BEGIN
IF (.SIZE + .CHR_IDX + 1) GTR .MAX_SIZE THEN EXITLOOP;
SMSG_DATA_CHARS = .SMSG_DATA_CHARS + 1;
FILE_CHARS = .FILE_CHARS + 1;
DECR CHR_IDX FROM .CHR_IDX TO 0 DO
BEGIN
CH$WCHAR_A (.CHRS [.CHR_IDX], POINTER);
SIZE = .SIZE + 1;
END;
IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR ();
IF (.STATUS NEQ KER_NORMAL) THEN EXITLOOP;
END;
END;
!
! Determine if we really stored anything into the buffer.
!
IF .SIZE NEQ 0 THEN RETURN KER_NORMAL ELSE RETURN .STATUS;
END; ! End of BFR_FILL
%SBTTL 'BFR_EMPTY'
ROUTINE BFR_EMPTY =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will empty the data from the REC_MSG message buffer
! to the file. It will process quoting characters.
!
! CALLING SEQUENCE:
!
! Flag = BFR_EMPTY();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! True - No problems writing the file.
! False - I/O error writing the file.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
STATUS, ! Status returned by various routines
REPEAT_COUNT, ! Count of times to repeat character
TURN_BIT_8_ON, ! If eight bit quoting
COUNTER, ! Count of the characters left
CHARACTER, ! Character we are processing
POINTER; ! Pointer to the data
POINTER = CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE);
COUNTER = 0;
WHILE (.COUNTER LSS .REC_LENGTH) DO
BEGIN
CHARACTER = CH$RCHAR_A (POINTER);
COUNTER = .COUNTER + 1;
!
! If the character is the repeat character (and we are doing repeat
! compression), then get the count.
!
IF ((.CHARACTER EQL .REPT_CHR) AND .FLAG_REPEAT)
THEN
BEGIN
REPEAT_COUNT = UNCHAR (CH$RCHAR_A (POINTER) AND %O'177');
CHARACTER = CH$RCHAR_A (POINTER);
COUNTER = .COUNTER + 2;
END
ELSE
REPEAT_COUNT = 1;
!
! If the character is an eight bit quoting character and we are doing eight
! bit quoting then turn on the flag so we turn the eighth bit on when we
! get the real character.
!
IF ((.CHARACTER EQL .SEND_8QUOTE_CHR) AND .FLAG_8QUOTE)
THEN
BEGIN
TURN_BIT_8_ON = TRUE;
COUNTER = .COUNTER + 1;
CHARACTER = CH$RCHAR_A (POINTER);
END
ELSE
TURN_BIT_8_ON = FALSE;
!
! Now determine if we are quoting the character. If so then we must eat
! the quoting character and get the real character.
!
IF .CHARACTER EQL .SEND_QUOTE_CHR
![035] Is this character other Kermit sends as quote?
THEN
BEGIN
CHARACTER = CH$RCHAR_A (POINTER);
COUNTER = .COUNTER + 1;
!
! Determine if we must undo what someone else has done to the character
!
IF ((.CHARACTER AND %O'177') GEQ CTL (CHR_DEL)) AND ((.CHARACTER AND %O'177') LEQ CTL (
CHR_DEL) + %O'40')
THEN
CHARACTER = CTL (.CHARACTER);
END;
!
! Turn on the eight bit if needed and then write the character out
!
IF .TURN_BIT_8_ON THEN CHARACTER = .CHARACTER OR %O'200';
RMSG_DATA_CHARS = .RMSG_DATA_CHARS + .REPEAT_COUNT;
FILE_CHARS = .FILE_CHARS + .REPEAT_COUNT;
DECR REPEAT_COUNT FROM .REPEAT_COUNT TO 1 DO
BEGIN
STATUS = (.PUT_CHR_ROUTINE) (.CHARACTER);
IF NOT .STATUS THEN RETURN .STATUS;
END;
END;
RETURN KER_NORMAL;
END; ! End of BFR_EMPTY
%SBTTL 'Buffer filling and emptying subroutines'
ROUTINE SET_STRING (POINTER, LENGTH, START) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is used to set up the buffer filling and emptying
! routines to use a string for input (or output) rather than
! the file I/O routines.
!
! CALLING SEQUENCE:
!
! SET_STRING (.POINTER, .LENGTH, .START)
!
! INPUT PARAMETERS:
!
! POINTER - Character pointer to string
!
! LENGTH - Number of characters in string
!
! START - True to start string, false to end it
!
! IMPLICIT INPUTS:
!
! None.
!
! OUPTUT PARAMETERS:
!
! Returns 0 if START = TRUE, actual number of characters used
! by last string if START = FALSE.
!
! IMPLICIT OUTPUTS:
!
! GET_CHR_ROUTINE and PUT_CHR_ROUTINE modifed so that string
! routines are called instead of file I/O.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
OWN
STR_POINTER, ! Pointer to string
STR_LENGTH, ! Length of string
STR_ORG_LENGTH, ! Original length of string
OLD_GET_CHR, ! Old get-char routine
OLD_PUT_CHR; ! Old put-char routine
!
! Routine to get a character from the string
!
ROUTINE GET_STRING (CHAR_ADDRESS) =
BEGIN
!
! If some characters are left, count down the length and get next character
! Otherwise return and end of file indication.
!
IF .STR_LENGTH GTR 0
THEN
BEGIN
STR_LENGTH = .STR_LENGTH - 1;
.CHAR_ADDRESS = CH$RCHAR_A (STR_POINTER);
RETURN KER_NORMAL;
END
ELSE
RETURN KER_EOF;
END; ! End of GET_STRING
ROUTINE PUT_STRING (CHAR_VALUE) =
BEGIN
!
! If there is enough room to store another character, store the character
! and count it. Otherwise return a line too long indication.
!
IF .STR_LENGTH GTR 0
THEN
BEGIN
STR_LENGTH = .STR_LENGTH - 1;
CH$WCHAR_A (.CHAR_VALUE, STR_POINTER);
RETURN KER_NORMAL;
END
ELSE
RETURN KER_LINTOOLNG;
END; ! End of PUT_STRING
!
! If we have a request to start a string (input or output), save the old
! routines and set up ours. Also save the string pointer and length for
! use by our get/put routines.
! Otherwise this is a request to stop using the string routines, so reset
! the old routines and return the actual number of characters read or
! written
!
IF .START
THEN
BEGIN
STR_POINTER = .POINTER;
STR_ORG_LENGTH = .LENGTH;
STR_LENGTH = .LENGTH;
OLD_GET_CHR = .GET_CHR_ROUTINE;
OLD_PUT_CHR = .PUT_CHR_ROUTINE;
GET_CHR_ROUTINE = GET_STRING;
PUT_CHR_ROUTINE = PUT_STRING;
RETURN 0;
END
ELSE
BEGIN
GET_CHR_ROUTINE = .OLD_GET_CHR;
PUT_CHR_ROUTINE = .OLD_PUT_CHR;
RETURN .STR_ORG_LENGTH - .STR_LENGTH;
END;
END; ! End of SET_STRING
%SBTTL 'Add parity routine'
ROUTINE DO_PARITY (MESSAGE, LENGTH) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will add parity for a complete message that is to be
! sent to the remote Kermit.
!
! CALLING SEQUENCE:
!
! DO_PARITY (Message_address, Message_length);
!
! INPUT PARAMETERS:
!
! Message_address - Address of the message to put parity on.
! Message_length - Lengtho of the message.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
MAP
MESSAGE : REF VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)];
LOCAL
POINTER; ! Point into the message
IF NOT .DEV_PARITY_FLAG
THEN
BEGIN
POINTER = CH$PTR (.MESSAGE,, CHR_SIZE);
INCR I FROM 1 TO .LENGTH DO
CH$WCHAR_A (GEN_PARITY (CH$RCHAR (.POINTER)), POINTER);
END;
END; ! End of DO_PARITY
%SBTTL 'Parity routine'
GLOBAL ROUTINE GEN_PARITY (CHARACTER) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will add parity to the character that is supplied.
!
! CALLING SEQUENCE:
!
! CHARACTER = GEN_PARITY(CHARACTER)
!
! INPUT PARAMETERS:
!
! CHARACTER - Produce the parity for this character depending on the
! setting of the SET PARITY switch.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
TEMP_CHAR;
IF .IBM_FLAG THEN RETURN .CHARACTER OR %O'200';
CASE .PARITY_TYPE FROM PR_MIN TO PR_MAX OF
SET
[PR_NONE] :
RETURN .CHARACTER;
[PR_SPACE] :
RETURN .CHARACTER AND %O'177';
[PR_MARK] :
RETURN .CHARACTER OR %O'200';
[PR_ODD] :
TEMP_CHAR = .CHARACTER AND %O'177' OR %O'200';
[PR_EVEN] :
TEMP_CHAR = .CHARACTER AND %O'177';
TES;
TEMP_CHAR = .TEMP_CHAR XOR (.TEMP_CHAR^-4);
TEMP_CHAR = .TEMP_CHAR XOR (.TEMP_CHAR^-2);
IF .TEMP_CHAR<0, 2> EQL %B'01' OR .TEMP_CHAR<0, 2> EQL %B'10'
THEN
RETURN .CHARACTER AND %O'177' OR %O'200'
ELSE
RETURN .CHARACTER AND %O'177';
END; ! End of GEN_PARITY
%SBTTL 'Per transfer -- Initialization'
ROUTINE INIT_XFR : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will initialize the various locations that the
! send and receive statistics are kept.
!
! CALLING SEQUENCE:
!
! INIT_XFR();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
!
! Determine if we should do 8 bit quoting
!
IF .PARITY_TYPE NEQ PR_NONE
THEN
BEGIN
RECV_8QUOTE_CHR = .RCV_8QUOTE_CHR;
END
ELSE
BEGIN
RECV_8QUOTE_CHR = %C'Y';
END;
NUM_RETRIES = 0;
SEND_8QUOTE_CHR = .RECV_8QUOTE_CHR;
!
! Send parameters that may not get set before we need them for the first
! time.
!
SEND_PKT_SIZE = ABS (.SND_PKT_SIZE);
SEND_NPAD = ABS (.SND_NPAD);
SEND_PADCHAR = ABS (.SND_PADCHAR);
SEND_TIMEOUT = ABS (.SND_TIMEOUT);
SEND_EOL = ABS (.SND_EOL);
SEND_QUOTE_CHR = ABS (.SND_QUOTE_CHR);
!
! For initialization messages, we must use single character checksum
! When the send-init/ack sequence has been done, we will switch to the
! desired form
!
BLK_CHK_TYPE = CHK_1CHAR;
INI_CHK_TYPE = .CHKTYPE; ! Send desired type
!
! Set desired repeat character for use in we are doing send-init
! Will be overwritten by other ends desired character if it sends
! the send-init.
!
REPT_CHR = .SET_REPT_CHR;
!
! Assume packet assembly/disassembly uses characters from a file
!
GET_CHR_ROUTINE = GET_FILE; ! Initialize the get-a-char routine
PUT_CHR_ROUTINE = PUT_FILE; ! And the put-a-char
TEXT_HEAD_FLAG = FALSE; ! And assume we will get an File header
NO_FILE_NEEDED = FALSE; ! Assume will do file ops
INIT_PKT_SENT = FALSE; ! And no server-init sent
!
! Always start with packet number 0
!
MSG_NUMBER = 0; ! Initial message number
!
! Stats information
!
SMSG_TOTAL_CHARS = 0;
RMSG_TOTAL_CHARS = 0;
SMSG_DATA_CHARS = 0;
RMSG_DATA_CHARS = 0;
SMSG_COUNT = 0;
RMSG_COUNT = 0;
RMSG_NAKS = 0;
SMSG_NAKS = 0;
XFR_TIME = SY_TIME ();
END; ! End of INIT_XFR
%SBTTL 'Statistics -- Finish message transfer'
ROUTINE END_STATS : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will end the collection of the statistices. It will
! update the various overall statistic parameters.
!
! CALLING SEQUENCE:
!
! END_STATS ();
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
SND_COUNT = .SND_COUNT + .SMSG_COUNT;
RCV_COUNT = .RCV_COUNT + .RMSG_COUNT;
SND_TOTAL_CHARS = .SND_TOTAL_CHARS + .SMSG_TOTAL_CHARS;
SND_DATA_CHARS = .SND_DATA_CHARS + .SMSG_DATA_CHARS;
RCV_TOTAL_CHARS = .RCV_TOTAL_CHARS + .RMSG_TOTAL_CHARS;
RCV_DATA_CHARS = .RCV_DATA_CHARS + .RMSG_DATA_CHARS;
SND_NAKS = .SND_NAKS + .SMSG_NAKS;
RCV_NAKS = .RCV_NAKS + .RMSG_NAKS;
XFR_TIME = SY_TIME () - .XFR_TIME;
TOTAL_TIME = .TOTAL_TIME + .XFR_TIME;
END; ! End of END_STATS
%SBTTL 'Status type out -- STS_OUTPUT'
ROUTINE STS_OUTPUT : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will output the current status of a transfer.
! This is used when the user types a ^A during a transfer.
!
! CALLING SEQUENCE:
!
! STS_OUTPUT ()
!
! INPUT PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! Statistics blocks, file names, etc.
!
! OUPTUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
TT_CHAR (%C'['); ! Start the message
CASE .STATE FROM STATE_MIN TO STATE_MAX OF
SET
[STATE_ID, STATE_II] :
TT_TEXT (UPLIT (%ASCIZ'Idle in server mode'));
[STATE_S, STATE_SF] :
BEGIN
TT_TEXT (UPLIT (%ASCIZ'Initializing for sending file '));
TT_TEXT (FILE_NAME);
END;
[STATE_SI] :
TT_TEXT (UPLIT (%ASCIZ'Initializing for remote command'));
[STATE_SG] :
TT_TEXT (UPLIT (%ASCIZ'Waiting for response to remote command'));
[STATE_SD] :
BEGIN
TT_NUMBER (.FILE_CHARS);
TT_TEXT (UPLIT (%ASCIZ' characters sent for file '));
TT_TEXT (FILE_NAME);
END;
[STATE_SZ] :
BEGIN
TT_TEXT (UPLIT (%ASCIZ'At end of file '));
TT_TEXT (FILE_NAME);
END;
[STATE_SB] :
TT_TEXT (UPLIT (%ASCIZ'Finishing transfer session'));
[STATE_R] :
TT_TEXT (UPLIT (%ASCIZ'Waiting for initialization'));
[STATE_RF] :
TT_TEXT (UPLIT (%ASCIZ'Waiting for next file or end of session'));
[STATE_RD] :
BEGIN
TT_NUMBER (.FILE_CHARS);
TT_TEXT (UPLIT (%ASCIZ' characters received for file '));
TT_TEXT (FILE_NAME);
END;
[STATE_C] :
TT_TEXT (UPLIT (%ASCIZ' Session complete'));
[STATE_A] :
TT_TEXT (UPLIT (%ASCIZ' Session aborted'));
[INRANGE, OUTRANGE] :
TT_TEXT (UPLIT (%ASCIZ' Unknown state'));
TES;
SELECTONE .STATE OF
SET
[STATE_S, STATE_SF, STATE_SD, STATE_SZ, STATE_SB] :
BEGIN
IF .RMSG_NAKS GTR 0
THEN
BEGIN
TT_TEXT (UPLIT (%ASCIZ', '));
TT_NUMBER (.RMSG_NAKS);
TT_TEXT (UPLIT (%ASCIZ' NAKs received'));
END;
END;
[STATE_R, STATE_RF, STATE_RD] :
BEGIN
IF .SMSG_NAKS GTR 0
THEN
BEGIN
TT_TEXT (UPLIT (%ASCIZ', '));
TT_NUMBER (.SMSG_NAKS);
TT_TEXT (UPLIT (%ASCIZ' NAKs sent'));
END;
END;
TES;
TT_CHAR (%C']'); ! End the line
TT_CRLF (); ! with a CRLF
END; ! End of STS_OUTPUT
%SBTTL 'TYPE_CHAR - Type out a character'
ROUTINE TYPE_CHAR (CHARACTER) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is used as an alternate output routine for BFR_EMPTY.
! It will type the character on the terminal, and always return a
! true status.
!
! CALLING SEQUENCE:
!
! STATUS = TYPE_CHAR (.CHARACTER);
!
! INPUT PARAMETERS:
!
! CHARACTER - The character to type
!
! IMPLICIT INPUTS:
!
! None.
!
! OUPTUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
TT_CHAR (.CHARACTER); ! Type the character
RETURN KER_NORMAL; ! And return OK
END; ! End of TYPE_CHAR
%SBTTL 'Debugging -- DBG_SEND'
ROUTINE DBG_SEND (ADDRESS, LENGTH) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will output the message that is going to be sent
! as part of the debugging information that is turned on in the
! SET DEBUG command.
!
! CALLING SEQUENCE:
!
! DBG_SEND(MSG_ADDRESS, MSG_LENGTH);
!
! INPUT PARAMETERS:
!
! MSG_ADDRESS - Address of the message that is going to be sent
! to the remote KERMIT. The bytes are CHR_SIZE.
! MSG_LENGTH - Length of the message.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
BIND
SEND_TEXT = UPLIT (%ASCIZ'Sending...');
IF .DEBUG_FLAG
THEN
BEGIN
LOCAL
OLD_RTN;
OLD_RTN = TT_SET_OUTPUT (DBG_DUMP);
TT_TEXT (SEND_TEXT);
DBG_MESSAGE (.ADDRESS, .LENGTH);
TT_SET_OUTPUT (.OLD_RTN);
END;
END; ! End of DBG_SEND
%SBTTL 'Debugging -- DBG_RECEIVE'
ROUTINE DBG_RECEIVE (ADDRESS) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will output the message that was received from
! the remote KERMIT. This routine is called only if the DEBUG_FLAG
! is true.
!
! CALLING SEQUENCE:
!
! DBG_RECEIVE(MSG_ADDRESS);
!
! INPUT PARAMETERS:
!
! MSG_ADDRESS - Address of the message received by the remote KERMIT.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
BIND
RECEIVE_TEXT = UPLIT (%ASCIZ'Received...');
IF .DEBUG_FLAG
THEN
BEGIN
LOCAL
OLD_RTN;
OLD_RTN = TT_SET_OUTPUT (DBG_DUMP);
TT_TEXT (RECEIVE_TEXT);
DBG_MESSAGE (.ADDRESS, .REC_LENGTH);
TT_SET_OUTPUT (.OLD_RTN);
END;
END; ! End of DBG_RECEIVE
%SBTTL 'Debugging -- DBG_MESSAGE'
ROUTINE DBG_MESSAGE (MSG_ADDRESS, MSG_LENGTH) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will display a message that is either being sent
! or received on the user's terminal.
!
! CALLING SEQUENCE:
!
! DBG_MESSAGE(MSG_ADDRESS, MSG_LENGTH);
!
! INPUT PARAMETERS:
!
! MSG_ADDRESS - Address of the message to be output
! MSG_LENGTH - Length of the message to be output.
!
! IMPLICIT INPUTS:
!
! None.
!
! OUTPUT PARAMETERS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
MAP
MSG_ADDRESS : REF VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)]; ! Point to the vector
LOCAL
OLD_RTN, ! Old type out routine
CHKSUM, ! Numeric value of block check
TEMP_POINTER, ! Temporary character pointer
MSG_LEN;
!
! Message type text
!
BIND
DATA_TEXT = UPLIT (%ASCIZ' (Data)'),
ACK_TEXT = UPLIT (%ASCIZ' (ACK)'),
NAK_TEXT = UPLIT (%ASCIZ' (NAK)'),
SND_INIT_TEXT = UPLIT (%ASCIZ' (Send init)'),
BREAK_TEXT = UPLIT (%ASCIZ' (Break)'),
TEXT_TEXT = UPLIT (%ASCIZ' (Text header)'),
FILE_TEXT = UPLIT (%ASCIZ' (File header)'),
EOF_TEXT = UPLIT (%ASCIZ' (EOF)'),
ERROR_TEXT = UPLIT (%ASCIZ' (Error)'),
RCV_INIT_TEXT = UPLIT (%ASCIZ' (Receive initiate)'),
COMMAND_TEXT = UPLIT (%ASCIZ' (Command)'),
KERMIT_TEXT = UPLIT (%ASCIZ' (Generic KERMIT command)');
!
! Header information
!
BIND
MN_TEXT = UPLIT (%ASCIZ'Message number: '),
LENGTH_TEXT = UPLIT (%ASCIZ' Length: '),
DEC_TEXT = UPLIT (%ASCIZ' (dec)'),
MSG_TYP_TEXT = UPLIT (%ASCIZ'Message type: '),
CHKSUM_TEXT = UPLIT (%ASCIZ'Checksum: '),
CHKSUM_NUM_TEXT = UPLIT (%ASCIZ' = '),
OPT_DATA_TEXT = UPLIT (%ASCIZ'Optional data: '),
PRE_CHAR_TEXT = UPLIT (%ASCIZ' "');
!
! Ensure that the type out will go to the debugging location
!
OLD_RTN = TT_SET_OUTPUT (DBG_DUMP);
!
! Preliminary calculations
!
MSG_LEN = UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_COUNT, CHR_SIZE)));
!
! First output some header information for the packet.
!
TT_CRLF ();
TT_TEXT (MN_TEXT);
TT_NUMBER (UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_SEQ, CHR_SIZE))));
TT_TEXT (DEC_TEXT);
TT_TEXT (LENGTH_TEXT);
TT_NUMBER (.MSG_LEN);
TT_TEXT (DEC_TEXT);
TT_CRLF ();
!
! Now output the message type and dependent information
!
TT_TEXT (MSG_TYP_TEXT);
TT_CHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_TYPE, CHR_SIZE)));
SELECTONE CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_TYPE, CHR_SIZE)) OF
SET
[MSG_DATA] :
TT_TEXT (DATA_TEXT);
[MSG_ACK] :
TT_TEXT (ACK_TEXT);
[MSG_NAK] :
TT_TEXT (NAK_TEXT);
[MSG_SND_INIT] :
TT_TEXT (SND_INIT_TEXT);
[MSG_BREAK] :
TT_TEXT (BREAK_TEXT);
[MSG_FILE] :
TT_TEXT (FILE_TEXT);
[MSG_TEXT] :
TT_TEXT (TEXT_TEXT);
[MSG_EOF] :
TT_TEXT (EOF_TEXT);
[MSG_ERROR] :
TT_TEXT (ERROR_TEXT);
[MSG_GENERIC] :
TT_TEXT (KERMIT_TEXT);
[MSG_COMMAND] :
TT_TEXT (COMMAND_TEXT);
TES;
TT_CRLF ();
!
! Now output any of the optional data.
!
IF .MSG_LEN - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR) NEQ 0
THEN
BEGIN
TT_TEXT (OPT_DATA_TEXT);
TT_CRLF ();
TEMP_POINTER = CH$PTR (.MSG_ADDRESS, PKT_MSG, CHR_SIZE);
INCR I FROM 1 TO .MSG_LEN - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR) DO
BEGIN
IF (.I MOD 10) EQL 1
THEN
BEGIN
TT_CRLF ();
TT_CHAR (CHR_TAB);
END;
TT_TEXT (PRE_CHAR_TEXT);
TT_CHAR (CH$RCHAR_A (TEMP_POINTER));
TT_CHAR (%C'"');
END;
IF ((.MSG_LEN - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR)) MOD 10) EQL 1 THEN TT_CRLF ();
TT_CRLF ();
END;
!
! Now output the checksum for the message that we received
!
! This could be either 1 two or three characters.
TT_TEXT (CHKSUM_TEXT);
TEMP_POINTER = CH$PTR (.MSG_ADDRESS,
PKT_MSG + .MSG_LEN + PKT_CHKSUM - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR), CHR_SIZE);
CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF
SET
[CHK_1CHAR] :
BEGIN
TT_TEXT (PRE_CHAR_TEXT);
TT_CHAR (CH$RCHAR (.TEMP_POINTER));
TT_CHAR (%C'"');
CHKSUM = UNCHAR (CH$RCHAR (.TEMP_POINTER));
END;
[CHK_2CHAR] :
BEGIN
CHKSUM = 0;
TT_TEXT (PRE_CHAR_TEXT);
TT_CHAR (CH$RCHAR (.TEMP_POINTER));
TT_CHAR (%C'"');
CHKSUM<6, 6> = UNCHAR (CH$RCHAR_A (TEMP_POINTER));
TT_TEXT (PRE_CHAR_TEXT);
TT_CHAR (CH$RCHAR (.TEMP_POINTER));
TT_CHAR (%C'"');
CHKSUM<0, 6> = UNCHAR (CH$RCHAR (.TEMP_POINTER));
END;
[CHK_CRC] :
BEGIN
CHKSUM = 0;
TT_TEXT (PRE_CHAR_TEXT);
TT_CHAR (CH$RCHAR (.TEMP_POINTER));
TT_CHAR (%C'"');
CHKSUM<12, 4> = UNCHAR (CH$RCHAR_A (TEMP_POINTER));
TT_TEXT (PRE_CHAR_TEXT);
TT_CHAR (CH$RCHAR (.TEMP_POINTER));
TT_CHAR (%C'"');
CHKSUM<6, 6> = UNCHAR (CH$RCHAR_A (TEMP_POINTER));
TT_TEXT (PRE_CHAR_TEXT);
TT_CHAR (CH$RCHAR (.TEMP_POINTER));
TT_CHAR (%C'"');
CHKSUM<0, 6> = UNCHAR (CH$RCHAR (.TEMP_POINTER));
END;
TES;
TT_TEXT (CHKSUM_NUM_TEXT);
TT_NUMBER (.CHKSUM);
TT_TEXT (DEC_TEXT);
TT_CRLF ();
TT_SET_OUTPUT (.OLD_RTN); ! Reset output destination
END; ! End of DBG_MESSAGE
%SBTTL 'End of KERMSG'
END
ELUDOM