(* tab p; * * Kermit utilities * * Low-level IO, ++ * To be INCLUDE'd by main program. * *) function PackToCh ( pType : PacketType ): char; var RetVal : char; begin case pType of DataPack : RetVal := 'D'; ACKPack : RetVal := 'Y'; NAKPack : RetVal := 'N'; SInitPack : RetVal := 'S'; BrkPack : RetVal := 'B'; FHeadPack : RetVal := 'F'; EOFPack : RetVal := 'Z'; ErrPack : RetVal := 'E'; NoChangePack, TimOutPack, IllPack, ChkIllPack : RetVal := ' '; end; PackToCh := RetVal; end; function ChToPack( ch : char ): PacketType; begin if not ( ch in LegalPackets ) then begin if Debug then begin DbgWrite ( 'Illegal packet type : $' ); DbgChar ( ch ); DbgNL; end; ChToPack := IllPack; end else begin case ch of 'D' : ChToPack := DataPack; 'Y' : ChToPack := AckPack; 'N' : ChToPack := NakPack; 'S' : ChToPack := SinitPack; 'B' : ChToPack := BrkPack; 'F' : ChToPack := FHeadPack; 'Z' : ChToPack := EOFPack; 'E' : ChToPack := ErrPack; end; end; end; procedure SetInitPars( var Pack : Packet ); (* Build SendInit packet *) begin with Pack do begin if MaxPack=96 then (* Max packet-length I can handle *) data(.MinString.) := ToChar( chr(0) ) else data(.MinString.) := ToChar( chr(MaxPack) ); data(.MinString + 1.) := ToChar( chr(MyTime) ); (* When I want to be timed out *) data(.MinString + 2.) := ToChar( chr(MyPad) ); (* How much padding I need *) data(.MinString + 3.) := ctl ( chr(MyPChar) ); (* My padding character *) data(.MinString + 4.) := ToChar( chr(MyEoln) ); (* End-of-line I want *) data(.MinString + 5.) := MyQuote ; (* control-quote char I send *) if not HasSw8Off then data(.MinString + 6.) := My8Quote (* 8-bit-quote char I send *) else data(.MinString + 6.) := 'N'; (* No 8-bit quoting *) count:= ToChar( chr( 7 + 3 ) ); ptype:= PackToCh( SInitPack ); end; end; procedure ReadPars ( VAR Pack : Packet ); (* Set parameters according to Pack (Which is SendInit or Acknowledge packet) and build the corresponding Acknowledge packet *) VAR len,i : integer; Sending, Receiving : Boolean; begin with Pack do begin Sending := (ChToPack(Ptype) = ACKPack); Receiving := (ChToPack(Ptype) = SInitPack); if not( Sending or Receiving ) then begin CurrState := ABORT; if Debug then begin DbgWrite( ' Attempted ReadPars from non-SendInit packet - Failed!$' ); DbgNL; end; end else begin len := ord( UnChar( count ) ) - 3; for i := len to MaxString do (* treat absent data and *) Data(.i.) := ' '; (* blank data alike *) (* Packet size: max. & default is 94 (or is it 96?), reply with MaxPack *) i := MinString; if UnChar( Data(.i.) ) = chr(0) then SendPSize := 96 (* Default packet size *) else SendPSize := ord ( UnChar ( Data(.i.) ) ); (* If we are receiving, tell other Kermit about our max. packet length *) if MaxPack=96 then data(.i.) := ToChar( chr(0) ) else data(.i.) := ToChar( chr(MaxPack) ); (* Seconds before timeout: Default is no timeout, reply with MyTime *) i := MinString + 1; TimeOut := ord ( UnChar ( Data(.i.) ) ); data(.i.) := ToChar( chr(MyTime) ); (* Number of pad characters: Default is no padding, reply with MyPad *) i := MinString + 2; NPad := ord ( UnChar ( Data(.i.) ) ); data(.i.) := ToChar( chr(MyPad) ); (* Pad character: Default is ASCII NUL, reply with MyPadChar *) i := MinString + 3; if ( NPad = 0 ) or ( UnChar(Data(.i.))=chr(0) ) then PadChar := chr(0) else PadChar := Ctl ( Data(.i.) ) ; data(.i.) := ctl( chr(MyPChar) ); (* End-of-line character: Default is ASCII CR, reply with MyEOLN *) i := MinString + 4; if UnChar(Data(.i.))=chr(0) then Eol := chr(13) else Eol := UnChar ( Data(.i.) ) ; data(.i.) := ToChar( chr(MyEoln) ); (* Control-quote character: Is suggested by the sender and must be accepted * by the receiver. Default is '#' if nothing is said (a blank field). *) i := MinString + 5; if Receiving then begin if UnChar(data(.i.))=chr(0) then Quote := '#' else Quote := data(.i.); if not (Quote in OkQuote) then begin Currstate := ABORT; if Debug then begin DbgWrite( ' Sender proposing illegal quote-character - Failed!$'); DbgNL; end; end; end; (* Now compute set of valid 8-bits quotes *) Ok8Quote := OkQuote - (.Quote.); (* 8-bit quoting negotiation: The sender may say N -- I will not do 8-bit-quoting Y -- I agree to 8-bit-quoting, you suggest which character & -- I want to do 8-b-q using this character (could be some other). Kermit-ND will reply as follows: sender Kermit-ND/USE-8=OFF Kermit-ND/USE-8=AUTO N N N Y N & & N Y SP N N ill. abort abort When Kermit-ND is sending its Send-Init packet said '&' if USE-8 is AUTO, and 'N' otherwise. The reply to this may be Kermit-ND Other Kermit N various ... 8-b-q must not be done anyhow. & N ... 8-b-q may not be done. Y OK, we use '&'. & OK (though not correct acc. to protocol manual), use '&'. *) i := MinString + 6; if Receiving then case HasSw8Off of TRUE: begin Use8Quote := FALSE; data(.i.) := 'N'; if not (data(.i.) in(Ok8Quote + (.'N','Y',' '.))) then if Debug then begin DbgWrite( ' (bad 8-bit-quote proposal from sender)$'); DbgNL; end; end; FALSE: (* Auto *) begin if data(.i.) = ' ' then data(.i.) := 'N'; if data(.i.) = 'N' then Use8Quote := FALSE else if data(.i.) = 'Y' then begin Bit8Quote := My8Quote; data(.i.) := My8Quote; Use8Quote := TRUE; end else if data(.I.) in Ok8Quote then begin Bit8Quote := data(.i.); Use8Quote := TRUE; data(.i.) := 'Y'; end else if Debug then begin Use8Quote := FALSE; DbgWrite (' (bad 8-bit-quote proposal from sender)$'); DbgNL; end; end; end else if Sending then case HasSw8Off of TRUE: (* Means we said 'N' in our SendInit packet *) begin Use8Quote := FALSE; if not( data(.i.) in (.' ','N'.)) then if Debug then begin DbgWrite( ' (silly 8-bit-quote reply from receiver)$'); DbgNL; end; end; FALSE: (* We said '&' *) begin if (data(.i.) = My8Quote) or (data(.i.) = 'Y') then begin Use8Quote := TRUE; Bit8Quote := My8Quote; end else if data(.i.) in (.' ','N'.) then Use8Quote := FALSE else if Debug then begin Use8Quote := FALSE; DbgWrite( ' (silly 8-bit-quote reply from receiver)$'); DbgNL; end; end; end; (* Checksum type : Default is 1-character checksum. * No other supported by Kermit-ND. *) i := MinString + 7; Data(.i.) := '1'; (* Repeat prefix : No default, not (yet) supported. *) Data(.MinString + 8.) := ' '; Count := ToChar ( chr( 9 + 3 ) ); Ptype := PackToCh ( ACKPack ); end; end; end; (* -- Packet level I/O *) (*$t- *) procedure WritePacket ( VAR data : EqRecord; odev : integer ); (* procedure to do the actual O, assume packet is OK *) var i,j,k : integer; begin k := ord ( UnChar ( data.Pack.count ) ); Data.Pack.data(.k - 2 + MinString.) := chr(0); (* Number of bytes to output: *) i := 4 + k - 3; NChSent := NChSent + i + NPad; (* compute number of 8-bytes to output: *) i := i div 8; for j := 0 to i do m8out ( ODev , Data.IntArr(.j*4.)); outbt ( ODev , eol ); end; (*$t+ *) procedure SendPacket ( sptype : PacketType; num : integer; len : integer; VAR data : Packet; odev : integer ); (* build header, calculate checksum and send packet on output-device *) var i, chksum : integer; DirtPtr : EqPtr; function Addr ( VAR Data : Packet ):EqPtr; extern; begin (* SendPacket *) with data do begin mark := SOH; for i := 1 to NPad do outbt ( odev , PadChar ); if len>=0 then (* is there valid data? *) count := ToChar ( chr ( len + 3 ) ) else len := ord ( UnChar ( count ) ) - 3 ; chksum := ord ( count ); if num>=0 then seq := ToChar ( chr ( num ) ); chksum := chksum + ord ( seq ); if sptype<>NoChangePack then ptype := PackToCh( sptype ); chksum := chksum + ord ( ptype ); for i := MinString to ( MinString + len - 1 ) do (* accumulate checksum *) chksum := chksum + ord ( data(.i.) ); data(.MinString + len.) := MakeCheck ( chksum ); end; (* with *) (*$t- *) DirtPtr := Addr ( data ); WritePacket ( DirtPtr^, odev ); (*$t+ *) if Debug then DbgShowPacket ( data ); end; function ReadPacket ( var num : integer; var len : integer; var data : Packet; idev : integer ): PacketType; label 99; (* where to jump to abort function *) (* read a packet and return seq. number, data packet and length *) var chksum,NumPoll,i : integer; done,ReSynch : boolean; ch : char; PType : PacketType; InpSize,Expect : integer; function Poll( NumChar : integer ) : integer; (* Wait until input buffer contains at least min (Expect,NumChar) characters, or time out when max. time (NumPoll decremented to zero). Jump to label 99 when timed out. *) VAR i,j: integer; begin I:= 0; if NumChar>Expect then NumChar := Expect; if ( TimeOut>0 ) and not DisableTimeOut then (* TimeOut=0 ==> never time out *) repeat j := I; I := Isize ( idev ); if I < NumChar then begin xhold( BUnits, ( Del20Chars * (NumChar-I) ) div 20 + 1 ); NumPoll := NumPoll - (NumChar-I); if NumPoll<=0 then begin ReadPacket := TimOutPack; if Debug then begin DbgWrite( 'Timed out waiting for packet!$'); DbgNL; end; goto 99; end; end; until ( I >= NumChar ); Poll := I ; Expect := Expect - I ; end; begin NumPoll := TimeOut*50 div Del20Chars; (* Max. number of polls before timeout *) Expect := MAXINT; (* Expects unlimited number of chars. *) repeat InpSize := Poll(1) - 1 ; (* Quit if timeout *) ch := inbt ( idev ) ; NChRcvd := NChRcvd + 1L; until (ch = SOH); if ch = SOH then begin data.mark := ch; done := false; while not done do begin if InpSize=0 then InpSize := Poll(1); InpSize := InpSize - 1; ch := inbt ( idev ); NChRcvd := NChRcvd + 1L; if ch <> SOH then (* resynch on SOH *) begin chksum := ord ( ch ); Expect := ord( UnChar ( ch ) ); (* Rest of packet *) len := Expect - 3; data.count := ch; InpSize := Poll( Chunk ) - 1; ch := inbt ( idev ); NChRcvd := NChRcvd + 1L; if ch <> SOH then (* resynch on SOH *) begin chksum := chksum + ord ( ch ); num := ord( UnChar ( ch ) ); data.seq := ch; InpSize := InpSize - 1; ch := inbt ( idev ); NChRcvd := NChRcvd + 1L; if ch <> SOH then (* resynch on SOH *) begin chksum := chksum + ord ( ch ); ReadPacket := ChToPack ( ch ); data.ptype := ch; i := MinString; ReSynch := FALSE; while not ((i > (len + MinString - 1 )) or ReSynch) do begin if InpSize=0 then begin InpSize := Poll( Chunk ); end; InpSize := InpSize - 1; ch := inbt ( idev ); NChRcvd := NChRcvd + 1L; ReSynch := ch=SOH; if not ReSynch then begin chksum := chksum + ord ( ch ); data.data(.i.) := ch; end; i := i + 1; end; if not ReSynch then begin if InpSize=0 then InpSize := Poll(1); InpSize := InpSize - 1; ch := inbt ( idev ); NChRcvd := NChRcvd + 1L; if ( MakeCheck ( chksum ) <> ch ) and ( ch <> SOH ) then ReadPacket := ChkIllPack; done := ch <> SOH; end; end; end; end; end; if Debug then DbgShowPacket( data ); end; 99: ; (* jump to 99 after timeout *) end; procedure FillBuffer ( var data : Packet; var infile : ByteFile ); var ch : Byte; i : integer; NRead : integer; (* Number of characters read from file *) Quote8 , CtrlChar : boolean; begin i := MinString; NRead := 0; with data do begin if not eof ( infile ) then begin repeat read ( infile , ch ); NRead := NRead + 1; Quote8 := ( ch >= 128 ) and Use8Quote; if Quote8 then begin (* quote for eight bit: *) data(.i.) := Bit8Quote; i := i + 1; end; (* strip off 8'th bit. On ND-version - unconditional *) (* Other machines may include in test above *) ch := iand ( ch , 127 ); CtrlChar := ( ch < ord ( ' ' ) ) or ( ch = 127 ) or (* del *) ( chr ( ch ) = Quote ) or ( ( chr( ch ) = Bit8Quote) and Use8Quote ) ; if CtrlChar then begin if ( ch < ord ( ' ' ) ) or ( ch = 127 ) then (* real control character *) ch := ord ( ctl ( chr ( ch ) ) ); data(.i.) := Quote; i := i + 1; end; data(.i.) := chr ( ch ); i := i + 1; until eof ( infile ) or ( i + 9 - MinString >= SendPSize ); (* Put count field = len of data + 3, i = len of data + 1 *) count := ToChar ( chr ( i + 3 - MinString ) ); end else count := ToChar ( chr ( 0 ) ); (* if chr( iand( ord(seq), 127 ) ) IN (. ToChar(chr(0))..ToChar(chr(63)) .) then *) (* update sequence number - if it vas a valid one in the first place *) (* seq := ToChar( chr( ( ord( UnChar( seq ) ) + 1 ) mod 64 ) ); *) ptype := PackToCh( DataPack ); end; (* with *) NChFile := NChFile + NRead; end; procedure EmptyBuffer ( var OutFile : bytefile; var data : Packet ); var i, NChar, (* Number of characters in packet *) NWritten (* Number of characters actually written to file *) : integer; CtrlChar, Quote8 : boolean; ch : char; Scr : Byte; begin i := MinString; NWritten := 0; with data do begin (* Calculate number of data-characters in "data": *) NChar := ord( UnChar ( count ) ) - 4 - MinString; while i <= NChar do begin ch := data(.i.); Quote8 := Use8Quote and ( ch = Bit8Quote ); if Quote8 then begin i := i + 1; ch := data(.i.); end; CtrlChar := ch = MyQuote; if CtrlChar then begin i := i + 1; ch := data(.i.); if ch <> MyQuote then if not Use8Quote then ch := ctl(ch) else if ch <> Bit8Quote then ch := ctl(ch); (* else character is a quoted quote(!) *) end; if Quote8 then Scr := ior ( ord ( ch ) , 128 ) else Scr := ord ( ch ); write ( OutFile , Scr ); NWritten := NWritten + 1; i := i + 1; end; end; (* with *) NChFile := NChFile + NWritten; end; procedure SendACK( num, odev : integer ); VAR dummy : Packet; begin SendPacket( ACKPack, num, 0, dummy, odev ); end; procedure SendNAK( num, odev : integer ); VAR dummy : Packet; begin SendPacket( NAKPack, num, 0, dummy, odev ); end; procedure SendBrk( odev : integer ); VAR dummy : Packet; begin SendPacket( BrkPack, 0, 0, dummy, odev ); end; procedure InitializeKermit; (* Abstract: This procedure initializes various global Kermit variables: "Constants", Transmission parameters, Kermit state variables. NB! This procedure is to be called only ONCE during the run! *) begin (* Ought to have been constants, *) (* but there are no such constants in PASCAL...*) xhold(BUnits,0); (* Dummy hold - ND dependent *) SOH := chr(1); LegalPackets := (. 'D','Y','N','S','B','F','Z','E'.); (* Then some useful character sets : NB! they are recomputed by ReadPars *) (* This is the set which the set of control characters is mapped into by the Ctl function *) CtlMapping := (. ctl( chr(0) )..ctl( pred(' ') ), ctl( chr(127) ) .); (* Valid control quote characters, i.e all printable characters which Ctl does not map a control character into *) OkQuote := (.'!'..'~'.) - CtlMapping; (* Valid 8-bit quote characters, i.e. same as for quote, except SPACE is not valid but 'Y' is (=default), and of course the character that is chosen as control quote is not valid *) Ok8Quote := OkQuote - (.'#'.) + (.'Y'.); (* Kermit parameters: must be defined to enable first packet to get through *) SendPSize := 96; (* - max. packet size *) TimeOut := 0; (* - no timeout *) NPad := 0; (* - no padding *) PadChar := chr(0); (* - ASCII NUL as padchar *) Eol := chr(13); (* - carriage return as eol *) Quote := '#'; (* - sharp as control quote *) Bit8Quote := '&'; (* - ampersand as 8-bit quote *) Use8Quote := FALSE; (* - 8-bit quoting disabled *) HasSw8Off := FALSE; (* -"- has not been switched off*) LocalKermit := FALSE; (* This frog is born a remote kermit *) Idev := 1; Odev := 1; DisableTimOut := FALSE; (* Allow partner to enable timeout *) FileWarning := FALSE; (* Overwrite existing files initially *) CurrState := Complete; (* Avoid starting out in a bad state *) N := 0; (* Start out with packet zero *) NumTry := 0; OldTry := 0; MaxTry := 16; (* Retries before giving up *) Delay := 5; (* Default delay *) (* before sending/receiving *) RTSet := false; STSet := false; DbgConnected := false; Debug := false; HasDone := false; (* No transaction has been done yet *) InitVocab; (* Initialize command vocabulary *) end; (* InitializeKermit *)