Columbia Kermit/kermit.zip/c/pq2glo.pas

Pascal/Delphi Source File | 2020-01-01 | 15.8 KB | 525 lines

Module KermitGlobals;

{ This module contains global protocol definitions (packet types, generic
{ command codes, protocol states), character conversion functions,
{ error handling and some other global definitions. }

{===============================} Exports {===================================}

Imports Perq_String from Perq_String;

CONST

    KermitMessage = 'NTH Kermit for 3RC/ICL Perq - V2.2';
    AbortedByCtlC = 'Transfer aborted by control C';

    GCLogin     = 'I';      { Generic commands }
    GCConnect   = 'C';
    GCLogout    = 'L';
    GCFinish    = 'F';
    GCDirectory = 'D';
    GCDiskUsage = 'U';
    GCErase     = 'E';
    GCTypeFile  = 'T';
    GCSubmit    = 'S';
    GCPrint     = 'P';
    GCWhoIsOn   = 'W';
    GCSendMess  = 'M';
    GCHelp      = 'H';
    GCStatusQ   = 'Q';

    OldFile     =  FALSE;
    NewFile     =  TRUE;

    NULL        =  chr(0);
    CR          =  chr(13);
    LF          =  chr(10);
    FF          =  chr(12);
    BS          =  chr(8);
    CtlZ        =  chr( ord('Z') mod #40 );
    ESC         =  chr( ord('[') mod #40 );
    Xon         =  chr( ord('Q') mod #40 );
    Xoff        =  chr( ord('S') mod #40 );
    BreakKey    =  chr(255);

    MaxString   =   100;

    ProgressLines=5;

TYPE
    KermitStates=   (   FileData,
                        Init,
                        Break,
                        FileHeader,
                        RemoteReply,
                        EOFile,
                        Complete,
                        Abort1,
                        AbortCtlC,
                        AbortAll );

    StringType      =   array [ 1 .. MaxString ] of char;

    FNameType       =   PString;

    PacketType  =   (   DataPack,
                        ACKPack,
                        NAKPack,
                        SinitPack,
                        BrkPack,
                        FHeadPack,
                        EOFPack,
                        ErrPack,
                        RinitPack,
                        CommPack,
                        GCommPack,
                        THeadPack,
                        NoChangePack,   { for internal use }
                        TimOutPack,     {     -  "  -      }
                        IllPack,        {     -  "  -      }
                        ChkIllPack);    {     -  "  -      }

    Packet      =   record
                        mark    :   char;   { SOH character }
                        count   :   char;   { # bytes following this field }
                        seq     :   char;   { sequence number mod 64 }
                        ptype   :   char;   { packet-type }
                        data    :   String[MaxString]; { the data }
                        { checksum is last of data }
                    end;

VAR

{ Protocol state variables }

    N,NN                    : Integer;      { Current packet seq. number }
    OldTry,NumTry,TotTry    : Integer;      { Packet retry counts  }
    CurrState               : KermitStates; { the current state of Kermit }

    LastNAK                 : Integer;      { if previous packet was NAK:
                                              Seq.no of last NAK, else -1 }

    function    ToChar ( ch : char ): char;
    function    UnChar ( ch : char ): char;
    function    Ctl ( ch : char ): char;
    function    MakeCheck ( chksum : integer ): char;
    function    Prev ( n : integer ):integer;

    function    PackToCh ( pType : PacketType ): char;

    function    ChToPack( ch : char ): PacketType;

    procedure   Succeeded;
    procedure   SendACK ( num : integer );
    procedure   SendBrk;
    procedure   SendNAK ( num : integer );
    procedure   SendErrPack( Mess : String );
    procedure   TreatErrPack( VAR EPack : Packet; Num : integer );

    procedure   LocalError( EMess : PString );

    function SendGComm( Cmd : char;  CmdParam    : String ) : boolean;

    procedure   DbgNL;
    procedure   DbgInt        (     n       : integer );
    procedure   DbgChar       (     ch      : char );
    procedure   DbgWrite      (     Str     : String );
    procedure   DbgState      (     S       : KermitStates );
    procedure   DbgPacket     (     Pack    : Packet );
    procedure   DbgShowPacket ( VAR Pack    : Packet);
    procedure   DbgFileName   ( VAR FileN   : FNameType );

Imports KermitScreen from KermitScreen;

{==========================} private  {=======================================}

Imports Perq_String from Perq_String;
imports KermitLineIO from KermitLineIO;
imports KermitParameters from KermitParameters;
imports KermitRead from KermitRead;

{-----------------------------------------------------------------------------}
{==================== Kermit basic operations ================================}
{-----------------------------------------------------------------------------}

function    ToChar ( ch : char ): char;
begin
    { make sure not a control character }
    ToChar := chr( ord ( ch ) + ord ( ' ' ) );
end;

{-----------------------------------------------------------------------------}

function    UnChar ( ch : char ): char;
begin
    { undoes ToChar }
    UnChar := chr ( ord ( ch ) - ord ( ' ' ) );
end;

{-----------------------------------------------------------------------------}

function    Ctl ( ch : char ): char;
begin
    { toggle control bit }
    Ctl := chr( lxor ( ord( ch ), 64 ) );
end;

{-----------------------------------------------------------------------------}

function    MakeCheck ( chksum : integer ): char;
begin
    MakeCheck := ToChar (
                          chr (
                                ( chksum +
                                Land ( chksum , 192 ) div 64 )
                                      mod 64
                              )
                        );
end;

{-----------------------------------------------------------------------------}


function Prev ( n : integer ):integer;
begin
    if n = 0 then
        Prev := 63
    else
        Prev := n - 1;
end;

{-----------------------------------------------------------------------------}


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';
        RinitPack   :   RetVal := 'R';
        CommPack    :   RetVal := 'C';
        GCommPack   :   RetVal := 'G';
        THeadPack   :   RetVal := 'X';
        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;
            'R' :   ChToPack := RinitPack;
            'C' :   ChToPack := CommPack;
            'G' :   ChToPack := GCommPack;
            'X' :   ChToPack := THeadPack;
        end;
    end;
end;


{-----------------------------------------------------------------------------}
{===================== Debugging output routines =============================}
{-----------------------------------------------------------------------------}


{ Perq Kermit is always Local, so use standard output for debug info }
procedure   DbgNL;
{  Globals     :   Debug   ( read )
    SideEffects :   Finishes current line on debug-file
}
begin
    if Debug then writeln;
end;

{-----------------------------------------------------------------------------}

procedure   DbgInt( n : integer );
{  Globals     :   Debug ( read )
    SideEffects :   Writes an integer on DbgOut with default field width
}
begin
    if Debug then write( n );
end;

{-----------------------------------------------------------------------------}

procedure PrintChar( ch : char );
begin
    if ch IN [' '..'~'] then
        write( ch )
    else
        if ch='/' then
            write( '//' )
        else
            write( '/', ord( ch ):3:-8, '/' );
end;

{-----------------------------------------------------------------------------}

procedure   DbgChar( ch : char );
{  Globals     :   Debug ( read )
    SideEffects :   Outputs a character on DbgOut.
}
begin
    if Debug then
        PrintChar(ch);
end;

{-----------------------------------------------------------------------------}

procedure   DbgWrite( Str : String );
{  Abstract    :   Outputs a string to Debug-file.
    Globals     :   Debug   ( read )
    SideEffects :   Writes a string on DbgOut
    Input Params:   Str - String to be written
}
var     i : integer;
begin
    if Debug then
        for i := 1 to Length( Str ) do
            PrintChar( Str[i] );
end;

{-----------------------------------------------------------------------------}

procedure   DbgState( S : KermitStates );
begin
    if Debug then
        case S of
            FileData    :   Write( 'FileData   ');
            Init        :   Write( 'Init       ');
            Break       :   Write( 'Break      ');
            FileHeader  :   Write( 'FileHeader ');
            RemoteReply :   Write( 'RemoteReply');
            EOFile      :   Write( 'EOFile     ');
            Complete    :   Write( 'Complete   ');
            Abort1      :   Write( 'Abort1     ');
            AbortCtlC   :   Write( 'AbortCtlC  ');
            AbortAll    :   Write( 'AbortAll   ');
        end;
end;

{-----------------------------------------------------------------------------}

procedure   DbgPacket ( Pack : Packet );
{  Abstract    :   Outputs a packet on debug-file.
                    Does a Writeln on debug-file.
    Globals     :   Debug   ( read )
    InputParams :   Pack  - Packet to be written on DbgOut.
    SideEffects :   Outputs packet and "NewLine" to DbgOut.
    Uses        :   UnChar
}
var     i : integer;
begin
    if Debug then
    begin
        with Pack do
        if PType IN LegalPackets then
        begin
            write( 'Packet: ' );
            PrintChar( count );
            PrintChar( seq );
            PrintChar( pType );
            if count < ' ' then
                write( '/////// Bad count field in packet! //////' )
            else
                for i := 1 to ord( UnChar ( count ) ) - 2 do
                    PrintChar( Data[i] );
        end else
        begin
            write( ' DbgPacket: Invalid packet type ');
        end;
        writeln;
    end;
end;

{-----------------------------------------------------------------------------}

procedure   DbgFileName(VAR FileN:FNameType );
begin
    if Debug then
        write( FileN );
end;

{-----------------------------------------------------------------------------}

procedure DbgShowPacket(VAR Pack:Packet);
{  Abstract        :   Writes a packet to the Debug file
                        as DbgPacket, but in greater detail }

var     i,packlen : integer;
begin
    if Debug then
    with Pack do begin
        write( 'DbgShowPacket: ' );
        if not ( Mark in [ SendSOH, RecSOH ] ) then begin
            writeln( ' *** Bad StartOfHeader character: / ',
                ord(Mark):3:-8,'/'  );
        end;
        write( '  Seq =' );
        if seq<' ' then
            write( ' BAD' )
        else
            write( ord(UnChar(seq)):4:8 );
        if count<' ' then
            writeln( '  *** Bad Packet Lenght *** ')
        else begin
            PackLen := ord( UnChar(count) );
            write( '  Count = ',PackLen:3 );
            write( '  PType = ');
            PrintChar( PType );
            Writeln;
            if PackLen>MaxString - 2 then PackLen := MaxString - 2;
            for i:=1 to PackLen-2 do
                PrintChar( data[i] );
            writeln;
        end;
    end { with };
end;

{-----------------------------------------------------------------------------}
{======================= Packet utilities ====================================}
{-----------------------------------------------------------------------------}

procedure SendACK( num : integer );
VAR dummy : Packet;
begin
    SendPacket( ACKPack,
                num,
                0,
                dummy );
end;

{-----------------------------------------------------------------------------}

procedure SendNAK( num : integer );
VAR dummy : Packet;
begin
    SendPacket( NAKPack,
                num,
                0,
                dummy );
end;

{-----------------------------------------------------------------------------}

procedure SendBrk;
VAR dummy : Packet;
begin
    SendPacket( BrkPack,
                0,
                0,
                dummy );
end;

{-----------------------------------------------------------------------------}

procedure Succeeded;
{ -- Update sequence number, a packet has been received OK }
begin
    OldTry := NumTry;           { Number of retries for previous packet }
    NumTry := 0;                { Number of retries for next packet }
    n :=  ( n + 1 ) mod 64;     { Update packet sequence number (mod 64) }
    nn := nn + 1;               { Total packet count }
end;

{-----------------------------------------------------------------------------}
{======================== Error handling =====================================}
{-----------------------------------------------------------------------------}

procedure LocalError( EMess : PString );
var OldWin : WinType;
{ For use when fatal error:
{   Write an error message to the screen, and send an error packet to remote }
begin
    CurrentWindow( OldWin );
    SwitchWindow( MainWindow );
    SendErrPack( EMess );
    writeln( EMess );
    SwitchWindow( OldWin );
end;

{-----------------------------------------------------------------------------}

procedure TreatErrPack( VAR Epack : Packet; Num : integer );
VAR EMess       : PString;
    OldWin      : WinType;
begin
    SendAck( Num );   { Ack the error packet anyway }
    CurrentWindow( OldWin );
    SwitchWindow( TermWindow );   { Or main window ? }
    writeln;
       { Error packet should step packet seq. numbers forward?? }
    if  (( (N+1) MOD 64 )<>Num ) and Debug then
        writeln( 'Bad number field in error packet!' );

    EMess := Substr( Epack.data, 1, length( Epack.data )-1 );
    writeln( EMess );
    SwitchWindow( OldWin );
end;

{-----------------------------------------------------------------------------}

procedure   SendErrPack( Mess : String );
Var EPack : Packet;
begin
    EPack.Data := Mess;
    SendPacket( ErrPack, N, Length( Mess ), EPack );
        { Should one wait for ACK or not?? }
end;

{-----------------------------------------------------------------------------}
{===================== Generic and host commands =============================}
{-----------------------------------------------------------------------------}

function SendGComm( Cmd : char;  CmdParam : String ) : boolean;

VAR LPack, RPack    : Packet;
    Num, Len, Size  : integer;
    PackType        : PacketType;
    CmdS            : String[1];
begin
    FlushBuffer( Idev );     { don't let us be led astray by pending ACK's }
    Adjust( CmdS, 1 );
    CmdS[1] := Cmd;
    LPack.data := Concat( CmdS, CmdParam );
    Size := Length( CmdParam ) + 1;

    NumTry := 0;
    SendPacket( GCommPack, 0, Size, LPack );    { Send command }
    CurrState := RemoteReply;
    SendGComm := Complete = ReadSwitch;         { Read reply }

end.