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

{$i platform.inc}

{ $ DEFINE HDRDEBUG}

{ Header searching code (for POP3, SOUP) }

INTERFACE

USES Ramon,
     Logs,
     Database,
     Cfg,
     Address,
     Globals,
     Msgs,
     Usenet;

PROCEDURE HeaderSearch_SetEnvelope (Envelope: STRING);

PROCEDURE HeaderSearch_ScanLine (Line: STRING);
PROCEDURE HeaderSearch_CheckNoRecipients (Default: STRING);

IMPLEMENTATION

VAR EnvelopeHeader : STRING;      { Header to treat as X-Envelope: }


{ ------------------------------------------------------------------------ }
{ HeaderSearch_SetEnvelope                                                 }
{                                                                          }
{ Sets the 'envelope header' to the specified string.  If we are given an  }
{ envelope header, we only search for that header.  If EnvelopeHeader=='', }
{ the ScanLine procedure will check all headers (with some exceptions, see }
{ below.)                                                                  }
{                                                                          }
PROCEDURE HeaderSearch_SetEnvelope (Envelope: STRING);
BEGIN
{$IFDEF HDRDEBUG}
     IF Config.LogDebug THEN
          LogMessage (liDebug, '[HeaderSearch] Envelope header is: '+Envelope);
{$ENDIF}

     EnvelopeHeader := Envelope;
END;

CONST
     HeadersToSkip : ARRAY [1..11] OF STRING [30] =
                              ('Message-ID:',
                               'Approved:',
                               'From:',
                               'Sender:',
                               'X-',
                               'Reply-To:',
                               'In-Reply-To:',
                               'Organization:',
                               'Subject:',
                               'References:',
                               '');               { Terminator }
{ ------------------------------------------------------------------------ }
{ HeaderSearch_ScanLine                                                    }
{                                                                          }
{ Called by the POP3/SOUP reading code for every line in the message       }
{ header.  If we have been told of a specific envelope header by a call    }
{ to HeaderSearch_SetEnvelope, we /only/ search for that header.  If no    }
{ header has been specified, we search ALL headers, except:                }
{ Message-ID, In-Reply-TO, Organization, Subject, Reply-To, Approved, From }
{ Sender, X-*                                                              }
{                                                                          }
PROCEDURE HeaderSearch_ScanLine (Line: STRING);

     PROCEDURE AcceptEnvelopeHeader (Line: STRING);
     BEGIN
          IF (Line[Length (Line)] = #13) THEN
               Delete (Line,Length (Line),1);

{$IFDEF HDRDEBUG}          
          IF Config.LogDebug THEN
               LogMessage (liTrivial,'[HeaderSearch] Found envelope header: '+Line);
{$ENDIF}

          Delete (Line,1,Length (EnvelopeHeader));
          Line:=DeleteFrontAndBackSpaces (Line);

          Line:=UseGetAddress (Line);

          IF Config.LogDebug THEN
               LogMessage (liDebug, '[HeaderSearch] Adding recipient: '+Line);

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

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

BEGIN
     P := Pos (#13, Line);

     IF (P > 0) THEN
          Line:=Copy (Line,1,P-1);

     UpLine:=UpCaseString (Line);

     { Check for our envelope header }
     IF (EnvelopeHeader <> '') THEN
     BEGIN
          IF CaselessStartMatch (Line, EnvelopeHeader) THEN
          BEGIN
               AcceptEnvelopeHeader (Line);
               Exit;     { ## EXIT ## }
          END;
     END;

     { Don't process certain headers }
     Lp := 1;
     WHILE (HeadersToSkip [Lp] <> '') DO
     BEGIN
          IF CaselessStartMatch (Line, HeadersToSkip [Lp]) THEN
          BEGIN
{$IFDEF HDRDEBUG}               
               IF Config.LogDebug THEN
                    LogMessage (liDebug, '[HeaderSearch] Skipping header: '+Line);
{$ENDIF}
               Exit;     { ## EXIT ## }
          END;

          Inc (Lp);
     END;

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

               IF (P > 0) THEN
               BEGIN
                    { found a header that might match }
{$IFDEF HDRDEBUG}                    
                    IF Config.LogDebug THEN
                       LogMessage (liDebug,'[HeaderSearch] Possible Header: "'+Line+'"');
{$ENDIF}
                    IF NOT (Line[1] IN [' ',#9]) THEN
                    BEGIN
                         Line:=Line+' ';
                         Delete (Line,1,Pos (' ',Line));
                    END;

                    Line:=UseGetAddress (Line);

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

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

                         Address_AddRFCRaw (Line,destTo,{Note:}FALSE,{ByFilter:}FALSE);
                    END;
               END;
          END; { if }
     END; { for }
END;

{ ------------------------------------------------------------------------ }
{ HeaderSearch_CheckNoRecipients                                           }
{                                                                          }
{ Should be called just before GoProcess is executed to add the 'default   }
{ recipient' if no header was found with a suitable address.               }
{                                                                          }
PROCEDURE HeaderSearch_CheckNoRecipients (Default: STRING);
BEGIN
     IF (Msg.FirstDest = NIL) THEN
     BEGIN
          IF (EnvelopeHeader = '') THEN
               LogMessage (liTrivial, '[HeaderSearch] Envelope header ('+EnvelopeHeader+') not found in message')
          ELSE
               LogMessage (liTrivial, '[HeaderSearch] No suitable address found in header');
     
          LogMessage (liGeneral, '[HeaderSearch] Delivering message to: '+Default);
          Address_AddRFCRaw (Default, destTo, False, False);
     END;
END;

BEGIN
     EnvelopeHeader := '';
END.




