UNIT Usenet;

{$i platform.inc}

{ Routines om Usenet pakketten in te lezen en weg te schrijven }

{ History

RvdW 20-02-93 History gestart.
     27-02-93 Locale buffer routines verwijderd en aan FBuffer geknoopt.
              Read ahead buffer van 1K naar 10000 bytes vergroot.
     02-04-93 Datum wordt vanaf alleen nog bij de start van de toss in de log
              gezet.
     16-05-93 Foutje verwijderd uit de filename munging routine
              FilenameUnix2Waffle.
     25-05-93 Verwijderen van .X en .D files ingebouwd. Zet de Define
              DelFiles uit om ze weer te bewaren.
              WaitKey als parameter ingevoerd zodat bij een commandline
              optie niet op een toets wordt gewacht.
     06-06-93 UsenetSplit en UsenetIsOurDomain geschreven voor de mail
              verwerking.
     12-06-93 FidoPack wordt nu aangeroepen aan het einde van de toss.
     17-06-93 GetUsenetUniqueName aangemaakt die een breedere codering
              gebruikt, waardoor de naam korter wordt. Afgeleid van de Fido
              versie.
MD   11-07-93 Aan UsenetRouteMail begonnen, nadat een mailtje naar school
              terugging naar waffle...
              Figures, zit ik hier een complete usenet mailer te schrijven
              met slechts een paar mailtjes gegenereerd door Waffle, nu is
              het tijd voor een beetje Zen.
     17-07-93 Major rewrite van de Usenet routing routine, het is nog
              steeds een hoop magie, maar nu in ieder geval gestructureerde
              magie. Na het lezen van enige honderden Kb's aan C source
              heb ik nog steeds het idee dat Usenet mail gewoon via een
              random routine wordt geroute...
     21-07-93 Bang path routing toegevoegt. (en het schijnt echt te werken!)
     08-10-93 DeCunBatch is nu intern,... scheelt een HOOP tijd
     06-11-93 Allow SubDomains check toegevoegt
     01-01-94 !!! Happy NewYear !!! Toevoegen van Usenet ListServer
     11-03-94 Usenet BAG file support toegevoegt
     06-04-94 Nu ook onderzoeken of we een 'gunbatch' (GZip) string
              tegenkomen
}

{$DEFINE DelFiles}
{ Verwijder de $ om de .X en .D files NIET te laten wissen }

INTERFACE

USES Msgs,
     Database;

PROCEDURE UsenetSplit (Adres : STRING; VAR Domain : UsenetDomainNameString; VAR User : UsenetUserNameString);
FUNCTION  UsenetArpaNetDate : String;
FUNCTION  UseGetAddress (Source : STRING) : STRING;
FUNCTION  GetUsenetUniqueName (Grade : CHAR) : STRING;
FUNCTION  UseGetSystemFromName : STRING;
FUNCTION  UseGetUserFromName (UserData : UserBaseRecord) : STRING;
FUNCTION  UsenetReplyAdres : STRING;
FUNCTION  UsenetPosterName : STRING;
FUNCTION  UsenetIsOurDomain (Domain : STRING) : BOOLEAN;

PROCEDURE RFC_StartSingleRecipientMessage (RecipientEMail,FromEMail,FromName,Subject : STRING);
PROCEDURE RFC_PushAndBuildReply (Subject,FromName,FromEmail : STRING);

PROCEDURE RFC_Bounce (Reason,WasAddressedTo : STRING);
PROCEDURE RFC_BounceTo (Reason,WasAddressedTo,ToEmail : STRING);
PROCEDURE RFC_NodelistBounce (DestPtr : DestRecordPtr);

PROCEDURE RFC_CompleteAdmin;
PROCEDURE RFC_PreCheckBodyLine (VAR Regel : STRING);
PROCEDURE RFC_AddTossedRegel (VAR Regel : STRING; VAR PrevHad13 : BOOLEAN);
PROCEDURE RFC_GoProcess;

FUNCTION  RFC_Domain2FTN (Domain : STRING; VAR Addr_F : FidoAddrType) : BOOLEAN;
FUNCTION  RFC_BuildFromHeader (Email,Fullname : STRING) : STRING;


TYPE TossWhatType = (twMail,  { .X with mail or SMTP }
                     twNews,  { .X with news}
                     twBag);  { combined mail and news }

VAR RFC_AddWhereTo : WhereToType;
    RFC_TossWhat   : TossWhatType;


IMPLEMENTATION

USES Dos,
     Globals,
     Ramon,
     Cfg,
     Logs,
     FBuffer,
     AreaBase,
     UserBase,
     FidoMsg,
     Crt,
     Routing,
     DupeChk,
     Keys,
     NewExec,
     AreaMgr,
     Fido,
     UseAdres,
     Trans,
     UUCPRout,
     Squish,
     ListSrv,
     SwapMem,
     Language,
     JAM,
     Start,
     TextFile,
     Nodelist,
     Address,
     Deliver,
     Decode,
     Charsets;

VAR UsenetUniqueTeller : LONGINT;

{--------------------------------------------------------------------------}
{ UseGetAddress                                                            }
{                                                                          }
{ Martijnd@Solist.Htsa.Aha.Nl  (Big Dijk) -> Martijnd@Solist.Htsa.Aha.Nl   }
{ <Big Dijk> Martijnd@Solist.Htsa.Aha.Nl  -> Martijnd@Solist.Htsa.Aha.Nl   }
{ <foold@notknown.dijkline.wlink.nl>      -> fool@dijkline.wlink.nl        }
{ rmburns   <rmburns@vela.acs.oakland.edu>-> rmburns@vela.oakland.edu      }
{ Martijnd@Solist.Htsa.Aha.Nl             -> Martijnd@Solist.Htsa.Aha.Nl   }
{ <fool@something> (Big Fool Is Here)     -> fool@something   (RWI 950217) }
{ "Full name" <e-mail@address>            -> e-mail@address (RAWI 980202)  }
{                                                                          }
FUNCTION UseGetAddress (Source : STRING) : STRING;

VAR X,Y : BYTE;

BEGIN
     {$IFDEF Pre}
     IF (Pos (#13,Source) > 0) THEN
        LogMessage (liReport,'[UseGetAddress] Found #13 in "'+Source+'"');
     {$ENDIF}

     Source:=DeleteBackSpaces (DeleteFrontSpaces (Source));
     X:=Pos ('<',Source);
     Y:=Pos ('>',Source);

     IF (X = 1) THEN
     BEGIN
          { RWI 950217: nieuwe optie: <email> (Full Name) }
          IF (Pos ('(',Source) > Y) THEN
             { RWI 950122: changed Y+1 to Y, anders stond er een spatie }
             {             achter: "<ramon@wsd> " en ging de length     }
             {             vergelijking mis.                            }
             Source:=Copy (Source,1,Y); { full name eraf knippen }

          IF (Y = Length (Source)) THEN
             { "<ramon@wsd.wlink.nl>" }
             UseGetAddress:=DeleteFrontAndBackSpaces (Copy (Source,X+1,Y-X-1))
          ELSE
              { "<Ramon van der Winkel> ramon@wsd.wlink.nl" }
              UseGetAddress:=DeleteFrontAndBackSpaces (Copy (Source,Y+1,255));
     END ELSE
         IF (X > 1) THEN
            { "Ramon van der Winkel <ramon@wsd.wlink.nl>" }
            UseGetAddress:=DeleteBackspaces (Copy (Source,X+1,Y-X-1))
         ELSE
             { geen < teken }
             IF (Pos ('(',Source ) > 0) THEN
                { "ramon@wsd.wlink.nl (Ramon van der Winkel)" }
                UseGetAddress:=DeleteBackspaces (Copy (Source,1,Pos ('(',Source)-1))
             ELSE
                 { geen ( teken, moet dus "ramon@wsd.wlink.nl" zijn }
                 UseGetAddress:=DeleteBackspaces (Source);
END;


{--------------------------------------------------------------------------}
{ UsenetArpaNetDate                                                        }
{                                                                          }
{ Creer een nieuwe Arpanet compatible datum, doen we niet moeilijk over.   }
{                                                                          }
FUNCTION UsenetArpaNetDate : STRING;

VAR Year,Months,Days,Dow,
    Hour,Minute,Second   : WordLong;
    LocalTime            : STRING;

TYPE Pre0sString = STRING[2];

    {----------------------------------------------------------------------}
    { Pre0s                                                                }
    {                                                                      }
    FUNCTION Pre0s (Getal : BYTE) : Pre0sString;

    VAR Tmp : Pre0sString;

    BEGIN
         Str (Getal,Tmp);
         IF (Getal < 10) THEN
            Tmp:='0'+Tmp;
         Pre0s:=Tmp;
    END;

BEGIN
     GetTime (Hour,Minute,Second,Dow{dummy});
     GetDate (Year,Months,Days,Dow);

     { Dit programma heeft de toekomst, wel tot 2099                }
     { maar dan houdt de systeem klok er ook mee op dus, who cares? }
     IF (Year > 1999) THEN
        Year:=1900; {# wat is dit nou? dan doet ie het niet meer na 1999#}

     LocalTime:=Day[Dow]+', '+Pre0s (Days)+' '+Month[Months]+' '+
                Pre0s (Year-1900)+' '+
                Pre0s (Hour)+':'+Pre0s (Minute)+':'+Pre0s (Second)+
                ' '+Config.TimeZone;

     UsenetArpaNetDate:=LocalTime;
END;


{--------------------------------------------------------------------------}
{ UsenetSplit                                                              }
{                                                                          }
{ Deze routine splitst de opgegeven domain adres met user naam op in de    }
{ juiste stukken en geeft deze terug. Eventuele andere methoden kunnen     }
{ hier nu eenvoudig toegevoegd worden.                                     }
{ De conversies:                                                           }
{ newsfix@wlink.nl         -> wlink.nl, newsfix                            }
{ Strlnd!newsfix           -> Strlnd, newsfix                              }
{ contrast.wlink.nl!sander -> contrast.wlink.nl, sander                    }
{ newsfix                  -> newsfix                                      }
{                                                                          }
PROCEDURE UsenetSplit (Adres : STRING; VAR Domain : UsenetDomainNameString; VAR User : UsenetUserNameString);

VAR P : BYTE;

BEGIN
     IF (Pos ('!',Adres) > 0) THEN
     BEGIN
          { laatste stuk is de user naam, rest is het pad }
          P:=Length (Adres);
          WHILE (Adres[P] <> '!') DO
                Dec (P);

          User:=Copy (Adres,P+1,255);
          Domain:=Copy (Adres,1,P-1);
          Exit;
     END;

     P:=Pos ('@',Adres);
     IF (P > 0) THEN
     BEGIN
          User:=Copy (Adres,1,P-1);
          Domain:=Copy (Adres,P+1,255);
          Exit;
     END;

     Domain:='';
     User:=Adres;
END;


{--------------------------------------------------------------------------}
{ UsenetIsOurDomain                                                        }
{                                                                          }
{ Deze routine geeft TRUE terug als het opgegeven domain in onze domains   }
{ lijst staat.                                                             }
{                                                                          }
FUNCTION UsenetIsOurDomain (Domain : STRING) : BOOLEAN;

VAR Lp : AkaIndexType;

BEGIN
     UsenetIsOurDomain:=TRUE;

     IF (Domain = '') THEN
        LogMessage (liReport,'Unexpected situation in OurDomain check.');

     Domain:=DeleteBackSpaces (Domain);

     { RWI 960604: WorldWide conditie verwijderd }
     IF CaselessMatch (Config.UUCPName,Domain) THEN
        Exit; { TRUE }

     FOR Lp:=1 TO MaxSystemDomains DO
         IF CaselessMatch (Config.Domains[Lp],Domain) THEN
            Exit; { TRUE }

     UsenetIsOurDomain:=FALSE;
END;


{--------------------------------------------------------------------------}
{ ScanHeader_FindEmail                                                     }
{                                                                          }
{ Deze routine verwerkt een regel die een deel van de To:, CC: of Bcc:     }
{ header bevat. Deze wordt van tabs ontdaan, spaties eraf gehakt en daarna }
{ op eventuele kommas in stukjes gehakt. Ieder stukje wordt bekeken of het }
{ een lokaal domain bevat. Als dat erin zit, dan wordt het aan de Address  }
{ gegeven om eventuele incomplete e-mail addressen aan te vullen.          }
{ Er wordt TRUE terug gegeven als er niet meer verder gezocht hoeft te     }
{ worden en er dus geen header stukken meer aangegeven hoeven te worden.   }
{                                                                          }
FUNCTION Scan_FindEMail (Regel : STRING) : BOOLEAN;

VAR Email,
    Part  : STRING;
    SysD  : BOOLEAN;
    Lp    : 1..MaxSystemDomains;

BEGIN
     IF (Regel[Length (Regel)] = #13) THEN
        Delete (Regel,Length (Regel),1);

     Regel:=DeleteFrontAndBackSpaces (CleanTabs (Regel,1));

     WHILE (Regel <> '') DO
     BEGIN
          IF (Pos (',',Regel) > 0) THEN
          BEGIN
               Part:=DeleteBackSpaces (Copy (Regel,1,Pos (',',Regel)-1));
               Delete (Regel,1,Pos (',',Regel));
               Regel:=DeleteFrontSpaces (Regel);
          END ELSE
          BEGIN
               Part:=Regel;
               Regel:='';
          END;

          EMail:=UseGetAddress (Part);

          { "postmaster" is ook wel eens de full-name, dus nog }
          { maar een check.                                    }

          { Doublequote check is voor MHS/X.400 systemen die een  }
          { To: hebben die het e-mail address tussen quotes op de }
          { eerste regel zetten als "user name" en op de volgende }
          { regel het echt e-mail adres.                          }
          IF (EMail[1] <> '"') THEN
          BEGIN
               { RWI 960914: check voor system domain address erin!       }
               {             anders wordt mailing list adres zelf genomen }
               SysD:=FALSE;

               { check system domains }
               FOR Lp:=1 TO MaxSystemDomains DO
                   IF (Config.Domains[Lp] <> '') AND
                      (Pos (UpCaseString (Config.Domains[Lp]),UpCaseString (EMail)) > 0) THEN
                   BEGIN
                        {LogMessage (liDebug,'Found (system domain): '+EMail);}
                        SysD:=TRUE;
                        Break; { from the for }
                   END;

               { check the system uucp name }
               IF (NOT SysD) AND (Config.UUCPName <> '') AND
                  (Pos (UpCaseString (Config.UUCPName)+'!',UpCaseString (EMail)) > 0) THEN
               BEGIN
                    {LogMessage (liDebug,'Found (UUCP name): '+EMail);}
                    SysD:=TRUE;
               END;

               { check for routed downlinks }
               IF (NOT SysD) AND (GetUUCPRoute (EMail) <> NILRecordNr) THEN
               BEGIN
                    {LogMessage (liDebug,'Found (can route to): '+EMail);}
                    SysD:=TRUE;
               END;

               IF SysD THEN
                  IF Address_FoundRFCAddress (EMail) THEN
                  BEGIN
                       Scan_FindEMail:=TRUE; { stop search }
                       Exit; { no need to keep on searching }
                  END;
          END;
     END; { while }

     Scan_FindEMail:=FALSE; { blijf aanvoeren }
END;


VAR ScanHeader_InToBlock          : BOOLEAN;
    ScanHeader_InContentTypeBlock : BOOLEAN;

{--------------------------------------------------------------------------}
{ ScanHeader_ContentType                                                  }
{                                                                         }
{ This function checks a Content-Type header for a multi-part indication. }
{                                                                         }
{ Content-Type: multipart/mixed;                                          }
{               boundary="_=_=_=IMA.BOUNDARY.EJEL26138764=_=_=_"          }
{                                                                         }
PROCEDURE ScanHeader_ContentType (Regel : STRING);

VAR Part : STRING;
    P    : BYTE;

BEGIN
     IF (Regel[Length (Regel)] = #13) THEN
        Delete (Regel,Length (Regel),1);

     IF (UpCaseString (Copy (Regel,1,24)) = 'CONTENT-TYPE: MULTIPART/') THEN
     BEGIN
          Delete (Regel,1,24); { the above }

          P:=Pos (';',Regel);
          IF (P > 0) THEN
             Delete (Regel,1,P)
          ELSE
              Regel:='';
     END ELSE
         IF (Regel[1] IN [' ',#9]) THEN
         BEGIN
              WHILE (Regel <> '') AND (Regel[1] IN [' ',#9]) DO
                    Delete (Regel,1,1);
         END ELSE
         BEGIN
              ScanHeader_InContentTypeBlock:=FALSE;
              Exit;
         END;

     { rest of the line and continuation lines are MIME variables, }
     { of which we want the "boundary" variable.                   }

     REPEAT
           Regel:=DeleteFrontAndBackSpaces (Regel);

           P:=Pos (';',Regel);

           IF (P > 0) THEN
           BEGIN
                Part:=Copy (Regel,1,P-1);
                Delete (Regel,1,P);
           END ELSE
           BEGIN
                Part:=Regel;
                Regel:='';
           END;

           Part:=DeleteFrontAndBackSpaces (Part);

           IF (Part <> '') THEN
           BEGIN
                P:=Pos ('=',Part);

                IF (P = 0) THEN
                BEGIN
                     LogMessage (liFatal,'Missing = in MIME variable: "'+Part+'"');
                     Exit;
                END;

                IF (UpCaseString (Copy (Part,1,P-1)) = 'BOUNDARY') THEN
                BEGIN
                     Part:=DeleteFrontSpaces (Copy (Part,P+1,255));
                     IF (Part[1] = '"') AND (Part[Length (Part)] = '"') THEN
                     BEGIN
                          Delete (Part,Length (Part),1);
                          Delete (Part,1,1);
                     END;

                     Msg.MultiPartBoundary:=Part;
                     IF Config.LogDebug THEN
                        LogMessage (liDebug,'Boundary: "'+Part+'"');

                     ScanHeader_InContentTypeBlock:=FALSE; { stop now }
                     Exit; { we found what we were looking for }
                END;
           END;

     UNTIL (Regel = '');
END;


{--------------------------------------------------------------------------}
{ ScanHeader_ProcessLine                                                   }
{                                                                          }
{ This routine checks each header line and copies interesting info.        }
{                                                                          }
FUNCTION ScanHeader_ProcessLine (VAR OrigRegel : STRING) : BOOLEAN; FAR;

    {----------------------------------------------------------------------}
    { UnSpace                                                              }
    {                                                                      }
    { deze routine haalt de troep weg de Pegasus Mail geproduceert heeft.  }
    { Daar staat bijvoorbeeld: "From:       <naam>". Hier worden al die    }
    { spaties weggehaald.                                                  }
    { Nu wordt ook de #13 aan het einde van de regel verwijderd.           }
    {                                                                      }
    FUNCTION UnSpace (Regel : STRING) : STRING;

    VAR P : BYTE;

    BEGIN
         IF (Regel[Length (Regel)] = #13) THEN
            Delete (Regel,Length (Regel),1);

         { let op: onderstaande methode vervangt alleen de spaties achter }
         { de EERSTE dubbele punt! Niet een Pos (': ',Regel) gebruiken!!  }
         P:=Pos (':',Regel);
         IF (P > 0) THEN
            WHILE (Length (Regel) > P+2) AND (Regel[P+2] = ' ') DO
                  Delete (Regel,P+2,1);

         UnSpace:=Regel;
    END;

{ScanHeader_ProcessLine}

VAR Kludge,
    Regel  : STRING;

BEGIN
     ScanHeader_ProcessLine:=FALSE; { do not abort }

     Regel:=OrigRegel;

     Kludge:=UpCaseString (Copy (Regel,1,Pos (':',Regel)-1));

     IF (Msg.Ready_U = Mail) AND (Config.RMailCorrect = ctScanHeaders) THEN
        IF (Kludge = 'CC') OR
           (Kludge = 'BCC') OR
           (Kludge = 'TO') OR
           (Kludge = 'APPARENTLY-TO') THEN
        BEGIN
             { incomplete e-mail adres correctie }

             ScanHeader_InToBlock:=TRUE; { controleer DEZE plus volgregels }

             { To: weghalen en een spatie ervoor zetten }
             Regel:=' '+Copy (Regel,Length (Kludge)+2,255);

             { checks are done below }
        END;

     IF ScanHeader_InToBlock THEN
     BEGIN
          IF (Regel[1] IN [' ',#9]) THEN
          BEGIN
               IF Scan_FindEmail (Regel) THEN
                  ScanHeader_InToBlock:=FALSE;  { stop checking }
          END ELSE
              ScanHeader_InToBlock:=FALSE; { einde van To: blok }
     END;

     IF ScanHeader_InContentTypeBlock THEN
     BEGIN
          IF (Regel[1] IN [' ',#9]) THEN
          BEGIN
               ScanHeader_ContentType (Regel);
          END ELSE
              ScanHeader_InContentTypeBlock:=FALSE;
     END;

     { RWI 960601 }
     IF (Kludge = '') THEN
        Exit;


     IF (Kludge = 'TO') THEN
        Msg.ToUser_U:=UnSpace (OrigRegel);

     IF (Kludge = 'FROM') THEN
        Msg.FromUser_U:=UnSpace (OrigRegel);

     IF (Kludge = 'ORGANIZATION') THEN
        Msg.Organization_U:=UnSpace (OrigRegel);

     IF (Kludge = 'MESSAGE-ID') THEN
        Msg.MessageID_U:=UnSpace (OrigRegel);

     IF (Kludge = 'IN-REPLY-TO') THEN
        Msg.InReplyTo_U:=UnSpace (OrigRegel); { RWI 960404: toegevoegd }

     IF (Kludge = 'SENDER') THEN
        Msg.Sender_U:=UnSpace (OrigRegel);

     IF (Kludge = 'SUBJECT') THEN
        Msg.Subj_U:=UnSpace (OrigRegel);

     IF (Kludge = 'DATE') THEN
        Msg.Date_U:=UnSpace (OrigRegel);

     IF (Kludge = 'MIME-VERSION') THEN
        Msg.IsMime:=TRUE;

     IF (Kludge = 'REPLY-TO') THEN
        Msg.ReplyTo_U:=UnSpace (OrigRegel);

     IF (Kludge = 'REFERENCES') THEN
        Msg.References_U:=Unspace (OrigRegel);

     IF (Kludge = 'APPROVED') THEN
        Msg.Approved_U:=TRUE;

     IF (Kludge = 'APPARENTLY-TO') THEN
        Msg.ApparentlyTo:=UnSpace (OrigRegel);

     IF (Kludge = 'APPARENTLY-FROM') THEN
        Msg.ApparentlyFrom:=UnSpace (OrigRegel);

     IF (Kludge = 'CONTROL') THEN
        Msg.Control:=UnSpace (OrigRegel);

     IF (Kludge = 'CONTENT-TYPE') THEN
     BEGIN
          ScanHeader_InContentTypeBlock:=TRUE;
          ScanHeader_ContentType (Regel);
     END;

     IF (Kludge = 'NEWSGROUPS') THEN
        Msg.Newsgroups_U:=UnSpace (OrigRegel);
END;


{--------------------------------------------------------------------------}
{ RFC_CompleteAdmin                                                        }
{                                                                          }
{ Deze routine maakt de universele msg af met de Usenet gegevens. Deze     }
{ worden hier uit het header blok gehaald en geinterpreteerd. Hierbij      }
{ wordt Unfolding toegepast op velden die langer zijn dan een regel.       }
{ Voor de regels die aangepast moeten worden zodat het lijkt dat ie door   }
{ ons verwerkt is, worden her de aanpassingen gemaakt.                    }
{                                                                          }
{ SWAPCOMMENT: Dit is een zelfstandige routine en hoeft daarom niet bij te }
{              houden WAAR in de swapfile ie bezig was.                    }
{                                                                          }
{ RWI 950803: controle op domain-loze naam in Msg.XqtTo_U en vervanging    }
{             door wat er in het To: veld staat.                           }
{                                                                          }
PROCEDURE RFC_CompleteAdmin;
BEGIN
     ScanHeader_InToBlock:=FALSE;
     ScanHeader_InContentTypeBlock:=FALSE;

{$IFNDEF WtrTest}
     MsgsForEach (Msg.HeaderTop_U,ScanHeader_ProcessLine);
{$ELSE (WtrTest)}
     IF (Msg.Ready_U = Mail) THEN
        Scan_FindEMail (Copy (Msg.ToUser_U,4,255));
{$ENDIF (!WtrTest)}

     IF (Msg.ApparentlyTo <> '') AND (Msg.ToUser_U = '') THEN
        Msg.ToUser_U:=Copy (Msg.ApparentlyTo,12,255); { keeps To: }

     IF (Msg.ApparentlyFrom <> '') AND (Msg.FromUser_U = '') THEN
        Msg.FromUser_U:=Copy (Msg.ApparentlyFrom,12,255); { keep "From: " }
END;


{--------------------------------------------------------------------------}
{ CheckNewsForDupe                                                         }
{                                                                          }
{ This routine checks whether the news message is a dupe.                  }
{                                                                          }
PROCEDURE CheckNewsForDupe;

VAR DupeValue : LONGINT;
    Lp        : 1..MAX_AREA_CROSS_POSTS;
    AreaRecNr : AreaBaseRecordNrType;
    AreaRec   : AreaBaseRecord;

BEGIN
     { calculate once }
     DupeValue:=DupeCheck_CalcDupeValue_News;

     { and use to check all areas }
     FOR Lp:=1 TO MAX_AREA_CROSS_POSTS DO
     BEGIN
          AreaRecNr:=Msg.AreaRecNrs[Lp];

          IF (AreaRecNr <> NILRecordNr) THEN
          BEGIN
                ReadAreaBaseRecord (AreaRecNr,AreaRec);
                IF (AreaRec.DupeAge <> 0) THEN
                BEGIN
                     DupeCheck_SetAreaRef (AreaRecNr,AreaRec);

                     IF DupeCheck_Exists (DupeValue) THEN
                     BEGIN
                          Msg.Ready_U:=Dupe;
                          LogMessage (liGeneral,'News article is a duplicate!');
                          Exit;
                     END;
                END;
          END;
     END; { for }
END;


{--------------------------------------------------------------------------}
{ RFC_GoProcess                                                            }
{                                                                          }
{ This routine processed an mail or news messages that is now in memory.   }
{ It updates the screen statistics, checks for dupes in news and then      }
{ exports the message. This routine can be called in the middle of a UUCP  }
{ news batch or BAG file. Both Mail and News can be ready for processing.  }
{ For Mail, the list of multiple recipients must be post-processed to      }
{ filter out Error addresses.                                              }
{                                                                          }
PROCEDURE RFC_GoProcess;

VAR IORes     : BYTE;
    Name      : STRING[8];
    OutName   : STRING[80];
    Hulp      : STRING[2];

BEGIN
     { RWI 960915: controle op leeg bericht toegevoegd }
     IF (Msg.HeaderTop_U = NIL) THEN
        Msg.Ready_U:=NotReady;

     IF (Msg.Ready_U = NotReady) THEN
     BEGIN
          { it is normal to get here with a NotReady state for the first }
          { UUCP news message in a batch. It finds the "#! rnews" and    }
          { calls this routine.                                          }
          IF (Msg.BodyParts[1] <> NIL) THEN
             LogMessage (liFatal,'[GoProcess] Ready_U not set. Dropping message!');
          Exit;
     END;

     IF Config.LogDebug THEN
        LogMessage (liDebug,'RFC_GoProcess: '+Byte2String (Msg.CurrentBodyPart)+' parts');

     CASE PacketUserData.System OF
          _U   : UpdateInfoNr (INFO_UucpIn_Msgs,1);
          _S   : UpdateInfonr (INFO_SmtpIn_Msgs,1);
          _B   : UpdateInfoNr (INFO_BagIn_Msgs,1);
          _P   : UpdateInfoNr (INFO_Pop3In_Msgs,1);
          _SOUP: UpdateInfoNr (INFO_SoupIn_Msgs,1);
     END;

     IF (Msg.Ready_U = Mail) THEN
     BEGIN
          {### stats}
          {
          UpdateUserStats (Msg.DeliveringUserRecNr,MailFrom,Msg.MsgSize);
          }


          CASE PacketUserData.System OF
               _U   : UpdateInfoNr (INFO_UucpIn_Mail,1);
               _S   : UpdateInfonr (INFO_SmtpIn_Mail,1);
               _B   : UpdateInfoNr (INFO_BagIn_Mail,1);
               _P   : UpdateInfoNr (INFO_Pop3In_Mail,1);
               _SOUP: UpdateInfoNr (INFO_SoupIn_Mail,1);
          END;

          { onderzoek nu alle destRFCRaw addresses en schrijf bounce, forward, }
          { CC, etc. berichten }
          Address_CheckRFCRaw;
     END;

     IF (Msg.Ready_U = News) THEN
     BEGIN
          { add destination to get the distribution started }
          Address_SelectNewsgroups;
          Address_AddNews;

          CASE PacketUserData.System OF
               _B   : UpdateInfoNr (INFO_BagIn_News,1);
               _U   : UpdateInfoNr (INFO_UucpIn_News,1);
               _SOUP: UpdateInfoNr (INFO_SoupIn_News,1)
               ELSE
                   LogMessage (liReport, '[RFC_GoProcess] Unknown system type in News delivery');
          END; { case }

          { always count the statistics, whether dupe or not }
          {### stats}
          {
          UpdateUserStats (Msg.DeliveringUserRecNr,NewsFrom,Msg.MsgSize);
          }

          { check for dupes in all known areas }
          CheckNewsForDupe;
     END;

     DeliverNow;
END;


{--------------------------------------------------------------------------}
{ RFC_PreCheckBodyLine                                                    }
{                                                                          }
{ This routine checks a line that will be added to the body. It was broken }
{ out of RFC_AddTossedRegel so it can be used from the POP3 code as well.  }
{                                                                          }
PROCEDURE RFC_PreCheckBodyLine (VAR Regel : STRING);
BEGIN
     IF (Msg.IsMime) AND (Msg.MultiPartBoundary <> '') THEN
     BEGIN
          { multi-part mime }

          IF (Regel = '--'+Msg.MultiPartBoundary+#13) OR        {intermediate }
             (Regel = '--'+Msg.MultiPartBoundary+'--'+#13) THEN {terminating }
          BEGIN
               { found a boundary line: start a new part }
               IF (Msg.BodyParts[Msg.CurrentBodyPart] <> NIL) AND
                  (Msg.BodyParts[Msg.CurrentBodyPart]^.TotalRegelLength > 0) THEN
               BEGIN
                    { check if we can add a new part }
                    IF (Msg.CurrentBodyPart = MAX_BODY_PARTS) THEN
                       LogMessage (liReport,'Too many multiparts in MIME message')
                    ELSE BEGIN
                         Inc (Msg.CurrentBodyPart);
                         IF Config.LogDebug THEN
                            LogMessage (liDebug,'MIME multipart '+Byte2String (Msg.CurrentBodyPart));
                    END;
               END;
          END;
     END ELSE
     BEGIN
          { not multi-part mime, but might be single-part mime }
          {$IFDEF Pre}
          IF (Msg.CurrentBodyPart < 1) OR (Msg.CurrentBodyPart > MAX_BODY_PARTS) THEN
             LogMessage (liReport,'Msg.CurrentBodyPart is out of range: '+
                                  Word2String (Msg.CurrentBodyPart));
          {$ENDIF}

          { check for UU or XX encoded attachments and stuff them in }
          { their own body part.                                     }
          IF (Msg.BodyParts[Msg.CurrentBodyPart] <> NIL) AND
             (Msg.BodyParts[Msg.CurrentBodyPart]^.PartStatus = psAttachment) THEN
          BEGIN
               { inside an attachment - find the "end" and "sum -r" lines }
               IF (Regel = #13) THEN
               BEGIN
                    LogMessage (liTrivial,'Detected end of attachment');
                    IF (Msg.CurrentBodyPart = MAX_BODY_PARTS) THEN
                       LogMessage (liReport,'Too many body parts')
                    ELSE BEGIN
                         { start a new body part }
                         Inc (Msg.CurrentBodyPart);
                    END;
               END;
          END ELSE
          BEGIN
               { not inside an attachment - find the "begin <n> <filename>" line }
               IF (Copy (Regel,1,6) = 'begin ') AND
                  (Regel[7] IN ['0'..'7']) AND
                  (Regel[8] IN ['0'..'7']) AND
                  (Regel[9] IN ['0'..'7']) THEN
               BEGIN
                    { found the start of an UU or XX encoded attachment }
                    LogMessage (liTrivial,'Detected an attachment ('+Copy (Regel,1,Length (Regel)-1)+')');

                    IF (Msg.CurrentBodyPart = MAX_BODY_PARTS) THEN
                       LogMessage (liReport,'Too many body parts')
                    ELSE BEGIN
                         Inc (Msg.CurrentBodyPart);
                         Msg.BodyParts[Msg.CurrentBodyPart]:=MsgsCreateTopRegelRecord;
                         Msg.BodyParts[Msg.CurrentBodyPart]^.PartStatus:=psAttachment;
                    END;
               END ELSE
                   IF (Regel = BINHEX_HEADER+#13) THEN
                   BEGIN
                        { start of a BinHex attachment }
                        { same end as for UU/XX encoded files }
                        LogMessage (liGeneral,'Detected a BinHex 4.0 attachment (not supported yet)');

                        IF (Msg.CurrentBodyPart = MAX_BODY_PARTS) THEN
                           LogMessage (liReport,'Too many body parts')
                        ELSE BEGIN
                             Inc (Msg.CurrentBodyPart);
                             Msg.BodyParts[Msg.CurrentBodyPart]:=MsgsCreateTopRegelRecord;
                             Msg.BodyParts[Msg.CurrentBodyPart]^.PartStatus:=psAttachment;
                        END;
                   END;
          END;
     END;
END;


{--------------------------------------------------------------------------}
{ RFC_AddTossedRegel                                                       }
{                                                                          }
{ Met deze routine wordt een regel die zojuist uit een .D file is binnen   }
{ gekomen naar in de universele msg gezet. Als de regel te lang is worden  }
{ er meerdere regels van gemaakt, met uitzondering van een aantal kludges. }
{ Als het een kludge regel bevat, dan komt deze in de header.              }
{ De Regel is als VAR meegegeven omdat dan alleen een pointer wordt mee-   }
{ gegeven en niet een kopie van de tekst, die daarna toch weer weggegooid  }
{ wordt.                                                                   }
{ Als deze routine het einde van een bericht tegenkomt wordt het bericht   }
{ verwerkt door MsgsExport aan te roepen. Het einde van een bericht is     }
{ gedefinieerd als "#! rnews" of het einde van de file, maar dat wordt in  }
{ een andere routine bepaald.                                              }
{ De scheiding tussen header en body wordt gemaakt door een lege regel.    }
{                                                                          }
PROCEDURE RFC_AddTossedRegel (VAR Regel : STRING; VAR PrevHad13 : BOOLEAN);

VAR Test  : LONGINT;
    Nop   : ValNop;
    P     : BYTE;
    Temp  : STRING;

BEGIN
     { detect start of new news article in BAG file and UUCP news batches }
     IF (RFC_TossWhat <> twMail) AND (Copy (Regel,1,8) = '#! rnews') THEN
     BEGIN
          { er komt een nieuw bericht aan. Maak de vorige af en verwerk die }

          RFC_GoProcess;

          MsgsEmptyKeepDeliveringUser; { including addresses }
          RFC_AddWhereTo:=Header_U;
          Msg.Ready_U:=News; { expecting news }

          { #! rnews line is now processed }
          Exit;
     END;

     IF (RFC_TossWhat = twBag) AND (Copy (Regel,1,8) = '#! rmail') THEN
     BEGIN
          { zou alleen bij .BAG files voor moeten komen }
          { er komt een nieuw e-mail bericht aan }

          RFC_GoProcess;

          MsgsEmptyKeepDeliveringUser; { drops all recipients as well! }
          RFC_AddWhereTo:=Header_U;
          Msg.Ready_U:=Mail; { expecting mail }

          { stop de rest van de rmail regel in de Xqt_To voor naar disk }
          { schrijven of verwerken in een latere fase.                  }
          Delete (Regel,1,9);
          IF (Regel[Length (Regel)] = #13) THEN
             Delete (Regel,Length (Regel),1);

          Regel:=DeleteFrontSpaces (Regel);

          { ivm KA9Q: als de regel nu een 10-cijferig nummer bevat, dan }
          { strippen we die.                                            }
          { RWI961214: alle nummers verwijderen, ook korte nummers,     }
          { maar nog wel nummers in e-mail adressen ondersteunen. Er    }
          { moet dus een spatie achter de nummers staan.                }
          P:=Pos (' ',Regel);
          IF (P > 0) THEN
          BEGIN
               { kijk of het een nummer is }
               Val (Copy (Regel,1,P-1),Test,Nop);
               IF (Nop = 0) THEN
                  Delete (Regel,1,P);
          END;

          { split the rest into e-mail addresses, which are then to be }
          { fed into the system one by one }
          WHILE (Regel <> '') DO
          BEGIN
               Regel:=DeleteFrontSpaces (Regel);
               P:=Pos (' ',Regel);
               IF (P > 0) THEN
               BEGIN
                    Address_AddRFCRaw (Copy (Regel,1,P-1),destTo,FALSE,FALSE);
                    Delete (Regel,1,P);
               END ELSE
               BEGIN
                    Address_AddRFCRaw (Regel,destTo,FALSE,FALSE);
                    Regel:='';
               END;
          END; { while }

          { #! rmail line now processed }
          Exit;
     END;

     IF (RFC_AddWhereTo = Header_U) THEN
     BEGIN
          IF (PrevHad13) AND (Regel = #13) THEN
          BEGIN
               { overgang van header naar body }

               { check the header for MIME and Content-Type so we can }
               { act on boundary headers while reading the message.   }
               RFC_CompleteAdmin;

               RFC_AddWhereTo:=Body;

               { deze *lege* regel NIET opslaan! }
               { MakeOut maakt em wel weer aan.  }
               Exit;
          END;

          PrevHad13:=(Regel[Length (Regel)] = #13);

          IF (UpCaseString (Copy (Regel,1,6)) = 'PATH: ') AND
             (Pos ('@',Regel) = 0) {RAWI961019} THEN
          BEGIN
               Temp:=NewsDomain;
               (*
               IF Config.WorldWide THEN
                  Temp:=Config.UUCPName
               ELSE
                   Temp:=Config.Domains[1];
               *)

                     {Path: }
               Temp:=Copy (Regel,1,6)+Temp+'!';
               Delete (Regel,1,6);

               IF (Length (Regel)+Length (Temp) > 255) THEN
               BEGIN
                    { split in tweeen }
                    Temp:=Temp+Copy (Regel,1,100);
                    MsgsAddLineToNoEOL (RFC_AddWhereTo,Temp);
                    Delete (Regel,1,100);
               END ELSE
                   Regel:=Temp+Regel;
          END;
     END;

     { see if we have to start a new multi part body block }
     IF (RFC_AddWhereTo = Body) THEN
        RFC_PreCheckBodyLine (Regel);

     MsgsAddLineToNoEOL (RFC_AddWhereTo,Regel);
END;


{--------------------------------------------------------------------------}
{ UsenetUniqueNameInit                                                     }
{                                                                          }
{ Deze routine initialiseert een teller aan de hand van de Maand, Dag en   }
{ aantal tikken vandaag.                                                   }
{                                                                          }
{ MD> Leuke routine maar als de waarde <0 dan gaan er allerlei dingen      }
{     verkeerd...                                                          }
{                                                                          }
PROCEDURE UsenetUniqueNameInit;

VAR Maand,Dag,Nop : WordLong;
    InFile        : TEXT;
    IORes         : BYTE;

BEGIN
     Assign (InFile,'WGSETNR.TST');
     {$I-} Reset (InFile); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          ReadLn (InFile,UsenetUniqueTeller);
          Close (InFile);
          Exit;
     END;

     GetDate (Nop,Maand,Dag,Nop);

     UsenetUniqueTeller:=GetTimer AND ((1 SHL 22) -1) SHL 2; { 18.2 keer/sec ++ }
     UsenetUniqueTeller:=UsenetUniqueTeller OR (Longint (Dag) SHL 23);
     UsenetUniqueTeller:=UsenetUniqueTeller OR (Longint (Maand) SHL 28);

     IF (UsenetUniqueTeller < 0) THEN
        UsenetUniqueTeller:=-UsenetUniqueTeller;
END;


{--------------------------------------------------------------------------}
{ GetUsenetUniqueName                                                      }
{                                                                          }
{ Deze routine bepaald de naam van het volgende .DAT file. De bij het      }
{ opgestarten van het programma bepaalde teller wordt hier met een (1)     }
{ verhoogd en omgezet in een string. Er wordt een 36 tekens codering per   }
{ digit gebruikt, waardoor er maar 6 tekens nodig zijn om te de code op te }
{ bouwen.                                                                  }
{                                                                          }
{ Het leading character wordt nu voorzien van een 'Z' voor news, en een    }
{ 'A' voor mail berichten, zodat een mail bericht hogere prioriteit krijgt }
{ dan een news bundel.                                                     }
{                                                                          }
{ RWI 960224: Mail en News grade geintroduceerd. De A en Z zijn nu in te   }
{             stellen.                                                     }
{                                                                          }
FUNCTION GetUsenetUniqueName (Grade : CHAR) : STRING;

VAR Res    : STRING[8];
    Getal  : LONGINT;
    MaxLen : BYTE;

BEGIN
     IF NOT (Grade IN ['0'..'9','A'..'Z','a'..'z']) THEN
     BEGIN
          LogMessage (liConfig,'Invalid grade "'+Grade+'"; using A instead');
          Grade:='A';
     END;

     Inc (UsenetUniqueTeller);
     Getal:=UsenetUniqueTeller;
     Res:='';

     IF Config.ForceNoBitmask THEN
        MaxLen:=5
     ELSE
         MaxLen:=4;

     { getal met base 36 omzetting naar een string }
     WHILE (Getal <> 0) AND (Length (Res) < MaxLen) DO
     BEGIN
          IF ((Getal MOD 36) < 10) THEN
             Res:=Chr (Ord ('0')+(Getal MOD 36))+Res
          ELSE
              Res:=Chr (Ord ('A')-10+(Getal MOD 36))+Res;

          Getal:=Getal DIV 36;
     END;

     GetUsenetUniqueName:=Grade+Res;
END;


{-------------------------------------------------------------------------}
{ UsenetGetUUCPName                                                       }
{                                                                         }
{ Geeft de UUCP name van een domain adres terug.                          }
{                                                                         }
{ Waterland.Wlink.Nl -> Waterland                                         }
{                                                                         }
FUNCTION UsenetGetUUCPName (Domain : STRING) : STRING;

VAR Loc : BYTE;

BEGIN
     { Splits op de eerste punt }
     Loc:=Pos ('.',Domain);

     IF (Loc <> 0) THEN
        UsenetGetUUCPName:=Copy (Domain,1,Loc-1)
     ELSE
         UsenetGetUUCPName:=Domain;
END;


{--------------------------------------------------------------------------}
{ UsenetReplyAdres                                                         }
{                                                                          }
{ Deze routine maakt een keuze uit de beschikbare terugzend adressen,      }
{ en geeft degene met de hoogste prioriteit terug.                         }
{                                                                          }
FUNCTION UsenetReplyAdres : STRING;

VAR Tmp : STRING;

BEGIN
     { RWI 960320: added prevention against empty header lines, like }
     {             "Reply-To: ".                                     }

     IF (Msg.ReplyTo_U <> '') THEN
     BEGIN
          Tmp:=UseGetAddress (Copy (Msg.ReplyTo_U,Length ('Reply-To: ')+1,255));
          IF (Tmp <> '') THEN
          BEGIN
               UsenetReplyAdres:=Tmp;
               Exit;
          END;
     END;

     { I believe an RFC says that Sender: is just the posting agent }
     { and replies should go to Reply-To, then From, then Sender...  }
     IF (Msg.Sender_U <> '') THEN
     BEGIN
          Tmp:=UseGetAddress (Copy (Msg.Sender_U,Length ('Sender: ')+1,255));
          IF (Tmp <> '') THEN
          BEGIN
               UsenetReplyAdres:=Tmp;
               Exit;
          END;
     END;

     IF (Msg.FromUser_U <> '') THEN
     BEGIN
          Tmp:=UseGetAddress (Copy (Msg.FromUser_U,Length ('From: ')+1,255));
          IF (Tmp <> '') THEN
          BEGIN
               UsenetReplyAdres:=Tmp;
               Exit;
          END;
     END;

     { add "From " header handling? (UUCP only) }

     LogMessage (liFatal,'Could not find RFC reply address (1)');

     UsenetReplyAdres:='';
END;


{--------------------------------------------------------------------------}
{ UsenetPosterName                                                         }
{                                                                          }
{ This routine takes the Reply-To, Sender or From header and extracts the  }
{ e-mail address and full name found there and returns these two parts.    }
{                                                                          }
FUNCTION UsenetPosterName : STRING;

VAR Tmp : STRING;

BEGIN
     IF (Msg.FromUser_U <> '') THEN
     BEGIN
          Tmp:=Copy (Msg.FromUser_U,Length ('From: ')+1,255);
          IF (Pos (' ',Tmp) > 0) THEN
          BEGIN
               UsenetPosterName:=Trans_RfcHeader2FullName (0,Tmp);
               Exit;  { ## EXIT ## }
          END;
     END;

     IF (Msg.Sender_U <> '') THEN
     BEGIN
          Tmp:=Copy (Msg.Sender_U,Length ('Sender: ')+1,255);
          IF (Pos (' ',Tmp) > 0) THEN
          BEGIN
               UsenetPosterName:=Trans_RfcHeader2FullName (0,Tmp);
               Exit;  { ## EXIT ## }
          END;
     END;

     IF (Msg.ReplyTo_U <> '') THEN
     BEGIN
          Tmp:=Copy (Msg.ReplyTo_U,Length ('Reply-To: ')+1,255);
          IF (Pos (' ',Tmp) > 0) THEN
          BEGIN
               UsenetPosterName:=Trans_RfcHeader2FullName (0,Tmp);
               Exit;  { ## EXIT ## }
          END;
     END;

     { extract from e-mail address instead }
     Tmp:=UsenetReplyAdres;
     UsenetPosterName:=Trans_RfcHeader2FullName (0,Tmp);
END;


{--------------------------------------------------------------------------}
{ UseGetSystemFromName                                                     }
{                                                                          }
{ Aangezien we onze UUCP name alleen mogen gebruiken als ie uniek is       }
{ bepaal hier welke string we op die plaats moeten zetten.                 }
{                                                                          }
FUNCTION UseGetSystemFromName : STRING;
BEGIN
     IF Config.WorldWide THEN
        UseGetSystemFromName:=Config.UUCPName
     ELSE
         UseGetSystemFromName:=Config.Domains[1];
END;


{---------------------------------------------------------------------------}
{ UseGetUserFromName                                                        }
{                                                                           }
{ Deze routine geeft de domain naam aan de hand van het opgegeven userbase  }
{ record terug. Als de user worldreg is, dan wordt het zijn/haar uucpname,  }
{ anders het eerste domain adres.                                           }
{                                                                           }
FUNCTION UseGetUserFromName (UserData : UserBaseRecord) : STRING;
BEGIN
     { removed... was too confusing and used wrong all the time..
     IF UserData.WorldReg THEN
        UseGetUserFromName:=UserData.UUCPName
     ELSE
     }
     UseGetUserFromName:=UserData.Domains[1];
END;


{--------------------------------------------------------------------------}
{ RFC_BuildHeader                                                          }
{                                                                          }
{ This routine creates all the header lines needed for a message.          }
{                                                                          }
PROCEDURE RFC_BuildHeader (FromName,FromEMail,Subject : STRING);
BEGIN
     { add first system domain if no domain given }
     IF (Pos ('!',FromEMail) = 0) AND (Pos ('@',FromEMail) = 0) THEN
        FromEMail:=FromEMail+'@'+Config.Domains[1];

     (* this is now done by the UUCP mail outbound handling code!
     BEGIN
          { bang!path address in From_ header }
          MsgsAddLineTo (Header_U,'From '+UseGetSystemFromName+'!'+FromEMail+' '+UsenetArpaNetDate);

          { dom@in address in From: header }
          FromEMail:=FromEMail+'@'+Config.Domains[1];
     END ELSE
         { already contains a ! or @ -> use as is }
         MsgsAddLineTo (Header_U,'From '+FromEMail+' '+UsenetArpaNetDate);
     *)

     Msg.Date_U:='Date: '+UsenetArpaNetDate;
     MsgsAddLineTo (Header_U,Msg.Date_U);

     { bouw ook FromUser_U op, want die wordt gebruikt door TransMail->Net }
     { om de naam van de zender uit te vissen.                             }

     { put SenderName between comment braces, if present }
     IF (FromName <> '') THEN
        FromName:=' ('+FromName+')';

     Msg.FromUser_U:='From: '+FromEmail+FromName;
     MsgsAddLineTo (Header_U,Msg.FromUser_U);

     Msg.MessageId_U:='Message-ID: <'+GetFidoPktName+'@'+Config.Domains[1]+'>';
     MsgsAddLineTo (Header_U,Msg.MessageId_U);

     Msg.Subj_U:='Subject: '+Subject;
     MsgsAddLineTo (Header_U,Msg.Subj_U);

     IF (Config.Organization <> '') THEN
     BEGIN
          Msg.Organization_U:='Organization: '+Config.Organization;
          MsgsAddLineTo (Header_U,Msg.Organization_U);
     END;
END;


{--------------------------------------------------------------------------}
{ RFC_StartSingleRecipientMessage                                          }
{                                                                          }
{ This routine starts a new, system originated message (MsgsEmpty is       }
{ called!) and adds a single recipient address. This address shows up in   }
{ the To: line as well.                                                    }
{                                                                          }
PROCEDURE RFC_StartSingleRecipientMessage (RecipientEMail,FromEMail,FromName,Subject : STRING);
BEGIN
     MsgsEmpty; { Zorg dat we met een schone lei beginnen }

     RFC_BuildHeader (FromName,FromEmail,Subject);

     Msg.ToUser_U:='To: '+RecipientEmail;
     MsgsAddLineTo (Header_U,Msg.ToUser_U);

     Msg.Ready_U:=Mail;

     Address_AddRFCRaw (RecipientEmail,destTo,{AddNote:}FALSE,FALSE);
END;


{--------------------------------------------------------------------------}
{ RFC_PushAndBuildReply                                                    }
{                                                                          }
{ This routine sets up a reply e-mail back to the original sender of the   }
{ message, based on the UsenetReplyAdres. The subject and full name plus   }
{ e-mail address of the sender can be given.                               }
{                                                                          }
PROCEDURE RFC_PushAndBuildReply (Subject,FromName,FromEmail : STRING);

VAR ReplyAd : STRING;

BEGIN
     ReplyAd:=UsenetReplyAdres;

     MsgsPushState;   { performs a MsgsEmptyKeepSwapfile }

     RFC_BuildHeader (FromName,FromEMail,Subject);

     Msg.ToUser_U:='To: '+ReplyAd;
     MsgsAddLineTo (Header_U,Msg.ToUser_U);

     IF CaselessStartMatch (Msg.PrevMsgPtr^.MessageID_U,'Message-ID: ') THEN
     BEGIN
          Msg.InReplyTo_U:='In-Reply-To: '+Copy (Msg.PrevMsgPtr^.MessageID_U,13,255);
          MsgsAddLineTo (Header_U,Msg.InReplyTo_U);
     END ELSE
         Msg.InReplyTo_U:='';

     Msg.Ready_U:=Mail;

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


{--------------------------------------------------------------------------}
{ Bounce_InsertOriginalMessage                                             }
{                                                                          }
{ This is used by all the RFC bounce routines to include the start of or   }
{ the complete body of the message that is being bounced.                  }
{                                                                          }
PROCEDURE Bounce_InsertOriginalMessage;

VAR N         : WORD;
    Lp        : 1..MAX_BODY_PARTS;
    Truncated : BOOLEAN;

BEGIN
     MsgsAddLineTo (Body,RepChar (70,'-'));

     IF Config.BounceSmall THEN
        { Start of original message follows below }
        MsgsAddLineTo (Body,GetLang0 (120))
     ELSE
         { Original message follows below: }
         MsgsAddLineTo (Body,GetLang0 (122));

     MsgsAddLineTo (Body,RepChar (70,'-'));
     MsgsAddLineTo (Body,'');

     { add the original header }
     MsgsCopyNLines (Msg.PrevMsgPtr^.HeaderTop_U,0);
     MsgsAddLineTo (Body,'');

     IF Config.BounceSmall THEN
     BEGIN
          Truncated:=FALSE;
          N:=20;
          FOR Lp:=1 TO MAX_BODY_PARTS DO
          BEGIN
               IF (N = 0) THEN
               BEGIN
                    Truncated:=TRUE;
                    Break; { from the for }
               END;

               Dec (N,MsgsCopyNLines (Msg.PrevMsgPtr^.BodyParts[Lp],N));
          END;

          IF Truncated THEN
          BEGIN
               {*** truncated rest of message ***}
               MsgsAddLineTo (Body,'');
               MsgsAddLineTo (Body,GetLang0 (121));
          END;
     END ELSE
         FOR Lp:=1 TO MAX_BODY_PARTS DO
             MsgsCopyNLines (Msg.PrevMsgPtr^.BodyParts[Lp],0);
END;


{--------------------------------------------------------------------------}
{ RFC_BounceTo                                                             }
{                                                                          }
{ This routine bounces an RFC message back to the sender. The reason is    }
{ put at the top and (part of) the original body is included.              }
{                                                                          }
PROCEDURE RFC_BounceTo (Reason,WasAddressedTo,ToEmail : STRING);
BEGIN
     {## shouldn't there be some check here that avoids messages from }
     {## being bounced and instead writes them to the netmail area?   }
     LogMessage (liGeneral,'Bouncing RFC message');

     LogExtraMessage ('Was addressed to: '+WasAddressedTo);
     LogExtraMessage ('Reason: '+Reason);
     LogExtraMessage ('Back to: '+ToEmail);

     IF (ToEmail = WasAddressedTo) THEN
     BEGIN
          LogMessage (liFatal,'Sender is recipient; avoiding bounce loop');
          Exit;
     END;

     { Bounced message addressed to @1@ }
     RFC_PushAndBuildReply ({Subject:}GetLang1 (123,WasAddressedTo),
                            {FromName}'',
                            {FromEmail}'postmaster');

     { avoid looping on bounce filters }
     Msg.IsBounceMsg:=TRUE;

     { ... bounced a message back to ... }
     MsgsAddLineTo (Body,GetLang2 (124,UseGetSystemFromName,ToEmail));
     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,GetLang1 (100,Reason));
     MsgsAddLineTo (Body,'');

     Bounce_InsertOriginalMessage;

     DeliverNow;

     MsgsPopState;
END;


{--------------------------------------------------------------------------}
{ RFC_Bounce                                                               }
{                                                                          }
{ This routine takes works out the reply addresses and bounces the         }
{ message to that address by using RFC_BounceTo.                           }
{                                                                          }
PROCEDURE RFC_Bounce (Reason,WasAddressedTo : STRING);
BEGIN
     RFC_BounceTo (Reason,WasAddressedTo,UsenetReplyAdres);
END;


{--------------------------------------------------------------------------}
{ RFC_NodelistBounce                                                       }
{                                                                          }
{ This routine bounces an RFC message back to the sender because the       }
{ gateway didn't find the address of the node it was destined for in one   }
{ of the nodelists. The reason is put at the top, including the consulted  }
{ nodelists and (part of) the original body is included.                   }
{                                                                          }
PROCEDURE RFC_NodelistBounce (DestPtr : DestRecordPtr);

VAR Hulp : STRING;

    PROCEDURE Add60 (More : STRING);

    VAR P : BYTE;

    BEGIN
         IF (Hulp <> '') THEN
            Hulp:=Hulp+' '+More
         ELSE
             Hulp:=More;

         WHILE (Length (Hulp) > 70) DO
         BEGIN
              P:=70;
              WHILE (P > 0) AND (Hulp[P] <> ' ') DO
                    Dec (P);

              IF (P = 0) THEN
                 P:=70;

              MsgsAddLineTo (Body,Copy (Hulp,1,P-1));
              Delete (Hulp,1,P);
         END;
    END;

VAR ReplyAddr : STRING;

BEGIN
{$IFDEF WtrTest}
     LogMessage (liTrivial,'Target: Mail bounce with consulted nodelist(s) reference');
{$ELSE}

     ReplyAddr:=UsenetReplyAdres;

     LogMessage (liGeneral,'Bouncing RFC message (nodelist)');

     LogExtraMessage ('Was addressed to: '+DestPtr^.To_U);
     LogExtraMessage ('Reason: Node not in nodelist');
     LogExtraMessage ('Back to: '+ReplyAddr);

     IF (ReplyAddr = DestPtr^.To_U) THEN
     BEGIN
          LogMessage (liFatal,'Sender is recipient; avoiding bounce loop');
          Exit;
     END;

     { Bounced message addressed to @1@ }
     RFC_PushAndBuildReply ({Subject}GetLang1 (123,DestPtr^.To_U),
                            {FromName}'',
                            {FromEmail}'postmaster');

     { avoid looping on bounce filters }
     Msg.IsBounceMsg:=TRUE;

     { ... bounced a message back to ... }
     MsgsAddLineTo (Body,GetLang2 (124,UseGetSystemFromName,ReplyAddr));
     MsgsAddLineTo (Body,'');

     Hulp:='';
     Add60 ('Your message to '+DestPtr^.To_U);
     Add60 ('could not be delivered because the matching FTN address');
     Add60 (Fido23DStr (DestPtr^.ToAddr_F)+' was not found in the nodelists.');
     IF (Hulp <> '') THEN
        MsgsAddLineTo (Body,Hulp);

     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,'Please contact postmaster@'+Config.Domains[1]+' for more information.');
     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,'The following nodelists were consulted:');
     NodeList_ListNodelistFilenames;
     MsgsAddLineTo (Body,'');

     Bounce_InsertOriginalMessage;

     DeliverNow;

     MsgsPopState;
{$ENDIF (!WtrTest)}
END;


{--------------------------------------------------------------------------}
{ RFC_Domain2FTN                                                           }
{                                                                          }
{ This routine converts a string like p5.f12.n125.z2 to an FTN address.    }
{ TRUE is returned if the syntax of the string was correct, otherwise      }
{ FALSE is returned.                                                       }
{                                                                          }
FUNCTION RFC_Domain2FTN (Domain : STRING; VAR Addr_F : FidoAddrType) : BOOLEAN;

VAR V   : STRING[20];
    C   : CHAR;
    N   : WORD;
    P   : BYTE;
    Nop : ValNop;

BEGIN
     RFC_Domain2FTN:=FALSE; { assume error }

     LogMessage (liDebug,'RFC_Domain2FTN: Domain="'+Domain+'"');

     WHILE (Domain <> '') DO
     BEGIN
          P:=Pos ('.',Domain);

          IF (P = 0) THEN
             P:=Length (Domain)+1;

          C:=UpCase (Domain[1]);
          V:=Copy (Domain,2,P-2);
          Delete (Domain,1,P);

          LogMessage (liDebug,'RFC_Domain2FTN: C='+C+'; V="'+V+'"; Domain="'+Domain+'"');

          Val (V,N,Nop);

          IF (Nop <> 0) THEN
          BEGIN
               LogMessage (liDebug,'RFC_Domain2FTN: Nop<>0; Bailing out');
               Exit; { invalid string }
          END;

          CASE C OF
               'Z': Addr_F.Zone:=N;
               'N': Addr_F.Net:=N;
               'F': Addr_F.Node:=N;
               'P': Addr_F.Point:=N;

               ELSE BEGIN
                    LogMessage (liDebug,'RFC_Domain2FTN: Unknown C; bailing out');
                    Exit;
               END;
          END; { case }

     END; { while }

     { address 0:0/0.0 is not allowed }
     WITH Addr_F DO
          IF (Zone = 0) AND (Net = 0) AND (Node = 0) AND (Point = 0) THEN
             Exit;

     RFC_Domain2FTN:=TRUE; { correct }
END;


{--------------------------------------------------------------------------}
{ RFC_BuildFromHeader                                                      }
{                                                                          }
{ This routine returns "From: <email> (<comment>)", but leaves out the     }
{ (<comment>) part if it equals the e-mail address.                        }
{                                                                          }
FUNCTION RFC_BuildFromHeader (Email,FullName : STRING) : STRING;
BEGIN
     IF (FullName <> '') AND (FullName <> Email) THEN
        RFC_BuildFromHeader:='From: '+Email+' ('+CharSets_MimeEncodeHeader ('',FullName)+')'
     ELSE
         RFC_BuildFromHeader:='From: '+Email;
END;


{--------------------------------------------------------------------------}
{ unit initialization                                                      }
{                                                                          }
BEGIN
     UsenetUniqueNameInit;
END.
