Columbia Kermit/kermit.zip/norskdata/ndkuti.pas

Pascal/Delphi Source File | 2020-01-01 | 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 *)