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

{$i platform.inc}

{ History:

 RWI 960714: Started this unit.

}

INTERFACE

PROCEDURE SmtpToss;


IMPLEMENTATION

USES Dos,
     Ramon,
     Globals,
     Database,
     Logs,
     UserBase,
     AreaBase,
     Start,
     FBuffer,
     Msgs,
     Usenet,
     Address,
     NewStats;


{--------------------------------------------------------------------------}
{ ProcessWrkFile                                                           }
{                                                                          }
{ Deze routine verwerkt e'e'n .WRK file. De bijbehorende .TXT file wordt   }
{ opgezocht en beide worden verwerkt.                                      }
{                                                                          }
FUNCTION ProcessWrkFile (Path,Name : STRING) : BOOLEAN;

VAR TxtName   : STRING[13];
    WrkFile   : FBufferType;
    TxtSize   : LONGINT;

    {----------------------------------------------------------------------}
    { ProcessTxtFile                                                       }
    {                                                                      }
    PROCEDURE ProcessTxtFile;

    VAR TxtFile   : FBufferType;
        Regel,
        FromRegel : STRING;
        PrevHad13 : BOOLEAN;

    BEGIN
         TxtSize:=0; { in case of errors }

         IF (NOT FBufferOpen (TxtFile,Path+TxtName,5000,5000)) THEN
         BEGIN
              LogMessage (liFatal,'  Failed to open '+TxtName);
              FBufferClose (TxtFile);
              Exit;
         END;

         LogMessage (liTrivial,'  Processing (mail) '+TxtName);

         { klaarmaken om de body in te lezen }
         RFC_AddWhereTo:=Header_U;
         RFC_TossWhat:=twMail;
         PrevHad13:=FALSE;

         { Received: by dijkline.wlink.nl (0.01 beta/WaterGate) }
         {           via SMTP; Sat, 10 Jul 93 00:06:50 +0100    }

         Regel:='Received: by '+UseGetSystemFromName+' ('+ProgramShortName+' '+MainRevisionNr+')'+#13;
         RFC_AddTossedRegel (Regel,PrevHad13);

         Regel:='          via SMTP; '+UsenetArpaNetDate+#13;
         RFC_AddTossedRegel (Regel,PrevHad13);

         { ID? }

         { lees de .txt file in }
         WHILE FBReadLnLF (TxtFile,Regel) DO
               RFC_AddTossedRegel (Regel,PrevHad13);

         Msg.Ready_U:=Mail;

         TxtSize:=FileSize (TxtFile.Bestand);
         FBufferClose (TxtFile);  { geeft cache vrij }

         { process the message now }
         RFC_GoProcess;
    END;

{ProcessWrkFile}

VAR Regel  : STRING;
    Eraser : FILE;
    IORes  : BYTE;

    OldMail: LONGINT;

BEGIN
     OldMail := RetrieveInfoNr (INFO_SmtpIn_Mail);

     LogMessage (liTrivial,'  Processing (smtp) '+Name);

     { kijk of de .lck file er staat, zoja kappen }
     IF TestIfExist (Path+Copy (Name,1,Pos ('.WRK',UpCaseString (Name)))+'LCK') THEN
     BEGIN
          LogExtraMessage ('  Locked; skipping');
          Exit;
     END;

     { zelf een .lck file zetten? }

     { open de .wrk file }
     IF (NOT FBufferOpen (WrkFile,Path+Name,256,256)) THEN
     BEGIN
          LogMessage (liFatal,'  Failed to open '+Name);
          FBufferClose (WrkFile);
          { .lck file verwijderen! }
          Exit;
     END;

     { open de .txt file. Bestaat ie niet -> afkappen }
     TxtName:=Copy (Name,1,Pos ('.WRK',UpCaseString (Name)))+'TXT';
     IF (NOT TestIfExist (Path+TxtName)) THEN
     BEGIN
          LogExtraMessage ('  Cannot find '+TxtName);
          FBufferClose (WrkFile);
          { .lck file verwijderen! }
          Exit;
     END;

     MsgsEmptyKeepDeliveringUser; { initializes address list }

     { lees de .wrk file in }
     WHILE FBReadLnLF (WrkFile,Regel) DO
     BEGIN
          IF (UpCaseString (Copy (Regel,1,3)) = 'TO:') THEN
          BEGIN
               Delete (Regel,1,3);
               IF (Regel[Length (Regel)] = #13) THEN
                  Delete (Regel,Length (Regel),1);

               { pre-process the line in case some stupid application }
               { has just copied the header lines and has the full-   }
               { name part information in here.                       }
               Regel := UseGetAddress (DeleteFrontAndBackSpaces (Regel));

               { voeg deze recipient toe aan de lijst }
               Address_AddRFCRaw (DeleteFrontAndBackSpaces (Regel),destTo,FALSE,FALSE);
          END;
     END;

     FBufferClose (WrkFile);

     IF (Msg.FirstDest = NIL) THEN
     BEGIN
          LogMessage (liFatal,'No addresses found in .WRK file!');
          Exit;
     END;

     { process the .TXT file }
     ProcessTxtFile;

     UpdateInfoNr (INFO_SmtpIn_Bytes,TxtSize);
     { Update stats file }
     StatEntry_SmtpJob (stdInbound, PacketUserData.UUCPName, 'LOCAL', TxtSize,
                              RetrieveInfoNr (INFO_SmtpIn_Mail) - OldMail);

     { beide verwijderen }
     Assign (Eraser,Path+Name);
     {$I-} Erase (Eraser); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'Error deleting '+Path+Name);

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

     { verwijder .lck file? }
     { niet gezet, wel?... }

     { clean up after toss }
     MsgsEmptyKeepDeliveringUser;
END;


{--------------------------------------------------------------------------}
{ ScanSmtpIn                                                               }
{                                                                          }
{ Deze routine doorzoekt het SMTP-In pad voor PacketUserData. Als het pad  }
{ bestaat worden alle .WRK files gezocht en een voor een aangeboden voor   }
{ verwerking door ProcessWrkFile.                                          }
{                                                                          }
PROCEDURE ScanSmtpIn;

VAR Search : SearchRec;
    IORes  : BYTE;
    Path   : STRING;

LABEL Abort;

BEGIN
     { alle .WRK files aflopen }
     Path:=CorrectPath (PacketUserData.SmtpInPath);

     FindFirst (Path+'*.WRK',saJustFiles,Search);

     IF (DosError <> 0) AND (DosError <> 18{no more files}) THEN
        LogDiskIOError (DosError,'Cannot find SMTP-In path '+Path)
     ELSE BEGIN
          IF (DosError = 0) THEN
             LogMessage (liTrivial,'Checking SMTP-In for '+PacketUserData.UUCPName);

          WHILE (DosError = 0) AND (NOT GlobalAbort) DO
          BEGIN
               IF (NOT CheckMinDiskFree) THEN
                  Break; { from the while; calls FindClose }

               IF KeyPressed THEN
               BEGIN
                    GlobalAbort:=TRUE;
                    ReadKey; { weglezen }
                    Break; { from the while; calls FindClose }
               END;

               UpdateReadFile (Path+Search.Name,Search.Size);
               UpdateInfoNr (INFO_SmtpIn_Jobs,1);

               ProcessWrkFile (Path,Search.Name);

               FindNext (Search);
          END; { while }
     END; { if }

     FindClose (Search);
END;


{--------------------------------------------------------------------------}
{ SmtpToss                                                                 }
{                                                                          }
{ Deze routine scant de userbase voor SMTP users en scant daarna de        }
{ SMTP-In directory van die users.                                         }
{                                                                          }
PROCEDURE SmtpToss;

VAR Lp : UserBaseRecordNrType;

BEGIN
     LogMessage (liTrivial,'SMTP toss started on '+DateStamp);

     FOR Lp:=1 TO UserBaseRecCount DO
         IF (NOT GlobalAbort) THEN
         BEGIN
              Msg.DeliveringUserRecNr:=Lp;
              ReadUserBaseRecord (Lp,PacketUserData);

              IF (NOT PacketUserData.Deleted) AND (PacketUserData.System = _S) THEN
              BEGIN
                   UserDataRecNr:=Lp; { voor MsgsExport }
                   AreaCreatorUserBaseRecNr:=Lp;
                   PacketUserData.UUCPName:=UpCaseString (PacketUserData.UUCPName);

                   UpdateAction ('Checking SMTP-In for "'+PacketUserData.UUCPName+'"');

                   ScanSmtpIn; { for PacketUserData }

              END; { if }
         END; { if, for }

     LogMessage (liTrivial,'SMTP toss finished');
END;


END.
