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

{$i platform.inc}

{ support for inbound POP3 mailbox files }

INTERFACE

PROCEDURE Pop3Toss;


IMPLEMENTATION

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

{--------------------------------------------------------------------------}
{ TossPop3Mailbox                                                          }
{                                                                          }
{ Deze routine kijkt of een mailbox file bestaat. Zoja, dan wordt ie       }
{ verwerkt en verwijderd (hernoemd?).                                      }
{                                                                          }
PROCEDURE TossPop3Mailbox (MailboxFile,
                           Recipient,
                           Separator,
                           EnvelopeHdr : STRING;
                           IgnoreCR    : BOOLEAN);

    PROCEDURE Pop3Process;
    BEGIN
         Msg.Ready_U:=Mail;

         (*
         IF (Msg.FirstDest = NIL) THEN
         BEGIN
              IF (EnvelopeHdr <> '') THEN
                 LogMessage (liGeneral,'POP3 envelope header not found!');

              LogMessage (liGeneral,'Sending to '+Recipient);
              Address_AddRFCRaw (Recipient,destTo,FALSE,FALSE);
         END;
         *)

         HeaderSearch_CheckNoRecipients (Recipient);
         RFC_GoProcess;

         { prepare for processing next message in POP3 with new }
         { recipients and all.                                  }
         MsgsEmptyKeepDeliveringUser;
    END;

     (*
    PROCEDURE CheckEnvelopeHdr (Regel : STRING);
    BEGIN
         IF (Regel[Length (Regel)] = #13) THEN
            Delete (Regel,Length (Regel),1);

         IF Config.LogDebug THEN
            LogMessage (liTrivial,'Found POP3 envelope header: '+Regel);

         Delete (Regel,1,Length (EnvelopeHdr));
         Regel:=DeleteFrontAndBackSpaces (Regel);

         Regel:=UseGetAddress (Regel);

         Address_AddRFCRaw (Regel,destTo,FALSE,FALSE);
    END;

    PROCEDURE SearchHeaderLine (Regel : STRING);

    VAR Lp      : BYTE;
        UpRegel : STRING;
        P,P2    : BYTE;

    BEGIN
         P:=Pos (#13,Regel);
         IF (P > 0) THEN
            Regel:=Copy (Regel,1,P-1);

         UpRegel:=UpCaseString (Regel);

         FOR Lp:=1 TO MaxSystemDomains DO
             IF (Config.Domains[Lp] <> '') THEN
             BEGIN
                  P:=Pos (UpCaseString (Config.Domains[Lp]),UpRegel);

                  IF (P > 0) THEN
                  BEGIN
                       { found a header that might match }
                       LogMessage (liDebug,'Pop3Header: "'+Regel+'"');

                       IF NOT (Regel[1] IN [' ',#9]) THEN
                       BEGIN
                            Regel:=Regel+' ';
                            Delete (Regel,1,Pos (' ',Regel));
                       END;

                       Regel:=UseGetAddress (Regel);

                       { avoid finding otherdomain.com if we are domain.com }
                       UpRegel:=UpCaseString (Regel);
                       P:=Pos (UpCaseString (Config.Domains[Lp]),UpRegel);

                       { can be domain.com!user }
                       IF (P > 0) AND (Regel[P-1] IN ['.','@']) THEN
                       BEGIN
                            IF Config.LogDebug THEN
                               LogMessage (liTrivial,'Found in header: '+Regel);

                            Address_AddRFCRaw (Regel,destTo,{Note:}FALSE,{ByFilter:}FALSE);
                       END;
                  END;

             END; { if, for }
    END;
     *)

{TossPop3Mailbox}

VAR Mailbox   : FBufferType;
    IsHeader  : BOOLEAN;
    PrevHad13 : BOOLEAN;
    PrevEmpty : BOOLEAN;
    Regel     : STRING;
    IORes     : BYTE;
    OldMail   : LONGINT;

BEGIN
     OldMail := RetrieveInfoNr (INFO_Pop3In_Mail);

     IF (MailboxFile = '') OR (NOT CheckMinDiskFree) THEN
        Exit;

     IF (NOT FBufferOpen (MailBox,MailboxFile,5000,5000)) THEN
     BEGIN
          FBufferClose (MailBox);
          Exit;
     END;

     LogMessage (liTrivial,'Processing '+MailboxFile);

     UpdateAction ('Processing POP3 mailbox');
     UpdateReadFile (MailboxFile,FileSize (MailBox.Bestand));

     UpdateInfoNr (INFO_Pop3In_Jobs,1);

     EnvelopeHdr:=UpCaseString (EnvelopeHdr);

     IF (Recipient = '') THEN
        Recipient:='postmaster@'+Config.Domains[1];

     HeaderSearch_SetEnvelope (EnvelopeHdr);

     MsgsEmptyKeepDeliveringUser;

     PrevHad13:=FALSE;
     PrevEmpty:=FALSE;
     IsHeader:=TRUE;

     WHILE FBReadLnLF (MailBox,Regel) DO
     BEGIN
          IF (NOT IsHeader) THEN
          BEGIN
               { body }
               IF (IgnoreCR OR PrevEmpty) AND
                  (Copy (Regel,1,Length (Separator)) = Separator) THEN
               BEGIN
                    Pop3Process;
                    IsHeader:=TRUE;
                    { line is processed below }
                    { must be like this or EnvelopeHeader = Separator won't work }
               END ELSE
               BEGIN
                    RFC_PreCheckBodyLine (Regel);
                    MsgsAddLineToNoEOL (Body,Regel);
                    PrevEmpty:=(Regel = #13);
               END;
          END;

          IF IsHeader THEN
          BEGIN
               { header }
               IF (PrevHad13) AND (Regel = #13) THEN
               BEGIN
                    { transition from header to body }
                    IsHeader:=FALSE;

                    { check the header for MIME and Content-Type so we can }
                    { act on boundary headers while reading the message.   }
                    RFC_CompleteAdmin;
               END ELSE
               BEGIN
                    (*
                    IF (EnvelopeHdr <> '') THEN
                    BEGIN
                         IF CaselessStartMatch (Regel,EnvelopeHdr) THEN
                            CheckEnvelopeHdr (Regel);
                    END ELSE
                        SearchHeaderLine (Regel);
                    *)

                    HeaderSearch_ScanLine (Regel);

                    { always add the Received: or envelope header now }
                    MsgsAddLineToNoEOL (Header_U,Regel);
                    PrevHad13:=Regel[Length (Regel)] = #13;
               END;
          END;
     END; { while }

     { verwerk het laatste bericht ook! }
     Pop3Process;

     UpdateInfoNr (INFO_Pop3In_Bytes,FileSize (MailBox.Bestand));

     { Update stats }
     StatEntry_Pop3Job (PacketUserData.UUCPName, 'LOCAL',
                    FileSize (MailBox.Bestand),
                    RetrieveInfoNr (INFO_Pop3In_Mail) - OldMail);

     FBufferClose (MailBox);

     {$I-} Erase (MailBox.Bestand); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'Error deleting '+Mailbox.Filename);

     { clean up after toss }
     MsgsEmptyKeepDeliveringUser;
END;


{--------------------------------------------------------------------------}
{ Pop3Toss                                                                 }
{                                                                          }
{ Deze routine wordt aangeroepen om alle ontvangen POP3 mailbox files te   }
{ vinden en te verwerken.                                                  }
{                                                                          }
PROCEDURE Pop3Toss;

VAR Lp       : UserBaseRecordNrType;
    Search   : SearchRec;
    IgnoreCR : BOOLEAN;

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

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

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

                        { an * at the start means WG should not require }
                        { an empty line before the separator.           }
                        Pop3Separator:=DeleteFrontSpaces (Pop3Separator);
                        IgnoreCR:=(Pop3Separator <> '') AND (Pop3Separator[1] = '*');
                        IF IgnoreCR THEN
                           Delete (Pop3Separator,1,1);

                        Pop3Separator:=DeleteFrontAndBackSpaces (Pop3Separator);
                        IF (Pop3Separator = '') THEN
                           Pop3Separator:='From';

                        IF CaselessMatch (Pop3Separator,'From') THEN
                           Pop3Separator:=Pop3Separator+' ';

                        IF Config.LogDebug THEN
                           LogMessage (liTrivial,'Searching '+Pop3File);

                        FindFirst (Pop3File,saJustFiles,Search);
                        WHILE (DosError = 0) DO
                        BEGIN
                             TossPop3Mailbox (ExtractPathPart (Pop3File)+Search.Name,
                                              Pop3Recipient,
                                              Pop3Separator,
                                              Pop3EnvelopeHdr,
                                              IgnoreCR);
                             FindNext (Search);
                        END; { while }

                        FindClose (Search);

                   END; { if }
              END; { with }

         END; { if, for }

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

END.
