$D AFS-} { indicates to compile to run without Adv. File Sys. unit sender; interface {Change log: 13 May 89, V1.1: Misc. cleanups to debug messages RTC 26 Apr 89, V1.1: minor cleanups RTC 16 Apr 89, V1.1: Fixed "garbage in buffer" bug RTC 13 Apr 89, V1.1: Added Version message RTC 14 Aug 88: Fixed timeout state bug RTC 07 Aug 88: Added conditional compilation for AFS/SFS difference RTC 31 Jul 88: Added Attributes Packets & cancel xfr request from receiver RTC 10 Jul 88: Converted to use screenops unit RTC 10 Jul 88: Fixed cleareol problem on filenames RTC 02 Jul 88: Fixed sinit 8th-bit prefix negotiation bug RTC 30 Jun 88: Added Binary and multiple file transfers RTC } procedure sendsw(var send_ok: boolean); procedure sen_version; implementation uses screenops, {RTC, 10 Jul 88} {$U kermglob.code} kermglob, {$U kermutil.code} kermutil, {$U kermpack.code} kermpack, {$B AFS+} {$U syslibr:attribute.code} attributes, {$E AFS+} {$U syslibr:wild.code} wild, {$U syslibr:dir.info.code} dirinfo; const my_version = ' Sender Unit V1.1, 13 May 89'; procedure sendsw{(var send_ok: boolean)}; var do_attr, still_sending, discard, next_is_empty : boolean; files_to_send : D_listp; io_status: integer; heap: ^integer; {$B AFS-} this_file : D_listp; {$E AFS-} procedure openfile; (* resets file of appropriate type *) var dummy : boolean; begin if debug then debugwrite(concat('Opening ',xfilename)); (*$I-*) (* turn off compiler i/o checking temporarily *) if f_is_binary then begin reset(b_file,xfilename); if io_result = 0 then {$B AFS+} dummy := get_attribute(b_file,FA_lastvalidbyte,last_blksize); {$E AFS+} {$B AFS-} last_blksize := 512; {default as we can't determine it} {$E AFS-} bufend := 0 {mark the buffer as empty!} end else reset(t_file,xfilename); (*$I+*) (* turn compiler i/o checking back on *) io_status := io_result; {$B AFS-} this_file := files_to_send; {$E AFS-} end; (* openfile *) function sinit: char; (* send init packet & receive other side's *) var num, len, i: integer; (* packet number and length *) ch: char; begin if debug then debugwrite('sinit'); if numtry > maxtry then begin sinit := 'a'; exit(sinit) end; num_try := num_try + 1; spar(packet); clear_buf(inport); refresh_screen(numtry,n); spack('S',n mod 64,10,packet); ch := rpack(len,num,recpkt); if (ch = 'N') then begin sinit := 's'; exit(sinit) end (* if 'N' *) else if (ch = 'Y') then begin if ((n mod 64) <> num) then (* not the right ack *) begin sinit := currstate; exit(sinit) end; rpar(recpkt,len); if (xeol = chr(0)) then (* if they didn't spec eol *) xeol := chr(my_eol); (* use mine *) if (quote = chr(0)) then (* if they didn't spec quote *) quote := my_quote; (* use mine *) ctl_set := [chr(0)..chr(31),chr(del),quote]; if en_qbin then ctl_set := ctl_set + [qbin]; numtry := 0; n := n + 1; (* increase packet number *) sinit := 'f'; exit(sinit) end (* else if 'Y' *) else if (ch = 'E') then begin error(recpkt,len); sinit := 'a' end (* if 'E' *) else if (ch = chr(0)) then sinit := currstate else if (ch <> 'N') then sinit := 'a' end; (* sinit *) function sattr: char; (* send attributes packet *) var num, len: integer; ch: char; got_attr : boolean; {$B AFS+} file_date : FA_chron; {$E AFS+} packet : packettype; begin if debug then debugwrite('sattr'); if numtry > maxtry then begin sattr := 'a'; exit(sattr) end; num_try := num_try + 1; refresh_screen(numtry,n); packet[0] := '#'; { creation date attribute } {$B AFS+} packet[1] := tochar(chr(12)); { length } if f_is_binary then got_attr := get_attribute(b_file,FA_revision_date,file_date) else got_attr := get_attribute(t_file,FA_revision_date,file_date); with file_date,date,time do {$E AFS+} {$B AFS-} packet[1] := tochar(chr(6)); { length } with this_file^.D_date do {$E AFS-} begin packet[2] := chr(year div 10 + ord('0')); packet[3] := chr(year mod 10 + ord('0')); packet[4] := chr(month div 10 + ord('0')); packet[5] := chr(month mod 10 + ord('0')); packet[6] := chr(day div 10 + ord('0')); packet[7] := chr(day mod 10 + ord('0')); {$B AFS+} packet[8] := ' '; packet[9] := chr(hour div 10 + ord('0')); packet[10] := chr(hour mod 10 + ord('0')); packet[11] := ':'; packet[12] := chr(min div 10 + ord('0')); packet[13] := chr(min mod 10 + ord('0')) {$E AFS+} end; spack('A',n mod 64,{$B AFS+}14{$E AFS+} {$B AFS-}8{$E AFS-},packet); ch := rpack(len,num,recpkt); if (ch = 'N') then begin sattr := 'd'; exit(sattr) end (* if 'N' *) else if (ch = 'Y') then begin if ((n mod 64) <> num) then (* not the right ack *) begin sattr := currstate; exit(sattr) end; numtry := 0; n := n + 1; (* increase packet number *) do_attr := false; discard := (len > 0) and (recpkt[0] = 'N'); if discard then sattr := 'z' else sattr := 'd'; exit(sattr) end (* else if 'Y' *) else if (ch = 'E') then begin error(recpkt,len); sattr := 'a' end (* if 'E' *) else if (ch = chr(0)) then sattr := currstate else if (ch <> 'N') then sattr := 'a' end; (* sattr *) function sdata: char; (* send file data *) var num, len: integer; ch: char; packarray: array[boolean] of packettype; sizearray: array[boolean] of integer; current: boolean; b: boolean; function other(b: boolean): boolean; (* complements a boolean which is used as array index *) begin if b then other := false else other := true end; (* other *) begin discard := false; current := true; packarray[current] := packet; sizearray[current] := size; next_is_empty := true; while (currstate = 'd') do begin if (numtry > maxtry) then (* if too many tries, give up *) currstate := 'a'; b := other(current); numtry := numtry + 1; (* send a data packet *) spack('D',n mod 64,sizearray[current],packarray[current]); refresh_screen(numtry,n); if next_is_empty then (* set up next packet *) begin sizearray[b] := bufill(packarray[b]); next_is_empty := false end; ch := rpack(len,num,recpkt); (* receive a packet *) if ch = 'N' then (* NAK, so just stay in this state *) if ((n+1) mod 64 <> num) then (* unless NAK for next packet, which *) sdata := currstate else (* is just like ACK for this packet *) begin if num > 0 then num := (num - 1) (* in which case, decrement num *) else num := 63; ch := 'Y'; (* and indicate an ACK *) end; (* else *) if (ch = 'Y') then begin if ((n mod 64) <> num) then (* if wrong ACK *) (* stay in same state *) else begin numtry := 0; n := n + 1; current := b; next_is_empty := true; discard := sizearray[current] = at_badblk; if read_ch(keyport, ch) then {check for user canceling send} begin if ord(ch) in [can_cur,can_all] then discard := true; if ord(ch) = can_all then files_to_send := nil end; if len = 1 then {check for receiver canceling send} begin if recpkt[0] in ['X','Z'] then discard := true; if recpkt[0] = 'Z' then files_to_send := nil end; if (sizearray[current] = at_eof) or discard then currstate := 'z' (* set state to eof *) else currstate := 'd' (* else stay in data state *) end {else} end (* if *) else if (ch = 'E') then begin error(recpkt,len); currstate := 'a' end (* if 'E' *) else if (ch = chr(0)) then (* receive failure, so stay in d *) else if (ch <> 'N') then currstate := 'a' (* on anything else goto abort state *) end; (* while *) size := sizearray[current]; packet := packarray[current]; sdata := currstate end; (* sdata *) function sfile: char; (* send file header *) var num, len, i: integer; ch: char; fn: packettype; oldfn: string255; procedure legalize(var fn: string255); (* make sure we send only 1 '.' in filename *) var count, i, j, l: integer; begin if not lit_names then begin count := 0; l := length(fn); for i := 1 to l do (* count '.'s in fn *) if fn[i] = '.' then count := count + 1; for i := 1 to count-1 do (* remove all but 1 *) begin j := 1; while (j < l) and (fn[j] <> '.') do j := j + 1; (* by finding it *) fn := concat(copy(fn,1,j-1),copy(fn,j+1,l-j)); (* and copying around it *) l := l - 1 end (* for i *) end; i := pos(':',fn); if i <> 0 then fn := copy(fn,i+1,length(fn)-i) {remove Vol. name} end; (* legalize *) begin if debug then debugwrite('sfile'); if (numtry > maxtry) then (* if too many tries, give up *) begin sfile := 'a'; exit(sfile) end; numtry := numtry + 1; oldfn := xfilename; legalize(xfilename); (* make filename acceptable to remote *) len := length(xfilename); moveleft(xfilename[1],fn[0],len); (* move filename into a packettype *) SC_erase_to_EOL(filepos,fileline); write(oldfn,' ==> ',xfilename); refresh_screen(numtry,n); spack('F',n mod 64,len,fn); (* send file header packet *) if next_is_empty then begin size := bufill(packet); (* get first data from file *) next_is_empty := false end; (* while waiting for response *) ch := rpack(len,num,recpkt); if ch = 'N' then (* NAK, so just stay in this state *) if ((n+1) mod 64 <> num) then (* unless NAK for next packet, which *) begin sfile := 'f'; exit(sfile) (* is just like ACK for this packet *) end else begin if (num > 0) then num := (num - 1) (* in which case, decrement num *) else num := 63; ch := 'Y'; (* and indicate an ACK *) end; (* else *) if (ch = 'Y') then begin if ((n mod 64) <> num) then (* if wrong ACK, stay in F state *) begin sfile := 'f'; exit(sfile) end; numtry := 0; n := n + 1; do_attr := en_attr; sfile := 'd'; end (* if *) else if (ch = 'E') then begin error(recpkt,len); sfile := 'a' end (* if 'E' *) else if (ch = chr(0)) then {stay in f state} sfile := 'f' else if (ch <> 'N') then (* don't recognize it *) sfile := 'a' end; (* sfile *) function seof: char; (* send end of file *) var num, len: integer; ch: char; begin if debug then debugwrite('seof'); if (numtry > maxtry) then (* if too many tries, give up *) begin seof := 'a'; exit(seof) end; numtry := numtry + 1; refresh_screen(numtry,n); packet[0] := 'D'; {set up in case of discard} spack('Z',(n mod 64),ord(discard),packet); (* send end of file packet *) if debug then debugwrite('seof1'); ch := rpack(len,num,recpkt); if ch = 'N' then (* NAK, so just stay in this state *) if ((n+1) mod 64 <> num) then (* unless NAK for next packet, which *) begin seof := 'z'; exit(seof) (* is just like ACK for this packet *) end else begin if num > 0 then num := (num - 1) (* in which case, decrement num *) else num := 63; ch := 'Y'; (* and indicate an ACK *) end; (* else *) if (ch = 'Y') then begin if debug then debugwrite('seof2'); if ((n mod 64) <> num) then (* if wrong ACK, stay in Z state *) begin seof := 'z'; exit(seof) end; numtry := 0; n := n + 1; if debug then debugwrite(concat('Closing ',xfilename)); if f_is_binary then close(b_file) else close(t_file); while files_to_send <> nil do with files_to_send^ do begin xfilename := concat(D_volume,':',D_title); seof := 'f'; next_is_empty := true; openfile; files_to_send := D_next_entry; if io_status <> 0 then io_error(io_status) else exit(seof) end {while}; seof := 'b' end (* if *) else if (ch = 'E') then begin error(recpkt,len); seof := 'a' end (* if 'E' *) else if (ch = chr(0)) then (* receive failed, so stay in z state *) seof := 'z' else if (ch <> 'N') then (* other error, just abort *) seof := 'a' end; (* seof *) function sbreak: char; var num, len: integer; ch: char; (* send break (end of transmission) *) begin if debug then debugwrite('sbreak'); if (numtry > maxtry) then (* if too many tries, give up *) begin sbreak := 'a'; exit(sbreak) end; numtry := numtry + 1; refresh_screen(numtry,n); spack('B',(n mod 64),0,packet); (* send Break Transfer packet *) ch := rpack(len,num,recpkt); if ch = 'N' then (* NAK, so just stay in this state *) if ((n+1) mod 64 <> num) then (* unless NAK for next packet, which *) begin sbreak := 'b'; exit(sbreak) (* is just like ACK for this packet *) end else begin if num > 0 then num := (num - 1) (* in which case, decrement num *) else num := 63; ch := 'Y'; (* and indicate an ACK *) end; (* else *) if (ch = 'Y') then begin if ((n mod 64) <> num) then (* if wrong ACK, stay in B state *) begin sbreak := 'b'; exit(sbreak) end; numtry := 0; n := n + 1; sbreak := 'c' (* else, switch state to complete *) end (* if *) else if (ch = 'E') then begin error(recpkt,len); sbreak := 'a' end (* if 'E' *) else if (ch = chr(0)) then (* receive failed, so stay in b state *) sbreak := 'b' else if (ch <> 'N') then (* other error, just abort *) sbreak := 'a' end; (* sbreak *) (* state table switcher for sending *) begin (* sendsw *) mark(heap); send_ok := false; still_sending := D_dirlist(xfilename,[D_code..D_svol],files_to_send,false) = D_okay; if files_to_send <> nil then with files_to_send^ do begin xfilename := concat(D_volume,':',D_title); next_is_empty := true; openfile; files_to_send := D_next_entry; if io_status <> 0 then begin io_error(io_status); still_sending := false end end; if still_sending then write_screen('Sending'); currstate := 's'; n := 0; (* set packet # *) numtry := 0; flush_comm; {flush any garbage in buffer} while still_sending do if currstate in ['d', 'f', 'z', 's', 'b', 'c', 'a'] then case currstate of 'd': if do_attr then currstate := sattr else currstate := sdata; 'f': currstate := sfile; 'z': currstate := seof; 's': currstate := sinit; 'b': currstate := sbreak; 'c': begin send_ok := true; still_sending := false end; (* case c *) 'a': still_sending := false end (* case *) else (* state not in legal states *) begin debugwrite('Unknown State'); still_sending := false end (* else *); release(heap) end; (* sendsw *) procedure sen_version; begin writeln(my_version) end {sen_version}; end. { sender }