{$IFDEF WtrGate}{$IFDEF UseOvr}{$O+,F+}{$ENDIF}{$ENDIF}
UNIT FidoPack;

{ all code to "pack" outbounds }

{$i platform.inc}

INTERFACE

PROCEDURE Fido_Pack;


IMPLEMENTATION

USES Ramon,
     Dos,
     Cfg,
     Database,
     FidoPkt,
     Logs,
     NewExec,
     Fido,
     Routing,
     ReadRout,
     Usenet,
     UU,
     Msgs,
     Globals,
     Start,
     UserBase,
     AreaBase,
     Binkley,
     DBridge,
     Strings,
     FD,
     RunCfg,
     Import,
     Deliver,
     Seat,
     PKT2000;

{--------------------------------------------------------------------------}
{ RenameQQQtoPKT                                                           }
{                                                                          }
{ This routine renames the .QQQ file to .PKT or .P2K, depending on its     }
{ type. Returns TRUE on success, FALSE on error. It modifies Filename to   }
{ the new name.                                                            }
{                                                                          }
FUNCTION RenameQQQtoPKT (VAR Filename : STRING;
                         PktFormat    : PktFormatType) : BOOLEAN;

VAR NewExt  : STRING[3];
    Temp    : STRING;
    RenFile : FILE;
    IORes   : BYTE;

BEGIN
     RenameQQQtoPKT:=FALSE; { assume error }

     { verander de naam van de QQQ in PKT or P2K }
     IF (PktFormat = fptPkt2000) THEN
        NewExt:='P2K'
     ELSE
         NewExt:='PKT';

     Temp:=Copy (Filename,1,Length (Filename)-3)+NewExt;

     Assign (RenFile,Filename);
     {$I-} Rename (RenFile,Temp); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error renaming '+Filename+' to '+Temp);
          Exit; { with FALSE: error }
     END;

     Filename:=Temp; { return new filename }
     RenameQQQtoPKT:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ FidoCompress                                                             }
{                                                                          }
{ Deze routine gebruikt de argumenten als volgt:                           }
{               <Compressor> <Directory><ArchiveFile> <Filename>           }
{ Bijvoorbeeld: PKZIP A C:\OUTBOUND.001\00004512.ZIP 12345678.PKT          }
{                                                                          }
FUNCTION FidoCompress (Directory,
                       ArchiveFile,
                       FileName    : STRING;
                       Address     : FidoAddrType;
                       Compression : CompressionType) : BOOLEAN;

VAR KillFile : FILE;
    IORes    : BYTE;

BEGIN
     FidoCompress:=FALSE;

     LogMessage (liTrivial,'Adding '+Filename+' to '+Directory+ArchiveFile);

     { roep het juiste compressie programma aan }
     GoExec (ArchiversPtr^.Archive[Compression],
             Directory+ArchiveFile+' '+FileName,
             'Adding .PKT file to archive for '+Fido2Str (Address));

     { en analyseer het resultaat }
     IF (ExecRes > $0000) THEN
     BEGIN
          LogMessage (liFatal,'Program failure: '+ArchiversPtr^.Archive[Compression]);
          Exit; { with FALSE }
     END;

     Assign (KillFile,FileName);
     {$I-} Erase (KillFile); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'Error deleting '+Filename);

     FidoCompress:=TRUE;
END;


{--------------------------------------------------------------------------}
{ RestorePKTtoQQQ                                                          }
{                                                                          }
{ Deze routine hernoemd de in .PKT hernoemde .?QQ file weer terug naar     }
{ .CQQ of .QQQ.                                                            }
{                                                                          }
PROCEDURE RestorePKTtoQQQ (CurrentName,OriginalName : STRING);

VAR RenFile : FILE;
    IORes   : BYTE;

BEGIN
     Assign (RenFile,CurrentName);
     {$I-} Rename (RenFile,OriginalName); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'Error renaming '+CurrentName+' back to '+OriginalName)
     ELSE
         LogMessage (liGeneral,'Renamed '+CurrentName+' back to '+OriginalName);
END;


{--------------------------------------------------------------------------}
{ PackQQQ_Binkley                                                          }
{                                                                          }
{ This routine is called when normal outbound archiving for a QQQ file     }
{ needs to be done and the system is configured for a Binkley mailer.      }
{ Returns TRUE if succesful, otherwise FALSE.                              }
{                                                                          }
FUNCTION PackQQQ_Binkley (Filename    : STRING;
                          Header      : FidoPktHdr;
                          QQQRecNr    : UserBaseRecordNrType;
                          QQQDest     : FidoAddrType;
                          Address     : FidoAddrType;
                          Compression : CompressionType;
                          PktFormat   : PktFormatType;
                          SendFormat  : SendType) : BOOLEAN;

VAR Destination_Dir : STRING;
    Tmp             : STRING;
    OutFileName     : STRING[8+1+3];
    UserRecNr       : UserBaseRecordNrType;
    UserRec         : UserBaseRecord;

BEGIN
     PackQQQ_Binkley:=FALSE; { assume error }

     { Binkley: Zoek uit naar welke directory geschreven moet }
     {          worden, en plaats een BUSY vlag zodat de node }
     {          node niet begint te zenden op het moment dat  }
     {          wij aan het inpakken zijn.                     }

     { If this user has a special outbound, use that instead of our normal }
     { outbound directory.                                                 }
     Destination_Dir := '';

     UserRecNr := GetUserBaseRecordNrByAddress (QQQDest.Zone, QQQDest.Net, QQQDest.Node, QQQDest.Point);
     IF (UserRecNr <> NILRecordNr) THEN
     BEGIN
          ReadUserBaseRecord (UserRecNr, UserRec);
          IF (UserRec.NodeOutDir <> '') THEN
               Destination_Dir := UserRec.NodeOutDir;
     END;

     IF (Destination_Dir <> '') THEN
     BEGIN
          IF Config.LogDebug THEN
             LogMessage (liTrivialLog,Fido2Str (QQQDest)+' uses outbound '+Destination_Dir);
     END ELSE
         Destination_Dir:=BinkleyOutbound (QQQDest);

     { Controle op BINKLEY.BSY flags !!!!! }
     IF BinkCheckBusy (Destination_Dir,Address) THEN
     BEGIN
          LogExtraMessage ('Skipping '+Filename+' because Binkley node is busy');
          Exit; { with FALSE: error }
     END;

     Tmp:=Filename;
     IF (NOT RenameQQQtoPKT (Tmp,PktFormat)) THEN
     BEGIN
          { RWI 951217: added deletion of .BSY file }
          BinkClearBusy (Destination_Dir,Address);

          Exit; { with FALSE: error }
     END;

     { kijken welke compressie methode we gaan gebruiken }
     IF (Compression <> fctNone) THEN
     BEGIN
          IF (QQQDest.Point > 0) THEN
             OutFileName:=Long2HexString (QQQDest.Point)
          ELSE
              WITH Header DO
                   OutFileName:=Word2HexString (Orig_Net-Dest_Net)+
                                Word2HexString (Orig_Node-Dest_Node);

         { Kijk of er archives bestaan met dezelfde naam, }
         { maar met een lengte van 0 bytes.               }
         OutFileName:=OutFileName+FidoGetExtension (OutFileName,QQQRecNr,Destination_Dir);

         { run de archiver }
         IF (NOT FidoCompress (Destination_Dir,
                               OutFileName,
                               Tmp,
                               Address,
                               Compression)) THEN
         BEGIN
              RestorePKTtoQQQ (Tmp,Filename);

              { verwijder de binkley .BSY vlag }
              BinkClearBusy (Destination_Dir,Address);

              Exit; { with FALSE: error }
         END; { packing failed }
     END ELSE
     BEGIN
          { PKT archiving }
          {## == Tmp??}
          {## dangerously assumes filename has certain length??}
          OutFileName:=Copy (Tmp,Length (Tmp)-11,255);
     END;

     { Als de target directory anders is dan de huidige, verplaats }
     { dan het archive naar de doel directory.                     }
     { 'Bereken' de binkley stijl outbound directory               }

     { creeren van Binkley Flag File }
     IF (NOT BinkCreateOutfile ('^',Destination_Dir,OutFilename,Address,SendFormat)) THEN
     BEGIN
          LogMessage (liFatal,'Unable to create Binkley *.?LO file');
          Exit; { with FALSE: error }
     END;

     IF (Compression = fctNone) THEN
     BEGIN
          { de .PKT file staat nog steeds in de outbound directory }
          { zelf. Verplaats em nu naar de subdirectory.            }
          { RWI 960209: dit ging dus mis als source=destination }
          IF (NOT MoveFileWithDirectory (OutFilename,Destination_Dir+OutFilename)) THEN
             LogMessage (liFatal,'Error moving '+OutFilename+' to '+Destination_Dir);
     END;

     { ok, dan kan nu de .BSY vlag weer weg... }
     BinkClearBusy (Destination_Dir,Address);
END;


{--------------------------------------------------------------------------}
{ PackQQQ_FrontDoor                                                        }
{                                                                          }
{ This routine is called when normal outbound archiving for a QQQ file     }
{ needs to be done and the system is configured for a FrontDoor mailer.    }
{ Returns TRUE if succesful, otherwise FALSE.                              }
{                                                                          }
FUNCTION PackQQQ_FrontDoor (Filename    : STRING;
                            QQQRecNr    : UserBaseRecordNrType;
                            QQQDest     : FidoAddrType;
                            QQQSource   : FidoAddrType;
                            Address     : FidoAddrType;
                            ExportAKA   : BYTE;
                            Compression : CompressionType;
                            PktFormat   : PktFormatType;
                            SendFormat  : SendType;
                            SysOp       : STRING;
                            MaxArcLen   : LONGINT;
                            QQQSize     : LONGINT) : BOOLEAN;

VAR OutFileName   : STRING[8+1+3];
    Tmp           : STRING;
    NewAttachFile : BOOLEAN;
    TmpAdres      : FidoAddrType;
    Outbound_Dir  : STRING;
    UserRecNr     : UserBaseRecordNrType;
    UserRec       : UserBaseREcord;

BEGIN
     PackQQQ_FrontDoor:=FALSE; { assume error }

     Tmp:=Filename;
     IF (NOT RenameQQQtoPKT (Tmp,PktFormat)) THEN
        Exit; { with FALSE: error }

     { kijken welke compressie methode we gaan gebruiken }
     IF (Compression <> fctNone) THEN
     BEGIN
          Outbound_Dir := '';
          
          UserRecNr := GetUserBaseRecordNrByAddress (QQQDest.Zone, QQQDest.Net, QQQDest.Node, QQQDest.Point);
          IF (UserRecNr <> NILRecordNr) THEN
          BEGIN
               ReadUserBaseRecord (UserRecNr, UserRec);
               IF (UserRec.NodeOutDir <> '') THEN
                    Outbound_Dir := UserRec.NodeOutDir;
          END;

          IF (Outbound_Dir <> '') THEN
          BEGIN
               IF Config.LogDebug THEN
                  LogMessage (liTrivialLog,Fido2Str (QQQDest)+' uses outbound '+Outbound_Dir);
          END ELSE
              Outbound_Dir:=Config.Outbound_F;

          OutFilename:=FrontDoorGetOutboundFile (Outbound_Dir,
                                                 QQQDest,
                                                 QQQSource,
                                                 NewAttachFile,
                                                 QQQRecNr,
                                                 MaxArcLen,
                                                 QQQSize);

          { run de archiver }
          IF (NOT FidoCompress (Outbound_Dir,
                                OutFileName,
                                Tmp,
                                Address,
                                Compression)) THEN
          BEGIN
               RestorePKTtoQQQ (Tmp,Filename);

               Exit; { with FALSE: error }
          END; { packing failed }
     END ELSE
     BEGIN
          { no compression -> keep PKT / P2K }
          {## == Tmp??}
          {## dangerously assumes filename has certain length??}
          OutFileName:=Copy (Tmp,Length (Tmp)-11,255);
          NewAttachFile:=TRUE;

          { important to set Outbound_Dir here as well, since it is used }
          { below.                                                       }
          Outbound_Dir := '';

          UserRecNr := GetUserBaseRecordNrByAddress (QQQDest.Zone, QQQDest.Net, QQQDest.Node, QQQDest.Point);
          IF (UserRecNr <> NILRecordNr) THEN
          BEGIN
               ReadUserBaseRecord (UserRecNr, UserRec);
               IF (UserRec.NodeOutDir <> '') THEN
                    Outbound_Dir := UserRec.NodeOutDir;
          END;

          IF (Outbound_Dir <> '') THEN
          BEGIN
               IF Config.LogDebug THEN
                  LogMessage (liTrivialLog,Fido2Str (QQQDest)+' uses outbound '+Outbound_Dir);

               { move the uncompressed PKT/P2K to this directory }
               IF (NOT MoveFileWithDirectory (OutFilename,Outbound_Dir+OutFilename)) THEN
                  LogMessage (liFatal,'Error moving '+OutFilename+' to '+Outbound_Dir);
          END ELSE
              Outbound_Dir:=Config.Outbound_F;
     END;

     { Als de target directory anders is dan de huidige, verplaats }
     { dan het archive naar de doel directory.                     }
     { 'Bereken' de binkley stijl outbound directory               }

     { Controleer eerst of we er al een attach voor deze node }
     { is. Zoja, dan heeft het weinig zin om een nieuwe te    }
     { creeren.                                               }
     IF NewAttachFile THEN
     BEGIN
          { no need to use push/pop here }
          MsgsEmpty;

          Msg.Date_F:=FidoCurrTime2Str;

          { always set the KILL flag on the ARCmail message }
          { KFS/TFS is set below }
          Msg.Attr_F:=MSGLOCAL OR MSGPRIVATE OR MSGFILE OR MSGKILL;

          { RAWI980419 }
          IF Config.Mailer_TFS THEN
             FidoAddToExtFlag (EXTMSGTFS)
          ELSE
              FidoAddToExtFlag (EXTMSGKFS);

          CASE SendFormat OF
               stNormal : {leave as is};
               stHold   : Msg.Attr_F:=Msg.Attr_F OR MSGHOLD;
               stCrash  : Msg.Attr_F:=Msg.Attr_F OR MSGCRASH;
               stDirect : FidoAddToExtFlag (EXTMSGDIR);
               ELSE
                   LogMessage (liFatal,'Unexpected situation 1 in PackFtnOutbound ** PLEASE REPORT **');
          END; { case }

          { Schrijf ^aFLAGS in het bericht }
          FidoExportExtFlag;

          IF (SendFormat = stHold) THEN
             Msg.Attr_F:=Msg.Attr_F OR MSGHOLD;

          AreaData.FidoMsgPath:=Config.FidoNetmailPath;
          AreaData.AreaName_F:='Netmail';

          IF (ExportAKA = 0) THEN
          BEGIN
               ExportAKA:=FidoMatchAdres (Address,TmpAdres);
               IF Config.LogDebug THEN
                  LogMessage (liTrivial,'Matched System AKA '+Fido2Str (Config.NodeNrs[ExportAKA])+' to '+Fido2Str (Address));
          END;

          Msg.FromUser_F:='ARCmail';
          Msg.FromAddr_F:=Config.NodeNrs[ExportAKA];

          Msg.Subj_F:=Outbound_Dir+OutFileName;

          Msg.Ready_F:=Netmail; { for stats counting }

          { schrijf het file attach netmailtje }

          IF (SysOp = '') THEN
             SysOp:='SysOp';

          ImportNetmail_InPrimaryNetmailArea (SysOp,Address);

          { ask to create FDRESCAN.NOW on exit }
          GoSetFDRescan:=TRUE;
     END; { newattachfile }
END;


{--------------------------------------------------------------------------}
{ PackQQQ_DBridge                                                          }
{                                                                          }
{ This routine is called when normal outbound archiving for a QQQ file     }
{ needs to be done and the system is configured for a dBridge mailer.      }
{ Returns TRUE if succesful, otherwise FALSE.                              }
{                                                                          }
FUNCTION PackQQQ_DBridge (Filename    : STRING;
                          Header      : FidoPktHdr;
                          QQQRecNr    : UserBaseRecordNrType;
                          QQQDest     : FidoAddrType;
                          Address     : FidoAddrType;
                          Compression : CompressionType;
                          PktFormat   : PktFormatType;
                          SendFormat  : SendType) : BOOLEAN;

VAR IORes        : BYTE;
    OutFileName  : STRING[8+1+3];
    Tmp          : STRING;
    Outbound_Dir : STRING;
    UserRecNr    : UserBaseRecordNrType;
    UserRec      : UserBaseRecord;

BEGIN
     PackQQQ_DBridge:=FALSE; { assume error }

     Tmp:=Filename;
     IF (NOT RenameQQQtoPKT (Tmp,PktFormat)) THEN
        Exit; { with FALSE: error }

     { kijken welke compressie methode we gaan gebruiken }
     IF (Compression <> fctNone) THEN
     BEGIN
          WITH Header DO
               IF (QQQDest.Point > 0) THEN
                  OutFileName:='P'+Copy (Word2HexString (Dest_Node),2,3)+Word2HexString (Dest_Point)
               ELSE
                   OutFileName:=Word2HexString (Orig_Net-Dest_Net)+
                                Word2HexString (Orig_Node-Dest_Node);

          OutFileName:=OutFileName+FidoGetExtension (OutFileName,QQQRecNr,'');

          UserRecNr := GetUserBaseRecordNrByAddress (QQQDest.Zone, QQQDest.Net, QQQDest.Node, QQQDest.Point);

          Outbound_Dir := '';

          IF (UserRecNr <> NILRecordNr) THEN
          BEGIN
               ReadUserBaseRecord (UserRecNr, UserRec);
               IF (UserRec.NodeOutDir <> '') THEN
                    Outbound_Dir := UserRec.NodeOutDir;
          END;

          IF (Outbound_Dir <> '') THEN
          BEGIN
               IF Config.LogDebug THEN
                  LogMessage (liTriviallog,Fido2Str (QQQDest)+' uses outbound '+Outbound_Dir);
          END ELSE
              Outbound_Dir:=Config.Outbound_F;

          { run de archiver }
          IF (NOT FidoCompress (Outbound_Dir,
                                OutFileName,
                                Tmp,
                                Address,
                                Compression)) THEN
          BEGIN
               RestorePKTtoQQQ (Tmp,Filename);

               Exit; { with FALSE: error }
          END; { packer failed }
     END ELSE
     BEGIN
          { PKT archiving }
          {## == Tmp??}
          {## dangerously assumes filename has certain length??}
          OutFileName:=Copy (Tmp,Length (Tmp)-11,255);

          Outbound_Dir := '';

          UserRecNr := GetUserBaseRecordNrByAddress (QQQDest.Zone, QQQDest.Net, QQQDest.Node, QQQDest.Point);
          IF (UserRecNr <> NILRecordNr) THEN
          BEGIN
               ReadUserBaseRecord (UserRecNr, UserRec);
               IF (UserRec.NodeOutDir <> '') THEN
                    Outbound_Dir := UserRec.NodeOutDir;
          END;

          IF (Outbound_Dir <> '') THEN
          BEGIN
               IF Config.LogDebug THEN
                  LogMessage (liTrivialLog,Fido2Str (QQQDest)+' uses outbound '+Outbound_Dir);

               { move the uncompressed PKT/P2K to this directory }
               IF (NOT MoveFileWithDirectory (OutFilename,Outbound_Dir+OutFilename)) THEN
                  LogMessage (liFatal,'Error moving '+OutFilename+' to '+Outbound_Dir);
          END;
     END;

     DBridgeCreateQueueFile (OutFileName,Address,SendFormat);
END;


{--------------------------------------------------------------------------}
{ PackQQQ_Tunnel                                                           }
{                                                                          }
{ This routine is called when the QQQ file needs to be tunneled via e-mail }
{ using either SEAT or MailTunnel.                                         }
{ Returns TRUE if succesful, otherwise FALSE.                              }
{                                                                          }
FUNCTION PackQQQ_Tunnel (Filename    : STRING;
                         TunnelPtr   : MailTunnelPtr;
                         TunnelFName : STRING;
                         QQQRecNr    : UserBaseRecordNrType;
                         Address     : FidoAddrType;
                         Compression : CompressionType;
                         PktFormat   : PktFormatType) : BOOLEAN;

VAR RenFile : FILE;
    IORes   : BYTE;
    Tmp     : STRING;
    OutFileName : STRING[8+1+3];

BEGIN
     PackQQQ_Tunnel:=FALSE; { assume error }

     { kijken welke compressie methode we gaan gebruiken }
     IF (Compression = fctNone) THEN
     BEGIN
          LogMessage (liConfig,'Fatal error: compression not set for tunnel destination');
          Exit; { with FALSE: error }
     END;

     { verander de naam van de QQQ in PKT }
     Tmp:=Copy (Filename,1,Length (Filename)-3)+'PKT';
     Assign (RenFile,Filename);
     {$I-} Rename (RenFile,Tmp); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error renaming '+Filename+' to .PKT');
          Exit; { with FALSE: error }
     END;

     { compression with the user set compression format, }
     { but always keep the files in the main outbound.   }
     { use special filenames as well.                    }

     IF (TunnelPtr <> NIL) THEN
        OutFilename:=TunnelPtr^.ArchiveName
     ELSE
         OutFilename:=TunnelFName; { calculated above }

     OutFilename:=OutFilename+FidoGetExtension (OutFileName,QQQRecNr,Config.Outbound_F);

     IF (NOT FidoCompress (Config.Outbound_F,
                           OutFileName,
                           Tmp,
                           Address,
                           Compression)) THEN
     BEGIN
          { rename PKT back to original name }
          {$I-} Rename (RenFile,Filename); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             LogDiskIOError (IORes,'Error renaming '+Tmp+' back to '+Filename)
          ELSE
              LogMessage (liGeneral,'Renamed .PKT back to '+Filename);

          Exit; { with FALSE: error }
     END;

     PackQQQ_Tunnel:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ PackQQQFile                                                              }
{                                                                          }
{ This routine processes one QQQ file that is in the outbound directory.   }
{ The destination is looked up, it is renamed to .PKT and put into an      }
{ archive. It is then either moved into the FD, Binkley or dBridge         }
{ outbound directory and a note is made in a queue administration file or  }
{ a an f/a netmail for the mailer is created, alternative it is tunneled   }
{ out of here via e-mail using MailTunnel or SEAT.                         }
{ In case of errors, the .PKT is renamed back to .QQQ.                     }
{ Returns TRUE on success, FALSE on error.                                 }
{                                                                          }
FUNCTION PackQQQFile (Filename : STRING;
                      QQQSize  : LONGINT) : BOOLEAN;

VAR QQQFile     : FILE;
    IORes       : BYTE;
    PktHeader   : FidoPktHdr;
    P2kHeader   : Pkt2000Header;

    QQQSource,
    QQQDest     : FidoAddrType;
    QQQRecNr    : UserBaseRecordNrType;

    TunnelPtr   : MailTunnelPtr;
    TunnelFName   : STRING[8];

    Address     : FidoAddrType;
    ExportAKA   : BYTE;
    SysOp       : STRING[MaxLenSysOpName];
    SendFormat  : SendType;
    Compression : CompressionType;
    PktFormat   : PktFormatType;
    MaxArchLen  : LONGINT;

    Result      : BOOLEAN;

    Buf         : ARRAY[1..3] OF CHAR;
    BytesRead   : WordLong;

BEGIN
     Assign (QQQFile,Filename);

     { RWI 960819: clean files that were left behind }
     IF (QQQSize = 0) THEN
     BEGIN
          {$I-} Erase (QQQFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             LogDiskIOError (IORes,'Error deleting 0-length file: '+Filename)
          ELSE
              LogMessage (liGeneral,'Deleted 0-length outbound file: '+Filename);

          Exit; { ## EXIT ## }
     END;

     {$I-} Reset (QQQFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error opening '+Filename);
          Exit; { ## EXIT ## }
     END;

     {$IFDEF LogFileIO}PostOpenF (QQQFile);{$ENDIF}

     BlockRead (QQQFile,P2kHeader,SizeOf (Pkt2000Header),BytesRead);
     IF (BytesRead = SizeOf (Pkt2000Header)) AND
        (P2kHeader.Id[1] = 'P') AND (P2kHeader.Id[2] = '2') AND (P2kHeader.Id[3] = 'K') THEN
     BEGIN
          PktFormat:=fptPkt2000;

          QQQSource.Zone:=P2kHeader.OrigAddr.Zone;
          QQQSource.Net:=P2kHeader.OrigAddr.Net;
          QQQSource.Node:=P2kHeader.OrigAddr.Node;
          QQQSource.Point:=P2kHeader.OrigAddr.Point;
          QQQSource.Domain:=P2kHeader.OrigDomain;

          QQQDest.Zone:=P2kHeader.DestAddr.Zone;
          QQQDest.Net:=P2kHeader.DestAddr.Net;
          QQQDest.Node:=P2kHeader.DestAddr.Node;
          QQQDest.Point:=P2kHeader.DestAddr.Point;
          QQQDest.Domain:=P2kHeader.DestDomain;
     END ELSE
     BEGIN
          PktFormat:=fptPkt;

          Seek (QQQFile,0);
          {$I-} BlockRead (QQQFile,PktHeader,SizeOf (FidoPktHdr)); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Error reading PKT header from '+Filename);

               {$IFDEF LogFileIO}PreCloseF (QQQFile);{$ENDIF}
               {$I-} Close (QQQFile); {$I+} IORes:=IORes OR IOResult;

               Exit;    { ## EXIT ## }
          END;

          {## check whether package contains netmail or echomail,
              either by looking at the Pvt flag in the first message
              or the AREA: kludge at the start of the first message.

              If netmail, don't compress it if not for a known user
              Unknown users are normally packed with the default
              archiver, but netmail shouldn't be packed.
          }

          { Decodeer de informatie die in de header zat naar een }
          { compleet 4D fido adres.                              }
          WITH QQQDest DO
          BEGIN
               Zone:=PktHeader.Dest_zone;
               Net:=PktHeader.Dest_net;
               Node:=PktHeader.Dest_node;
               Point:=PktHeader.Dest_point;
               { RAWI 971206: domain is required for 5D outbound handling }
               Domain:=FidoGetZoneDomain (Zone);
          END; { with }

          WITH QQQSource DO
          BEGIN
               Zone:=PktHeader.Orig_zone;
               Net:=PktHeader.Orig_net;
               Node:=PktHeader.Orig_node;
               Point:=PktHeader.Orig_point;
               {## why is this one empty? Must we use the P2kHeader.DestDomain?}
               Domain:='';
          END; { with }
     END;

     {$IFDEF LogFileIO}PreCloseF (QQQFile);{$ENDIF}

     {$I-} Close (QQQFile); {$I+} IORes:=IORes OR IOResult;
     IF (IORes <> 0) THEN
        Exit; { ## EXIT ## }

     LogMessage (liTrivial,Filename+' file destination: '+Fido2Str (QQQDest));

     TunnelPtr:=GetMailTunnelTo (QQQDest);

     { Laad het node record in waar we naartoe gaan zenden }
     IF (NOT FindUserBaseRecordByFidoAddress (QQQDest,QQQRecNr)) THEN
     BEGIN
          { Het doel systeem niet direct aan ons bekent, nu moeten }
          { we improviseren aan de hand van de defaults.           }

          {## if netmail, stick to PKT}
          Compression:=Config.DefaultCompressor;
          SendFormat:=stNormal;
          Address:=QQQDest;
          SysOp:='SysOp';
          TunnelFName:='';
          ExportAKA:=0; { automatic }
          MaxArchLen:=0; { don't care }
     END ELSE
     BEGIN
          { neem de instellingen over uit het userbase record }
          ReadUserBaseRecord (QQQRecNr,UserData);

          Compression:=UserData.Compression;
          SendFormat:=UserData.SendFormat;
          Address:=UserData.Address;
          SysOp:=UserData.SysOp;
          ExportAKA:=UserData.ExportAKA;
          MaxArchLen:=UserData.MaxArcLength;

          IF (SendFormat IN [stMailTunnel,stSeat]) THEN
             TunnelFName:=SEAT_CalcBaseFilename (UserData)
          ELSE
              TunnelFName:='';

          IF (Compression = fctNone) AND
             ((TunnelPtr <> NIL) OR (SendFormat IN [stMailTunnel,stSeat])) THEN
          BEGIN
               LogMessage (liConfig,'WARNING: No compression set for Tunnel user! Using default.');
               Compression:=Config.DefaultCompressor;
          END;
     END;

     { Een *.CQQ file overides the default SendFormat routing }
     IF (Filename[10] = 'C') THEN
        SendFormat:=stCrash;

     Result:=FALSE;

     IF (TunnelPtr <> NIL) OR (SendFormat IN [stMailTunnel,stSeat]) THEN
     BEGIN
          Result:=PackQQQ_Tunnel (Filename,TunnelPtr,TunnelFName,QQQRecNr,Address,Compression,PktFormat);
     END ELSE
         CASE Config.FidoSystem OF
              stBinkley :
                  BEGIN
                       LogMessage (liDebug,'Pack for Binkley');
                       Result:=PackQQQ_Binkley (Filename,
                                                PktHeader,
                                                QQQRecNr,
                                                QQQDest,
                                                Address,
                                                Compression,
                                                PktFormat,
                                                SendFormat);
                  END;

              stFrontDoor :
                  BEGIN
                       LogMessage (liDebug,'Pack for FrontDoor');
                       Result:=PackQQQ_FrontDoor (Filename,
                                                  QQQRecNr,
                                                  QQQDest,
                                                  QQQSource,
                                                  Address,
                                                  ExportAKA,
                                                  Compression,
                                                  PktFormat,
                                                  SendFormat,
                                                  SysOp,
                                                  MaxArchLen,
                                                  QQQSize);
                  END;

              stDBridge :
                  BEGIN
                       LogMessage (liDebug,'Pack for d''Bridge');
                       Result:=PackQQQ_DBridge (Filename,
                                                PktHeader,
                                                QQQRecNr,
                                                QQQDest,
                                                Address,
                                                Compression,
                                                PktFormat,
                                                SendFormat);
                  END;

              ELSE
                  LogMessage (liReport,'Unexpected situation in PackQQQFile');
         END;

     PackQQQFile:=Result; { TRUE = success }
END;


{--------------------------------------------------------------------------}
{ WriteTunnelEmails                                                        }
{                                                                          }
{ Deze routine scant de outbound voor mail tunnel archives en encode deze  }
{ in e-mails voor de tunnel target adressen.                               }
{ Outbound is nog steeds de huidige directory.                             }
{                                                                          }
{ Sla de laatste archive over als deze nog niet groot genoeg is.           }
{                                                                          }
PROCEDURE WriteTunnelEmails;

    {----------------------------------------------------------------------}
    { SendTunnelFiles                                                      }
    {                                                                      }
    { This routine searches for the given FilePattern and all files that   }
    { are either not the latest or have reached the size limit are sent    }
    { off.                                                                 }
    {                                                                      }
    PROCEDURE SendTunnelFiles (FilePattern : STRING;
                               Latest      : LONGINT;
                               MinimumSize : LONGINT;
                               ToEmail     : STRING;
                               SendSeat    : BOOLEAN);

    VAR DelFile    : FILE;
        ReachedEnd : BOOLEAN;
        StartOver  : BOOLEAN;   { removed a file, restart findfirst/next }
        Search     : SearchRec;
        IORes      : BYTE;

    BEGIN
         { nu steeds een archive zoeken totdat er geen over zijn, }
         { of alleen die ene die nog niet groot genoeg is.        }

         REPEAT
               { now start searching over again for the oldest }
               FindFirst (FilePattern,saJustFiles,Search);
               ReachedEnd:=(DosError <> 0);

               IF (NOT ReachedEnd) THEN
               BEGIN
                    StartOver:=FALSE;

                    WHILE (NOT StartOver) DO
                    BEGIN
                         IF (Search.Time <> Latest) OR { always send not-last archives }
                            (Search.Size >= MinimumSize) THEN
                         BEGIN
                              { minimum archive size reached }
                              IF SendSeat THEN
                              BEGIN
                                   IF SEAT_AddFile (Search.Name,ToEmail) THEN
                                   BEGIN
                                        LogExtraMessage ('Security abort');
                                        MsgsEmpty;
                                        Exit; { ## EXIT ## }
                                   END;
                              END ELSE
                              BEGIN
                                   LogMessage (liTrivial,'Tunneling '+Search.Name+' to '+ToEmail);

                                   RFC_StartSingleRecipientMessage (ToEmail, { to e-mail }
                                                                    'mailtunnel', { from e-mail }
                                                                    'WaterGate MailTunnel Server', { from name }
                                                                    'MailTunnel Delivery'); { subject }

                                   XX_FileToBody (Search.Name,FALSE{SuppressInfo},FALSE{ForceText},FALSE{ForceEncode});

                                   Assign (DelFile,Search.Name);
                                   {$I-} Erase (DelFile); {$I+} IORes:=IOResult;
                                   IF (IORes <> 0) THEN
                                   BEGIN
                                        LogDiskIOError (IORes,'Error deleting '+Search.Name);
                                        LogExtraMessage ('Security abort');
                                        MsgsEmpty;
                                        Exit; { ## EXIT ## }
                                   END;

                                   DeliverNow;
                              END;

                              StartOver:=TRUE; { file deleted, search again }
                         END ELSE
                         BEGIN
                              FindNext (Search);

                              IF (DosError <> 0) THEN
                              BEGIN
                                   StartOver:=TRUE;  { abort while }
                                   ReachedEnd:=TRUE; { abort repeat }
                              END;
                         END;

                    END; { while not startover }

               END; { if not reached end }

               FindClose (Search);

         UNTIL ReachedEnd;
    END;

    {------------------------------------------------------------------}
    { FindLatest                                                       }
    {                                                                  }
    { This routine will search for all the files with the given search }
    { pattern and return the one with the lastest date/time stamp. If  }
    { no field were found, -1 is returned.                             }
    {                                                                  }
    FUNCTION FindLatest (FilePattern : STRING) : LONGINT;

    VAR Search : SearchRec;
        Latest : LONGINT;

    BEGIN
         FindFirst (FilePattern,saJustFiles,Search);
         IF (DosError <> 0) THEN
            FindLatest:=-1
         ELSE BEGIN
              { als er meer zijn, bepaal dan de jongste voor min. archive check }
              Latest:=Search.Time;

              REPEAT
                    IF (Search.Time > Latest) THEN
                       Latest:=Search.Time;
                    FindNext (Search);
              UNTIL (DosError <> 0);
         END;

         FindClose (Search);

         FindLatest:=Latest;
    END;

{ WriteMailTunnelEmails }

VAR TunnelPtr : MailTunnelPtr;
    Latest    : LONGINT;
    ULp       : UserBaseRecordNrType;
    UserRec   : UserBaseRecord;
    Pattern   : STRING[8+2];

BEGIN
     TunnelPtr:=MailTunnelList.GetFirstItem;

     WHILE (TunnelPtr <> NIL) DO
     BEGIN
          { make sure this is a tunnel-to }
          IF (TunnelPtr^.FromOrTo = mtTo) THEN
          BEGIN
               { find the latest archive. We have to do minimum size }
               { checking against _that_ archive only to prevent TH0 }
               { from never being sent when FR0 has been created...  }

               Pattern:=TunnelPtr^.ArchiveName+'.*';

               Latest:=FindLatest (Pattern);

               IF (Latest <> -1) THEN
                   SendTunnelFiles (Pattern,
                                    Latest,
                                    TunnelPtr^.MinimumSize*1024,
                                    TunnelPtr^.EMailAddress,
                                    TunnelPtr^.Seat);
          END;

          TunnelPtr:=MailTunnelList.GetNextItem2 (TunnelPtr);
     END; { while }

     FOR ULp:=1 TO UserBaseRecCount DO
     BEGIN
          ReadUserBaseRecord (ULp,UserRec);

          IF (NOT UserRec.Deleted) AND
             (UserRec.System = _F) AND
             (UserRec.SendFormat IN [stMailTunnel,stSeat]) AND
             (UserRec.TunnelTo <> '') THEN
          BEGIN
               { RAWI980524: why??
                 The archive must be sent at once, so stick to 0
               IF (UserRec.MaxArcLength = 0) THEN
                  UserRec.MaxArcLength:=500000;
               }

               Pattern:=SEAT_CalcBaseFilename (UserRec)+'.*';;

               Latest:=FindLatest (Pattern);

               IF (Latest <> -1) THEN
                   SendTunnelFiles (Pattern,
                                    Latest,
                                    UserRec.MaxArcLength,
                                    UserRec.TunnelTo,
                                    (UserRec.SendFormat = stSeat));
          END;
     END;

     MsgsEmpty; { voor het geval dat er nog wat rond hing }
END;


{--------------------------------------------------------------------------}
{ PackFtnOutbound                                                          }
{                                                                          }
{ Deze routine loopt alle .QQQ files af in de FTN outbound directory,      }
{ zoekt uit voor welke node ze zijn en begint/update de archive met de in  }
{ .PKT hernoemde .QQQ file, mits ze een archive optie gekozen hebben,      }
{ anders blijven de .PKT files gewoon staan.                               }
{                                                                          }
PROCEDURE PackFtnOutbound;

    {----------------------------------------------------------------------}
    { CreateFlagFile                                                       }
    {                                                                      }
    { Creer een lege file om de mailer te waarschuwen dat hij beter actie  }
    { kan ondernemen.                                                      }
    {                                                                      }
    { RWI 251094: Veranderd zodat er nu een compleet pad + FILENAME        }
    {             opgegeven moet worden. Voor FrontDoor werd FDRESCAN.NOW  }
    {             opgegeven en voor D'Bridge DBRIDGE.RSN. Nu kan ook       }
    {             FMRESCAN.NOW en IMRESCAN.NOW of zelf RESCAN.GO! gebruikt }
    {             worden.                                                  }
    {                                                                      }
    PROCEDURE CreateFlagFile;

    VAR FlagFile : FILE;
        IORes    : BYTE;

    BEGIN
         IF (DeleteBackSpaces (Config.RescanFlagFile) = '') THEN
            Exit; { niet opgegeven, dus niet aanmaken }

         Assign (FlagFile,Config.RescanFlagFile);
         {$I-} ReWrite (FlagFile,0); {$I+} IORes:=IOResult;
         IF (IORes = 0) THEN
         BEGIN
              {$IFDEF LogFileIO}PostOpenF (FlagFile);{$ENDIF}
              {$IFDEF LogFileIO}PreCloseF (FlagFile);{$ENDIF}
              {$I-} Close (FlagFile); {$I+} IORes:=IOResult;
         END;

         IF (IORes <> 0) THEN
            LogDiskIOError (IORes,'Error creating rescan flag file '+Config.RescanFlagFile);
    END;

{ PackFtnOutbound }

VAR OldDir,
    OldCurr       : PathStr;
    Search        : SearchRec;
    Header        : FidoPktHdr;
    NewDir        : STRING[79];
    IORes         : BYTE;
    Nop,Dow       : WordLong;
    ProcessedAtLeastOneFile : BOOLEAN;

BEGIN
     UpdateAction ('Packing FTN outbound');

     Config.Outbound_F:=UpCaseString (Config.Outbound_F);

     GetDate (Nop,Nop,Nop,Dow);

     GetDir (0,OldCurr);

     { is nu nog slechts de ene outbound die we hebben }
     NewDir:=UNC_FExpand (Config.Outbound_F);
     IF (NewDir[Length (NewDir)] = '\') AND (NewDir[Length (NewDir)-1] <> ':') THEN
        Delete (NewDir,Length (NewDir),1);

     { RWI 960904: now track the current directory on the outbound drive }
     GetDir (Ord (NewDir[1])-Ord ('A')+1,OldDir);

     { Alle QQQ's staan voor het gemak in 1 outbound directory  }
     { Hier worden ze gerenamed, gecomprimeerd en evt verplaats }

     {$I-} ChDir (NewDir); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Invalid FTN outbound: '+NewDir);
          Exit; { ## EXIT ## }
     END;

     { Doorloop de Outbound directory op zoek naar *.QQQ files }
     { en naar *.CQQ files voor crash outbound files           }

     { RWI 951231:                                                        }
     { De huidige directory veranderd nooit. Als de target archive in een }
     { andere directory aangemaakt moet worden, dan zorgt de archiver     }
     { daar voor. Bij binkley verandert dus NOOIT de huidige directory!   }

     ProcessedAtLeastOneFile:=FALSE;

     FindFirst ('*.?QQ',saJustFiles,Search);
     WHILE (NOT GlobalAbort) AND (DosError = 0) DO
     BEGIN
          { Zorg ervoor dat we alleen *.QQQ & *.CQQ files kunnen openen! }
          IF (Search.Name[10] IN ['Q','C']) THEN
          BEGIN
               { Probeer de QQQ file te openen en lees de binaire header }
               { in pluk hieruit het adres van de TO node en lees het    }
               { bijbehorende userbase record in.                        }

               UpdateReadFile (Config.Outbound_F+Search.Name,Search.Size);

               IF PackQQQFile (Search.Name,Search.Size) THEN
                  ProcessedAtLeastOneFile:=TRUE;
          END;

          FindNext (Search);

          IF KeyPressed AND (Ramon.ReadKey = kEsc) THEN
             GlobalAbort:=TRUE;

     END; { while }

     FindClose (Search);

     { creer flag files voor frontdoor en d'bridge systems }
     IF ProcessedAtLeastOneFile AND (Config.FidoSystem IN [stFrontdoor,stDBridge]) THEN
        CreateFlagFile;

     IF (NOT ForceNoTunnel) THEN
        WriteTunnelEmails;

     { change back on outbound drive }
     {$I-} ChDir (OldDir); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to change back to: '+OldDir);
          Exit; { ## EXIT ## }
     END;

     { change back to old drive + path }
     {$I-} ChDir (OldCurr); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to change back to: '+OldCurr);
          Exit; { ## EXIT ## }
     END;
END;


{--------------------------------------------------------------------------}
{ PackBbsOutbounds                                                         }
{                                                                          }
{ Deze routine doorloopt de user base op zoek naar BBS Interface users en  }
{ "pack"t daarna de outbound voor die user. Dit is simpelweg het hernoemen }
{ van .QQQ files in .PKT.
{                                                                          }
PROCEDURE PackBbsOutbounds;

    PROCEDURE PackBbsOutbound;

    VAR NewDir  : STRING;
        OldDir  : STRING;
        IORes   : BYTE;
        Search  : SearchRec;
        QQQFile : FILE;

    BEGIN
         NewDir:=UNC_FExpand (UserData.Outbound);
         IF (NewDir[Length (NewDir)] = '\') AND (NewDir[Length (NewDir)-1] <> ':') THEN
            Delete (NewDir,Length (NewDir),1);

         { onthoud de huidige directory op die drive }
         GetDir (Ord (NewDir[1])-Ord ('A')+1,OldDir);

         {$I-} ChDir (NewDir); {$I+} IORes:=IOResult;
         IF (IORes <> 0) THEN
         BEGIN
              LogDiskIOError (IORes,'Invalid BBS outbound: "'+NewDir+'"');
              Exit;
         END;

         FindFirst ('*.QQQ',saJustFiles,Search);
         WHILE (NOT GlobalAbort) AND (DosError = 0) DO
         BEGIN
              UpdateReadFile (Config.Outbound_F+Search.Name,Search.Size);

              Assign (QQQFile,Search.Name);

              {$I-}
              Rename (QQQFile,Copy (Search.Name,1,Pos ('.',Search.Name))+'PKT');
              {$I+} IORes:=IOResult;

              IF (IORes <> 0) THEN
                 LogDiskIOError (IORes,'Failed to rename '+Search.Name+' to .PKT');

              FindNext (Search);
         END; { while }

         FindClose (Search);

         ChDir (OldDir);   { change back on outbound drive }
    END;

{ PackBbsOutbounds }

VAR OldCurr : PathStr;
    UserLp  : UserBaseRecordNrType;

BEGIN
     UpdateAction ('Packing BBS outbound(s)');

     GetDir (0,OldCurr);

     FOR UserLp:=1 TO UserBaseRecCount DO
         IF (NOT GlobalAbort) THEN
         BEGIN
              ReadUserBaseRecord (UserLp,UserData);

              IF (NOT UserData.Deleted) AND (UserData.System = _BBS) THEN
                 PackBbsOutbound;
         END;

     ChDir (OldCurr);  { change back to old drive + path }
END;


{--------------------------------------------------------------------------}
{ Fido_Pack                                                                }
{                                                                          }
{ Deze routine pakt de FTN outbound in en doorloopt de outbound van iedere }
{ BBS Interface en hernoemd daar de .QQQ files naar .PKT.                  }
{                                                                          }
PROCEDURE Fido_Pack;
BEGIN
     LogMessage (liTrivial,'PACK outbound(s) started');
     LogClose; { ## TEMP ## }

     PackFtnOutbound;

     IF (NOT GlobalAbort) THEN
        PackBbsOutbounds;

     LogMessage (liTrivial,'PACK finished');
END;


END.
