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

{$i platform.inc}

INTERFACE

USES Database;

PROCEDURE FidoScan;
PROCEDURE FidoTossBad;

TYPE ScanDeliverResultType = (sdError,        { 0: abnormal, report }
                              sdSent,         { 1: normal }
                              sdReceived,     { 2: internally handled (areafix, etc.) }
                              sdKill,         { 3: gated, kill/sent option enabled }
                              sdOrphan);      { 4: make orphan (invalid message) }

FUNCTION Scan_DeliverMessage (AreaRecNr : AreaBaseRecordNrType; IsBadArea : BOOLEAN) : ScanDeliverResultType;

{add a function for E-mail export - there is lots of generic code out there}


IMPLEMENTATION

USES Ramon,
     Areamgr,            { IsAreafixName }
     Cfg,
     Msgs,
     Logs,
     Address,
     Deliver,
     Globals,
     Start,
     FidoMsg,
     Squish,
     Jam,
     SeenBy,
     Fido,
     Slice;

{--------------------------------------------------------------------------}
{ FidoScan                                                                 }
{                                                                          }
{ Deze routine loopt alle *.MSG directories af en leest daaruit alle       }
{ berichten om te verwerken. Door eerst te kijken of er een ECHOTOSS.LOG   }
{ aanwezig is wordt voorkomen dat we gebieden gaan scannen waarin geen     }
{ nieuwe berichten zitten.                                                 }
{                                                                          }
{ Als we later meer soorten MBase's ondersteunen moeten we een CASE        }
{ routine voor elke area inbouwen.                                         }
{                                                                          }
{ MD 25-07-93 Blijkbaar heb ik een vooruitziende blik....                  }
{    01-08-94 De hele procedure opnieuw vorm gegeven                       }
{                                                                          }
PROCEDURE FidoScan;

TYPE AreasDoneArray = ARRAY[0..65527] OF BYTE; { 1 bit per area      }
                                               { 0 = Not scanned yet }
                                               { 1 = Already scanned }

VAR EchoTossFile : TEXT;
    AreasDonePtr : ^AreasDoneArray;

    {----------------------------------------------------------------------}
    { ScanArea                                                             }
    {                                                                      }
    { Scan de gegeven area.                                                }
    {                                                                      }
    PROCEDURE ScanArea (AreaRecNr : AreaBaseRecordNrType;
                        VAR AreaRec : AreaBaseRecord);

    VAR GroupLp : GroupNrType;

    BEGIN
         { Scan de area niet als deze geen geldige naam heeft, geen      }
         { areabase of een echomail area is terwijl we die niet scannen. }
         IF (AreaRec.Deleted) OR { RWI 221094: BugFix! }
            (AreaRec.AreaType = Area_Local{never export}) OR
            (AreaRec.AreaName_F = '') OR
            (AreaRec.FidoMsgStyle = NoneType) OR
            (AreaRec.FidoMsgPath = '') OR { RWI961210: added }
            (ForceNoEcho AND (AreaRec.AreaType = Area_Echo))
         THEN
             Exit;

         { skip areas in Z1,Z2 and Z3 }
         FOR GroupLp:=Group_NewAreas TO MaxGroups DO
             IF TestIfInGroup (AreaRec.IsInGroups,GroupLp) THEN
                Exit;

         UpdateAction ('Scanning '+AreaRec.AreaName_F);

         Slice_Now;

         CASE AreaRec.FidoMsgStyle OF
              FidoMsgType :
                  FidoMsg_ScanArea (AreaRecNr,AreaRec,FALSE,FALSE);

              SquishType :
                  Squish_ScanArea (AreaRecNr,AreaRec,FALSE,FALSE);

              JamType :
                  Jam_ScanArea (AreaRecNr,AreaRec,FALSE,FALSE);

         END; { case }
    END;

    {----------------------------------------------------------------------}
    { CheckForEchoTossFiles                                                }
    {                                                                      }
    { Controleerd of er een ECHOTOSS.LOG of een ECHOMAIL.JAM file in       }
    { de huidige directory staat.                                          }
    {                                                                      }
    {  0 = niets gevonden                                                  }
    {  1 = EchoToss.Log gevonden                                           }
    {  2 = ECHOMAIL.JAM gevonden                                           }
    {                                                                      }
    FUNCTION CheckForEchoTossFiles : BYTE;
    BEGIN
         IF TestIfExist (Config.SystemDir+'ECHOTOSS.LOG') THEN
            CheckForEchoTossFiles:=1  { echotoss.log gevonden }
         ELSE
             IF TestIfExist (Config.SystemDir+'ECHOMAIL.JAM') THEN
                CheckForEchoTossFiles:=2  { echomail.jam gevonden }
             ELSE
                 CheckForEchoTossFiles:=0; { niets gevonden }
    END;

    {----------------------------------------------------------------------}
    { ScanNetmail                                                          }
    {                                                                      }
    { Scant de hoofd netmail directory, eventuele andere netmail           }
    { directory's worden tijdens het scannen van de andere areas           }
    { wel meegenomen.                                                      }
    {                                                                      }
    PROCEDURE ScanNetMail;

    VAR AreaRec : AreaBaseRecord;

    BEGIN
         IF (Config.FidoNetmailPath = '') THEN
         BEGIN
              LogMessage (liConfig,'Primary netmail area message base path is missing');
              Exit;
         END;

         FillChar (AreaRec,SizeOf (AreaBaseRecord),0);
         AreaRec.AreaName_F:='PRIMARY NETMAIL'; { RWI 961011 }
         AreaRec.FidoMsgPath:=Config.FidoNetmailPath;
         AreaRec.AreaType:=Area_Netmail;

         UpdateAction ('Scanning primary netmail area');

         CASE Config.FidoNetmailType OF
              FidoMsgType :
                  FidoMsg_ScanArea (NILRecordNr,AreaRec,TRUE,FALSE);

              SquishType :
                  Squish_ScanArea (NILRecordNr,AreaRec,TRUE,FALSE);

              JamType :
                  Jam_ScanArea (NILRecordNr,AreaRec,TRUE,FALSE);

         END; { case }
    END;

    {----------------------------------------------------------------------}
    { OpenAreaListing                                                      }
    {                                                                      }
    FUNCTION OpenAreaListing (Filename : STRING) : BOOLEAN;

    VAR IORes : BYTE;

    BEGIN
         Assign (EchoTossFile,Config.SystemDir+FileName);
         {$I-} Reset (EchoTossFile); {$I+} IORes:=IOResult;
         IF (IORes <> 0) THEN
         BEGIN
              LogDiskIOError (IORes,'Failed to open '+FileName);
              OpenAreaListing:=FALSE;
              Exit;
         END;

         {$IFDEF LogFileIO}PostOpenT (EchoTossFile);{$ENDIF}

         LogExtraMessage ('Using found '+FileName+' listing');
         OpenAreaLIsting:=TRUE;
    END;

    {----------------------------------------------------------------------}
    { CloseAreaListing                                                     }
    {                                                                      }
    { Sluit de lijst met areas, en geeft het aangevraagde geheugen weer    }
    { vrij.                                                                }
    {                                                                      }
    PROCEDURE CloseAreaListing;

    VAR IORes : BYTE;

    BEGIN
         { Sluit en verwijder de ECHOTOSS.LOG file }
         {$IFDEF LogFileIO}PreCloseT (EchoTossFile);{$ENDIF}
         {$I-} Close (EchoTossFile); {$I+} IORes:=IOResult;

         {$I-} Erase (EchoTossFile); {$I+} IORes:=IOResult;

         IF (IORes <> 0) THEN
            LogDiskIOError (IORes,'Failed to remove area listing');
    END;


    {----------------------------------------------------------------------}
    { AreaDone                                                             }
    {                                                                      }
    { Returns TRUE if the done bit is not set first the given area.        }
    {                                                                      }
    FUNCTION IsAreaDone (AreaRecNr : AreaBaseRecordNrType) : BOOLEAN;

    VAR AreasOfs : WORD;
        AreasBit : BYTE;

    BEGIN
         AreasOfs:=AreaRecNr DIV 8;
         AreasBit:=1 SHL (AreaRecNr-AreasOfs*8);

         IsAreaDone:=((AreasDonePtr^[AreasOfs] AND AreasBit) <> 0);
    END;

    {----------------------------------------------------------------------}
    { SetAreaDone                                                          }
    {                                                                      }
    { Sets the Done bit for the given area                                 }
    {                                                                      }
    PROCEDURE SetAreaDone (AreaRecNr : AreaBaseRecordNrType);

    VAR AreasOfs : WORD;
        AreasBit : BYTE;

    BEGIN
         AreasOfs:=AreaRecNr DIV 8;
         AreasBit:=1 SHL (AreaRecNr-AreasOfs*8);

         AreasDonePtr^[AreasOfs]:=AreasDonePtr^[AreasOfs] OR AreasBit;
    END;

{ FidoScan }

VAR EchoRegel    : STRING;
    AreaRecNr    : AreaBaseRecordNrType;
    FullScan     : BYTE;
    Lp           : WORD;
    AreasDoneCnt : WORD;
    AreaRec      : AreaBaseRecord;

BEGIN
     LogMessage (liTrivial,'SCAN for outgoing Local mail started');

     { Scan de NETMAIL directory voor uitgaande berichten }
     { Alleen voor BINKLEY systemen, Frontdoor systemen   }
     { regelen de netmail zelf.                           }

     IF (NOT ForceNoNet{mail}) THEN
        ScanNetmail;

     { Controleer of we alle areas willen scannen of alleen }
     { die genoemd worden in een ECHOMAIL.LOG/ECHOMAIL.JAM  }
     { file.                                                }
     IF ForceNoEcho THEN
        FullScan:=0 {Check alle areas}
     ELSE
         FullScan:=CheckForEchoTossFiles;

     IF (FullScan <> 0) THEN
     BEGIN
          AreasDoneCnt:=(AreaBaseRecCount DIV 8)+1;
          GetMem (AreasDonePtr,AreasDoneCnt);
          FillChar (AreasDonePtr^,AreasDoneCnt,0);
     END;

     CASE FullScan OF
          0 : { FullScan }
              FOR Lp:=1 TO AreaBaseRecCount DO
                  IF (NOT GlobalAbort) THEN
                  BEGIN
                       ReadAreaBaseRecord (Lp,AreaRec);
                       ScanArea (Lp,AreaRec);

                       IF KeyPressed AND (Ramon.ReadKey = kEsc) THEN
                          GlobalAbort:=TRUE;
                  END; { if, for }

          1 : { EchoToss }
              BEGIN
                   IF (NOT OpenAreaListing ('ECHOTOSS.LOG')) THEN
                      Exit;

                   { doorloop alle regels in de EchoToss File }
                   WHILE (NOT GlobalAbort) AND (NOT Eof (EchoTossFile)) DO
                   BEGIN
                        IF KeyPressed AND (Ramon.ReadKey = kEsc) THEN
                        BEGIN
                             GlobalAbort:=TRUE;
                             Break;
                        END;

                        { Lees een regel in en kijk of het een bestaande area is }
                        ReadLn (EchoTossFile,EchoRegel);
                        EchoRegel:=DeleteBackspaces (UpCaseString (EchoRegel));
                        AreaRecNr:=GetAreaBaseRecordNrByAreaName_F (EchoRegel);

                        IF (AreaRecNr = NILRecordNr) THEN
                        BEGIN
                             LogExtraMessage ('Ignoring undefined area '+EchoRegel);
                             Continue; { while }
                        END;

                        IF IsAreaDone (AreaRecNr) THEN
                           Continue;

                        { licht het betreffende record van zijn/haar bed }
                        ReadAreaBaseRecord (AreaRecNr,AreaRec);
                        ScanArea (AreaRecNr,AreaRec);
                        SetAreaDone (AreaRecNr);
                   END; { while}

                   CloseAreaListing;
              END; { FullScan = Echotoss.log }

          2 : { Echomail.Jam }
              BEGIN
                   IF (NOT OpenAreaListing ('ECHOMAIL.JAM')) THEN
                      Exit;

                   WHILE (NOT GlobalAbort) AND (NOT Eof (EchoTossFile)) DO
                   BEGIN
                        IF KeyPressed AND (Ramon.ReadKey = kEsc) THEN
                        BEGIN
                             GlobalAbort:=TRUE;
                             Break; { uit de while }
                        END;

                        { Lees een regel in en kijk of het een bestaande area is }
                        ReadLn (EchoTossFile,EchoRegel);
                        EchoRegel:=Copy (EchoRegel,1,Pos (' ',EchoRegel));
                        EchoRegel:=DeleteBackSpaces (UpCaseString (EchoRegel));

                        { Zoek het record dat bij het gegeven path hoort }
                        FOR Lp:=1 TO AreaBaseRecCount DO
                            IF (NOT IsAreaDone (Lp)) THEN
                            BEGIN
                                 ReadAreaBaseRecord (Lp,AreaRec);

                                 IF (AreaRec.FidoMsgStyle <> NoneType) AND
                                    (Pos (EchoRegel,UpCaseString (AreaRec.FidoMsgPath)) > 0) THEN
                                 BEGIN
                                      ScanArea (Lp,AreaRec);
                                      SetAreaDone (Lp);
                                      Break;
                                 END;
                            END; { if, for }

                   END; { while }

                   CloseAreaListing;
              END;
     END; { case }

     { als we aan de hand van echotoss.log of echomail.jam gescanned hebben }
     { dan toch nog even de netmail en e-mail areas doorlopen, tenzij       }
     { nonetscan gezet is.                                                  }
     IF (FullScan <> 0) AND (NOT ForceNoNet) AND (NOT GlobalAbort) THEN
     BEGIN
          LogMessage (liTrivial,'Scanning secondary netmail and e-mail areas');

          FOR Lp:=1 TO AreaBaseRecCount DO
              IF (NOT IsAreaDone (Lp)) AND (NOT GlobalAbort) THEN
              BEGIN
                   ReadAreaBaseRecord (Lp,AreaRec);
                   IF (AreaRec.AreaType IN [Area_Netmail,Area_Email]) THEN
                      ScanArea (Lp,AreaRec);
              END; { for }
     END;

     IF (FullScan <> 0) THEN
        FreeMem (AreasDoneptr,AreasDoneCnt);

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


{--------------------------------------------------------------------------}
{ FidoTossBad                                                              }
{                                                                          }
{ Deze routine scant de BAD area. De normale scan routine van een message  }
{ base wordt aangeroepen, maar met IsBadArea op TRUE gezet voor een        }
{ "speciale behandeling".                                                  }
{                                                                          }
PROCEDURE FidoTossBad;

VAR AreaRec : AreaBaseRecord;

BEGIN
     LogMessage (liTrivial,'TOSSBAD started');

     IF (Config.FidoBadAreaType = NoneType) THEN
     BEGIN
          LogMessage (liConfig,'No BAD area defined');
          Exit;
     END;

     FillChar (AreaRec,SizeOf (AreaBaseRecord),0);
     AreaRec.AreaName_F:='WtrBad';
     AreaRec.FidoMsgPath:=Config.FidoBadPath;
     AreaRec.AreaType:=Area_Echo; { anders gaat scan mis }

     CASE Config.FidoBadAreaType OF
          FidoMsgType :
              FidoMsg_ScanArea (NILRecordNr,AreaRec,FALSE,TRUE);

          SquishType :
              Squish_ScanArea (NILRecordNr,AreaRec,FALSE,TRUE);

          JamType :
              Jam_ScanArea (NILRecordNr,AreaRec,FALSE,TRUE);

     END; { case }

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


{--------------------------------------------------------------------------}
{ Scan_DeliverMessage                                                      }
{                                                                          }
{ This routine is called when one of the message base scan functions has   }
{ found a message to distribute. All tasks generic for all message bases   }
{ from that point onwards are in this function.                            }
{ The return value are the flags to set on the stored message.             }
{## split this for Netmail, Echomail and Email?                            }
{                                                                          }
FUNCTION Scan_DeliverMessage (AreaRecNr : AreaBaseRecordNrType;
                              IsBadArea : BOOLEAN) : ScanDeliverResultType;

VAR Lp        : BYTE;
    Result    : DeliverResultType;
    ForceKill : BOOLEAN;

BEGIN
     Scan_DeliverMessage:=sdError;

     { this is used to avoid import in the area we export from }
     Msg.ExportAreaRecNr:=AreaRecNr;

     { verwijderen van lokale vlaggen van een bericht
     Msg.Attr_F:=Msg.Attr_F AND ($FFFF-MSGLOCAL-MSGXX2);}

     IF (Msg.Ready_F = Local_Netmail) AND (Msg.Stored_ToUser = '') THEN
     BEGIN
          LogMessage (liFatal,'To-user is empty; not exporting message');
          { let the caller set the Orphan flag, which will prevent   }
          { the message from getting exported again and this message }
          { this show again for each and every scan.                 }
          Scan_DeliverMessage:=sdOrphan;
          Exit; { ## EXIT ## }
     END;

     ForceKill:=FALSE;

     { for the moment, just convert the destination into a proper }
     { DestRecord and send the message on its way.                }

     IF (Msg.Ready_F = Local_Echomail) THEN
     BEGIN
          Address_AddAreaToAreaRecNrsList (GetAreaBaseRecordNrByAreaName_F (Msg.Area_F));

          { prepare the internal SEEN-BY and PATH administration }
          SBP_StoreSeenBysAndPath (Msg.FromAddr_F.Zone);
          Address_AddEcho;
     END;

     IF (Msg.Ready_F = Local_Netmail) THEN
     BEGIN
          Address_AddFTN (Msg.Stored_ToUser,Msg.Stored_ToAddr,FALSE,FALSE);
          ForceKill:=((Msg.Attr_F AND MSGKILL) <> 0) OR
                     ((Msg.ExtAttr_F AND EXTMSGK_S) <> 0);

          IF (Config.KillAreaFixMsgs AND FidoOurAdres (Msg.Stored_ToAddr)) THEN
               IF (IsAreafixName (Msg.Stored_ToUser)) THEN
                   ForceKill:=TRUE;
     END;

     IF IsBadArea THEN
        ForceKill:=TRUE;

     Msg.DeliveringUserRecNr:=NILRecordNr; {WaterGate sends}

     { fill in the informational fields }
     Msg.ToUser_F:=Msg.Stored_ToUser;

     Result:=DeliverNow;

     CASE Result OF
          drNormal:
              Scan_DeliverMessage:=sdSent;

          drGated:
              IF Config.KillGatedNetmail THEN
                 Scan_DeliverMessage:=sdKill
              ELSE
                  Scan_DeliverMessage:=sdSent;

          drProcessed:
              Scan_DeliverMessage:=sdReceived;

          ELSE BEGIN
               LogMessage (liReport,'Unknown DeliverResult: '+Byte2String (Byte (Result)));
               Scan_DeliverMessage:=sdSent; { avoid nothing -> rescan!! }
          END;
     END; { case }

     IF ForceKill THEN
        Scan_DeliverMessage:=sdKill;
END;

END.
