procedure check_init(var check_ok : boolean); (* check send init packet *) (* This procedure looks at the send init packet or the ack for one and matches the data to see if we can communicate. IT sets up what it can if I can live with what the other guy wants. I don't want to be picky if I can help it. If he doesn't tell me everything I make some assumptions that should allow communications. *) var packet_length : integer; begin (* we've got a packet we can work with *) if rec_packet_num = packet_num mod 64 then check_ok := true; packet_length := length(rec_packet); if packet_length >= 1 then begin if unchar(rec_packet[1]) in [4..94] then packet_size := unchar(rec_packet[1]) else check_ok := false; (* packets < 4 and > 94 make no sense *) end; if check_ok then (* let's find out what he wants *) begin if packet_length >= 3 then (* skip timeout, I can't *) my_pad_num := unchar(rec_packet[3]); (* number of pad chars *) if packet_length >= 4 then my_pad_char := ctl(rec_packet[4]); if packet_length >= 5 then send_eol := unchar(rec_packet[5]); if packet_length >= 6 then begin if rec_packet[6] = ' ' then his_ctl_quote := quote_char else his_ctl_quote := rec_packet[6]; end else his_ctl_quote := quote_char; if packet_length >= 7 then case rec_packet[7] of 'N' : if quoting then (* we're deadlocked *) check_ok := false; 'Y' : ; (* we don't care, quoting is all set up *) '!'..'>','`'..'~' : begin (* we'll use his quote char *) quoting := true; quote_8 := rec_packet[7]; end; else check_ok := false; (* he didn't send me a valid char *) end (* case *) else if quoting then check_ok := false; (* I'm trying to quote and he won't acknowledge it *) end; end; (* check_init *) procedure check_ack; (* check ack states for most packets *) begin ack_ok := false; (* we'll assume a bad packet and prove otherwise *) receive_packet; if packet_ok and (not abort) then begin case packet_type of ack_pack : if rec_packet_num = packet_num mod 64 then ack_ok := true; (* we better be exact on this one *) nak_pack : begin if rec_packet_num = 0 then rec_packet_num := 63 else rec_packet_num := rec_packet_num - 1; if rec_packet_num = (packet_num mod 64) then ack_ok := true; (* nak for next is ack for current *) end; error_pack : begin (* he must be upset at me *) gotoxy(1,9); write(rec_packet); abort := true; end; else ack_ok := false; (* if it's another type try to keep sending I don't know if this is right, but it sounds logical. *) end; (* case *) end else ack_ok := false; if debug then begin gotoxy(1,16); write('ack_ok: ', ack_ok,' packet_num: ',packet_num, ' rec_packet_num: ',rec_packet_num); end; if ack_ok = false then packets_bad := packets_bad + 1; end; procedure send_packet; (* This will send a packet that has been prepared by build packet, which does most of the work. *) var temp_char : char; begin (* send_packet *) update(packets_sent, packets_bad); (* update the display with new info *) if debug then begin gotoxy(1,17); write('Packet length: ', length(packet_buffer)); gotoxy(1,13); write('spack: '); for count := 1 to length(packet_buffer) do begin temp_char := packet_buffer[count]; (* make dummy var *) if ord(temp_char) > 127 then (* 8th bit set *) begin temp_char := chr(ord(temp_char) and $7f); (* strip 8th bit *) write(''''); (* show ' for 8th bit and fall through *) end; if temp_char < ' ' then write('^' + ctl(temp_char)) else write(temp_char); end; end; for count := 1 to length(packet_buffer) do send_char(ord(packet_buffer[count])); end; (* send_packet *) (*----------------------------------------------------------------*) procedure build_packet; (* This procedure tacks on the things we need for a packet such as parity, checksum, padding, and the ^A. *) var checksum, count, index, bit_count : integer; temp_pack : string[150]; begin (* build_packet *) checksum := 0; packet_buffer := ^A + char40(length(packet_buffer_data) + 2) + char40(packet_num mod 64) + packet_buffer_data; for count := 2 to length(packet_buffer) do begin checksum := checksum + ord(packet_buffer[count]); end; checksum := ((checksum + ((checksum and 192) div 64)) and 63); packet_buffer := packet_buffer + char40(checksum) + chr(send_eol); if my_pad_num > 0 then (* add in the padding requested *) for count := 1 to my_pad_num do packet_buffer := my_pad_char + packet_buffer; case parity_type_var of mark_parity : for count := 1 to length(packet_buffer) do packet_buffer[count] := chr(ord(packet_buffer[count]) or $80); space_parity : for count := 1 to length(packet_buffer) do packet_buffer[count] := chr(ord(packet_buffer[count]) and $7f); even_parity, odd_parity : begin for count := 1 to length(packet_buffer) do begin bit_count := 0; temp_pack := packet_buffer; for index := 1 to 7 do begin temp_pack[count] := chr(ord(temp_pack[count]) shr 1); if (ord(temp_pack[count]) and $01 = 1) then bit_count := bit_count + 1; end; if odd(bit_count) and (parity_type_var = even_parity) then packet_buffer[count] := chr(ord(packet_buffer[count]) or $80); if (not odd(bit_count)) and (parity_type_var = odd_parity) then packet_buffer[count] := chr(ord(packet_buffer[count]) or $80); end; end; end; (* case *) end; (* build_packet *) (*----------------------------------------------------------------*) procedure quit; (* return to CP/M. *) begin (* quit *) gotoxy(1,23); (* get cursor back below display *) halt; end; (* quit *) procedure finish; (* finish with server - bye, finish, logout, commands *) var try : integer; begin (* finish *) case line_command[1] of 'F','f' : packet_buffer_data := 'GF'; 'B','b','L','l' : packet_buffer_data := 'GL'; end; (* case *) packet_num := 0; try := 0; build_packet; repeat try := try + 1; send_packet; check_ack; until (abort) or (ack_ok) or (try > maxtry); if (try > maxtry) or abort then begin gotoxy(1,9); writeln('Unable to logout server.'); end else case line_command[1] of (* we only halt if 'bye' and we logged out *) 'B','b' : halt; end; (* case *) gotoxy(1,23); (* get cursor back below display *) end; (* finish *) (*----------------------------------------------------------------*) procedure send; (* send a file to remote host *) const eof_packet = 'Z'; break_packet = 'B'; var try : integer; send_done : boolean; procedure get_file_data; (* read in the file data *) var char_count : integer; temp : char; temp_data : string[120]; end_of_file : boolean; begin packet_buffer_data := 'D'; char_count := 1; end_of_file := false; while not (((filepointer > buffersize) and eof(outfile)) or (char_count >= (packet_size - 4)) or end_of_file) do begin if (filepointer > buffersize) then begin blockread(outfile, filebuffer, 1); filepointer := 1; buffer_num := buffer_num + 1; end; temp := filebuffer[filepointer]; filepointer := filepointer + 1; if (ord(temp) > $7f) and quoting then begin packet_buffer_data := packet_buffer_data + quote_8; (* add 8 bit quote char *) char_count := char_count + 1; temp := chr(ord(temp) and $7f); (* strip high bit *) end; (* and fall through *) if (ord(temp) and $7f) < ord(' ') then begin packet_buffer_data := packet_buffer_data + quote_char + ctl(temp); char_count := char_count + 2; end else begin if (ord(temp) and $7f) = ord(quote_char) then begin packet_buffer_data := packet_buffer_data + quote_char; char_count := char_count + 1; end; packet_buffer_data := packet_buffer_data + temp; char_count := char_count + 1; end; if (file_type_var = ascii) then if temp = ^Z then begin end_of_file := true; delete(packet_buffer_data,length(packet_buffer_data) - 1, 2); (* delete ^Z at end of packet *) end; end; (* while *) if (end_of_file or ((filepointer > buffersize) and eof(outfile))) then begin file_done := true; close(outfile); end else file_done := false; end; procedure sinit; (* do send init packet *) begin packet_num := 0; try := 0; if (parity_type_var <> no_parity) and (file_type_var = binary) then quote_8 := '&' (* let's try to quote chars with 8'th bit set *) (* We have to if we're to transmit binary *) else quote_8 := 'Y'; (* I'm willing to quote *) if repeating then repeat_char := '~' else repeat_char := ' '; packet_buffer_data := 'S' + char40(packet_size) + char40(timeout) + char40(npad) + ctl(pad) + char40(end_of_line) + quote_char + quote_8 + chk_type + repeat_char; build_packet; repeat ack_ok := false; (* assume its bad until proved otherwise *) packets_sent := packets_sent + 1; send_packet; receive_packet; if debug then begin gotoxy(1,22); write('got incoming packet'); end; if (packet_ok and (packet_type = ack_pack) and (not abort)) then check_init(ack_ok); try := try + 1; until ack_ok or abort or (try = maxtry); if ack_ok then state := send_file_header else abort := true; end; (* sinit *) procedure sheader; (* send file header *) begin packet_num := packet_num + 1; (* next packet *) packet_buffer_data := 'F' + arg1; build_packet; try := 0; repeat send_packet; check_ack; try := try + 1; until ack_ok or abort or (try = maxtry); if ack_ok then state := send_file else abort := true; end; (* sinit *) procedure sfile; (* send the file data *) begin gotoxy(40,2); write('Sending...'); repeat packet_num := packet_num + 1; get_file_data; if length(packet_buffer_data) > 1 then (* packet has data in it *) begin build_packet; try := 0; repeat send_packet; check_ack; try := try + 1; until ack_ok or abort or (try = maxtry); end; until file_done or abort or (try = maxtry); if file_done then state := send_eof else abort := true; end; procedure seof; (* send EOF packet *) begin packet_num := (packet_num + 1) mod 64; packet_buffer_data := eof_packet; build_packet; try := 0; repeat send_packet; check_ack; try := try + 1; until ack_ok or abort or (try = maxtry); if ack_ok then state := send_break else abort := true; end; procedure sbreak; begin state := send_break; packet_num := (packet_num + 1) mod 64; packet_buffer_data := break_packet; build_packet; try := 0; repeat send_packet; check_ack; try := try + 1; until ack_ok or abort or ( try = maxtry); if ack_ok then send_done := true else abort := true; end; (* sbreak *) begin (* send *) clrscr; packets_sent := 0; packets_bad := 0; send_done := false; displayt; open_file(read_open, arg1); if open_ok then begin filepointer := buffersize + 1; (* postion pointer beyond end of buffer so we get a record on entry *) state := send_init; repeat case state of send_init : sinit; send_file_header : sheader; send_file : sfile; send_eof : seof; send_break : sbreak; end; (* case *) until abort or send_done; if send_done then begin gotoxy(40,2); write('Completed. ', bell); end else begin gotoxy(40,2); write('Aborted ', bell); end; if abort and debug then begin gotoxy(1,18); writeln('Abort conditions were:'); writeln('State during abort was: ', state_str[state]); writeln('Quoting was: ',quoting); end; end; gotoxy(1,23); end; (* send *) (*----------------------------------------------------------------*) procedure send_ack; var q_var : char; begin (* send_ack *) if (state = receive_init) or (state = get_file) then begin if quoting then q_var := quote_8 else q_var := 'N'; packet_buffer_data := 'Y' + char40(packet_size) + char40(timeout) + char40(npad) + ctl(pad) + char40(end_of_line) + quote_char + q_var + chk_type; end else packet_buffer_data := 'Y'; build_packet; send_packet; end; (* send_ack *) (*----------------------------------------------------------------*) procedure send_nak; begin packet_buffer_data := 'N'; build_packet; send_packet; end;