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

{$i platform.inc}

{--------------------------------------------------------------------------}
{ UUCP Routing                                                             }
{                                                                          }
{ Deze routine maakt het mogenlijk om usenet mail berichten op een         }
{ flexibelere manier door te sturen.                                       }
{                                                                          }
{ 14-11-93 MvdL Code ontworpen en geschreven                               }
{          MD   Toevoegen aan de WaterGate code                            }
{               Aanpassing gemaakt, zodat de routines een UserBase         }
{               record terug geven. Verder zal alle routing                }
{               informatie in deze tabel opgeslagen worden.                }
{               Dus ook informatie over onze eigen AKA's, en alle node     }
{               informatie uit de Userbase.                                }
{                                                                          }

INTERFACE

USES Database,
     UseAdres;

FUNCTION AddUucpRouteLine (RoutedUUCPName : UserBaseRecordNrType; RouteVia : STRING) : LONGINT;
{
Gebruiken om routing-regels toe te voegen, deze URLine moet het
formaat hebben: <route-systeem>  <alias>
<route-systeem> moet dan ofwel lokaal bij ons bekend zijn (meestal dus
een neighbour) ofwel eerder in de routingfile gedefinieerd zijn
als alias o.i.d. voor een ander UUCP-systeem. In principe moet
<route-systeem> een uucp-name zijn, maar juist deze routingtabel
maakt aliasing e.d. mogelijk dus het is niet vereist als er maar
een weg naar het systeem bekend is
}

{FUNCTION GetUucpRoute(VAR InAddress : String; OurSystemsUucpName : String) : String;}
{ RWI 950212: removed OurSystemsUucpName, because we are now checking }
{             against our uucpname AND domain addresses.              }
FUNCTION GetUucpRoute(VAR InAddress : STRING{; OurSystemsUucpName : String}) : UserBaseRecordNrType;
{

Levert de naam van het systeem via welke het bericht moet
worden geroute. 'InAddress' is een volledig(!) mailadres, dus
de username moet er niet vanaf gestript zijn!
Als geen routing kan worden gevonden, dan wordt onze eigen systeemnaam
geretourneerd (vandaar dat deze naam ook aan de functie moet worden
meegegeven) ten teken dat we het zelf ergens moeten kunnen vinden
(bijv. een lokaal gedefinieerd AKA of een eigen user). Kunnen we dat
toch niet, dan moet een bounce volgen.
InAddress wordt bovendien aangepast wanneer nodig en domain-adressen
worden omgekat naar bangpath adressen.
}

{$IFDEF WtrTest}
PROCEDURE UUCPRouting_ListTables;
{$ENDIF}

PROCEDURE ShowRoutingTable;
{
Toont de Routingtable ter eventuele debug informatie
}

PROCEDURE DeleteUUCPRoutingTable;
{
Verwijdert de routingtable (gelinkte lijsten!) en geeft daarmee
weer wat geheugen vrij. Altijd aanroepen NADAT alle routing
gedaan is en dat er dus geen routing meer gevonden moet worden.
}


{
  Deze functie doet twee dingen: Converteert InAddress naar een
  bangpath style adres als het een domain-adres is (VAR)
  en retourneert De UUCPname van de neighbour via wie
  dit bericht moet worden vertuurd. (als deze neighbour dan
  niet bekend blijkt te zijn in de setup dan volgt dus een BOUNCE,
  want in the UUROUTE regel moet het eerste systeem dus altijd de
  UUCP name van een neighbour zijn. Als eventueel ons
  systeem in het bangpath staat maar het is bestemd voor
  een ander systeem, want wordt onze UUCPname van het adres
  afgepeuterd. (bijv. wtrlnd!hotline!piet wordt hotline!piet
  en ed getourneerde UUCPname is 'hotline' (want wij zijn wtrlnd)
  Als het bericht bestemd is voor ons eigen systeem retourneert
  het de UUCPname van ons eigen systeem, dan zou de lokale routing
  eruit moeten komen. (adres blijft verder intact, behalve dat het
  nu een bang-adres is natuurlijk (bijv, waterland.wlink.nl!system
  of wtrlnd!system (retourneren beiden 'wtrlnd' als UucpName.
  Als geen routing kan worden gevonden, wordt eveneens het
  adres intact gelaten en onze eigen UucpName geretourneerd;
  de lokale routing (met Usenet AKA domains etc zou het dan moeten
  kunnen afhandelen, en zo niet, dan moet het worden gebounced).
  NB: Het is dus niet nodig om routing van AKA's van neighbours
  in deze file op te nemen, maar 'het kan geen kwaad', het heeft
  hetzelfde resultaat. Deze file kan wel worden gebruikt om
  meer AKA's voor domainnames te gebruiken dan WtrConf toestaat
  indien 10 AKA's niet genoeg is.

  Om kort te gaan: indien als de eigen UUCPname wordt geretourneerd,
  moet de lokale routing het zelf af kunnen.
}

VAR FindUUCPRoutePoint : WORD;

IMPLEMENTATION

USES Logs,
     Ramon,
     Fido,
     Usenet;

TYPE {#1
     UucpNameStringType    = STRING[12];
     UucpNameStringPtrType = ^UucpNameStringType;
     UucpNamesListPtr      = ^UucpNamesListElement;
     UucpNamesListElement  = RECORD
                                   UucpName    : UserBaseRecordNrType;
                                   NextElement : UucpNamesListPtr;
                             END;
     }

     DomainListPtr     = ^DomainListElement;
     DomainListElement = RECORD
                               DomainBranch : ^STRING;
                               UucpRoute    : UserBaseRecordNrType;
                               NextElement  : DomainListPtr;
                         END;

VAR DomainList : DomainListPtr;
    {#1UucpNamesList : UucpNamesListPtr;}

{--------------------------------------------------------------------------}
{ AddUucpRouteLine                                                         }
{                                                                          }
{ Heeft als input nodig een uppercased string van de UUROUTE line,         }
{ MINUS het UUROUTE statement.                                             }
{ Bijv. er staat in de ROUTE.TDB een regel met :                           }
{                                                                          }
{ UUROUTE wtrlnd waterland.wlink.nl                                        }
{                                                                          }
{ Dan moet de invoerstring voor deze procedure zijn:                       }
{                                                                          }
{ WTRLND WATERLAND.WLINK.NL                                                }
{                                                                          }
{ Eventuele extra spaties tussen 'WTRLND' en 'WATERLAND.WLINK.NL' of       }
{ spaties ACHTER de regel worden in deze procedure gewoon                  }
{ genegeerd.                                                               }
{                                                                          }
FUNCTION AddUucpRouteLine (RoutedUUCPName : UserBaseRecordNrType; RouteVia : STRING) : LONGINT;

VAR {#1
    UucpNameFound         : BOOLEAN;
    HulpUucpNamePtr,
    HulpUucpNameElement,
    TempUucpNameElement   : UucpNamesListPtr;
    }
    PrevPtr,
    ZoekPtr,
    HulpDomainListElement : DomainListPtr;

BEGIN
     AddUUCPRouteLine:=0; { in case of Exit }

     RouteVia:=DeleteFrontAndBackSpaces (RouteVia);

     IF (RouteVia = '') THEN
        Exit;

{$IFDEF WtrTest}
     { see if it already exists }
     ZoekPtr:=DomainList;
     WHILE (ZoekPtr <> NIL) DO
     BEGIN
          IF CaselessMatch (ZoekPtr^.DomainBranch^,Routevia) THEN
             LogMessage (liConfig,'Found ambiguous routing of '+RouteVia);

          ZoekPtr:=ZoekPtr^.NextElement;
     END; { while }
{$ENDIF (WtrTest)}

     {#!
     UucpNameFound:=FALSE;
     HulpUucpNameElement:=UucpNamesList;

     WHILE ((HulpUucpNameElement <> NIL) AND (NOT UucpNameFound)) DO
     BEGIN
          IF (HulpUucpNameElement^.UucpName = RoutedUucpName) THEN
             UucpNameFound:=TRUE
          ELSE
              HulpUucpNameElement:=HulpUucpNameElement^.NextElement;
     END;

     IF (NOT UucpNameFound) THEN
     BEGIN
          GetMem (TempUucpNameElement,SizeOf (UucpNamesListElement));

          TempUucpNameElement^.UucpName:=RoutedUucpName;
          TempUucpNameElement^.NextElement:=UucpNamesList;
          UucpNamesList:=TempUucpNameElement;
          HulpUucpNamePtr:=UucpNamesList;
     END ELSE
         HulpUucpNamePtr:=HulpUucpNameElement;
     }

     GetMem (HulpDomainListElement,SizeOf (DomainListElement));
     GetMem (HulpDomainListElement^.DomainBranch,Length (RouteVia)+1);
     AddUucpRouteLine:=SizeOf (DomainListElement)+Length (RouteVia)+1;

     HulpDomainListElement^.DomainBranch^:=UpCaseString (RouteVia);
     HulpDomainListElement^.UucpRoute:=RoutedUucpName; {#1 HulpUucpNamePtr^.UucpName;}
     HulpDomainListElement^.NextElement:=NIL;

     PrevPtr:=NIL;
     ZoekPtr:=DomainList;
     WHILE (ZoekPtr <> NIL) AND (Length (ZoekPtr^.DomainBranch^) > Length (Routevia)) DO
     BEGIN
          PrevPtr:=ZoekPtr;
          ZoekPtr:=ZoekPtr^.NextElement;
     END; { while }

     IF (PrevPtr = NIL) THEN
     BEGIN
          { aan het begin toevoegen }
          HulpDomainListElement^.NextElement:=DomainList;
          DomainList:=HulpDomainListElement;
     END ELSE
     BEGIN
          { tussen voegen }
          HulpDomainListElement^.NextElement:=PrevPtr^.NextElement;
          PrevPtr^.NextElement:=HulpDomainListElement;
     END;
END;


{---------------------------------------------------------------------------}
{ Convert2Bang                                                              }
{                                                                           }
{ Converts A@B.C.D addresses to B.C.D!A                                     }
{                                                                           }
{ RAWI 970619: changes to support "joseph.Cheng@eh.net"@NK.hongkong.NET     }
{                                                                           }
FUNCTION Convert2Bang (S : STRING) : STRING;

VAR At_Pos : BYTE;

BEGIN
     {At_Pos:=Pos ('@',S);}
     At_Pos:=Length (S);
     WHILE (At_Pos > 0) AND (S[At_Pos] <> '@') DO
           Dec (At_Pos);

     IF (At_Pos = 0) THEN
        Convert2Bang:=S
     ELSE
         Convert2Bang:=Copy (S,At_Pos+1,Length (S)-At_Pos)+'!'+Copy (S,1,At_Pos-1);
END;


{---------------------------------------------------------------------------}
{ FindRoute                                                                 }
{                                                                           }
{ RWI 960511: dit moet aangepast worden. Nu gaat de volgende situatie mis:  }
{        .wline.se                                                          }
{    .wsd.wline.se                                                          }
{                                                                           }
{ hierbij krijgt het system voor .wsd.wline.se nooit mail. Alles gaat naar  }
{ de eerste.                                                                }
{                                                                           }
{ De juiste implementatie moet de volgende opzoek acties doen:              }
{ 1) none-strategy (. of *)                                                 }
{ 2) points op none-strategy                                                }
{ 3) * strategy                                                             }
{ 4) . stragegy                                                             }
{                                                                           }
FUNCTION FindRoute (S : STRING) : UserBaseRecordNrType;

VAR StrategyChar : CHAR;
    BranchLen    : BYTE;
    FoundRoute   : BOOLEAN;
    PointNr      : WORD;
    Nop          : ValNop;
    HulpDomainListElement : DomainListPtr;

BEGIN
     HulpDomainListElement:=DomainList;
     FoundRoute:=FALSE;

     WHILE ((HulpDomainListElement <> NIL) AND (NOT FoundRoute)) DO
     BEGIN
          BranchLen:=Length (HulpDomainListElement^.DomainBranch^);
          StrategyChar:=HulpDomainListElement^.DomainBranch^[1];

          IF (StrategyChar = '.') THEN
          BEGIN
               {
                 Strategie 1: If the routing is  'UucpName  .A.B.C'
                 then everything ending in A.B.C may be routed to this
                 system, E.g. both 'X@A.B.C' as well as 'X@D.A.B.C'
               }
               IF (Length (S) < (BranchLen-1)) THEN
               BEGIN
                    {
                      Because of this length condition, this touring cannot
                      apply here. Try the next one
                    }
                    HulpDomainListElement:=HulpDomainListElement^.NextElement;
               END ELSE
               BEGIN
                    { kijk of het deel overeenkomt, of eindigt met }
                    { adres. Bijvoorbeeld:                         }
                    { wsd.wline.se => wsd.wline.se                 }
                    { blabla.wsd.wline.se => wsd.wline.se          }
                    { xwsd.wline.se !=> wsd.wline.se               }
                    IF (Copy (HulpDomainListElement^.DomainBranch^,2,BranchLen-1) =
                        Copy (S,Length (S)-BranchLen+2,BranchLen-1)) AND
{ RWI 951126 }         ((Length (S) = BranchLen-1) OR (S[Length (S)-BranchLen+1] = '.')) THEN
                    BEGIN
                         { Gevonden! }
                         FoundRoute:=TRUE;
                         FindRoute:=HulpDomainListElement^.UucpRoute;
                    END ELSE
                        HulpDomainListElement:=HulpDomainListElement^.NextElement;

                    { niet gevonden, probeer volgende }
               END;
          END ELSE
              IF (StrategyChar = '*') THEN
              BEGIN
                   {
                     Strategy 2: If the routing is  'UucpName  *.A.B.C
                     Then, only addresses like 'X@D.A.B.C' may be routed to this
                     system, but X@A.B.C may NOT be routed this way!
                   }
                   IF (Length (S) < BranchLen) THEN
                      { het kan deze niet zijn... volgende }
                      HulpDomainListElement:=HulpDomainListElement^.NextElement
                   ELSE BEGIN
                        IF (Copy (HulpDomainListElement^.DomainBranch^,3,BranchLen-2) =
                            Copy (S,Length (S)-Branchlen+3,BranchLen-2)) THEN
                        BEGIN
                             FoundRoute:=TRUE;
                             FindRoute:=HulpDomainListElement^.UucpRoute;
                        END ELSE
                            HulpDomainListElement:=HulpDomainListElement^.NextElement;
                   END;
              END ELSE
              BEGIN
                   {
                     Strategy 3:
                     Most simple case : Strings have to be exactly the same
                   }
                   IF (BranchLen <> Length (S)) THEN
                      HulpDomainListElement:=HulpDomainListElement^.NextElement
                   ELSE BEGIN
                        IF (HulpDomainListElement^.DomainBranch^ = S) THEN
                        BEGIN
                             FoundRoute:=TRUE;
                             FindRoute:=HulpDomainListElement^.UucpRoute;
                        END ELSE
                            HulpDomainListElement:=HulpDomainListElement^.NextElement;
                   END;
              END;
     END; { while }

     IF FoundRoute THEN
        Exit;

     { RWI 950313: als we nu niets gevonden hebben, dan gaan we nog }
     {             eens zoeken voor de points. Maar dan moet het    }
     {             adres wel beginnen met een "P<nummer>."...       }

     FindRoute:=NILRecordNr; { voor al die Exit cases... }

     IF (S[1] <> 'P') OR (Pos ('.',S) = 0) THEN
        Exit;

     Val (Copy (S,2,Pos ('.',S)-2),FindUUCPRoutePoint,Nop);
     IF (Nop <> 0) THEN
        Exit;

     { point nummer bepaald. Nu kijken of we nog een match hebben }
     Delete (S,1,Pos ('.',S));

     HulpDomainListElement:=DomainList;

     WHILE (HulpDomainListElement <> NIL) DO
     BEGIN
          BranchLen:=Length (HulpDomainListElement^.DomainBranch^);
          StrategyChar:=HulpDomainListElement^.DomainBranch^[1];

          { overslaan waar we geen behoefte aan hebben }
          IF (StrategyChar IN ['.','*']) OR (BranchLen <> Length (S)) THEN
          BEGIN
               HulpDomainListElement:=HulpDomainListElement^.NextElement;
               Continue;
          END;

          IF (HulpDomainListElement^.DomainBranch^ = S) THEN
          BEGIN
               FoundRoute:=TRUE;
               FindRoute:=HulpDomainListElement^.UucpRoute;
               Exit;
          END;

          HulpDomainListElement:=HulpDomainListElement^.NextElement;
     END; { while }

     FindRoute:=NILRecordNr;  { was ie nog... }

     {
       IF the routing could not be found, then direct the message to our
       own system and see what local routing can do. (If the local
       routing cannot route the message to either a node or user,
       then it should be bounced.
     }
END;


{---------------------------------------------------------------------------}
{ GetUucpRoute                                                              }
{                                                                           }
{ Deze routine gaat op zoek naar een voor ons bekend systeem waar het       }
{ opgegeven adres verder verwerkt kan worden.                               }
{                                                                           }
{ RWI 950212: OurSystemsUucpName wordt nu niet meer bekeken, maar we kijken }
{             nu naar onze in de config gedefinieerde domain namen!         }
{                                                                           }
FUNCTION GetUucpRoute (VAR InAddress : STRING{; OurSystemsUucpName : STRING}) : UserBaseRecordNrType;

VAR TempAdr       : STRING;
    OrigAdres,
    HulpDomain,
    HulpUser,
    TempSegment,
    FirstSegment,
    SecondSegment : STRING;
    FirstBang,
    SecondBang    : BYTE;

BEGIN
     FindUUCPRoutePoint:=0; { wordt ingevuld door FindRoute }

     OrigAdres:=InAddress;

     InAddress:=Convert2Bang (InAddress);
     FirstBang:=Pos ('!',InAddress);
     IF (FirstBang > 0) THEN
     BEGIN
          FirstSegment:=UpCaseString (Copy (InAddress,1,FirstBang-1));
          TempSegment:=Copy (InAddress,FirstBang+1,Length(InAddress)-FirstBAng);
          SecondBang:=Pos ('!',TempSegment);
          IF (SecondBang > 0) THEN
          BEGIN
               {
                 Twee of meer bangs in het pad.
                 Kijk of eerste segment onze UucpName is. Zoja, haal eraf.
                 Kijk of het te routen is naar tweede segment.
                 Zo nee, kijk of het te routen is naar het eerste segment en
                 laat adres intact.
               }
               SecondSegment:=UpCaseString (Copy (TempSegment,1,SecondBang-1));

               { RWI 950212: we kijken hier alleen naar onze eigen UUCPname }
               {             maar wat doen we dan met al onze AKA's??       }
               {             vb: take!takev@justine.uucp ->                 }
               {                 justine.uucp!take!takev                    }
               {                 ^^^^^^^ onze uucpname!                     }
               IF UsenetIsOurDomain (FirstSegment) THEN
               BEGIN
                    InAddress:=TempSegment;
                    GetUucpRoute:=FindRoute (SecondSegment);
               END ELSE
                   GetUucpRoute:=FindRoute (FirstSegment);
          END ELSE
          BEGIN
               {
                 Er is maar ‚‚n bang. Als dat onze UucpName is, laat het
                 zitten en stuur aan ons eigen systeem. Zo nee, dan gewoon
                 routing opzoeken.
               }

               { RWI 950212: we kijken hier alleen naar onze eigen UUCPname }
               {             maar wat doen we dan met al onze AKA's??       }
               {             vb: take!takev@justine.uucp ->                 }
               {                 justine.uucp!take!takev                    }
               {                 ^^^^^^^ onze uucpname!                     }
               IF UsenetIsOurDomain (FirstSegment) THEN
                  GetUucpRoute:=NILRecordNr
               ELSE
                   GetUucpRoute:=FindRoute (FirstSegment);
          END;
     END ELSE
     BEGIN
          {
            Geen bangs in het adres. Stuur door aan eigen systeem en kijk of
            die het lokaal kan routen aan een user. Anders bouncen of dumpen
          }
          GetUucpRoute:=NILRecordNr;
     END;

     IF (Pos ('!',OrigAdres) = 0) THEN
        InAddress:=OrigAdres
     ELSE BEGIN
          { Converteer terug naar '@' domain adressen }
          UseAdresParse (InAddress,HulpDomain,HulpUser);
          InAddress:=HulpUser+'@'+HulpDomain;
     END;
END;


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

VAR DPtr     : DomainListPtr;
    UserRec  : UserBaseRecord;
    UserType : STRING[30];

BEGIN
     ListAddItem ('--- domain routing for e-mails (triggers only one!) ---',0,Bottom);

     DPtr:=DomainList;
     WHILE (DPtr <> NIL) DO
     BEGIN
          ReadUserBaseRecord (DPtr^.UucpRoute,UserRec);
          CASE UserRec.System OF
               _F : UserType:=Fido2Str (UserRec.Address)+' (FTN)';
               _U : UserType:=UserRec.UUCPName+' (UUCP)';
               _S : UserType:=UserRec.UUCPName+' (SMTP)';
               _B : UserType:=UserRec.UUCPName+' (BAG)';
          END;

          ListAddItem ('  Route '+LoCaseString (DPtr^.DomainBranch^)+' via '+UserType,0,Bottom);
          DPtr:=DPtr^.NextElement;
     END; { while }

     ListAddItem ('',0,Bottom);
     ListAddItem ('  p#.f#.n#.z#.<system domain address> is automatically detected and gated',0,Bottom);
     ListAddItem ('--- end of domain routing table ---',0,Bottom);
END;
{$ENDIF (WtrTest)}


{--------------------------------------------------------------------------}
{ ShowRoutingTable                                                         }
{                                                                          }
PROCEDURE ShowRoutingTable;

VAR HulpDomainListElement : DomainListPtr;

BEGIN
     HulpDomainListElement:=DomainList;
     WHILE (HulpDomainListElement <> NIL) DO
     BEGIN
          LogMessage (liAdd,
                      HulpDomainListElement^.DomainBranch^ + ' will be routed through ' +
                      LongInt2String(HulpDomainListElement^.UucpRoute));
          HulpDomainListElement:=HulpDomainListElement^.NextElement;
     END; { while }
END;


{--------------------------------------------------------------------------}
{ DeleteUUCPRoutingTable                                                   }
{                                                                          }
PROCEDURE DeleteUUCPRoutingTable;

VAR ErasePtr : DomainListPtr;

BEGIN
     WHILE (DomainList <> NIL) DO
     BEGIN
          FreeMem (DomainList^.DomainBranch,Length (DomainList^.DomainBranch^)+1);
          ErasePtr:=DomainList;
          DomainList:=DomainList^.NextElement;
          FreeMem (ErasePtr,SizeOf (DomainListElement));
     END;
END;


{--------------------------------------------------------------------------}
{ unit initialization                                                      }
{                                                                          }
BEGIN
     {#1UucpNamesList:=NIL;}
     DomainList:=NIL;
END.

