Unit Packets ; (* ------------------------------------------------------------------ *) (* Packets - Packet procedures and ReadChar procedures *) (* ------------------------------------------------------------------ *) Interface Uses Dos,Crt, (* Standard Turbo Pascal Unit *) sysfunc, (* System functions used by Kermit *) KGlobals, (* Kermit Globals - Execution Control Flags *) ModemPro ; (* Modem procedures *) CONST MaxPacketSize = 4096 ; TYPE STATETYPE = (S,SF,SD,SZ,SB,C,A,R,RF,RD) ; ABORTTYPE = (NOSOH,BADSF,NOT_S,NOT_SFBZ,NOT_DZ); BREAKTYPE = (NOBREAK,BX,BZ,BC,BE); PACKET = PACKED ARRAY[1..MaxPacketsize] OF BYTE ; VAR STATE : STATETYPE ; ABORT : ABORTTYPE ; BREAKSTATE : BREAKTYPE ; RetryCount : Integer ; (* Packet variables *) (* format *) (* Receive Send *) (* SOH *) InCount, OutCount : BYTE ; (* COUNT *) INSEQ, OUTSEQ : BYTE ; (* SEQNUM *) INPACKETTYPE, OUTPACKETTYPE : BYTE ; (* TYPE *) LENX1, (* extend lenght1 *) LENX2, (* extend Length2 *) HCHECK : BYTE ; (* checksum *) RecvData, SendData : PACKET ; (* DATA... *) CHECKSUM : INTEGER ; (* CHECKSUM *) CRC : INTEGER ; (* CRC *) InDataCount, OutDataCount : Integer ; (* dataCOUNT *) (* Initialization packet parameters *) StartChar,sMAXL : byte ; rPacketSize,sPacketSize : integer ; rTimeout,rNumPad,rPadChar,rEolChar,rCntrlQuote, sTimeout,sNumPad,sPadChar,sEolChar,sCntrlQuote, Bit8Quote,Checktype,RepChar, rCapas,sCapas,Windo,Maxlx1,Maxlx2 : Byte ; (* Functions and Procedures *) Function ReadChar(var char : byte): boolean; Function ReadMChar(var char : byte): boolean; PROCEDURE SENDPACKET ; FUNCTION RECVPACKET : BOOLEAN ; PROCEDURE RESENDIT ( RETRIES : INTEGER ) ; PROCEDURE SendPacketType (PacketType : char); PROCEDURE PutInitPacket ; PROCEDURE GetInitPacket ; Implementation (* ------------------------------------------------------------------ *) (* ReadChar - Read a character from the modem. *) (* Waits for a character to appear on the modem. *) (* It returns TRUE when the character is received and *) (* the value of the char is return in the parameter. *) (* It returns FALSE if the keyboard char is detected before *) (* a character is received or it times out. *) (* Side Effects : if the keys ^Z ^X ^C or ^E are pressed then *) (* BREAKSTATE is set to BZ, BX, BC, or BE respectively. *) (* Note : The ticker value may need to change if code is added to *) (* to this procedure or RecvChar or KeyChar. It is also *) (* machine dependent. *) (* ------------------------------------------------------------------ *) Function ReadChar(var char : byte): boolean; var waiting : boolean ; dummy : byte ; hh,mm,ss,ms,seconds : word ; Timer : integer ; Begin (* Read Char *) waiting := true ; timer := 0 ; While waiting Do Begin (* Wait for a Character *) If RecvChar(char) then Begin (* got char *) ReadChar := true ; waiting := false ; End (* got char *) else If KeyChar(char,dummy) then Begin (* key char *) ReadChar := false ; waiting := false ; if char = $03 then BREAKSTATE := BC ; if char = $05 then BREAKSTATE := BE ; if char = $18 then BREAKSTATE := BX ; if char = $1A then BREAKSTATE := BZ ; End (* key char *) else Begin (* Check for timeout *) GetTime(hh,mm,ss,ms); if timer = 0 then begin seconds := ss ; timer := 1 ; end else if ss <> seconds then begin timer := timer + 1 ; seconds := ss ; end ; if Timer > rTimeOut then Begin Waiting := false; ReadChar := False; End; End; (* Check for timeout *) End ; (* Wait for a Character *) End; (* Read Char *) (* ------------------------------------------------------------------ *) (* ReadMChar - Read a character from the modem. *) (* Waits for a character to appear on the modem. *) (* It returns TRUE when the character is received and *) (* the value of the char is return in the parameter. *) (* It returns FALSE if the it times out. *) (* Note : This is simular to ReadChar except it does not check the *) (* key board and the time out value is smaller. *) (* *) (* ------------------------------------------------------------------ *) Function ReadMChar(var char : byte): boolean; var waiting : boolean ; dummy : byte ; hh,mm,ss,ms,seconds : word ; Timer : integer ; Begin (* Read MChar *) waiting := true ; timer := 0 ; While waiting Do Begin (* Wait for a Character *) If RecvChar(char) then Begin (* got char *) ReadMChar := true ; waiting := false ; End (* got char *) else Begin (* Check for timeout *) GetTime(hh,mm,ss,ms); if timer = 0 then begin seconds := ss; timer := 1 ; end else if seconds <> ss then begin seconds := ss ; timer := timer + 1 ; end ; if Timer > 5 then Begin Waiting := false; ReadMChar := False; End; End; (* Check for timeout *) End ; (* Wait for a Character *) End; (* Read MChar *) (* ----------------------------------------------------------------- *) (* CRCheck - Procedure - generates a CCITT CRC using the polynominal *) (* X^16 + X^12 + X^5 + 1 *) (* Side Effects : Updates the global variable CRC which should be *) (* initialized to 0. It is call only once for each *) (* byte to be checked and all 8 bits are included. *) (* No terminating calls are necessary. *) (* ----------------------------------------------------------------- *) Procedure CRCheck ( Abyte : byte ) ; Var j,temp : integer ; Begin (* CRCheck *) For j := 0 to 7 do Begin (* check all 8 bits *) temp := CRC xor Abyte ; CRC := CRC shr 1 ; (* shift right *) If Odd(temp) then CRC := CRC xor $8408 ; abyte := abyte shr 1 ; End ; (* check all 8 bits *) End ; (* CRCheck *) (* =============================================================== *) (* SENDPACKET -This procedure sends the SendData packet . *) (* 1. The COUNT sent includes SEQ,PACKETTYPE,and CHECKSUM *) (* i.e. it is 3 larger than the OutCount or *) (* if CheckType = 2 or 3 then COUNT is 4 or 5 larger. *) (* 2. The COUNT and SEQ and CHECKSUM values are offset by *) (* 32 decimal (20hex) to make it a printable ASCII char.*) (* 3. The CHECKSUM are calculated on the ASCII value of *) (* the printable characters. *) (* *) (* Assumptions: *) (* The following Global variables must be correctly set *) (* before calling this procedure . *) (* 1. OutDataCount - an integer-byte count of data characters.*) (* 2. OUTSEQ - an integer-byte count of sequence number. *) (* 3. OUTPACKETTYPE - an character of type . *) (* 4. SendData - a character array of data to be sent. *) (* =============================================================== *) PROCEDURE SENDPACKET ; VAR I,SUM,Checkbytes : INTEGER ; achar : byte ; SOHecho : boolean ; BEGIN (* SENDPACKET procedure *) (* SOHecho := Not (LocalEcho or (NoEcho and WaitXon)) ; *) SOHecho := Not (LocalEcho or NoEcho) ; achar := 0 ; If WaitXon then While achar <> XON do if Readchar(achar) then else achar := xon ; WaitXon := XonXoff ; While RecvChar(achar) do ; (* throw away all previous incoming data *) Delay(50); SUM := 0 ; CRC := 0 ; Checkbytes := 1 ; If (OutPacketType = ord('S')) or (OutPacketType = ord('I')) or (InpacketType = ord('S')) or (InpacketType = ord('I')) or (InpacketType = ord('R')) then (* leave Checkbytes := 1 *) else If Checktype = ord('2') then Checkbytes := 2 else If Checktype = ord('3') then Checkbytes := 3 ; SendChar(StartChar) ; (* SOH *) If SOHecho then (* wait for SOH to be echoed back *) While achar <> StartChar do if Not Readchar(achar) then achar:=StartChar ; If OutDataCount > 94 then OutCount := 0 (* long packet format *) else OutCount := OutDataCount + 2 + Checkbytes ; SendChar(OutCount + $20) ; (* COUNT *) SUM := SUM + OutCount + $20 ; If CheckBytes = 3 then CRCheck(OutCount+$20) ; SendChar(OUTSEQ+$20) ; (* SEQ *) SUM := SUM + OUTSEQ + $20; If CheckBytes = 3 then CRCheck(OUTSEQ+$20); SendChar(OUTPACKETTYPE) ; (* TYPE *) SUM := SUM + ORD(OUTPACKETTYPE) ; If CheckBytes = 3 then CRCheck(Ord(OutpacketType)); If OutDataCount > 94 then (* long packet format *) Begin (* send LENX1 LENX2 and HCHECK *) LENX1 := Trunc((OutDataCount + Checkbytes ) / 95 ) ; SendChar(LENX1+$20) ; (* LENX1 *) SUM := SUM + LENX1+$20 ; If CheckBytes = 3 then CRCheck(LENX1+$20); LENX2 := (OutDataCount + Checkbytes ) Mod 95 ; SendChar(LENX2+$20) ; (* LENX2 *) SUM := SUM + LENX2+$20 ; If CheckBytes = 3 then CRCheck(LENX2+$20); HCHECK := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ; SendChar(HCHECK+$20); (* HCHECK *) SUM := SUM + HCHECK+$20 ; If CheckBytes = 3 then CRCheck(HCHECK+$20); End ; (* send LENX1 LENX2 and HCHECK *) IF OutDataCount > 0 THEN FOR I := 1 TO OutDataCount DO BEGIN (* Send Data *) SendChar(SendData[I]) ; (* DATA *) SUM := SUM + SendData[I] ; If Checkbytes = 3 then CRCheck(SendData[I]); END ; (* Send Data *) If Checkbytes = 1 then Begin (* one Checksum *) CHECKSUM := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ; SendChar(CHECKSUM+$20); (* CHECKSUM *) End (* one Checksum *) else If Checkbytes = 2 then Begin (* two Checksum *) Checksum := (Sum div $40) and $3F ; (* Bit 11 - 6 *) SendChar(Checksum+$20) ; Checksum := Sum and $3F ; (* Bit 5 - 0 *) SendChar(Checksum+$20) ; End (* two Checksum *) else If Checkbytes = 3 then Begin (* CRC *) SendChar((CRC shr 12 ) and $0F + $20) ; SendChar((CRC shr 6 ) and $3F + $20) ; SendChar((CRC ) and $3F + $20) ; End ; (* CRC *) SendChar(rEolChar); (* Cr *) If rNumPad > 0 then For I := 1 to rNumPad do SendChar(rPadChar); (* Padding *) END ; (* SENDPACKET procedure *) (* =============================================================== *) (* RECVPACKET -This Function returns TRUE if it successfully *) (* recieved a packet and FALSE if it had an error. *) (* Side Effects: *) (* The following global variables will be set. *) (* 1. InDataCount - an integer value of the msg char count. *) (* 2. INSEQ - an integer value of the sequence count. *) (* 3. TYPE - a character of message type (Y,N,D,F,etc) *) (* 4. RecvData - an array of data bytes to be sent. *) (* *) (* =============================================================== *) FUNCTION RECVPACKET : BOOLEAN ; VAR I,SUM,RESENDS : INTEGER ; INCHAR,Checkbytes : Byte ; dummy : Boolean ; LABEL EXIT ; BEGIN (* RECVPACKET procedure *) RECVPACKET := false ; (* assume false until proven otherwise *) If GotSOH then begin Inchar := StartChar; GotSOH := false; end else Inchar := $20 ; While Inchar <> StartChar Do If Readchar(Inchar) then (* SOH *) else goto exit ; SUM := 0 ; CRC := 0 ; If not ReadChar (InCount) then goto exit ; (* COUNT *) SUM := SUM + InCount ; If CheckBytes = 3 then CRCheck(InCount) ; InCount := InCount - $20 ; (* To absolute value *) if not ReadChar (INSEQ) then goto exit ; (* SEQ *) SUM := SUM + INSEQ ; If CheckBytes = 3 then CRCheck(INSEQ) ; INSEQ := INSEQ - $20 ; If not ReadChar (INPACKETTYPE ) then goto exit ; (* TYPE *) SUM := SUM + INPACKETTYPE ; If CheckBytes = 3 then CRCheck(InPacketType); Checkbytes := 1 ; If (OutPacketType = ord('S')) or (InpacketType = ord('S')) or (InpacketType = ord('R')) then (* leave Checkbytes := 1 *) else If Checktype = ord('2') then Checkbytes := 2 else If Checktype = ord('3') then Checkbytes := 3 ; If Incount = 0 then Begin (* Long Packet format *) If not ReadChar (LENX1) then goto exit ; SUM := SUM + LENX1 ; If CheckBytes = 3 then CRCheck(LENX1) ; LENX1 := LENX1 - $20 ; If not ReadChar (LENX2) then goto exit ; SUM := SUM + LENX2 ; If CheckBytes = 3 then CRCheck(LENX2) ; LENX2 := LENX2 - $20 ; CHECKSUM := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ; If ReadChar (HCHECK) then IF HCHECK <> CHECKSUM+$20 THEN RECVPACKET := FALSE ; SUM := SUM + HCHECK ; If Checkbytes = 3 then CRCheck(HCHECK) ; InDataCount := (95*LENX1) +LENX2 - CheckBytes ; End (* Long Packet format *) else InDataCount := InCount - 2 - CheckBytes ; IF InDataCount > 0 THEN FOR I := 1 TO InDataCount DO BEGIN (* Recv Data *) If ReadChar (RecvData[I]) then (* DATA *) Begin (* checksum and CRC *) SUM := (SUM and $0FFF) + RecvData[I] ; If CheckBytes = 3 then CRCheck(RecvData[I]); End (* checksum and CRC *) else goto exit ; END ; (* Revc Data *) RECVPACKET := True ; (* Assume Ok until check fails *) If Checkbytes = 1 then Begin (* one char Checksum *) CHECKSUM := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ; If ReadChar (INCHAR) then IF INCHAR <> CHECKSUM+$20 THEN RECVPACKET := FALSE ; End (* one char Checksum *) else If Checkbytes = 2 then Begin (* two char Checksum *) Checksum := (Sum div $40) and $3F ; If ReadChar(Inchar) then If Inchar <> Checksum+$20 then RECVPACKET := false ; Checksum := Sum and $3F ; If ReadChar(Inchar) then If Inchar <> Checksum+$20 then RECVPACKET := false ; End (* two char Checksum *) else If Checkbytes = 3 then Begin (* CRC char Checksum *) Checksum := (CRC shr 12) and $0F ; If ReadChar(Inchar) then (* If Inchar <> Checksum+$20 then Writeln('CRC1 ',Inchar,' ',checksum+$20); *) If Inchar <> Checksum+$20 then RECVPACKET := false ; Checksum := (CRC shr 6 ) and $3F ; If ReadChar(Inchar) then (* If Inchar <> Checksum+$20 then Writeln('CRC2 ',Inchar,' ',checksum+$20); *) If Inchar <> Checksum+$20 then RECVPACKET := false ; Checksum := (CRC ) and $3F ; If ReadChar(Inchar) then (* If Inchar <> Checksum+$20 then Writeln('CRC3 ',Inchar,' ',checksum+$20); *) If Inchar <> Checksum+$20 then RECVPACKET := false ; End; (* CRC char Checksum *) Exit: END ; (* RECVPACKET procedure *) (* =============================================================== *) (* RESENDIT - This procedure RESENDS the packet if it gets a nak *) (* It calls itself recursively upto the number of times *) (* specified in the intial parameter list. *) (* Side Effects - If it fails then the STATE in the message is set *) (* to 'A' which means ABORT . *) (* - Global variable RetryCount is incremented *) (* =============================================================== *) PROCEDURE RESENDIT ( RETRIES : INTEGER ) ; VAR I : INTEGER ; BEGIN (* RESENDIT procedure *) RetryCount := RetryCount + 1 ; GotoXY(10,5) ; Write(' Number of Retries = ',RetryCount,' '); IF RETRIES > 0 THEN BEGIN (* Try again *) SENDPACKET ; IF RECVPACKET THEN IF INPACKETTYPE = ord('Y') THEN ELSE IF INPACKETTYPE = ord('E') THEN Begin (* Error Packet *) Writeln(' ') ; Write(' Error Packet >>>> ') ; For I:=1 to InDataCount Do Write(Chr(RecvData[i])) ; STATE := A ; (* ABORT if not INIT packet *) Writeln(''); End (* Error Packet *) ELSE RESENDIT(RETRIES-1) ELSE RESENDIT(RETRIES-1) ; END (* Try again *) ELSE Begin writeln('retries exhausted '); STATE := A ; (* Retries failed - ABORT *) end ; END ; (* RESENDIT procedure *) (* ------------------------------------------------------------ *) (* SendPacketType - Procedure will send a packet of the *) (* type specified in the Character parameter. *) (* i.e. SendPacketType('Y') an ACK packet *) (* SendPacketType('N') an NAK packet *) (* ------------------------------------------------------------ *) PROCEDURE SendPacketType (PacketType : char); BEGIN (* SEND ACK or NAK or B or Z *) OutDataCount := 0 ; OUTSEQ := OUTSEQ + 1 ; IF OUTSEQ >= 64 THEN OUTSEQ := 0; OUTPACKETTYPE := Ord(PacketType) ; SENDPACKET ; END ; (* SEND ACK or NAK or B or Z *) (* ------------------------------------------------------------ *) PROCEDURE PutInitPacket ; Begin (* Put Parameters into Init Packet *) OutDataCount := 9 ; OUTSEQ := 0 ; (* The values are tranformed by adding hex 20 to *) (* the true value, making the value a printable char *) SendData[1] := sMAXL + $20 ; (* Buffsize *) SendData[2] := sTimeout + $20 ; (* Time out sec *) SendData[3] := sNumPad + $20 ; (* Num padchars *) SendData[4] := sPadChar + $20 ; (* Pad char *) SendData[5] := sEolChar + $20 ; (* EOL char *) SendData[6] := sCntrlQuote ; (* Quote character *) (* optional parameters follows *) SendData[7] := Bit8Quote ; (* Quote character *) SendData[8] := CheckType ; (* Check Type *) SendData[9] := RepChar ; (* Repeat Character *) SendData[10]:= sCapas + $20 ; (* Capability field *) If Bit8Quote <= $20 then SendData[7] := ord('Y') ; If CheckType <= $20 then SendData[8] := ord('1') ; If RepChar <= $20 then OutDataCount := 8 ; If ((sCapas and $02) = $02) and (sPacketSize > 94) then Begin (* long Packet init *) SendData[11] := Windo + $20 ; (* Window Size *) SendData[12] := Trunc(sPacketsize/95) + $20 ; (* MAXLX1 *) SendData[13] := (sPacketSize mod 95 ) + $20 ; (* MAXLX2 *) OutDataCount := 13 ; End ; (* long packet init *) End ; (* Put Parameters into Init Packet *) (* ------------------------------------------------------------ *) PROCEDURE GetInitPacket ; Begin (* Get init parameters *) IF InDataCount >= 1 then rPacketSize := RecvData[1]-$20 ; IF InDataCount >= 2 then rTimeOut := RecvData[2]-$20 ; IF InDataCount >= 3 then rNumPad := RecvData[3]-$20 ; IF InDataCount >= 4 then rPadChar := RecvData[4]-$20 ; IF InDataCount >= 5 then rEolChar := (* RecvData[5]-$20 ; *) RecvData[5] and $1F ; IF InDataCount >= 6 then rCntrlQuote := RecvData[6] ; (* optional parameters *) IF InDataCount >= 7 then Begin (* Validate bit8Quote *) If RecvData[7] = ord('Y') then Bit8Quote := Ord('&') else If Chr(RecvData[7]) in ['!'..'?','`'..'~'] then Bit8Quote := RecvData[7] else Bit8Quote := $20 ; End (* Validate bit8Quote *) else Bit8Quote := $20 ; IF (InDataCount >= 8) and (chr(RecvData[8]) in ['1','2','3'] ) then CheckType := RecvData[8] else CheckType := ord('1') ; IF InDataCount >= 9 then If chr(RecvData[9]) in ['!'..'?','`'..'~'] then RepChar := RecvData[9] else RepChar := $20 else RepChar := $20 ; IF InDataCount >= 10 then rCapas := RecvData[10] - $20 else rCapas := 0 ; If InDataCount >= 11 then Windo := RecvData[11] - $20 else Windo := 0 ; If (rCapas and $02) = $02 then (* long blocks *) If InDataCount >= 13 then rPacketsize := (RecvData[12]-$20)*95 + (RecvData[13]-$20) else rPacketsize := 500 ; End ; (* Get init parameters *) (* ------------------------------------------------------------ *) Begin (* Unit Packets *) StartChar := 01 ; (* Start of Packet char - SOH *) (* Default receive Packet settings *) rPacketSize := 94 ; (* PACKET size 94 maximum *) rTimeout := 60 ; (* Time out in seconds *) rNumPad := 00 ; (* Number of Pad characters *) rPadChar := 00 ; (* Padding Character *) rEolChar := 13 ; (* End of line char - CR *) rCntrlQuote := 35 ; (* # *) (* Default send Packet settings *) sMAXL := 94 ; (* Packet size 94 maximum - no long packets *) sPacketSize := 94 ; (* PACKET size up to MaxPacketsize *) sTimeout := 60 ; (* Time out in seconds *) sNumPad := 00 ; (* Number of Pad characters *) sPadChar := 00 ; (* Padding Character *) sEolChar := 13 ; (* End of line char - CR *) sCntrlQuote := 35 ; (* # *) Bit8Quote := $26 ; (* & *) CheckType := $31 ; (* 1 *) RepChar := $7E ; (* ~ *) sCapas := $02 ; (* long packets *) Windo := $00 ; (* window size *) End. (* Unit Packets *)