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

{$i platform.inc}

{ Routines om een routing tabel te creeren, te bewerken en om gegevens }
{ eruit te halen.                                                      }

{ History:

MD   31-03-93 Toevoegen van routines aan de 'real version'
RvdW 04-04-93 Alle routing routines hier naartoe verhuisd.
MD   27-06-93 Flink in de routing zitten sleutelen
     08-09-93 Toevoegen van controle op ROUTE-TO adres
     14-11-93 Link gelegt naar michels UUCP routing routines
     11-03-94 BAG file leveranciers worden niet in de routing table
              opgenomen.

RWI 950625  FILTER commando toegevoegd.
}

INTERFACE

USES Database,
     ReadRout,
     DList,
     Msgs;

FUNCTION  FindRoute (AdresTo : FidoAddrType; VAR ToAddr : FidoAddrType) : BYTE;
FUNCTION  GetFIDO_2_UUCP (FromUser : STRING; FromAKA : FidoAddrType; VAR Adres : STRING) : BOOLEAN;
PROCEDURE MapFTN (DestPtr : DestRecordPtr);
FUNCTION  MapFidoCheck (ToUser : STRING; ToAka : FidoAddrType) : BOOLEAN;
PROCEDURE MapRFC (DestPtr : DestRecordPtr);
PROCEDURE AddSignature;
FUNCTION  CheckFilter (Name : STRING; VAR NewPath : STRING) : BOOLEAN;
FUNCTION  RFC_CheckAndHandleSendFile (ToUser : STRING) : BOOLEAN;
FUNCTION  FidoSendFileCheck (UpToName : STRING) : BOOLEAN;
FUNCTION  FTN_CheckAndHandleSendFile (ToName : STRING) : BOOLEAN;
FUNCTION  CheckAndHandleTunnelFrom (DestPtr : DestRecordPtr) : BOOLEAN;
FUNCTION  GetMailTunnelTo (Addr : FidoAddrType) : MailTunnelPtr;
FUNCTION  CheckForcePack (Addr : FidoAddrType) : BOOLEAN;
FUNCTION  IsCustomSkipName (UpName : STRING) : BOOLEAN;
FUNCTION  CheckForRouteTdbBounce : BOOLEAN;
FUNCTION  HaveNotLocalRecord (Domain : STRING) : BOOLEAN;
FUNCTION  IsMimeAttachment (MimeType : STRING) : BOOLEAN;

{$IFDEF WtrTest}
PROCEDURE Routing_ListTables;
{$ENDIF (WtrTest)}

CONST MAX_CUSTOMSKIPUSERNAMES = 5;

VAR FirstRouteRecordPtr : RouteRecordPtr;

    FidoMappingList : List;
    UUCPMappingList : List;
    SignatureList   : List;
    FilterList      : List;
    SendFileList    : List;
    BounceList      : List;
    MailTunnelList  : List;
    ForcePackList   : List;
    NotLocalList    : List;
    MimeAttachList  : List;

    CustomSkipCount     : 0..MAX_CUSTOMSKIPUSERNAMES;
    CustomSkipUsernames : ARRAY[1..MAX_CUSTOMSKIPUSERNAMES] OF STRING[MaxLenUserName_F];

    Mail2NewsAddress : STRING[MaxLenDomain];
    NewsDomain       : STRING[MaxLenDomain];

    BBSEmailAreaRecNr,
    BBSNormalAreaRecNr : AreaBaseRecordNrType;
    BBSViaRecNr        : UserBaseRecordNrType;


IMPLEMENTATION

USES Ramon,
     Fido,
     Cfg,
     Logs,
     UseAdres,
     Trans,
     {Translat,}
     Globals,
     SwapMem,
     Dos,
     AreaBase,
     Usenet,
     UUCPRout,
     Decode,
     UU,
     Charsets,
     Deliver,
     Language,
     Import;


{--------------------------------------------------------------------------}
{ IsCustomSkipName                                                         }
{                                                                          }
{ Return TRUE if UpName (uppercased, no back spaces) can be found in the   }
{ CustomSkipUserNames array.                                               }
{                                                                          }
FUNCTION IsCustomSkipName (UpName : STRING) : BOOLEAN;

VAR Lp : BYTE;

BEGIN
     IsCustomSkipName:=TRUE;

     FOR Lp:=1 TO CustomSkipCount DO
         IF (UpName = CustomSkipUserNames[Lp]) THEN
            Exit;

     IsCustomSkipName:=FALSE;
END;


{--------------------------------------------------------------------------}
{ MapFTN                                                                   }
{                                                                          }
{ This routine is called by DeliverNetmail to check the destination FTN    }
{ address for possible MAP-FIDO mappings. This routine must be called for  }
{ destFTN records only!                                                    }
{                                                                          }
PROCEDURE MapFTN (DestPtr : DestRecordPtr);

VAR Tmp    : MapRecordPtr;
    LocStr : EenRegelRecordPtr;
    X      : BYTE;
    XTo,
    XFrom  : FidoAddrType;
    TmpLine: STRING;

LABEL Verder;

BEGIN
     {## change execution though push/pop and moving destination to new copy? }
     Tmp:=FidoMappingList.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          IF CaselessMatch (DestPtr^.ToUser_F,Tmp^.LName) THEN
          BEGIN
               { We hebben een entry gevonden, nu kijken wat ermee moet }
               { gebeuren                                               }
               { Als er een TO_ADDRESS gespecificeerd is, controleer    }
               { dan of die ook overeenkomen                            }
               IF (Tmp^.LFidoAddr.Zone <> 0) THEN
                  IF (NOT FidoCompare (Tmp^.LFidoAddr,DestPtr^.ToAddr_F)) THEN
                     GOTO Verder;

               CASE Tmp^.RType OF
                    1 : BEGIN
                             { Simpel! ;-) Map fido naam naar nieuwe naam }

                             { Maar het wordt vervelend als het TO adres }
                             { niet overeen komt!                        }
                             IF (Tmp^.RFidoAddr.Zone <> 0) AND
                                (NOT FidoOurAdres (Tmp^.RFidoAddr)) THEN
                             BEGIN
                                  IF Config.LogMapApply THEN
                                     LogMessage (liTrivial,'Mapping: "'+DestPtr^.ToUser_F+'"%'+Fido2Str (DestPtr^.ToAddr_F)+
                                                 ' -> "'+Tmp^.RName+'"%'+Fido2Str (Tmp^.RFidoAddr));

                                  { Dump de complete fido header, en creer een nieuwe }

                                  {## loosing RFC header kludges here!!}
                                  { commented out since the INTL, FMPT and TOPT headers are not }
                                  { stored in the Header_F anymore anyway - see if this works.  }
                                  {MsgsReleaseLines (Msg.HeaderTop_F);}

                                  { RWI 960223: Changed Header_F into Body }
                                  MsgsAddFirstLineTo (Body,'');
                                  MsgsAddFirstLineTo (Body,'Mapped to    : '+Fido2Str (Tmp^.RFidoAddr));
                                  MsgsAddFirstLineTo (Body,'Originaly to : '+Fido2Str (DestPtr^.ToAddr_F));
                                  MsgsAddFirstLineTo (Body,'This message was rerouted at '+Fido2Str (Config.NodeNrs[1]));

                                  DestPtr^.ToUser_F:=Tmp^.RName;
                                  DestPtr^.ToAddr_F:=Tmp^.RFidoAddr;

                                  XTo:=DestPtr^.ToAddr_F;
                                  XTo.Point:=0;

                                  XFrom:=Msg.FromAddr_F;
                                  XFrom.Point:=0;

                                  (* now done when netmail is written out
                                  MsgsAddLineTo (Header_F,#1'INTL: '+Fido2Str (XTo)+' '+Fido2Str (XFrom));

                                  IF (Msg.FromAddr_F.Point > 0) THEN
                                     MsgsAddLineTo (Header_F,#1'FMPT '+Word2String (Msg.FromAddr_F.Point));

                                  IF (Msg.ToAddr_F.Point > 0) THEN
                                     MsgsAddLineTo (Header_F,#1'TOPT '+Word2String (Msg.ToAddr_F.Point));
                                  *)
                             END ELSE
                             BEGIN
                                  IF Config.LogMapApply THEN
                                     LogMessage (liTrivial,'Mapping: "'+DestPtr^.ToUser_F+'" -> "'+Tmp^.RName+'"');

                                  DestPtr^.ToUser_F:=Tmp^.RName;
                             END;

                             Break; { uit de while }
                        END; { 1 }

                    3 : BEGIN
                             { Simpel! Plaats een TO: line in de eerste }
                             { regel van het bericht, en stuur het naar }
                             { de gateway.                              }
                             IF Config.LogMapApply THEN
                                LogMessage (liTrivial,'Mapping: "'+DestPtr^.ToUser_F+'"%'+Fido2Str (DestPtr^.ToAddr_F)+
                                            ' -> '+Tmp^.RName);

                             DestPtr^.ToAddr_F:=Config.NodeNrs[Config.GatewayAKA];
                             DestPtr^.ToUser_F:=Config.GateWayUser;
                             MsgsAddFirstLineTo (Body,'TO: '+Tmp^.RName);

                             Break; { uit de while }
                        END; { 3 }

               END; { case }
          END;

Verder:
          Tmp:=FidoMappingList.GetNextItem;
     END; { while }
END;


{--------------------------------------------------------------------------}
{ MapFidoCheck                                                             }
{                                                                          }
{ Deze routine kijkt of een MAP-FIDO statement van toepassing kan zijn op  }
{ een bericht. Zoja, dan wordt TRUE terug gegeven, anders FALSE.           }
{                                                                          }
FUNCTION MapFidoCheck (ToUser : STRING; ToAka : FidoAddrType) : BOOLEAN;

VAR Tmp : MapRecordPtr;

BEGIN
     Tmp:=FidoMappingList.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          IF CaselessMatch (ToUser,Tmp^.LName) THEN
             IF (Tmp^.RType = 1) OR (Tmp^.RType = 3) THEN
                IF (Tmp^.LFidoAddr.Zone = 0) OR FidoCompare (Tmp^.LFidoAddr,ToAka) THEN
                BEGIN
                     MapFidoCheck:=TRUE;
                     Exit;
                END;

          Tmp:=FidoMappingList.GetNextItem;
     END; { while }

     MapFidoCheck:=FALSE;
END;


{--------------------------------------------------------------------------}
{ MapRFC                                                                   }
{                                                                          }
{ This routine performs the MAP-UUCP stuff on a DestRecord.                }
{                                                                          }
PROCEDURE MapRFC (DestPtr : DestRecordPtr);

VAR MapIt  : STRING;
    Tmp    : MapRecordPtr;

    { source }
    SVorm      : EForm;
    DomainAdr,
    User       : STRING;

    { target }
    TVorm      : EForm;
    TDomainAdr,
    TUser      : STRING;

BEGIN
     Tmp:=UUCPMappingList.GetFirstItem;

     MapIt:='Mapping: '+DestPtr^.To_U+' -> ';

     WHILE (Tmp <> NIL) DO
     BEGIN
          { negeer mapping statements die alleen voor Fido->Usenet zijn }
          IF (Tmp^.MapType = UUCP_Map_FU) THEN
          BEGIN
               Tmp:=UUCPMappingList.GetNextItem; { RWI 291094: bugfix! (was endless loop) }
               Continue;
          END;

          {## move outside of the search loop? }
          SVorm:=UseAdresParse (DestPtr^.To_U,DomainAdr,User);

          { als er geen domain adres is, maar alleen een user name, }
          { dan mag die usernaam ook als domain naam gezien worden, }
          { zodat de mapping statements er op werken.               }
          IF (DomainAdr = '') THEN
             DomainAdr:=User;

          { Kan de volgende vormen herkennen en omzetten              }
          {                                                           }
          { (type 2)                                                  }
          { martijnd@dijkline.wlink.nl  -1-> "Martijn Dijk"%2:280/802 }
          { martijnd@Dijkline.wlink.nl  -2-> super.link.nl            }
          { martijnd@dijkline.wlink.nl  -3-> martijnd@super.link.nl   }
          {                                                           }
          { (type 3)                                                  }
          { dijkline.wlink.nl           -1-> 2:280/802                }
          { dijkline.wlink.nl           -2-> super.link.nl            }
          { dijkline.wlink.nl           -3-> sysop@super.link.nl      }
          IF (Tmp^.LType = 3{user@domain}) AND (Tmp^.RType IN [2,3]{(user@)domain}) THEN
          BEGIN
               TVorm:=UseAdresParse (Tmp^.LName,TDomainAdr,TUser);

               IF (SVorm IN [Lokaal,Domain]) AND
                  CaselessMatch (DomainAdr,TDomainAdr) AND
                  CaselessMatch (TUser,User) THEN
               BEGIN
                    IF (Tmp^.RType = 2{domain}) THEN
                       DestPtr^.To_U:=TUser+'@'+Tmp^.RName
                    ELSE
                        DestPtr^.To_U:=Tmp^.RName;

                    IF Config.LogMapApply THEN
                       LogMessage (liTrivial,MapIt+DestPtr^.To_U);

                    Exit;
               END;
          END;

          IF (Tmp^.LType = 2{domain}) AND (Tmp^.RType = 3{user@domain}) THEN
          BEGIN
               TVorm:=UseAdresParse (Tmp^.LName,TDomainAdr,TUser);

               IF (SVorm IN [Lokaal,Domain]) AND
                  CaselessMatch (DomainAdr,TDomainAdr) THEN
               BEGIN
                    DestPtr^.To_U:=Tmp^.RName;

                    IF Config.LogMapApply THEN
                       LogMessage (liTrivial,MapIt+DestPtr^.To_U);

                    Exit;
               END;

          END;

          IF (Tmp^.LType = 2{domain}) AND (Tmp^.RType = 2{user@domain}) THEN
          BEGIN
               TVorm:=UseAdresParse (Tmp^.LName,TDomainAdr,TUser);

               IF (SVorm IN [Lokaal,Domain]) AND
                  CaselessMatch (DomainAdr,TUser) THEN
               BEGIN
                    DestPtr^.To_U:=User+'@'+Tmp^.RName;

                    IF Config.LogMapApply THEN
                       LogMessage (liTrivial,MapIt+DestPtr^.To_U);

                    Exit;
               END;
          END;

          IF (Tmp^.LType = 3{user@domain}) AND (Tmp^.RType = 1{"User"%aka}) THEN
          BEGIN
               TVorm:=UseAdresParse (Tmp^.LName,TDomainAdr,TUser);

               IF (SVorm IN [Lokaal,Domain]) AND
                  CaselessMatch (DomainAdr,TDomainAdr) AND
                  ((User <> '') AND CaselessMatch (TUser,User)) THEN
               BEGIN
                    IF (Tmp^.RFidoAddr.Zone = 0) THEN
                       Tmp^.RFidoAddr:=Config.NodeNrs[Config.GatewayAKA];

                    IF (Tmp^.RName <> '') THEN
                       DestPtr^.ToUser_F:=Tmp^.RName
                    ELSE
                        DestPtr^.ToUser_F:=TUser;

                    DestPtr^.ToAddr_F:=Tmp^.RFidoAddr;
                    DestPtr^.Status:=destFTN;

                    IF Config.LogMapApply THEN
                       LogMessage (liTrivial,MapIt+'"'+DestPtr^.ToUser_F+'"%'+Fido2Str (Tmp^.RFidoAddr));

                    Exit;
               END;
          END;

          IF (Tmp^.LType = 2{domain}) AND (Tmp^.RType = 1{aka}) THEN
          BEGIN
               IF CaselessMatch (DomainAdr,Tmp^.LName) THEN
               BEGIN
                    IF (Tmp^.RFidoAddr.Zone = 0) THEN
                       Tmp^.RFidoAddr:=Config.NodeNrs[Config.GatewayAKA];

                    IF (Tmp^.RName <> '') THEN
                       DestPtr^.ToUser_F:=Tmp^.RName
                    ELSE
                        DestPtr^.ToUser_F:=FtnizeUserName (User);

                    DestPtr^.ToAddr_F:=Tmp^.RFidoAddr;
                    DestPtr^.Status:=destFTN;

                    IF Config.LogMapApply THEN
                       LogMessage (liTrivial,MapIt+'"'+DestPtr^.ToUser_F+'"%'+Fido2Str (Tmp^.RFidoAddr));

                    Exit;
               END;
          END;

          Tmp:=UUCPMappingList.GetNextItem;
     END; { while }
END;


{--------------------------------------------------------------------------}
{ GetFIDO_2_UUCP                                                           }
{                                                                          }
{ Kijkt of er in de routing table aparte addressen zijn gedefinieerd       }
{ die niet de 'standaard' routing moeten krijgen.                          }
{                                                                          }
{ User+FidoAddress          ---------> Full Domain Name                    }
{                                      Domain Name                         }
{ FidoAddress               ---------> Full Domain Name                    }
{                                      Domain Name                         }
{                                                                          }
FUNCTION GetFIDO_2_UUCP (FromUser : STRING; FromAKA : FidoAddrType;
                         VAR Adres : STRING) : BOOLEAN;

VAR Found,
    Tmp    : MapRecordPtr;

BEGIN
     GetFIDO_2_UUCP:=FALSE;

     Found:=NIL;
     Tmp:=UUCPMappingList.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          { negeer commando's die alleen voor Usenet -> Fido zijn bedoeld }
          IF (Tmp^.MapType = UUCP_Map_UF) THEN
          BEGIN
               Tmp:=UUCPMappingList.GetNextItem;
               Continue;
          END;

          { Is dit een type 1 aan de rechterkant ? }
          IF (Tmp^.RType = 1) THEN
          BEGIN
               { Als alleen adres overeenkomt zoek dan verder naar een }
               { betere match, als ook de namen overeenkomen hebben we }
               { gevonden wat we zochten.                              }
               IF FidoCompare (Tmp^.RFidoAddr,FromAKA) THEN
               BEGIN
                    IF (Tmp^.RName = '') THEN
                       Found:=Tmp
                    ELSE
                        IF CaselessMatch (FromUser,Tmp^.RName) THEN
                        BEGIN
                             Found:=Tmp;
                             Break; { uit de while }
                        END;
               END;
          END;

          Tmp:=UUCPMappingList.GetNextItem;
     END; { while }

     IF (Found <> NIL) THEN
     BEGIN
          Adres:=Found^.LName;
          GetFIDO_2_UUCP:=TRUE;
          Exit;
     END;

     { RWI 960313 }
     { Als ie niet gevonden is nu en dit adres is een point adres, }
     { dan zoeken we nog een keer maar nu naar een node adres waar }
     { dit point adres bij hoort en zonder naam aan de R-kant. Dan }
     { wordt die genomen en p#. ervoor gezet.                      }
     { We nemen de eerste de beste match.                          }

     IF (FromAKA.Point = 0) THEN
        Exit;  { heeft geen zin }

     Found:=NIL;
     Tmp:=UUCPMappingList.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          { negeer commando's die alleen voor Usenet -> Fido zijn bedoeld }
          IF (Tmp^.MapType = UUCP_Map_UF) THEN
          BEGIN
               Tmp:=UUCPMappingList.GetNextItem;
               Continue;
          END;

          { Is dit een type 1 aan de rechterkant ? }
          IF (Tmp^.RType = 1) AND (Tmp^.RName = '') THEN
          BEGIN
               IF (Tmp^.RFidoAddr.Point = 0) AND
                  (Tmp^.RFidoAddr.Zone = FromAKA.Zone) AND
                  (Tmp^.RFidoAddr.Net = FromAKA.Net) AND
                  (Tmp^.RFidoAddr.Node = FromAKA.Node) THEN
               BEGIN
                    Adres:='p'+Word2String (FromAKA.Point)+'.'+Tmp^.LName;
                    GetFIDO_2_UUCP:=TRUE;
                    Exit;
               END;
          END;

          Tmp:=UUCPMappingList.GetNextItem;
     END; { while }

     { return with FALSE: not found }
END;


{--------------------------------------------------------------------------}
{ AddSignature                                                             }
{                                                                          }
{ Voegt een een 'handtekening' aan een bericht toe, dat door de gateway    }
{ gaat. Dit wordt alleen gedaan als er een voor deze persoon of systeem    }
{ gereserveerd is.                                                         }
{                                                                          }
{ RWI 941127: toevoeging van split regel voor de eigenlijke signature.     }
{                                                                          }
{ RWI 970120: added level checking to allow signatures for 51:51/* etc.    }
{                                                                          }
PROCEDURE AddSignature;

VAR Found,
    Tmp        : SignaturePtr;
    CheckMail  : STRING[80];
    CheckName  : STRING[80];
    Match      : BOOLEAN;
    Signature  : TEXT;
    IORes      : BYTE;
    FoundLevel : BYTE;

BEGIN
     CheckMail:=UpCaseString (UsenetReplyAdres);
     CheckName:=UpCaseString (DeleteBackSpaces (Msg.FromUser_F));

     { de laatst overeenkomende wordt genomen }
     { de gebruikers moeten maar sorteren in de route.tdb file }

     FoundLevel:=0;
     Found:=NIL;

     Tmp:=SignatureList.GetFirstItem;
     WHILE (Tmp <> NIL) DO
           WITH Tmp^ DO
           BEGIN
                IF (Level = 255) THEN
                BEGIN
                     IF (Pos (Tmp^.UserName,CheckMail) > 0) THEN
                     BEGIN
                          Found:=Tmp;
                          FoundLevel:=Level;
                     END;
                END ELSE
                BEGIN
                     { fido }

                     { see if the addresses match }
                     Match:=TRUE;

                     IF (Level >= 1) AND (Address.Zone <> Msg.FromAddr_F.Zone) THEN
                        Match:=FALSE;

                     IF (Level >= 2) AND (Address.Net <> Msg.FromAddr_F.Net) THEN
                        Match:=FALSE;

                     IF (Level >= 3) AND (Address.Node <> Msg.FromAddr_F.Node) THEN
                        Match:=FALSE;

                     IF (Level >= 4) AND (Address.Point <> Msg.FromAddr_F.Point) THEN
                        Match:=FALSE;

                     IF (UserName <> '') AND (UserName <> CheckName) THEN
                        Match:=FALSE;

                     IF Match THEN
                        IF (Level > FoundLevel) THEN
                        BEGIN
                             { new best so far }
                             Found:=Tmp;
                             FoundLevel:=Level;
                        END;
                END;

                Tmp:=SignatureList.GetNextItem;
           END; { with, while }

     { Als we een match gevonden hebben plakken we het tekstfiletje aan }
     { het bericht vast.                                                }
     IF (Found <> NIL) THEN
     BEGIN
          Assign (Signature,Found^.Path);
          {$I-} Reset (Signature); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Unable to open SIGNATURE file '+Found^.Path);
               Exit;
          END;

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

          IF Config.LogDebug THEN
             LogMessage (liTrivial,'Adding signature '+Found^.Path);

          { voeg een lege regel toe }
          MsgsAddEmptyLineIfNotPresentAlready;

          { voeg een signature separator line aan het bericht toe }
          MsgsAddLineTo (Body,'-- '); { spatie hoort erbij! }

          WHILE (NOT Eof (Signature)) DO
          BEGIN
               {$I-} ReadLn (Signature,CheckName); {$I+}
               IF (IOResult <> 0)  THEN
                  Break; { pech }

               MsgsAddLineTo (Body,CheckName);
          END; { while }

          {$IFDEF LogFileIO}PreCloseT (Signature);{$ENDIF}
          Close (Signature);
     END; { found signature }
END;


{--------------------------------------------------------------------------}
{ CheckFilter                                                              }
{                                                                          }
{ Deze routine controleert of de opgegeven newsgroup naam door de filters  }
{ toegestaan wordt of niet. Zoja, dan wordt TRUE terug gegeven en het pad  }
{ ingevuld.                                                                }
{                                                                          }
FUNCTION CheckFilter (Name : STRING; VAR NewPath : STRING) : BOOLEAN;

VAR Tmp    : FilterPtr;
    Allow  : BOOLEAN;
    LineNr : WORD;
    Hulp   : STRING[6]; { "Allow" / "Reject" }
    Path   : STRING;

LABEL Einde;

BEGIN
     Name:=UpCaseString (Name);

     Allow:=FALSE; { nog geen regels gevonden die em goedkeurden }
     LineNr:=0;
     Path:='';

     Tmp:=FilterList.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          IF (Tmp^.NamePtr^ = '') THEN
          BEGIN
               { special cases: * en !* }
               Allow:=Tmp^.Allow;
               LineNr:=Tmp^.LineNr;
               IF (Tmp^.PathPtr = NIL) THEN
                  Path:=''
               ELSE
                   Path:=Tmp^.PathPtr^;
          END ELSE
              IF (Copy (Name,1,Length (Tmp^.NamePtr^)) = Tmp^.NamePtr^) THEN
              BEGIN
                   { we hebben een match }
                   IF (Length (Name) = Length (Tmp^.NamePtr^)) THEN
                   BEGIN
                        { de naam komt precies overeen. Eens kijken }
                        { wat ze hiervan zeggen.                    }
                        IF (Tmp^.Option = foEXACT) THEN
                        BEGIN
                             { beter dan dit vinden we niet. Geef het }
                             { resultaat meteen terug.                }
                             Allow:=Tmp^.Allow;
                             LineNr:=Tmp^.LineNr;
                             IF (Tmp^.PathPtr = NIL) THEN
                                Path:=''
                             ELSE
                                 Path:=Tmp^.PathPtr^;
                             GOTO Einde;
                        END;

                        { nvt, gewoon ignoren alsof het geen match was
                        IF (Tmp^.Option = foBELOWONLY) THEN
                        }

                        IF (Tmp^.Option = foPLUSBELOW) THEN
                        BEGIN
                             Allow:=Tmp^.Allow;
                             LineNr:=Tmp^.LineNr;
                             IF (Tmp^.PathPtr = NIL) THEN
                                Path:=''
                             ELSE
                                 Path:=Tmp^.PathPtr^;
                        END;

                   END ELSE
                       IF (Tmp^.Option <> foEXACT) THEN
                       BEGIN
                            Allow:=Tmp^.Allow;
                            LineNr:=Tmp^.LineNr;
                            IF (Tmp^.PathPtr = NIL) THEN
                               Path:=''
                            ELSE
                                Path:=Tmp^.PathPtr^;
                       END;
              END;

          Tmp:=FilterList.GetNextItem;
     END; { while }

Einde:
     IF Config.LogCheckFilter THEN
     BEGIN
          IF Allow THEN
             Hulp:='Allow'
          ELSE
              Hulp:='Reject';

          LogMessage (liTrivial,Hulp+'ing '+Name+' (line '+Word2String (LineNr)+')')
     END;

     CheckFilter:=Allow;
     NewPath:=Path;
END;


{--------------------------------------------------------------------------}
{ FindRoute                                                                }
{                                                                          }
{ Zoekt de route dat een netmailtje dat niet voor ons bestemd is moet      }
{ aflopen. Als het routen gelukt is, dan wordt TRUE terug gegeven en bevat }
{ ToAddr het adres waar het naartoe moet. Als het niet gelukt is, om welke }
{ reden dan ook, dan wordt FALSE terug gegeven. ToAddr alleen veranderd    }
{ als 2 terug wordt gegeven.                                               }
{                                                                          }
{ RWI 961006: geeft nieuwe waarden terug:                                  }
{   0: Geen route gevonden (was: FALSE)                                    }
{   1: ForceNoRoute of "geef aan FrontDoor"                                }
{   2: Route gevonden                                                      }
{                                                                          }
FUNCTION FindRoute (AdresTo : FidoAddrType; VAR ToAddr : FidoAddrType) : BYTE;

VAR ZoekRouteRecordPtr : RouteRecordPtr;
    Level_C            : BYTE;
    DestAddr           : FidoAddrType;

BEGIN
     { Als we in frontdoor mode draaien, mogen we geen berichten routen  }
     { en moet alles in de frontdoor netmail directory geplaatst worden! }

     { RAWI 970508: uitzondering: MailTunnels!                             }
     {              Als de destination van een ROUTE-FIDO een FORCEPACK    }
     {              adres is, dan toch routen ook al draaien we in FD mode }

     IF ForceNoRoute THEN
     BEGIN
          FindRoute:=1; { import }
          ToAddr:=Config.NodeNrs[1];
          Exit;
     END;

     Level_C:=0;
     ZoekRouteRecordPtr:=FirstRouteRecordPtr;

     WHILE (ZoekRouteRecordPtr <> NIL) DO
           WITH ZoekRouteRecordPtr^ DO
           BEGIN
                IF (Level >= Level_C) THEN
                BEGIN
                     IF (Level = 4) THEN
                        IF (MaskFidoAddr.Point = AdresTo.Point) AND
                           (MaskFidoAddr.Node = AdresTo.Node) AND
                           (MaskFidoAddr.Net = AdresTo.Net) AND
                           (MaskFidoAddr.Zone = AdresTo.Zone) THEN
                        BEGIN
                             DestAddr:=ViaFidoAddr;
                             Level_C:=4;
                             FindRoute:=2; { Grootst mogelijk match }
                             {## zou dit niet een BREAK moeten zijn? }
                             {## hieronder wordt FindRoute toch altijd overschreven! }
                        END;

                     IF (Level = 3) THEN
                        IF (MaskFidoAddr.Node = AdresTo.Node) AND
                           (MaskFidoAddr.Net = AdresTo.Net) AND
                           (MaskFidoAddr.Zone = AdresTo.Zone) THEN
                        BEGIN
                             DestAddr:=ViaFidoAddr;
                             Level_C:=3;
                             { maar nog wel verder zoeken }
                        END;

                     IF (Level = 2) THEN
                        IF (MaskFidoAddr.Net = AdresTo.Net) AND
                           (MaskFidoAddr.Zone = AdresTo.Zone) THEN
                        BEGIN
                             DestAddr:=ViaFidoAddr;
                             Level_C:=2;
                             { maar nog wel verder zoeken }
                        END;

                     IF (Level = 1) THEN
                        IF (MaskFidoAddr.Zone = AdresTo.Zone) THEN
                        BEGIN
                             DestAddr:=ViaFidoAddr;
                             Level_C:=1;
                             { maar nog wel verder zoeken }
                        END;

                END; { dit level is beter }

                ZoekRouteRecordPtr:=NextRouteRecordPtr;
           END; { with, while }

     IF (Level_C > 0) THEN
     BEGIN
          { route gevonden }
          { als we niet in FrontDoor mode zitten, dan toestaan }
          { anders terug vallen op 1, tenzij de destination forcepack is }

          IF (Config.FidoSystem <> stFrontDoor) OR CheckForcePack (DestAddr) THEN
          BEGIN
               ToAddr:=DestAddr;
               FindRoute:=2;
               Exit;
          END;
     END;

     { geen route gevonden of geen routes gedefinieerd maar FrontDoor }
     { en niet forcepacked route-fido destination.                    }

     { In geval FrontDoor een 1 terug gegeven }
     IF (Config.FidoSystem = stFrontDoor) AND (NOT CheckForcePack (AdresTo)) THEN
        FindRoute:=1
     ELSE
         FindRoute:=0;
END;


{--------------------------------------------------------------------------}
{ CheckAndHandleTunnelFrom                                                 }
{                                                                          }
{ Deze routine kijkt of het opgegeven target adres voorkomt in een van de  }
{ TUNNEL-FROM statements. Zoja, dan wordt de file uitgepakt en in de       }
{ opgegeven directory gezet en TRUE terug gegeven. Het bericht zelf gaat   }
{ verloren. Als er geen hit is, dan wordt FALSE terug gegeven.             }
{                                                                          }
FUNCTION CheckAndHandleTunnelFrom (DestPtr : DestRecordPtr) : BOOLEAN;

VAR Tmp         : MailTunnelPtr;
    EenRegelPtr : EenRegelRecordPtr;
    Regel       : STRING;

BEGIN
     Tmp:=MailTunnelList.GetFirstItem;

     WHILE (Tmp <> NIL) DO
     BEGIN
          IF (Tmp^.FromOrTo = mtFrom) AND
             CaselessMatch (Tmp^.EMailAddress,DestPtr^.To_U) THEN
          BEGIN
               Regel := UsenetReplyAdres;

               IF (Pos ('MAILER-DAEMON', UpCaseString(Regel)) > 0) THEN
               BEGIN
                    LogMessage (liGeneral, 'Mailtunnel suspects bounced mail from '+Regel);
                    WriteMessageToRFCBad ('Mailtunnel suspects bounced mail from '+Regel, DestPtr);
                    CheckAndHandleTunnelFrom:=TRUE;
                    Exit;
               END;
               
               { gevonden! }
               LogMessage (liGeneral,'Detected MailTunnel traffic for '+DestPtr^.To_U);

{$IFDEF WtrTest}
               LogMessage (liTrivial,'Target: Tunnel-in statement');
{$ELSE}
               DecodeAttachedFiles (Tmp^.ExtractPath,NIL);
{$ENDIF}
               CheckAndHandleTunnelFrom:=TRUE;
               Exit;
          END;

          Tmp:=MailTunnelList.GetNextItem;
     END;

     CheckAndHandleTunnelFrom:=FALSE; { niets gevonden }
END;


{--------------------------------------------------------------------------}
{ RFC_CheckAndHandleSendFile                                               }
{                                                                          }
{ Deze routine kijkt of het adres in HulpUser geconfigureerd is in de      }
{ ROUTE.TDB file. Zoja, dan wordt een reactie terug gestuurd met daarin    }
{ de inhoud van de file waarnaar verwezen wordt. Dit moet een textfile     }
{ zijn die bijvoorbeeld een UU-encoded file bevat.                         }
{                                                                          }
FUNCTION RFC_CheckAndHandleSendFile (ToUser : STRING) : BOOLEAN;

VAR Tmp      : SendFilePtr;
    ZoekAddr : STRING;  { wordt ook gebruikt om de file te lezen!! }

BEGIN
     ZoekAddr:=UpCaseString (ToUser);

     Tmp:=SendFileList.GetFirstItem;
     WHILE (Tmp <> NIL) AND (Tmp^.UserName <> ZoekAddr) DO
           Tmp:=SendFileList.GetNextItem;

     IF (Tmp = NIL) THEN
     BEGIN
          RFC_CheckAndHandleSendFile:=FALSE; { gewoon verwerken }
          Exit;
     END;

     LogMessage (liGeneral,'SEND(TEXT)FILE ('+ToUser+') to '+UsenetReplyAdres);

{$IFDEF WtrTest}
     LogMessage (liTrivial,'Target: Sendfile');
{$ELSE}

     RFC_PushAndBuildReply (GetLang1 (130,ToUser),'Info Server','infoserver');

     IF (NOT TestIfExist (Tmp^.FilePath)) THEN
     BEGIN
          LogMessage (liFatal,'SENDFILE: cannot access '+Tmp^.FilePath);
          MsgsAddLineTo (Body,'Cannot access the requested data at this moment');
          MsgsAddLineTo (Body,'Please try again later.');
     END ELSE
         XX_FileToBody (Tmp^.FilePath,TRUE{suppress info},Tmp^.ForceText,(NOT Tmp^.ForceText));

     FtnBodyToMime;
     AddStandardMimeHeaders;

     DeliverNow;
     MsgsPopState;

{$ENDIF (!WtrTest)}

     RFC_CheckAndHandleSendFile:=TRUE; { bericht verder niet verwerken }
END;


{--------------------------------------------------------------------------}
{ FidoSendFileCheck                                                        }
{                                                                          }
{ Deze routine kijkt of de geaddresserde van het in geheugen aanwezige     }
{ netmailtje in een sendfile te vinden is. Zoja, dan wordt TRUE terug      }
{ gegeven.                                                                 }
{                                                                          }
FUNCTION FidoSendFileCheck (UpToName : STRING) : BOOLEAN;

VAR Tmp : SendFilePtr;

BEGIN
     Tmp:=SendFileList.GetFirstItem;
     WHILE (Tmp <> NIL) AND (Tmp^.UserName <> UpToName) DO
           Tmp:=SendFileList.GetNextItem;

     FidoSendFileCheck:=(Tmp <> NIL);  { TRUE = gevonden }
END;


{--------------------------------------------------------------------------}
{ FTN_CheckAndHandleSendFile                                               }
{                                                                          }
{ This routine searches the define SENDFILE and SENDTEXTFILE statements    }
{ for the given name. If found, it is sent back and TRUE is returned.      }
{ Otherwise, FALSE is returned when there is no hit.                       }
{                                                                          }
FUNCTION FTN_CheckAndHandleSendFile (ToName : STRING) : BOOLEAN;

VAR Tmp : SendFilePtr;

BEGIN
     Tmp:=SendFileList.GetFirstItem;
     WHILE (Tmp <> NIL) AND (NOT CaselessMatch (Tmp^.UserName,ToName)) DO
           Tmp:=SendFileList.GetNextItem;

     IF (Tmp = NIL) THEN
     BEGIN
          FTN_CheckAndHandleSendFile:=FALSE; { no hit }
          Exit;
     END;

     LogMessage (liGeneral,'Triggered SEND(TEXT)FILE: '+ToName);

{$IFNDEF WtrTest}
     FTN_PushAndBuildReply ('Automatic reply: '+ToName,  { filename in subject }
                            0{automatic},
                            'InfoServer');

     IF (NOT TestIfExist (Tmp^.FilePath)) THEN
     BEGIN
          LogMessage (liFatal,'SEND(TEXT)FILE: cannot access '+Tmp^.FilePath);
          MsgsAddLineTo (Body,'Cannot access the requested data at this moment');
          MsgsAddLineTo (Body,'Please try again later.');
     END ELSE
         XX_FileToBody (Tmp^.FilePath,TRUE{suppress info},Tmp^.ForceText,(NOT Tmp^.ForceText));

     DeliverNow;

     MsgsPopState;
{$ENDIF (!WtrTest)}

     FTN_CheckAndHandleSendFile:=TRUE; { handled }
END;


{--------------------------------------------------------------------------}
{ GetMailTunnelTo                                                          }
{                                                                          }
{ Deze routine doorzoekt de mail tunnel lijst op zoek naar een match voor  }
{ het opgegeven fido adres. Als deze gevonden wordt, dan wordt de pointer  }
{ naar dat record terug gegeven. Anders komt NIL terug.                    }
{                                                                          }
FUNCTION GetMailTunnelTo (Addr : FidoAddrType) : MailTunnelPtr;

VAR Tmp : MailTunnelPtr;

BEGIN
     Tmp:=MailTunnelList.GetFirstItem;

     WHILE (Tmp <> NIL) DO
     BEGIN
          IF (Tmp^.FromOrTo = mtTo) AND (FidoCompare (Addr,Tmp^.FidoAddress)) THEN
             Break; { from the while }

          Tmp:=MailTunnelList.GetNextItem;
     END; { while }

     GetMailTunnelTo:=Tmp;
END;


{--------------------------------------------------------------------------}
{ CheckForcePack                                                           }
{                                                                          }
{ Kijk of het opgegeven adres in de forcepack lijst voorkomt. Zoja, geef   }
{ dan TRUE terug, anders FALSE.                                            }
{                                                                          }
FUNCTION CheckForcePack (Addr : FidoAddrType) : BOOLEAN;

VAR Tmp : ForcePackPtr;

BEGIN
     Tmp:=ForcePackList.GetFirstItem;

     WHILE (Tmp <> NIL) DO
     BEGIN
          IF FidoCompare (Addr,Tmp^.FidoAddr) THEN
          BEGIN
               CheckForcePack:=TRUE;
               Exit;
          END;

          Tmp:=ForcePackList.GetNextItem;
     END; { while }

     CheckForcePack:=FALSE; { niet gevonden }
END;


{--------------------------------------------------------------------------}
{ HaveNotLocalRecord                                                       }
{                                                                          }
{ Returns TRUE if the specified domain has been excluded by a 'notlocal'   }
{ command.                                                                 }
{                                                                          }
FUNCTION HaveNotLocalRecord (Domain : STRING) : BOOLEAN;

VAR Tmp : NotLocalPtr;

BEGIN
     Tmp := NotLocalList.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          IF (CaselessMatch (Domain, Tmp^.Domain)) THEN
          BEGIN
               HaveNotLocalRecord := TRUE;
               Exit;
          END;

          Tmp := NotLocalList.GetNextItem;
     END;

     HaveNotLocalRecord := FALSE;
END;

{--------------------------------------------------------------------------}
{ IsMimeAttachment                                                         }
{                                                                          }
{ Returns TRUE if the specified MIME type is in the 'MimeAttachList' list. }
{                                                                          }
FUNCTION IsMimeAttachment (MimeType : STRING) : BOOLEAN;

VAR Tmp : MimeAttachPtr;

BEGIN
     Tmp := MimeAttachList.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          IF (CaselessMatch (MimeType, Tmp^.MimeType)) THEN
          BEGIN
               IsMimeAttachment := TRUE;
               Exit;
          END;

          Tmp := MimeAttachList.GetNextItem;
     END;

     IsMimeAttachment := FALSE;
END;

{$IFDEF WtrTest}
{--------------------------------------------------------------------------}
{ Routing_ListTables                                                       }
{                                                                          }
PROCEDURE Routing_ListTables;

     { list used by FindRoute }
     PROCEDURE Routing_DumpFidoRoutingTable;
     
     VAR Ptr : RouteRecordPtr;
         Tmp : STRING;

     BEGIN
          ListAddItem ('--- when routing a netmail (best match) ---',0,Bottom);

          Ptr:=FirstRouteRecordPtr;
          WHILE (Ptr <> NIL) DO
          BEGIN
               Tmp:=Word2String (Ptr^.MaskFidoAddr.Zone)+':';

               IF (Ptr^.Level > 1) THEN
                  Tmp:=Tmp+Word2String (Ptr^.MaskFidoAddr.Net)+'/';

               IF (Ptr^.Level > 2) THEN
                  Tmp:=Tmp+Word2String (Ptr^.MaskFidoAddr.Node)+'.';

               IF (Ptr^.Level > 3) THEN
                  Tmp:=Tmp+Word2String (Ptr^.MaskFidoAddr.Point)
               ELSE
                   Tmp:=Tmp+'*';

               ListAddItem ('  Route '+Tmp+' via '+
                               Word2String (Ptr^.ViaFidoAddr.Zone)+
                               ':'+Word2String (Ptr^.ViaFidoAddr.Net)+
                               '/'+Word2String (Ptr^.ViaFidoAddr.Node)+
                               '.'+Word2String (Ptr^.ViaFidoAddr.Point),
                            0,Bottom);

               Ptr:=Ptr^.NextRouteRecordPtr;
          END; { while }

          ListAddItem ('  Exceptions when in FrontDoor mode to do with FORCEPACK',0,Bottom);
          ListAddItem ('--- end ---',0,Bottom);
     END;

     PROCEDURE Routing_DumpMapFidoTable;

     VAR Tmp    : MapRecordPtr;
         LocStr : EenRegelRecordPtr;
         X      : BYTE;
         XTo,
         XFrom  : FidoAddrType;
         TmpLine: STRING;

     LABEL Verder;

     BEGIN
          ListAddItem ('--- before routing a netmail (triggers only one!) ---',0,Bottom);

          Tmp:=FidoMappingList.GetFirstItem;
          WHILE (Tmp <> NIL) DO
          BEGIN
               ListAddItem ('  if ToName = "'+Tmp^.LName+'"',0,Bottom);

               IF (Tmp^.LFidoAddr.Zone <> 0) THEN
                  ListAddItem ('  and ToNode = '+Fido2Str (Tmp^.LFidoAddr),0,Bottom);

               ListAddItem ('  then',0,Bottom);

               CASE Tmp^.RType OF
                    1 : BEGIN
                             ListAddItem ('   change ToName to '+Tmp^.RName,0,Bottom);
                             IF (Tmp^.RFidoAddr.Zone <> 0) THEN
                             BEGIN
                                  ListAddItem ('   if '+Fido2Str (Tmp^.RFidoAddr)+' is not a system AKA then',0,Bottom);
                                  ListAddItem ('      change ToNode to '+Fido2Str (Tmp^.RFidoAddr),0,Bottom);
                                  ListAddItem ('      add re-mapping stuff; redo header',0,Bottom);
                                  ListAddItem ('   endif',0,Bottom);
                             END;
                        END;

                    3 : ListAddItem ('    for gateway, TO: '+Tmp^.RName,0,Bottom);

                    ELSE ListAddItem ('   ignore it',0,Bottom);

               END; { case }

               ListAddItem ('endif',0,Bottom);
               ListAddItem ('',0,Bottom);

               Tmp:=FidoMappingList.GetNextItem;
          END; { while }

          ListAddItem ('--- end ---',0,Bottom);
     END;

     PROCEDURE Routing_DumpMapUucpTable;

     VAR Tmp          : MapRecordPtr;
         LocStr       : EenRegelRecordPtr;
         X            : BYTE;
         TDomainAdr,
         TUser,
         TmpLine      : STRING;
         TVorm,SVorm  : EForm;

     LABEL Next;

     BEGIN
          ListAddItem ('--- when routing an e-mail (triggers only one!) ---',0,Bottom);

          Tmp:=UUCPMappingList.GetFirstItem;

          WHILE (Tmp <> NIL) DO
          BEGIN
               IF (Tmp^.MapType = UUCP_Map_FU) THEN
               BEGIN
                    Tmp:=UUCPMappingList.GetNextItem;
                    Continue;
               END;

               IF (Tmp^.LType = 3) AND (Tmp^.RType IN [2,3]) THEN
               BEGIN
                    TVorm:=UseAdresParse (Tmp^.LName,TDomainAdr,TUser);

                    ListAddItem ('  if local or domain style',0,Bottom);
                    ListAddItem ('  and domain='+TDomainAdr,0,Bottom);
                    ListAddItem ('  and user='+TUser,0,Bottom);
                    ListAddItem ('  then',0,Bottom);

                    IF (Tmp^.RType = 2) THEN
                       ListAddItem ('   to='+TUser+'@'+Tmp^.RName,0,Bottom)
                    ELSE
                        ListAddItem ('    to='+Tmp^.RName,0,Bottom);

                    ListAddItem ('  endif',0,Bottom);
                    ListAddItem ('',0,Bottom);
               END;

               IF (Tmp^.LType = 2) AND (Tmp^.RType = 3) THEN
               BEGIN
                    TVorm:=UseAdresParse (Tmp^.LName,TDomainAdr,TUser);

                    ListAddItem ('  if local or domain style',0,Bottom);
                    ListAddItem ('  and domain='+TDomainAdr,0,Bottom);
                    ListAddItem ('  then',0,Bottom);
                    ListAddItem ('      to='+Tmp^.RName,0,Bottom);
                    ListAddItem ('  endif',0,Bottom);
                    ListAddItem ('',0,Bottom);
               END;

               IF (Tmp^.LType = 2) AND (Tmp^.RType = 2) THEN
               BEGIN
                    TVorm:=UseAdresParse (Tmp^.LName,TDomainAdr,TUser);

                    ListAddItem ('  if local or domain style',0,Bottom);
                    ListAddItem ('  and domain='+TUser,0,Bottom);
                    ListAddItem ('  then',0,Bottom);
                    ListAddItem ('      to=<original>@'+Tmp^.RName,0,Bottom);
                    ListAddItem ('  endif',0,Bottom);
                    ListAddItem ('',0,Bottom);
               END;

               IF (Tmp^.LType = 3) AND (Tmp^.RType = 1) THEN
               BEGIN
                    TVorm:=UseAdresParse (Tmp^.LName,TDomainAdr,TUser);

                    ListAddItem ('  if local or domain style',0,Bottom);
                    ListAddItem ('  and domain='+TDomainAdr,0,Bottom);
                    ListAddItem ('  and user is not empty',0,Bottom);
                    ListAddItem ('  and user='+TUser,0,Bottom);
                    ListAddItem ('  then',0,Bottom);

                    IF (Tmp^.RFidoAddr.Zone = 0) THEN
                       ListAddItem ('    NewToZone=0, so replace ToAddr with '+
                                    Fido2Str (Config.NodeNrs[Config.GatewayAKA]),0,Bottom);

                    IF (Tmp^.RName <> '') THEN
                       ListAddItem ('    to='+CleanFidoName (Tmp^.RName,TRUE)+'@'+
                                    BuildFidonetInternetAdres (Tmp^.RFidoAddr,'.')+Config.Domains[1],0,Bottom)
                    ELSE
                        ListAddItem ('    to='+CleanFidoName (TUser,TRUE)+'@'+
                                     BuildFidonetInternetAdres (Tmp^.RFidoAddr,'.')+Config.Domains[1],0,Bottom);

                    ListAddItem ('  endif',0,Bottom);
                    ListAddItem ('',0,Bottom);
               END;

               IF (Tmp^.LType = 2) AND (Tmp^.RType = 1) THEN
               BEGIN
                    ListAddItem ('  if domain='+Tmp^.LName+' then',0,Bottom);

                    IF (Tmp^.RFidoAddr.Zone = 0) THEN
                       ListAddItem ('    NewToZone=0, so replace with '+Fido2Str (Config.NodeNrs[Config.GatewayAKA]),0,Bottom);

                    IF (Tmp^.RName <> '') THEN
                       ListAddItem ('    '+CleanFidoName (Tmp^.RName,TRUE)+'@'+
                                    BuildFidonetInternetAdres (Tmp^.RFidoAddr,'.')+Config.Domains[1],0,Bottom)
                    ELSE
                        ListAddItem ('    to=<original>@'+BuildFidonetInternetAdres (Tmp^.RFidoAddr,'.')+Config.Domains[1],
                                     0,Bottom);

                    ListAddItem ('  endif',0,Bottom);
                    ListAddItem ('',0,Bottom);
               END;

               Tmp:=UUCPMappingList.GetNextItem;
          END; { while }

          ListAddItem ('--- end ---',0,Bottom);
     END;

     PROCEDURE Routing_DumpLocalDomainsTable;

     VAR Lp : BYTE;

     BEGIN
          ListAddItem ('--- considered local (when processing an e-mail) ---',0,Bottom);

          FOR Lp:=1 TO MaxSystemDomains DO
              IF (Config.Domains[Lp] <> '') THEN
                 ListAddItem ('   '+Config.Domains[Lp]+' (system domain)',0,Bottom);

          IF (Config.UUCPName <> '') THEN
             ListAddItem ('   '+Config.UUCPName+' (system UUCP name)',0,Bottom);

          ListAddItem ('--- end ---',0,Bottom);
     END;

     PROCEDURE Routing_DumpMimeAttachTable;
     VAR
          Tmp : MimeAttachPtr;

     BEGIN
          ListAddItem ('--- MIME types considered to be attachments ---', 0, Bottom);

          Tmp:=MimeAttachList.GetFirstItem;
          WHILE (Tmp <> NIL) DO
          BEGIN
               ListAddItem ('  '+Tmp^.MimeType, 0, Bottom);
               Tmp:=MimeAttachList.GetNextItem;
          END; { while }

          ListAddItem ('--- end ---',0,Bottom);
     END;

BEGIN
     Routing_DumpMapFidoTable;
     ListAddItem ('',0,Bottom);

     Routing_DumpFidoRoutingTable;
     ListAddItem ('',0,Bottom);

     Routing_DumpMapUucpTable;
     ListAddItem ('',0,Bottom);

     Routing_DumpLocalDomainsTable;
     ListAddItem ('',0,Bottom);

     Routing_DumpMimeAttachTable;
     ListAddItem ('',0,Bottom);
END;
{$ENDIF (WtrTest)}


{--------------------------------------------------------------------------}
{ CheckForRouteTdbBounce                                                   }
{                                                                          }
{ This routine checks if one of the destinations match a BOUNCE statement  }
{ or whether the From: header matches a BOUNCEFROM statement. If so, TRUE  }
{ is returned and the message must be bounced to its sender.               }
{                                                                          }
FUNCTION CheckForRouteTdbBounce : BOOLEAN;

VAR Tmp : BouncePtr;

    FUNCTION IsMatch (Address : STRING) : BOOLEAN;

    VAR P : BYTE;

    BEGIN
         P:=Pos (Tmp^.EMailAddress,Address);

         {LogMessage (liDebug,'Checking '+Address+' against '+Tmp^.EmailAddress+' -> '+Byte2String (P));}

         IsMatch:=(P = 1) OR
                  ((Tmp^.WildMatch) AND (P > 1)) OR
                  ((P > 1) AND (Address[P-1] IN [' ','<']));
    END;

VAR UpFromUser_U,
    UpSender_U,
    UpReplyTo_U  : STRING;

VAR DestPtr : DestRecordPtr;

BEGIN
     { avoid bouncing on bounce messages }
     IF (Msg.IsBounceMsg) THEN
     BEGIN
          CheckForRouteTdbBounce:=FALSE;
          Exit; { with FALSE }       { ## EXIT ## }
     END;

     CheckForRouteTdbBounce:=TRUE;

     UpFromUser_U:=UpCaseString (Msg.FromUser_U);
     UpSender_U:=UpCaseString (Msg.Sender_U);
     UpReplyTo_U:=UpCaseString (Msg.ReplyTo_U);

     Tmp:=BounceList.GetFirstItem;

     WHILE (Tmp <> NIL) DO
     BEGIN
          IF (NOT Tmp^.FromBounce) THEN
          BEGIN
               { BOUNCE statement }

               { check all the RFC destinations }
               DestPtr:=Msg.FirstDest;
               WHILE (DestPtr <> NIL) DO
               BEGIN
                    IF (DestPtr^.Status = destRFC) THEN
                    BEGIN
                         IF IsMatch (UpCaseString (DestPtr^.To_U)) THEN
                         BEGIN
                              LogMessage (liGeneral,'Mail BOUNCE on '+DestPtr^.To_U);
                              Msg.BounceReason:=Tmp^.Reason;
                              Exit; { ## EXIT ## }
                         END;
                    END ELSE
                        IF (DestPtr^.Status = destRFCRaw) THEN
                           LogMessage (liReport,'CheckForRouteTdbBounce cannot handle destRFCRaw');

                    DestPtr:=DestPtr^.NextDest;
               END; { while }
          END ELSE
          BEGIN
               { BOUNCEFROM statement }

               IF IsMatch (UpFromUser_U) THEN
               BEGIN
                    LogMessage (liGeneral,'Mail BOUNCEFROM on '+Msg.FromUser_U);
                    Msg.BounceReason:=Tmp^.Reason;
                    Exit;  { ## EXIT ## }
               END;

               IF IsMatch (UpSender_U) THEN
               BEGIN
                    LogMessage (liGeneral,'Mail BOUNCEFROM on '+Msg.Sender_U);
                    Msg.BounceReason:=Tmp^.Reason;
                    Exit;  { ## EXIT ## }
               END;

               IF IsMatch (UpReplyTo_U) THEN
               BEGIN
                    LogMessage (liGeneral,'Mail BOUNCEFROM on '+Msg.ReplyTo_U);
                    Msg.BounceReason:=Tmp^.Reason;
                    Exit;  { ## EXIT ## }
               END;
          END;

          Tmp:=BounceList.GetNextItem;
     END; { while }

     { no match }

     CheckForRouteTdbBounce:=FALSE;
END;


{--------------------------------------------------------------------------}
{ unit initialization                                                      }
{                                                                          }
BEGIN
     FirstRouteRecordPtr:=NIL;

     CustomSkipCount:=0;
     Mail2NewsAddress:='';
     NewsDomain:='';
     BBSEmailAreaRecNr:=NILRecordNr;
     BBSNormalAreaRecNr:=NILRecordNr;
     BBSViaRecNr:=NILRecordNr;
END.
