with CALENDAR; separate (NETWORK_PROTOCOLS.KERMIT_PROTOCOL) package body GENERAL_UTILITIES is -- This package contains procedures and functions which handle - getting and -- putting the packet bytes by calling rs_read and rs_write; sending and -- receiving packets (tracking timeouts, etc); reading data from the file -- and coding it for transfer; obtaining a packet, decoding the data and -- writing the data to the file; modification of characters (toggling 6th -- bit, adding 32, subtracting 32). UNCHAR_ERROR: exception ; TRANSFER_MODE_ERROR : exception; CHECKSUM_ERROR : exception; use KERMIT_GLOBALS; function TOCHAR(A_CHAR : BYTE) return BYTE is -- this function takes a character and adds 32 to it. This is to convert -- values that fall between 0 - 31 to printable characters for transmission. INT : INTEGER ; begin INT := BYTE'POS(A_CHAR) + 32 ; return BYTE'VAL(INT) ; end TOCHAR ; function UNCHAR(A_CHAR : BYTE) return BYTE is -- this function takes a character and subtracts 32 from it. This is to -- convert characters that were tochar'd back to their proper value. INT : INTEGER ; begin if BYTE'POS(A_CHAR) >= 32 then -- looks like the character was tochar'd so unchar it INT := BYTE'POS(A_CHAR) - 32 ; return BYTE'VAL(INT) ; else -- looks like we've got the wrong character raise UNCHAR_ERROR; end if; end UNCHAR ; procedure GET_PACKET(PACKET_RECEIVED : out PACKET_TYPE) is -- this procedure obtains the incoming packet and puts it into the packet -- record. If at any point the next character never arrives, a t packet -- is returned to signal a timeout. If a packet is received, the length -- and sequence fields are unchar'd. -- Uses RS_READ to get the next byte from the port. raise -- READ_ERROR if it times out. TEMP_STRING : BYTE_STRING(1..MAX_DATALEN+4); -- data+len+seq+type+checksum PACKET_LEN, I, J : INTEGER := 0; NUM_CHARS : INTEGER := 0; CHAR_IN : BYTE; IS_THERE : BOOLEAN ; READ_ERROR, PACKET_RECEIVE_ERROR : exception; begin PACKET_RECEIVED.KTYPE := T_PACKET; -- assume time out -- get first character of packet--it is the length RS_READ_WITH_TIMEOUT(CHAR_IN, IS_THERE, TIME_TO_WAIT); -- if a char is waiting, see what's there, otherwise... if not IS_THERE then raise READ_ERROR; end if; PACKET_LEN := INTEGER'VAL(BYTE'POS(UNCHAR(CHAR_IN))); I := I + 1; TEMP_STRING(1) := CHAR_IN; -- get all the characters until we see our line_terminator or read in all loop RS_READ_WITH_TIMEOUT(CHAR_IN, IS_THERE, TIME_TO_WAIT); -- if a char is waiting, see what's there, otherwise... if not IS_THERE then raise READ_ERROR; end if; exit when CHAR_IN = OUR_TERMINATOR; -- we see terminator, end of packet -- we will see this only if too few -- characters have been sent. -- otherwise, we will have left loop -- due to next exit when statement. I:= I + 1; TEMP_STRING(I) := CHAR_IN; exit when I = PACKET_LEN + 1; -- stop if all chars for a packet + -- checksum char are here -- remember terminator need not be sent end loop; if I /= PACKET_LEN + 1 then raise PACKET_RECEIVE_ERROR; end if; -- Got what looks like a packet; put chars in packet form PACKET_RECEIVED.LEN := UNCHAR(TEMP_STRING(1)); PACKET_RECEIVED.SEQ := UNCHAR(TEMP_STRING(2)); PACKET_RECEIVED.KTYPE := TEMP_STRING(3); NUM_CHARS := BYTE'POS(UNCHAR(TEMP_STRING(1))); for J in 1..NUM_CHARS-3 loop PACKET_RECEIVED.DATA(J) := TEMP_STRING(J+3); end loop; PACKET_RECEIVED.CHECK := TEMP_STRING(I); if TEMP_STRING(I) /= TOCHAR(CHECKSUM(TEMP_STRING(1..I-1))) then -- checksums didn't match--signal corrupted packet PACKET_RECEIVED.KTYPE := Q_PACKET; end if; exception when CONSTRAINT_ERROR => PACKET_RECEIVED.KTYPE := Q_PACKET; -- too long, assume noise errors when READ_ERROR => PACKET_RECEIVED.KTYPE := T_PACKET; -- assume timeout; when UNCHAR_ERROR => PACKET_RECEIVED.KTYPE := Q_PACKET; -- couldn't unchar, assume bad when CHECKSUM_ERROR => PACKET_RECEIVED.KTYPE := Q_PACKET; -- couldn't do checksum, assume bad when PACKET_RECEIVE_ERROR => PACKET_RECEIVED.KTYPE := Q_PACKET; -- got different num chars than len when others => raise FILE_TRANSFER_ERROR; end GET_PACKET; procedure PUT_PACKET(PACKET_OUT : in PACKET_TYPE) is -- this procedure takes the packet to send and tochars the length, sequence -- and checksum fields. CHAR_OUT : BYTE; NUM_CHARS : INTEGER := BYTE'POS(PACKET_OUT.LEN) ; TEMP_PACKET : PACKET_TYPE := PACKET_OUT; begin TEMP_PACKET.LEN := TOCHAR(PACKET_OUT.LEN); TEMP_PACKET.SEQ := TOCHAR(PACKET_OUT.SEQ); for I in 1 .. NUM_PADC loop -- preceding pad chars they want to see RS_WRITE(PADC); end loop; RS_WRITE(TEMP_PACKET.MARK); RS_WRITE(TEMP_PACKET.LEN); RS_WRITE(TEMP_PACKET.SEQ); RS_WRITE(TEMP_PACKET.KTYPE); for I in 1 .. NUM_CHARS - 3 loop RS_WRITE(TEMP_PACKET.DATA(I)); end loop; RS_WRITE(TOCHAR(CHECKSUM(TEMP_PACKET))); RS_WRITE(THEIR_TERMINATOR); exception when others => raise FILE_TRANSFER_ERROR; end PUT_PACKET ; procedure CONTROLIFY(A_CHAR_IN : in BYTE; A_CHAR_OUT : out BYTE) is -- this procedure converts a control or delete character into the printable -- range. begin if BYTE'POS(A_CHAR_IN) < 64 or BYTE'POS(A_CHAR_IN) = 191 then -- the 191 is a special case of 8 bit transfer with NO prefixing where byte -- transmitted was = 255 (1 DEL). The 255 gets controlified into 191 -- and the result transmitted was # 191. A_CHAR_OUT := BYTE'VAL(BYTE'POS(A_CHAR_IN) + 64); else -- BYTE'POS(A_CHAR_IN) > 63 but /= 191 A_CHAR_OUT := BYTE'VAL(BYTE'POS(A_CHAR_IN) - 64); end if; exception when others => raise FILE_TRANSFER_ERROR; end CONTROLIFY; 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) is -- this procedure builds up the data from the particular file, doing -- control quoting as necessary and binary prefixing as requested TOTAL_CHARS : INTEGER := 0; TEMP_STRING : BYTE_STRING(1..5);--used to keep & and/or # -- while processing character ADD_TO_CHAR : INTEGER := 0; TDL, COUNT : INTEGER := 0; CTLD_CHAR, CUR_CHAR, LOOK_AHEAD : BYTE; FILE_END : BOOLEAN := FALSE; NOT_ENOUGH_ROOM : BOOLEAN := FALSE; begin DONE := FALSE; OUTER: while TOTAL_CHARS < MAX_LENGTH - 3 loop -- max_length is total for packet -- see if we have a character left over from before if IS_CHAR_SAVED then CUR_CHAR := SAVED_CHAR; IS_CHAR_SAVED := FALSE; else -- get a new character from the file F_READ(CUR_CHAR, FILE_END); end if; exit when FILE_END; -- see if 8th bit is set and if we are doing 8 bit prefixing. -- If so, start temp_string with &, or whatever DEFAULT_QBIN is -- remove the 8th bit and process rest as if it were a regular char if BYTE'POS(CUR_CHAR) > 127 then if DO_8_BIT_PREFIXING then if TOTAL_CHARS + 3 > MAX_LENGTH - 3 then -- not enough room in packet for character plus & (and possible #) IS_CHAR_SAVED := TRUE; SAVED_CHAR := CUR_CHAR; -- save character for next packet exit OUTER; -- no point in continuing to read data else TDL := TDL + 1; TEMP_STRING(TDL) := DEFAULT_QBIN; -- start with CUR_CHAR := BYTE'VAL(BYTE'POS(CUR_CHAR) - 128); -- remove 8th bit end if; else -- check lower order bits, but don't need to prefix CUR_CHAR := BYTE'VAL(BYTE'POS(CUR_CHAR) - 128); -- remove 8th bit ADD_TO_CHAR := 128; --save to add back after checking is done end if; end if; -- see if 7 lower bits are a control character or DEL or quote char -- or if 8 bit prefixing and the & char if ((CUR_CHAR >= NUL and CUR_CHAR <= US) or CUR_CHAR = DEL or CUR_CHAR = DEFAULT_QCTL ) or (DO_8_BIT_PREFIXING and CUR_CHAR = DEFAULT_QBIN) then -- we have to add the control quote first if TOTAL_CHARS + 2 > MAX_LENGTH - 3 then -- note did check for +3 above -- not enough room in packet for char and its # IS_CHAR_SAVED := TRUE; SAVED_CHAR := BYTE'VAL(BYTE'POS(CUR_CHAR) + ADD_TO_CHAR); NOT_ENOUGH_ROOM := TRUE; else -- do have room for #char. controlify & store if CUR_CHAR = DEFAULT_QCTL then -- simply put ## in string CTLD_CHAR := DEFAULT_QCTL; elsif CUR_CHAR = DEFAULT_QBIN and DO_8_BIT_PREFIXING then -- simply put #& in string CTLD_CHAR := DEFAULT_QBIN; else CONTROLIFY(CUR_CHAR, CTLD_CHAR); end if; TDL := TDL + 1; TEMP_STRING(TDL) := DEFAULT_QCTL; -- put in control quote TDL := TDL + 1; -- put in the character (plus set 8th bit if necessary) TEMP_STRING(TDL) := BYTE'VAL(BYTE'POS(CTLD_CHAR) + ADD_TO_CHAR); end if; else -- regular character (non control) TDL := TDL + 1; -- put in the character (plus set 8th bit if necessary) TEMP_STRING(TDL) := BYTE'VAL(BYTE'POS(CUR_CHAR) + ADD_TO_CHAR); end if; exit OUTER when NOT_ENOUGH_ROOM; -- total_chars will never be >= max -- and don't want to save any temp_strings -- put the data byte plus any prefixes in the_data_string (which will -- go in the packet TOTAL_CHARS := TOTAL_CHARS + 1; THE_DATA_STRING(TOTAL_CHARS..TOTAL_CHARS+TDL-1) := TEMP_STRING(1..TDL); TOTAL_CHARS := TOTAL_CHARS + TDL - 1; TDL := 0; ADD_TO_CHAR := 0; -- reset in case next char isn't >127 (not 8 bit pre) exit when FILE_END; end loop OUTER; DATA_LEN := TOTAL_CHARS; DONE := FILE_END and not IS_CHAR_SAVED; -- if we're at the end of file, let caller know exception when others => raise FILE_TRANSFER_ERROR; end NEXT_DATA; procedure EXTRACT_DATA(THE_PACKET : in PACKET_TYPE) is -- take the characters we've read in and convert them to the original -- data by removing control quotes and controlifying if necessary. -- if 8 bit prefixing, check for binary prefix -- write the data to the file. CHAR_OUT : BYTE ; I : INTEGER := 0; ADD_TO_CHAR : INTEGER := 0; begin while I < BYTE'POS(THE_PACKET.LEN) - 3 loop -- get the data bytes I := I + 1; CHAR_OUT := THE_PACKET.DATA(I); -- get the candidate character to write -- see if we're doing 8 bit prefixing and have the qbin prefix if CHAR_OUT = QBIN_IN and DO_8_BIT_PREFIXING then ADD_TO_CHAR := 128; I := I + 1; CHAR_OUT := THE_PACKET.DATA(I); -- get next char end if; if CHAR_OUT = QCTL_IN then -- we see the control quote they use I := I + 1; -- get next character if THE_PACKET.DATA(I) = QCTL_IN then CHAR_OUT := QCTL_IN; -- it's the control quote, quoted. just write one elsif THE_PACKET.DATA(I) = QBIN_IN then CHAR_OUT := QBIN_IN; -- the 8thbit prefix, quoted. just write prefix elsif THE_PACKET.DATA(I) = BYTE'VAL(BYTE'POS(QCTL_IN) + 128) and NOT DO_8_BIT_PREFIXING then -- the 7 lower bits equal the control quote, but byte = 128 + quote CHAR_OUT := THE_PACKET.DATA(I); -- write byte else CONTROLIFY(THE_PACKET.DATA(I), CHAR_OUT); -- it was a control char end if; end if; -- add in the 8th bit if necessary and write out CHAR_OUT := BYTE'VAL(BYTE'POS(CHAR_OUT) + ADD_TO_CHAR); F_WRITE(CHAR_OUT); ADD_TO_CHAR := 0; -- in case 8th bit not set end loop; exception when others => raise FILE_TRANSFER_ERROR; end EXTRACT_DATA; 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) is -- construct a packet. Note at this point, the length and sequence are -- the actual byte values, they haven't been tochar'd for sending yet. -- they will be in put_packet begin THE_PACKET.LEN := BYTE'VAL(DATA_LEN + 3); -- DATA LEN + seq + type+check THE_PACKET.SEQ := BYTE'VAL(THE_SEQ); THE_PACKET.KTYPE := THE_TYPE; for I in 1 .. DATA_LEN loop THE_PACKET.DATA(I) := THE_DATA(I); end loop; -- the checksum is computed in PUT_PACKET exception when others => raise FILE_TRANSFER_ERROR; end CREATE_PACKET; procedure CHECK_SI_RESPONSE(THEIR_SI : in PACKET_TYPE; OK : out BOOLEAN) is -- examine the other kermit's S packet. See what parameters values it wants -- only examine up to the number of features we can handle THEIR_SI_LEN : INTEGER := BYTE'POS(THEIR_SI.LEN) - 3; NUM_FEATURES_CHECKED : INTEGER := 1; THEIR_SI_MAXL : BYTE; TEMP_OK : BOOLEAN := TRUE; begin if THEIR_SI_LEN > 0 then -- they have si features in their s_packet while NUM_FEATURES_CHECKED <= NUM_FEATURES loop -- compare their features up to the number we have (but not more) -- get their packet max length that they want us to send THEIR_SI_MAXL := UNCHAR(THEIR_SI.DATA(1)); -- turn into a byte number if BYTE'POS(THEIR_SI_MAXL) > MAX_LENGTH then null; -- we can't send bigger than max length so leave values alone elsif THEIR_SI.DATA(1) = SP then MAX_LENGTH := 80; -- space means use 80 else MAX_LENGTH := BYTE'POS(THEIR_SI_MAXL); -- use what they sent end if; NUM_FEATURES_CHECKED := NUM_FEATURES_CHECKED + 1; exit when not TEMP_OK or (NUM_FEATURES_CHECKED > THEIR_SI_LEN); -- their request for how long we wait for them before timing out if THEIR_SI.DATA(2) = SP or THEIR_SI.DATA(2) = DEFAULT_TIME then -- use the default from K_GLOBALS for our time to wait for them -- if we haven't sent init packet yet, let's ask them to wait 7 TIME := BYTE'VAL(CHARACTER'POS(''')); else -- let's see how long they want us to wait -- leave our time request at default (if we haven't sent init ) TIME_TO_WAIT := DURATION(BYTE'POS(UNCHAR(THEIR_SI.DATA(2)))); end if; NUM_FEATURES_CHECKED := NUM_FEATURES_CHECKED + 1; exit when NUM_FEATURES_CHECKED > THEIR_SI_LEN; -- let's check their request for number of padding chars (sp=0) if THEIR_SI.DATA(3) /= SP then NUM_PADC := BYTE'POS(UNCHAR(THEIR_SI.DATA(3))); -- integerize CONTROLIFY(THEIR_SI.DATA(4), PADC); -- get pad char to use end if; NUM_FEATURES_CHECKED := NUM_FEATURES_CHECKED + 2; exit when NUM_FEATURES_CHECKED > THEIR_SI_LEN; -- what line terminator do they want (sp = cr) if THEIR_SI.DATA(5) /= SP then THEIR_TERMINATOR := UNCHAR(THEIR_SI.DATA(5)); end if; NUM_FEATURES_CHECKED := NUM_FEATURES_CHECKED + 1; exit when NUM_FEATURES_CHECKED > THEIR_SI_LEN; -- what control quote will they be sending us & is it a legal one if (THEIR_SI.DATA(6) >= BYTE'VAL(33) and THEIR_SI.DATA(6) <= BYTE'VAL(63)) or (THEIR_SI.DATA(6) >= BYTE'VAL(96) and THEIR_SI.DATA(6) <= BYTE'VAL(126)) then QCTL_IN := THEIR_SI.DATA(6); elsif THEIR_SI.DATA(6) = SP then QCTL_IN := DEFAULT_QCTL; -- theirs is same as ours else TEMP_OK := FALSE; -- something's wrong end if; NUM_FEATURES_CHECKED := NUM_FEATURES_CHECKED + 1; exit when NUM_FEATURES_CHECKED > THEIR_SI_LEN; if THEIR_SI.DATA(7) = BYTE'VAL(CHARACTER'POS('Y')) then -- they can do 8 bit prefixing, but did not request it -- we will do it only if we need it (ie, qbin_request=&) -- if we ask for 8 bit prefixing, their prefix will be the default DO_8_BIT_PREFIXING := (QBIN_REQUEST = DEFAULT_QBIN); QBIN_IN := DEFAULT_QBIN; elsif THEIR_SI.DATA(7) = BYTE'VAL(CHARACTER'POS('N')) or THEIR_SI.DATA(7) = SP then -- they can't do 8 bit prefixing at all, so if we want to, too bad DO_8_BIT_PREFIXING := FALSE; elsif (THEIR_SI.DATA(7) >= BYTE'VAL(33) and THEIR_SI.DATA(7) <= BYTE'VAL(63)) or (THEIR_SI.DATA(7) >= BYTE'VAL(96) and THEIR_SI.DATA(7) <= BYTE'VAL(126)) then -- they have requested 8 bit prefixing, with a valid character if THEIR_SI.DATA(7) /= QCTL_IN then -- they did not specify the control quote by mistake--all is ok DO_8_BIT_PREFIXING := TRUE; TRANSFER_MODE := BINARY_TRANSFER; QBIN_IN := THEIR_SI.DATA(7); else -- they used the same character for both control & 8 bit quoting TEMP_OK := FALSE; end if; end if; NUM_FEATURES_CHECKED := NUM_FEATURES_CHECKED + 1; exit when not TEMP_OK and NUM_FEATURES_CHECKED > THEIR_SI_LEN; end loop; end if; if TRANSFER_MODE = BINARY_TRANSFER and DO_8_BIT_PREFIXING = FALSE and QBIN_REQUEST = DEFAULT_QBIN then -- we need to do a binary file transfer with 8 bit prefixing and -- they can't raise TRANSFER_MODE_ERROR; end if; OK := TEMP_OK; exception when others => raise FILE_TRANSFER_ERROR; end CHECK_SI_RESPONSE; procedure PRINT_ERROR_MSG(THE_PACKET : in PACKET_TYPE) is -- take the E packet message and write to the file if ascii transfer TEMP_LEN : INTEGER := BYTE'POS(THE_PACKET.LEN) - 3; begin if TRANSFER_MODE = ASCII_TRANSFER then for I in 1 .. TEMP_LEN loop F_WRITE(THE_PACKET.DATA(I)); end loop; end if; exception when others => raise FILE_TRANSFER_ERROR; end PRINT_ERROR_MSG; function CHECKSUM(TEMP_STRING : in BYTE_STRING) return BYTE is TEMP_SUM : INTEGER := 0; CHKSUM : INTEGER := 0; begin TEMP_SUM := BYTE'POS(LOW_BYTE_OF_SUM(TEMP_STRING)); -- integer sum of bytes -- use this checksum algorithm (from KERMIT A File Transfer Protocol) -- checksum = ((( sum_of_bytes & 192) >> 6) + sum_of_bytes) & 63 -- which equals the following: CHKSUM := (TEMP_SUM mod 256) / 64; CHKSUM := CHKSUM + TEMP_SUM; CHKSUM := CHKSUM mod 64; return BYTE'VAL(CHKSUM); -- turn result into byte form exception when others => raise FILE_TRANSFER_ERROR; end CHECKSUM; function CHECKSUM(THE_PACKET : in PACKET_TYPE) return BYTE is TEMP_LEN : INTEGER := BYTE'POS(THE_PACKET.LEN) - 32; -- .len is tochar'd TEMP_STRING : BYTE_STRING (1 .. TEMP_LEN); TEMP_SUM : INTEGER := 0; CHKSUM : INTEGER := 0; begin TEMP_STRING(1) := THE_PACKET.LEN; TEMP_STRING(2) := THE_PACKET.SEQ; TEMP_STRING(3) := THE_PACKET.KTYPE; for I in 1 .. TEMP_LEN - 3 loop TEMP_STRING(3+I) := THE_PACKET.DATA(I); end loop; TEMP_SUM := BYTE'POS(LOW_BYTE_OF_SUM(TEMP_STRING)); -- integer sum of bytes -- use this checksum algorithm (from KERMIT A File Transfer Protocol) -- checksum = ((( sum_of_bytes & 192) >> 6) + sum_of_bytes) & 63 -- which equals the following: CHKSUM := (TEMP_SUM mod 256) / 64; CHKSUM := CHKSUM + TEMP_SUM; CHKSUM := CHKSUM mod 64; return BYTE'VAL(CHKSUM); -- turn result into byte form exception when others => raise FILE_TRANSFER_ERROR; end CHECKSUM; procedure CONSTRUCT_SI_RETURN(THE_PACKET : out PACKET_TYPE) is -- build up our S packet TEMP_PACKET : PACKET_TYPE; DATA_STRING : BYTE_STRING (1..NUM_FEATURES) := (1..NUM_FEATURES => SP); begin -- send the other kermit what we want to see. Use defaults in k_constants -- the only difference may be the TIME. If they requested 5 seconds, -- we'll ask for 7 DATA_STRING(1) := DEFAULT_MAXL; DATA_STRING(2) := TIME; -- was tochar'd if necessary in check_si_response DATA_STRING(3) := DEFAULT_NPAD; DATA_STRING(4) := DEFAULT_PADC; DATA_STRING(5) := DEFAULT_EOL; DATA_STRING(6) := DEFAULT_QCTL; DATA_STRING(7) := QBIN_REQUEST; -- Y CREATE_PACKET(TEMP_PACKET, Y_PACKET, DATA_STRING, NUM_FEATURES, 0); THE_PACKET := TEMP_PACKET; exception when others => raise FILE_TRANSFER_ERROR; end CONSTRUCT_SI_RETURN; procedure SEND_PACKET(THE_PACKET : in PACKET_TYPE; CURRENT_SEQUENCE : in INTEGER; RESPONSE : out PACKET_TYPE) is -- note -- For SENDing, the current_sequence and THE_PACKET.SEQ will be equal. -- For RECEIVEing, they will probably be equal EXCEPT when we've received -- a duplicate packet and must retransmit our previous ACK. In this case, -- we've incremented CURRENT_SEQUENCE because we are done with one packet -- and are expecting the next; if we get a duplicate, something has -- happened to our ACK and we must retransmit it. But THE_PACKET to send -- has the previous sequence number now, not the current. TRIES : INTEGER := 0; MAX_TRIES : constant INTEGER := 10; NOT_TIMED_OUT : BOOLEAN := TRUE; GOT_ONE : BOOLEAN := FALSE; TEMP_PACKET : PACKET_TYPE; NEXT_SEQ : INTEGER := (BYTE'POS(THE_PACKET.SEQ) + 1) mod 64; -- the next -- is always in reference to the seq being sent PREV_SEQ : INTEGER; -- is in reference to the current sequence number begin if CURRENT_SEQUENCE = 0 then PREV_SEQ := 63; else PREV_SEQ := CURRENT_SEQUENCE - 1; end if; while TRIES < MAX_TRIES loop TRIES := TRIES + 1; PUT_PACKET(THE_PACKET); RECEIVE_RESPONSE(TEMP_PACKET); exit when -- exit if: ((TEMP_PACKET.KTYPE /= Q_PACKET -- not corrupted and TEMP_PACKET.KTYPE /= T_PACKET -- not timeout and TEMP_PACKET.KTYPE /= N_PACKET -- not NAK'd and TEMP_PACKET.SEQ /= BYTE'VAL(PREV_SEQ))-- not prev seq or or (TEMP_PACKET.KTYPE = N_PACKET and -- NAK for next seq TEMP_PACKET.SEQ = BYTE'VAL(NEXT_SEQ))); -- if here packet was either corrupted, nak'd, or a time out packet end loop; -- got a packet or reached max retries RESPONSE := TEMP_PACKET; if TRIES >= MAX_TRIES then raise TIMEOUT_ERROR; elsif TEMP_PACKET.KTYPE = N_PACKET and TEMP_PACKET.SEQ = BYTE'VAL(NEXT_SEQ) then RESPONSE.KTYPE := Y_PACKET; RESPONSE.SEQ := THE_PACKET.SEQ ; -- a nak for next is ack for current end if; exception when others => raise FILE_TRANSFER_ERROR; end SEND_PACKET; procedure RECEIVE_RESPONSE(THE_PACKET : out PACKET_TYPE) is -- get the packet they are sending us. Keep track of total time to get all -- the packet bytes. Timeout if it is too long. use CALENDAR; PACKET_PRESENT : BOOLEAN := FALSE; CHAR_IN : BYTE; IS_RECD : BOOLEAN; TEMP_PACKET : PACKET_TYPE; START_TIME : CALENDAR.TIME; NOW : CALENDAR.TIME; begin -- Get time before entering loop. Ask for a byte from the port. -- We want only an SOH, but we could get something else. If we get -- something else, we will ask for another byte until the time_to_wait -- limit is reached. If GET_BYTE times out READ_ERROR is raised. START_TIME := CLOCK; while not PACKET_PRESENT loop GET_BYTE(CHAR_IN, TIME_TO_WAIT); if CHAR_IN = SOH then PACKET_PRESENT := TRUE; exit; end if; NOW := CLOCK; exit when (NOW - START_TIME) > TIME_TO_WAIT; end loop; if not PACKET_PRESENT then -- return a timeout packet THE_PACKET.KTYPE := T_PACKET; else -- there appears to be a paket out there GET_PACKET(TEMP_PACKET); THE_PACKET := TEMP_PACKET; end if; exception when READ_ERROR => THE_PACKET.KTYPE := T_PACKET; when others => raise FILE_TRANSFER_ERROR; end RECEIVE_RESPONSE; end GENERAL_UTILITIES;