$Debug off$ $UCSD ON$ $SYSPROG$ $SEARCH '*INTERFACE.', '*IO.', 'KRMIO', 'KRMCMD', 'KRMWNDW', 'KRMRPT'$ $PAGE$ { Module KRMGUTS contains the heart of Kermit - the procedures, variables, etc., that actually implement the Kermit protocol. } module krmguts; import ascii_defs, byte_str, byte_io, krmrpt, terminal, iodeclarations, general_1, general_3; export const MAXFILES = 10; { maximum number of files that can be sent } type filename_list = array[1..MAXFILES] of filename; var RunType : Transfer_type; { type of transfer currently in effect } { operational parameters } Local : boolean; { local/remote flag } OneWayOnly : boolean; { used for testing } Verbosity: boolean; { true to print verbose messages } Debug : boolean; { true to print really verbose debugging msgs } PROCEDURE KermitInit; { initialize various parameters & defaults } PROCEDURE SYSInit; PROCEDURE ParmInit; { Command entry points } procedure RecvSwitch( files : filename_list ); { Receive file group entry point } procedure SendSwitch( files : filename_list ); { Send file group entry point } procedure TN; { invokes terminal emulator } implement CONST {-%- System Dependent -%-} DEFPARMFILE = 'KERMIT.PRM'; TEMPFILE = 'TEMP.K'; ConsoleAbort = chr(CTRLC); { character to abort packet } { receive operation } { Default transmission parameter definitions. These are assigned to } { the transmission parameter variables by ParmInit when Kermit is } { first started. } DEFTRY = 10; { default for number of retries } DEFTIMEOUT = 12; { default time out } MAXPACK = 94; { max is 94 ~ - ' ' } DEFDELAY = 5; { delay before sending first init for send } NUMPARAM = 6; { number of parameters in init packet } DEFMARK = SOH; { packet start mark } DEFQUOTE = SHARP; { default quote character } DEFPAD = 0; { default number of padding chars } DEFPADCHAR = 0; { default padding character } DEFEOL = CR; { default end of line sequence } DEFEOLTYPE = 2; { 1 = LineFeed 2 = CrLf 3 = Just Cr } NUMBUFFERS = 5; { Number of buffers } { packet types } TYPEB = 66; { ord('B') break packet } TYPEC = 67; { ord('C') Host command packet } TYPED = 68; { ord('D') data packet } TYPEE = 69; { ord('E') error packet } TYPEF = 70; { ord('F') file header packet } TYPEG = 71; { ord('G') generic kermit command packet } TYPEN = 78; { ord('N') NAK packet } TYPER = 82; { ord('R') Receive init packet } TYPES = 83; { ord('S') send init packet } TYPET = 84; { ord('T') ? } TYPEX = 88; { ord('X') Text packet } TYPEY = 89; { ord('Y') ACK packet } TYPEZ = 90; { ord('Z') EOF packet } $PAGE$ TYPE { Data Types for Kermit } Packet = RECORD mark : byte; { SOH character } count: byte; { # of bytes following this field } seq : byte; { sequence number modulo 64 } ptype: byte; { d,y,n,s,b,f,z,e,t packet type } data : ByteString; { the actual data } { chksum is last valid char in data array } { eol is added, not considered part of packet proper } END; EOLtype = (LineFeed,CrLf,JustCr); Ppack = 1..NUMBUFFERS; CType = RECORD check : integer; PacketPtr : integer; i : integer; fld : integer; t : byte; finished : boolean; restart : boolean; control : boolean; good : boolean; END; $PAGE$ VAR keyboard : text; { non-echoing standard input file } ior : integer; { error recovery routine saves ioresult } { here } breakchar : byte; { break character for TN mode } ch : char; { scratch character } report : string[120]; { status report string } rpos : integer; { status report string position } { Variables for Kermit } send_file_list : filename_list; { list of filenames to be sent } send_file_next : 1..MAXFILES+1; { index of next filename to be sent } ParmFile : filename; { parameter file name } DiskFile : filedesc; { file being sent or received } EOLforFile : EOLtype; { EOL sequence to use for local files } State : kermitstates; { current state of the automaton } SaveState : kermitstates; { holds old state for retries } n,J : integer; { packet sequence number } MaxTry : integer; { maximum number of retries allowed } NumTry : integer; { times this packet retried } OldTry : integer; { times last packet retried } { packet transmission parameters } LocalMark : integer; { packet start mark } RemoteMark : integer; LocalPad : integer; { number of padding characters I need } RemotePad : integer; { number of padding chars to send } LocalPadChar : byte; { padding character I need } RemotePadChar : byte; { padding character to use } LocalTimeOut : integer; { our timeout interval in seconds } RemoteTimeOut : integer; { their timeout interval in seconds } LocalDelay : integer; { delay before sending first init } LocalEOL,LocalQuote : byte; { parms. for us } RemoteEOL, RemoteQuote : byte; { parms. the remote wants } SizeRecv, SizeSend : integer; { buffer sizes for receive and send } { statistics variables } stats : kermit_statistics; { Packet buffers. These are used to hold packets being built as } { received, or assembled for transmission. } Buf : ARRAY [1..NUMBUFFERS] OF packet; ThisPacket : Ppack; { current packet being sent } LastPacket : Ppack; { last packet sent } CurrentPacket : Ppack; { current packet received } NextPacket : Ppack; { next packet being received } DebugPacket : Ppack; { save input to do debug } TOPacket : packet; { Time_Out Packet } TimeLeft : integer; { until Time_Out } PackControl : CType; { variables for receive packet routine } $PAGE$ PROCEDURE Verbose ( c : cstring ); { Print writeln if verbosity Called by Field1 Field2 Field3 Field5 SendFile SendEOF SendBreak SendOurInit GetTheirInit ReceiveData } BEGIN IF Verbosity THEN begin setstrlen(report,0); strwrite(report, 1,rpos, c); report_log( report ); end; END; { procedure verbosity } $PAGE$ PROCEDURE PutErr( c : cstring ); { Print error messages. } BEGIN IF Local THEN begin setstrlen(report,0); strwrite(report,1,rpos,c); report_status(report); report_log(report); end; END; { procedure PutErr } $PAGE$ PROCEDURE OverHead ( p , f : integer; VAR o : integer ); { Calculate OverHead as % OverHead := (p-f)*100/f Called by DisplayStatistics } BEGIN IF f <> 0 then o := trunc((p-f)*100/f) else o := 0; END; $PAGE$ PROCEDURE CalRat ( f : integer; t : integer; VAR r : integer ); { Calculate Effective Baud Rate Rate = f*10/t Called by DisplayStatistics } BEGIN r := 0; END; $PAGE$ PROCEDURE Sleep ( t : integer); { pause for t seconds } { Called by SendSwitch } BEGIN END; $PAGE$ PROCEDURE StartTimer; { Called by ReceivePacket } BEGIN TimeLeft := RemoteTimeOut; END; $PAGE$ PROCEDURE StopTimer; { Called by ReceivePacket } BEGIN TimeLeft := MaxInt; END; $PAGE$ FUNCTION MakeChar ( c : byte ) : byte; { Convert integer to printable character. } BEGIN MakeChar := c+BLANK; END; $PAGE$ FUNCTION UnChar ( c : byte ) : byte; { Reverse of MakeChar } BEGIN UnChar := c-BLANK END; $PAGE$ FUNCTION Ctl ( c : byte ) : byte; { Does c XOR 100. } BEGIN IF IsControl(c) THEN c := c+64 ELSE c := c-64; Ctl := c; END; $PAGE$ FUNCTION IsValidPType ( c : byte ) : boolean; { True if c is a valid packet type. Called by Field3 } BEGIN IsValidPType := c in [TYPEB, TYPEC, TYPED, TYPEE, TYPEF, TYPEG, TYPEN, TYPER, TYPES, TYPET, TYPEX, TYPEY, TYPEZ] END; $PAGE$ FUNCTION CheckFunction ( c : integer ) : byte; { Calculate checksum Called by SendPacket Field5 } VAR x: integer; BEGIN { CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; } x := (c MOD 256 ) DIV 64; x := x+c; CheckFunction := x MOD 64; END; $PAGE$ PROCEDURE EnCodeParm ( VAR data : ByteString ); { encode parameters } { Encodes the global parameter variables and places them into the given parameter ByteString. References : SizeRecv LocalTimeOut LocalPad LocalPadChar LocalEOL LocalQuote Called by SendOurInit GetTheirInit DoInitLast } VAR i: integer; BEGIN FOR i:=1 TO NUMPARAM DO data[i] := BLANK; data[NUMPARAM+1] := ENDSTR; data[1] := MakeChar(SizeRecv); { my biggest packet } data[2] := MakeChar(LocalTimeOut); { when I want timeout} data[3] := MakeChar(LocalPad); { how much padding } data[4] := Ctl(LocalPadChar); { my padding character } data[5] := MakeChar(LocalEOL); { my EOL } data[6] := LocalQuote; { my quote char } END; $PAGE$ PROCEDURE DeCodeParm ( VAR data : ByteString ); { decode parameters } { Accepts a parameter string, decodes the values, and places them in the global parameter variables. Modifies : SizeSend RemoteTimeOut RemotePad RemotePadChar RemoteEOL RemoteQuote Called by GetTheirInit } BEGIN SizeSend := UnChar(data[1]); RemoteTimeOut := UnChar(data[2]); { when I should time out } RemotePad := UnChar(data[3]); { padding characters to send } RemotePadChar := Ctl(data[4]); { padding character } RemoteEOL := UnChar(data[5]); { EOL to send } RemoteQuote := data[6]; { quote to send } END; $PAGE$ PROCEDURE ReadParm ( VAR Parms : ByteString ; ParmFile : filename ); { Opens the parameter file, if any, and reads a single line from it into the parameter Parms. If no parameter file exists, returns a null string (i.e., just ENDSTR in the first position). Inputs : ParmFile filename of parameter file Calls Exists Sopen GetLine Called by GetParm } VAR dummy : boolean; fd : filedesc; BEGIN; Parms[1]:=ENDSTR; IF Exists(ParmFile) THEN BEGIN fd := Sopen(ParmFile,IOREAD); dummy := GetLine(Parms,fd,MAXSTR); Sclose(fd); END; END; $PAGE$ PROCEDURE GetParm( ParmFile : filename ); { get parameters from file } { Reads a line from the parameter file via ReadParm and sets the global parameter variables according to the values in the file. Inputs : ParmFile filename of parameter file Modifies SizeRecv LocalTimeOut LocalPad LocalPadChar LocalEOL LocalQuote Calls ReadParm Called by ParmInit SetParameters } VAR data : ByteString; BEGIN; ReadParm(data, ParmFile); IF (length(data) > 0) THEN { get parameters } BEGIN SizeRecv := UnChar(data[1]); LocalTimeOut := UnChar(data[2]); { when I should time out } LocalPad := UnChar(data[3]); { padding characters to send } LocalPadChar := Ctl(data[4]); { padding character } LocalEOL := UnChar(data[5]); { EOL to send } LocalQuote := data[6]; { quote to send } END; END; $PAGE$ PROCEDURE ParmInit; { Initializes transmission parameters (pad character, timeout, etc.) to their default values as defined by the default parameter constants, then reads any new values from the parameter file. Parameter file values thus override the initial 'hardwired' defaults. Calls GetParm Called by Main Program } BEGIN breakchar:=CTRLY; { Set the initial default values } RemotePad := DEFPAD; LocalPad := DEFPAD; RemotePadChar := DEFPADCHAR; LocalPadChar := DEFPADCHAR; LocalMark := DEFMARK; RemoteTimeOut := DEFTIMEOUT; LocalTimeOut := DEFTIMEOUT; LocalDelay := DEFDELAY; SizeRecv := MAXPACK; SizeSend := MAXPACK; RemoteEOL := DEFEOL; LocalEOL := DEFEOL; RemoteQuote := DEFQUOTE; LocalQuote := DEFQUOTE; MaxTry := DEFTRY; CASE DEFEOLTYPE OF 1: EOLforFile := LineFeed; 2: EOLforFile := CrLf; 3: EOLforFile := JustCR; END { case }; { Now read the new defaults from the parameter file } ParmFile := DEFPARMFILE; GetParm( ParmFile ); Local := true; { default to remote } END; $PAGE$ {-%- System Dependent -%-} PROCEDURE SYSInit; { Performs system dependent initialization, for example setting the mode of the console terminal. Called once by the main program when Kermit is started. Called by Main Program } begin { procedure SYSInit } ioinitialize; initio; { initialize the byte I/O module } init_data_comm; end; { procedure SYSInit } $PAGE$ {-%- System Dependent -%-} PROCEDURE SYSFinish; { Performs any system dependent cleanup operations, for example resetting the mode of the console terminal to normal. Called once by main program just before Kermit exits. Called by Main Program } BEGIN iouninitialize; END; $PAGE$ {-%- Sytem Dependent -%-} PROCEDURE SYSArguments; { Processes system dependent command arguments. Called by main program when a 'do system function' command is processed. } BEGIN END; $PAGE$ PROCEDURE StartRun; { initialization as necessary } { Modifies stats.RunTime Calls SerialFlush Called by SendSwitch RecvSwitch } BEGIN SerialFlush; stats.RunTime := 0; END; $PAGE$ { Function DoBreakchar is the break character action routine passed to the procedure emulator when in TN mode. The break character command (i.e., the character typed immediately after the break character) is passed as the argument. If it returns true, the emulator will exit back to its caller. } function DoBreakchar ( c : char ) : boolean; begin DoBreakchar := false; case c of 'c','C': DoBreakchar := true; otherwise begin writeln('Break character commands:'); writeln(' C Break connection'); writeln(' ? This message'); end; end; { case } end; { procedure DoBreakchar } PROCEDURE TN; { This procedure implements the 'terminal emulator' to connect to the host. Calls Called by Main program } BEGIN { procedure TN } write(#12); writeln('Connecting to host'); emulator( chr(CTRLY), DoBreakchar ); write(#12); END; { procedure TN } $PAGE$ PROCEDURE SetParameters( arg : filename ); { Sets new parameter file name, loads new parameters via GetParm. Implicit inputs : Arg filename of file from which to read new parameters Calls GetParm Called by Main Program (invoked by load new parameters command) } var fnm : filename; BEGIN IF (strlen(Arg) > 2) THEN BEGIN ParmFile := arg; { get the new parameter file } { name from the command line } { into ParmFile } GetParm( ParmFile ); { read new parameters } END; END; $PAGE$ PROCEDURE KermitInit; { initialize various parameters & defaults } { Initializes the KERMIT protocol machine and sets the option variables to default values. Calls Called by Main program } BEGIN n := 0; stats.NumSendPacks := 0; stats.NumRecvPacks := 0; stats.NumACKsent := 0; stats.NumNAKsent := 0; stats.NumACKrecv := 0; stats.NumNAKrecv := 0; stats.NumBADrecv := 0; stats.ChInPack := 0; stats.ChInFile := 0; RunType := invalid; DiskFile := IOERROR; { to indicate not open yet } ThisPacket := 1; LastPacket := 2; CurrentPacket := 3; NextPacket := 4; DebugPacket := 5; WITH TOPacket DO BEGIN count := 3; seq := 0; ptype := TYPEN; data[1] := ENDSTR; END; { with } END; { procedure KermitInit } $PAGE$ procedure FinishUp; { do End of Program clean up } { Called by ErrorPack BuildPacket ReceivePacket Main program } begin Sclose(DiskFile); SYSFinish; { do System dependent } end; { procedure FinishUp } $PAGE$ PROCEDURE DisplayStatistics; { Calls OverHead CalRat Called by ErrorPack BuildPacket ReceivePacket } BEGIN IF ((RunType <> Invalid) AND Local ) THEN with stats do BEGIN OverHead(ChInPack,ChInFile,packet_overhead); CalRat(ChInFile,RunTime,effrate); report_packet_statistics( stats, runtype ); END; { with } END; { procedure DisplayStatistics } $PAGE$ PROCEDURE DisplayPacket ( mes : cstring; VAR p : Ppack ); { where mes = string to be printed preceding packet contents p = index into buf of packet to be displayed Print Debugging Info. Prints the given message on the standard error device, followed by the contents of the given packet as follows: Called by ReSendPacket SendPacket BuildPacket } BEGIN WITH Buf[p] DO BEGIN setstrlen(report,0); strwrite(report,1,rpos, mes, UnChar(count):3, UnChar(seq):3, chr(ptype):3); report_log( report ); BtoS(data, report); report_log( report ); END; { with } END; { procedure DisplayPacket } $PAGE$ PROCEDURE PutOut ( p : Ppack ); { Output Packet } { where p = index into buf of packet to be sent Outputs the given packet, preceded by RemotePad padding characters, to the serial line. Calls Putcf PutCon PutStr Called by ReSendPacket SendPacket } VAR i : integer; BEGIN IF (RemotePad > 0) THEN FOR i := 1 TO RemotePad DO Putcf(RemotePadChar,LineOut); WITH Buf[p] DO BEGIN report_send_packet(UnChar(seq)); { report which packet we're sending } Putcf(mark,LineOut); Putcf(count,LineOut); Putcf(seq,LineOut); Putcf(ptype,LineOut); PutStr(data,LineOut); END; { with } END; { procedure PutOut } $PAGE$ PROCEDURE ReSendPacket; { Re-sends previous packet, which had been renamed to Buf[LastPacket] by SendPacket just after that routine had sent it. Modifies stats.ChInPack stats.NumSendPacks Calls PutOut Called by SendPacket } BEGIN stats.NumSendPacks := stats.NumSendPacks+1; stats.ChInPack := stats.ChInPack + RemotePad + UnChar(Buf[LastPacket].count) + 3; IF Debug THEN DisplayPacket('Re-Sending ... ',LastPacket); PutOut(LastPacket); END; $PAGE$ PROCEDURE SendPacket; { sends ThisPacket; leaves it in LastPacket } { Accepts "raw" packet in Buf[ThisPacket]. Encodes count (which is initially the length of the data field), sequence number, and calculates the checksum. After packet is sent, exchanges ThisPacket and LastPacket by swapping pointers, so that ReSendPacket can send it again if necessary. Modifies stats.ChInPack Calls PutOut ReSendPacket CheckFunction DisplayPacket Called by SendACK SendNAK ErrorPack SendFile SendData SendEOF SendBreak SendOurInit GetTheirInit DoInitLast } VAR i,len,chksum : integer; temp : Ppack; BEGIN IF (NumTry <> 1) AND (RunType = Transmit ) THEN ReSendPacket ELSE BEGIN { send fresh packet } WITH Buf[ThisPacket] DO BEGIN mark := LocalMark; { mark } len := count; { save length } count := MakeChar(len+3); { count = 3+length of data } seq := MakeChar(seq); { seq number } chksum := count + seq + ptype; IF ( len > 0) { is there data ? } THEN FOR i:= 1 TO len DO chksum := chksum + data[i]; { loop for data } chksum := CheckFunction(chksum); { calculate checksum } data[len+1] := MakeChar(chksum); { make printable & output } data[len+2] := RemoteEOL; { EOL } data[len+3] := ENDSTR; END; { WITH } stats.NumSendPacks := stats.NumSendPacks+1; IF Debug THEN DisplayPacket('Sending ... ',ThisPacket); PutOut(ThisPacket); IF RunType = Transmit THEN BEGIN stats.ChInPack := stats.ChInPack + RemotePad + len + 6; temp := LastPacket; LastPacket := ThisPacket; ThisPacket := temp; END; END; { send fresh packet } END; { procedure SendPacket } $PAGE$ PROCEDURE SendACK ( n : integer ); { send ACK packet } { Builds an ACK packet for the given sequence number in Buf[ThisPacket] and sends it. Modifies stats.NumACKsent Buf[ThisPacket] Calls SendPacket Called by BuildPacket DoData DoEOF DoBreak DoFile DoEOFLast } BEGIN WITH Buf[ThisPacket] DO BEGIN count := 0; seq := n; ptype := TYPEY; END; SendPacket; stats.NumACKsent := stats.NumACKsent+1; END; $PAGE$ PROCEDURE SendNAK ( n : integer ); { send NAK packet } { Builds a NAK packet for the given sequence number into Buf[ThisPacket] and sends it. Modifies stats.NumNAKsent Buf[ThisPacket] Calls SendPacket Called by GetTheirInit DoData DoFileLast DoEOF DoBreak DoFile DoEOFLast DoInitLast ReceiveFile } BEGIN WITH Buf[ThisPacket] DO BEGIN count := 0; seq := n; ptype := TYPEN; END; SendPacket; stats.NumNAKsent := stats.NumNAKsent+1; END; $PAGE$ PROCEDURE ErrorPack ( c : cstring ); { where c = Error description string to be printed or sent in data field of packet If local, prints the error string to the standard error device. If remote, sends an error packet to the other host with the error string in the data field. Calls PutCon SendPacket Called by GetNextFile GetFile Main program } BEGIN IF Local THEN PutErr(c) ELSE BEGIN { send error packet to remote Kermit } WITH Buf[ThisPacket] DO BEGIN seq := n; ptype := TYPEE; CtoB(c,data); count := length(data); END; { with } SendPacket; END; { send error packet to remote Kermit } FinishUp; DisplayStatistics; END; $PAGE$ PROCEDURE Field1; { Count } { Checks the count field assumed to be in PackControl.t, sets the count field in Buf[DebugPacket] to t itself, and the count field in Buf[NextPacket] to UnChar(t). If the count is not within the proper range, a message will be printed via Verbose and PackControl.good will be set FALSE; otherwise, PackControl.good will be unchanged. References SizeRecv Modifies Buf[NextPacket] Buf[DebugPacket] PackControl Calls Verbose Called by BuildPacket } VAR test: boolean; BEGIN WITH Buf[NextPacket] DO BEGIN WITH PackControl DO BEGIN Buf[DebugPacket].count := t; count := UnChar(t); test := (count >= 3) OR (count <= SizeRecv-2); IF NOT test THEN Verbose('Bad count '); good := good AND test; END; { with PackControl } END; { with NextPacket } END; { procedure Field1 } $PAGE$ PROCEDURE Field2; { Packet Number } { Checks the sequence number field assumed to be in PackControl.t, sets the sequence number field in Buf[DebugPacket] to t itself, and the sequence number field in Buf[NextPacket] to UnChar(t). If the sequence number is not within the proper range, a message will be printed via Verbose and PackControl.good will be set FALSE; otherwise, PackControl.good will be unchanged. Modifies Buf[NextPacket] Buf[DebugPacket] PackControl Calls Verbose Called by BuildPacket } VAR test : boolean; BEGIN WITH Buf[NextPacket] DO BEGIN WITH PackControl DO BEGIN Buf[DebugPacket].seq := t; seq := UnChar(t); test := (seq >= 0) OR (seq <= 63); IF NOT test THEN Verbose('Bad seq number '); good := test AND good; END; END; END; $PAGE$ PROCEDURE Field3; { Packet Type } { Checks the type field assumed to be in PackControl.t, sets the type field in Buf[DebugPacket] and in Buf[NextPacket] to PackControl.t. If the type is not a valid packet type, a message will be printed via Verbose and PackControl.good will be set FALSE; otherwise, PackControl.good will be unchanged. Modifies Buf[NextPacket] Buf[DebugPacket] PackControl Calls Verbose IsValidPType Called by BuildPacket } VAR test : boolean; BEGIN WITH Buf[NextPacket] DO BEGIN WITH PackControl DO BEGIN ptype := t; Buf[DebugPacket].ptype := t; test := IsValidPType(ptype); IF NOT test THEN Verbose('Bad Packet Type '); good := test AND good; END; END; END; $PAGE$ PROCEDURE Field4; { Data } { Places the data character, assumed to be in PackControl.t, into the next position in Buf[DebugPacket].data. This position is assumed to be in PackControl.PacketPtr. Does the proper unquoting, and leaves the unquoted character in the next position of Buf[NextPacket].data. Modifies Buf[NextPacket] Buf[DebugPacket] PackControl Calls -nothing- Called by BuildPacket } BEGIN WITH PackControl DO BEGIN PacketPtr := PacketPtr+1; Buf[DebugPacket].data[PacketPtr] := t; WITH Buf[NextPacket] DO BEGIN IF t=LocalQuote THEN begin { character is quote } IF control THEN begin { quote ,quote } data[i] := LocalQuote; i := i+1; control := false; END { quote, quote } ELSE control := true { set control on } END { character is quote } ELSE IF control { not quote } THEN begin { convert to control } data[i] := Ctl(t); i := i+1; control := false END { convert to control } ELSE begin { regular data } data[i] := t; i := i+1; END; { regular data } END; { with NextPacket } END; { with PackControl } END; { procedure Field4 } $PAGE$ PROCEDURE Field5; { Check Sum } { Places the checksum character, assumed to be in PackControl.t, followed by a terminator, into the next position of Buf[DebugPacket].data. Calls CheckFunction to verify the checksum; if the checksum accumulated for the data does not match the one sent, then outputs an error message via Verbose and sets Good to FALSE, otherwise Good is unchanged. Sets the PackControl.finished. Modifies Buf[NextPacket] Buf[DebugPacket] PackControl Calls Verbose CheckFunction Called by BuildPacket } VAR test : boolean; BEGIN WITH PackControl DO BEGIN PacketPtr := PacketPtr +1; Buf[DebugPacket].data[PacketPtr] := t; Buf[DebugPacket].data[PacketPtr + 1] := ENDSTR; check := CheckFunction(check); check := MakeChar(check); test := (t=check); IF NOT test THEN Verbose('Bad CheckSum '); good := test AND good; Buf[NextPacket].data[i] := ENDSTR; finished := true; { set finished } END; END; $PAGE$ PROCEDURE BuildPacket; { Process received character } { Processes received character, assumed to be in PackControl.t, and adds it to the packet in Buf[NextPacket] according to the state information in PackControl. When the packet is completely received, if it is an error packet, the data field will be printed and FinishUp and DisplayStatistics will be called. Errors Error Packet Received Modifies PackControl Buf[NextPacket] CurrentPacket NextPacket stats.NumRecvPacks Calls Field1 Field2 Field3 Field4 Field5 PutStr DisplayStatistics SendACK DisplayPacket PutCon Called by ReceivePacket } VAR temp : Ppack; errstr : string[80]; { holds error text from error packet } BEGIN WITH PackControl DO BEGIN WITH Buf[NextPacket] DO BEGIN IF (t<>ENDSTR) { if a character was read } THEN IF restart THEN BEGIN { read until we get SOH marker } IF (t = SOH) THEN BEGIN { is packet mark } finished := false; { set variables } control := false; good := true; seq := -1; { set return values to bad packet } ptype := QUESTION; data[1] := ENDSTR; data[MAXSTR] := ENDSTR; restart := false; fld := 0; i := 1; PacketPtr := 0; check := 0; END; { is packet mark } END { read until we get SOH marker } ELSE BEGIN { have started packet } IF (t=SOH) { check for restart or EOL } THEN restart := true ELSE IF (t=LocalEOL) THEN BEGIN finished := true; good := false; END ELSE BEGIN { not mark or EOL } CASE fld OF { increment field number } 0: fld := 1; 1: fld := 2; 2: fld := 3; 3: { no data } IF (count=3) THEN fld := 5 ELSE fld := 4; 4: { end of data } IF (PacketPtr>=count-3) THEN fld := 5; END { case }; IF (fld<>5) THEN { add into checksum } check := check+t; CASE fld OF 1: Field1; 2: Field2; 3: Field3; 4: Field4; 5: Field5; END; { case } END; { not mark or EOL } END; { have started packet } IF finished THEN BEGIN IF (ptype=TYPEE) AND good THEN BEGIN { was error packet } IF Local THEN begin BtoS(data, errstr); setstrlen(report,0); strwrite(report,1,rpos, 'Error packet from remote - ', errstr); report_status(report); report_log(report); end; { if local } Finishup; DisplayStatistics; SendACK(n); { send ACK } END; { was error packet } stats.NumRecvPacks := stats.NumRecvPacks+1; IF Debug THEN BEGIN DisplayPacket('Received ... ',DebugPacket); IF good THEN PutErr('Is Good '); END; { debug } temp := CurrentPacket; CurrentPacket := NextPacket; NextPacket := temp; END; { if finished } END; { with Buf[NextPacket] } END; { with PackControl } END; { procedure BuildPacket } $PAGE$ FUNCTION ReceivePacket : boolean; { Receives a packet into Buf[NextPacket], which is then renamed to Buf[CurrentPacket] when complete. Errors Timeout while waiting for complete packet Abort key typed by user References PackControl Modifies stats.ChInPack Calls SerialIn ConsoleStatus ConsoleIn PutErr BuildPacket Called by ReceiveACK GetTheirInit ReceiveData ReceiveFile } label 1000; { here when abort key typed } var c : char; BEGIN WITH PackControl DO BEGIN StartTimer; finished := false; restart := true; REPEAT t := SerialIn; IF (RunType = Receive) AND (t <> ENDSTR) THEN stats.ChInPack := stats.ChInPack + 1; IF Local { see if character typed on console } THEN if consolestatus then begin { if a character was typed } c := consolein; { read it } if c = ConsoleAbort then begin { if abort forced } FinishUp; good := false; goto 1000; end { if abort forced } else t := LocalEOL; END; { if a character was typed } BuildPacket; UNTIL finished OR (TimeLeft = 0); IF (TimeLeft = 0) { if timed out waiting for packet } THEN BEGIN Buf[CurrentPacket] := TOPacket; restart := true; IF NOT ((RunType=Transmit) AND (State=RecvInit)) THEN BEGIN PutErr('Timed Out '); FinishUp; END; END; 1000: StopTimer; DisplayStatistics; ReceivePacket := good; END; { with PackControl } END; { procedure ReceivePacket } $PAGE$ FUNCTION ReceiveACK : boolean; { Receive ACK with correct number } { If OneWayOnly is set, then returns TRUE immediately. Receives a packet into CurrentPacket. If it is not received correctly, will return FALSE and the NumXXXRecv counters will be invalid (!?). Otherwise, if it is an ACK packet, increments stats.NumACKrecv. If it is an ACK packet, increments stats.NumNAKrecv. If it is any other type, increments stats.NumBADrecv. If it is an ACK packet and the sequence number number matches the one expected, then will return TRUE. Modifies stats.NumACKrecv stats.NumNAKrecv stats.NumBADrecv Calls ReceivePacket Called by SendFile SendData SendEOF SendBreak SendOurInit } VAR Ok: boolean; BEGIN IF (NOT OneWayOnly ) THEN Ok := ReceivePacket; WITH Buf[CurrentPacket] DO BEGIN IF (ptype=TYPEY) THEN stats.NumACKrecv := stats.NumACKrecv+1 ELSE IF (ptype=TYPEN) THEN stats.NumNAKrecv := stats.NumNAKrecv+1 ELSE IF NOT OneWayOnly THEN stats.NumBADrecv := stats.NumBADrecv +1; { got right one ? } ReceiveACK := ( Ok AND (ptype=TYPEY) AND (n=seq)) OR (OneWayOnly) END; { with } END; { function ReceiveACK } $PAGE$ PROCEDURE DataFromFile ( VAR newstate : KermitStates ); { Get data from file into ThisPacket } { Fills the data field of Buf[ThisPacket] with characters from DiskFile, which is assumed to be opened. Characters are read from file via Getcf. The field is terminated by ENDSTR, and the count, sequence and packet type fields are set. If EOF is reached, the file is closed, and newstate and SaveState are set to FileData. Otherwise, newstate is set to whatever SaveState is, and SaveState is left unchanged. References Diskfile Modifies SaveState Buf[ThisPacket] stats.ChInFile Calls Sclose Getcf Called by SendData } VAR x,c : byte; i: integer; BEGIN IF (NumTry=1) { if first time packet sent } THEN BEGIN i := 1; x := ENDSTR; WITH Buf[ThisPacket] DO BEGIN { leave room for quote & NEWLINE } WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE) DO begin x := Getcf(c,DiskFile); { get character and quote if necessary } IF (x<>ENDFILE) THEN IF (IsControl(x)) OR (x=RemoteQuote) THEN BEGIN { control char -- quote } IF (x=NEWLINE) THEN CASE EOLforFile OF { use proper EOL } LineFeed: { ok as is }; CrLf: BEGIN data[i] := RemoteQuote; i := i+1; data[i] := Ctl(CR); i := i+1; { LF will be sent below } END; { CrLf } JustCR: x := CR; END { case }; data[i] := RemoteQuote; i := i+1; IF (x<>RemoteQuote) THEN data[i] := Ctl(x) ELSE data[i] := RemoteQuote; END { control char } ELSE data[i] := x; { it's regular char } IF (x<>ENDFILE) THEN BEGIN i := i+1; { increase count for next char } stats.ChInFile := stats.ChInFile + 1; END; END; { get character and quote if necessary } data[i] := ENDSTR; { terminate ByteString } count := i-1; { set data fieldlength } seq := n; { set sequence number } ptype := TYPED; { set packet type } IF (x=ENDFILE) THEN BEGIN newstate := EOFile; Sclose(DiskFile); DiskFile := ioerror; END ELSE newstate := FileData; SaveState := newstate; { save state } END { with Buf[ThisPacket] do } END { if first time packet sent } ELSE newstate := SaveState; { get old state } END; { procedure DataFromFile } $PAGE$ FUNCTION GetNextFile : boolean; { Get next file to send in ThisPacket. Returns true if no more. Modifies Buf[ThisPacket] NextArg stats.ChInFile Calls GetStrArg Exists Sopen ErrorPack PutStr Called by SendFile } VAR result : boolean; name : FileName; { get_next_name gets the next file name in the file list and places it in the parameter name. If no more names in the file name list, returns false. } function get_next_name( var name : string ) : boolean; var result : boolean; begin result := false; name := send_file_list[send_file_next]; if strlen(name) <> 0 then begin send_file_next := send_file_next + 1; result := true; end; get_next_name := result; end; { procedure get_next_name } BEGIN result := true; IF (NumTry=1) THEN WITH Buf[ThisPacket] DO BEGIN { first try at this packet } while get_next_name(name) and (result) do begin IF Exists(name) THEN BEGIN { file already exists } DiskFile := Sopen(name,IOREAD); count := strlen(name); { set packet length } StoB(name, data); { convert name to Bytestring } { in data field of packet } report_send_file(name); stats.ChInFile := stats.ChInFile + count; seq := n; ptype := TYPEF; IF DiskFile <= IOERROR THEN ErrorPack('Cannot open file '); result := false; END; { file already exists } end; { while } END { first try at this packet } ELSE result := false; { for saved packet } GetNextFile := result; END; { function getnextfile } $PAGE$ PROCEDURE SendFile; { send file name packet } { Errors Retry Count Exhausted References MaxTry Modifies NumTry State n Calls PutErr Verbose GetNextFile SendPacket ReceiveACK Called by SendSwitch } var fnm : filename; num : integer; BEGIN IF NumTry > MaxTry THEN BEGIN { retry count exhausted } PutErr ('Send file - Too Many'); State := Abort; { too many tries, abort } END { retry count exhausted } ELSE BEGIN { maybe send file header } NumTry := NumTry+1; IF GetNextFile { if no more files to send } THEN BEGIN State := Break; NumTry := 0; END ELSE BEGIN { send file header packet } IF Verbosity THEN begin { report sending file header } IF (NumTry = 1) THEN begin BtoS(Buf[ThisPacket].data,fnm); num := Buf[ThisPacket].seq; end ELSE begin BtoS(Buf[LastPacket].data,fnm); num := Buf[LastPacket].seq; end; setstrlen(report,0); strwrite(report,1,rpos,'Sending file header packet #', num:1,' for ',fnm); report_log(report); end; { report sending file header } SendPacket; { send this packet } IF ReceiveACK THEN BEGIN State := FileData; NumTry := 0; n := (n+1) MOD 64; END END; { send file header packet } END; { maybe send file header } END; { procedure SendFile } $PAGE$ PROCEDURE SendData; { send file data packets } { Errors Retry Count Exhausted References MaxTry Modifies NumTry State n Calls PutCon PutNum PutErr DataFromFile SendPacket ReceiveACK Called by SendSwitch } VAR newstate: KermitStates; BEGIN IF Verbosity THEN BEGIN setstrlen(report,0); strwrite(report,1,rpos,'Sending data packet #',n:1); report_log(report); END; IF NumTry > MaxTry THEN BEGIN State := Abort; { too many tries, abort } PutErr ('Send data - Too many'); END ELSE BEGIN { send data packet } NumTry := NumTry+1; DataFromFile(newstate); SendPacket; IF ReceiveACK THEN BEGIN { got acknowledgement } State := newstate; NumTry := 0; n := (n+1) MOD 64; END; { got acknowledgement } END; { send data packet } END; { procedure SendData } $PAGE$ PROCEDURE SendEOF; { send EOF packet } { References MaxTry Modifies Buf[ThisPacket] NumTry State n Calls Verbose SendPacket ReceiveACK Called by SendSwitch } BEGIN Verbose ('Sending EOF '); IF NumTry > MaxTry THEN BEGIN State := Abort; { too many tries, abort } PutErr('Send EOF - Too Many '); END ELSE BEGIN { send EOF packet } NumTry := NumTry+1; IF (NumTry = 1) THEN BEGIN { if first time packet sent } WITH Buf[ThisPacket] DO BEGIN ptype := TYPEZ; seq := n; count := 0; END { with } END; { if first time packet sent } SendPacket; IF ReceiveACK THEN BEGIN { got acknowledgement } State := FileHeader; NumTry := 0; n := (n+1) MOD 64; END; { got acknowledgement } END; { send EOF packet } END; { procedure SendEOF } $PAGE$ PROCEDURE SendBreak; { send break packet } { References MaxTry Modifies Buf[ThisPacket] NumTry State n Calls Verbose PutErr SendPacket ReceiveACK Called by SendSwitch } BEGIN Verbose ('Sending break '); IF NumTry > MaxTry THEN BEGIN State := Abort; { too many tries, abort } PutErr('Send break -Too Many'); END ELSE BEGIN { send break packet } NumTry := NumTry+1; { make up packet } IF NumTry = 1 THEN BEGIN WITH Buf[ThisPacket] DO BEGIN ptype := TYPEB; seq := n; count := 0; END END; { with } SendPacket; { send this packet } IF ReceiveACK THEN State := Complete; END; { send break packet } END; { procedure SendBreak } $PAGE$ PROCEDURE SendOurInit; { send init packet } { References MaxTry OneWayOnly Modifies Buf[ThisPacket] Buf[CurrentPacket] NumTry State n SizeSend RemoteTimeOut RemotePad RemotePadChar RemoteEOL RemoteQuote Calls Verbose PutErr EnCodeParm SendPacket ReceiveACK Called by SendSwitch } BEGIN Verbose ('Sending init '); IF NumTry > MaxTry THEN BEGIN State := Abort; { too many tries, abort } PutErr('Cannot Initialize '); END ELSE BEGIN { send our send init packet } NumTry := NumTry+1; IF (NumTry = 1) THEN BEGIN { if first time packet sent } WITH Buf[ThisPacket] DO BEGIN EnCodeParm(data); count := NUMPARAM; seq := n; ptype := TYPES; END { with } END; { if first time packet sent } SendPacket; { send this packet } IF ReceiveACK THEN BEGIN { got acknowledgment } WITH Buf[CurrentPacket] DO BEGIN IF OneWayOnly { use same data if test mode } THEN data := Buf[LastPacket].data; SizeSend := UnChar(data[1]); RemoteTimeOut := UnChar(data[2]); RemotePad := UnChar(data[3]); RemotePadChar := Ctl(data[4]); RemoteEOL := CR; { default to CR } IF (length(data) >= 5) THEN IF (data[5] <> 0) THEN RemoteEOL := UnChar(data[5]); RemoteQuote := SHARP; { default # } IF (length(data) >= 6) THEN IF (data[6] <> 0) THEN RemoteQuote := data[6]; END; { with } State := FileHeader; NumTry := 0; n := (n+1) MOD 64; END; { got acknowledgement } END; { send our send init packet } END; { procedure SendOurInit } $PAGE$ PROCEDURE SendSwitch( files : filename_list); { Send-switch is the state table switcher for sending files. It loops until either it is finished or a fault is encountered. Routines called by SendSwitch are responsible for changing the state. References OneWayOnly Modifies State NumTry Calls Sleep StartRun SendData SendFile SendEOF SendOurInit SendBreak Called by Main Program } BEGIN State := SendInit; { send initiate is the start state } NumTry := 0; { say no tries yet } init_packet_display(runtype); IF (NOT OneWayOnly ) THEN Sleep(LocalDelay); send_file_list := files; { get list of files to send } send_file_next := 1; { point to first filename } StartRun; REPEAT CASE State OF FileData: SendData; { data-send state } FileHeader: SendFile; { send file name } EOFile: SendEOF; { send end-of-file } SendInit: SendOurInit; { send initialize } Break: SendBreak; { send break } Complete: { nothing }; Abort: { nothing }; END { case }; UNTIL ( (State = Abort) OR (State=Complete) ); END; $PAGE$ PROCEDURE GetFile ( data : bytestring ); { Creates file with name given by the bytestring data. Assigns it to file descriptor diskfile. References Verbosity Modifies DiskFile Calls Exists ErrorPack Called by DoFile } VAR name : FileName; npos : integer; BEGIN IF DiskFile = IOERROR { if we don't already have a file } THEN begin { create a file } BtoS( data, name ); { get the filename from the packet } { data field } IF Verbosity THEN begin setstrlen(report,0); strwrite(report,1,rpos,'Creating file ',name); report_log(report); end; { check Max length } IF strlen(name) > FILENAME_LENGTH THEN setstrlen(name, FILENAME_LENGTH); IF Exists(name) THEN BEGIN { if file exists already } setstrlen(report,0); strwrite(report,1,rpos,'File already exists - ',name); setstrlen(name,0); strwrite(name, 1, npos, TEMPFILE:1, n:1); strwrite(report,rpos,rpos, '. Calling new file ',name,' instead.'); report_status(report); END; { if file exists already } DiskFile := Sopen(name,IOWRITE); END; { create a file } IF (Diskfile <= IOERROR) THEN ErrorPack('Cannot create file '); END; { procedure GetFile } $PAGE$ PROCEDURE GetTheirInit; { Receive init packet. Respond with ACK and our parameters. Errors Retry count exhausted Received Bad Init packet References MaxTry Debug Modifies Buf[ThisPacket] Buf[CurrentPacket] State NumTry n stats.NumACKsent OldTry Calls PutErr Verbose ReceivePacket DeCodeParm EnCodeParm SendPacket PutCon SendNAK Called by RecvSwitch } VAR rs : boolean; BEGIN IF NumTry > MaxTry THEN BEGIN State := Abort; PutErr('Cannot receive init '); END ELSE BEGIN { Receive the Send init from remote } Verbose ( 'Receiving Init '); NumTry := NumTry+1; rs := ReceivePacket; IF rs AND (Buf[CurrentPacket].ptype = TYPES) THEN BEGIN { Good send init packet received } WITH Buf[CurrentPacket] DO BEGIN n := seq; DeCodeParm(data); END; { with } { now send mine } WITH Buf[ThisPacket] DO BEGIN count := NUMPARAM; seq := n; Ptype := TYPEY; EnCodeParm(data); END; SendPacket; stats.NumACKsent := stats.NumACKsent+1; State := FileHeader; OldTry := NumTry; NumTry := 0; n := (n+1) MOD 64 END { good send init packet received } ELSE BEGIN { received bad init } IF Debug THEN begin PutErr('Received Bad init '); end; SendNAK(n); END; { received bad init } END; { Receive the Send init from remote } END; $PAGE$ PROCEDURE DataToFile; { output to file } { Writes the data field of Buf[CurrentPacket] to DiskFile, with the end of line sequence dictated by EOLforFile. Implicit Inputs Buf[CurrentPacket] References EOLForFile DiskFile Modifies stats.ChInFile Calls Putcf PutStr Called by DoData } VAR len,i : integer; temp : ByteString; BEGIN WITH Buf[CurrentPacket] DO BEGIN len := length(data); stats.ChInFile := stats.ChInFile + len; CASE EOLforFile OF LineFeed: PutStr(data,DiskFile); CrLf: BEGIN { don't output CR } FOR i:=1 TO len DO IF data[i] <> CR THEN Putcf(data[i],DiskFile); END; { CrLf } JustCR: BEGIN { change CR to NEWLINE } FOR i:=1 TO len DO IF data[i]=CR THEN data[i]:=NEWLINE; PutStr(data,DiskFile); END; { JustCR } END; { case } END; { with } END; { procedure DataToFile } $PAGE$ PROCEDURE DoData; { Process Data packet } { Processes received data packet, assumed to be in CurrentPacket. If the packet is the expected one, writes the data to the destination file via DataToFile. If it is the previous packet (i.e. the ACK for that packet got lost), ACKs that packet again if the retry count has not reached maximum. If it is any other packet number, the a NAK will be sent for the expected packet. Implicit Inputs Buf[CurrentPacket] Errors Retry count exhausted References MaxTry OldTry Modifies OldTry NumTry n State Calls DataToFile PutErr SendACK SendNAK Called by ReceiveData } BEGIN WITH Buf[CurrentPacket] DO BEGIN IF seq = ((n + 63) MOD 64) THEN BEGIN { it's the previous data packet } IF OldTry>MaxTry { if retried too many times } THEN BEGIN State := Abort; PutErr('Old data - Too many '); END ELSE BEGIN SendACK(seq); NumTry := 0; END; END { it's the previous packet } ELSE BEGIN { it's not the previous one } IF (n<>seq) { if it's not the expected one } THEN SendNAK(n) { NAK the expected one } ELSE BEGIN SendACK(n); { ACK } DataToFile; OldTry := NumTry; NumTry := 0; n := (n+1) MOD 64; END; END; { it's not the previous one } END; { with } END; { procedure DoData } $PAGE$ PROCEDURE DoFileLast; { Process File Packet } { Called by ReceiveData when file header packet received when a data packet expected (ie the sender never got the ACK for the file header). Errors Retry count exhausted References Buf[CurrentPacket] MaxTry Modifies State OldTry NumTry Calls PutErr SendACK SendNAK Called by ReceiveData } BEGIN { File header - last one } IF OldTry > MaxTry { tries ? } THEN BEGIN State := Abort; PutErr('Old file - Too many '); END ELSE BEGIN OldTry := OldTry+1; WITH Buf[CurrentPacket] DO BEGIN IF seq = ((n + 63) MOD 64) { packet number } THEN BEGIN { send ACK } SendACK(seq); NumTry := 0 END ELSE BEGIN SendNAK(n); { NAK } END; END; { with } END; { retry not exhausted } END; { procedure DoFileLast } $PAGE$ PROCEDURE DoEOF; { Process EOF packet } { Called by ReceiveData to process received EOF packets. If not the expected sequence number, NAKs the expected packet, otherwise ACKs it and closes the file. References Buf[CurrentPacket] DiskFile Modifies DiskFile OldTry NumTry State n Calls SendNAK SendACK Sclose Called by ReceiveData } BEGIN { EOF - this one } IF Buf[CurrentPacket].seq<>n { packet number ? } THEN SendNAK(n) { NAK the expected packet } ELSE BEGIN { ACK this one } SendACK(n); Sclose(DiskFile); { close file } DiskFile := IOERROR; OldTry := NumTry; NumTry := 0; n := (n+1) MOD 64; { next packet } State := FileHeader; { change state } END; { ACK this one } END; { procedure DoEOF } $PAGE$ PROCEDURE ReceiveData; { Receive data packets } { Reads packet, dispatches to proper routine if data, EOF, or file header packet. If it is any other type, NAKs the expected data packet. Errors Retry Count Exhausted Invalid Packet Type References MaxTry Verbosity Local Buf[CurrentPacket] Modifies NumTry Calls PutStr ReceivePacket PutCon PutNum DoData DoFileLast DoEOF Verbose SendNAK Called by RecvSwitch } VAR strend : integer; packetnum : ByteString; good : boolean; BEGIN IF NumTry > MaxTry { check number of tries } THEN BEGIN State := Abort; CtoB('Recv data -Too many ',packetnum); strend := ItoC(n,packetnum,CONLENGTH+1); IF Local THEN PutStr(packetnum,STDERR); END ELSE BEGIN { retry not exhausted } NumTry := NumTry+1; { increase number of tries } good := ReceivePacket; { get packet } WITH Buf[CurrentPacket] DO BEGIN IF Verbosity THEN BEGIN PutCon('Receiving (Data) ',STDERR); PutNum(seq,STDERR); END; IF (ptype in [TYPED, TYPEZ, TYPEF]) AND good { check type } THEN CASE ptype OF TYPED: DoData; TYPEF: DoFileLast; TYPEZ: DoEOF; END { case } ELSE BEGIN { not a good type } Verbose('Expected data pack '); SendNAK(n); END; END; { with } END; { retry not exhausted } END; { procedure ReceiveData } $PAGE$ PROCEDURE DoBreak; { Process Break packet } { Called by ReceiveFile to process a break packet. Errors None References Buf[CurrentPacket] n Modifies State Calls SendNAK SendACK Called by ReceiveFile } BEGIN { Break transmission } IF Buf[CurrentPacket].seq<>n { packet number ? } THEN SendNAK(n) { NAK } ELSE BEGIN { send ACK } SendACK(n) ; State := Complete { change state } END END; $PAGE$ PROCEDURE DoFile; { Process file packet } { Called by ReceiveFile to process file header packet. Errors None References Buf[CurrentPacket] Modifies stats.ChInFile OldTry NumTry n State Calls SendNAK SendACK GetFile Called by ReceiveFile } BEGIN WITH Buf[CurrentPacket] DO BEGIN IF seq<>n { packet number ? } THEN SendNAK(n) { NAK } ELSE BEGIN { send ACK } SendACK(n); stats.ChInFile := stats.ChInFile + length(data); GetFile(data); { get file name } OldTry := NumTry; NumTry := 0; n := (n+1) MOD 64; { next packet } State := FileData; { change state } END; { send ACK } END; { with } END; { procedure DoFile } $PAGE$ PROCEDURE DoEOFLast; { Process EOF Packet } { Called by ReceiveFile to process an EOF for the last file (i.e., the ACK for the last EOF was lost). Resends the ACK for the EOF. Errors Retry count exhausted References Buf[CurrentPacket] MaxTry n Modifies State OldTry NumTry Calls PutErr SendACK SendNAK Called by ReceiveFile } BEGIN { End Of File Last One} IF OldTry > MaxTry { tries ? } THEN BEGIN State := Abort; PutErr('Old EOF - Too many '); END ELSE BEGIN { process last EOF packet } OldTry := OldTry+1; WITH Buf[CurrentPacket] DO BEGIN IF seq =((n + 63 ) MOD 64) { packet number } THEN BEGIN { send ACK } SendACK(seq); Numtry := 0; END ELSE SendNAK(n); { NAK } END; { with } END; { process last EOF packet } END; { procedure DoEOFLast } $PAGE$ PROCEDURE DoInitLast; { Called by ReceiveFile when a Send-Init packet was received (i.e. when the ACK for the last Send-Init was lost). Resends the Send-Init. Errors Retry count exhausted References MaxTry Buf[CurrentPacket] NUMPARAM Modifies Buf[ThisPacket] State OldTry NumTry stats.NumACKsent Calls PutErr EnCodeParm SendPacket SendNAK Called by ReceiveFile } BEGIN { Init Packet - last one } IF OldTry>MaxTry { number of tries? } THEN BEGIN State := Abort; PutErr('Old init - Too many '); END ELSE BEGIN { process last init packet } OldTry := OldTry+1; IF Buf[CurrentPacket].seq = ((n + 63) MOD 64) { packet number } THEN BEGIN { send ACK } WITH Buf[ThisPacket] DO BEGIN count := NUMPARAM; seq := Buf[CurrentPacket].seq; ptype := TYPEY; EnCodeParm(data); END; SendPacket; stats.NumACKsent := stats.NumACKsent+1; NumTry := 0; END { send ACK } ELSE SendNAK(n); { NAK } END; { process last init packet } END; { procedure DoInitLast } $PAGE$ PROCEDURE ReceiveFile; { receive file packet } { Errors Retry count exhausted Invalid Packet Type References MaxTry Verbosity Debug Modifies Buf[CurrentPacket] NumTry Calls PutErr ReceivePacket PutCon PutNum DoInitLast DoEOFLast DoFile DoBreak SendNAK Called by RecvSwitch } VAR good: boolean; rpos : integer; report, fnm : string[80]; BEGIN IF NumTry > MaxTry { check number of tries } THEN BEGIN { retry count exhausted } State := Abort; PutErr('Recv file - Too many'); END { retry count exhausted } ELSE BEGIN { get the file header packet } NumTry := NumTry+1; { increase number of tries } good := ReceivePacket; { get packet } WITH Buf[CurrentPacket] DO BEGIN IF VERBOSITY THEN BEGIN setstrlen(report,0); strwrite(report,1,rpos, 'Receiving file header packet #', seq:1); report_log(report); END; IF (ptype in [TYPES, TYPEZ, TYPEF, TYPEB]) AND good THEN CASE ptype OF TYPES: DoInitLast; { ACK to Init packet lost } TYPEZ: DoEOFLast; { ACK to EOF lost } TYPEF: begin { File header } BtoS(data, fnm); report_receive_file(fnm); DoFile; end; { TYPEF } TYPEB: DoBreak; { finished receiving file group } END { case } ELSE BEGIN IF Debug THEN PutErr('Expected File Packet'); SendNAK(n); END; END; { with } END; { get the file header packet } END; { procedure ReceiveFile } $PAGE$ procedure SendRecvInit( fnm : filename ); { Sends receive initiate packet with the given filename to the remote server. Called by RecvSwitch } begin { build the Receive Init packet in ThisPacket } with Buf[ThisPacket] do begin StoB(fnm, data); { convert filename into bytestring in data field } count := strlen(fnm); seq := n; ptype := TYPER; { type is Receive Init } end; { with } SendPacket; { send ThisPacket } end; { procedure SendRecvInit } $PAGE$ procedure RecvSwitch( files : filename_list ); { Receive file group state switcher. If filename_list is non-empty, sends receive init packet for the files in it. Modifies State NumTry Calls StartRun ReceiveData GetTheirInit ReceiveFile Called by Main program } var i : integer; fnm : filename; BEGIN State := RecvInit; init_packet_display(runtype); NumTry := 0; StartRun; i := 1; while strlen(files[i]) <> 0 do begin fnm := files[i]; i := i + 1; SendRecvInit( fnm ); REPEAT if debug or verbosity then begin { print blank line to separate packet info } report := ''; report_log(report); end; CASE State OF FileData: ReceiveData; RecvInit: GetTheirInit; Break: { nothing }; FileHeader: ReceiveFile; EOFile: { nothing }; Complete: { nothing }; Abort: { nothing }; END; { case } UNTIL (State = Abort ) OR ( State = Complete ); end; { while } END; { procedure recvswitch } end. { module krmguts }