separate (NETWORK_PROTOCOLS) package body KERMIT_PROTOCOL is -------------------------------------------------------------------------- -- Kermit information for this program obtained from -- KERMIT A File Transfer Protocol by Frank da Cruz -- Digital Press (Digital Equipment Corporation) -- 1987 -- Also some information was obtained from a Pascal KERMIT for the VAX -- written at the University of Toronto, Computing Services -------------------------------------------------------------------------- package UTILITIES is new PROTOCOL_INDEPENDENT_UTILITIES ( BYTE, F_READ, F_WRITE, RS_READ, RS_WRITE, RS_WRITE_FLUSH, SERVICE ) ; use UTILITIES ; -------------------------------------------------------------------------- -- constants and globals for the kermit_protocol program -------------------------------------------------------------------------- package KERMIT_CONSTANTS is type STATES is (START, FILE_HEADER_STATE, DATA_STATE, END_STATE); type TRANSFER_TYPE is (ASCII_TRANSFER, BINARY_TRANSFER); NUL : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.NUL)); --1st control SOH : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.SOH)); EOL : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.CR)); US : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.US)); --last control SP : constant BYTE := BYTE'VAL(CHARACTER'POS(' ')); DEL : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.DEL)); B_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('B')); D_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('D')); E_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('E')); F_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('F')); N_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('N')); Q_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('Q')); S_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('S')); T_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('T')); Y_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('Y')); Z_PACKET : constant BYTE := BYTE'VAL(CHARACTER'POS('Z')); -- set up the defaults for the send-initialization packet (S packet) -- the values are sent as ascii characters -- subtract 32 from the given -- ascii character's value (except default_qctl is literal) -- the defaults are: maxl = 94; time = 5 (seconds); npad = 0 (no padding) -- padc = NUL; eol = CR; -- the terms maxl, time, npad, etc., are those used in -- KERMIT A File Transfer Protocol, p 234 DEFAULT_MAXL : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.TILDE)); -- ~ DEFAULT_TIME : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.PERCENT));-- % DEFAULT_NPAD : constant BYTE := BYTE'VAL(CHARACTER'POS(' ')); DEFAULT_PADC : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.AT_SIGN));-- @ DEFAULT_EOL : constant BYTE := BYTE'VAL(CHARACTER'POS('-')) ; DEFAULT_QCTL : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.SHARP)); -- # DEFAULT_QBIN : constant BYTE := BYTE'VAL(CHARACTER'POS(ASCII.AMPERSAND));--& MAX_DATALEN : constant := 91; -- 3 less than max packet len, default_maxl NUM_FEATURES : constant INTEGER := 7; -- number of features this kermit has type PACKET_TYPE is record MARK : BYTE := SOH; LEN : BYTE ; SEQ : BYTE ; KTYPE: BYTE ; DATA : BYTE_STRING(1..MAX_DATALEN) := (1..MAX_DATALEN => NUL) ; CHECK: BYTE ; end record; -- here we have some exceptions we're going to trap; they will all give -- rise to FILE_TRANSFER_ERROR eventually TIMEOUT_ERROR, ERROR_RECEIVED, INCOMPATIBLE_KERMITS : exception; UNEXPECTED_PACKET, FILE_NAME_ERROR, PACKET_TOO_LONG : exception; END_OF_TRANSMISSION : exception; end KERMIT_CONSTANTS; use KERMIT_CONSTANTS; package KERMIT_GLOBALS is MAX_LENGTH : INTEGER := 94 ; -- maximum packet size they want TIME : BYTE := DEFAULT_TIME; -- time we want them to wait for us -- we may change this in check_si_response TIME_TO_WAIT : DURATION := 5.0; -- time to wait for their packets NUM_PADC : INTEGER := 0; -- number of padding characters they want PADC : BYTE := DEFAULT_PADC; -- the padding character THEIR_TERMINATOR : BYTE := EOL; -- what they want at end of packet OUR_TERMINATOR : BYTE := EOL; -- what we want at end of packet QCTL_IN : BYTE := DEFAULT_QCTL; -- what control quote they will be sending QBIN_IN : BYTE; QBIN_REQUEST : BYTE := BYTE'VAL(CHARACTER'POS('Y')); -- we can do 8 bit TRANSFER_MODE : TRANSFER_TYPE := BINARY_TRANSFER; DO_8_BIT_PREFIXING : BOOLEAN := false; end KERMIT_GLOBALS; ---------------------------------------------------------------------------- ---------------------------------------------------------------------------- -- procedures and functions specific to kermit_protocol ---------------------------------------------------------------------------- package GENERAL_UTILITIES is procedure GET_PACKET(PACKET_RECEIVED : out PACKET_TYPE); procedure PUT_PACKET(PACKET_OUT : in PACKET_TYPE); procedure NEXT_DATA(THE_DATA_STRING : out BYTE_STRING; DATA_LEN : out INTEGER; DONE: out BOOLEAN; SAVED_CHAR : in out BYTE; IS_CHAR_SAVED : in out BOOLEAN); procedure EXTRACT_DATA(THE_PACKET : in PACKET_TYPE); procedure CREATE_PACKET(THE_PACKET: out PACKET_TYPE; THE_TYPE: in BYTE; THE_DATA: in BYTE_STRING; DATA_LEN : in INTEGER; THE_SEQ: in INTEGER) ; procedure CHECK_SI_RESPONSE(THEIR_SI : in PACKET_TYPE; OK : out BOOLEAN); procedure PRINT_ERROR_MSG(THE_PACKET : in PACKET_TYPE); function CHECKSUM(TEMP_STRING : in BYTE_STRING) return BYTE; function CHECKSUM(THE_PACKET : in PACKET_TYPE) return BYTE; procedure CONSTRUCT_SI_RETURN(THE_PACKET : out PACKET_TYPE); procedure SEND_PACKET(THE_PACKET : in PACKET_TYPE; CURRENT_SEQUENCE : in INTEGER; RESPONSE : out PACKET_TYPE); procedure RECEIVE_RESPONSE(THE_PACKET : out PACKET_TYPE); end GENERAL_UTILITIES; use GENERAL_UTILITIES; package body GENERAL_UTILITIES is separate; package RECEIVE_UTILITIES is procedure RECEIVE_INITIALIZATION(CURRENT_SEQUENCE : in out INTEGER); procedure RECEIVE_FILE_HEADER(CURRENT_SEQUENCE : in out INTEGER); procedure RECEIVE_DATA(CURRENT_SEQUENCE : in out INTEGER); end RECEIVE_UTILITIES; package body RECEIVE_UTILITIES is separate; package SEND_UTILITIES is procedure SEND_INITIALIZATION(CURRENT_SEQUENCE : in out INTEGER); procedure SEND_FILE_HEADER(CURRENT_SEQUENCE : in out INTEGER); procedure SEND_DATA(CURRENT_SEQUENCE : in out INTEGER); procedure SEND_END_OF_FILE(CURRENT_SEQUENCE : in out INTEGER); end SEND_UTILITIES; package body SEND_UTILITIES is separate; --------------------------------------------------------------------- use RECEIVE_UTILITIES; procedure RECEIVE is STATE : STATES := START; CURRENT_SEQ : INTEGER := 0; begin while STATE /= END_STATE loop case STATE is when START => RECEIVE_INITIALIZATION(CURRENT_SEQ); STATE := FILE_HEADER_STATE; when FILE_HEADER_STATE => RECEIVE_FILE_HEADER(CURRENT_SEQ); STATE := DATA_STATE; when DATA_STATE => RECEIVE_DATA(CURRENT_SEQ); STATE := END_STATE; when END_STATE => null; end case; end loop; exception when others => raise FILE_TRANSFER_ERROR; end RECEIVE ; use SEND_UTILITIES; procedure SEND is -- This procedure is similar to that recommended for the top level send -- module of a kermit program in KERMIT A File Transfer Protocol. -- Multiple filenames cannot be handled by this send function, -- although it could be modified to do so. STATE : STATES := START; CURRENT_SEQ : INTEGER := 0; begin while STATE /= END_STATE loop case STATE is when START => SEND_INITIALIZATION(CURRENT_SEQ); STATE := FILE_HEADER_STATE; when FILE_HEADER_STATE => SEND_FILE_HEADER(CURRENT_SEQ); STATE := DATA_STATE; when DATA_STATE => SEND_DATA(CURRENT_SEQ); SEND_END_OF_FILE(CURRENT_SEQ); STATE := END_STATE; when END_STATE => null; end case; end loop; exception when others => raise FILE_TRANSFER_ERROR; end SEND; end KERMIT_PROTOCOL ;