Columbia Kermit/kermit.zip/perqb/pq2fil.pas

Pascal/Delphi Source File | 2020-01-01 | 36KB | 1,082 lines

module KermitFile;


{ Abstract:
{   This module implements a 'KermitFile' abstract datatype.
{
{   A 'KermitFile' consists of two sets of files, with one-to-one
{   mapping between the two.  The sets of files and the
{   mapping are defined by two patterns, SourcePat and DestPat.
{   SourcePat defines the name space of the source files (all files
{   on local or remote machine that matches the pattern).  DestPat then
{   gives the translation into the name space of the destination files.
{
{   The routines SetReadFile and SetWriteFile defines the name spaces,
{   when the source file is on the Perq and on the remote machine,
{   respectively.  Then NextReadFile and NextWriteFile will step
{   through all files in the name spaces.
{
{   When reading, FillBuffer will read one data packet from the file.
{   At end-of-file, a EOF (Z) packet will be generated instead of a
{   data packet.  EndFile may always be called to test for an end-of-file
{   condition.  No special termination will need to be done when a
{   entire file group is transferred, calling NextReadFile iteratively
{   until it returns FALSE (no next file).
{
{   When writing, EmptyBuffer will write one data packet to the file.
{   To keep the file, call KeepFile after all data has been written;
{   otherwise DiscardFile may be called at any time.  In that case,
{   all file operations after the last NextWriteFile will be undone.
{
{   If unsure of the state, FileIdle will always reset the module to the
{   idle state.
{
{============================} EXPORTS {======================================}

    imports KermitGlobals from KermitGlobals;

CONST
    TempName = '$Kermit$Temp$';

TYPE
    Byte8        =   0..255;

    Byte8File    =   packed file of Byte8;

    FileErrs   =   (    { Fatal errors - aborts one file  }
                          { or the whole batch }

                       FReadErr,    { Disk read error }
                       FWriteErr,   { Disk write error }
                       FNoSpace,    { No more space to write file into }
                       FNoReadPriv, { Not read access to file }
                       FNoWritePriv,{ Not write access to file }
                       FCantOpen,   { Cannot open file }
                       FNotRenamed, { Could not rename }
                       FNoFile,     { No file of this name }
                       FBadNames,   { Bad filenames or wildcard matching }
                       FInternalErr,{ Internal error (program logic) }

                       FNoError,    { Idle code }

                          { Informational }
                       FRenamed,    { Renamed files when FileWarning on }
                       FEndDir,     { No more matching files when wildcards }
                       FAtEof);     { File is already at EOF }

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


{ -- File Open/Close routines: (Pascal files)
    These routines are not to be used for the transferred files }

    function OpenRead (     VAR ReadFile    :   Byte8File ;
                            VAR FileName    :   FNameType ) : FileErrs;

    function OpenWrite (    VAR WriteFile   :   Byte8File ;
                            VAR FileName    :   FNameType ) : FileErrs;

    function CloseFile(     VAR FileToClose : Byte8File ) : FileErrs;

{ -- Filename manipulation routines }

    procedure ParseArgs( VAR Args, Arg1, Arg2 : String );

    procedure ReadFName   ( Var FileName    :   FNameType   );

    procedure PutFileName ( VAR FileN       :   FNameType;
                            VAR Pack        :   Packet      );

    procedure GetFileName ( VAR FileN       :   FNameType;
                            VAR Pack        :   Packet      );

{ -- KermitFile manipulation }

    function SetReadFile( VAR SourcePat, DestPat : String ) : FileErrs;

    function NextReadFile( VAR FileName : String ) : FileErrs;

    function EndFile : Boolean;

    function SetWriteFile( VAR SourcePat, DestPat : String ) : FileErrs;

    function NextWriteFile( VAR FileName : String ) : FileErrs;

    procedure WriteScreen;

    function FillBuffer ( Var Data : Packet ) : FileErrs;

    function EmptyBuffer( Var Data : Packet ) : FileErrs;

    function FileIdle : FileErrs;

    function DiscardFile : FileErrs;

    function KeepFile : FileErrs;

    procedure FileAbort;

{ -- Error message generator }

    procedure  FileError (       FileName : FNameType;
                                 ErrCode  : FileErrs;
                             Var Message  : String );

    procedure InitFile;

{============================} PRIVATE {======================================}

    imports KermitParameters from KermitParameters;
    imports FileSystem from FileSystem;
    imports FileUtils from FileUtils;
    imports CmdParse from CmdParse;
    imports Perq_String from Perq_String;
    imports PMatch from PMatch;
    imports Stream from Stream;

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

CONST

    NoFile      = '?No such file to open: ';
    NoSetRead   = '?Internal error: NextReadFile without SetReadFile';
    NoSetWrite  = '?Internal error: NextWriteFile without SetWriteFile';
    NotReading  = '?Internal error: FillBuffer when not reading';
    NotWriting  = '?Internal error: EmptyBuffer when not writing';

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

TYPE

    ModuleState = ( Idling, Writing, WritingScreen, Reading );

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

VAR
    RemoteFName, LocalFName : FNameType;  { Rem. & loc. names of current file }

    SourcePat, DestPat :  String; { Matching patterns of file names }
    ScanPtr     :   ptrScanRecord;
    DataFile    :   Byte8File;    { File to receive to/send from }
    FileIsOpen  :   Boolean;      { True if DataFile is open }
    FileState   :   ModuleState;  { What we're doing now }
    FileNoPatt  :   Boolean;      { Wildcard filename }

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

procedure InitFile;
begin
    FileIsOpen := FALSE;
    FileState := Idling;
end;

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

procedure ConvLower( VAR S : PString );
var i : integer;
begin
    for i := 1 to length( s ) do
        if S[i] in ['a'..'z'] then
            S[i] := chr( Ord(S[i]) - (ord('a')-ord('A')) );
end;

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

function ReleaseFName( VAR FileName : FNameType ) : FileErrs;
{ -- Assumes a file of name FileName exists.  Free this name by
        renaming existing files.  }
var Renamed : FNameType;
    B1, B2  : Integer;
    Dummy   : FileErrs;
begin
    Renamed := FileName;
    AppendChar( Renamed, '$' );
    if 0<>FSLocalLookUp( Renamed, B1, B2 ) then
        Dummy := ReleaseFName( Renamed );
    FSRename( FileName, Renamed );
    ReleaseFName := FRenamed;
end;

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

procedure ReadFName(    Var FileName    :   FNameType );
{  Abstract :  Reads filename from terminal (standard input).
                Skips blanks before filename.
                Skips over rest of line until EOLN.
                No check of correct syntax is at present
                performed.  }
var first : char;
    Fstr  : string[1];
begin
    read( first );  { read at least one character }
    while (not EOLN) and (first=' ') do
        read( first );
    read( FileName );
    adjust( Fstr, 1);
    FStr[1] := first;
    if first<>' ' then
        FileName := Concat( FStr, FileName );
end;

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

function OpenRead (     VAR ReadFile    :   Byte8File ;
                        VAR FileName    :   FNameType ) : FileErrs;
{ Abstract : Opens ReadFile for Read
              Does a RESET of the file

              Returns FNoError if Open was successful,
                   i.e. file existed and read access of file was granted.
              Returns FNoFile if file did not exist.
 }

var     Ostat   : FileErrs;
        B1,B2   : integer;
begin
    if 0=FSLookUp( FileName, B1, B2 ) then
       Ostat := FNoFile
    else begin
        Ostat := FNoError;
        reset( ReadFile, FileName );
    end;
    OpenRead := Ostat;
end;

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

function OpenWrite (    VAR WriteFile   :   Byte8File ;
                        VAR FileName    :   FNameType ) : FileErrs;
{ Abstract:  Opens WriteFile for Write
              Does a REWRITE of the file
              Returns  FNoFile: If Open was NOT successful.
                       FNoError: If Open was immediately successful, i.e.
                         new file or write access granted to existing
                         file, provided FileWarning OFF.
                       FRenamed: If Open was successful after renaming files,
                         i.e. Kermit was able to create the new file       }

const   MaxTries = 5;

var     B1, B2    : integer;

begin
    if NOT FileWarning then begin  { don't worry about existing file }
        rewrite( WriteFile, FileName );
        OpenWrite := FNoError;

    end else    { we have to check if file already exists }
        if 0 = FSLocalLookUp( FileName, B1, B2 ) then begin
            rewrite( WriteFile, FileName );
            OpenWrite := FNoError;
        end
        else begin
            if ReleaseFName( FileName )=FRenamed then begin
                Rewrite( WriteFile, Filename );
                OpenWrite := FRenamed;
            end else
                OpenWrite := FNoWritePriv;
        end;
end;

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


function CloseFile( VAR FileToClose     : Byte8File ) : FileErrs;
{  Abstract:   Do any actions necessary when closing file }
begin
    Close( FileToClose );
    CloseFile := FNoError;
end;

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

function KeepFile : FileErrs;
{ -- Close a file after writing, keep file }
var B1, B2 : Integer;
    OldWin : WinType;
    RetCode: FileErrs;

    handler RenToExist( FileName : PathName );
    begin
        raise RenError( 'Attempted rename to existing name:', FileName );
    end;

    handler RenError( Msg : String; FileName : PathName );
    begin
        writeln( '**', Msg, FileName );
        FileAbort;
        KeepFile := FNotRenamed;
        Exit( KeepFile );
    end;

begin
    CurrentWindow( OldWin );
    SwitchWindow( MainWindow );
    RetCode := FNoError;

    if (FileState=Writing) and FileIsOpen then begin
        Close( DataFile );

        if 0 <> FSLocalLookUp( LocalFName, B1, B2 ) then
            if FileWarning then
                RetCode := ReleaseFName( LocalFName )
            else
                FSDelete( LocalFName );

        FSRename( TempName, LocalFName );
        writeln( 'Completed:     ', RemoteFName, ' --> ', LocalFName );

        FileIsOpen := FALSE;
    end;

    SwitchWindow( OldWin );
    KeepFile := RetCode;
end;

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

function DiscardFile : FileErrs;
{ -- Close a file after writing, discard file }
VAR OldWin : WinType;
begin
    CurrentWindow( OldWin );
    SwitchWindow( MainWindow );
    DiscardFile := FNoError;

    if (FileState=Writing) and FileIsOpen then begin
        Close( DataFile );
        FSDelete( TempName );
        FileIsOpen := FALSE;
        writeln( '**Discarded**: ', RemoteFName, ' --> ', LocalFName );
    end;

    SwitchWindow( OldWin );
end;

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

procedure FileAbort;
VAR OldWin : WinType;
begin
    CurrentWindow( OldWin );
    SwitchWindow( MainWindow );
    write( '**Aborted**:   ' );
    if Reading=FileState then begin
        writeln( LocalFName, ' --> ', RemoteFName );
    end else if Writing=FileState then begin
        writeln( RemoteFName, ' --> ', LocalFName );
    end;
    SwitchWindow( OldWin );
end;

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

procedure CloseReading;
var OldWin : WinType;
begin
    if EOF(DataFile) then begin
        CurrentWindow( OldWin );
        SwitchWindow( MainWindow );
        writeln( 'Completed:     ', LocalFName,
                             ' --> ', RemoteFName );
        SwitchWindow( OldWin );
    end else
        FileAbort;
    Close( DataFile );
end;    { CloseReading }

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

function CheckPatterns( VAR S, D : String ) : FileErrs;
{ -- Verify that patterns S and D are valid }
VAR InS, OutS       : String;
    Dummy           : Boolean;

    handler BadPatterns;
    begin
        CheckPatterns := FBadNames;
        exit( CheckPatterns );
    end;

begin

    InS := '';
    OutS := '';
    CheckPatterns := FNoError;
    if IsPattern( S ) then begin
        FileNoPatt := FALSE;
        dummy := PattMap ( InS, S, D, OutS, Translate=TransUpper );
    end else
        FileNoPatt := TRUE;
end;

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

procedure ParseArgs( VAR Args, Arg1, Arg2 : String );
var DelPos : integer;

    procedure LeadingBlanks( VAR Arg : String );
    var i, l : integer;
    begin
        i := 1;
        L := Length(Arg);
        if L<>0 then
            while (Arg[i]=' ') and (i<L) do i := i+1;

        if i>=L then   { All spaces }
            Arg := ''
        else begin
            if Arg[i]<>' ' then
               i := i-1;
            Delete( Arg, 1, i );
        end;
    end;

begin
    LeadingBlanks( Args );
    DelPos := PosC( Args, ' ');
    if DelPos=0 then
        DelPos := PosC( Args, ',' );

    if DelPos=0 then begin
        Arg1 := Args;
        Arg2 := '';
    end else begin
        Arg1 := SubStr( Args, 1, DelPos -1 );

        Delete( Args, 1, DelPos );
        LeadingBlanks( Args );
        DelPos := PosC( Args, ' ' );
        if DelPos = 0 then
            DelPos := PosC( Args, ',' );
        if DelPos <> 0 then
            Args := SubStr( Args, 1, DelPos -1 );
        Arg2 := Args;
    end;
end;

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

function SetPatterns( VAR S, D : String ) : FileErrs;
{ -- Set the module local pattern names }
begin
    if (S='') and (D='') then begin
        SourcePat := '';
        DestPat := '';
    end else begin
        if S = '' then
            SourcePat := D
        else
            SourcePat := S;

        if D = '' then
            DestPat := S
        else
            DestPat := D;
    end;

    SetPatterns := CheckPatterns( SourcePat, DestPat );
end;

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

function SetReadFile( VAR SourcePat, DestPat : String ) : FileErrs;
{ -- Setup for read of multiple files.  S contains Perq filename  }
{    to match, D is name to transmit file under.                  }
var Dummy : FileErrs;
begin
    if FileIsOpen then
        Dummy := FileIdle;

    SetReadFile := SetPatterns( SourcePat, DestPat );

    new( ScanPtr );
    ScanPtr^.InitialCall := TRUE;
    ScanPtr^.DirName := FSDirPrefix;

    FileState := Reading;
    FileIsOpen := False;
end;

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

procedure ConvExt( VAR FileN : String );
{  Abstract: Converts a filename to external form }
var  FD, LD, PD, TI, L, T : Integer;
begin
        { Pathname is always stripped }
    L := RevPosC( FileN, '>' );
    if (Length( FileN )-L) > MaxString then
        Adjust( FileN, MaxString+L );
    FileN := SubStr( FileN, L+1, Length( FileN )-L );

    if Nord then begin                  { Apply NORD transformation }

        LD := RevPosC( FileN, '.' );    { find last dot of file name  }
        FD := PosC   ( FileN, '.' );    { find first dot of file name }
        while LD<>FD do begin           { substitute until last dot   }
            FileN[FD] := '-';           { if no dots: LD=FD=0         }
            FD := PosC( FileN, '.' );   { find next dot               }
        end;

    end else

        if NumTrunc>0 then begin            { Do TRUNCATE transformation  }
            LD := RevPosC( FileN, '.' );

            if (LD=0) or (NumTrunc=1) then  { ONE part, truncate according}
            begin                           { to first entry of list      }
                T := TruncList[1];
                if Length(FileN) < T then   { See where to chop off name: }
                    T := Length(FileN);     { Minimum of length, trunc    }
                if LD<>0 then begin         { and position of dot         }
                    FD := PosC(FileN,'.')-1;{ Guaranteed to find a dot    }
                    if FD<T then
                        T := FD;
                end;
                Adjust( FileN, T );
            end else begin

                L := Length( FileN )-LD;        { length of last part }
                if L>TruncList[NumTrunc] then   { truncate last part  }
                    Delete( FileN, LD+TruncList[NumTrunc]+1,
                                   L-TruncList[NumTrunc] );

                TI := 1;
                PD := 0;
                FD := PosC( FileN, '.' );   { where does next part end??  }

                while (FD<>0) do begin      { Move it until no next part  }

                    if TI>=NumTrunc then    { Part with no matching entry }
                        T := -1             { Delete everything, dot too  }
                    else
                        T := TruncList[TI]; { Keep as much as list tell   }

                    TI := TI + 1;
                    L := FD-PD-1-T;         { Num. chars to delete        }

                    if L>0 then begin
                        Delete( FileN, PD+T+2, L );
                        LD := LD - L;       { Last dot has been moved     }
                        PD := FD - L;       { So has the delimiting one - }
                    end else
                        PD := FD;

                    FileN[PD] := '>';       { don't find it again         }
                    FD := PosC( FileN, '.' );
                end;

                FD := PosC( FileN, '>' );
                while FD<>0 do begin        { Restore dots }
                    FileN[FD] := '.';
                    FD := PosC( FileN, '>' );
                end;

            end;  { Two parts }
        end;    { TRUNCATE }

    if Nord or (Translate=TransUpper) then
        ConvUpper( FileN )
    else if (Translate=TransLower) then
        ConvLower( FileN );

end;

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

function NextReadFile( VAR FileName : String ) : FileErrs;
{ -- Open next file }
var id                  : FileId;
    NewFile, Matched    : Boolean;
    B1, B2              : integer;

    handler ResetError( FName : PathName );
    begin
        NextReadFile := FCantOpen;
        FileName := FName;
        exit( NextReadFile );
    end;

begin
    if FileState<>Reading then begin
        NextReadFile := FInternalErr;
        Writeln( NoSetRead );
    end else begin

        if FileNoPatt then begin
            if not FileIsOpen then begin   { First time }
                LocalFName := SourcePat;
                NewFile := 0 <> FSLocalLookUp( SourcePat, B1, B2 );
                Matched := True;
                if Not NewFile then begin
                    NextReadFile := FNoFile;
                end else begin
                    NextReadFile := FNoError;
                    if DestPat<>'' then
                        RemoteFName := DestPat
                    else
                        RemoteFName := SourcePat;
                end;
            end else begin
                NextReadFile := FEndDir;
                NewFile := False;
                CloseReading;
                FileIsOpen := False;
            end;

        end else begin

            if FileIsOpen then
                CloseReading;

            repeat
                NewFile := FSScan( ScanPtr, LocalFName, ID );
                if NewFile then
                    Matched :=
                        PattMap( LocalFName, SourcePat, DestPat, RemoteFName,
                                 Translate=TransUpper );
            until Matched or ( NOT NewFile );

            if not NewFile then
                NextReadFile := FEndDir;

        end;

        if NOT NewFile then begin

            Dispose( ScanPtr );
            FileState := Idling;
            FileIsOpen := False;
            FileName := SourcePat;   { To be able to report name in err.mess.}

        end else begin

            NextReadFile := FNoError;
            ConvExt( RemoteFName );
            ShowSRFile( True, RemoteFName, LocalFName );
            FileIsOpen := TRUE;
            FileName := RemoteFName;    { To put into FileHeader packet }
            Reset( DataFile, LocalFName );

        end;

    end;
end;

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

function EndFile : Boolean;
begin
    if (FileState=Reading) and FileIsOpen then
        EndFile := EOF( DataFile )
    else
        EndFile := TRUE;
end;

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

function SetWriteFile( VAR SourcePat, DestPat : String ) : FileErrs;
{ -- Setup for write to file }
var Dummy : FileErrs;
begin
    if FileIsOpen then
        Dummy := FileIdle;
    SetWriteFile := SetPatterns( SourcePat, DestPat );
    FileState := Writing;
    FileIsOpen := False;
end;

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

procedure WriteScreen;
{ -- Setup to write to screen instead of file }
var Dummy : FileErrs;
begin
    if FileIsOpen then
        Dummy := FileIdle;
    FileState := WritingScreen;
end;

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

procedure ConvInt(  VAR FileN : FNameType );
{  Abstract:    Converts a file name
                to internal format in FileN, including
                any necessary transformations of file name }
var FD              : integer;
    T               : PString;
    Sep             : char;
    IsSwitch        : boolean;
begin
    { We expect DEC-10, -20, CP/M and MP/M style filenames, <name>.<typ>
       Acceptable to PERQ! }

    if Nord then begin
        FD := PosC( FileN, '-' );       { Apply reverse NORD transf. }
        while FD<>0 do begin
            FileN[FD] := '.';
            FD := PosC( FileN, '-' );
        end;
    end;
end;

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

function NextWriteFile( VAR FileName : String ) : FileErrs;
{ -- Open next file to write. }
var Matched : boolean;
    RetCode : FileErrs;
begin
    if FileState<>Writing then begin
        if FileState<>WritingScreen then begin
            Writeln( NoSetWrite );
            RetCode := FInternalErr;
        end;
    end else begin
        RetCode := FNoError;

        if FileIsOpen then
            RetCode := KeepFile;

        if RetCode>=FNoError then begin

            RemoteFName := FileName;
            ConvInt( FileName );

            if FileNoPatt then begin
                if (SourcePat=FileName) and (DestPat<>'') then
                    LocalFName := DestPat       { Two file names given: }
                else                            { Rename intended, but only }
                    LocalFName := FileName;     { if equal to the first one }
            end else begin
                Matched :=
                    PattMap( FileName, SourcePat, DestPat, LocalFName,
                             Translate=TransUpper );
                if not Matched then
                    LocalFName := FileName;     { Store with no translation }
            end;

            rewrite( DataFile, TempName );
            FileIsOpen := TRUE;
            ShowSRFile( False, RemoteFName, LocalFName );
        end
           { else NextWriteFile should be retried };

    end;
    NextWriteFile := RetCode;
end;

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

function FileIdle : FileErrs;
{ -- Reset the module to idle state }
var OldWin : WinType;
begin
    FileIdle := FNoError;
    if FileIsOpen then begin

        if FileState = Writing then
            FileIdle := DiscardFile
        else if FileState = Reading then
            CloseReading;
    end;

    FileIsOpen := False;
    FileState := Idling;
end;

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

function   FillBuffer ( var data : Packet ) : FileErrs;

{ -- Read a packet from the file }

const   PackHead = 4;       { Number of characters in packet header }
var
        NextB                                               : Byte8;
        i, j, RepCnt, NextBSz, Needed                       : integer;
        GoForNext, Quote8, CtrlChar, eofi, WillRepeat       : boolean;

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

    procedure CharInPack;
    begin
        With data do
        begin                           { Put character into the packet }
            if Quote8 then
            begin
                data[i] := Bit8Quote;           { Quote for 8'th bit    }
                i := i + 1;
                NextB := Land ( NextB, 127 );   { Mask 8'th bit         }
            end;
            if CtrlChar then
            begin                               { Real control character?}
                if    ( Land( NextB, 127) < ord ( ' ' ) )
                   or ( Land( NextB, 127) = 127 ) then      { De-       }
                    NextB := ord ( ctl ( chr ( NextB ) ) ); { controlify}
                data[i] := SendQuote;
                i := i + 1;
            end;
            data[i] := chr ( NextB );
            i := i + 1;
        end;
    end;

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

    procedure FetchNext;
    begin
        NextB := DataFile^;   { Retreive next character from file buffer. }
                            { How will it have to be quoted?            }
        Quote8 := ( NextB >= 128 ) and NowUse8Quote;

        if Parity<>NOKParity then           { Test for quotes with char.}
            NextB := LAnd( NextB, 127 );    { as it will arrive at rcvr.}

        CtrlChar := ( Land( NextB,127) < ord ( ' ' )               ) or
                    ( Land( NextB,127) = 127                       ) or
                    (   chr( NextB ) = SendQuote                   ) or
                    ( ( chr( NextB ) = Bit8Quote) and NowUse8Quote ) or
                    ( ( chr( NextB ) = RepFix   ) and NowUseRepFix );

        NextBSz := 1;       { How much packet space will it need?       }
        if Quote8 then NextBSz := NextBSz + 1;      { Adjust for the    }
        if CtrlChar then NextBSz := NextBSz + 1;    { quotes!           }
    end;

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

    Procedure PutLookAhead;
    var PutIt : boolean;
    begin
        if not eofi then        { We've decided to use the character in }
            get( DataFile );      { file buffer.   Advance file window so }
        eofi := eof( DataFile );  { we may test against next character.   }
                                { Remember DataFile^ is undef. if at EOF  }
        if not NowUseRepFix then begin
            CharInPack;         { Don't use prefixing - assert RepCnt=1 }
            Needed := 0;
        end else begin          { Do we have to put out the lookahead   }
            if eofi or (NextB<>DataFile^) or (RepCnt>=94) then    { char? }
            begin
                if not WillRepeat then
                    for j := 1 to RepCnt do     { Too few occurrences - }
                        CharInPack              { put it out literally  }
                else
                with Data do begin              { We will gain  -       }
                    Data[i] := RepFix;                  { put prefix,   }
                    Data[i+1] := ToChar(chr(RepCnt));   { RepCnt,       }
                    i := i+2;
                    CharInPack;                 { the character itself  }
                end;
                RepCnt := 1;
                Needed := 0;            { What space we're committed to }
                WillRepeat := false;    { Not decided to repeat yet!    }
            end
            else
            begin
                RepCnt := RepCnt + 1;         { just count occurrences  }
                if not WillRepeat then
                    if Needed+NextBSz<=2 then       { Committing our-   }
                        Needed := Needed + NextBSz  { selves to use     }
                    else begin                      { more space!       }
                        Needed := NextBSz+2;        { Else: limit has   }
                        WillRepeat := true;         { been reached,     }
                    end;                    { will not need more space. }
            end;
        end;

        if eofi then            { No character to go next.              }
            GoForNext := false  { Last one has already been put.        }
        else begin
            FetchNext;          { Look at the next character, decide    }
                                { whether it too wil go into packet.    }
            if WillRepeat then  { Next char won't use additional space. }
                GoForNext := true
            else                { Is there space for NextB?             }
                GoForNext := SendPSize >= (i+PackHead+Needed+NextBSz);
        end;
    end;

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

begin

    FillBuffer := FNoError;

    if (FileState<>Reading) or (Not FileIsOpen) then
        Writeln( NotReading )
    else
      with data do begin
        if not eof ( DataFile ) then
        begin
            RepCnt := 1;        { #Times DataFile^ is to be put into packet.}
            i := 1;             { Where will the character go?            }
            adjust( Data, 100 );
            eofi := false;
            FetchNext;          { Establish lookahead. }
            WillRepeat := false;

            repeat              { NOT EOF => At least one character to put}
                PutLookAhead;
            until not GoForNext;

            if (RepCnt>1) then begin        { Don't forget it if last   }
                for j := 1 to RepCnt do     { char. was repeated.       }
                    CharInPack;             { ASSERT not WillRepeat     }
                if not eofi then get( DataFile );
            end;

                { Put count field = len of data + 3, i = len of data +1 }
            count := ToChar ( chr ( i + 2 ) );
            ptype := PackToCh( DataPack );
            adjust( Data, i );
        end
        else begin
            count := ToChar ( chr ( 3 ) );
            Ptype := PackToCh( EOFPack );
            FillBuffer := FAtEOF;
        end;

    end;
end;

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

function   EmptyBuffer ( var data  : Packet ) : FileErrs;

{ -- Write a data packet to file }

var     i,j,scr,rep         : integer;
        CtrlChar, Quote8    : boolean;
        ch                  : char;
begin
    EmptyBuffer := FNoError;
    if (FileState<>WritingScreen) and
      ((FileState<>Writing) or (Not FileIsOpen)) then
        Writeln( NotWriting )
    else begin
        i := 1;
        with data do

        while i <= ( ord ( UnChar( count ) ) - 3 ) do
        begin
            ch := data[i];

            if NowUseRepFix and ( ch = RepFix ) then begin
                i := i + 1;
                ch := data[i];
                rep := ord( UnChar( ch ) );
                i := i + 1;
                ch := data[i];
            end else
                rep := 1;

            Quote8 := NowUse8Quote and ( ch = Bit8Quote );
            if Quote8 then
            begin
                i := i + 1;
                ch := data[i];
            end;

            CtrlChar := ch = RecQuote;
            if CtrlChar then
            begin
                i := i + 1;
                ch := data[i];
                if ch in CtlMapping then
                    ch := ctl ( ch );
                { else character is a quoted quote(!) }
            end;

            if Quote8 then
                Scr := Lor ( ord ( ch ) , 128 )
            else
                Scr := ord ( ch );

            if FileState=WritingScreen then
                for j := 1 to rep do
                    write( chr( Land(Scr,127) ) )
            else
                for j := 1 to rep do begin
                    DataFile^ := Scr;
                    put( DataFile );
                end;

            i := i + 1;
        end;
    end;
end;

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

procedure PutFileName(  VAR FileN   :   FNameType;
                        VAR Pack    :   Packet );
{  Abstract:   Puts a file name corresponding to internal format
                in FileN into a FileHeader packet (Pack). }
begin
        Pack.Data := Concat( FileN, ' ' );
        Pack.Count := ToChar( chr( Length( Pack.Data ) + 2 ) );
end;

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

procedure GetFileName(  VAR FileN   :   FNameType;
                        VAR Pack    :   Packet );
{  Abstract:   Gets a file name from a FileHeader packet and converts
                to internal format in FileN, including
                any necessary transformations of file name }
var FD              : integer;
    T               : PString;
    Sep             : char;
    IsSwitch        : boolean;
begin
    with Pack do begin
        if ( Ptype<>PackToCh( FHeadPack ) ) and Debug then begin
            DbgWrite(' Attempts GetFileName from non-FileHeader packet!');
            DbgNL;
        end;
    { We expect DEC-10, -20, CP/M and MP/M style filenames, <name>.<typ>
       Acceptable to PERQ! }
            { remember not to include the checksum byte!! }
        T := SubStr( Data, 1, Length( Data )-1 );
            { Also: be sure there are no trailing separator characters }
        Sep := NextIDString( T, FileN, isSwitch );
    end;
end;

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

procedure  FileError (       FileName : FNameType; ErrCode : FileErrs;
                         Var Message  : String );
{ -- Generate File error messages }
begin
    case ErrCode of

       FReadErr:    Message := 'Disk read error';
       FWriteErr:   Message := 'Disk write error';
       FNoSpace:    Message := 'No more space to write file into';
       FNoReadPriv: Message := 'Not granted read access to file';
       FNoWritePriv:Message := 'Not granted write access to file';
       FCantOpen:   Message := 'Cannot open file';
       FNotRenamed: Message := 'Could not rename file';
       FNoFile:     Message := 'No file of this name';
       FBadNames:   Message := 'Bad filenames or wildcard matching';
       FInternalErr:Message := 'Kermit internal error';

       FNoError:    Message := 'File operation successful';

       FRenamed:    Message := 'Filename conflict, renamed files';
       FEndDir:     Message := 'No more matching names in directory';
       FAtEof:      Message := 'At end-of-file';
    end;

    Message := Concat( Message, ' for file : ' );
    if FileName<>'' then
        Message := Concat( Message, FileName )
    else
        Message := Concat( Message, LocalFName );
end
.