home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
queenskermit.tar.gz
/
queenskermit.tar
/
packets.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-12-14
|
25KB
|
541 lines
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 *)