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

{$i platform.inc}

{## need to set FromUser_U, To_U, ReplyTo_U etc. when adding new header lines }
{## need to reset FromUser_U, Newsgroups_U, etc. when dropping Header_U?? }
{## need to reply From and To between accepting netmail post and distributing to FTN }

{--------------------------------------------------------------------------}
{ ListServer                                                               }
{                                                                          }
{ Nieuwe toevoeging aan de configuratie, een MailList server. Op deze      }
{ manier kunnen mensen op prive newsgroup worden aangesloten zonder dat    }
{ deze meteen landelijk verspreid hoeft te worden.                         }
{ Transport voor fido gaat via netmail, voor UUCP via Mail.                }
{                                                                          }
{ MD 05/01/94 Nog enig verder geknutsel, het programma kan nu ook remote   }
{             user requests afhandelen (aka, een soort Areafix dus)        }
{    07/01/94 Toevoegen van een PackDatabase routine voor WtrUtil          }
{    19/01/94 Toevoegen van support voor List->Area conversie              }
{    12/04/94 Fix linebuffer bug (<> NIL gaf pointer probleem)             }
{                                                                          }
{ RWI 231094 Lijst met aangesloten users: UUCP users kregen hun naam       }
{            afgekapt. Editten van zo'n naam ging niet met FieldEditDirect }
{            en de <enter to edit> entry staat nu helemaal bovenaan.       }
{                                                                          }
{ RWI 950624: grote schoonmaak, nieuwe entrypoints, nieuwe manier van      }
{             distribueren. Nu zou het van alle kanten af en naar alle     }
{             kanten toe (mail,news,netmail,echomail) goed moeten gaan.    }
{             Er wordt nu ook rekening mee gehouden dat als iets in Fido   }
{             formaat aangeleverd wordt, dat het er dan eerst via alle     }
{             Fido kanalen uit moet en daarna pas vertaald moet worden,    }
{             waarbij de body eventueel minder mooi wordt.                 }
{                                                                          }
{ RAWI 980327: Moved Mailing List Definition editor to listedit.pas.       }
{                                                                          }

INTERFACE

USES Database,
     FlexCfg,
     Msgs;

{ addresses on which the list server can be reached }
CONST ListServer1 = 'LISTSERV';
      ListServer2 = 'LISTSERVER';

PROCEDURE ListServerTabelInit;
PROCEDURE JunkListServerTable;

FUNCTION  ListServerSearchName (Name : STRING) : LONGINT;
FUNCTION  ListServerSearchNameCorrect (VAR Name : STRING) : LONGINT;

PROCEDURE ListServer_FTN_ProcessMessage;
PROCEDURE ListServer_RFC_ProcessMessage (DestPtr : DestRecordPtr);

PROCEDURE MailingList_RFC_AcceptPost (WasAddressedTo : STRING; ListPos : LONGINT; DestPtr : DestRecordPtr);
PROCEDURE MailingList_FTN_AcceptPost (WasAddressedTo : STRING; ListPos : LONGINT);
PROCEDURE MailingList_AcceptArea (AreaRecNr : AreaBaseRecordNrType);

{ called at the end of a run }
PROCEDURE ListReconfirmCheck;

PROCEDURE ListTrans_ReplaceRfcHeader;


IMPLEMENTATION

USES Ramon,
     Logs,
     DList,
     Usenet,
     Fido,
     Cfg,
     UnixTime,
     TextFile,
     Language,
     UUCPRout,
     {$IFDEF WTRCONF}
     ListEdit,
     {$ENDIF}
     Address,
     Deliver,
     SeenBy,
     Trans,
     FlexTdb,
     Gateway,
     Import,
     NewStats;

CONST MAX_LISTSERVER_CONSECUTIVE_ERRORS = 5;

TYPE LSType = RECORD
                    Pos           : LONGINT;
                    ListID        : WORD;
                    ServerNameCRC : LONGINT;
                    AreaRecNr     : AreaBaseRecordNrType;
              END;

     LSTypePtr = ^LSType;

VAR LSNameTable    : List;
    {AdminListRecNr : ListServerRecordNrType;}
    WidestListName : BYTE; { excluding lists with Private flag set! }

    ListUserAccess : ListAccessType; {## indirectly set and used! Make return value! }

{--------------------------------------------------------------------------}
{ ListServerTabelInit                                                      }
{                                                                          }
{ Maak een tabel met de CRC-32 van alle bekende listserver namen in het    }
{ geheugen.                                                                }
{                                                                          }
PROCEDURE ListServerTabelInit;

VAR ListRec : MailingListRecord;
    Pos     : LONGINT;
    Tmp     : LSTypePtr;
    L       : BYTE;

BEGIN
     LSNameTable.Clear;

     WidestListName:=0;

     IF Flex_MailingList_ReadFirst (ListRec,Pos) THEN
        REPEAT
              ListRec.Name:=AddUpWithSpaces (MaxLenMailingListName,UpCaseString (ListRec.Name));

              Tmp:=LSNameTable.Create;

              Tmp^.Pos:=Pos;
              Tmp^.ListID:=ListRec.ListID;
              Tmp^.ServerNameCRC:=UpDateCRC32 ($FFFFFFFF,ListRec.Name[1],MaxLenMailingListName);
              Tmp^.AreaRecNr:=GetAreaBaseRecordNrByAreaName (ListRec.AreaName);

              { work out the widest list name }
              IF (NOT ListRec.PrivateList) THEN
              BEGIN
                   L:=Length (ListRec.Name);
                   IF (L > WidestListName) THEN
                      WidestListName:=L;
              END;

        UNTIL (NOT Flex_MailingList_ReadNext (ListRec,Pos));
END;


{--------------------------------------------------------------------------}
{ JunkListServerTable                                                      }
{                                                                          }
{ Cleans up memory usage afterwards.                                       }
{                                                                          }
PROCEDURE JunkListServerTable;
BEGIN
     LSNameTable.Clear;
END;


{--------------------------------------------------------------------------}
{ FindMailingListByListID                                                  }
{                                                                          }
{ This routine runs through the index to find the mailing list ID asked    }
{ for. If found, the record position is returned. If not found, NILPos is  }
{ returned.                                                                }
{                                                                          }
FUNCTION FindMailingListByListID (ListID : WORD) : LONGINT;

VAR Tmp : LSTypePtr;

BEGIN
     Tmp:=LSNameTable.GetFirstItem;

     WHILE (Tmp <> NIL) DO
     BEGIN
          IF (Tmp^.ListID = ListID) THEN
          BEGIN
               FindMailingListByListID:=Tmp^.Pos;
               Exit;
          END;

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

     FindMailingListByListID:=NILPos; { not found }
END;


{--------------------------------------------------------------------------}
{ ListServerSearchNameCorrect                                              }
{                                                                          }
{ This routine searches the mailing list index we keep in memory for the   }
{ given name by means of CRC on the upper cased form of the name. If       }
{ found, the position of the flex record is returned. Otherwise NILPos     }
{ will be returned.                                                        }
{                                                                          }
FUNCTION ListServerSearchNameCorrect (VAR Name : STRING) : LONGINT;

VAR Hulp    : STRING[MaxLenMailingListName];
    TmpCRC  : LONGINT;
    Tmp     : LSTypePtr;
    ListRec : MailingListRecord;

BEGIN
     Hulp:=AddUpWithSpaces (MaxLenMailingListName,UpCaseString (Name));
     TmpCrc:=UpDateCRC32 ($FFFFFFFF,Hulp[1],MaxLenMailingListName);

     Tmp:=LSNameTable.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          IF (Tmp^.ServerNameCRC = TmpCRC) THEN
          BEGIN
               Flex_MailingList_Read (Tmp^.Pos,ListRec);

               IF (NOT ListRec.Passive) THEN
               BEGIN
                    { correct the name, as promised }
                    Name:=ListRec.Name;

                    { return the record number }
                    ListServerSearchNameCorrect:=Tmp^.Pos;
                    Exit;
               END;

          END; { if, for }

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

     ListServerSearchNameCorrect:=NILPos; { not found }
END;


{--------------------------------------------------------------------------}
{ ListServerSearchName                                                     }
{                                                                          }
{ Searches the table in search of the mailing list name. If found, the     }
{ record number of the mailing list record will be returned. Otherwise,    }
{ NILPos will be returned.                                                 }
{                                                                          }
FUNCTION ListServerSearchName (Name : STRING) : LONGINT;
BEGIN
     ListServerSearchName:=ListServerSearchNameCorrect (Name);
END;


{--------------------------------------------------------------------------}
{ ListServer_DestIsSubscribed                                              }
{                                                                          }
{ Check whether the pointed to destination record is subscribed to the     }
{ mailing list with the given ListID. Returns TRUE if subscribed.          }
{                                                                          }
FUNCTION ListServer_DestIsSubscribed (DestPtr : DestRecordPtr; ListID : WORD) : ListUserRecordNrType;

VAR DestUser,
    DestDomain,
    RecUser,
    RecDomain   : STRING;
    ListUserRec : ListUserRecord;
    Lp          : ListUserRecordNrType;

BEGIN
     UsenetSplit (DestPtr^.To_U,DestUser,DestDomain);

     { search all mailing list subscriber records for the user and ListID }

     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUserRec);

          IF (ListUserRec.ListID = ListID) THEN
          BEGIN
               ListUserAccess:=ListUserRec.Access; {## remove}

               CASE ListUserRec.UserType OF
                    lutFTN:
                        IF (DestPtr^.Status = destFTN) AND
                           CaselessMatch (DestPtr^.ToUser_F,ListUserRec.User) AND
                           FidoCompare (DestPtr^.ToAddr_F,ListUserRec.Aka) THEN
                        BEGIN
                             ListServer_DestIsSubscribed:=Lp;
                             Exit; { found }             { ## EXIT ## }
                        END;

                    lutRFC:
                        IF (DestPtr^.Status IN [destRFC,destRFCRaw]) THEN
                        BEGIN
                             UsenetSplit (ListUserRec.Email,RecUser,RecDomain);

                             IF CaselessMatch (DestUser,RecUser) AND
                                CaselessMatch (DestDomain,RecDomain) THEN
                             BEGIN
                                  ListServer_DestIsSubscribed:=Lp;
                                  Exit; { found }        { ## EXIT ## }
                             END;
                        END;

                    lutRemoteGW:
                        IF (DestPtr^.Status = destRemoteGW) AND
                           CaselessMatch (DestPtr^.ToUser_F,ListUserRec.User) AND
                           FidoCompare (DestPtr^.ToAddr_F,ListUserRec.Aka) THEN
                        BEGIN
                             UsenetSplit (ListUserRec.Email,RecUser,RecDomain);

                             IF CaselessMatch (DestUser,RecUser) AND
                                CaselessMatch (DestDomain,RecDomain) THEN
                             BEGIN
                                  ListServer_DestIsSubscribed:=Lp;
                                  Exit; { found }        { ## EXIT ## }
                             END;
                        END;

                    lutDeleted:
                        { nothing! }
               END; { case }

          END; { if correct ListID }

     END; { for }

     ListServer_DestIsSubscribed:=NILRecordNr; { assume we don't find it }
END;


{--------------------------------------------------------------------------}
{ ListServer_IsKnownFTNSubscriber                                          }
{                                                                          }
{ Checks whether a poster is subscribed the mailing list. If subscribed,   }
{ its "last confirmed" date is updated to todays date to avoid sending     }
{ out confirm messages to active posters.                                  }
{                                                                          }
FUNCTION ListServer_IsKnownFTNSubscriber (ListID : WORD; Aka : FidoAddrType; User : STRING) : BOOLEAN;

VAR ListUserRec : ListUserRecord;
    Lp          : ListUserRecordNrType;

BEGIN
     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUserRec);

          IF (ListUserRec.ListID = ListID) AND (ListUserRec.UserType = lutFTN) THEN
          BEGIN
               IF CaselessMatch (User,ListUserRec.User) AND
                  FidoCompare (Aka,ListUserRec.Aka) THEN
               BEGIN
                    ListUserAccess:=ListUserRec.Access; {## remove!}

                    { reset this users re-confirmation counter  }
                    { even though the user might not be allowed }
                    { to post to the list.                      }

                    IF Config.LogDebug THEN
                       LogMessage (liTrivial,'Updated confirmation date');

                    ListUserRec.ConfirmedDate:=GetCurrentUnixTime;
                    ListUserRec.ConfirmState:=lcOk;

                    { write the updated record back to disk }
                    ListUser_Write (Lp,ListUserRec);

                    ListServer_IsKnownFTNSubscriber:=TRUE;
                    Exit;

               END; { if found }

          END; { if lutFTN }

     END; { for }

     ListServer_IsKnownFTNSubscriber:=FALSE;
END;


{--------------------------------------------------------------------------}
{ ListServer_IsKnownRemoteGWUser                                            }
{                                                                          }
{ Kontroleert of een remote gateway gebruiker wel op de huidige mailing    }
{ list is aangesloten.                                                     }
{                                                                          }
FUNCTION ListServer_IsKnownRemoteGWUser (ListID : WORD; Aka : FidoAddrType; User : STRING; EMail: STRING) : BOOLEAN;

VAR ListUserRec : ListUserRecord;
    Lp          : ListUserRecordNrType;

BEGIN
     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUserRec);

          IF (ListUserRec.ListID = ListID) AND (ListUserRec.UserType = lutRemoteGW) THEN
          BEGIN
               IF CaselessMatch (User,ListUserRec.User) AND
                  CaselessMatch (EMail,ListUserRec.Email) AND
                  FidoCompare (Aka,ListUserRec.Aka) THEN
               BEGIN
                    ListUserAccess:=ListUserRec.Access; {## remove!}

                    { reset this users re-confirmation counter  }
                    { even though the user might not be allowed }
                    { to post to the list.                      }

                    IF Config.LogDebug THEN
                       LogMessage (liTrivial,'Updated confirmation date');

                    ListUserRec.ConfirmedDate:=GetCurrentUnixTime;
                    ListUserRec.ConfirmState:=lcOk;

                    { write the updated record back to disk }
                    ListUser_Write (Lp,ListUserRec);

                    ListServer_IsKnownRemoteGWUser:=TRUE;
                    Exit;
               END; { found }

          END; { if lutRemoteGW }

     END; { for }

     ListServer_IsKnownRemoteGWUser:=FALSE;
END;


{--------------------------------------------------------------------------}
{ ListServer_IsKnownRFCSubscriber                                          }
{                                                                          }
{ Controleert of een usenet user wel op de huidige mailing list is         }
{ aangesloten.                                                             }
{                                                                          }
FUNCTION ListServer_IsKnownRFCSubscriber (ListID : WORD; Email : STRING) : BOOLEAN;

VAR ListUserRec : ListUserRecord;
    Lp          : ListUserRecordNrType;
    InUser,
    InDomain    : STRING;
    LstUser,
    LstDomain   : STRING;

BEGIN
     UsenetSplit (Email,InDomain,InUser);

     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUserRec);

          IF (ListUserRec.ListID = ListID) AND (ListUserRec.UserType = lutRFC) THEN
          BEGIN
               UsenetSplit (ListUserRec.Email,LstDomain,LstUser);

               IF CaselessMatch (InUser,LstUser) AND
                  CaselessMatch (InDomain,LstDomain) THEN
               BEGIN
                    ListUserAccess:=ListUserRec.Access; {## remove!}

                    { reset this users re-confirmation counter  }
                    { even though the user might not be allowed }
                    { to post to the list.                      }

                    IF Config.LogDebug THEN
                       LogMessage (liTrivial,'Updated confirmation date');

                    ListUserRec.ConfirmedDate:=GetCurrentUnixTime;
                    ListUserRec.ConfirmState:=lcOk;

                    { write the updated record back to disk }
                    ListUser_Write (Lp,ListUserRec);

                    ListServer_IsKnownRFCSubscriber:=TRUE;
                    Exit;
               END; { found }

          END; { is lutRFC }

     END; { for }

     ListServer_IsKnownRFCSubscriber:=FALSE;
END;


{--------------------------------------------------------------------------}
{ ListServerSendHelp                                                       }
{                                                                          }
{ Stuur informatie over de list server naar een bepaalde node.             }
{                                                                          }
PROCEDURE ListServerSendHelp;
BEGIN
     IF (NOT AddFileToBody ('LISTHELP.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,'This list server supports the following commands:');
          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,'CONNECT name          Connects you to the mailing list "name"' );
          MsgsAddLineTo (Body,'SUBSCRIBE name        Connects you to the mailing list "name"' );
          MsgsAddLineTo (Body,'DISCONNECT name       Removes you from the mailing list "name"');
          MsgsAddLineTo (Body,'UNSUBSCRIBE name      Removes you from the mailing list "name"');
          MsgsAddLineTo (Body,'HELP                  This information');
          MsgsAddLineTo (Body,'LIST                  Sends a listing of all public mailing lists on this system');
          MsgsAddLineTo (Body,'');
     END;
END;


{--------------------------------------------------------------------------}
{ ListServerSendList                                                       }
{                                                                          }
{ Add a list of all possible subscribeable mailing lists to the body of    }
{ the current message.                                                     }
{                                                                          }
PROCEDURE ListServerSendList;

VAR ListRec : MailingListRecord;
    Pos     : LONGINT;

BEGIN
     IF (NOT AddFileToBody ('LISTHDR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'An overview of all available lists at this site follows below:');
          MsgsAddLineTo (Body,'');
     END;

     IF Flex_MailingList_ReadFirst (ListRec,Pos) THEN
     BEGIN
          REPEAT
                IF (NOT ListRec.PrivateList) THEN
                   IF (ListRec.Description <> '') THEN
                      MsgsAddLineTo (Body,AddUpWithSpaces (WidestListName,ListRec.Name)+' - '+ListRec.Description)
                   ELSE
                       MsgsAddLineTo (Body,ListRec.Name);

          UNTIL (NOT Flex_MailingList_ReadNext (ListRec,Pos));
     END ELSE
         { no mailing list definitions present }
         {## add language item}
         MsgsAddLineTo (Body,'There are no mailing lists available at all!');

     IF (NOT AddFileToBody ('LISTFTR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,'End of listing.');
          MsgsAddLineTo (Body,'');
     END;
END;


(*
{--------------------------------------------------------------------------}
{ ListServer_RemoteAdmin                                                   }
{                                                                          }
{ This routine searches all the mailing lists and compares the password.   }
{ If a match is found, remote administration of this mailing list becomes  }
{ possible.                                                                }
{                                                                          }
PROCEDURE ListServer_RemoteAdmin (Password : STRING);

VAR Tmp     : LSTypePtr;
    ListRec : ListServerRecord;

BEGIN
     Tmp:=LSNameTable.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          ReadListBaseRecord (Tmp^.RecNr,ListRec);

          IF (ListRec.AdminPassword <> '') AND
             CaselessMatch (ListRec.AdminPassword,Password) THEN
          BEGIN
               LogMessage (liGeneral,'ListServer: Remote admin accepted for "'+ListRec.ListName+'"');
               MsgsAddLineTo (Body,'Remote administration of mailing list "'+ListRec.ListName+'" accepted.');
               AdminListRecNr:=Tmp^.RecNr;
               Exit;
          END;

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

     LogMessage (liFatal,'ListServer: Remote admin attempt failed, password "'+Password+'"');
     MsgsAddLineTo (Body,'Access denied');

     IF (AdminListRecNr <> NILRecordNr) THEN
     BEGIN
          AdminListRecNr:=NILRecordNr;
          LogMessage (liGeneral,'Stopped remote administration access');
          MsgsAddLineTo (Body,'Stopped remote administration access');
     END;
END;
*)

{--------------------------------------------------------------------------}
{ ProcessConfirm                                                           }
{                                                                          }
{ Processes a detected confirm code. The record is looked up and the       }
{ confirm fields are updated. The function returns an empty string if the  }
{ user could not be found or the code was not a valid 8 character hex      }
{ number, otherwise a language 1042 processes string with the name of the  }
{ mailing list for which the subscription was updated.                     }
{                                                                          }
FUNCTION ProcessConfirm (CodeStr : STRING) : STRING;

VAR ListUserRec : ListUserRecord;
    Lp          : ListUserRecordNrType;
    ListRec     : MailingListRecord;
    Pos         : LONGINT;
    Code        : LONGINT;

BEGIN
     ProcessConfirm:=''; { assume syntax error }

     { check for valid hex string }
     IF (Length (CodeStr) <> 8) THEN
        Exit;

     FOR Lp:=1 TO 8 DO
         IF NOT (CodeStr[Lp] IN ['0'..'9','A'..'F','a'..'f']) THEN
            Exit;

     { convert to number }
     Code:=HexString2Long (CodeStr);

     LogMessage (liTrivial,'Received confirm code '+Long2HexString (Code));

     { first find the subscriber, then take the ListID and find the }
     { name of the mailing list, which is then run through language }
     { entry 1042 and returned.                                     }

     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUserRec);

          IF (ListUserRec.UserType <> lutDeleted) AND
             (ListUserRec.ConfirmCode = Code) THEN
          BEGIN
               { todo: add sender address verification (?) }
               LogMessage (liTrivial,'  Confirmation accepted');

               { set confirm date, confirm state=Ok }
               ListUserRec.ConfirmedDate:=GetCurrentUnixTime;
               ListUserRec.ConfirmState:=lcOk;

               { write the updated record back to disk }
               ListUser_Write (Lp,ListUserRec);

               { find the mailing list name according to the ID }
               Pos:=FindMailingListByListID (ListUserRec.ListID);

               IF (Pos <> NILPos) THEN
               BEGIN
                    Flex_MailingList_Read (Pos,ListRec);

                    { Subscription confirmation for mailing list @1@ was successful. }
                    ProcessConfirm:=GetLang1 (1042,ListRec.Name);
                    Exit;
               END;

               LogMessage (liFatal,' Could not find list with ListID '+Word2String (ListUserRec.ListID));
               Exit; { with empty string }
          END;
     END; { for }

     LogMessage (liFatal,'  Confirmation code not found!');
END;


{ global for ListServer_XXX_ProcessXXX }
VAR RequestList,
    RequestHelp : BOOLEAN;
    SendConfirm : STRING;
    WroteUseful : BOOLEAN;

{--------------------------------------------------------------------------}
{ SendResponse                                                             }
{                                                                          }
{ This is a generic routine to write a single response line to the body of }
{ the list server reply message and set WroteUseful at the same time. If   }
{ WroteUseful is not set once, then the entire reply will not be set.      }
{                                                                          }
PROCEDURE SendResponse (Response : STRING);
BEGIN
     LogExtraMessage ('  '+Response);
     MsgsAddLineTo (Body,Response);
     WroteUseful:=TRUE;
END;


VAR ListServer_Process_ErrorCount : BYTE;

{--------------------------------------------------------------------------}
{ ListServer_Generic_ProcessLine                                           }
{                                                                          }
{ This routine is called by both the FTN and RFC message processor to      }
{ check for keywords that can be handled in a generic way for both message }
{ formats.                                                                 }
{ Returns TRUE when the keyword was understood and processed, otherwise    }
{ FALSE.                                                                   }
{                                                                          }
PROCEDURE ListServer_Generic_ProcessLine (Keyword,Regel : STRING);

VAR Response    : STRING;
    P           : BYTE;
    ListRec     : MailingListRecord;
    ListPos     : LONGINT;
    ListUserRec : ListUserRecord;
    RecNr       : ListUserRecordNrType;

BEGIN
     { --- UNSUBSCRIBE }

     IF (Keyword = 'DISCONNECT') OR (Keyword = 'UNSUBSCRIBE') THEN
     BEGIN
          ListServer_Process_ErrorCount:=0;

          { RWI 950531: Kijk of er wel wat achter volgt }
          P:=Pos (' ',Regel);
          IF (P = 0) THEN
          BEGIN
               { Missing name after ...; Help and a list will follow. }
               SendResponse (GetLang1 (1000,Regel));
               RequestHelp:=TRUE;
               RequestList:=TRUE;
               Exit; { ## EXIT ## }
          END;

          Delete (Regel,1,P);
          Regel:=DeleteFrontAndBackSpaces (Regel);

          { controleer of de list wel bestaat }
          ListPos:=ListServerSearchNameCorrect (Regel);

          IF (ListPos = NILPos) THEN
          BEGIN
               { Cannot disconnect you from unknown list ... }
               SendResponse (GetLang1 (1010,Regel));
               RequestHelp:=TRUE;
               Exit; { ## EXIT ## }
          END;

          Flex_MailingList_Read (ListPos,ListRec);

          { controleer of de user op de groep is aangesloten }
          RecNr:=ListServer_DestIsSubscribed (Msg.FirstDest,ListRec.ListID);

          IF (RecNr = NILRecordNr) THEN
          BEGIN
               { You are not connected to ...; no need to disconnect }
               SendResponse (GetLang1 (1011,Regel));
               RequestHelp:=TRUE;
               Exit; { ## EXIT ## }
          END;

          { dan zijn er geen excuses meer om 'm niet af te sluiten }
          ListUser_Read (RecNr,ListUserRec);
          ListUserRec.UserType:=lutDeleted;
          ListUser_Write (RecNr,ListUserRec);

          { Disconnected from mailing list "..." }
          SendResponse (GetLang1 (1012,ListRec.Name));

          Exit; { ## EXIT ## }
     END;


     { --- LIST of available mailing lists }

     IF (Keyword = 'LIST') THEN
     BEGIN
          ListServer_Process_ErrorCount:=0;

          { Listing of available mailing lists will follow in another message. }
          SendResponse (GetLang0 (1041));
          RequestList:=TRUE;
          Exit; { ## EXIT ## }
     END;

     { --- HELP }

     IF (Keyword = 'HELP') THEN
     BEGIN
          ListServer_Process_ErrorCount:=0;

          { Help will follow in another message. }
          SendResponse (GetLang0 (1040));
          RequestHelp:=TRUE;
          Exit; { ## EXIT ## }
     END;

     { --- REMOTE-ADMIN }

     (*
     IF (Keyword = 'REMOTE-ADMIN') AND (Length (Regel) > 13) THEN
     BEGIN
          ListServer_RemoteAdmin (Copy (Regel,14,8));
          Exit; { ## EXIT ## }
     END;

     { --- ADMIN COMMANDS }

     IF (AdminListRecNr <> NILRecordNr) THEN
     BEGIN
          { --- SUBSCRIBERS }

          IF (Keyword = 'SUBSCRIBERS') THEN
          BEGIN
               Exit; { ## EXIT ## }
          END;

          { --- ADD }

          IF (Keyword = 'ADD') THEN
          BEGIN
               Exit; { ## EXIT ## }
          END;

          { --- DELETE }

          IF (Keyword = 'DELETE') THEN
          BEGIN
               Exit; { ## EXIT ## }
          END;

     END; { if admin mode enabled }
     *)

     { Unknown command found! (...)' }
     { note: do not use SendResponse() here because it sets WroteUseful }
     Response:=GetLang1 (1030,Regel); { note: not UpRegel }
     LogExtraMessage ('  '+Response);
     MsgsAddLineTo (Body,Response);

     Inc (ListServer_Process_ErrorCount);

     RequestHelp:=TRUE;
END;


{--------------------------------------------------------------------------}
{ ListServer_RFC_ProcessLine                                               }
{                                                                          }
{ This routine is called for each line in the message sent to the list     }
{ server. This routine processes the request, acts on it and writes reply  }
{ lines where required. Do NOT modify OrigRegel!!                          }
{                                                                          }
FUNCTION ListServer_RFC_ProcessLine (VAR OrigRegel : STRING) : BOOLEAN; FAR;

VAR Regel,
    UpRegel,
    Response    : STRING;
    P           : BYTE;
    Keyword     : STRING[30];
    ListPos     : LONGINT;
    ListRec     : MailingListRecord;
    ListUserRec : ListUserRecord;

BEGIN
     IF (ListServer_Process_ErrorCount > MAX_LISTSERVER_CONSECUTIVE_ERRORS) THEN
     BEGIN
          ListServer_RFC_ProcessLine:=TRUE; { abort }
          Exit;
     END;

     ListServer_RFC_ProcessLine:=FALSE; { do not abort }

     { skip MIME multi-part headers }
     IF CaselessStartMatch (OrigRegel,'Content-') THEN
        Exit;

     { skip multi-part boundary headers }
     IF (Msg.MultiPartBoundary <> '') AND
        (Copy (OrigRegel,1,Length (Msg.MultiPartBoundary)+2) = '--'+Msg.MultiPartBoundary)
     THEN
         Exit;

     IF (OrigRegel = '-- '#13) THEN
     BEGIN
          ListServer_RFC_ProcessLine:=TRUE; { abort }
          Exit; { ## EXIT ## }
     END;

     Regel:=OrigRegel;

     WHILE (Regel <> '') AND (Regel[Length (Regel)] = #13) DO
           Delete (Regel,Length (Regel),1);

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

     IF (Regel = '') THEN
        Exit;

     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,'--> '+Regel);
     LogMessage (liTrivial,'--> '+Regel);

     { --- CONFIRM }

     UpRegel:=UpCaseString (Regel);
     P:=Pos ('CONFIRM ',UpRegel);
     IF (P > 0) THEN
     BEGIN
          SendConfirm:=ProcessConfirm (Copy (UpRegel,P+8,8));
          IF (SendConfirm <> '') THEN
          BEGIN
               { disable possibly triggered messages }
               RequestHelp:=FALSE;
               RequestList:=FALSE;

               { ignore rest of message }
               ListServer_RFC_ProcessLine:=TRUE; { stop here }

               Exit; { ## EXIT ## }
          END;
     END;

     P:=Pos (' ',Regel);
     IF (P > 0) AND (P < 30) THEN
        Keyword:=UpCaseString (Copy (Regel,1,P-1))
     ELSE
         IF (P = 0) THEN
            Keyword:=UpCaseString (Regel)
         ELSE
             Keyword:='';

     { --- QUIT }
     { --- EXIT }
     { --- STOP }
     { --- END }

     IF (Keyword = 'QUIT') OR
        (Keyword = 'EXIT') OR
        (Keyword = 'STOP') OR
        (Keyword = 'END') THEN
     BEGIN
          ListServer_RFC_ProcessLine:=TRUE; { stop here }
          Exit; { ## EXIT ## }
     END;

     { --- subscribing an area }

     IF (Keyword = 'CONNECT') OR (Keyword = 'SUBSCRIBE') THEN
     BEGIN
          ListServer_Process_ErrorCount:=0;

          { RWI 950531: Kijk of er wel wat achter volgt }
          P:=Pos (' ',Regel);
          IF (P = 0) THEN
          BEGIN
               { Missing name after @1@. Help and a list will follow. }
               SendResponse (GetLang1 (1000,Regel));
               RequestHelp:=TRUE;
               RequestList:=TRUE;
               Exit; { ## EXIT ## }
          END;

          Delete (Regel,1,P);
          Regel:=DeleteFrontAndBackSpaces (Regel);

          ListPos:=ListServerSearchNameCorrect (Regel);
          IF (ListPos = NILPos) THEN
          BEGIN
               { Cannot connect unknown list name ... }
               SendResponse (GetLang1 (1001,Regel));
               RequestList:=TRUE;
               Exit; { ## EXIT ## }
          END;

          Flex_MailingList_Read (ListPos,ListRec);

          { sluit een node aan als die nog niet aangesloten is }
          IF (ListServer_DestIsSubscribed (Msg.FirstDest,ListRec.ListID) <> NILRecordNr) THEN
          BEGIN
               { already connected to }
               SendResponse (GetLang1 (1002,Regel));
               Exit; { ## EXIT ## }
          END;

          IF (ListRec.PrivateList) THEN
          BEGIN
               { You cannot connect this private mailing lists }
               SendResponse (GetLang1 (1003,Regel));
               Exit; { ## EXIT ## }
          END;

          { controleer of de node wel aangesloten mag worden }
          IF (ListRec.OnlyKnown) THEN
             { we moeten de node dus kennen }
             IF (GetUucpRoute (Msg.FirstDest^.To_U) = NILRecordNr) THEN
             BEGIN
                  { You are not allowed to connect to list ... }
                  SendResponse (GetLang1 (1004,Regel));
                  Exit; { ## EXIT ## }
             END;

          { door onze lijst met excuses heen, sluit 'm dan maar aan }
          FillChar (ListUserRec,SizeOf (ListUserRecord),0);

          WITH ListUserRec DO
          BEGIN
               UserType:=lutRFC;
               ListID:=ListRec.ListID;
               Email:=Msg.FirstDest^.To_U;
               Access:=ListRec.DefaultAccess;
               SubscribedDate:=GetCurrentUnixTime;
               ConfirmedDate:=0;  { trigger at once }
               ConfirmReqDate:=0;
               ConfirmState:=lcReq2;
               ConfirmCode:=0;
          END; { with }

          ListUser_WriteNew (ListUserRec);

          { Connected ... to mailing list "..." }
          SendResponse (GetLang2 (1005,Msg.FirstDest^.To_U,ListRec.Name));

          IF (ListRec.WelcomeFile <> '') THEN
             AddFileToBody (ListRec.WelcomeFile);

          Exit; { ## EXIT ## }
     END;

     { try generic handling }
     ListServer_Generic_ProcessLine (Keyword,Regel);
END;


{--------------------------------------------------------------------------}
{ ListServer_RFC_ProcessMessage                                            }
{                                                                          }
{ Verwerk de commando's die een Usenet gebruiker geeft.                    }
{ Ondersteund worden:                                                      }
{                                                                          }
{   Subscribe/Connect                                                      }
{   UnSubscribe/Disconnect                                                 }
{   List                                                                   }
{   Help                                                                   }
{                                                                          }
PROCEDURE ListServer_RFC_ProcessMessage (DestPtr : DestRecordPtr);

VAR ReturnAdres : UsenetUserNameString;
    Lp          : 1..MAX_BODY_PARTS;

BEGIN
     RequestHelp:=FALSE;
     RequestList:=FALSE;
     WroteUseful:=FALSE;
     SendConfirm:='';
     {AdminListRecNr:=NILRecordNr;}

     ReturnAdres:=UsenetReplyAdres;

     LogMessage (liTrivial,'List Server: Processing RFC message');

     IF (Pos ('MAILER-DAEMON',UpCaseString (ReturnAdres)) > 0) THEN
     BEGIN
          LogMessage (liGeneral,'List server suspects bounced mail (1) from '+ReturnAdres);
          WriteMessageToRFCBad ('List server suspects bounced mail (1) from '+ReturnAdres,DestPtr);

          { on exit, the DestRecord as assumed to be handled and }
          { will be removed from the list.                       }
          Exit;         { ## EXIT ## }
     END;

     ListServer_Process_ErrorCount:=0;

     MsgsPushState;
     RFC_StartSingleRecipientMessage (ReturnAdres,'listserv',GetLang0 (1031),GetLang0 (1032));
     InitTokens (_U);

     { add the response header }
     IF (NOT AddFileToBody ('LSERVHDR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'Your message was processed by listserv@'+Config.Domains[1]+
                              ' on '+UnixTimeToString (GetCurrentUnixTime));
          {no empty line here: the processor will put an empty
           line before each line it processes.
           MsgsAddLineTo (Body,'');}
     END;

     { run each body part through the processor }
     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.PrevMsgPtr^.BodyParts[Lp] <> NIL) THEN
            IF (Msg.PrevMsgPtr^.BodyParts[Lp]^.PartStatus <> psAttachment) THEN
               IF MsgsForEach (Msg.PrevMsgPtr^.BodyParts[Lp],ListServer_RFC_ProcessLine) THEN
                  Break;

     { add the response footer }
     MsgsAddEmptyLineIfNotPresentAlready;
     IF (NOT AddFileToBody ('LSERVFTR.TXT')) THEN
        MsgsAddLineTo (Body,'End of response.');

     IF (ListServer_Process_ErrorCount > MAX_LISTSERVER_CONSECUTIVE_ERRORS) THEN
     BEGIN
          RequestHelp:=FALSE;
          RequestList:=FALSE;
          WroteUseful:=FALSE;
     END;

     { do not send reply if it just contains complaints because of the }
     { CONFIRM message that just was a complete quote.                 }
     IF WroteUseful THEN
     BEGIN
          LogMessage (liTrivial,'List Server: Sending reply');
          DeliverNow;
     END ELSE
     BEGIN
          LogMessage (liTrivial,'List Server: Suppressing useless reply');
          MsgsFreeAllDestRecords ({Silent:}TRUE);
     END;

     MsgsPopState;

     IF RequestHelp THEN
     BEGIN
          LogMessage (liTrivial,'List Server: Sending help information');
          MsgsPushState;
          RFC_StartSingleRecipientMessage (ReturnAdres,'listserv',GetLang0 (1031),GetLang0 (1033));
          ListServerSendHelp;
          DeliverNow;
          MsgsPopState;
     END;

     IF RequestList THEN
     BEGIN
          LogMessage (liTrivial,'List Server: Sending available mailing lists');
          MsgsPushState;
          RFC_StartSingleRecipientMessage (ReturnAdres,'listserv',GetLang0 (1031),GetLang0 (1034));
          ListServerSendList;
          DeliverNow;
          MsgsPopState;
     END;

     IF (SendConfirm <> '') THEN
     BEGIN
          LogMessage (liTrivial,'List Server: Sending subscription confirmation');
          MsgsPushState;
          RFC_StartSingleRecipientMessage (ReturnAdres,'listserv',GetLang0 (1031),GetLang0 (1034));
          MsgsAddLineTo (Body,SendConfirm);
          DeliverNow;
          MsgsPopState;
     END;

     {AdminListRecNr:=NILRecordNr; { prevent loopholes }

     LogMessage (liTrivial,'List Server: finished processing message');
END;


{--------------------------------------------------------------------------}
{ ListServer_FTN_ProcessLine                                               }
{                                                                          }
{ This routine is called for each line in the message sent to the list     }
{ server. This routine rocesses the request, acts on it and writes reply   }
{ lines where required. Do NOT modify OrigRegel!!                          }
{ If you want to refer to fields from the original message, use the        }
{ Msg.PrevMsgPtr^ since we are already building a reply. User              }
{ Msg.FirstDest^ to get the address information of where we will send the  }
{ reply, thus the person who sent the message.                             }
{                                                                          }
FUNCTION ListServer_FTN_ProcessLine (VAR OrigRegel : STRING) : BOOLEAN; FAR;

VAR Regel,
    UpRegel,
    Response    : STRING;
    P           : BYTE;
    Keyword     : STRING[30];
    ListRecNr   : LONGINT;
    ListRec     : MailingListRecord;
    ListUserRec : ListUserRecord;

BEGIN
     IF (ListServer_Process_ErrorCount > MAX_LISTSERVER_CONSECUTIVE_ERRORS) THEN
     BEGIN
          ListServer_FTN_ProcessLine:=TRUE; { abort }
          Exit;
     END;

     ListServer_FTN_ProcessLine:=FALSE; { do not abort }

     { kijk of er een fido tear-line staat }
     IF (Copy (OrigRegel,1,3) = '---') THEN
     BEGIN
          ListServer_FTN_ProcessLine:=TRUE; { stop here }
          Exit;                          { ## EXIT ## }
     END;

     Regel:=OrigRegel;
     WHILE (Regel <> '') AND (Regel[Length (Regel)] = #13) DO
           Delete (Regel,Length (Regel),1);

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

     IF (Regel = '') THEN
        Exit;                   { ## EXIT ## }

     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,'--> '+Regel);
     LogMessage (liTrivial,'--> '+Regel);

     { --- CONFIRM }

     UpRegel:=UpCaseString (Regel);
     P:=Pos ('CONFIRM ',UpRegel);
     IF (P > 0) THEN
     BEGIN
          SendConfirm:=ProcessConfirm (Copy (UpRegel,P+8,8));
          IF (SendConfirm <> '') THEN
          BEGIN
               { disable possibly triggered messages }
               RequestHelp:=FALSE;
               RequestList:=FALSE;

               { ignore rest of message }
               ListServer_FTN_ProcessLine:=TRUE; { stop here }

               Exit;                     { ## EXIT ## }
          END;
     END;

     P:=Pos (' ',Regel);
     IF (P > 0) AND (P < 30) THEN
        Keyword:=UpCaseString (Copy (Regel,1,P-1))
     ELSE
         IF (P = 0) THEN
            Keyword:=UpCaseString (Regel)
         ELSE
             Keyword:='';

     { --- QUIT }
     { --- EXIT }
     { --- STOP }
     { --- END }

     IF (Keyword = 'QUIT') OR
        (Keyword = 'EXIT') OR
        (Keyword = 'STOP') OR
        (Keyword = 'END') THEN
     BEGIN
          ListServer_FTN_ProcessLine:=TRUE; { stop here }
          Exit; { ## EXIT ## }
     END;

     { --- SUBSCRIBE }

     IF (Keyword = 'CONNECT') OR (Keyword = 'SUBSCRIBE') THEN
     BEGIN
          ListServer_Process_ErrorCount:=0;

          P:=Pos (' ',Regel);
          IF (P = 0) THEN
          BEGIN
               { Missing name after ... Help and a list will follow. }
               SendResponse (GetLang1 (1000,Regel));
               RequestHelp:=TRUE;
               RequestList:=TRUE;
               Exit;                            { ## EXIT ## }
          END;

          { delete command }
          Delete (Regel,1,P);
          Regel:=DeleteFrontAndBackSpaces (Regel);

          ListRecNr:=ListServerSearchNameCorrect (Regel);

          IF (ListRecNr = NILPos) THEN
          BEGIN
               { Cannot connect unknown list name ... }
               SendResponse (GetLang1 (1001,Regel));
               RequestList:=TRUE;
               Exit;                            { ## EXIT ## }
          END;

          Flex_MailingList_Read (ListRecNr,ListRec);

          IF (ListServer_DestIsSubscribed (Msg.FirstDest{take reply address},
                                           ListRec.ListID) <> NILRecordNr) THEN
          BEGIN
               { You are already connected to ... }
               SendResponse (GetLang1 (1002,Regel));
               Exit;
          END;

          IF ListRec.PrivateList THEN
          BEGIN
               { You cannot connect this private mailing list }
               SendResponse (GetLang1 (1003,UpRegel));
               Exit;                        { ## EXIT ## }
          END;

          {## controleer of de node wel aangesloten mag worden }
          LogMessage (liReport,'ListServer OnlyKnown check not re-implemented yet');
          (*
          IF ListMainRec.OnlyKnown THEN
             { we moeten de node dus kennen }
             IF (ReturnEMail <> '') OR (NOT FindUserBaseRecordByFidoAddress (ReturnAdres,TmpRec)) THEN
             BEGIN
                  { You are not allowed to connect to list ... }
                  SendResponse (GetLang1 (1004,TempInfo));
                  Continue;
             END;
          *)

          { door onze lijst met excuses heen, sluit 'm dan maar aan }

          FillChar (ListUserRec,SizeOf (ListUserRecord),0);

          WITH ListUserRec DO
          BEGIN
               UserType:=lutFTN;
               ListID:=ListRec.ListID;
               User:=Msg.FirstDest^.ToUser_F;   { take reply address }
               Aka:=Msg.FirstDest^.ToAddr_F;    { take reply address }
               Access:=ListRec.DefaultAccess;
               SubscribedDate:=GetCurrentUnixTime;
               ConfirmedDate:=0;  { trigger at once }
               ConfirmReqDate:=0;
               ConfirmState:=lcReq2;
               ConfirmCode:=0;

               IF (Msg.FirstDest^.Status = destRemoteGW) THEN
               BEGIN
                    UserType:=lutRemoteGW;
                    Email:=Msg.FirstDest^.To_U; { take reply address }

                    { note: put e-mail address in reply only. the subscribing }
                    {       user does not have to know we are behind a remote }
                    {       gateway.                                          }

                    { Connected @1@ to mailing list ... }
                    SendResponse (GetLang2 (1005,Email,ListRec.Name));
               END ELSE
                    { Connected @1@ to mailing list ... }
                    SendResponse (GetLang2 (1005,'"'+ListUserRec.User+'" at '+
                                                     Fido2Str (ListUserRec.Aka),
                                                     ListRec.Name));
          END; { with }

          ListUser_WriteNew (ListUserRec);

          IF (ListRec.WelcomeFile <> '') THEN
             AddFileToBody (ListRec.WelcomeFile);

          Exit;                 { ## EXIT ## }
     END;

     { Try generic handling }
     ListServer_Generic_ProcessLine (Keyword,Regel);
END;


{--------------------------------------------------------------------------}
{ ListServer_FTN_ProcessMessage                                            }
{                                                                          }
{ Verwerk de commando's die een Usenet gebruiker geeft.                    }
{ Ondersteund worden:                                                      }
{                                                                          }
{   Subscribe/Connect                                                      }
{   UnSubscribe/Disconnect                                                 }
{   List                                                                   }
{   Help                                                                   }
{                                                                          }
PROCEDURE ListServer_FTN_ProcessMessage;

VAR Lp : 1..MAX_BODY_PARTS;

BEGIN
     { init }
     RequestHelp:=FALSE;
     RequestList:=FALSE;
     WroteUseful:=FALSE;
     SendConfirm:='';
     {AdminListRecNr:=NILRecordNr;}

     LogMessage (liTrivial,'ListServer: Processing FTN message');

     ListServer_Process_ErrorCount:=0;

     FTN_PushAndBuildReply (GetLang0 (1032),0,'ListServer');
     InitTokens (_F);

     { add the response header }
     IF (NOT AddFileToBody ('LSERVHDR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'Your message was processed by ListServer at '+Fido2Str (Config.NodeNrs[1])+
                              ' on '+UnixTimeToString (GetCurrentUnixTime));
          {no empty line here: the processor will put an empty
           line before each line it processes.
           MsgsAddLineTo (Body,'');}
     END;

     { run each body part through the processor }
     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.PrevMsgPtr^.BodyParts[Lp] <> NIL) THEN
            IF (Msg.PrevMsgPtr^.BodyParts[Lp]^.PartStatus <> psAttachment) THEN
               IF MsgsForEach (Msg.PrevMsgPtr^.BodyParts[Lp],ListServer_FTN_ProcessLine) THEN
                  Break; { from the for }

     { add the response footer }
     MsgsAddEmptyLineIfNotPresentAlready;
     IF (NOT AddFileToBody ('LSERVFTR.TXT')) THEN
        MsgsAddLineTo (Body,'End of response.');

     IF (ListServer_Process_ErrorCount > MAX_LISTSERVER_CONSECUTIVE_ERRORS) THEN
     BEGIN
          RequestHelp:=FALSE;
          RequestList:=FALSE;
          WroteUseful:=FALSE;
     END;

     { do not send reply if it just contains complaints because of the }
     { CONFIRM message that just was a complete quote.                 }
     IF WroteUseful THEN
     BEGIN
          LogMessage (liTrivial,'ListServer: Sending reply');
          DeliverNow;
     END ELSE
     BEGIN
          LogMessage (liTrivial,'Suppressing useless ListServer reply');
          MsgsFreeAllDestRecords ({Silent:}TRUE);
     END;

     MsgsPopState;

     IF RequestHelp THEN
     BEGIN
          LogMessage (liTrivial,'ListServer: Sending help information');
          FTN_PushAndBuildReply (GetLang0 (1033),0,'ListServer');
          ListServerSendHelp;
          DeliverNow;
          MsgsPopState;
     END;

     IF RequestList THEN
     BEGIN
          LogMessage (liTrivial,'ListServer: Sending available mailing lists');
          FTN_PushAndBuildReply (GetLang0 (1034),0,'ListServer');
          ListServerSendList;
          DeliverNow;
          MsgsPopState;
     END;

     IF (SendConfirm <> '') THEN
     BEGIN
          LogMessage (liTrivial,'ListServer: Sending subscription confirmation');
          FTN_PushAndBuildReply (GetLang0 (1034),0,'ListServer');
          MsgsAddLineTo (Body,SendConfirm);
          DeliverNow;
          MsgsPopState;
     END;

     {AdminListRecNr:=NILRecordNr; { prevent loopholes }

     LogMessage (liTrivial,'ListServer: finished processing message');
END;


(*
{--------------------------------------------------------------------------}
{ UsenetMapListToNews                                                      }
{                                                                          }
{ Verspreid een mail bericht ook onder aangesloten news lezers.            }
{                                                                          }
PROCEDURE UsenetMapListToNews;

VAR FindRecord : AreaBaseRecordNrType;
    OldMode    : SystemModeType;

BEGIN
     { zet de news vlag }
     Msg.Ready_U:=News;

     FindRecord:=GetAreaBaseRecordNrByAreaName_U (UpCaseString (ListMainRec.AreaName));
     IF (FindRecord = NILRecordNr) THEN
     BEGIN
          FindRecord:=GetAreaBaseRecordNrByAreaName_F (UpCaseString(ListMainRec.AreaName));
          IF (FindRecord = NILRecordNr) THEN
          BEGIN
               LogMessage ('Warning! Unknown area "'+ListMainRec.AreaName+
                           '" assigned to mailing-list "'+ListMainRec.ListName+'"');
               Exit;
          END;
     END;

     { MsgsExport is hiervan afhankelijk }
     ReadAreaBaseRecord (FindRecord,AreaData);

     { Gooi de oude bericht header weg, maar zet 'm daarna meteen }
     { gedeeltelijk weer terug.                                   }
     MsgsReleaseLines (Msg.HeaderTop_U);

     { RWI 950530: Header line text toegevoegd: From:, Subject:, Message-ID:, Date:, Organization: }
     MsgsAddLineTo (Header_U,'Path: '+UseGetSystemFromName+'!'+ListMainRec.ListName);
     MsgsAddLineTo (Header_U,'From: '+Msg.FromUser_U);
     MsgsAddLineTo (Header_U,'Newsgroups: '+LoCaseString (AreaData.AreaName_U));
     MsgsAddLineTo (Header_U,'Subject: '+Msg.Subj_U);
     MsgsAddLineTo (Header_U,'Message-ID: '+Msg.MsgID_U);
     MsgsAddLineTo (Header_U,'Date: '+Msg.Date_U);
     MsgsAddLineTo (Header_U,'Organization: '+Msg.Organization_U);
     Msg.NewsGroups_U:=': '+LoCaseString (AreaData.AreaName_U)+#13{RWI950217};

     OldMode:=SystemMode;
     SystemMode:=smDISTRIBUTE; { Zorgt ervoor dat we dit bericht niet nogmaals }
                               { proberen te distribueren.                     }

     MsgsExport;
     SystemMode:=OldMode;
END;
*)

(*
{==========================================================================}
{             AREA (ECHOMAIL, NEWS, MESSAGEBASES) DISTRIBUTIE              }
{==========================================================================}


{--------------------------------------------------------------------------}
{ SendEchomail                                                             }
{                                                                          }
{ Deze routine schrijft het opgegeven bericht naar de area waar deze in    }
{ gepost moet worden, als deze mailing list gelinkt is aan een area. Dit   }
{ is nogal tricky, omdat we het bericht niet weer terug willen hebben van  }
{ "dit bericht is in de mailing list related area gepost, distribueer het" }
{ Hiervoor wordt SystemMode op smDISTRUBUTE gezet.                         }
{ Deze routine wordt nooit aangeroepen als het bericht uit de area zelf    }
{ afkomstig is.                                                            }
{                                                                          }
PROCEDURE SendEchomail (AreaRecNr : AreaBaseRecordNrType);

VAR OldMode : SystemModeType;

BEGIN
     { MsgsExport is hiervan afhankelijk }
     ReadAreaBaseRecord (AreaRecNr,AreaData);

     { zorg ervoor dat het bericht aan ALL gericht wordt
        RAWI 970611: waarom dat? Niet meer..
     Msg.ToUser_F:='All';
     Msg.ToAddr_F:=Config.NodeNrs[ListMainRec.ListAKA];  dit wordt volgens mij niet gebruikt
     }

     MsgsAddFirstLineTo (Body,'');

     {
     MsgsAddFirstLineTo (Body,ListMainRec.ListName+' at '+Fido2Str (Config.NodeNrs[ListMainRec.ListAKA]));
     MsgsAddFirstLineTo (Body,'This message was distributed by the mailing list:');
     }

     OldMode:=SystemMode;
     SystemMode:=smDISTRIBUTE;

     MsgsExport;

     SystemMode:=OldMode;

     MsgsDeleteFirstRowFromBody;
     MsgsDeleteFirstRowFromBody;
     {MsgsDeleteFirstRowFromBody;}
END;
*)

{==========================================================================}
{                             DISTRIBUTION                                 }
{==========================================================================}

{--------------------------------------------------------------------------}
{ MailingList_AddAllAddresses                                              }
{                                                                          }
{ This routine adds all addresses of the subscribers. If the given         }
{ argument is TRUE, then a Copy to Area Filter is immitated to get the     }
{ message in an area as well.                                              }
{                                                                          }
{ Returns the number of recipients added.                                  }
{                                                                          }
FUNCTION MailingList_AddAllAddresses (AllowListToArea : BOOLEAN; ListPos : LONGINT): LONGINT;

VAR ListUserRec : ListUserRecord;
    Lp          : ListUserRecordNrType;
    ListRec     : MailingListRecord;
    Count       : LONGINT;

BEGIN
     { add all recipient addresses }
     Flex_MailingList_Read (ListPos,ListRec);

     Count := 0;

     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUserRec);

          WITH ListUserRec DO
              IF (ListID = ListRec.ListID) AND
                 (Access <> laWriteOnly) THEN
              BEGIN
                   IF (ListUserRec.UserType IN [lutRFC, lutFTN, lutRemoteGW]) THEN
                         Inc (Count);

                   CASE ListUserRec.UserType OF
                        lutRFC :
                            Address_AddRFCRaw (Email,destTo,FALSE,FALSE);

                        lutFTN :
                            Address_AddFTN (User,Aka,FALSE,FALSE);

                        lutRemoteGW:
                            Address_AddRemoteGW (User,Aka,Email,FALSE,FALSE);

                        { else deleted - ignore }
                   END; { case }
              END; { if,with }

     END; { for}

     IF AllowListToArea AND ListRec.ListToArea THEN
        { fake a Copy filter }
        Address_AddCopyAreaDest (ListRec.AreaName,FALSE);

     MailingList_AddAllAddresses := Count;
END;


VAR MLC_Target : WhereToType;

{--------------------------------------------------------------------------}
{ MailingList_CopyRegel                                                    }
{                                                                          }
{ This routine is used to instanciate the header and footer lines of the   }
{ original message. The line is simply added to the set target.            }
{                                                                          }
FUNCTION MailingList_CopyRegel (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     MsgsAddLineToNoEOL (MLC_Target,Regel);
     MailingList_CopyRegel:=FALSE; { do not abort }
END;


{--------------------------------------------------------------------------}
{ MakeListSubject                                                          }
{                                                                          }
{ This routine converts a normal subject into a mailing list subject line. }
{ If the NameInSubject flag is set then the name of the list is inserted   }
{ between square brackets and any other instances of it are removed from   }
{ the subject to avoid situations like this:                               }
{ Subject: [teamwg] [teamwg] Old subject                                   }
{ Subject: [teamwg] Re: [teamwg] Old subject                               }
{                                                                          }
FUNCTION MakeListSubject (VAR ListRec : MailingListRecord; Subj : STRING) : STRING;

VAR Header : STRING[MaxLenMailingListName+3];
    P      : BYTE;

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

     IF ListRec.NameInSubject THEN
     BEGIN
          Header:='['+ListRec.Name+'] ';

          { remove other instances of this text }
          REPEAT
                P:=Pos (Header,Subj);

                IF (P > 0) THEN
                   Delete (Subj,P,Length (Header));

          UNTIL (P = 0);

          { prevent loads of Re: Re: Re: Re: }
          REPEAT
                P:=Pos ('Re: Re:',Subj);
                IF (P > 0) THEN
                   Delete (Subj,P,4)
                ELSE BEGIN
                     P:=Pos ('Re:  Re:',Subj);
                     IF (P > 0) THEN
                        Delete (Subj,P,5);
                END;
          UNTIL (P = 0);

          { set the new header at the start }
          Subj:=Header+Subj;
     END;

     MakeListSubject:=Subj;
END;


{--------------------------------------------------------------------------}
{ MailingList_PushAndCopyMessage                                           }
{                                                                          }
{ This routine is called by the routines accepting a FTN and RFC message   }
{ sent to the mailing list. This routine calls MsgsPushState and makes a   }
{ copy of the original message, include the date, subject, etc.            }
{ The caller should call MsgsPopState afterwards.                          }
{ This message now adds the FooterFile as well, if configured.             }
{                                                                          }
PROCEDURE MailingList_PushAndCopyMessage (VAR ListRec : MailingListRecord; VAR ListPos : LONGINT);

VAR Lp    : 1..MAX_BODY_PARTS;
    Regel : STRING;

BEGIN
     Regel:=MsgsGetFirstRowInBody; { do this before the push }

     MsgsPushState;

     Msg.IsListDist:=TRUE;
     Msg.ListPos:=ListPos;

     WITH Msg.PrevMsgPtr^ DO
     BEGIN
          Msg.Ready_F:=Ready_F;
          Msg.Ready_U:=Ready_U;

          IF (Ready_F <> NotReady) THEN
             Msg.ListSubj:=MakeListSubject (ListRec,Subj_F)
          ELSE
              IF (Ready_U <> NotReady) THEN
                 Msg.ListSubj:=MakeListSubject (ListRec,Copy (Subj_U,10,255));

          { these fields were set before this routine was called }
          Msg.ListPosterEmail:=ListPosterEmail;
          Msg.ListPosterName:=ListPosterName;
          Msg.ListPosterAKA:=ListPosterAKA;

          { copy all FTN fields from pushed message }
          Msg.Date_F:=Date_F;

          Msg.Subj_F:=Msg.ListSubj;

          Msg.MsgID_F:=MsgID_F;
          Msg.ReplyID_F:=ReplyID_F;
          Msg.Chrs_F:=Chrs_F;

          Msg.Attr_F:=Attr_F;
          {## have to clear all unwanted flags}
          Msg.Attr_F:=Msg.Attr_F OR MSGLOCAL;

          Msg.FromUser_F:=FromUser_F;
          Msg.FromAddr_F:=FromAddr_F;


          { copy all RFC fields from pushed message }
          Msg.Date_U:=Date_U;

          Msg.Subj_U:='Subject: '+Msg.ListSubj;

          Msg.Organization_U:=Organization_U;
          Msg.MessageID_U:=MessageID_U;
          Msg.FromUser_U:=FromUser_U;
          Msg.ReplyTo_U:=ReplyTo_U;
          Msg.Sender_U:=Sender_U;
          Msg.InReplyTo_U:=InReplyTo_U;
          Msg.IsMime:=IsMime;
          Msg.MultiPartBoundary:=MultiPartBoundary;

          Msg.FirstSeenByPtr:=SBP_Instanciate (FirstSeenByPtr);
          Msg.FirstPathPtr:=SBP_Instanciate (FirstPathPtr);
     END; { with }

     {## not really necessary - is replaced afterwards anyway }
     {   (expect maybe for echo -> list) }
     MLC_Target:=Header_U;
     MsgsForEach (Msg.PrevMsgPtr^.HeaderTop_U,MailingList_CopyRegel);

     MLC_Target:=Header_F;
     MsgsForEach (Msg.PrevMsgPtr^.HeaderTop_F,MailingList_CopyRegel);
     MsgsForEach (Msg.PrevMsgPtr^.CopiedHeadersTop_F,MailingList_CopyRegel);

     MLC_Target:=Footer_F;
     MsgsForEach (Msg.PrevMsgPtr^.FooterTop_F,MailingList_CopyRegel);

     { This message was distributed by the mailing list @1@ }
     IF (ListRec.UseMessageCounter) THEN
     BEGIN
          Inc (ListRec.MessageCounter);
          MsgsAddFirstLineTo (Body,GetLang2 (1024,ListRec.Name,Longint2String (ListRec.MessageCounter)));
     END ELSE
          MsgsAddFirstLineTo (Body,GetLang1 (1020,ListRec.Name));

     { add empty line, but only if first row in body isn't empty }
     IF (Regel <> '') AND (Regel <> #13) THEN
        MsgsAddLineTo (Body,'');

     { copy the body, including status and attachment info }
     MsgsCopyBodyFromPrevMsg;

     { add the footer file, if configured }
     IF (ListRec.FooterFile <> '') THEN
     BEGIN
          MsgsAddEmptyLineIfNotPresentAlready;
          IF (NOT AddFileToBody (ListRec.FooterFile)) THEN
             LogMessage (liConfig,'Mailing list Footer file not found: '+ListRec.FooterFile);
     END;

     {$IFDEF Pre}
     LogMessage (liDebug,'Poster: '+Msg.ListPosterEmail+','+Msg.ListPosterName+','+Fido2Str (Msg.ListPosterAKA));
     {$ENDIF}
END;


{--------------------------------------------------------------------------}
{ MailingList_RFC_AcceptPost                                               }
{                                                                          }
{ This routine distributes a message addressed to one of our mailinglists. }
{ We first check whether the sender is allowed to post to the list, then   }
{ update his/hers confirm date and then distribute it to all subscribers   }
{ and the connected area, if any.                                          }
{                                                                          }
{ This routine is called by DeliverMail.                                   }
{                                                                          }
PROCEDURE MailingList_RFC_AcceptPost (WasAddressedTo : STRING; ListPos : LONGINT; DestPtr : DestRecordPtr);

VAR ListRec : MailingListRecord;

BEGIN
     Flex_MailingList_Read (ListPos,ListRec);

     Msg.ListPosterEmail:=UsenetReplyAdres;
     Msg.ListPosterName:=UsenetPosterName;
     Msg.ListPosterAka:=Config.NodeNrs[ListRec.AKA];  {## verify this}

     IF (Pos ('MAILER-DAEMON',UpCaseString (Msg.ListPosterEmail)) > 0) THEN
     BEGIN
          LogMessage (liGeneral,'List server suspects bounced mail (3) from '+Msg.ListPosterEmail);

          WriteMessageToRFCBad ('List server suspects bounced mail from '+Msg.ListPosterEmail,DestPtr);

          { caller assumes destination to be handled and removes }
          { DestRecord from the distribution list.               }
          Exit;
     END;

     IF (NOT ListServer_IsKnownRFCSubscriber (ListRec.ListID,Msg.ListPosterEmail)) THEN
     BEGIN
          { You are not connected to the list "..." }
          LogMessage (liGeneral,'ListServer: User "'+Msg.ListPosterEmail+'" is not subscribed to "'+ListRec.Name+'"');
          RFC_Bounce (GetLang1 (100{Reason:},GetLang1 (1021,ListRec.Name)),WasAddressedTo);
          Exit;
     END;

     IF (ListUserAccess = laReadOnly) THEN
     BEGIN
          LogMessage (liGeneral,'ListServer: User "'+Msg.ListPosterEmail+
                                '" is not allowed to post to "'+ListRec.Name+'"');
          RFC_Bounce (GetLang1 (100{Reason:},GetLang1 (1022,ListRec.Name)),WasAddressedTo);
          Exit;
     END;

     { accepted, distribute now }

     LogMessage (liTrivial,'RFC post accepted; distributing via mailing list');

     MailingList_PushAndCopyMessage (ListRec,ListPos);

     ListTrans_ReplaceRfcHeader;

     StatEntry_MailingList (Msg.ListPosterEmail,  MailingList_AddAllAddresses ({AllowListToArea:}TRUE,ListPos),
                            Msg.Subj_U, Msg.MsgSize);


     DeliverNow;

     MsgsPopState;

     LogMessage (liTrivial,'Distribution via mailing list complete');

     { If this list uses counters, update the counter on disk              }
     IF (ListRec.UseMessageCounter) THEN
          Flex_MailingList_Write (ListPos, ListRec);
END;


{--------------------------------------------------------------------------}
{ MailingList_AcceptFTN_CopyHeader                                         }
{                                                                          }
{ This routine is called for each line in the header of the message sent   }
{ to the list. We simply copy everything, except for the REPLYTO/ADDR/ALSO }
{ kludges.                                                                 }
{                                                                          }
FUNCTION MailingList_AcceptFTN_CopyHeader (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     MailingList_AcceptFTN_CopyHeader:=FALSE; { do not abort }

     IF (Copy (Regel,1,8) = #1'REPLYTO') THEN
        Exit;

     IF (Copy (Regel,1,10) = #1'REPLYADDR') THEN
        Exit;

     IF (Copy (Regel,1,10) = #1'REPLYALSO') THEN
        Exit;

     MsgsAddLineToNoEOL (Header_F,Regel);
END;


{--------------------------------------------------------------------------}
{ MailingList_AcceptFTN_CopyFooter                                         }
{                                                                          }
{ This routine is called for each line in the footer of the message sent   }
{ to the list.                                                             }
{                                                                          }
FUNCTION MailingList_AcceptFTN_CopyFooter (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     MailingList_AcceptFTN_CopyFooter:=FALSE; { do not abort }

     IF CaselessStartMatch (Regel,#1'VIA:') THEN
        Exit;

     MsgsAddLineToNoEOL (Footer_F,Regel);
END;


{--------------------------------------------------------------------------}
{ MailingList_FTN_AcceptPost                                               }
{                                                                          }
{ Deze routine distribueert een netmail bericht dat aan een mailing list   }
{ is gestuurd naar alle aangesloten users in mail en netmail formaat en    }
{ naar de area die hieraan gekoppeld is. Voordat dat gebeurd wordt eerst   }
{ gecontroleerd of de zender van het bericht wel een member van deze lijst }
{ is.                                                                      }
{                                                                          }
{ This routine is called by DeliverNetmail and should not modify the       }
{ original message! ListMainRec must contain the record of the mailing     }
{ list this message is addressed to.                                       }
{                                                                          }
PROCEDURE MailingList_FTN_AcceptPost (WasAddressedTo : STRING; ListPos : LONGINT);

VAR Response      : STRING;
    Dummy_Org,
    Dummy_Bang,
    MailFromAdres : STRING;
    ListRec       : MailingListRecord;

    Sender        : STRING;

BEGIN
     Flex_MailingList_Read (ListPos,ListRec);

     { Remote Gateway user? }
     IF (Msg.ReplyEMail <> '') AND (Msg.ReplyUser <> '') THEN
     BEGIN
          { sender is a remote gateway user }

          { het echte email adres in dit bericht is slechts de }
          { transporteur vanaf de gateway.                     }
          Msg.ListPosterEmail:=Msg.ReplyEMail;  { from REPLYADDR }

          { the ListPosterName and ListPosterAka are not important for }
          { the subscription, but will be used during the distribution }
          { so we work out some "nice" information based on the only   }
          { thing we have: an e-mail address.                          }
          Msg.ListPosterName:=Trans_RfcHeader2FullName (0,Msg.ReplyEmail);
          Msg.ListPosterAKA:=Config.NodeNrs[ListRec.Aka];
          
          { check for bounced mail }
          IF (Pos ('MAILER-DAEMON',UpCaseString (Msg.ListPosterEmail)) > 0) THEN
          BEGIN
               {## note: this is an FTN side distribution!!}
               LogMessage (liGeneral,'List server suspects bounce mail (2) from '+Msg.ListPosterEmail);
               WriteMessageToBad;
               Exit; { ## EXIT ## }
          END;

          LogMessage (liTrivial,'Found netmail for mailing list "'+ListRec.Name+
                      '" from '+Msg.ReplyEmail+
                      ' via "'+Msg.ReplyUser+'"%'+Fido2Str (Msg.ReplyAka));

          Sender := Msg.ReplyEmail;

          { controleer eerst of de zender wel op de lijst is aangesloten }
          IF (NOT ListServer_IsKnownRemoteGWUser (ListRec.ListID,Msg.ReplyAka,Msg.ReplyUser,Msg.ReplyEmail)) THEN
          BEGIN
               { You are not connected to the list "..." }
               Response:=GetLang1 (1021,ListRec.Name);
               LogExtraMessage ('  '+Response);
               FTN_Bounce (Response,'ListServer',WasAddressedTo);
               Exit;
          END;
     END ELSE
     BEGIN
          { normal FTN subscription }

          Msg.ListPosterName:=DeleteFrontAndBackSpaces (Msg.FromUser_F);
          Msg.ListPosterAka:=Msg.FromAddr_F;
          Sender := Msg.ListPosterName;

          LogMessage (liTrivial,'Found netmail for mailing list "'+ListRec.Name+
                      '" from "'+Msg.ListPosterName+
                      '"%'+Fido2Str (Msg.ListPosterAka));

          IF (NOT CheckGateway (Msg.ListPosterAka,Msg.ListPosterName,Response)) THEN
          BEGIN
               { not allowed to use the gateway, so put the mailing }
               { list address in here instead.                      }
               LogMessage (liGeneral,'Not allowed to use gateway; replies will go to list');
               Msg.ListPosterEmail:=ListRec.Name+'@'+Config.Domains[ListRec.HomeDomain];
          END ELSE
              Msg.ListPosterEmail:=Trans_UserPlusAka2Email (Msg.FromUser_F,Msg.FromAddr_F);

          { make sure the poster is subscribed to the list }
          IF (NOT ListServer_IsKnownFTNSubscriber (ListRec.ListID,Msg.ListPosterAka,Msg.ListPosterName)) THEN
          BEGIN
               { You are not connected to the list "..." }
               Response:=GetLang1 (1021,ListRec.Name);
               LogExtraMessage ('  '+Response);
               FTN_Bounce (Response,'ListServer',WasAddressedTo);
               Exit;
          END;
     END;

     IF (ListUserAccess = laReadOnly) THEN
     BEGIN
          Response:=GetLang1 (1022,ListRec.Name);
          LogExtraMessage ('  '+Response);
          FTN_Bounce (Response,         { Reason }
                      'ListServer',     { FromName }
                      WasAddressedTo);  { listed in body }
          Exit;
     END;

     { accepted, distribute now }
     LogMessage (liTrivial,'FTN post accepted; distributing via mailing list');

     MailingList_PushAndCopyMessage (ListRec,ListPos);

     { message is in netmail format }

     { ignore the copied headers and make a new copy based on a filter }
     MsgsReleaseLines (Msg.HeaderTop_F);
     MsgsForEach (Msg.PrevMsgPtr^.HeaderTop_F,MailingList_AcceptFTN_CopyHeader);

     MsgsReleaseLines (Msg.CopiedHeadersTop_F);
     MsgsForEach (Msg.PrevMsgPtr^.CopiedHeadersTop_F,MailingList_AcceptFTN_CopyHeader);

     MsgsReleaseLines (Msg.FooterTop_F);
     MsgsForEach (Msg.PrevMsgPtr^.FooterTop_F,MailingList_AcceptFTN_CopyFooter);

     { replace the From (=reply address) if the mailing list has the }
     { highest reply address priority.                               }
     IF (ListRec.MLAddress = laHigher) THEN
     BEGIN
          { list has higher priority, so we replace the reply address }
          { with the name and address of the list so the replies      }
          { get right.                                                }
          Msg.FromUser_F:=ListRec.Name;
          Msg.FromAddr_F:=Config.NodeNrs[ListRec.Aka];

          {## add something to body to indicate original poster? }
          {## might want to replace that when gating?? }
     END;

     StatEntry_MailingList (Sender, MailingList_AddAllAddresses ({AllowListToArea:}TRUE,ListPos),
                              Msg.Subj_F, Msg.MsgSize);

     DeliverNow;

     MsgsPopState;

     LogMessage (liTrivial,'Distribution via mailing list complete');

     { If this list uses counters, update the counter on disk              }
     IF (ListRec.UseMessageCounter) THEN
          Flex_MailingList_Write (ListPos, ListRec);
END;


{--------------------------------------------------------------------------}
{ MailingList_AcceptArea                                                   }
{                                                                          }
{ This routine is called for each area a message is distributed in, both   }
{ news and echomail.                                                       }
{ Task one is to find out whether the area is connected to a mailing list  }
{ (forward lookup - takes time). Then, if the list is active and has       }
{ AreaToList set to Yes and we are not distributing via a mailing list     }
{ when the message was still in echomail format, THEN we distribute via    }
{ this mailing list.                                                       }
{                                                                          }
PROCEDURE MailingList_AcceptArea (AreaRecNr : AreaBaseRecordNrType);

VAR Tmp     : LSTypePtr;
    ListRec : MailingListRecord;
    Reason  : STRING;
    Sender  : STRING;

BEGIN
     { prevent loops }
     IF Msg.IsListDist THEN
        Exit;

     { prevent checking for AreaToList both for news and echomail }
     IF Msg.DidAreaToList THEN
        Exit;

     Msg.DidAreaToList:=TRUE;

     Tmp:=LSNameTable.GetFirstItem;
     WHILE (Tmp <> NIL) DO
     BEGIN
          IF (Tmp^.AreaRecNr = AreaRecNr) THEN
          BEGIN
               Flex_MailingList_Read (Tmp^.Pos,ListRec);

               IF (ListRec.Passive) OR (NOT ListRec.AreaToList) THEN
                  Exit;

               { distribute }
               IF (Msg.Ready_F IN [Local_Echomail,Echomail]) THEN
               BEGIN
                    LogMessage (liTrivial,'Echomail article accepted; distributing via "'+ListRec.Name+'" list');

                    Msg.ListPosterName:=DeleteFrontAndBackSpaces (Msg.FromUser_F);
                    Msg.ListPosterAka:=Msg.FromAddr_F;
                    Sender := Msg.FromUser_F;

                    IF (NOT CheckGateway (Msg.FromAddr_F,Msg.FromUser_F,Reason)) THEN
                    BEGIN
                         { not allowed to use the gateway, so put the mailing }
                         { list address in here instead.                      }
                         LogMessage (liGeneral,'Not allowed to use gateway; replies will go to list');
                         Msg.ListPosterEmail:=ListRec.Name+'@'+Config.Domains[ListRec.HomeDomain];
                    END ELSE
                        Msg.ListPosterEmail:=Trans_UserPlusAka2Email (Msg.FromUser_F,Msg.FromAddr_F);
               END ELSE
               BEGIN
                    LogMessage (liTrivial,'News article accepted; distributing via "'+ListRec.Name+'" list');

                    Msg.ListPosterEmail:=UsenetReplyAdres;
                    Msg.ListPosterName:=UsenetPosterName;
                    Msg.ListPosterAka:=Config.NodeNrs[ListRec.AKA];

                    Sender := Msg.ListPosterEmail;
               END;

               MailingList_PushAndCopyMessage (ListRec,Tmp^.Pos);
               IF (Msg.Ready_F IN [Local_Echomail, Echomail]) THEN
                    StatEntry_MailingList (Sender, MailingList_AddAllAddresses ({AllowListToArea:}FALSE,Tmp^.Pos),
                                           Msg.Subj_F, Msg.MsgSize)
               ELSE
                    StatEntry_MailingList (Sender, MailingList_AddAllAddresses ({AllowListToArea:}FALSE,Tmp^.Pos),
                                           Msg.Subj_U, Msg.MsgSize);

               DeliverNow;

               MsgsPopState;
               LogMessage (liTrivial,'Distribution via mailing list complete');

               Exit; { ## EXIT ## }
          END; { if }

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


{--------------------------------------------------------------------------}
{ SendReconfirmMessage                                                     }
{                                                                          }
{ Tijd om een re-confirm message te sturen.                                }
{                                                                          }
{ Global variables used:                                                   }
{  ListMainRec                                                             }
{  ListUserRec                                                             }
{  ListUserRecNo                                                           }
{                                                                          }
PROCEDURE SendReconfirmMessage (RecNr : ListUserRecordNrType;
                                VAR ListUserRec : ListUserRecord;
                                VAR ListRec : MailingListRecord);

VAR Desc : STRING;
    Days : BYTE;

BEGIN
     { omschrijving opbouwen }
     CASE ListUserRec.UserType OF
          lutFTN :
              Desc:=ListUserRec.User+' at '+Fido2Str (ListUserRec.Aka);

          lutRFC :
              Desc:=ListUserRec.Email;

          lutRemoteGW :
              Desc:=ListUserRec.Email+
                    ' via '+ListUserRec.User+
                    ' at '+Fido2Str (ListUserRec.Aka);

          ELSE { delete/error }
              Exit;  { ## EXIT ## }
     END; { case }

     { als de state nu op Try3 staat, dan mogen we 'deze user verwijderen }
     IF (ListUserRec.ConfirmState = lcReq3) THEN
     BEGIN
          LogMessage (liTrivial,'  Removing '+Desc);
          ListUserRec.UserType:=lutDeleted;
          ListUser_Write (RecNr,ListUserRec);
          Exit; { ## EXIT ## }
     END;

     { als we nu op Ok staan, bereken dan een nieuwe code }
     { om de kans op dubbele codes te voorkomen berekenen we een CRC32 }
     { over het hele user record, waar dus ook de adres informatie in  }
     { zit. Omdat de ConfirmedDate steeds veranderd krijgt de user     }
     { niet dezelfde code. Een record nummer erin stoppen heeft geen   }
     { zin omdat een WtrUtil Database alle records kan opschuiven na   }
     { een delete.                                                     }
     IF (ListUserRec.ConfirmState = lcOk) OR (ListUserRec.ConfirmCode = 0{initial}) THEN
        ListUserRec.ConfirmCode:=UpdateCRC32 (0,ListUserRec,SizeOf (ListUserRec));

     { current date is the last request sent date }
     ListUserRec.ConfirmReqDate:=GetCurrentUnixTime;

     { increase the current state from OK to Try1 to Try2 to Try3 }
     Inc (ListUserRec.ConfirmState);
     LogMessage (liTrivial,'  Request '+Byte2String (Byte (ListUserRec.ConfirmState)-Byte (lcOk))+' to '+Desc);

     ListUser_Write (RecNr,ListUserRec);

     { schrijf het bericht }
     CASE ListUserRec.UserType OF
          lutFTN :
              BEGIN
                   { netmail schrijven }
                   InitTokens (_F);
                   FTN_CreateNetmail (Config.NodeNrs[ListRec.Aka],
                                   'ListServer',
                           { Subj }GetLang0 (1035));
                   Address_AddFTN (ListUserRec.User,ListUserRec.Aka,FALSE,FALSE);
                   MsgsAddLineTo (Body,'');
              END;

          lutRFC :
              BEGIN
                   { e-mail schrijven }
                   InitTokens (_U);
                   RFC_StartSingleRecipientMessage (ListUserRec.Email,
                                                    'listserver@'+Config.Domains[ListRec.HomeDomain],
                                                    GetLang0 (1031),  { ls full name }
                                                    GetLang0 (1035)); { Subject }
              END;

          lutRemoteGW :
              BEGIN
                   { netmail schrijven }
                   InitTokens (_F);
                   FTN_CreateNetmail (Config.NodeNrs[ListRec.Aka],
                                      'ListServer',
                           { Subj }   GetLang0 (1035));
                   Address_AddRemoteGW (ListUserRec.User,
                                        ListUserRec.Aka,
                                        ListUserRec.Email,FALSE,FALSE);
                   MsgsAddLineTo (Body,'');
              END;
     END; { case }

     MsgsAddLineTo (Body,'CONFIRM '+Long2HexString (ListUserRec.ConfirmCode));
     MsgsAddLineTo (Body,'');

     Days:=(ListRec.ConfirmInterval DIV 3)*(Byte (lcReq3)-Byte (ListUserRec.ConfirmState));
     SetToken (tokDaysLeft,Byte2String (Days));
     SetToken (tokListName,ListRec.Name);

     IF (ListUserRec.ConfirmedDate = 0) THEN
     BEGIN
          { initial confirmation }
          IF (NOT AddFileToBody ('LSTCNF.TXT')) THEN
          BEGIN
               MsgsAddLineTo      (Body,'Somebody (probably you) has requested to be subscribed to the mailing list "'+
                                        ListRec.Name+'".');
               MsgsAddLineToNoEOL (Body,'To make sure your reply address works and you really want to be subscribed,');
               MsgsAddLineToNoEOL (Body,'you must confirm this by replying to this message. Put a single line in the');
               MsgsAddLineTo      (Body,'body with the command CONFIRM and the code indicated above.');
               MsgsAddLineTo      (Body,'For your convenience you can simply quote-reply to this message.');
               MsgsAddLineTo      (Body,'');
               MsgsAddLineTo      (Body,'You can ignore this message if you do not wish to be subscribed.');
          END;
     END ELSE
     BEGIN
          { reconfirmation }
          IF (NOT AddFileToBody ('LSTRECNF.TXT')) THEN
          BEGIN
               MsgsAddLineToNoEOL (Body,'To remain subscribed to the mailing list "'+ListRec.Name+'"');
               MsgsAddLineTo      (Body,'you must send a reply at once.');
               MsgsAddLineToNoEOL (Body,'Put a single line in the body with the command CONFIRM and the code');
               MsgsAddLineTo      (Body,'indicated above. For your convenience you can simply quote-reply to this message.');
               MsgsAddLineTo      (Body,'You will be removed from the list if you do not reply within '+Byte2String (Days)+
                                        ' days.');
          END;
     END;

     DeliverNow;
     MsgsEmpty;
END;


{--------------------------------------------------------------------------}
{ ListReconfirmCheck                                                       }
{                                                                          }
{ This routine checks all the users and sends a reconfirmation request     }
{ where required. Users that have not responded in time will be removed.   }
{                                                                          }
PROCEDURE ListReconfirmCheck;

VAR CurrentUT   : LONGINT;
    First       : BOOLEAN;
    Lp          : ListUserRecordNrType;
    ListUserRec : ListUserRecord;
    Pos         : LONGINT;
    ListRec     : MailingListRecord;

BEGIN
     CurrentUT:=GetCurrentUnixTime;
     First:=TRUE;
     Pos:=NILPos;

     FOR Lp:=1 TO ListUser_RecCount DO
     BEGIN
          ListUser_Read (Lp,ListUserRec);

          IF (ListUserRec.ConfirmState = lcNever) THEN
             Continue;

          IF (ListRec.ListID <> ListUserRec.ListID) THEN
             Pos:=NILPos;

          IF (Pos = NILPos) THEN
          BEGIN
               Pos:=FindMailingListByListID (ListUserRec.ListID);
               IF (Pos = NILPos) THEN
                  Continue;

               Flex_MailingList_Read (Pos,ListRec);
          END;

          { ListRec.ListID must now match ListUserRec.ListID }
          IF (ListRec.ConfirmInterval <> 0) THEN
          BEGIN
               { confirmation mechanism is enabled }
               IF First THEN
               BEGIN
                    LogMessage (liTrivial,'Checking mailing list re-confirmations');
                    First:=FALSE;
               END;

               { following check has to trigger                  }
               { 1) only if ConfirmState <> Never                }
               { 2) when confirm has never been issued           }
               {    (confirmeddate = 0)                          }
               { 3) ConfirmInterval days after the ConfirmedDate }
               { 4) Every two days after the first confirm req.  }

               { note: deleting is done in SendReconfirmMessage  }

               { ConfirmState must be <> lcNever because of the check above }

               IF (ListUserRec.ConfirmReqDate = 0) THEN
                  { first confirm request }
                  SendReconfirmMessage (Lp,ListUserRec,ListRec)
               ELSE
                   IF (ListUserRec.ConfirmState = lcOk) THEN
                   BEGIN
                        { trigger next confirmation after Interval days }
                        IF (ListUserRec.ConfirmedDate = 0) OR
                           (CurrentUT > ListUserRec.ConfirmedDate+SEC_Dag*Longint (ListRec.ConfirmInterval))
                        THEN
                            SendReconfirmMessage (Lp,ListUserRec,ListRec);
                   END ELSE
                       { trigger re-confirmation attempt after Interval/3 days }
                       IF (CurrentUT > ListUserRec.ConfirmReqDate+Longint (ListRec.ConfirmInterval DIV 3)*SEC_Dag)
                       THEN
                           SendReconfirmMessage (Lp,ListUserRec,ListRec);

          END; { if ConfirmInterval <> 0 }
     END; { for }
END;


VAR LT_RRHCH_CH : BOOLEAN;

{--------------------------------------------------------------------------}
{ ListTrans_RRH_CopyHeader                                                 }
{                                                                          }
{ This routine is used in a MsgsForEach construction to copy all the       }
{ header lines of the original post to the copy, for distribution.         }
{ Unwanted header lines can be filtered out.                               }
{                                                                          }
FUNCTION ListTrans_RRH_CopyHeader (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     ListTrans_RRH_CopyHeader:=FALSE; { do not abort }

     { check for continuation header lines }
     IF LT_RRHCH_CH AND (Regel[1] IN [' ',#9]) THEN
        Exit;

     { not a continuation header line anymore }
     LT_RRHCH_CH:=FALSE;

     IF CaselessStartMatch (Regel,'From ') OR          { mail->news }
        CaselessStartMatch (Regel,'From: ') OR
        CaselessStartMatch (Regel,'To: ') OR
        CaselessStartMatch (Regel,'Sender: ') OR
        CaselessStartMatch (Regel,'Reply-To: ') OR
        CaselessStartMatch (Regel,'Subject: ') OR
        CaselessStartMatch (Regel,'X-') OR
        CaselessStartMatch (Regel,'Received: ') OR     { mail }
        CaselessStartMatch (Regel,'Path: ') OR         { news->mail }
        CaselessStartMatch (Regel,'Lines: ') OR        { news->mail }
        CaselessStartMatch (Regel,'Newsgroups: ') THEN { news->mail }
     BEGIN
          LT_RRHCH_CH:=TRUE; { kill continuation lines }
          Exit;
     END;

     MsgsAddLineToNoEOL (Header_U,Regel);
END;


{--------------------------------------------------------------------------}
{ ListTrans_ReplaceRfcHeader                                               }
{                                                                          }
{ This routine is called from the Netmail2Mail and Echomail2News translate }
{ routines and the _AcceptRfcPost routines to build a new RFC header with  }
{ the information available. The current header is run through a filter    }
{ routine to remove unwanted header lines and new header lines are added   }
{ in line with the mailing list rules. The same routine is used for mail   }
{ and news.                                                                }
{                                                                          }
PROCEDURE ListTrans_ReplaceRfcHeader;

VAR ListRec : MailingListRecord;
    OldTop  : TopRegelRecordPtr;
    AreaRec : AreaBaseRecord;
    Tmp     : LSTypePtr;

BEGIN
     { read the mailing list record }
     Flex_MailingList_Read (Msg.ListPos,ListRec);

     { find and read the area base record }
     IF (DeleteBackSpaces (ListRec.AreaName) <> '') THEN
     BEGIN
          Tmp:=LSNameTable.GetFirstItem;
          WHILE (Tmp <> NIL) DO
          BEGIN
               IF (Tmp^.ListID = ListRec.ListID) THEN
               BEGIN
                    ReadAreaBaseRecord (Tmp^.AreaRecNr,AreaRec);
                    Msg.Newsgroups_U:='Newsgroups: '+AreaRec.AreaName_U;
                    Tmp:=NIL;
               END ELSE
                   Tmp:=LSNameTable.GetNextItem;
          END; { while }
     END;

     OldTop:=Msg.HeaderTop_U;
     Msg.HeaderTop_U:=NIL;

     { now added by UUCP outbound code
     IF (Msg.Ready_U = Mail) THEN
        MsgsAddLineTo (Header_U,'From listserv@'+Config.Domains[ListRec.HomeDomain]+' '+UsenetArpaNetDate);
     }

     IF (Msg.Ready_U = News) THEN
     BEGIN
          MsgsAddLineTo (Header_U,'Path: '+Config.Domains[ListRec.HomeDomain]+'!not-for-mail');
          IF (Msg.Newsgroups_U = '') THEN
             LogMessage (liFatal,'No newsgroup name available!');
          MsgsAddLineTo (Header_U,Msg.Newsgroups_U);
     END;

     { add new headers }
     Msg.FromUser_U:=RFC_BuildFromHeader (Msg.ListPosterEmail,Msg.ListPosterName);
     {Msg.FromUser_U:='From: '+Msg.ListPosterEmail+' ('+Msg.ListPosterName+')';}
     MsgsAddLineTo (Header_U,Msg.FromUser_U);

     { To: xxx@yyy (Multiple recipients of mailing list "...") }
     Msg.ToUser_U:='To: '+LoCaseString (ListRec.Name)+'@'+Config.Domains[ListRec.HomeDomain]+
                    ' ('+GetLang1 (1023,ListRec.Name)+')';
     MsgsAddLineTo (Header_U,Msg.ToUser_U);

     IF (ListRec.MLAddress = laLower) THEN
     BEGIN
          { Reply-To: Poster's address (has higher priority) }
          Msg.ReplyTo_U:='Reply-To: '+Copy (Msg.FromUser_U,6,255);
          MsgsAddLineTo (Header_U,Msg.ReplyTo_U);
     END ELSE
     BEGIN
          { Reply-To: xxx@yyy (Mailing list "...") }
          {## make this a language entry}
          Msg.ReplyTo_U:='Reply-To: '+LoCaseString (ListRec.Name)+'@'+Config.Domains[ListRec.HomeDomain]+
                         ' (Mailing list "'+ListRec.Name+'")';
          MsgsAddLineTo (Header_U,Msg.ReplyTo_U);
     END;

     { Sender: xxx@yyy (Mailing list "...") }
     Msg.Sender_U:='Sender: '+LoCaseString (ListRec.Name)+'@'+Config.Domains[ListRec.HomeDomain]+
                   ' (Mailing list "'+ListRec.Name+'")';
     MsgsAddLineTo (Header_U,Msg.Sender_U);

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

     { filter out the unwanted lines, copy the rest }
     LT_RRHCH_CH:=FALSE; { not a continuation header }
     MsgsForEachKill (OldTop,ListTrans_RRH_CopyHeader);

     { Lines: for news must be added by the caller }
END;


{--------------------------------------------------------------------------}
{ Unit Initialization                                                      }
{                                                                          }
BEGIN
     LSNameTable.Init (SizeOf (LSType),NIL);
END.
