home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
norskdata.tar.gz
/
norskdata.tar
/
ndkuti.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-06-24
|
27KB
|
691 lines
(* 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 *)