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

{$i platform.inc}

{ idea: build a list of finalized destinations in Msg. and use those }
{       to deliver. Let a special function do the routing to the     }
{       different destinations, or do it here. Need to work out      }
{       routing to certain targets, etc.                             }

{ na het gaten naar FTN, meteen kijken of er een destNetHold bij zit }
{ want dan kunnen we daar meteen vanaf.                              }

INTERFACE

USES Database;

{ note: must be in order of importance! If a messsage is both }
{ processed  and gated, then drGated should be returned.      }
TYPE DeliverResultType = (drNormal,     { 0: give Sent flag          }
                          drProcessed,  { 1: give Received Flag      }
                          drGated);     { 2: delete if configured to }

FUNCTION DeliverNow : DeliverResultType;

PROCEDURE DeliverEchomail_Rescan (UserRecNr   : UserBaseRecordNrType;
                                  VAR AreaRec : AreaBaseRecord);

VAR SmartHostUserRecNr : UserBaseRecordNrType; { set in wtrstart.pas }


IMPLEMENTATION

USES Ramon,
     Msgs,
     Cfg,
     Logs,
     Routing,
     UseAdres,
     Usenet,
     ListSrv,
     AreaMgr,
     AreaBase,   { AreaCreateUserBaseRecNr }
     UucpRout,
     Fido,
     Globals,
     Nodelist,
     Language,
     Mappers,
     Slice,
     Outbound,
     Start,
     FlexCfg,
     PackBuf,
     DList,
     Address,
     Gateway,
     BBSUsers,
     Trans,
     Import,
     SeenBy,
     Binkley,
     UserBase,  { UserBaseRecNr - have to get rid of this one }
     FidoPkt,
     Pkt2000,
     {Stats,}
     NewStats,
     FlexTdb;

{--------------------------------------------------------------------------}
{ RemoveDestRecord                                                         }
{                                                                          }
{ This routine is called to remove a DestRecord from the chain of          }
{ destination records. The DestRecord itself is only freed when FreeIt is  }
{ set to TRUE. Otherwise it is only unchained.                             }
{                                                                          }
PROCEDURE RemoveDestRecord (DestPtr : DestRecordPtr; FreeIt : BOOLEAN);

VAR FindPtr : DestRecordPtr;

BEGIN
     IF (DestPtr = Msg.FirstDest) THEN
        Msg.FirstDest:=Msg.FirstDest^.NextDest
     ELSE BEGIN
          FindPtr:=Msg.FirstDest;
          WHILE (FindPtr <> NIL) AND (FindPtr^.NextDest <> DestPtr) DO
                FindPtr:=FindPtr^.NextDest;

          IF (FindPtr = NIL) THEN
             LogMessage (liReport,'Failed to find DestRecord in chain!')
          ELSE
              FindPtr^.NextDest:=DestPtr^.NextDest;
     END;

     DestPtr^.NextDest:=NIL;

     IF FreeIt THEN
     BEGIN
          {$IFDEF LogGetMem} LogGetMem (DestPtr,SizeOf (DestRecord),'free DestRecord'); {$ENDIF}
          FreeMem (DestPtr,SizeOf (DestRecord));
     END;
END;


{--------------------------------------------------------------------------}
{ LogAllDestinations                                                       }
{                                                                          }
{ This routine logs all destination records (for debugging).               }
{                                                                          }
PROCEDURE LogAllDestinations;

VAR FindPtr : DestRecordPtr;
    Lp      : 1..MAX_AREA_CROSS_POSTS;
    Temp    : STRING;

BEGIN
     FindPtr:=Msg.FirstDest;
     WHILE (FindPtr <> NIL) DO
     BEGIN
          LogExtraMessage ('Dest: Status:'+
                           Status2Str[FindPtr^.Status]+'/'+
                           FindPtr^.ToUser_F+'/'+
                           Fido2Str (FindPtr^.ToAddr_F)+'/'+
                           FindPtr^.To_U+'/UserRecNr:'+
                           Word2String (FindPtr^.UserRecNr));
          FindPtr:=FindPtr^.NextDest;
     END; { while }

     Temp:='';
     FOR Lp:=1 TO MAX_AREA_CROSS_POSTS DO
         IF (Msg.AreaRecNrs[Lp] <> NILRecordNr) THEN
            Temp:=Temp+Word2String (Msg.AreaRecNrs[Lp])+'/';

     IF (Temp <> '') THEN
        LogExtraMessage ('Areas:'+Copy (Temp,1,Length (Temp)-1));
END;


{--------------------------------------------------------------------------}
{ Deliver_AddNote                                                          }
{                                                                          }
{ Oversee the addition of a 'filter'/move/copy/cc/fwd note.                }
{ First body part should be removed afterwards.                            }
{                                                                          }
{ Takes DeliverType to decide what type of information to include (RFC     }
{ or FTN)                                                                  }
{                                                                          }
{  Copied from Echo, destination News                                      }
{  ** This message was copied from local.test by tibbs.offsbbs.com         }
{                                                                          }
{  Copied from echo, destination echo                                      }
{  ** This message was forwarded from STN.WG by 111:1500/202.1             }
{                                                                          }
PROCEDURE Deliver_AddNote (DeliverType: DestStatus);
{## have DestRecordPtr as argment so you can get at the AreaRecNr? }

VAR Note     : STRING;
    AreaData : AreaBaseRecord;

BEGIN
     { Just to be safe ... }
     IF (Msg.FilterUsed IN [matDelete, matToFile, matSave, matBounce,
                            matBounceAddr, matNone]) THEN
     BEGIN
          LogMessage (liReport,'[Deliver_AddNote] Based on FilterUsed, we shouldn''t be here?');
          LogExtraMessage ('FilterUsed='+Word2String (Ord (Msg.MapperAction)));
          Exit;
     END;

     CASE Msg.FilterUsed OF
          matMove:    note := '** This message was moved';
          matCopy:    note := '** This message was copied';
          matForward: note := '** This message was forwarded';
     END;

     { If it was taken from a known area... }
     IF (Msg.ExportAreaRecNr <> 65535) THEN
     BEGIN
          { Get the area record for that area }
          ReadAreaBaseRecord (Msg.ExportAreaRecNr, AreaData);

          Note := Note + ' from ';
          IF (DeliverType IN [destNews, destNewsArea, destRFCRaw, destRFC,
                              destRFCUser]) THEN
             Note := Note + AreaData.AreaName_U
          ELSE     { FTN }
             Note := Note + AreaData.AreaName_F;
     END;

     { Add the 'by' part.. }
     Note := Note + ' by ';

     {## for RFC, do we always use the first system domain?}
     IF (DeliverType IN [destNews, destNewsArea, destRFCRaw, destRFC,
                         destRFCUser]) THEN
        Note := Note + Config.Domains [1]
     ELSE IF (Msg.ExportAreaRecNr <> 65535) THEN     {ftn, echoarea}
        Note := Note + Fido2Str (Config.NodeNrs [AreaData.OriginAKA])
     ELSE  { from FTN, but we don't know the AKA... use our system aka }
        Note := Note + Fido2Str (Config.NodeNrs [1]);

     IF (NOT MsgsInsertBodyPartAtTop) THEN
     BEGIN
          LogMessage (liFatal,'[AddNote] Can''t insert body part, skipping AddNote');
          Exit;
     END;

     MsgsAddLineTo (Body, Note);
     MsgsAddLineTo (Body, '');
END;


{--------------------------------------------------------------------------}
{ Deliver_RemoveNote                                                       }
{                                                                          }
{ Removes the filter note.                                                 }
{                                                                          }
PROCEDURE Deliver_RemoveNote;
BEGIN
     {## what if MsgsInsertBodyPartsAtTop failed?}
     MsgsReleaseLines (Msg.BodyParts [1]);
END;


{==========================================================================}
{                          DELIVER MAIL                                    }
{==========================================================================}

{--------------------------------------------------------------------------}
{ DeliverMail_Flush                                                        }
{                                                                          }
{ This routine is called when the PackBuf unit has filled a block with     }
{ message lines.                                                           }
{                                                                          }
PROCEDURE DeliverMail_Flush (VAR Buffer; Count: WORD; APtr : POINTER); FAR;

VAR OutPtr : OutboundRecordPtr;

BEGIN
     {LogMessage ('DeliverMail_Flush: '+Word2String (Count)+' bytes');}

     OutPtr:=APtr;

     IF (OutPtr^.OutType = otSmtpMail) THEN
        SmtpMailOut_WriteToJob (OutPtr,Count,Buffer)
     ELSE
         IF (OutPtr^.OutType = otUUCPMail) THEN
            UucpMailOut_WriteToJob (OutPtr,Count,Buffer)
         ELSE
             SoupMailOut_WriteToBatch (OutPtr,Count,Buffer);
END;


VAR _Soup_UserRecNr : UserBaseRecordNrType;
    _Soup_OutPtr    : OutboundRecordPtr;

{------------------------------------------------------------------}
{ DeliverMail_AddSoupHeaderLine                                    }
{                                                                  }
{ This routine is called for each Header_ line that is added to    }
{ the outbound SOUP job. All lines are written except for the      }
{ UUCP From_ header.  The TO: field is replaced with the list of   }
{ matching DestRecord recipients.                                  }
{                                                                  }
FUNCTION DeliverMail_AddSoupHeaderLine (VAR Regel : STRING) : BOOLEAN; FAR;
VAR
     Line:     STRING;
     FindPtr:  SoupEnvelopeRecordPtr;
     TempPtr:  SoupEnvelopeRecordPtr;

BEGIN
     DeliverMail_AddSoupHeaderLine:=FALSE; { never abort }

     IF (CaselessStartMatch (Regel, 'To: ') AND
        (_Soup_OutPtr^.SoupEnvelope <> NIL)) THEN
     BEGIN
          Line:='To: ';

          { Add all recipient addresses.  If the line is getting too }
          { long (>100 characters), fold it.                         }

          FindPtr := _Soup_OutPtr^.SoupEnvelope;
          WHILE (FindPtr <> NIL) DO
          BEGIN
               { Don't add '*SENDER*' address, since that's only used }
               { in WGSOUP situations.                                }
               IF (NOT CaselessStartMatch (FindPtr^.Address, '*SENDER*')) THEN
               BEGIN
                    LogExtraMessage ('Added '+FindPtr^.Address);

                    IF (Line <> 'To: ') AND (Line <> '       ') THEN
                         Line := Line+', ';

                    Line := Line+FindPtr^.Address;
                    IF (Length (Line) > 100) THEN
                    BEGIN
                         Line:=Line+#10;
                         PackBuf_AddLine (Line);
                         Line:='       ';
                    END;
               END;

               TempPtr := FindPtr^.Next;
               FreeMem (FindPtr, SizeOf (SoupEnvelopeRecord));
               FindPtr := TempPtr;
          END;

          { No more recipients }
          _Soup_OutPtr^.SoupEnvelope := NIL;

          IF (Line <> '       ') THEN
          BEGIN
               Line := Line+#10;
               PackBuf_AddLine (Line);
          END;
     END ELSE
         { not To: }
         PackBuf_AddLine (Regel);
END;


{----------------------------------------------------------------------}
{ DeliverMailToRfcUser_FindUucpFromHeaderInfo                          }
{                                                                      }
{ This routine is called for each line in the RFC header when we are   }
{ looking for the information to put in the UUCP From_ header. We      }
{ primarily search for a Sender: header, but take the From: header if  }
{ nothing else is available. Returns FALSE as long as Sender: is not   }
{ found. Match is copied to Msg.UUCP_From_.                            }
{ No support for multi-line or very long headers!                      }
{                                                                      }
FUNCTION DeliverMailToRfcUser_FindUucpFromHeaderInfo (VAR OrigRegel : STRING) : BOOLEAN; FAR;
BEGIN
     IF CaselessStartMatch (OrigRegel,'Sender: ') THEN
     BEGIN
          Msg.UUCP_From_:=UseGetAddress (Copy (OrigRegel,9,Length (OrigRegel)-9));
          DeliverMailToRfcUser_FindUucpFromHeaderInfo:=TRUE; { stop calling me }
          Exit; { ## EXIT ## }
     END;

     IF CaselessStartMatch (OrigRegel,'From: ') THEN
        Msg.UUCP_From_:=UseGetAddress (Copy (OrigRegel,7,Length (OrigRegel)-7));

     DeliverMailToRfcUser_FindUucpFromHeaderInfo:=FALSE; { keep on calling me }
END;


{----------------------------------------------------------------------}
{ DeliverMailToRfcUser                                                 }
{                                                                      }
{ This routine writes this message to an outbound job for all records  }
{ with the user record number equal to the given user record number.   }
{ These records are then deleted from the destlist.                    }
{                                                                      }
PROCEDURE DeliverMailToRfcUser (UserRecNr : UserBaseRecordNrType; FirstPtr : DestRecordPtr);

VAR UserRec : UserBaseRecord;
    OutPtr  : OutboundRecordPtr;

    {------------------------------------------------------------------}
    { CreateUucpEnvelope                                               }
    {                                                                  }
    { This routine starts a UUCP mail export. It calls the Outbound    }
    { functions to create a new UUCP mail job and then adds all the    }
    { recipients.                                                      }
    {                                                                  }
    PROCEDURE CreateUucpEnvelope;

    VAR FindPtr : DestRecordPtr;
        Full    : BOOLEAN;

    BEGIN
         OutPtr:=UucpMailOut_StartNewJob (UserRecNr);

         Full:=FALSE;

         FindPtr:=Msg.FirstDest;
         WHILE (FindPtr <> NIL) DO
         BEGIN
              IF (FindPtr^.Status = destRFCUser) AND (FindPtr^.UserRecNr = UserRecNr) THEN
              BEGIN
                   LogExtraMessage ('Added '+FindPtr^.To_U);

                   IF (UucpMailOut_AddRecipient (OutPtr,FindPtr^.To_U)) THEN
                   BEGIN
                        LogMessage (liTrivial,'UUCP envelope is full');
                        Full:=TRUE;
                   END;

                   RemoveDestRecord (FindPtr,TRUE);

                   IF Full THEN
                      Break; { from the while }

                   FindPtr:=Msg.FirstDest;
                   Continue;
              END;

              FindPtr:=FindPtr^.NextDest;
         END; { while }

         UucpMailOut_CloseEnvelope (OutPtr);
    END; { CreateUucpEnvelope }

    {------------------------------------------------------------------}
    { CreateSmtpEnvelope                                               }
    {                                                                  }
    { This routine starts a SMTP mail export. It calls the Outbound    }
    { functions to create a new job and then adds all the recipients.  }
    {                                                                  }
    PROCEDURE CreateSmtpEnvelope;

    VAR User,
        Domain,
        Domain2 : STRING;
        FindPtr : DestRecordPtr;
        WrkFrom : STRING;

    LABEL Skip;

    BEGIN
         WrkFrom:=UseGetAddress (Copy (Msg.FromUser_U,7,255)); { strips full name }

         IF (Config.SmtpForward = '') THEN
         BEGIN
              UseAdresParse (FirstPtr^.To_U,Domain,User);
              OutPtr:=SmtpMailOut_StartNewJob (UserRecNr,Domain,WrkFrom);
              Domain:=UpCaseString (Domain);
         END ELSE
             OutPtr:=SmtpMailOut_StartNewJob (UserRecNr,Config.SmtpForward,WrkFrom);

         IF (OutPtr = NIL) THEN
            LogMessage (liFatal,'Failed to create SMTP envelope; aborting');

         { add all recipient addresses to the envelope file }
         FindPtr:=Msg.FirstDest;
         WHILE (FindPtr <> NIL) DO
         BEGIN
              IF (FindPtr^.Status = destRFCUser) AND (FindPtr^.UserRecNr = UserRecNr) THEN
              BEGIN
                   IF (Config.SmtpForward = '') THEN
                   BEGIN
                        { check domain }
                        UseAdresParse (FindPtr^.To_U,Domain2,User);
                        IF (UpCaseString (Domain2) <> Domain) THEN
                           GOTO Skip;
                   END;

                   IF (OutPtr = NIL) THEN
                      LogMessage (liGeneral,'Not delivering to '+FindPtr^.To_U)
                   ELSE BEGIN
                        LogExtraMessage ('Added '+FindPtr^.To_U);
                        SmtpMailOut_AddRecipient (OutPtr,FindPtr^.To_U);
                   END;

                   RemoveDestRecord (FindPtr,TRUE);
                   FindPtr:=Msg.FirstDest;
                   Continue;
              END;

         Skip:
              FindPtr:=FindPtr^.NextDest;
         END; { while }

         IF (OutPtr <> NIL) AND (NOT SmtpMailOut_CloseEnvelope (OutPtr)) THEN
         BEGIN
              LogMessage (liFatal,'Failed to complete SMTP envelope; aborting');
              OutPtr:=NIL;
         END;
    END;

    {------------------------------------------------------------------}
    { CreateSoupEnvelope                                               }
    {                                                                  }
    { This routine starts a SOUP mail export. It calls the Outbound    }
    { functions to create a new job, but does not add the recipients.  }
    { This is because we have to replace to TO: header line with the   }
    { list of expected recipients when we add the header to the output }
    { message.                                                         }
    {                                                                  }
    PROCEDURE CreateSoupEnvelope;

    VAR User,
        Domain,
        Domain2 : STRING;
        FindPtr : DestRecordPtr;
        WrkFrom : STRING;

    LABEL Skip;

    BEGIN
          OutPtr := SoupMailOut_StartOfMessage (False {IsNews}, UserRecNr);
          SoupMailOut_WriteMessageHeader (OutPtr);

          _Soup_OutPtr := OutPtr;

          IF (OutPtr = NIL) THEN
               LogMessage (liFatal,'Failed to create SOUP envelope; aborting')
          ELSE
          BEGIN
              { add all recipient addresses to the envelope file }
              FindPtr:=Msg.FirstDest;
              WHILE (FindPtr <> NIL) DO
              BEGIN
                   IF (FindPtr^.Status = destRFCUser) AND (FindPtr^.UserRecNr = UserRecNr) THEN
                   BEGIN
                        IF (OutPtr = NIL) THEN
                           LogMessage (liGeneral,'Not delivering to '+FindPtr^.To_U)
                        ELSE BEGIN
                             {## have to do this}
                             SoupMailOut_AddRecipient (OutPtr,FindPtr^.To_U);
                        END;
     
                        RemoveDestRecord (FindPtr,TRUE);
                        FindPtr:=Msg.FirstDest;
                        Continue;
                   END;
     
              Skip:
                   FindPtr:=FindPtr^.NextDest;
              END; { while }
          END;

          { Add sender }
          WrkFrom := UseGetAddress (Copy (Msg.Sender_U,9,255));
          IF (DeleteFrontAndBackSpaces (WrkFrom) = '') THEN
          BEGIN
               WrkFrom := UseGetAddress (Copy (Msg.FromUser_U,7,255));

               IF (DeleteFrontAndBackSpaces (WrkFrom) = '') THEN
                    LogMessage (liFatal, 'CreateSoupEnvelope: Unable to find acceptable sender in Sender: or From:!');
          END;

          WrkFrom := '*SENDER*' + WrkFrom;

          SoupMailOut_AddRecipient (OutPtr, WrkFrom);

          SoupMailOut_CloseEnvelope (OutPtr);
    END;

    {------------------------------------------------------------------}
    { CreateInetMailEnvelope                                           }
    {                                                                  }
    { This routine starts a INET.MAIL job.  It calls the Outbound      }
    { functions to create a new mail job and then adds all the         }
    { recipients.                                                      }
    {                                                                  }
    PROCEDURE CreateInetMailEnvelope;

    VAR FindPtr : DestRecordPtr;
        Full    : BOOLEAN;
        WrkFrom : STRING;

    BEGIN
         WrkFrom := UseGetAddress (Copy (Msg.Sender_U,9,255));
         IF (DeleteFrontAndBackSpaces (WrkFrom) = '') THEN
         BEGIN
              WrkFrom := UseGetAddress (Copy (Msg.FromUser_U,7,255));

              IF (DeleteFrontAndBackSpaces (WrkFrom) = '') THEN
                   LogMessage (liFatal, 'CreateInetMailEnvelope: Unable to find acceptable sender in Sender: or From:!');
         END;


         OutPtr:=InetMailOut_StartNewJob (UserRecNr, WrkFrom);

         Full:=FALSE;

         FindPtr:=Msg.FirstDest;
         WHILE (FindPtr <> NIL) DO
         BEGIN
              IF (FindPtr^.Status = destRFCUser) AND (FindPtr^.UserRecNr = UserRecNr) THEN
              BEGIN
                   LogExtraMessage ('Added '+FindPtr^.To_U);

                   InetMailOut_AddRecipient (OutPtr,FindPtr^.To_U);
                   RemoveDestRecord (FindPtr,TRUE);

                   IF Full THEN
                      Break; { from the while }

                   FindPtr:=Msg.FirstDest;
                   Continue;
              END;

              FindPtr:=FindPtr^.NextDest;
         END; { while }

         InetMailOut_CloseEnvelope (OutPtr);
    END; { CreateUucpEnvelope }

    {------------------------------------------------------------------}
    { WriteUucpFrom_Header                                             }
    {                                                                  }
    { This routine writes the From_ header to the message file of the  }
    { UUCP job. If no From_ header is defined yet, this function will  }
    { define one based on the information found in the headers.        }
    {                                                                  }
    PROCEDURE WriteUucpFrom_Header;

    VAR User,
        Domain : STRING;

    BEGIN
         IF (Msg.UUCP_From_ = '') THEN
         BEGIN
              MsgsForEach (Msg.HeaderTop_U,DeliverMailToRfcUser_FindUucpFromHeaderInfo);

              IF (Msg.UUCP_From_ = '') THEN
              BEGIN
                   LogMessage (liReport,'[WriteUucpFrom_Header] Create UUCP_From_ not ready yet!');
                   Msg.UUCP_From_:='not-for-mail';
              END;

              UsenetSplit (Msg.UUCP_From_,Domain,User);

              IF (Domain = '') OR (User = '') THEN
              BEGIN
                   LogMessage (liReport,'[WriteUucpFrom_Header] UUCP_From_="'+Msg.UUCP_From_+
                                        '" -> Domain="'+Domain+'", User="'+User+'"');
              END;

              { finally, create the From_ header }
              { do not create the old-style "remote from" line anymore }
              { make sure there is a #13 at the end! }
              {Msg.UUCP_From_:='From '+User+' '+UsenetArpanetDate+' remote from '+Domain+#13;}
              Msg.UUCP_From_:='From '+Msg.UUCP_From_+' '+UsenetArpanetDate+#13;
         END;

         PackBuf_AddLine (Msg.UUCP_From_);
    END;

{DeliverMailToRfcUser}

VAR Terminator : LineTerminatorTypes;
    Regel      : STRING;
    Lp         : BYTE;
    FindPtr,
    TempPtr    : SoupEnvelopeRecordPtr;

BEGIN
     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverMailToRfcUser to UserRecNr '+Word2String (UserRecNr)+' begin');

{$IFNDEF WtrTest}
     ReadUserBaseRecord (UserRecNr,UserRec);
     _Soup_UserRecNr:=UserRecNr;

     { start job }

     IF (UserRec.System = _S) THEN
     BEGIN
          CreateSmtpEnvelope;
          Terminator:=lttCRLF;
     END ELSE
          IF (UserRec.System = _INETMAIL) THEN
          BEGIN
               CreateInetMailEnvelope;
               Terminator:=lttCRLF;
          END ELSE
              IF (UserRec.System = _U) THEN
              BEGIN
                   CreateUucpEnvelope;
                   Terminator:=lttLF;
              END ELSE
              BEGIN
                   CreateSoupEnvelope;
                   Terminator:=lttLF;
              END;

     { write body }
     IF (OutPtr <> NIL) THEN
     BEGIN
          IF PackBuf_Init (DeliverMail_Flush,Terminator,OutPtr) THEN
          BEGIN
               IF (UserRec.System = _U) THEN
                  WriteUucpFrom_Header;

               { pack header }
               IF (UserRec.System <> _SOUP) THEN
                  MsgsForEach (Msg.HeaderTop_U,PackBuf_AddLine)
               ELSE BEGIN
                    MsgsForEach (Msg.HeaderTop_U,DeliverMail_AddSoupHeaderLine);

                    { If there are still recipients, we can assume that there }
                    { wasn't a To: line in need of replacement.  Add one now  }
                    IF (OutPtr^.SoupEnvelope <> NIL) THEN
                    BEGIN
                         FindPtr := OutPtr^.SoupEnvelope;
                         Regel := 'To: ';

                         { Add all recipient addresses.  If the line is getting too }
                         { long (>100 characters), fold it.                         }

                         WHILE (FindPtr <> NIL) DO
                         BEGIN
                              { Don't add '*SENDER*' address, since that's only used }
                              { in WGSOUP situations.                                }
                              IF (NOT CaselessStartMatch (FindPtr^.Address, '*SENDER*')) THEN
                              BEGIN
                                   LogExtraMessage ('Added '+FindPtr^.Address);

                                   IF (Regel <> 'To: ') AND (Regel <> '       ') THEN
                                        Regel := Regel+', ';

                                   Regel := Regel+FindPtr^.Address;
                                   IF (Length (Regel) > 100) THEN
                                   BEGIN
                                        Regel := Regel+#10;
                                        PackBuf_AddLine (Regel);
                                        Regel := '       ';
                                   END;
                              END;

                              TempPtr:=FindPtr^.Next;
                              FreeMem (FindPtr,SizeOf (SoupEnvelopeRecord));
                              FindPtr:=TempPtr;
                         END;

                         { No more recipients }
                         OutPtr^.SoupEnvelope:=NIL;

                         IF (Regel <> '       ') THEN
                         BEGIN
                              Regel:=Regel+#10;
                              PackBuf_AddLine (Regel);
                         END;
                    END; { if SoupEnvelope }
               END; { if _SOUP }

               { header and body separator }
               Regel:=#13;
               PackBuf_AddLine (Regel);

               { pack body }
               FOR Lp:=1 TO MAX_BODY_PARTS DO
                   MsgsForEach (Msg.BodyParts[Lp],PackBuf_AddLine);

               PackBuf_Done;
          END;

          { close job }
          IF (UserRec.System = _S) THEN
               SmtpMailOut_CloseJob (OutPtr)
          ELSE
              IF (UserRec.System = _U) THEN
                 UucpMailOut_CloseJob (OutPtr)
              ELSE IF (UserRec.System = _SOUP) THEN
                  SoupMailOut_EndOfMessage (OutPtr)
              ELSE
                  InetMailOut_CloseJob (OutPtr);
     END; { if }

{$ELSE}
     { WtrTest }
     RemoveDestRecord (FirstPtr,TRUE);
{$ENDIF (WtrTest)}

     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverMailToRfcUser to UserRecNr '+Word2String (UserRecNr)+' complete');
END;


{--------------------------------------------------------------------------}
{ DeliverMail                                                              }
{                                                                          }
{ This routine is called from DeliverNow when the Msg.Ready_U is Mail.     }
{ This routine must make sure all recipients that wants to receive the     }
{ message in this format get a copy of it before this routine returns.     }
{ Here, we try to deliver the message as it is to a number (or all) of the }
{ DestRecords set for destRFC.                                             }
{ We first work out the real final destination for each recipient and fill }
{ in the UserRecNr and set the type to destRFCUser for exporting in a      }
{ later phase. All internal addresses are executed at once and             }
{ destinations at the other side of the gateway are set to destFTN.        }
{ The next phase then exports the message for all recipients set to        }
{ destRFCUser by calling DeliverMailToRfcUser for each found UserRecNr.    }
{ The body is thus processed again and again for each UserRecNr.           }
{ All DestRecords that are handled (internally) or delivered are removed   }
{ from the chain. Some entries might have changed to destFTN.              }
{                                                                          }
PROCEDURE DeliverMail;

    {----------------------------------------------------------------------}
    { OurDomainAtEnd                                                       }
    {                                                                      }
    { This routine checks whether our domain is at the end of the given    }
    { domain and verifies that a "." or "@" is in front. This avoids       }
    { triggering on "moredomain.se" when our domain is "domain.se".        }
    { Returns TRUE if it is a match. Both inputs are in upper case         }
    {                                                                      }
    FUNCTION OurDomainAtEnd (OurDomain,CheckDomain : STRING) : BOOLEAN;

    VAR P : BYTE;

    BEGIN
         OurDomainAtEnd:=FALSE; { assume not }

         IF (HaveNotLocalRecord (OurDomain)) THEN
             Exit;

         P:=Pos (OurDomain,CheckDomain);

         IF (P > 1) THEN
            IF (CheckDomain[P-1] <> '.') THEN
               P:=0;

         OurDomainAtEnd:=(P <> 0);
    END;


    {----------------------------------------------------------------------}
    { HandleRfcDest                                                        }
    {                                                                      }
    { Returns TRUE if the dest can be removed, otherwise FALSE.            }
    {                                                                      }
    FUNCTION HandleRfcDest (DestPtr : DestRecordPtr) : BOOLEAN;

    VAR HulpAddrType : EForm;
        HulpUserUp,
        HulpUser,
        HulpDomain   : STRING;

        { stap 1 }
        UserRec      : UserBaseRecord;

        { stap 2 }
        RecNr        : UserBaseRecordNrType;

        { stap 3 }
        FidoAdresStr,
        LocalDomain  : STRING;
        FoundTarget  : BOOLEAN;
        Found_FidoString,
        FoundOurDomainAtTheEndOfTheAdres : BOOLEAN;
        AliasTeller  : 0..MaxSystemDomains;
        Lp           : BYTE;

        ListRecNr    : LONGINT;

    BEGIN
         HandleRfcDest:=FALSE; { do not delete record }

         IF (NOT Msg.IsListDist) AND CheckAndHandleTunnelFrom (DestPtr) THEN
         BEGIN
              HandleRfcDest:=TRUE; { delete DestRecord }
              Exit;
         END;

         HulpAddrType:=UseAdresParse (DestPtr^.To_U,HulpDomain,HulpUser);
         HulpUserUp:=UpCaseString (HulpUser);

         IF UsenetIsOurDomain (HulpDomain) THEN
            HulpAddrType:=LOKAAL;

         { Stap 1                                                  }
         {                                                         }
         { Kijk of het bericht lokaal bestemd is, bijv. ListServer }

         IF (HulpAddrType = LOKAAL) THEN
         BEGIN
              IF (NOT Msg.IsListDist) THEN
              BEGIN
                   { oplossing 1: het bericht is aan newsfix gericht }
                   IF CaselessMatch (HulpUser,Config.NewsfixName) THEN
                   BEGIN
                        LogMessage (liGeneral,'Found e-mail for newsfix from '+UsenetReplyAdres);

                        {$IFDEF WtrTest}
                        LogMessage (liTrivial,'Target: Newsfix');
                        {$ELSE}
                        Newsfix_ProcessMessage;
                        {$ENDIF}

                        HandleRfcDest:=TRUE; { delete destrecord }
                        Exit;
                   END;

                   { controleer of het voor een van de mailing lists is }
                   ListRecNr:=ListServerSearchName (HulpUserUp);

                   IF (ListRecNr <> NILPos) THEN
                   BEGIN
                        LogMessage (liGeneral,'Found e-mail for mailing list "'+HulpUser+'" from '+UsenetReplyAdres);

                        {$IFDEF WtrTest}
                        LogMessage (liTrivial,'Target: Mailing list');
                        {$ELSE}
                        MailingList_RFC_AcceptPost (DestPtr^.To_U,ListRecNr,DestPtr);
                        {$ENDIF}

                        HandleRfcDest:=TRUE; { delete destrecord }
                        Exit;
                   END;

                   { kijk of het voor de list server robot is }
                   { RWI 960614: vergelijking op ListServ2 was tegen HulpUser }
                   IF CaselessMatch (HulpUser,ListServer1) OR
                      CaselessMatch (HulpUser,ListServer2) THEN
                   BEGIN
                        LogMessage (liGeneral,'Found e-mail for the list server from '+UsenetReplyAdres);

                        {$IFDEF WtrTest}
                        LogMessage (liTrivial,'Target: List Server');
                        {$ELSE}
                        ListServer_RFC_ProcessMessage (DestPtr);
                        {$ENDIF}

                        HandleRfcDest:=TRUE;  { delete destrecord }
                        Exit;
                   END;

                   IF RFC_CheckAndHandleSendFile (HulpUser) THEN
                   BEGIN
                        HandleRfcDest:=TRUE;  { delete destrecord }
                        Exit;
                   END;
              END;

              { check for user%akadomain@ourdomain }
              IF (Pos ('%',HulpUser) > 0) THEN
              BEGIN
                   DestPtr^.ToAddr_F:=Config.NodeNrs[Config.GatewayAKA];
                   DestPtr^.ToAddr_F.Point:=0;

                   IF RFC_Domain2FTN (Copy (HulpUser,Pos ('%',HulpUser)+1,255),Destptr^.ToAddr_F) THEN
                   BEGIN
                        { convert to a destFTN }
                        HulpUser:=Copy (HulpUser,1,Pos ('%',HulpUser)-1);
                        DestPtr^.ToUser_F:=FtnizeUserName (HulpUser);
                        DestPtr^.Status:=destFTN;

                        LogMessage (liTrivial,'Found e-mail for '+Fido2Str (DestPtr^.ToAddr_F)+' ('+DestPtr^.To_U+')');

                        { dest record is kept }
                        Exit; { ## EXIT ## }
                   END;
              END;

              { orphan -> vertaal naar netmail en schrijf daar weg }
              { gating process is delayed until later }

              DestPtr^.ToUser_F:=FtnizeUserName (HulpUser);
              DestPtr^.ToAddr_F:=Config.NodeNrs[Config.GatewayAKA];
              DestPtr^.Status:=destFTN;

              Exit; { met FALSE }
         END; { stap 1 }

         { Stap 2                                                        }
         {                                                               }
         { Probeer of we het doel adres gewoon kennen, in dat geval gaan }
         { we niet moeilijk doen.                                        }

         RecNr:=GetUucpRoute (DestPtr^.To_U);

         IF (RecNr <> NILRecordNr) THEN
         BEGIN
              ReadUserBaseRecord (RecNr,UserRec);

              { Als het doel systeem een RFC systeem is hoeft er niets }
              { te worden omgebouwd.                                   }
              CASE UserRec.System OF
                   _U,
                   _S: BEGIN
                            LogMessage (liTrivial,'Sending e-mail for '+DestPtr^.To_U+' to '+UserRec.UUCPName);

                            DestPtr^.Status:=destRFCUser;
                            DestPtr^.UserRecNr:=RecNr;

                            Exit; { met FALSE }

                            (*
                            Msg.ToSystem_U:=UserData.UUCPName;

                            {$IFDEF WtrTest}
                            LogMessage ('Target: Outgoing Mail');
                            {$ELSE}
                            LogMessage ('DeliverMail: not implemented (1) ** PLEASE REPORT **');
                            StatUsenetSendMail;
                            MsgsExportUsenetMail;
                            {$ENDIF}
                            Exit; { met FALSE?? na aflevering mag ie TRUE worden }
                            *)
                       END;

                   _F : BEGIN
                             { change to FTN }

                             DestPtr^.ToUser_F:=FtnizeUserName (HulpUser);
                             DestPtr^.ToAddr_F:=UserRec.Address;
                             DestPtr^.Status:=destFTNUser;
                             DestPtr^.UserRecNr:=RecNr;

                             { kijk of dit een e-mail aan een point van deze node }
                             { is. Zoja, dan moeten we het point nummer invullen. }
                             IF (UserRec.Address.Point = 0) AND (FindUUCPRoutePoint <> 0) THEN
                             BEGIN
                                  IF Config.LogMapApply THEN
                                     LogMessage (liTrivial,'Found e-mail for point '+Word2String (FindUUCPRoutePoint)+
                                                 ' of node '+Fido2Str (UserRec.Address));

                                  DestPtr^.ToAddr_F.Point:=FindUUCPRoutePoint;
                             END;

                             Exit; { met FALSE }
                        END;

                   ELSE
                       LogMessage (liReport,'GetRfcRoute: user type '+Byte2String (Byte (UserRec.System)));
              END; { case }
         END; { stap 2 }

         LocalDomain:=UpCaseString (HulpDomain);
         FoundTarget:=FALSE;

         FoundOurDomainAtTheEndOfTheAdres:=FALSE;

         { Stap 3                                                         }
         {                                                                }
         { Probeer te bekijken of het bericht mischien aan                }
         { martijn_dijksterhuis@p6.f802.n280.z2.wlink.nl gericht is       }

         FOR AliasTeller:=1 TO MaxSystemDomains DO
             IF OurDomainAtEnd (UpCaseString (Config.Domains[AliasTeller]),LocalDomain) THEN
             BEGIN
                  FoundOurDomainAtTheEndOfTheAdres:=TRUE;

                  { We hebben dus ons domain aan het einde van de string }
                  { gevonden. Probeer er wat van te brouwen.             }
                  { Formaat : p<point>.f<node>.n<net>.z<zone>            }

                  FidoAdresStr:=Copy (LocalDomain,1,(Length (LocalDomain)-Length (Config.Domains[AliasTeller]))-1);

                  DestPtr^.ToAddr_F:=Config.NodeNrs[Config.GatewayAKA];
                  DestPtr^.ToAddr_F.Point:=0;

                  IF RFC_Domain2FTN (FidoAdresStr,DestPtr^.ToAddr_F) THEN
                  BEGIN
                       { Blijkbaar hebben we een echt fido adres gevonden. Stuur }
                       { het bericht naar de gelukkige geadresseerde.            }
                       LogMessage (liTrivial,'Found e-mail for '+Fido2Str (DestPtr^.ToAddr_F)+' ('+DestPtr^.To_U+')');

                       { RAWI 970816: added nodelist look-up }
                       WITH DestPtr^.ToAddr_F DO
                            IF (NodeList_Verify (Zone,Net,Node) = 2) THEN
                            BEGIN
                                 LogMessage (liGeneral,Fido23DStr (DestPtr^.ToAddr_F)+' not found in nodelist(s); bouncing');

                                 RFC_NodelistBounce (DestPtr);

                                 HandleRfcDest:=TRUE; { delete destrecord }
                                 Exit;
                            END;

                       DestPtr^.Status:=destFTN;
                       DestPtr^.ToUser_F:=FtnizeUserName (HulpUser);

                       Exit; { met FALSE }
                  END;
             END; { if, for }

         { Stap 4: RWI 951024
         {
         { Het bericht is niet bestemd voor een van onze bekende systemen,  }
         { maar meteen terug sturen naar de smarthost is niet slim. Als     }
         { het adres aanduid dat het een van onze systeem moet zijn (onder  }
         { ons), dan moet het in ieder geval niet terug gestuurd worden.    }

         { RWI 960713: wat bevat Msg.ToAddr_F nu? Is het mogelijk dat ie niet }
         {             ingevuld is? Kan er een gateway AKA in staan die half  }
         {             overschreven is tijdens het decoderen van z.f.n.p?     }
         {             Ja dus!                                                }

         IF FoundOurDomainAtTheEndOfTheAdres THEN
         BEGIN
              LogMessage (liGeneral,'Found undeliverable mail for '+DestPtr^.To_U);

              CASE Config.BounceUnknown OF
                   0 : BEGIN
                            { write to netmail area }
                            DestPtr^.Status:=destNetHold;
                            DestPtr^.ToUser_F:=FtnizeUserName (HulpUser);
                            DestPtr^.ToAddr_F:=Config.NodeNrs[Config.GatewayAka];

                            Exit; { with FALSE }
                       END;

                   1 : BEGIN
                            { send a bounce mail }
                            LogExtraMessage ('Bouncing message to sender ('+UsenetReplyAdres+')');

                            RFC_Bounce (GetLang0 (102{Domain not found}),DestPtr^.To_U);
                       END;

                   ELSE
                       { 2 and invalid cases }
                       LogMessage (liGeneral,'Deleting message');
              END; { case }

              { cases BounceUnknown = 1 (bounce) or 2 (delete) }
              { -> delete the dest record }

              HandleRfcDest:=TRUE;  { delete destrecord }
              Exit;
         END;

         { Stap - 5                                                          }
         { We zijn er nog steeds, blijkbaar is het bericht niet voor een van }
         { onze bekende systemen bestemd. Stuur het door naar het systeem    }
         { dat aangewezen is als smarthost.                                  }

         IF (Config.SmartHost = '') THEN
         BEGIN
              LogMessage (liConfig,'ERROR: Smart Host not configured');
              LogExtraMessage ('Message will be parked (Hold) in primary netmail area');

              DestPtr^.Status:=destNetHold;
              DestPtr^.ToUser_F:=FtnizeUserName (HulpUser);
              DestPtr^.ToAddr_F:=Config.NodeNrs[Config.GatewayAka];

              Exit; { with FALSE }
         END;

         {## verify this: it uses Sender_U: NOT GOOD! }
         IF CaselessMatch (Msg.Sender_U,Config.SmartHost) THEN
         BEGIN
              LogMessage (liFatal,'Unable to transport e-mail message, originating from smart host');
              RFC_Bounce ('System unknown',DestPtr^.To_U);
              Exit;
         END;

         { find the smarthost }
         (* now done in wtrstart.pas
         IF (SmartHostUserRecNr = 0{not searched yet}) THEN
         BEGIN
              { search for the smarthost }
              SmartHostUserRecNr:=NILRecordNr;
              FindUserBaseRecordByUUCPName (Config.SmartHost,SmartHostUserRecNr);
         END;
         *)

         IF (SmartHostUserRecNr <> NILRecordNr) THEN
         BEGIN
              LogMessage (liTrivial,'Sending e-mail for '+DestPtr^.To_U+' to the smarthost');
              DestPtr^.UserRecNr:=SmartHostUserRecNr;
              DestPtr^.Status:=destRFCUser;
              Exit; { met FALSE }
         END;

         { hier moeten we straks niet meer kunnen komen als we de  }
         { smarthost check bij het opstarted al uitgevoerd hebben. }
         LogMessage (liConfig,'Serious config error! Smarthost not in UserBase!');
         LogExtraMessage ('Dropping msg for '+DestPtr^.To_U);

         HandleRfcDest:=TRUE;  { delete destrecord }
    END; { HandleRfcDest }

{DeliverMail}

VAR ErasePtr,
    FindPtr   : DestRecordPtr;

BEGIN
     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverMail enter');

     { Run 1: check and extrapolate all addresses }

     FindPtr:=Msg.FirstDest;

     WHILE (FindPtr <> NIL) DO
     BEGIN
          IF (FindPtr^.Status = destRFC) THEN
          BEGIN
               MapRFC (FindPtr);  { can change it into a FTN address! }

               IF (FindPtr^.Status = destRFC) THEN
                  IF HandleRfcDest (FindPtr) THEN
                  BEGIN
                       { remove this processed record }
                       ErasePtr:=FindPtr;
                       FindPtr:=FindPtr^.NextDest;

                       RemoveDestRecord (ErasePtr,TRUE);

                       Continue; { with the while, do not go to NextDest }
                  END;
          END;

          FindPtr:=FindPtr^.NextDest;
     END; { while }

     {LogAllDestinations;}

     { Run 2: write all destRFC's to UUCP and SMTP jobs }

     FindPtr:=Msg.FirstDest;

     WHILE (FindPtr <> NIL) DO
     BEGIN
          IF (FindPtr^.Status = destRFCUser) THEN
          BEGIN
               { routine must delete this destination as well }

               { Statistics }
               {## have to replace 0 with message length}
               IF (Msg.DeliveringUserRecNr = NILRecordNr) THEN
                    StatEntry_MailMsg (stdOutbound, UsenetPosterName,
                                        FindPtr^.To_U, Copy (Msg.Subj_U, 9, Length(Msg.Subj_U)), Msg.MsgSize)

               ELSE
                    StatEntry_MailMsg (stdInbound, UsenetPosterName,
                                        FindPtr^.To_U, Copy (Msg.Subj_U, 9, Length(Msg.Subj_U)), Msg.MsgSize);

               DeliverMailToRfcUser (FindPtr^.UserRecNr,FindPtr);
               FindPtr:=Msg.FirstDest;
               Continue; { van voren af aan doorgaan }
          END;

          FindPtr:=FindPtr^.NextDest;
     END; { while }

     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverMail exit');
END;


{==========================================================================}
{                          DELIVER NEWS                                    }
{==========================================================================}


VAR DeliverNews_List   : List;
    FoundBagReturnUser : BYTE; { 0=no attempt, 1=found, 2=not found }
    BagReturnRecordNr  : UserBaseRecordNrType;

{--------------------------------------------------------------------------}
{ DeliverNews_Flush                                                        }
{                                                                          }
PROCEDURE DeliverNews_Flush (VAR Buffer; Count : WORD; Unused : POINTER); FAR;

VAR OutPtr : OutboundRecordPtr;

BEGIN
     OutPtr:=DeliverNews_List.GetFirstItem;
     WHILE (OutPtr <> NIL) DO
     BEGIN
          IF (OutPtr^.OutType = otUUCPNews) THEN
               UucpNewsOut_WriteToBatch (OutPtr,Count,Buffer)
          ELSE
               SoupMailOut_WriteToBatch (OutPtr,Count,Buffer);

          OutPtr:=DeliverNews_List.GetNextItem;
     END;
END;


{--------------------------------------------------------------------------}
{ DeliverNews                                                              }
{                                                                          }
{ This routine is called when DeliverNow finds the message in News state.  }
{ This routine must make sure all recipients that wants to receive the     }
{ message in this format get a copy of it before this routine returns.     }
{ Here we check for a destNews and then deliver the news article to all    }
{ subscribers of the Areas this article is cross-posted in.                }
{                                                                          }
PROCEDURE DeliverNews;

    {-------------------------------------------------------------------}
    { HaveDestNews                                                      }
    {                                                                   }
    { Returns TRUE if a DestRecord with type destNews is present. This  }
    { record is deleted by this routine as well.                        }
    {                                                                   }
    FUNCTION HaveDestNews : BOOLEAN;

    VAR FindPtr : DestRecordPtr;

    BEGIN
         HaveDestNews:=FALSE; { assume we don't find it }

         FindPtr:=Msg.FirstDest;
         WHILE (FindPtr <> NIL) DO
         BEGIN
              IF (FindPtr^.Status = destNews) THEN
              BEGIN
                   { remove the destNews one }
                   RemoveDestRecord (FindPtr,TRUE);
                   HaveDestNews:=TRUE;
                   Exit; { ## EXIT ## }
              END;

              IF (FindPtr^.Status = destNewsArea) THEN
              BEGIN
                   { keep the dest record }
                   HaveDestNews:=TRUE; { change return status }
                   { do not return - keep on searching for destNews }
              END;

              FindPtr:=FindPtr^.NextDest;
         END; { while }

         { if we found a destNewsArea then we will return TRUE }
         { otherwise we return FALSE.                          }
    END;

    {-------------------------------------------------------------------}
    { DistributeNewsInArea                                              }
    {                                                                   }
    PROCEDURE DistributeNewsInArea (AreaRecNr : AreaBaseRecordNrType);

    VAR AreaRec      : AreaBaseRecord;
        Search       : SubscrSearchRecord;
        UserRec      : UserBaseRecord;
        OutPtr       : OutboundRecordPtr;
        Hulp         : STRING[1];
        ListRecNr    : ListUserRecordNrType;
        Lp           : BYTE;
        AlreadyCount : WORD;

    BEGIN
         { Record that we have 'seen' this area }
         Stats_SeenArea (AreaRecNr);

         ReadAreaBaseRecord (AreaRecNr,AreaRec);

         IF Config.LogDebug THEN
            LogMessage (liDebug,'AreaRecNr = '+Word2String (AreaRecNr)+' ('+AreaRec.AreaName_U+')');

         IF (AreaRec.FidoMsgStyle <> NoneType) THEN
         BEGIN
              { gate to echomail for importing }
              Address_AddAreaToAreaRecNrsList (AreaRecNr);
              Address_AddEcho;
         END;

         { check for ListToArea (prevents loops and duplicates) }
         MailingList_AcceptArea (AreaRecNr);

         { Find all users that want a copy and get an OutPtr for each.   }
         { Keep an eye on the "Exported" list as well to prevent sending }
         { an article to a user twice!                                   }
         { Add destRFCRaw for mail2news and destEchomail for FTN users   }
         { and when the area has a message base attached.                }

         DeliverNews_List.Init (0,NIL);
         AlreadyCount:=0;

         IF Msg.DeliveringUserRecNr = NILRecordNr THEN
            StatEntry_NewsMsg (stdOutbound,
                               UsenetPosterName,
                               Copy (Msg.Subj_U, 9, Length(Msg.Subj_U)),
                               AreaRec.AreaName_U,
                               Msg.MsgSize)
         ELSE
             StatEntry_NewsMsg (stdInbound,
                                UsenetPosterName,
                                Copy (Msg.Subj_U, 9, Length(Msg.Subj_U)),
                                AreaRec.AreaName_U,
                                Msg.MsgSize);

         GetFirstUserSubscribedToThisArea (AreaRec.UserList,Search);
         WHILE (Search.Found) DO
         BEGIN
              ReadUserBaseRecord (Search.UserBaseRecordNr,UserRec);

              IF UserRec.Passive THEN
                 Msg.Exported^[Search.UserBaseRecordNr]:=etIsPassive;

              IF (UserRec.System = _B) AND
                 (Msg.Exported^[Search.UserBaseRecordNr] = etReady) THEN
              BEGIN
                   { send via return system }
                   IF (FoundBagReturnUser = 1) THEN
                   BEGIN
                        { record nummer van het return systeem was al }
                        { opgezocht. Lees die gewoon in.              }
                        Search.UserBaseRecordNr:=BagReturnRecordNr;
                        ReadUserBaseRecord (BagReturnRecordNr,UserRec);
                   END ELSE
                       { als we al eens gezocht hebben en niets hebben }
                       { kunnen vinden, dan hoeven we niet nog eens te }
                       { zoeken en loggen we gewoon dat we een bericht }
                       { niet terug konden sturen.                     }
                       IF (FoundBagReturnUser = 0) THEN
                       BEGIN
                            { see if we have to send a copy to the mail2news gateway }
                            IF (Mail2NewsAddress <> '') AND CaselessMatch (UserRec.BagBackLink,'mail2news') THEN
                            BEGIN
                                 IF Config.LogDebug THEN
                                    LogMessage (liTrivial,'Adding mail2news gateway '+Mail2NewsAddress);

                                 Address_AddRFCRaw (Mail2NewsAddress,destTo,FALSE,FALSE);
                                 Address_CheckRFCRaw; { get rid of the raw state at once }

                                 { FoundBagReturnUser remains 0 }
                            END ELSE
                            BEGIN
                                 { zoek het record nummer van het bag return systeem }
                                 { op en sla deze op.                                }
                                 IF FindUserBaseRecordByUUCPName (UserRec.BagBackLink,Search.UserBaseRecordNr) THEN
                                 BEGIN
                                      BagReturnRecordNr:=Search.UserBaseRecordNr;
                                      ReadUserBaseRecord (BagReturnRecordNr,UserRec);
                                      FoundBagReturnUser:=1; { gevonden! }
                                 END ELSE
                                 BEGIN
                                      LogMessage (liConfig,'Cannot find BAG link Return System ('+UserRec.BagBackLink+')!!');
                                      FoundBagReturnUser:=2; { niet gevonden, niet meer zoeken }
                                      { UserRec blijft gewoon het _B systeem, dus }
                                      { het volgende blok wordt niet getriggerd.  }
                                 END;
                            END;
                       END;
              END; { is bag user }

              IF (UserRec.System = _SOUP) THEN
              BEGIN
                   IF (Msg.Exported^[Search.UserBaseRecordNr] = etReady) THEN
                   BEGIN
                        OutPtr:=SoupMailOut_StartOfMessage (True {IsNews}, Search.UserBaseRecordNr);

                        IF (OutPtr <> NIL) THEN
                        BEGIN
                             SoupMailOut_WriteMessageHeader (OutPtr);
                             DeliverNews_List.Add (OutPtr);
                        END;

                        Msg.Exported^[Search.UserBaseRecordNr]:=etHasReceivedMsg;
                   END ELSE
                       Inc (AlreadyCount);
              END;

              IF (UserRec.System = _U) THEN
              BEGIN
                   IF (Msg.Exported^[Search.UserBaseRecordNr] = etReady) THEN
                   BEGIN
                        OutPtr:=UucpNewsOut_StartOfMessage (Search.UserBaseRecordNr);

                        IF (OutPtr <> NIL) THEN
                        BEGIN
                             UucpNewsOut_WriteRNewsHeader (OutPtr);
                             DeliverNews_List.Add (OutPtr);
                        END;

                        Msg.Exported^[Search.UserBaseRecordNr]:=etHasReceivedMsg;
                   END ELSE
                       Inc (AlreadyCount);
              END;

              IF (UserRec.System = _F) THEN
                 Address_AddEcho;  { gate to echomail for distribution to FTN users }

              GetNextUserSubscribedToThisArea (Search);
         END;

         { check if we have any subscribers for this area }
         IF (DeliverNews_List.ItemCount <> 0) THEN
         BEGIN
              IF Config.LogDebug THEN
                 LogMessage (liDebug,Word2String (DeliverNews_List.ItemCount)+' subscribers (news)');

              { 4. Export large pre-packed blocks to all OutPtrs }

              IF PackBuf_Init (DeliverNews_Flush,lttLF,NIL) THEN
              BEGIN
                   MsgsForEach (Msg.HeaderTop_U,PackBuf_AddLine);

                   {## Change to add Lines: header first here }

                   { add empty line }
                   Hulp:=#13;
                   PackBuf_AddLine (Hulp);

                   { add the body }
                   FOR Lp:=1 TO MAX_BODY_PARTS DO
                       MsgsForEach (Msg.BodyParts[Lp],PackBuf_AddLine);

                   { flush the last bytes }
                   PackBuf_Done;
              END;

              { 5. Close for all OutPtrs so large batches can be compressed }

              OutPtr:=DeliverNews_List.GetFirstItem;
              WHILE (OutPtr <> NIL) DO
              BEGIN
                   IF (OutPtr^.OutType = otUUCPNews) THEN
                        UucpNewsOut_EndOfMessage (OutPtr)
                   ELSE
                        SoupMailOut_EndOfMessage (OutPtr);

                   OutPtr:=DeliverNews_List.GetNextItem;
              END;

              { 6. Clean up }

              DeliverNews_List.Clear;
         END ELSE
             LogMessage (liDebug,'No subscribers (news)');

         IF (AlreadyCount > 0) THEN
              LogMessage (liDebug,Word2String (AlreadyCount)+' subscribers already received a copy (news)');
    END;

{DeliverNews}

VAR Lp      : BYTE;
    FindPtr : DestRecordPtr;

BEGIN
     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverNews enter');

     { check for destNews existance }
     IF (NOT HaveDestNews) THEN
     BEGIN
          IF Config.LogDebug THEN
             LogMessage (liDebug,'destNews/destNewsArea not found; exiting DeliverNews');
          Exit;
     END;

{$IFNDEF WtrTest}
     { all the newsgroup names have already been extracted }

     { distribute in each of the areas }
     FOR Lp:=1 TO MAX_AREA_CROSS_POSTS DO
         IF (Msg.AreaRecNrs[Lp] <> NILRecordNr) THEN
            DistributeNewsInArea (Msg.AreaRecNrs[Lp]);

     { check for DestRecords met status destNewsArea }
     { (these are Copy filters or ListToArea distributions }
     FindPtr:=Msg.FirstDest;
     WHILE (FindPtr <> NIL) DO
     BEGIN
          IF (FindPtr^.Status = destNewsArea) THEN
          BEGIN
               IF FindPtr^.AddNote THEN
                  Deliver_AddNote (destNewsArea);

               {## seems to take the last x-posted area's MSGID here!\}
               DistributeNewsInArea (FindPtr^.AreaRecNr);

               IF FindPtr^.AddNote THEN
                  Deliver_RemoveNote;

               RemoveDestRecord (FindPtr,TRUE);
               FindPtr:=NIL; { stop the while loop }
          END ELSE
              FindPtr:=FindPtr^.NextDest;
     END; { while }

{$ENDIF (!WtrTest)}

     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverNews exit');
END;


{==========================================================================}
{                    FTN DELIVER SUPPORT FUNCTIONS                         }
{==========================================================================}


{--------------------------------------------------------------------------}
{ CalcPktSenderAddress                                                     }
{                                                                          }
{ This routine decides on our address to use the in the PKT header. This   }
{ is used by both the netmail and echomail PKT export routines.            }
{                                                                          }
PROCEDURE CalcPktSenderAddress (VAR Addr : FidoAddrType; UserRecNr : UserBaseRecordNrType);

VAR UserRec  : UserBaseRecord;
    FoundAKA : BYTE;
    Dummy    : FidoAddrType;

BEGIN
     ReadUserBaseRecord (UserRecNr,UserRec);

     IF (UserRec.System = _BBS) THEN
     BEGIN
          Addr.Zone:=UserRec.FakeZone;
          Addr.Net:=UserRec.FakeNet;
          Addr.Node:=UserRec.FakeNode;
          Addr.Point:=0;
          Addr.Domain:='';
          Exit;
     END;

     IF (UserRec.System <> _F) THEN
     BEGIN
          LogMessage (liReport,'CalcPktSenderAddress: Unexpected situation!');
          Exit;
     END;

     { check what is set in the record and do the automatic decision }
     FoundAKA:=UserRec.ExportAKA;
     IF (FoundAKA = 0{automatic}) THEN
        FoundAKA:=FidoMatchAdres (UserRec.Address,Dummy);

     Addr:=Config.NodeNrs[FoundAka];

     { check whether we have to use a pointnet address }
     {## should we not check the destination address instead?? }
     IF (Config.PointNets[FoundAKA] > 0) AND
        (Config.NodeNrs[FoundAKA].Point > 0) THEN
     BEGIN
          { modify to pointnet address }
          Addr.Net:=Config.PointNets[FoundAKA];
          Addr.Node:=Addr.Point;
          Addr.Point:=0;
     END;
END;


{--------------------------------------------------------------------------}
{ EstimateSplitParts                                                       }
{                                                                          }
{ This routine is used by both the netmail and echomail PKT file export    }
{ routine to calculate the number of split parts for a message.            }
{                                                                          }
PROCEDURE EstimateSplitParts (VAR SplitParts : WORD; VAR SplitBodyLen : LONGINT; ToUser_F : STRING);

VAR HeaderLen,
    BodyLen      : LONGINT;
    SplitParts_R : REAL;
    Lp           : 1..MAX_BODY_PARTS;

BEGIN
     SplitParts:=0;
     SplitBodyLen:=MAXLONGINT;

     IF (Config.MaxFidoMsgLen = 0) THEN
        Exit; { no need to split }

     HeaderLen:=0;
     BodyLen:=0;

     IF (Msg.HeaderTop_F <> NIL) THEN
        Inc (HeaderLen,Msg.HeaderTop_F^.TotalRegelLength);

     IF (Msg.FooterTop_F <> NIL) THEN
        Inc (HeaderLen,Msg.FooterTop_F^.TotalRegelLength);

     IF (Msg.CopiedHeadersTop_F <> NIL) THEN
        Inc (HeaderLen,Msg.CopiedHeadersTop_F^.TotalRegelLength);

     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.BodyParts[Lp] <> NIL) THEN
            Inc (BodyLen,Msg.BodyParts[Lp]^.TotalRegelLength);

     { since we don't know the exact length of the follow parameters, }
     { we have to be a bit conservative. This could result in split   }
     { parts that could have been a few bytes longer and sometimes    }
     { one split part less, but that's better as having more split    }
     { parts as estimated.                                            }
     SplitBodyLen:=Config.MaxFidoMsgLen-
                   SizeOf (FidoPktMsgHdrAdres)-
                   Length (ToUser_F)-
                   Length (Msg.FromUser_F)-
                   Length (Msg.Date_F)-
                   4-                   { #0's }
                   Length (Msg.Subj_F)-
                   6-                   { "(1/9) " }   { err: 0-4 }
                   HeaderLen-
                   64-                  { SPLIT kludge }
                   25-                  { avg. #INTL } { err: 0-16 }
                   8-                   { avg. FMPT }  { err: 0-4 }
                   8-                   { avg. TOPT }  { err: 0-4 }
                   200;                 { conservativeness compensation }

     { prevent too small split parts }
     IF (SplitBodyLen < 1024) THEN
     BEGIN
          LogMessage (liConfig,'Too small split parts for *.PKT export, limiting to 1Kb');
          SplitBodyLen:=1024;
     END;

     SplitParts_R:=(BodyLen / SplitBodyLen);

     SplitParts:=Trunc (SplitParts_R);
     IF (SplitParts < SplitParts_R) THEN
        Inc (SplitParts);
END;


{==========================================================================}
{                            DELIVER ECHOMAIL                              }
{==========================================================================}


VAR DeliverEchomail_List         : List;
    DeliverEchomail_ReplaceMsgID : BOOLEAN;
    DeliverEchomail_AreaRec      : AreaBaseRecord;
    DeliverEchomail_UserRec      : UserBaseRecord;
    DeliverEchomail_BbsMode      : BOOLEAN;

{--------------------------------------------------------------------------}
{ DeliverEchomail_Flush                                                    }
{                                                                          }
PROCEDURE DeliverEchomail_Flush (VAR Buffer; Count : WORD; Unused : POINTER); FAR;

VAR OutPtr : OutboundRecordPtr;

BEGIN
     OutPtr:=DeliverEchomail_List.GetFirstItem;
     WHILE (OutPtr <> NIL) DO
     BEGIN
          FtnEchoOut_WriteToPkt (OutPtr,Count,Buffer);
          OutPtr:=DeliverEchomail_List.GetNextItem;
     END;
END;


{--------------------------------------------------------------------------}
{ DeliverEchomail_AddHeaderLine                                            }
{                                                                          }
{ This routine is called for each line in a Header_F for netmail and       }
{ echomail and searches for the MSGID kludge and replaces it for each      }
{ split part.                                                              }
{ note: do not modify Regel!!                                              }
{                                                                          }
FUNCTION DeliverEchomail_AddHeaderLine (VAR Regel : STRING) : BOOLEAN; FAR;

VAR Temp : STRING;

BEGIN
     Temp:=TransFix_HeaderLine (Regel);

     IF (DeliverEchomail_ReplaceMsgID) THEN
     BEGIN
        { when this flag is set we are either into the second or more }
        { split-part of a message or dealing with a cross-posted      }
        { message.  In either case, we must replace the MSGID         }
        IF CaselessStartMatch (Temp, #1'MSGID: ') THEN
        BEGIN
           { Remove old 8-digit hex number + col }
           Temp := Copy (Temp, 1, Length (Temp)-9);

           { add a new one }
           Temp := Temp + GetFidoPktName + #13;
        END;
     END;

     DeliverEchomail_AddHeaderLine:=PackBuf_AddLine (Temp);
END;


{--------------------------------------------------------------------------}
{ DeliverEchomail_AddFooterLine                                            }
{                                                                          }
{ This routine is called for each line in a Footer_F for echomail and      }
{ searches for items that need some work before they can be used, like the }
{ Origin and the SEEN-BY and PATH replacement for the BBS user.            }
{ Note: do not modify Regel!!                                              }
{                                                                          }
FUNCTION DeliverEchomail_AddFooterLine (VAR Regel : STRING) : BOOLEAN; FAR;

VAR Temp : STRING;

BEGIN
     IF DeliverEchomail_BbsMode THEN
     BEGIN
          IF DeliverEchomail_UserRec.KeepSBP THEN
          BEGIN
               { they want to keep the SEEN-BY and PATH lines }
               { we promised to insert a SEEN-BY line with the fake aka  }
               { so we monitor for a PATH line and insert it just before }
               { that.                                                   }
               { we always use the info from the DeliverEchomail_UserRec }
               { but that information is static during the footer        }
               { writing, so each system gets the same footer and the    }
               { same fake aka. Since we do a separate export for the    }
               { BBS interfaces this will work, but not when two BBS i/f }
               { must get the same message. That is simply not supported.}

               IF (Copy (Regel,1,7) = #1'PATH: ') THEN
               BEGIN
                    { insert the SEEN-BY line with a fake AKA }
                    WITH DeliverEchomail_UserRec DO
                         Temp:='SEEN-BY: '+Word2String (FakeNet)+'/'+
                                           Word2String (FakeNode)+#13;
                    PackBuf_AddLine (Temp);
               END;
          END ELSE
          BEGIN
               { do not keep the SEEN-BY and PATH lines }
               { detect and destroy }
               IF (Copy (Regel,1,8) = 'SEEN-BY:') OR
                  (Copy (Regel,1,7) = #1'PATH: ')
               THEN
                   Exit; { ignore this line }
          END;
     END; { if BBS user }

     Temp:=TransFix_FooterLine (Regel); { takes care of Origin line }

     DeliverEchomail_AddFooterLine:=PackBuf_AddLine (Temp);
END;


VAR DeliverEchomail_SplitParts   : WORD;
    DeliverEchomail_SplitBodyLen : LONGINT;
    DeliverEchomail_MsgId        : STRING;

{--------------------------------------------------------------------------}
{ DeliverEchomail_PKT                                                      }
{                                                                          }
{ This routine is called from DeliverEchomail to deliver the message to    }
{ all FTN users with the packet type set to PKT.                           }
{ It returns a byte with bit 0 set if a P2K subscriber was found and bit 1 }
{ set if a BBS user was found.                                             }
{                                                                          }
FUNCTION DeliverEchomail_PKT : BYTE;

VAR RestFound      : BYTE;
    PktMsgHeader   : FidoPktMsgHdrAdres;
    Search         : SubscrSearchRecord;
    PktSenderAdres : FidoAddrType;
    OutPtr         : OutboundRecordPtr;
    PosRec         : ForEach_PosRecord;
    SplitCurrent   : WORD;
    SubjectLine    : STRING[MaxLenSubj_F]; { 71: ex. #0 }
    Temp           : STRING;
    AllDone        : BOOLEAN;
    OtherCount     : WORD;
    UserRecNr      : UserBaseRecordNrType;

BEGIN
     RestFound:=0;

     { build a list of subscribers in DeliverEchomailList }
     DeliverEchomail_List.Clear;
     OtherCount:=0;

     { prepare the PKT message header }
     FillChar (PktMsgHeader,SizeOf (FidoPktMsgHdrAdres),0);
     WITH PktMsgHeader DO
     BEGIN
          TypeIdent:=2;  { standard Fido Type 2 }

          IF (Msg.FromAddr_F.Domain <> #1#2#3) THEN
          BEGIN
               OrigNode:=Msg.FromAddr_F.Node;
               OrigNet:=Msg.FromAddr_F.Net;
          END ELSE
          BEGIN
               OrigNode:=Config.NodeNrs[DeliverEchomail_AreaRec.OriginAka].Node;
               OrigNet:=Config.NodeNrs[DeliverEchomail_AreaRec.OriginAka].Net;
          END;

          { fill in DestNet/DestNode for each }
          { destination we export to.         }
          { bullshit for echomail, really..  (it's to All) }

          { From FTS-0001.015: bits 0,1,4,10,12,13,14 }
          { must NOT be set to 0; the rest has to     }
          {   $7413 = 0111 0100 0001 0011             }
          {   BitNr   5432 1098 7654 3210             }
          {           1111 11                         }

          AttrFlag:=Msg.Attr_F AND $7413;

          Cost:=Msg.Cost_F;
     END; { with }

     GetFirstUserSubscribedToThisArea (DeliverEchomail_AreaRec.UserList,Search);
     WHILE (Search.Found) DO
     BEGIN
          ReadUserBaseRecord (Search.UserBaseRecordNr,DeliverEchomail_UserRec);

          IF (DeliverEchomail_UserRec.System = _F) AND DeliverEchomail_UserRec.Passive THEN
             Msg.Exported^[Search.UserBaseRecordNr]:=etIsPassive;

          { note: do NOT set Exported for an FTN users or they }
          {       won't get a copy in each area the message is }
          {       cross-posted in!                             }
          IF (Msg.Exported^[Search.UserBaseRecordNr] = etReady) THEN
             CASE DeliverEchomail_UserRec.System OF
                  _F :
                      IF (DeliverEchomail_UserRec.PktFormat = fptPkt2000) THEN
                      BEGIN
                           RestFound:=RestFound OR 1;
                           Inc (OtherCount);
                      END ELSE
                      BEGIN
                           CalcPktSenderAddress (PktSenderAdres,Search.UserBaseRecordNr);

                             { Update statistics }

                           OutPtr:=FtnEchoOut_StartOfMessage (Search.UserBaseRecordNr,PktSenderAdres);
                           IF (OutPtr <> NIL) THEN
                              DeliverEchomail_List.Add (OutPtr);
                      END; { _F }

                  _BBS :
                      BEGIN
                           RestFound:=RestFound OR 2;
                           Inc (OtherCount);
                      END;

                  ELSE
                      RestFound:=RestFound OR 4;

             END; { case,if }

          GetNextUserSubscribedToThisArea (Search);
     END;

     DeliverEchomail_PKT:=RestFound;

     LogMessage (liDebug,Word2String (DeliverEchomail_List.ItemCount+OtherCount)+
                              ' subscribers (echomail)');

     { check if we have any subscribers for this area }
     IF (DeliverEchomail_List.ItemCount = 0) THEN
        Exit;                                           { ## EXIT ## }

     TransFix_Load (DeliverEchomail_AreaRec,DeliverEchomail_MsgId);

     { distribute in this area }
     MsgsLimited_Init (PosRec,{IncludeAttachments}TRUE);

     SplitCurrent:=0;
     REPEAT
           Inc (SplitCurrent);

           { write the PKT header for each of the users }

           OutPtr:=DeliverEchoMail_List.GetFirstItem;
           WHILE (OutPtr <> NIL) DO
           BEGIN
                ReadUserBaseRecord (OutPtr^.UserRecNr,DeliverEchomail_UserRec);

                WITH PktMsgHeader DO
                BEGIN
                     DestNode:=DeliverEchomail_UserRec.Address.Node;
                     DestNet:=DeliverEchomail_UserRec.Address.Net;

                     { RWI 960304: Squish node level security }
                     OrigNode:=PktSenderAdres.Node;
                     OrigNet:=PktSenderAdres.Net;
                END; { with }

                { write binary message header }
                FtnEchoOut_WriteToPkt (OutPtr,SizeOf (FidoPktMsgHdrAdres),PktMsgHeader);

                UpdateInfoNr (INFO_PktOut_Echo,1);

                OutPtr:=DeliverEchomail_List.GetNextItem;
           END; { while }

           { build the subject line }
           SubjectLine:=FtnSubj_RemovePaths (Msg.Subj_F,Msg.Attr_F AND MSGFILE);

           { if this is a split part message, then add the (n/m) }
           { indicator at the start of the message.              }
           IF (DeliverEchomail_SplitParts > 1) THEN
              SubjectLine:='('+Word2String (SplitCurrent)+
                           '/'+Word2String (DeliverEchomail_SplitParts)+
                           ') '+SubjectLine;

           { write date, from, to and subj (split number indication) }
           Temp:=Msg.Date_F+#0+
                 Msg.ToUser_F+#0+
                 Msg.FromUser_F+#0+
                 SubjectLine+#0;

           DeliverEchomail_Flush (Temp[1],Length (Temp),NIL);

           IF PackBuf_Init (DeliverEchomail_Flush,lttCR,NIL) THEN
           BEGIN
                PackBuf_ReplaceNul ('!');

                { write AREA kludge }
                Temp:='AREA:'+DeleteFrontAndBackSpaces (DeliverEchomail_AreaRec.AreaName_F)+#13;
                PackBuf_AddLine (Temp);

                {## XPOST kludge? }

                { add the rest of the kludges }
                {## not used yet!}
                DeliverEchomail_ReplaceMsgID:=(SplitCurrent > 1) OR
                                              (Msg.AreaRecNrs[2] <> NILRecordNr); { crossposted }

                MsgsForEach (Msg.HeaderTop_F,DeliverEchomail_AddHeaderLine);
                MsgsForEach (Msg.CopiedHeadersTop_F,DeliverEchomail_AddHeaderLine);

                { write SPLIT kludge }
                IF (DeliverEchomail_SplitParts > 1) THEN
                BEGIN
                     Temp:=FidoCreateSplitLine (SplitCurrent,DeliverEchomail_SplitParts)+#13;
                     PackBuf_AddLine (Temp);
                END;

                { write body }
                AllDone:=MsgsLimited_ForEach (PosRec,DeliverEchomail_SplitBodyLen,PackBuf_AddLine);

                {## cannot guarantee empty line before tear line! }

                { write footer }
                DeliverEchomail_BbsMode:=FALSE;
                MsgsForEach (Msg.FooterTop_F,DeliverEchomail_AddFooterLine);

                PackBuf_Done;
           END ELSE
               AllDone:=TRUE;

           { call EndOfMessage for each subscriber }
           OutPtr:=DeliverEchoMail_List.GetFirstItem;
           WHILE (OutPtr <> NIL) DO
           BEGIN
                { save the user record number }
                UserRecNr:=OutPtr^.UserRecNr;

                { close the message. This can also close the file, }
                { in which case OutPtr becomes invalid.            }
                FtnEchoOut_EndOfMessage (OutPtr);

                { start the next message if this was not the last part }
                IF (SplitCurrent < DeliverEchomail_SplitParts{can be 0}) THEN
                BEGIN
                     CalcPktSenderAddress (PktSenderAdres,UserRecNr{the saved one});
                     OutPtr:=FtnEchoOut_StartOfMessage (UserRecNr{the saved one},PktSenderAdres);

                     { update the pointer stored in the list }
                     DeliverEchomail_List.Replace (OutPtr);
                END;

                OutPtr:=DeliverEchomail_List.GetNextItem;
           END; { while }

     UNTIL AllDone;

     DeliverEchomail_List.Clear;
END;


VAR DEP2K_ExtraFields : WORD;
    DEP2K_REPLY,
    DEP2K_MSGID       : STRING;

{--------------------------------------------------------------------------}
{ DEP2K_WantKludge                                                         }
{                                                                          }
{ This function is used by both DEP2K_CountKludes/WriteKludges to check    }
{ whether a kludges should be included or not. Returns FALSE if it should  }
{ be left out.                                                             }
{                                                                          }
FUNCTION DEP2K_WantKludge (VAR Regel : STRING) : BOOLEAN;
BEGIN
     DEP2K_WantKludge:=FALSE; { assume not }

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

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

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

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

     IF (Copy (Regel,1,7) = #1'CHRS: ') THEN
        Exit;

     IF (Copy (Regel,1,5) = #1'SOT ') THEN
        Exit;

     IF (Copy (Regel,1,5) = #1'EOT ') THEN
        Exit;

     IF (Copy (Regel,1,6) = #1'FLAGS') THEN
        Exit;

     IF (Copy (Regel,1,5) = #1'INTL') THEN
        Exit;

     IF (Copy (Regel,1,5) = #1'TOPT') THEN
        Exit;

     IF (Copy (Regel,1,5) = #1'FMPT') THEN
        Exit;

     DEP2K_WantKludge:=TRUE; { we want it alright }
END;


{--------------------------------------------------------------------------}
{ DEP2K_FindAndCountHeaders                                                }
{                                                                          }
{ This routine searches for the REPLY and MSGID kludges and stores them in }
{ the DEP2K_REPLY/MSGID variables. It also calls TransFix on the fly to    }
{ allow for MSGID replacement / completion.                                }
{ In the same run this functions evaluates and counts all 'wanted' kludges }
{ for the ExtraFields later on.                                            }
{                                                                          }
FUNCTION DEP2K_FindAndCountHeaders (VAR OrigRegel : STRING) : BOOLEAN; FAR;
BEGIN
     DEP2K_FindAndCountHeaders:=FALSE; { do not abort }

     IF (Copy (OrigRegel,1,8) = #1'REPLY: ') THEN
     BEGIN
          DEP2K_REPLY:=Copy (TransFix_HeaderLine (OrigRegel),9,255);
          Delete (DEP2K_REPLY,Length (DEP2K_REPLY),1); { remove #13 }
     END;

     IF (Copy (OrigRegel,1,8) = #1'MSGID: ') THEN
     BEGIN
          DEP2K_MSGID:=Copy (TransFix_HeaderLine (OrigRegel),9,255);
          Delete (DEP2K_MSGID,Length (DEP2K_MSGID),1); { remove #13 }
     END;

     IF DEP2K_WantKludge (OrigRegel) THEN
        Inc (DEP2K_ExtraFields);
END;


{--------------------------------------------------------------------------}
{ DEP2K_WriteKludges                                                       }
{                                                                          }
{ This routine is used to write the 'ExtraFields' of the P2K file.         }
{                                                                          }
FUNCTION DEP2K_WriteKludges (VAR Regel : STRING) : BOOLEAN; FAR;

VAR L : BYTE;

BEGIN
     DEP2K_WriteKludges:=FALSE; { do not abort }

     IF DEP2K_WantKludge (Regel) THEN
     BEGIN
          L:=Length (Regel)-2; { minus #1 and #13 }
          PackBuf_AddRaw (L,1);
          PackBuf_AddRaw (Regel[2],L);
     END;
END;


VAR DEP2K_SB_Count,
    DEP2K_PATH_Count : WORD;

{--------------------------------------------------------------------------}
{ DEP2K_WriteSBandPATH                                                     }
{                                                                          }
{ This routine scans the Footer_F for SEEN-BY and PATH lines and writes    }
{ out a NetworkAddress record to the PKT2000 file. For each address found  }
{ the DEP2K_SB/PATH_Count is increased. These are copied into the PKT2000  }
{ header when it is updated at the end of the message.                     }
{                                                                          }
FUNCTION DEP2K_WriteSBandPATH (VAR OrigRegel : STRING) : BOOLEAN; FAR;

VAR LastNet : WORD;

    PROCEDURE BuildAndWriteNetAddr (Part : STRING);

    VAR NetAddr : Pkt2000Address;
        P       : BYTE;
        Nop     : ValNop;

    BEGIN
         P:=Pos ('/',Part);
         IF (P > 0) THEN
         BEGIN
              Val (Copy (Part,1,P-1),LastNet,Nop);
              Delete (Part,1,P);
         END;

         Val (Part,NetAddr.Node,Nop);

         NetAddr.Zone:=Msg.FromAddr_F.Zone; {## Check: use Msg.SBP_Zone instead?}
         NetAddr.Net:=LastNet;
         NetAddr.Point:=0;

         PackBuf_AddRaw (NetAddr,SizeOf (Pkt2000Address));
    END;

VAR Regel : STRING;
    P     : BYTE;

BEGIN
     DEP2K_WriteSBandPATH:=FALSE; { do not abort }

     IF (Copy (OrigRegel,1,9) = 'SEEN-BY: ') THEN
     BEGIN
          Regel:=DeleteFrontSpaces (Copy (OrigRegel,9,255))+' ';
          LastNet:=0;

          WHILE (Regel <> '') DO
          BEGIN
               P:=Pos (' ',Regel);
               BuildAndWriteNetAddr (Copy (Regel,1,P-1));
               Inc (DEP2K_SB_Count);
               Delete (Regel,1,P);
          END;
     END;

     IF (Copy (OrigRegel,1,7) = #1'PATH: ') THEN
     BEGIN
          Regel:=DeleteFrontSpaces (Copy (OrigRegel,7,255))+' ';
          LastNet:=0;

          WHILE (Regel <> '') DO
          BEGIN
               P:=Pos (' ',Regel);
               BuildAndWriteNetAddr (Copy (Regel,1,P-1));
               Inc (DEP2K_PATH_Count);
               Delete (Regel,1,P);
          END;
     END;
END;


{--------------------------------------------------------------------------}
{ DEP2K_AddFooterLine                                                      }
{                                                                          }
{ This routine is called for each line in a Footer_F for echomail and      }
{ searches for items that need some work before they can be used, like the }
{ Origin. It also strips the SEEN-BY and PATH because these are already    }
{ stored binary in the header.                                             }
{ Note: do not modify Regel!!                                              }
{                                                                          }
FUNCTION DEP2K_AddFooterLine (VAR Regel : STRING) : BOOLEAN; FAR;

VAR Temp : STRING;

BEGIN
     IF (Copy (Regel,1,7) = #1'PATH: ') OR
        (Copy (Regel,1,9) = 'SEEN-BY: ') THEN
     BEGIN
          DEP2K_AddFooterLine:=FALSE; { keep on calling us }
          Exit; { ## EXIT ## }
     END;

     Temp:=TransFix_FooterLine (Regel); { takes care of Origin line }

     DEP2K_AddFooterLine:=PackBuf_AddLine (Temp);
END;


{--------------------------------------------------------------------------}
{ DeliverEchomail_P2K                                                      }
{                                                                          }
{ This routine is called from DeliverEchomail to write the current message }
{ to all FTN users with the packet type set to PKT2000 (P2K).              }
{                                                                          }
PROCEDURE DeliverEchomail_P2K;

VAR P2kMsgHeader   : Pkt2000MsgHeader;
    P2kMsgHeader2  : Pkt2000MsgHeader2;
    Search         : SubscrSearchRecord;
    PktSenderAdres : FidoAddrType;
    OutPtr         : OutboundRecordPtr;
    PosRec         : ForEach_PosRecord;
    SplitCurrent   : WORD;
    SubjectLine    : STRING[MaxLenSubj_F]; { 71: ex. #0 }
    Temp           : STRING;
    AllDone        : BOOLEAN;

BEGIN
     { build a list of subscribers in DeliverEchomailList }
     DeliverEchomail_List.Clear;

     FillChar (P2kMsgHeader,SizeOf (Pkt2000MsgHeader),0);
     FillChar (P2kMsgHeader2,SizeOf (Pkt2000MsgHeader2),0);

     WITH P2kMsgHeader DO
     BEGIN
          Id[1]:='P';
          Id[2]:='2';
          Id[3]:='K';
     END; { with }

     P2kMsgHeader2.CharSet:=Msg.Chrs_F;

     {
     not supported yet:
     DestAddr    : Pkt2000Address;
     TimeZone    : STRING[5];

     filled in afterwards:
     SeenBys     : WORD;
     Paths       : WORD;
     TextBytes   : LONGINT;
     }

     WITH P2kMsgHeader.OrigAddr DO
     BEGIN
          Zone:=Msg.FromAddr_F.Zone;
          Net:=Msg.FromAddr_F.Net;
          Node:=Msg.FromAddr_F.Node;
          Point:=Msg.FromAddr_F.Point;

          {##todo
          WrittenAddr
          }
     END; { with }

     FidoDate2Pkt2000 (Msg.Date_F,P2kMsgHeader);
     FidoAttr2Pkt2000 (Msg.Attr_F,Msg.ExtAttr_F,P2kMsgHeader);

     GetFirstUserSubscribedToThisArea (DeliverEchomail_AreaRec.UserList,Search);
     WHILE (Search.Found) DO
     BEGIN
          ReadUserBaseRecord (Search.UserBaseRecordNr,DeliverEchomail_UserRec);

          IF (DeliverEchomail_UserRec.System = _F) AND DeliverEchomail_UserRec.Passive THEN
             Msg.Exported^[Search.UserBaseRecordNr]:=etIsPassive;

          { note: do NOT set Exported for an FTN users or they }
          {       won't get a copy in each area the message is }
          {       cross-posted in!                             }
          IF (Msg.Exported^[Search.UserBaseRecordNr] = etReady) AND
             (DeliverEchomail_UserRec.System = _F) AND
             (DeliverEchomail_UserRec.PktFormat = fptPkt2000) THEN
          BEGIN
               {## used for...??}
               CalcPktSenderAddress (PktSenderAdres,Search.UserBaseRecordNr);


               OutPtr:=FtnEchoOut_StartOfMessage (Search.UserBaseRecordNr,PktSenderAdres);
               IF (OutPtr <> NIL) THEN
               BEGIN
                    DeliverEchomail_List.Add (OutPtr);

                    WITH P2kMsgHeader,DeliverEchomail_UserRec DO
                    BEGIN
                         DestAddr.Zone:=Address.Zone;
                         DestAddr.Net:=Address.Net;
                         DestAddr.Node:=Address.Node;
                         DestAddr.Point:=Address.Point;
                    END; { with }

                    { write binary message header }
                    FtnEchoOut_WriteToPkt (OutPtr,SizeOf (Pkt2000MsgHeader),P2kMsgHeader);
                    Outbound_StoreP2KOffset (OutPtr);
                    FtnEchoOut_WriteToPkt (OutPtr,SizeOf (Pkt2000MsgHeader2),P2kMsgHeader2);

                    UpdateInfoNr (INFO_PktOut_Echo,1);
               END; { if }
          END; { _F and PKT2000 }

          GetNextUserSubscribedToThisArea (Search);
     END; { while }

     { check if we have any PKT2000 subscribers for this area }
     IF (DeliverEchomail_List.ItemCount = 0) THEN
        Exit;                                         { ## EXIT ## }

     TransFix_Load (DeliverEchomail_AreaRec,DeliverEchomail_MsgId);

     { distribute in this area }
     MsgsLimited_Init (PosRec,{IncludeAttachments}TRUE);

     SplitCurrent:=0;
     REPEAT
           IF PackBuf_Init (DeliverEchomail_Flush,lttCR,NIL) THEN
           BEGIN
                Inc (SplitCurrent);

                { build the subject line }
                SubjectLine:=FtnSubj_RemovePaths (Msg.Subj_F,Msg.Attr_F AND MSGFILE);

                { if this is a split part message, then add the (n/m) }
                { indicator at the start of the message.              }
                IF (DeliverEchomail_SplitParts > 1) THEN
                   SubjectLine:='('+Word2String (SplitCurrent)+
                                '/'+Word2String (DeliverEchomail_SplitParts)+
                                ') '+SubjectLine;

                {## not used yet!}
                DeliverEchomail_ReplaceMsgID:=(SplitCurrent > 1) OR
                                              (Msg.AreaRecNrs[2] <> NILRecordNr); { crossposted }

                { now write the following strings (only the used bytes): }
                {  ReplyTo,MsgId,From,To,Subj,Area,Organization          }

                DEP2K_ExtraFields:=0;
                IF (DeliverEchomail_SplitParts > 1) THEN
                   Inc (DEP2K_ExtraFields); { for the SPLIT header }

                { find the REPLY and MSGID kludges }
                DEP2K_REPLY:='';
                DEP2K_MSGID:='';
                {## update for copied headers - kludges only? }
                MsgsForEach (Msg.HeaderTop_F,DEP2K_FindAndCountHeaders);

                PackBuf_AddRaw (DEP2K_REPLY[0],Length (DEP2K_REPLY)+1);
                PackBuf_AddRaw (DEP2K_MSGID[0],Length (DEP2K_MSGID)+1);
                PackBuf_AddRaw (Msg.FromUser_F[0],Length (Msg.FromUser_F)+1);
                PackBuf_AddRaw (Msg.ToUser_F[0],Length (Msg.ToUser_F)+1);
                PackBuf_AddRaw (SubjectLine[0],Length (SubjectLine)+1);
                PackBuf_AddRaw (DeliverEchomail_AreaRec.AreaName_F[0],
                                Length (DeleteFrontAndBackSpaces (DeliverEchomail_AreaRec.AreaName_F))+1);
                { add an empty Organization field }
                Temp:='';
                PackBuf_AddRaw (Temp[0],1);

                { now write the number of kludges we will write to disk, }
                { followed by the contents of the kludges without #1 and }
                { only the bytes of the string that are actually used.   }
                {  ExtraFields      : Word                               }
                {    |- Followed by [0..ExtraFields] Of Open String Type }
                {## update for copied headers }
                PackBuf_AddRaw (DEP2K_ExtraFields,2);
                MsgsForEach (Msg.HeaderTop_F,DEP2K_WriteKludges);

                { write SPLIT kludge }
                IF (DeliverEchomail_SplitParts > 1) THEN
                BEGIN
                     Temp:=FidoCreateSplitLine (SplitCurrent,DeliverEchomail_SplitParts);
                     PackBuf_AddRaw (Temp[0],Length (Temp));
                END;

                {## XPOST kludge? }

                { write SEEN-BY and PATH block }
                DEP2K_SB_Count:=0;
                DEP2K_PATH_Count:=0;
                MsgsForEach (Msg.FooterTop_F,DEP2K_WriteSBandPATH);

                PackBuf_GetAndResetCounter;

                { write body }
                AllDone:=MsgsLimited_ForEach (PosRec,DeliverEchomail_SplitBodyLen,PackBuf_AddLine);

                { verify #13#13 before tear-line }

                { write footer }
                MsgsForEach (Msg.FooterTop_F,DEP2K_AddFooterLine);

                P2kMsgHeader2.SeenBys:=DEP2K_SB_Count;
                P2kMsgHeader2.Paths:=DEP2K_PATH_Count;
                P2kMsgHeader2.TextBytes:=PackBuf_GetAndResetCounter;

                PackBuf_Done;
           END ELSE
               { PackBuf_Init failed }
               AllDone:=TRUE;

           { update the Pkt2000 message header and }
           { call EndOfMessage for each subscriber }
           OutPtr:=DeliverEchoMail_List.GetFirstItem;
           WHILE (OutPtr <> NIL) DO
           BEGIN
                Outbound_UpdateP2KHeader (OutPtr,SizeOf (Pkt2000MsgHeader2),P2kMsgHeader2);
                FtnEchoOut_EndOfMessage (OutPtr);

                { if we have multiple split parts, then we have to write }
                { a new Pkt2000 message header.                          }
                IF (DeliverEchomail_SplitParts > 1) THEN
                BEGIN
                     ReadUserBaseRecord (OutPtr^.UserRecNr,DeliverEchomail_UserRec);
                     CalcPktSenderAddress (PktSenderAdres,Search.UserBaseRecordNr);

                     OutPtr:=FtnEchoOut_StartOfMessage (Search.UserBaseRecordNr,PktSenderAdres);
                     DeliverEchomail_List.Replace (OutPtr); { can be replaced! }
                     IF (OutPtr <> NIL) THEN
                     BEGIN
                          WITH P2kMsgHeader,DeliverEchomail_UserRec DO
                          BEGIN
                               DestAddr.Zone:=Address.Zone;
                               DestAddr.Net:=Address.Net;
                               DestAddr.Node:=Address.Node;
                               DestAddr.Point:=Address.Point;
                          END; { with }

                          { write binary message header }
                          FtnEchoOut_WriteToPkt (OutPtr,SizeOf (Pkt2000MsgHeader),P2kMsgHeader);
                          Outbound_StoreP2KOffset (OutPtr);
                          FtnEchoOut_WriteToPkt (OutPtr,SizeOf (Pkt2000MsgHeader2),P2kMsgHeader2);

                          UpdateInfoNr (INFO_PktOut_Echo,1);
                     END; { if }
                END;

                OutPtr:=DeliverEchomail_List.GetNextItem;
           END; { while }

     UNTIL AllDone;

     DeliverEchomail_List.Clear;
END;


{--------------------------------------------------------------------------}
{ DeliverEchomail_BBSif                                                    }
{                                                                          }
{ This routine is called from DeliverEchomail when a BBS Interface Link    }
{ was found subscribed to the area this message is currently distributed   }
{ in. This routine creates the PKT file with the special changes for the   }
{ BBS Interface.                                                           }
{                                                                          }
PROCEDURE DeliverEchomail_BBSif;

VAR PktMsgHeader   : FidoPktMsgHdrAdres;
    Search         : SubscrSearchRecord;
    PktSenderAdres : FidoAddrType;
    OutPtr         : OutboundRecordPtr;
    PosRec         : ForEach_PosRecord;
    SplitCurrent   : WORD;
    SubjectLine    : STRING[MaxLenSubj_F]; { 71: ex. #0 }
    Temp           : STRING;
    AllDone        : BOOLEAN;

BEGIN
     { build a list of subscribers in DeliverEchomail_List }
     { note: there _can_ be multiple BBS Interfaces        }
     DeliverEchomail_List.Clear;

     { prepare the PKT message header }
     FillChar (PktMsgHeader,SizeOf (FidoPktMsgHdrAdres),0);
     WITH PktMsgHeader DO
     BEGIN
          TypeIdent:=2;  { standard Fido Type 2 }

          IF (Msg.FromAddr_F.Domain <> #1#2#3) THEN
          BEGIN
               OrigNode:=Msg.FromAddr_F.Node;
               OrigNet:=Msg.FromAddr_F.Net;
          END ELSE
          BEGIN
               OrigNode:=Config.NodeNrs[DeliverEchomail_AreaRec.OriginAka].Node;
               OrigNet:=Config.NodeNrs[DeliverEchomail_AreaRec.OriginAka].Net;
          END;

          { fill in DestNet/DestNode for each }
          { destination we export to.         }
          { bullshit for echomail, really..  (it's to All) }

          { From FTS-0001.015: bits 0,1,4,10,12,13,14 }
          { must NOT be set to 0; the rest has to     }
          {   $7413 = 0111 0100 0001 0011             }
          {   BitNr   5432 1098 7654 3210             }
          {           1111 11                         }

          AttrFlag:=Msg.Attr_F AND $7413;

          Cost:=Msg.Cost_F;
     END; { with }

     GetFirstUserSubscribedToThisArea (DeliverEchomail_AreaRec.UserList,Search);
     WHILE (Search.Found) DO
     BEGIN
          ReadUserBaseRecord (Search.UserBaseRecordNr,DeliverEchomail_UserRec);

          IF (DeliverEchomail_UserRec.System = _F) AND DeliverEchomail_UserRec.Passive THEN
             Msg.Exported^[Search.UserBaseRecordNr]:=etIsPassive;

          { note: do NOT set Exported for an FTN users or they }
          {       won't get a copy in each area the message is }
          {       cross-posted in!                             }
          IF (Msg.Exported^[Search.UserBaseRecordNr] = etReady) AND
             (DeliverEchomail_UserRec.System = _BBS) THEN
          BEGIN
               CalcPktSenderAddress (PktSenderAdres,Search.UserBaseRecordNr);

               OutPtr:=FtnEchoOut_StartOfMessage (Search.UserBaseRecordNr,PktSenderAdres);
               IF (OutPtr <> NIL) THEN
               BEGIN
                    DeliverEchomail_List.Add (OutPtr);

                    { zet de destination in de message header }
                    {## is this right? It seems to change the from/to aka?!!}
                    WITH PktMsgHeader DO
                    BEGIN
                         { bullshit for echomail, really }
                         DestNode:=Config.NodeNrs[DeliverEchomail_UserRec.SystemAka].Node;
                         DestNet:=Config.NodeNrs[DeliverEchomail_UserRec.SystemAka].Net;

                         { RWI 960304: Squish node level security }
                         OrigNode:=DeliverEchomail_UserRec.FakeNode;
                         OrigNet:=DeliverEchomail_UserRec.FakeNet;
                    END; { with }

                    { write binary message header }
                    FtnEchoOut_WriteToPkt (OutPtr,SizeOf (FidoPktMsgHdrAdres),PktMsgHeader);
                    UpdateInfoNr (INFO_PktOut_Echo,1);
               END; { if }

          END; { _BBS }

          GetNextUserSubscribedToThisArea (Search);
     END;

     { check if we have any subscribers for this area }
     IF (DeliverEchomail_List.ItemCount = 0) THEN
        Exit;                                    { ## EXIT ## }

     { half-fix: load the BBS Interface record for the first system }
     { we do not support two systems for one messages.              }
     OutPtr:=DeliverEchoMail_List.GetFirstItem;
     ReadUserBaseRecord (OutPtr^.UserRecNr,DeliverEchomail_UserRec);


     TransFix_Load (DeliverEchomail_AreaRec,DeliverEchomail_MsgId);

     { distribute in this area }
     MsgsLimited_Init (PosRec,{IncludeAttachments}TRUE);

     SplitCurrent:=0;
     REPEAT
           Inc (SplitCurrent);

           { build the subject line }
           SubjectLine:=FtnSubj_RemovePaths (Msg.Subj_F,Msg.Attr_F AND MSGFILE);

           { if this is a split part message, then add the (n/m) }
           { indicator at the start of the message.              }
           IF (DeliverEchomail_SplitParts > 1) THEN
              SubjectLine:='('+Word2String (SplitCurrent)+
                           '/'+Word2String (DeliverEchomail_SplitParts)+
                           ') '+SubjectLine;

           { PKT files }

           { write date, from, to and subj (split number indication) }
           Temp:=Msg.Date_F+#0+
                 Msg.ToUser_F+#0+
                 Msg.FromUser_F+#0+
                 SubjectLine+#0;

           DeliverEchomail_Flush (Temp[1],Length (Temp),NIL);

           IF PackBuf_Init (DeliverEchomail_Flush,lttCR,NIL) THEN
           BEGIN
                PackBuf_ReplaceNul ('!');

                { write AREA kludge }
                Temp:='AREA:'+DeleteFrontAndBackSpaces (DeliverEchomail_AreaRec.AreaName_F)+#13;
                PackBuf_AddLine (Temp);

                {## XPOST kludge? }

                { add the rest of the kludges }
                {## not used yet!}
                DeliverEchomail_ReplaceMsgID:=(SplitCurrent > 1) OR
                                              (Msg.AreaRecNrs[2] <> NILRecordNr); { crossposted }

                MsgsForEach (Msg.HeaderTop_F,DeliverEchomail_AddHeaderLine);
                MsgsForEach (Msg.CopiedHeadersTop_F,DeliverEchomail_AddHeaderLine);

                { write SPLIT kludge }
                IF (DeliverEchomail_SplitParts > 1) THEN
                BEGIN
                     Temp:=FidoCreateSplitLine (SplitCurrent,DeliverEchomail_SplitParts)+#13;
                     PackBuf_AddLine (Temp);
                END;

                { write body }
                AllDone:=MsgsLimited_ForEach (PosRec,DeliverEchomail_SplitBodyLen,PackBuf_AddLine);

                { verify #13#13 before tear-line }

                { write footer }
                {## is DeliverEchomail_UserRec loaded, or are we just }
                {## lucky to have something left after the checks above? }
                { in BbsMode the DeliverEchomail_UserRec must be valid   }
                { during calls to DeliverEchomail_AddFooterLine. We need }
                { it below as well.                                      }
                { We simply assume that it is still loaded - thereby     }
                { only supporting one BBS Interface per distributed      }
                { message. There can still be two interfaces, but for    }
                { different zones and messages.                          }
                DeliverEchomail_BbsMode:=TRUE;
                MsgsForEach (Msg.FooterTop_F,DeliverEchomail_AddFooterLine);

                {## is DeliverEchomail_UserRec loaded, or are we just }
                {## lucky to have something left after the checks above? }
                IF (NOT DeliverEchomail_UserRec.KeepSBP) THEN
                   WITH DeliverEchomail_UserRec DO
                   BEGIN
                        { all SEEN-BY and PATH lines have been }
                        { stripped, so we have to add new ones here }

                        Temp:='SEEN-BY: '+
                              Word2String (FakeNet)+
                              '/'+Word2String (FakeNode)+
                              ' '+Word2String (Config.NodeNrs[SystemAka].Net)+
                              '/'+Word2String (Config.NodeNrs[SystemAka].Node)+
                              #13;

                        PackBuf_AddLine (Temp);

                        Temp:=#1+'PATH: '+
                              Word2String (FakeNet)+
                              '/'+Word2String (FakeNode)+
                              #13;

                        PackBuf_AddLine (Temp);
                   END; { with, if }

                PackBuf_Done;
           END ELSE
               AllDone:=TRUE;

           { call EndOfMessage for each subscriber }
           OutPtr:=DeliverEchoMail_List.GetFirstItem;
           WHILE (OutPtr <> NIL) DO
           BEGIN
                FtnEchoOut_EndOfMessage (OutPtr);
                OutPtr:=DeliverEchomail_List.GetNextItem;
           END;

     UNTIL AllDone;

     DeliverEchomail_List.Clear;
END;


{--------------------------------------------------------------------------}
{ DeliverEchomail                                                          }
{                                                                          }
{ This routine is called when the internal message has the EchoMail status }
{ and here we have to distribute it to everybody subscribed, plus possible }
{ connected area. If a mailing list is connected to the area, then the     }
{ message will be distributed via the mailing list as well.                }
{                                                                          }
PROCEDURE DeliverEchomail;

    {----------------------------------------------------------------------}
    { HaveDestEchomail                                                     }
    {                                                                      }
    { Returns TRUE if a DestRecord with type destEchomail is present.      }
    { This record is deleted by this routine as well.                      }
    {                                                                      }
    FUNCTION HaveDestEchomail : BOOLEAN;

    VAR FindPtr : DestRecordPtr;

    BEGIN
         HaveDestEchomail:=FALSE; { assume we don't find it }

         FindPtr:=Msg.FirstDest;
         WHILE (FindPtr <> NIL) DO
         BEGIN
              IF (FindPtr^.Status = destEchomail) THEN
              BEGIN
                   { remove the destEchomail one }
                   RemoveDestRecord (FindPtr,TRUE);

                   HaveDestEchomail:=TRUE;
                   Exit; { ## EXIT ## }
              END;

              IF (FindPtr^.Status = destEchoArea) THEN
              BEGIN
                   HaveDestEchomail:=TRUE;

                   { keep the dest record }

                   { avoid Address_AddEcho from adding echomail destination }
                   { again when we have translated to news because of a     }
                   { filter.                                                }
                   Msg.AddedEcho:=TRUE;

                   { do not return - keep on searching for destEchomail }
              END;

              FindPtr:=FindPtr^.NextDest;
         END; { while }

         { if we found a destEchoArea then we will return TRUE }
         { otherwise we return FALSE.                          }
    END;

    {----------------------------------------------------------------------}
    { DistributeEchoInArea                                                 }
    {                                                                      }
    PROCEDURE DistributeEchoInArea (AreaRecNr : AreaBaseRecordNrType);

    VAR Rest : BYTE;

    BEGIN
         { Record that we have 'seen' this area }
         Stats_SeenArea (AreaRecNr);

         { make sure the Local flag is cleared }
         Msg.Attr_F:=Msg.Attr_F AND (NOT MSGLOCAL);

         ReadAreaBaseRecord (AreaRecNr,DeliverEchomail_AreaRec);

         LogMessage (liDebug,'AreaRecNr = '+Word2String (AreaRecNr)+' ('+DeliverEchomail_AreaRec.AreaName_F+')');

         SBP_ReplaceSeenBysAndPath (DeliverEchomail_AreaRec);

         { check for ListToArea (prevents loops and duplicates) }
         MailingList_AcceptArea (AreaRecNr);

         { import, if needed }
         {$IFNDEF WtrTest}
         {IF (Msg.DeliveringUserRecNr <> NILRecordNr{System Sends: thus exported) AND}
         IF (Msg.ExportAreaRecNr <> AreaRecNr) AND
            (NOT ForceNoImport) THEN
         BEGIN
              ImportEchomail (DeliverEchomail_AreaRec,DeliverEchomail_MsgId);
         END;
         {$ENDIF (!WtrTest)}

         IF Msg.DeliveringUserRecNr = NILRecordNr THEN
              StatEntry_EchoMsg (stdOutbound, Msg.FromUser_F, Msg.FromAddr_F,
                         Msg.ToUser_F, Msg.Subj_F, DeliverEchomail_AreaRec.AreaName_F, Msg.MsgSize)
          ELSE
              StatEntry_EchoMsg (stdInbound, Msg.FromUser_F, Msg.FromAddr_F,
                         Msg.ToUser_F, Msg.Subj_F, DeliverEchomail_AreaRec.AreaName_F, Msg.MsgSize);

         { export to the three media: PKT, P2K and BBS Interface }
         Rest:=DeliverEchomail_PKT;

         IF ((Rest AND 1) <> 0) THEN
            DeliverEchomail_P2K;

         IF ((Rest AND 2) <> 0) THEN
            DeliverEchomail_BBSif;

         IF ((Rest AND 4) <> 0) THEN
         BEGIN
              { not _F or _BBS, thus _UUCP or (future) _BAG }
              Address_AddAreaToAreaRecNrsList (AreaRecNr);
              Address_AddNews;
         END;
    END;

    {----------------------------------------------------------------------}
    { HaveDestEchoArea                                                     }
    {                                                                      }
    { This routine checks whether a destEchoArea definition is present for }
    { the given AreaRecNr. If so, the message must not be distributed in   }
    { this area, to prevent duplicates. This happens when the mailing list }
    { adds destNewsArea and destEchoArea and during DeliverNews a destEcho }
    { is added to get the message imported into the message base. There    }
    { might be other situations and we check for this here.                }
    { This might give strange effects where the real echomail is not       }
    { distributed in an area, but a copied message because of a filter is  }
    { distributed, but has a Note in front.                                }
    {                                                                      }
    FUNCTION HaveDestEchoArea (AreaRecNr : AreaBaseRecordNrType) : BOOLEAN;

    VAR FindPtr : DestRecordPtr;

    BEGIN
         FindPtr:=Msg.FirstDest;
         WHILE (FindPtr <> NIL) DO
         BEGIN
              IF (FindPtr^.Status = destEchoArea) AND
                 (FindPtr^.AreaRecNr = AreaRecNr) THEN
              BEGIN
                   {$IFDEF Pre}
                   IF Config.LogDebug THEN
                      LogMessage (liDebug,'Suppressing for area '+Word2String (AreaRecNr)+' because of CopyToArea');
                   {$ENDIF}
                   HaveDestEchoArea:=TRUE;
                   Exit;
              END;

              FindPtr:=FindPtr^.NextDest;
         END; { while }

         HaveDestEchoArea:=FALSE;
    END;

{DeliverEchomail}

VAR Lp        : BYTE;
    FindPtr   : DestRecordPtr;

BEGIN
     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverEchomail enter');

     IF (NOT HaveDestEchomail) THEN
     BEGIN
          IF Config.LogDebug THEN
             LogMessage (liDebug,'destEchomail/destEchoArea not found; exiting DeliverEchomail');
          Exit;
     END;

{$IFNDEF WtrTest}
     { calculate split parts }
     IF (Msg.FirstDest <> NIL) THEN
        EstimateSplitParts (DeliverEchomail_SplitParts,DeliverEchomail_SplitBodyLen,Msg.FirstDest^.ToUser_F)
     ELSE
         EstimateSplitParts (DeliverEchomail_SplitParts,DeliverEchomail_SplitBodyLen,'');

     { deliver in each of the areas it is cross-posted in! }
     FOR Lp:=1 TO MAX_AREA_CROSS_POSTS DO
         IF (Msg.AreaRecNrs[Lp] <> NILRecordNr) THEN
         BEGIN
              { fix the MSGID for this area }
              IF (Msg.AreaMsgIds[Lp] = '') THEN
                 Msg.AreaMsgIds[Lp]:=GetFidoPktName;

              DeliverEchomail_MsgId:=Msg.AreaMsgIds[Lp];

              IF (NOT HaveDestEchoArea (Msg.AreaRecNrs[Lp])) THEN
                 DistributeEchoInArea (Msg.AreaRecNrs[Lp]);
         END;

     { check for DestRecords met status destEchoArea }
     FindPtr:=Msg.FirstDest;
     WHILE (FindPtr <> NIL) DO
     BEGIN
          IF (FindPtr^.Status = destEchoArea) THEN
          BEGIN
               IF FindPtr^.AddNote THEN
                  Deliver_AddNote (destEchoArea);

               {## seems to take the first x-posted area's MSGID here, if any!!}
               DeliverEchomail_MsgId:=Msg.AreaMsgIds[1];
               DistributeEchoInArea (FindPtr^.AreaRecNr);

               IF FindPtr^.AddNote THEN
                  Deliver_RemoveNote;

               RemoveDestRecord (FindPtr,TRUE);
               FindPtr:=NIL; { stop the while loop }
          END ELSE
              FindPtr:=FindPtr^.NextDest;
     END; { while }

     DeliverEchomail_List.Clear; { just in case }

{$ENDIF (!WtrTest)}

     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverEchomail exit');
END;


{==========================================================================}
{                     DELIVER ECHOMAIL for RESCAN                          }
{==========================================================================}


{--------------------------------------------------------------------------}
{ DeliverEchomail_Rescan_PKT                                               }
{                                                                          }
{ This routine writes the rescanned message to a PKT file.                 }
{                                                                          }
PROCEDURE DeliverEchomail_Rescan_PKT (UserRecNr : UserBaseRecordNrType);

VAR PktMsgHeader   : FidoPktMsgHdrAdres;
    PktSenderAdres : FidoAddrType;
    OutPtr         : OutboundRecordPtr;
    PosRec         : ForEach_PosRecord;
    SplitCurrent   : WORD;
    SubjectLine    : STRING[MaxLenSubj_F]; { 71: ex. #0 }
    Temp           : STRING;
    AllDone        : BOOLEAN;

BEGIN
     { prepare the PKT message header }
     FillChar (PktMsgHeader,SizeOf (FidoPktMsgHdrAdres),0);
     WITH PktMsgHeader DO
     BEGIN
          TypeIdent:=2;  { standard Fido Type 2 }

          { RWI 960304: Squish node level security }
          OrigNode:=PktSenderAdres.Node;
          OrigNet:=PktSenderAdres.Net;

          { fill in DestNet/DestNode for each destination we export to }
          { bullshit for echomail, really..  (it's to All) }
          DestNode:=DeliverEchomail_UserRec.Address.Node;
          DestNet:=DeliverEchomail_UserRec.Address.Net;

          { From FTS-0001.015: bits 0,1,4,10,12,13,14 }
          { must NOT be set to 0; the rest has to     }
          {   $7413 = 0111 0100 0001 0011             }
          {   BitNr   5432 1098 7654 3210             }
          {           1111 11                         }

          AttrFlag:=Msg.Attr_F AND $7413;

          Cost:=Msg.Cost_F;
     END; { with }

     CalcPktSenderAddress (PktSenderAdres,UserRecNr);

     TransFix_Load (DeliverEchomail_AreaRec,DeliverEchomail_MsgId);

     { distribute in this area }
     MsgsLimited_Init (PosRec,{IncludeAttachments}TRUE);

     SplitCurrent:=0;
     REPEAT
           OutPtr:=FtnEchoOut_StartOfMessage (UserRecNr,PktSenderAdres);
           IF (OutPtr = NIL) THEN
           BEGIN
                LogMessage (liFatal,'Failed to create job; aborting export');
                Exit;
           END;

           DeliverEchomail_List.Clear;
           DeliverEchomail_List.Add (OutPtr);

           Inc (SplitCurrent);

           { write binary message header }
           FtnEchoOut_WriteToPkt (OutPtr,SizeOf (FidoPktMsgHdrAdres),PktMsgHeader);

           UpdateInfoNr (INFO_PktOut_Echo,1);

           { build the subject line }
           SubjectLine:=FtnSubj_RemovePaths (Msg.Subj_F,Msg.Attr_F AND MSGFILE);

           { if this is a split part message, then add the (n/m) }
           { indicator at the start of the message.              }
           IF (DeliverEchomail_SplitParts > 1) THEN
              SubjectLine:='('+Word2String (SplitCurrent)+
                           '/'+Word2String (DeliverEchomail_SplitParts)+
                           ') '+SubjectLine;

           { write date, from, to and subj (split number indication) }
           Temp:=Msg.Date_F+#0+
                 Msg.ToUser_F+#0+
                 Msg.FromUser_F+#0+
                 SubjectLine+#0;

           DeliverEchomail_Flush (Temp[1],Length (Temp),NIL);

           IF PackBuf_Init (DeliverEchomail_Flush,lttCR,NIL) THEN
           BEGIN
                PackBuf_ReplaceNul ('!');

                { write AREA kludge }
                Temp:='AREA:'+DeleteFrontAndBackSpaces (DeliverEchomail_AreaRec.AreaName_F)+#13;
                PackBuf_AddLine (Temp);

                {## XPOST kludge? }

                { add the rest of the kludges }
                {## not used yet!}
                DeliverEchomail_ReplaceMsgID:=(SplitCurrent > 1);

                MsgsForEach (Msg.HeaderTop_F,DeliverEchomail_AddHeaderLine);
                MsgsForEach (Msg.CopiedHeadersTop_F,DeliverEchomail_AddHeaderLine);

                { write SPLIT kludge }
                IF (DeliverEchomail_SplitParts > 1) THEN
                BEGIN
                     Temp:=FidoCreateSplitLine (SplitCurrent,DeliverEchomail_SplitParts)+#13;
                     PackBuf_AddLine (Temp);
                END;

                { write body }
                AllDone:=MsgsLimited_ForEach (PosRec,DeliverEchomail_SplitBodyLen,PackBuf_AddLine);

                { verify #13#13 before tear-line }

                { write footer }
                DeliverEchomail_BbsMode:=FALSE;
                MsgsForEach (Msg.FooterTop_F,DeliverEchomail_AddFooterLine);

                PackBuf_Done;
           END ELSE
               AllDone:=TRUE;

           { close the message. This can also close the file, }
           { in which case OutPtr becomes invalid.            }
           FtnEchoOut_EndOfMessage (OutPtr);

     UNTIL AllDone;

     DeliverEchomail_List.Clear;
END;


{--------------------------------------------------------------------------}
{ DeliverEchomail_Rescan_P2K                                               }
{                                                                          }
{ This routine writes the rescanned message to a PKT2000 file.             }
{                                                                          }
PROCEDURE DeliverEchomail_Rescan_P2K (UserRecNr : UserBaseRecordNrType);

VAR P2kMsgHeader   : Pkt2000MsgHeader;
    P2kMsgHeader2  : Pkt2000MsgHeader2;
    PktSenderAdres : FidoAddrType;
    OutPtr         : OutboundRecordPtr;
    PosRec         : ForEach_PosRecord;
    SplitCurrent   : WORD;
    SubjectLine    : STRING[MaxLenSubj_F]; { 71: ex. #0 }
    Temp           : STRING;
    AllDone        : BOOLEAN;

BEGIN
     FillChar (P2kMsgHeader,SizeOf (Pkt2000MsgHeader),0);
     FillChar (P2kMsgHeader2,SizeOf (Pkt2000MsgHeader2),0);

     WITH P2kMsgHeader DO
     BEGIN
          Id[1]:='P';
          Id[2]:='2';
          Id[3]:='K';
     END; { with }

     P2kMsgHeader2.CharSet:=Msg.Chrs_F;

     {
     not supported yet:
     DestAddr    : Pkt2000Address;
     TimeZone    : STRING[5];

     filled in afterwards:
     SeenBys     : WORD;
     Paths       : WORD;
     TextBytes   : LONGINT;
     }

     WITH P2kMsgHeader.OrigAddr DO
     BEGIN
          Zone:=Msg.FromAddr_F.Zone;
          Net:=Msg.FromAddr_F.Net;
          Node:=Msg.FromAddr_F.Node;
          Point:=Msg.FromAddr_F.Point;

          {##todo
          WrittenAddr
          }
     END; { with }

     FidoDate2Pkt2000 (Msg.Date_F,P2kMsgHeader);
     FidoAttr2Pkt2000 (Msg.Attr_F,Msg.ExtAttr_F,P2kMsgHeader);

     {DeliverEchomail_UserRec is already loaded}

     TransFix_Load (DeliverEchomail_AreaRec,DeliverEchomail_MsgId);

     { distribute in this area }
     MsgsLimited_Init (PosRec,{IncludeAttachments}TRUE);

     SplitCurrent:=0;
     REPEAT
           {## used for...??}
           CalcPktSenderAddress (PktSenderAdres,UserRecNr);

           DeliverEchomail_List.Clear;

           OutPtr:=FtnEchoOut_StartOfMessage (UserRecNr,PktSenderAdres);
           IF (OutPtr = NIL) THEN
           BEGIN
                LogMessage (liFatal,'Failed to write message to P2K file; aborting export');
                Exit;     { ## EXIT ## }
           END;

           { needed for Packbuf_Flush }
           DeliverEchomail_List.Add (OutPtr);

           WITH P2kMsgHeader,DeliverEchomail_UserRec DO
           BEGIN
                DestAddr.Zone:=Address.Zone;
                DestAddr.Net:=Address.Net;
                DestAddr.Node:=Address.Node;
                DestAddr.Point:=Address.Point;
           END; { with }

           { write binary message header }
           FtnEchoOut_WriteToPkt (OutPtr,SizeOf (Pkt2000MsgHeader),P2kMsgHeader);
           Outbound_StoreP2KOffset (OutPtr);
           FtnEchoOut_WriteToPkt (OutPtr,SizeOf (Pkt2000MsgHeader2),P2kMsgHeader2);

           UpdateInfoNr (INFO_PktOut_Echo,1);

           IF PackBuf_Init (DeliverEchomail_Flush,lttCR,NIL) THEN
           BEGIN
                Inc (SplitCurrent);

                { build the subject line }
                SubjectLine:=FtnSubj_RemovePaths (Msg.Subj_F,Msg.Attr_F AND MSGFILE);

                { if this is a split part message, then add the (n/m) }
                { indicator at the start of the message.              }
                IF (DeliverEchomail_SplitParts > 1) THEN
                   SubjectLine:='('+Word2String (SplitCurrent)+
                                '/'+Word2String (DeliverEchomail_SplitParts)+
                                ') '+SubjectLine;

                {## not used yet!}
                DeliverEchomail_ReplaceMsgID:=(SplitCurrent > 1) OR
                                              (Msg.AreaRecNrs[2] <> NILRecordNr); { crossposted }

                { now write the following strings (only the used bytes): }
                {  ReplyTo,MsgId,From,To,Subj,Area,Organization          }

                DEP2K_ExtraFields:=0;
                IF (DeliverEchomail_SplitParts > 1) THEN
                   Inc (DEP2K_ExtraFields); { for the SPLIT header }

                { find the REPLY and MSGID kludges }
                DEP2K_REPLY:='';
                DEP2K_MSGID:='';
                {## update for CopiedHeadersTop}
                MsgsForEach (Msg.HeaderTop_F,DEP2K_FindAndCountHeaders);

                PackBuf_AddRaw (DEP2K_REPLY[0],Length (DEP2K_REPLY)+1);
                PackBuf_AddRaw (DEP2K_MSGID[0],Length (DEP2K_MSGID)+1);
                PackBuf_AddRaw (Msg.FromUser_F[0],Length (Msg.FromUser_F)+1);
                PackBuf_AddRaw (Msg.ToUser_F[0],Length (Msg.ToUser_F)+1);
                PackBuf_AddRaw (SubjectLine[0],Length (SubjectLine)+1);
                PackBuf_AddRaw (DeliverEchomail_AreaRec.AreaName_F[0],
                                Length (DeleteFrontAndBackSpaces (DeliverEchomail_AreaRec.AreaName_F))+1);
                { add an empty Organization field }
                Temp:='';
                PackBuf_AddRaw (Temp[0],1);

                { now write the number of kludges we will write to disk, }
                { followed by the contents of the kludges without #1 and }
                { only the bytes of the string that are actually used.   }
                {  ExtraFields      : Word                               }
                {    |- Followed by [0..ExtraFields] Of Open String Type }
                PackBuf_AddRaw (DEP2K_ExtraFields,2);
                {## update for CopiedHeadersTop}
                MsgsForEach (Msg.HeaderTop_F,DEP2K_WriteKludges);

                { write SPLIT kludge }
                IF (DeliverEchomail_SplitParts > 1) THEN
                BEGIN
                     Temp:=FidoCreateSplitLine (SplitCurrent,DeliverEchomail_SplitParts);
                     PackBuf_AddRaw (Temp[0],Length (Temp));
                END;

                {## XPOST kludge? }

                { write SEEN-BY and PATH block }
                DEP2K_SB_Count:=0;
                DEP2K_PATH_Count:=0;
                MsgsForEach (Msg.FooterTop_F,DEP2K_WriteSBandPATH);

                PackBuf_GetAndResetCounter;

                { write body }
                AllDone:=MsgsLimited_ForEach (PosRec,DeliverEchomail_SplitBodyLen,PackBuf_AddLine);

                { verify #13#13 before tear-line }

                { write footer }
                MsgsForEach (Msg.FooterTop_F,DEP2K_AddFooterLine);

                P2kMsgHeader2.SeenBys:=DEP2K_SB_Count;
                P2kMsgHeader2.Paths:=DEP2K_PATH_Count;
                P2kMsgHeader2.TextBytes:=PackBuf_GetAndResetCounter;

                PackBuf_Done;
           END ELSE
               { PackBuf_Init failed }
               AllDone:=TRUE;

           { update the Pkt2000 message header and call EndOfMessage }
           Outbound_UpdateP2KHeader (OutPtr,SizeOf (Pkt2000MsgHeader2),P2kMsgHeader2);
           FtnEchoOut_EndOfMessage (OutPtr);

     UNTIL AllDone;

     DeliverEchomail_List.Clear;
END;


{--------------------------------------------------------------------------}
{ DeliverEchomail_Rescan                                                   }
{                                                                          }
{ This routine writes the echomail message in internal memory to the       }
{ outbound job for the given user, in the given area.                      }
{                                                                          }
PROCEDURE DeliverEchomail_Rescan (UserRecNr : UserBaseRecordNrType;
                                  VAR AreaRec : AreaBaseRecord);
BEGIN
     {--- preparation otherwise done in DeliverEchomail ---}

     EstimateSplitParts (DeliverEchomail_SplitParts,DeliverEchomail_SplitBodyLen,'');

     IF (Msg.AreaMsgIds[1] = '') THEN
        Msg.AreaMsgIds[1]:=GetFidoPktName;

     DeliverEchomail_MsgId:=Msg.AreaMsgIds[1];
     DeliverEchomail_AreaRec:=AreaRec;

     ReadUserBaseRecord (UserRecNr,DeliverEchomail_UserRec);

     IF (DeliverEchomail_UserRec.System <> _F) THEN
     BEGIN
          LogMessage (liFatal,'Invalid user type; stopping export');
          Exit;
     END;

     SBP_ReplaceSeenBysAndPath (DeliverEchomail_AreaRec);

     IF (DeliverEchomail_UserRec.PktFormat = fptPkt) THEN
        DeliverEchomail_Rescan_PKT (UserRecNr)
     ELSE
         DeliverEchomail_Rescan_P2K (UserRecNr);
END;


{==========================================================================}
{##                        DELIVER NETMAIL                                 }
{==========================================================================}


{--------------------------------------------------------------------------}
{ DeliverNetmail_Flush                                                     }
{                                                                          }
{ This routine is called when the PackBuf unit has filled a block with     }
{ message lines.                                                           }
{                                                                          }
PROCEDURE DeliverNetmail_Flush (VAR Buffer; Count: WORD; APtr : POINTER); FAR;
BEGIN
     {LogMessage ('DeliverNetmail_Flush: '+Word2String (Count)+' bytes');}
     FtnNetOut_WriteToPkt (OutboundRecordPtr (APtr),Count,Buffer)
END;


{--------------------------------------------------------------------------}
{ DeliverNetmail_AddHeaderLine                                             }
{                                                                          }
{ This routine is called for each line in a Header_F for netmail and       }
{ searches for the MSGID kludge and replaces it for each split part.       }
{ note: do not modify Regel!!                                              }
{                                                                          }
VAR DeliverNetmail_ReplaceMsgID : BOOLEAN;

FUNCTION DeliverNetmail_AddHeaderLine (VAR Regel : STRING) : BOOLEAN; FAR;

VAR Temp : STRING;

BEGIN
     { search MSGID header }
     IF DeliverNetmail_ReplaceMsgID AND (Copy (Regel,1,8) = #1'MSGID: ') THEN
     BEGIN
          Temp:=Copy (Regel,1,Length (Regel)-9)+GetFidoPktName+#13;
          DeliverNetmail_AddHeaderLine:=PackBuf_AddLine (Temp);
     END ELSE
         DeliverNetmail_AddHeaderLine:=PackBuf_AddLine (Regel);
END;


{--------------------------------------------------------------------------}
{ DeliverNetmailToFtnUser                                                  }
{                                                                          }
{ This routine is called from DeliverNetmail to write a copy of this       }
{ netmail to the .PKT file for the given DestPtr. Only this DestPtr has to }
{ be handled, since a netmail can only be address to one person at a time. }
{                                                                          }
PROCEDURE DeliverNetmailToFtnUser (DestPtr : DestRecordPtr);

VAR OutPtr         : OutboundRecordPtr;
    PktSenderAdres : FidoAddrType;

    { for binary header writing }
    MsgHeader      : FidoPktMsgHdrAdres;
    Temp           : STRING;
    SubjectLine    : STRING[MaxLenSubj_F]; { 71, ex #0 }
    TempAddr       : FidoAddrType;

    { for split part handling }
    SplitBodyLen   : LONGINT;
    SplitCurrent,
    SplitParts     : WORD;
    PosRec         : ForEach_PosRecord;
    AllDone        : BOOLEAN;

    UserRec        : UserBaseRecord;

BEGIN
     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverMailToFtnUser to UserRecNr '+Word2String (DestPtr^.UserRecNr)+' begin');

{$IFNDEF WtrTest}
     ReadUserBaseRecord (DestPtr^.UserRecNr,UserRec);
     IF (FidoOurAdres (Msg.FromAddr_F)) THEN
          StatEntry_NetMsg (stdOutbound, Msg.FromUser_F, Msg.FromAddr_F, DestPtr^.ToUser_F, UserRec.Address, Msg.Subj_F,
                              Msg.MsgSize)
     ELSE
          StatEntry_NetMsg (stdInbound, Msg.FromUser_F, Msg.FromAddr_F, DestPtr^.ToUser_F, UserRec.Address, Msg.Subj_F,
                              Msg.MsgSize);

     { decide the PktSenderAdres }
     CalcPktSenderAddress (PktSenderAdres,DestPtr^.UserRecNr);

     { estimate the number of split parts }
     EstimateSplitParts (SplitParts,SplitBodyLen,DestPtr^.ToUser_F);

     {## add support for decoding files here}
     MsgsLimited_Init (PosRec,{IncludeAttachments}TRUE);

     { create a message for each split part }
     SplitCurrent:=0;
     REPEAT
           OutPtr:=FtnNetOut_StartOfMessage (DestPtr^.UserRecNr,
                                             PktSenderAdres,
                                             ((Msg.Attr_F AND MSGCRASH) > 0));

           IF (OutPtr = NIL) THEN
           BEGIN
                LogMessage (liFatal,'Cannot write to PKT; aborting');
                Exit;
           END;

           UpdateInfoNr (INFO_PktOut_Net,1);

           Inc (SplitCurrent);

           IF PackBuf_Init (DeliverNetmail_Flush,lttCR,OutPtr) THEN
           BEGIN
                { prepare the PKT message header }
                WITH MsgHeader DO
                BEGIN
                     TypeIdent:=2;  { standard Fido Type 2 }

                     OrigNode:=Msg.FromAddr_F.Node;
                     OrigNet:=Msg.FromAddr_F.Net;

                     DestNode:=DestPtr^.ToAddr_F.Node;
                     DestNet:=DestPtr^.ToAddr_F.Net;

                     { From FTS-0001.015: bits 0,1,4,10,12,13,14 }
                     { must NOT be set to 0; the rest has to     }
                     {   $7413 = 0111 0100 0001 0011             }
                     {   BitNr = 5432 1098 7654 3210             }

                     AttrFlag:=Msg.Attr_F AND $7413;

                     Cost:=Msg.Cost_F;
                END;

                { write binary message header }
                FtnNetOut_WriteToPkt (OutPtr,SizeOf (MsgHeader),MsgHeader);

                { build the subject line }
                SubjectLine:=FtnSubj_RemovePaths (Msg.Subj_F,Msg.Attr_F AND MSGFILE);

                { if this is a split part message, then add the (n/m) }
                { indicator at the start of the message.              }
                IF (SplitParts > 1) THEN
                   SubjectLine:='('+Word2String (SplitCurrent)+
                                '/'+Word2String (SplitParts)+
                                ') '+SubjectLine;

                { write date, from, to and subj (split number indication) }
                Temp:=Msg.Date_F+#0+
                      DestPtr^.ToUser_F+#0+
                      Msg.FromUser_F+#0+
                      SubjectLine+#0;

                FtnNetOut_WriteToPkt (OutPtr,Length (Temp),Temp[1]);

                PackBuf_ReplaceNul ('!');

                { write INTL, FMPT, TOPT }
                Temp:=#1'INTL '+Fido23DStr (DestPtr^.ToAddr_F)+' '+
                                Fido23DStr (Msg.FromAddr_F)+#13;
                PackBuf_AddLine (Temp);

                IF (DestPtr^.ToAddr_F.Point <> 0) THEN
                BEGIN
                     Temp:=#1'TOPT '+Word2String (DestPtr^.ToAddr_F.Point)+#13;
                     PackBuf_AddLine (Temp);
                END;

                IF (Msg.FromAddr_F.Point <> 0) THEN
                BEGIN
                     Temp:=#1'FMPT '+Word2String (Msg.FromAddr_F.Point)+#13;
                     PackBuf_AddLine (Temp);
                END;

                { add the rest of the kludges }
                DeliverNetmail_ReplaceMsgID:=(SplitCurrent > 1);
                MsgsForEach (Msg.HeaderTop_F,DeliverNetmail_AddHeaderLine);
                MsgsForEach (Msg.CopiedHeadersTop_F,DeliverNetmail_AddHeaderLine);

                { write SPLIT kludge }
                IF (SplitParts > 1) THEN
                BEGIN
                     Temp:=FidoCreateSplitLine (SplitCurrent,SplitParts)+#13;
                     PackBuf_AddLine (Temp);
                END;

                { add the body or part of the body in case of split parts }
                AllDone:=MsgsLimited_ForEach (PosRec,SplitBodyLen,PackBuf_AddLine);

                { check #13 #13 before tear-line }

                { add footer }
                MsgsForEach (Msg.FooterTop_F,PackBuf_AddLine);

                { flush the last bytes }
                PackBuf_Done;
           END ELSE
               AllDone:=TRUE;

           FtnNetOut_EndOfMessage (OutPtr);

     UNTIL AllDone;

     { now make sure all attached files make it into the outbound }
     { FrontDoor does this automatically, so we only have to fix  }
     { this for Binkley and d'Bridge.                             }

     IF (Config.FidoSystem = stBinkley) THEN
     BEGIN
          { ++ already done for stats above }
          ReadUserBaseRecord (DestPtr^.UserRecNr,UserRec);

          {
          LogMessage (liDebug,'ATTR: '+Word2BinString (Msg.Attr_F));
          LogMessage (liDebug,'EXTA: '+Longint2BinString (Msg.ExtAttr_F));
          }

          {## have to take care of Immediate and Direct flags as well}
          IF ((Msg.Attr_F AND MSGFILE) > 0) THEN
             IF ((Msg.Attr_F AND MSGCRASH) > 0) THEN
                BinkOUTFile_AddAttaches ((Msg.ExtAttr_F AND EXTMSGKFS) > 0,
                                         Msg.Subj_F,
                                         UserRec.Address,
                                         stCrash)
             ELSE
                 BinkOUTFile_AddAttaches ((Msg.ExtAttr_F AND EXTMSGKFS) > 0,
                                          Msg.Subj_F,
                                          UserRec.Address,
                                          UserRec.SendFormat);

          IF ((Msg.Attr_F AND MSGFRQ) > 0) THEN
          BEGIN
               { Creer een *.REQ file voor deze node }
               { RWI 960127: put all filenames mentioned in there }
               Temp:=DeleteFrontAndBackSpaces (Msg.Subj_F)+' ';
               WHILE (Temp <> '') DO
               BEGIN
                    BinkCreateREQFile (UserRec.Address,
                                       Copy (Temp,1,Pos (' ',Temp)-1));
                    Delete (Temp,1,Pos (' ',Temp));
                    Temp:=DeleteFrontSpaces (Temp);
               END;
          END;
     END; { Binkley }

{$ENDIF (!WtrTest)}
     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverMailToFtnUser to UserRecNr '+Word2String (DestPtr^.UserRecNr)+' end');

(*
     { RWI 950216: voordat we aan de footer beginnen,          }
     {             controleren we eerst even of er twee enters }
     {             aan het einde van het blok staan want       }
     {             daardoor ontstaat een lege regel _voor_ de  }
     {             tear-line, die als eerste in de footer      }
     {             staat (waarschijnlijk).                     }
     {             Simpel: er moet #13#13 aan het einde staan, }
     {             anders maken we dat ervan. Als het buffer   }
     {             al weggeschreven was, dan kunnen we dit     }
     {             niet controleren en voegen we dus geen      }
     {             enters zomaar toe.                          }
     HulpLen:=2;
     IF (MsgBufOfs < 1) OR (MsgBuffer^[MsgBufOfs-1] = 13) THEN
     BEGIN
          Dec (HulpLen);
          IF (MsgBufOfs < 2) OR (MsgBuffer^[MsgBufOfs-2] = 13) THEN
             Dec (HulpLen);
     END;

     { nu de enters toevoegen }
     WHILE (HulpLen <> 0) DO
     BEGIN
          MsgBuffer^[MsgBufOfs]:=13;
          Inc (MsgBufOfs);
          Dec (HulpLen);
     END; { while }
*)
END;


{--------------------------------------------------------------------------}
{ DeliverNetmailToUnknownSystem                                            }
{                                                                          }
{ This routine is called from DeliverNetmail to write a copy of this       }
{ netmail to the .PKT file for the given address, which is not one of our  }
{ defined users.                                                           }
{                                                                          }
PROCEDURE DeliverNetmailToUnknownSystem (ToAddress : FidoAddrType; ToUserName : STRING);

VAR OutPtr         : OutboundRecordPtr;
    FoundAKA       : 1..MaxAKAs;
    Dummy,
    PktSenderAdres : FidoAddrType;

    { for binary header writing }
    MsgHeader      : FidoPktMsgHdrAdres;
    Temp           : STRING;
    SubjectLine    : STRING[MaxLenSubj_F]; { 71, ex #0 }
    TempAddr       : FidoAddrType;

    { for split part handling }
    SplitBodyLen   : LONGINT;
    SplitCurrent,
    SplitParts     : WORD;
    PosRec         : ForEach_PosRecord;
    AllDone        : BOOLEAN;

BEGIN
     IF Config.LogDebug THEN
     BEGIN
          LogMessage (liDebug,'DeliverMailToUnknownSystem begin');
          LogMessage (liDebug,'Destination is "'+ToUserName+'" at '+Fido2Str (ToAddress));
     END;

{$IFNDEF WtrTest}
     IF (FidoOurAdres (Msg.FromAddr_F)) THEN
          StatEntry_NetMsg (stdOutbound, Msg.FromUser_F, Msg.FromAddr_F, ToUserName, ToAddress, Msg.Subj_F,
                              Msg.MsgSize)
     ELSE
          StatEntry_NetMsg (stdInbound, Msg.FromUser_F, Msg.FromAddr_F, ToUserName, ToAddress, Msg.Subj_F,
                              Msg.MsgSize);

     { decide the PktSenderAdres }
     FoundAKA:=FidoMatchAdres (ToAddress,Dummy);
     PktSenderAdres:=Config.NodeNrs[FoundAka];

     { check whether we have to use a pointnet address }
     {## should we not check the destination address instead?? }
     IF (Config.PointNets[FoundAKA] > 0) AND
        (Config.NodeNrs[FoundAKA].Point > 0) THEN
     BEGIN
          { modify to pointnet address }
          PktSenderAdres.Net:=Config.PointNets[FoundAKA];
          PktSenderAdres.Node:=PktSenderAdres.Point;
          PktSenderAdres.Point:=0;
     END;

     { estimate the number of split parts }
     EstimateSplitParts (SplitParts,SplitBodyLen,ToUserName);

     {## add support for decoding files here}
     MsgsLimited_Init (PosRec,{IncludeAttachments}TRUE);

     { create a message for each split part }
     SplitCurrent:=0;
     REPEAT
           OutPtr:=FtnNetOut_UnknownSystem_StartOfMessage (ToAddress,
                                                           PktSenderAdres,
                                                           ((Msg.Attr_F AND MSGCRASH) > 0));

           IF (OutPtr = NIL) THEN
           BEGIN
                LogMessage (liFatal,'Cannot write to PKT; aborting');
                Exit;
           END;

           UpdateInfoNr (INFO_PktOut_Net,1);

           Inc (SplitCurrent);

           IF PackBuf_Init (DeliverNetmail_Flush,lttCR,OutPtr) THEN
           BEGIN
                { prepare the PKT message header }
                WITH MsgHeader DO
                BEGIN
                     TypeIdent:=2;  { standard Fido Type 2 }

                     OrigNode:=Msg.FromAddr_F.Node;
                     OrigNet:=Msg.FromAddr_F.Net;

                     DestNode:=ToAddress.Node;
                     DestNet:=ToAddress.Net;

                     { From FTS-0001.015: bits 0,1,4,10,12,13,14 }
                     { must NOT be set to 0; the rest has to     }
                     {   $7413 = 0111 0100 0001 0011             }
                     {   BitNr = 5432 1098 7654 3210             }

                     AttrFlag:=Msg.Attr_F AND $7413;

                     Cost:=Msg.Cost_F;
                END;

                { write binary message header }
                FtnNetOut_WriteToPkt (OutPtr,SizeOf (MsgHeader),MsgHeader);

                { build the subject line }
                SubjectLine:=FtnSubj_RemovePaths (Msg.Subj_F,Msg.Attr_F AND MSGFILE);

                { if this is a split part message, then add the (n/m) }
                { indicator at the start of the message.              }
                IF (SplitParts > 1) THEN
                   SubjectLine:='('+Word2String (SplitCurrent)+
                                '/'+Word2String (SplitParts)+
                                ') '+SubjectLine;

                { write date, from, to and subj (split number indication) }
                Temp:=Msg.Date_F+#0+
                      ToUserName+#0+
                      Msg.FromUser_F+#0+
                      SubjectLine+#0;

                FtnNetOut_WriteToPkt (OutPtr,Length (Temp),Temp[1]);

                PackBuf_ReplaceNul ('!');

                { write INTL, FMPT, TOPT }
                Temp:=#1'INTL '+Fido23DStr (ToAddress)+' '+
                                Fido23DStr (Msg.FromAddr_F)+#13;
                PackBuf_AddLine (Temp);

                IF (ToAddress.Point <> 0) THEN
                BEGIN
                     Temp:=#1'TOPT '+Word2String (ToAddress.Point)+#13;
                     PackBuf_AddLine (Temp);
                END;

                IF (Msg.FromAddr_F.Point <> 0) THEN
                BEGIN
                     Temp:=#1'FMPT '+Word2String (Msg.FromAddr_F.Point)+#13;
                     PackBuf_AddLine (Temp);
                END;

                { add the rest of the kludges }
                DeliverNetmail_ReplaceMsgID:=(SplitCurrent > 1);
                MsgsForEach (Msg.HeaderTop_F,DeliverNetmail_AddHeaderLine);
                MsgsForEach (Msg.CopiedHeadersTop_F,DeliverNetmail_AddHeaderLine);

                { write SPLIT kludge }
                IF (SplitParts > 1) THEN
                BEGIN
                     Temp:=FidoCreateSplitLine (SplitCurrent,SplitParts)+#13;
                     PackBuf_AddLine (Temp);
                END;

                { add the body or part of the body in case of split parts }
                AllDone:=MsgsLimited_ForEach (PosRec,SplitBodyLen,PackBuf_AddLine);

                { check #13 #13 before tear-line }

                { add footer }
                MsgsForEach (Msg.FooterTop_F,PackBuf_AddLine);

                { flush the last bytes }
                PackBuf_Done;
           END ELSE
               AllDone:=TRUE;

           FtnNetOut_EndOfMessage (OutPtr);

     UNTIL AllDone;

     { Kijk of het een lokaal bericht is met een file attach }
     { zoja , stuur dat dan ook mee..                        }
     { Dit geldt natuurlijk alleen voor Bink, Frontdoor doet }
     { automatisch file attaches.                            }
     IF (Config.FidoSystem = stBinkley) THEN
     BEGIN
          {
          LogMessage (liDebug,'ATTR: '+Word2BinString (Msg.Attr_F));
          LogMessage (liDebug,'EXTA: '+Longint2BinString (Msg.ExtAttr_F));
          }

          IF ((Msg.Attr_F AND MSGFILE) > 0) THEN
             { Nog? Geen controle of de file wel echt bestaat }
             IF ((Msg.Attr_F AND MSGCRASH) > 0) THEN
                  BinkOUTFile_AddAttaches ((Msg.ExtAttr_F AND EXTMSGKFS) > 0,
                                           Msg.Subj_F,ToAddress,
                                           stCrash)
             ELSE
                  BinkOUTFile_AddAttaches ((Msg.ExtAttr_F AND EXTMSGKFS) > 0,
                                           Msg.Subj_F,ToAddress,
                                           UserData.SendFormat);

          IF ((Msg.Attr_F AND MSGFRQ) > 0) THEN
          BEGIN
               { Creer een *.REQ file voor deze node }
               { RWI 960127: put all filenames mentioned in there }
               Temp:=DeleteFrontAndBackSpaces (Msg.Subj_F)+' ';
               WHILE (Temp <> '') DO
               BEGIN
                    BinkCreateREQFile (UserData.Address,
                                       Copy (Temp,1,Pos (' ',Temp)-1));

                    Delete (Temp,1,Pos (' ',Temp));
                    Temp:=DeleteFrontSpaces (Temp);
               END;
          END;
     END;

{$ENDIF (!WtrTest)}
     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverMailToUnknownSystem end');

(*
{FidoPktExportMsg}

                { RWI 950216: voordat we aan de footer beginnen,          }
                {             controleren we eerst even of er twee enters }
                {             aan het einde van het blok staan want       }
                {             daardoor ontstaat een lege regel _voor_ de  }
                {             tear-line, die als eerste in de footer      }
                {             staat (waarschijnlijk).                     }
                {             Simpel: er moet #13#13 aan het einde staan, }
                {             anders maken we dat ervan. Als het buffer   }
                {             al weggeschreven was, dan kunnen we dit     }
                {             niet controleren en voegen we dus geen      }
                {             enters zomaar toe.                          }
                HulpLen:=2;
                IF (MsgBufOfs < 1) OR (MsgBuffer^[MsgBufOfs-1] = 13) THEN
                BEGIN
                     Dec (HulpLen);
                     IF (MsgBufOfs < 2) OR (MsgBuffer^[MsgBufOfs-2] = 13) THEN
                        Dec (HulpLen);
                END;

                { nu de enters toevoegen }
                WHILE (HulpLen <> 0) DO
                BEGIN
                     MsgBuffer^[MsgBufOfs]:=13;
                     Inc (MsgBufOfs);
                     Dec (HulpLen);
                END; { while }
*)
END;


{--------------------------------------------------------------------------}
{ ProcessAndRemove_To_and_GW_Headers                                       }
{                                                                          }
{ The task of this function is to find and remove the following headers    }
{ from a FTN netmail message body and add the addresses as raw RFC         }
{ destinations.                                                            }
{ If non of these headers were found, FALSE is returned and the netmail    }
{ should be bounced. Otherwise TRUE is returned.                           }
{ Headers checked:                                                         }
{ "To:"                                                                    }
{ "GW-To:"                                                                 }
{ "GW-Cc:"                                                                 }
{ "GW-Bcc:"                                                                }
{ Continuation headers for any of the GW-* headers.                        }
{                                                                          }
FUNCTION ProcessAndRemove_To_and_GW_Headers : BOOLEAN;

TYPE GwTypes = (gwtNothing,gwtNormalTo,gwtTo,gwtCc,gwtBcc);

VAR PrevRegel : STRING;
    CurrType  : GwTypes;

    PROCEDURE AddAddr (Addr : STRING);
    BEGIN
         IF (Addr = '') THEN
            Exit;

         { ## comma inside double quotes not supported! (allowed?) }
         Addr:=UseGetAddress (Addr); { allow multiple address forms }

         CASE CurrType OF
              gwtNormalTo :
                  BEGIN
                       LogExtraMessage ('  To: '+Addr);
                       Address_AddRFCRaw (Addr,destTo,FALSE,FALSE);
                  END;

              gwtTo :
                  BEGIN
                       LogExtraMessage ('  GW-To: '+Addr);
                       Address_AddRFCRaw (Addr,destTo,FALSE,FALSE);
                  END;

              gwtCc :
                  BEGIN
                       LogExtraMessage ('  GW-Cc: '+Addr);
                       Address_AddRFCRaw (Addr,destCc,FALSE,FALSE);
                  END;

              gwtBcc :
                  BEGIN
                       LogExtraMessage ('  GW-Bcc: '+Addr);
                       Address_AddRFCRaw (Addr,destBcc,FALSE,FALSE);
                  END;

              ELSE
                  LogMessage (liReport,'Unexpected situation in AddAddr: '+
                              Byte2String (Byte (CurrType)));
         END; { case }
    END;

    PROCEDURE Process (Regel : STRING);

    VAR Addr : STRING;
        P    : BYTE;

    BEGIN
         {LogMessage ('Type='+Byte2String (Byte (CurrType))+', PrevRegel="'+PrevRegel+'", Regel="'+Regel+'"');}

         { ## comma inside double quotes not supported! (allowed?) }
         Regel:=DeleteFrontSpaces (Regel);

         WHILE (Regel <> '') DO
         BEGIN
              P:=Pos (',',Regel);
              IF (P > 0) THEN
              BEGIN
                   Addr:=DeleteFrontAndBackSpaces (Copy (Regel,1,P-1));
                   Delete (Regel,1,P);

                   IF (PrevRegel <> '') THEN
                   BEGIN
                        Addr:=PrevRegel+Addr;
                        PrevRegel:='';
                   END;

                   AddAddr (Addr);
              END ELSE
                  IF (Regel[Length (Regel)] = #13) THEN
                  BEGIN
                       { correct end of a multi-line }
                       Delete (Regel,Length (Regel),1);
                       Addr:=DeleteFrontAndBackSpaces (Regel);

                       IF (PrevRegel <> '') THEN
                       BEGIN
                            Addr:=PrevRegel+Addr;
                            PrevRegel:='';
                       END;

                       AddAddr (Addr);

                       Regel:=''; { exits while loop }
                       CurrType:=gwtNothing;
                  END ELSE
                  BEGIN
                       PrevRegel:=DeleteFrontAndBackSpaces (Regel);
                       {LogExtraMessage ('Over="'+PrevRegel+'"');}
                       Regel:=''; { exists while loop }
                  END;
         END; { while }
    END;

{ProcessAndRemove_To_and_GW_Headers}

VAR Regel : STRING;

BEGIN
     ProcessAndRemove_To_and_GW_Headers:=FALSE; { did not find any headers with a valid address }

     CurrType:=gwtNothing;
     PrevRegel:='';

     WHILE TRUE DO
     BEGIN
          Regel:=MsgsGetFirstRowInBody;

          IF (Regel = #13) THEN
          BEGIN
               { empty line. remove it and stop here }

               { process half a left over line, if any }
               IF (CurrType <> gwtNothing) THEN
                  Process (#13);

               MsgsDeleteFirstRowFromBody;

               Exit; { ## EXIT ## }
          END ELSE
              IF CaselessStartMatch (Regel,'To:') THEN
              BEGIN
                   { to: line. process, remove and continue }

                   { formats: ramon@wsd.wline.se }
                   {      or: Ramon van der Winkel <ramon@wsd.wline.se> }
                   {      or: ramon@wsd.wline.se (Ramon van der Winkel) }
                   IF (CurrType <> gwtNothing) THEN
                      Process (#13);

                   CurrType:=gwtNormalTo;
                   PrevRegel:='';

                   Delete (Regel,1,3); { remote "To:" }
                   Process (Regel);

                   { remove and continue }
              END ELSE
                  IF CaselessStartMatch (Regel,'GW-To:') THEN
                  BEGIN
                       { gw-to: line. process, remove and continue }

                       IF (CurrType <> gwtNothing) THEN
                          Process (#13);

                       CurrType:=gwtTo;
                       PrevRegel:='';

                       Delete (Regel,1,6); { remote "GW-To:" }
                       Process (Regel);

                       { continue }
                  END ELSE
                      IF CaselessStartMatch (Regel,'GW-Cc:') THEN
                      BEGIN
                           { gw-cc: line. process, remove and continue }

                           IF (CurrType <> gwtNothing) THEN
                              Process (#13);

                           CurrType:=gwtCc;
                           PrevRegel:='';

                           Delete (Regel,1,6); { remote "GW-Cc:" }
                           Process (Regel);

                           { continue }
                      END ELSE
                          IF CaselessStartMatch (Regel,'GW-Bcc:') THEN
                          BEGIN
                               { gw-bcc: line. process, remove and continue }

                               IF (CurrType <> gwtNothing) THEN
                                  Process (#13);

                               CurrType:=gwtBcc;
                               PrevRegel:='';

                               Delete (Regel,1,7); { remote "GW-Bcc:" }
                               Process (Regel);

                               { continue }
                          END ELSE
                          BEGIN
                               IF (CurrType <> gwtNothing) THEN
                                  Process (Regel)
                               ELSE BEGIN
                                    { unknown line. keep and exit }
                                    { ends up here too when body is empty }
                                    Exit; { ## EXIT ## }
                               END;
                          END;

          MsgsDeleteFirstRowFromBody;
     END; { endless while }
END;


{--------------------------------------------------------------------------}
{ ImportNetmail_Undeliverable                                              }
{                                                                          }
{ This routine is called to dump an undeliverable message into a the       }
{ primary netmail area. This routine copies the message, adds a section    }
{ that explains about the problem, sets the Hold flag and calls            }
{ ImportNetmail. On returns, the DestRecord can be removed.                }
{                                                                          }
PROCEDURE ImportNetmail_Undeliverable (DestPtr : DestRecordPtr);

VAR Put,
    Lp  : 1..MAX_BODY_PARTS;

BEGIN
     MsgsPushState;

     { copy fields from previous message }
     WITH Msg.PrevMsgPtr^ DO
     BEGIN
          Msg.Ready_F:=Ready_F;

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

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

          Msg.IsMime:=IsMime;
          Msg.MultiPartBoundary:=MultiPartBoundary;

          Msg.HeaderTop_F:=HeaderTop_F;
          Msg.CopiedHeadersTop_F:=CopiedHeadersTop_F;
          Msg.FooterTop_F:=FooterTop_F;

          Msg.MsgSize:=MsgSize;

          Msg.SBP_Zone:=SBP_Zone;
          Msg.FirstSeenByPtr:=FirstSeenByPtr;
          Msg.FirstPathPtr:=FirstPathPtr;

          { Domain not found; not bounced: ... }
          IF (GetLang0 (103) <> '') THEN
          BEGIN
               MsgsAddLineTo (Body,GetLang1 (103,DestPtr^.To_U));
               MsgsAddLineTo (Body,'');
          END;

          { copy all other body parts }
          Put:=1;
          WHILE (Msg.BodyParts[Put] <> NIL) DO
                Inc (Put);

          FOR Lp:=1 TO MAX_BODY_PARTS DO
              IF (BodyParts[Lp] <> NIL) THEN
              BEGIN
                   Msg.BodyParts[Put]:=BodyParts[Lp];
                   Inc (Put);
              END;

          Msg.CurrentBodyPart:=Put;
     END;

     Msg.Attr_F:=MSGLOCAL OR MSGHOLD;

     ImportNetmail_InPrimaryNetmailArea (DestPtr^.ToUser_F,DestPtr^.ToAddr_F);

     { prevent the copied lines from being destroyed }
     Msg.HeaderTop_F:=NIL;
     Msg.CopiedHeadersTop_F:=NIL;
     Msg.FooterTop_F:=NIL;
     MsgsReleaseLines (Msg.BodyParts[1]); { assume is the self-created part }
     FOR Lp:=2 TO MAX_BODY_PARTS DO
         Msg.BodyParts[Lp]:=NIL;
     Msg.FirstSeenByPtr:=NIL;
     Msg.FirstPathPtr:=NIL;

     MsgsPopState;
END;


{--------------------------------------------------------------------------}
{ DeliverNetmail                                                           }
{                                                                          }
{ This routine is called when the internal message is currently in Netmail }
{ format. This routine must make sure all recipients that wants to receive }
{ the message in this format get a copy of it before this routine returns. }
{ All destFTN addresses are mapped and routed as requested. All types then }
{ set for Local Import are imported and all set for destFtnUser are        }
{ written to the outbound jobs for those users. Hopefully nothing is left  }
{ after that.                                                              }
{                                                                          }
FUNCTION DeliverNetmail : DeliverResultType;

VAR Result : DeliverResultType;

    {----------------------------------------------------------------------}
    { SendToDestSystem                                                     }
    {                                                                      }
    { This function searches for a route to the destination. This can      }
    { either result in a netmail that will be delivered by FrontDoor or a  }
    { PKT file in the outbound or no known route at all, in which case     }
    { FALSE is returned.                                                   }
    {                                                                      }
    FUNCTION SendToDestSystem (DestPtr : DestRecordPtr) : BOOLEAN;

    VAR MatchAddr : FidoAddrType;
        UserRecNr : UserBaseRecordNrType;
        UserRec   : UserBaseRecord;

    BEGIN
         SendToDestSystem:=TRUE; { assume we found a route }

         CASE FindRoute (DestPtr^.ToAddr_F,MatchAddr) OF
              0 : {no route};

                  {-ForceNoRoute or (FD + !ForcePack) }
              1 : BEGIN
                       { import the message, for the mailer to deliver }

                       {$IFDEF WtrTest}
                       LogMessage (liTrivial,'Target: Import in primary netmail area for Mailer');
                       {$ELSE}

                       Msg.Attr_F:=Msg.Attr_F {##OR MSGLOCAL} OR MSGKILL;

                       { if we know the user, then set the proper flavour }
                       IF FindUserBaseRecordByFidoAddress (MatchAddr,UserRecNr) THEN
                       BEGIN
                            ReadUserBaseRecord (UserRecNr,UserRec);

                            { Plak vlaggen op het bericht afhankelijk van de }
                            { prioriteit die de node heeft.                  }
                            CASE UserRec.SendFormat OF
                                 stNormal :
                                     { add nothing };

                                 stHold :
                                     BEGIN
                                          FidoAddToExtFlag (EXTMSGHLD);
                                          Msg.Attr_F:=Msg.Attr_F OR MSGHOLD;
                                     END;

                                 stCrash :
                                     FidoAddToExtFlag (EXTMSGCRA);

                                 stDirect :
                                     FidoAddToExtFlag (EXTMSGDIR);

                                 ELSE
                                     LogMessage (liReport,'Unexpected situation 1 in DeliverNetmail');
                            END; { case }

                            { Schrijf #1'FLAGS' in het bericht }
                            FidoExportExtFlag;
                       END; { we kennen de user direct }

                       ImportNetmail_InPrimaryNetmailArea (DestPtr^.ToUser_F,DestPtr^.ToAddr_F);
                       {$ENDIF (!WtrTest)}

                       Exit; { with TRUE: was sent to destination  }
                  END;

                  { route-fido hit }
              2 : BEGIN
                       LogExtraMessage ('Routed netmail msg for "'+DestPtr^.ToUser_F+'"%'+Fido2Str (DestPtr^.ToAddr_F)+
                                        ' via '+Fido2Str (MatchAddr));

                       { Laadt de doel user }
                       IF FindUserBaseRecordByFidoAddress (MatchAddr,DestPtr^.UserRecNr) THEN
                       BEGIN
                            {$IFDEF WtrTest}
                            LogMessage (liTrivial,'Target: To .PKT file for FTN user '+Fido2Str (UserData.Address));
                            {$ENDIF}
                            DestPtr^.Status:=destFTNUser;
                            Exit;
                       END ELSE
                           LogMessage (liFatal,'Failed to load information for '+Fido2Str (MatchAddr));

                       Exit; { with TRUE: was sent to destination }
                  END;
         END; { case, if }

         { failed to find a route to the destination system }
         SendToDestSystem:=FALSE;
    END;


    {----------------------------------------------------------------------}
    { HandleFtnDest                                                        }
    {                                                                      }
    { Returns TRUE if the dest can be removed, otherwise FALSE.            }
    {                                                                      }
    FUNCTION HandleFtnDest (VAR DestPtr : DestRecordPtr) : BOOLEAN;

    VAR MatchAddr      : FidoAddrType;
        WasAddressedTo : STRING;
        Reason         : STRING;
        ListRecNr      : LONGINT;

    BEGIN
         HandleFtnDest:=TRUE; { assume it has been handled }

         IF (DestPtr^.Status = destFTN) THEN
            WasAddressedTo:='"'+DestPtr^.ToUser_F+'" at '+Fido2Str (DestPtr^.ToAddr_F)
         ELSE
         BEGIN
              WasAddressedTo:='Missing';
              LogMessage (liReport,'HandleFtnDest: unexpected dest type ('+Byte2String (Byte (DestPtr^.Status))+')');
         END;

         { check for local addresses (mailing lists, list server, }
         { areafix, sendfile.                                     }
         IF FidoOurAdres (DestPtr^.ToAddr_F) THEN
         BEGIN
              { check for gateway addressing }
              IF CaselessMatch (DestPtr^.ToUser_F,Config.GatewayUser) OR
                 (Config.FidoAcceptTO AND ((Pos ('@',DestPtr^.ToUser_F)+Pos ('!',DestPtr^.ToUser_F)) <> 0)) THEN
              BEGIN
                   { try to allow gateway-style addresses to FTN destinations }
                   { or the mailing list. This will avoid an unnecessary      }
                   { translation and allows for mailing list replies that     }
                   { have to be gated in combination with a REPLYALSO to the  }
                   { mailing list itself.                                     }

                   ProcessAndRemove_To_and_GW_Headers;
                   Address_CheckRFCRaw; { check raw to normal status }

                   IF (NOT CaselessMatch (DestPtr^.ToUser_F,Config.GatewayUser)) THEN
                   BEGIN
                        { address with @ or ! written on To: line }
                        { change the destination to destRFC }
                        Address_AddRFCRaw (DestPtr^.ToUser_F,destTo,FALSE,FALSE);
                        Address_CheckRFCRaw;
                   END;

                   { see if there are any RFC side addresses that can  }
                   { be reached from the FTN side as well (mailing     }
                   { lists) or result in FTN addresses anyway (users). }
                   Address_ChangeRfc2FtnSide;

                   IF Address_HasNoneFilterRfcDest THEN
                   BEGIN
                        IF (NOT CheckGateway (Msg.FromAddr_F,Msg.FromUser_F,Reason)) THEN
                        BEGIN
                             LogExtraMessage ('  '+Reason);
                             FTN_Bounce (Reason,Config.GatewayUser,WasAddressedTo);

                             { remove all destinations, to avoid addresses added }
                             { above by Address_AddRFCRaw to still continue.     }
                             MsgsFreeAllDestRecords ({Silent:}TRUE);

                             { avoid freemem by caller }
                             DestPtr:=NIL;
                             Exit; { with TRUE: delete the destrecord }
                        END;

                        Result:=drGated; { not yet, but most probably }
                   END;

                   { one or more DestRecord have been added - discard this one }
                   Result:=drNormal;
                   Exit; { with TRUE: delete the destrecord }
              END;

              IF (NOT Msg.IsListDist) THEN
              BEGIN
                   { RWI 960323: AreaFix is first from now on }
                   IF IsAreafixName (DestPtr^.ToUser_F) THEN
                   BEGIN
                        {$IFDEF WtrTest}
                        LogMessage (liTrivial,'Target: AreaFix');
                        {$ELSE}
                        AreaFix_ProcessMessage;
                        {$ENDIF}

                        Result:=drProcessed;
                        Exit; { with TRUE: delete the destrecord }
                   END;

                   { Controleer of het bericht aan een van onze list servers  }
                   { gericht is.                                              }
                   ListRecNr:=ListServerSearchName (DestPtr^.ToUser_F);

                   IF (ListRecNr <> NILPos) THEN
                   BEGIN
                        {$IFDEF WtrTest}
                        LogMessage (liTrivial,'Target: Mailing List');
                        {$ELSE}
                        MailingList_FTN_AcceptPost (WasAddressedTo,ListRecNr);
                        {$ENDIF}

                        Result:=drProcessed;
                        Exit; { with TRUE: delete the destrecord }
                   END;

                   IF CaselessMatch (DestPtr^.ToUser_F,ListServer1) OR
                      CaselessMatch (DestPtr^.ToUser_F,ListServer2) THEN
                   BEGIN
                        {$IFDEF WtrTest}
                        LogMessage (liTrivial,'Target: List Server');
                        {$ELSE}
                        ListServer_FTN_ProcessMessage;
                        {$ENDIF}

                        Result:=drProcessed;
                        Exit; { with TRUE: delete the destrecord }
                   END;

                   { is het aan een SENDFILE statement? }
                   IF FTN_CheckAndHandleSendFile (DestPtr^.ToUser_F) THEN
                   BEGIN
                        Result:=drProcessed;
                        Exit; { with TRUE: delete the destrecord }
                   END;
              END;

              { kijk of het een bekende BBS user is }
              IF IsKnownBBSUser (DestPtr^.ToUser_F) THEN
              BEGIN
                   LogMessage (liTrivial,'Detected netmail for BBS user "'+DestPtr^.ToUser_F+'"');

                   { if a BBS-VIA is defined, the route this message via }
                   { that user. Otherwise import it.                     }
                   IF (BBSViaRecNr <> NILRecordNr) THEN
                   BEGIN
                        { BBS-Via }
                        {$IFDEF WtrTest}
                        LogMessage (liTrivial,'Target: Sending via BBS-VIA user.');
                        {$ELSE}
                        DestPtr^.Status:=destFTNUser;
                        DestPtr^.UserRecNr:=BBSViaRecNr;
                        {$ENDIF}
                   END ELSE
                   BEGIN
                        { WtrTest termination in FidoImportNetmailForBBSUser }
                        { import in BBS-AREA or BBS-EMAILAREA }
                        Msg.Stored_ToUser:=DestPtr^.ToUser_F;
                        Msg.Stored_ToAddr:=DestPtr^.ToAddr_F;
                        ImportNetmailForBBSUser (DestPtr);
                   END;

                   Result:=drProcessed;
                   Exit; { with TRUE: delete the destrecord }
              END;

              { De enig overgebleven mogelijkheid is importeren... }

              ImportNetmail_InPrimaryNetmailArea (DestPtr^.ToUser_F,DestPtr^.ToAddr_F);

              Result:=drNormal;
              Exit; { with TRUE: delete the record }
         END; { if local }

         { message is not address to a local aka }
         { use the routine table to find its destination }

         { find our closest matching AKA }
         FidoMatchAdres (Msg.FromAddr_F,MatchAddr);

         (*
         {## should now be special for this destination.. ExtraFooter ofzo }
         { Add VIA Kludge }
         IF (NOT FidoCompare (Msg.FromAddr_F,MatchAddr)) THEN
            { Schrijf dat in een via kludge in de footer }
            MsgsAddLineTo (Footer_F,FidoViaKludge (MatchAddr));
         *)

         { Kijk of het een van onze points is, direct geadresseerd }
         IF FidoOurPoint (DestPtr^.ToAddr_F) THEN
         BEGIN
              { kijk of deze point wel bestaat }
              IF (NOT ForceNoRoute) THEN
              BEGIN
                   IF FindUserBaseRecordByFidoAddress (DestPtr^.ToAddr_F,DestPtr^.UserRecNr) THEN
                   BEGIN
                        LogMessage (liTrivial,'Found message for one of our points');
                        DestPtr^.Status:=destFTNUser;
                        HandleFtnDest:=FALSE; { do not delete destrecord }
                        Exit;
                   END;

                   { point is niet bekend, importeer het bericht lokaal }
                   LogMessage (liGeneral,'Undefined local point '+Fido2Str (DestPtr^.ToAddr_F)+
                               '; importing local.');
              END;

              ImportNetmail_InPrimaryNetmailArea (DestPtr^.ToUser_F,DestPtr^.ToAddr_F);

              Exit; { with TRUE: delete destrecord }
         END; { if }

         { Zoek de route naar de doel machine, maar doen geen routing voor }
         { IMMediate en CRAsh en filerequest meel.                         }
         IF ((Msg.Attr_F AND (MSGCRASH+MSGFRQ+MSGHOLD)) = 0) THEN
            IF SendToDestSystem (DestPtr) THEN
            BEGIN
                 { was sent to destination }

                 { check if it was routed one of our users }
                 IF (DestPtr^.Status = destFTNUser) THEN
                    HandleFtnDest:=FALSE; { do not delete destination }

                 Exit;
            END;

         DeliverNetmailToUnknownSystem (DestPtr^.ToAddr_F,DestPtr^.ToUser_F);

         { return value is TRUE: delete the destrecord }
    END;

    {----------------------------------------------------------------------}
    { HandleRemoteGWDest                                                   }
    {                                                                      }
    { This routine is called to modify the current message to make it      }
    { addressed to a remote gateway user, with a To: line in the body with }
    { the e-mail address. The message is then either imported into the     }
    { primary netmail area or written to a PKT file.                       }
    { Returns FALSE if the message must not be deleted, otherwise TRUE.    }
    {                                                                      }
    PROCEDURE HandleRemoteGWDest (DestPtr : DestRecordPtr);

    VAR Put,
        Lp        : 1..MAX_BODY_PARTS;
        MatchAddr : FidoAddrType;

    BEGIN
         { make a copy and insert the To: header as a new first body part }

         MsgsPushState;

         { copy fields from previous message }
         WITH Msg.PrevMsgPtr^ DO
         BEGIN
              Msg.Ready_F:=Ready_F;

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

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

              Msg.IsMime:=IsMime;
              Msg.MultiPartBoundary:=MultiPartBoundary;

              Msg.HeaderTop_F:=HeaderTop_F;
              Msg.CopiedHeadersTop_F:=CopiedHeadersTop_F;
              Msg.FooterTop_F:=FooterTop_F;

              Msg.MsgSize:=MsgSize;

              Msg.SBP_Zone:=SBP_Zone;
              Msg.FirstSeenByPtr:=FirstSeenByPtr;
              Msg.FirstPathPtr:=FirstPathPtr;

              IF Config.LogDebug THEN
                 LogMessage (liTrivial,'Adding to body: "TO: '+DestPtr^.To_U+'"');

              MsgsAddLineTo (Body,'TO: '+DestPtr^.To_U);
              MsgsAddLineTo (Body,'');

              { copy all other body parts }
              Put:=1;
              WHILE (Msg.BodyParts[Put] <> NIL) DO
                    Inc (Put);

              FOR Lp:=1 TO MAX_BODY_PARTS DO
                  IF (BodyParts[Lp] <> NIL) THEN
                  BEGIN
                       Msg.BodyParts[Put]:=BodyParts[Lp];
                       Inc (Put);
                  END;

              Msg.CurrentBodyPart:=Put;
         END;

         Msg.Attr_F:=MSGLOCAL OR MSGPRIVATE;

         IF SendToDestSystem (DestPtr) THEN
         BEGIN
              IF (DestPtr^.Status = destFTNUser) THEN
                 { must handle this at once to avoid TO: line loss below }
                 DeliverNetmailToFtnUser (DestPtr);
         END ELSE
         BEGIN
              LogMessage (liFatal,'No route to remote gateway "'+DestPtr^.ToUser_F+'" at '+Fido2Str ( DestPtr^.ToAddr_F));
              LogExtraMessage ('Not deliverable to '+DestPtr^.To_U);
         END;

         { prevent the copied lines from being destroyed }
         Msg.HeaderTop_F:=NIL;
         Msg.CopiedHeadersTop_F:=NIL;
         Msg.FooterTop_F:=NIL;
         MsgsReleaseLines (Msg.BodyParts[1]); { assume this is still the self-created part }
         FOR Lp:=2 TO MAX_BODY_PARTS DO
             Msg.BodyParts[Lp]:=NIL;
         Msg.FirstSeenByPtr:=NIL;
         Msg.FirstPathPtr:=NIL;

         MsgsPopState;
    END;

{DeliverNetmail}

VAR ErasePtr,
    FindPtr  : DestRecordPtr;

BEGIN
     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverNetmail enter');

     Result:=drNormal;

     { Run 1: check and extrapolate all addresses }

     FindPtr:=Msg.FirstDest;

     {## netmail statistics}

     WHILE (FindPtr <> NIL) DO
     BEGIN
          CASE FindPtr^.Status OF
               destFTN :
                   BEGIN
                        MapFTN (FindPtr);  { can change it into a RFC address! }

                        IF (FindPtr^.Status = destFTN) THEN
                           IF HandleFtnDest (FindPtr) THEN
                           BEGIN
                                { remove this processed record }
                                IF (FindPtr = NIL) THEN
                                   Continue; { with the while }

                                ErasePtr:=FindPtr;
                                FindPtr:=FindPtr^.NextDest;

                                RemoveDestRecord (ErasePtr,TRUE);

                                Continue; { with the while, do not go to NextDest }
                           END;
                   END;

               destNetHold:
                   BEGIN
                        ImportNetmail_Undeliverable (FindPtr);

                        ErasePtr:=FindPtr;
                        FindPtr:=FindPtr^.NextDest;
                        RemoveDestRecord (ErasePtr,TRUE);

                        Continue; { with the while, do not go to NextDest }
                   END;

               destNetArea:
                   BEGIN
                        { Move/Copy to Area filter }
                        { Area Definition is set to Netmail }
                        { Import in area - nothing more }

                        ImportNetmail (FindPtr^.AreaRecNr);

                        ErasePtr:=FindPtr;
                        FindPtr:=FindPtr^.NextDest;
                        RemoveDestRecord (ErasePtr,TRUE);

                        Continue; { with the while, do not go to NextDest }
                   END;

               destRemoteGW:
                   BEGIN
                        HandleRemoteGWDest (FindPtr);

                        { if not deliverable then delete }
                        ErasePtr:=FindPtr;
                        FindPtr:=FindPtr^.NextDest;
                        RemoveDestRecord (ErasePtr,TRUE);

                        Continue; { with the while, do not go to NextDest }
                   END;
          END; { case }

          FindPtr:=FindPtr^.NextDest;
     END; { while }

     { Run 2: write all destFTNUser destinations to disk }

     FindPtr:=Msg.FirstDest;

     WHILE (FindPtr <> NIL) DO
     BEGIN
          IF (FindPtr^.Status = destFTNUser) THEN
          BEGIN
               DeliverNetmailToFtnUser (FindPtr);
               RemoveDestRecord (FindPtr,TRUE);

               FindPtr:=Msg.FirstDest;
               Continue; { van voren af aan doorgaan }
          END;

          FindPtr:=FindPtr^.NextDest;
     END; { while }

     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverNetmail exit ('+Byte2String (Byte (Result))+')');

     DeliverNetmail:=Result;
END;


{--------------------------------------------------------------------------}
{ Deliver_TranslateNow                                                     }
{                                                                          }
{ This routine is called after each loop in DeliverNow. The message should }
{ have reached all its destinations in the current format, so we are now   }
{ expected to translate it a new required format so it can continue its    }
{ journey in that format.                                                  }
{ It is of the outmost importance that a message is gated only once        }
{ because the RFC->FTN gateway strips all alternative parts and MIME       }
{ related stuff and changes an attached file into a binary stream.         }
{ The FTN->RFC gateway does things the other way around.                   }
{                                                                          }
PROCEDURE Deliver_TranslateNow;

VAR ErasePtr,
    FindPtr      : DestRecordPtr;
    NeedEmail,
    NeedNetmail,
    NeedNews,
    NeedEchomail : BOOLEAN;

BEGIN
     IF Config.LogDebug THEN
        LogMessage (liDebug,'Deliver_TranslateNow');

     { If the message is not ready for one architecture, but is marked as  }
     { BAD for the other, drop it.  (This happens if, say, the message was }
     { stopped because of a duplicate Message-ID                           }
     IF ((Msg.Ready_F = Bad) AND (Msg.Ready_U = NotReady)) THEN
     BEGIN
          LogMessage (liGeneral,'Halting message at translation');

          {## Not sure if this is the best way, but..}
          DeliverNow;

          Exit;
     END;

     { work out in what formats the message is needed }
     NeedEmail:=FALSE;
     NeedNetmail:=FALSE;
     NeedNews:=FALSE;
     NeedEchomail:=FALSE;

     FindPtr:=Msg.FirstDest;
     WHILE (FindPtr <> NIL) DO
     BEGIN
          CASE FindPtr^.Status OF
               destNetHold,
               destFTN,
               destFTNUser,
               destNetArea,
               destRemoteGW :
                   NeedNetmail:=TRUE;

               destRFC,
               destRFCUser :
                   NeedEmail:=TRUE;

               destEchomail,
               destEchoArea :
                   NeedEchomail:=TRUE;

               destNews,
               destNewsArea :
                   NeedNews:=TRUE;

               ELSE
                   LogMessage (liReport,'Unknown dest status '+Byte2String (Byte (FindPtr^.Status)));
          END;

          FindPtr:=FindPtr^.NextDest;
     END; { while }

     { IMPLEMENTATION STATUS                        }
     { From/To    Mail   Netmail   News   Echomail  }
     { Email      x      i         i      i         }
     { Netmail    i      x         i      i         }
     { News       i      i         x      i         }
     { Echomail   i      i         i      x         }
     { (-=Not, i=Implemented, x=not needed)         }

     { priority:
     { 1. RFC-RFC             for personal and public messages }
     { 2. FTN-FTN             for personal and public messages }
     { 3. FTN-RFC and RFC-FTN for personal and public messages }
     { 4. FTN-RFC and RFC-FTN between personal and public      }

{ 1. Translations within RFC format }

     { Mail -> News }
     { put mail->news before gating to FTN to avoid header loss }
     IF NeedNews AND (Msg.Ready_U = Mail) THEN
     BEGIN
          Translate_Mail2News;
          Exit;
     END;

     { News -> Mail }
     IF NeedEmail AND (Msg.Ready_U = News) THEN
     BEGIN
          { needed for the mail2news gateway and cc on news articles }
          { maybe for the list server as well, when delivered via an echo }
          Translate_News2Mail;
          Exit;
     END;

{ 2. Translations within FTN format }

     { Netmail to Echomail }
     IF NeedEchomail AND (Msg.Ready_F IN [Netmail,Local_Netmail]) THEN
     BEGIN
          Translate_Netmail2Echomail;
          Exit;
     END;

     IF NeedNetmail AND (Msg.Ready_F IN [Echomail,Local_Echomail]) THEN
     BEGIN
          Translate_Echomail2Netmail;
          Exit;
     END;

{ 3. Netmail<->Email and Echomail<->News gating }

     { Netmail -> Mail }
     IF NeedEmail AND (Msg.Ready_F IN [Local_Netmail,Netmail]) THEN
     BEGIN
          {extract extra To:, Cc: and Bcc: just after export
           for decision making before this point!
          }
          {## add gateway allowance check here.
              if not, log all RFC addresses that didn't get a copy
              in the bounce address and remove those.
              We can only hope that it doesn't trigger the gw again
              after that...
          }
          Translate_Netmail2Mail;
          Exit;
     END;

     { Mail -> Netmail }
     IF NeedNetmail AND (Msg.Ready_U = Mail) THEN
     BEGIN
          Translate_Mail2Netmail;
          Exit;
     END;

     { Echomail -> News }
     IF NeedNews AND (Msg.Ready_F IN [Echomail,Local_Echomail]) THEN
     BEGIN
          Translate_Echomail2News;
          Exit;
     END;

     { News -> Echomail }
     IF NeedEchomail AND (Msg.Ready_U = News) THEN
     BEGIN
          Translate_News2Echomail;
          Exit;
     END;

{ 4. Cross-gatings: netmail<->news and echomail<->mail }

     IF NeedNews AND (Msg.Ready_F IN [Netmail,Local_Netmail]) THEN
     BEGIN
          Translate_Netmail2Mail;
          Translate_Mail2News;
          Exit;
     END;

     { News -> Netmail }
     IF NeedNetmail AND (Msg.Ready_U = News) THEN
     BEGIN
          { two step translation }
          Translate_News2Mail;
          Translate_Mail2Netmail;
          Exit;
     END;

     { Mail -> Echomail }
     IF NeedEchomail AND (Msg.Ready_U = Mail) THEN
     BEGIN
          Translate_Mail2News;
          Translate_News2Echomail;
          Exit;
     END;

     { Echomail -> Mail }
     { needed for Area -> List -> Mail }
     IF NeedEmail AND (Msg.Ready_F IN [Echomail,Local_Echomail]) THEN
     BEGIN
          Translate_Echomail2News;
          Translate_News2Mail;
          Exit;
     END;

     LogMessage (liReport,'Could not decide on next translation!');

     LogAllDestinations;

     LogExtraMessage ('Ready:F='+Byte2String (Byte (Msg.Ready_F))+
                      ',U='+Byte2String (Byte (Msg.Ready_U))+
                      ',Needs:'+Byte2String (Byte (NeedEmail))+
                      ','+Byte2String (Byte (NeedNetmail))+
                      ','+Byte2String (Byte (NeedNews))+
                      ','+Byte2String (Byte (NeedEchomail)));
END;


{--------------------------------------------------------------------------}
{ Deliver_FilterBounce                                                     }
{                                                                          }
{ This routine is called when a BOUNCE or BOUNCE-TO filter triggered. The  }
{ mapper record is read from disk again and a proper bounce is performed.  }
{                                                                          }
PROCEDURE Deliver_FilterBounce;

VAR Filter : FilterRecord;

BEGIN
     CASE Msg.Ready_F OF
          Netmail,
          Local_Netmail :
              BEGIN
                   Flex_Filter_Read (Msg.MapperPos,Filter);
                   IF (Filter.Action = matBounceAddr) THEN
                   BEGIN
                        IF (Filter.AddrType = madFTN) THEN
                           FTN_BounceTo (Filter.Argument,{Reason}
                                         Msg.FromUser_F,{FromName}
                                         '(not relevant - BOUNCE filter)',{WasAddressedTo}
                                         FALSE{Normal FTN},
                                         Filter.ToName,
                                         Filter.ToAKA,
                                         ''{email})
                        ELSE
                            FTN_BounceTo (Filter.Argument,{Reason}
                                          Msg.FromUser_F,{FromName}
                                          '(not relevant - BOUNCE filter)',{WasAddressedTo}
                                          TRUE{Remote GW users},
                                          Filter.ToName,
                                          Filter.ToAKA,
                                          Filter.ToEmail)
                   END ELSE
                       FTN_Bounce (Filter.Argument,{Reason}
                                   Msg.FromUser_F,{FromName}
                                   '(not relevant - BOUNCE filter)'{WasAddressedTo});
                   Exit;
              END;

          Echomail,
          Local_Echomail :
              BEGIN
                   LogMessage (liReport,'Cannot BOUNCE echomail!');
                   Exit;
              END;
     END;

     CASE Msg.Ready_U OF
          Mail :
              BEGIN
                   Flex_Filter_Read (Msg.MapperPos,Filter);
                   IF (Filter.Action = matBounceAddr) THEN
                      RFC_BounceTo (Filter.Argument,{Reason}
                                    '(not relevant - BOUNCE filter)',{WasAddressedTo}
                                    Filter.ToEmail)
                   ELSE
                       RFC_Bounce (Filter.Argument,{Reason}
                                   '(not relevant - BOUNCE filter)'{WasAddressedTo});
                   Exit;
              END;

          News :
              BEGIN
                   LogMessage (liReport,'Cannot BOUNCE news!');
                   Exit;
              END;
     END;

     LogMessage (liReport,'FilterBounce: Ready type unknown!');
END;


{--------------------------------------------------------------------------}
{ Deliver_RouteTdbBounce                                                   }
{                                                                          }
{ This routine is called when a BOUNCE or BOUNCEFROM statement from the    }
{ ROUTE.TDB file triggered on the current messsage, which is in Ready_U =  }
{ Mail. The message is bounced back to its source.                         }
{                                                                          }
PROCEDURE Deliver_RouteTdbBounce;
BEGIN
     RFC_Bounce (Msg.BounceReason,
                 '(not relevant - BOUNCE(FROM) statement)'{WasAddressedTo});
END;


{--------------------------------------------------------------------------}
{ DeliverNow                                                               }
{                                                                          }
{ This routine is called from all places where messages are read from disk }
{ or from a message base, to have it distributed to where ever it is set   }
{ to go. This routine has taken over from the old MsgsExport and should be }
{ called instead.                                                          }
{                                                                          }
{ The DestRecords bevatten alle details over het afleveren. Zowel multiple }
{ recipients in de verschillende formaten als message bases are set up     }
{ there. The task of this function is to make sure the Raw addresses are   }
{ worked out to a final destination and to have the message delivered in   }
{ all the required formats, with the least number of gating operations in  }
{ between.                                                                 }
{                                                                          }
{ SenderUserRecNr must be set to the record number of the sending user, or }
{ to NILRecordNr when exporting from a message base. This is used when     }
{ verifying area access and for auto-area-creation.                        }
{                                                                          }
FUNCTION DeliverNow : DeliverResultType;

VAR Result : DeliverResultType;

    {----------------------------------------------------------------------}
    { UpdateResult                                                         }
    {                                                                      }
    { This routine updates the Result variable according to the new result }
    { and the "importantness" of the result. Normal < Received < Gated.    }
    {                                                                      }
    PROCEDURE UpdateResult (NewResult : DeliverResultType);
    BEGIN
         IF (Byte (NewResult) > Byte (Result)) THEN
            Result:=NewResult;
    END;

    PROCEDURE FixEmptyToUser;

    VAR DestPtr    : DestRecordPtr;
        HulpDomain,
        HulpUser   : STRING;

    BEGIN
         { Use the first valid (non-destArea) destRecord.  If we still }
         { don't have a valid match, use 'Unknown'                     }

         Msg.ToUser_F:='Unknown';

         DestPtr:=Msg.FirstDest;
         WHILE (DestPtr <> NIL) DO
         BEGIN
              IF (DestPtr^.Status IN [destRFC,destRFCRaw,destRFCUser]) THEN
              BEGIN
                   UseAdresParse (DestPtr^.To_U,HulpDomain,HulpUser);
                   Msg.ToUser_F:=FtnizeUserName (HulpUser);
                   Break;
              END;

              IF (NOT (DestPtr^.Status IN [destNewsArea, destNetArea, destEchoArea])) THEN
              BEGIN
                   Msg.ToUser_F:=DestPtr^.ToUser_F;
                   Break;
              END;

              DestPtr:=DestPtr^.NextDest;
         END;

         {$IFDEF Pre}
         IF Config.LogDebug THEN
            LogMessage (liDebug,'[HeaderFix] Changed empty to-header to "'+Msg.ToUser_F+'"');
         {$ENDIF}

         {## are the two below necessary?}
         {## Stored_ToAddr might be handled by Trans code}
         FidoSplit ('0:0/0.0',Msg.Stored_ToAddr);  {## could take GW aka as well}
         Msg.Stored_ToUser:=Msg.ToUser_F;
    END;

VAR MaxLoops : BYTE;
    Lp       : BYTE;

LABEL LogEnd;

BEGIN
     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverNow enter');

     { Used for msgs/sec calculations }
     Inc (GlobalMsgCount);

     Result:=drNormal;

     IF Config.LogDebug THEN
     BEGIN
          IF (Msg.DeliveringUserRecNr = NILRecordNr) THEN
             LogMessage (liDebug,'Sender is WaterGate')
          ELSE
              LogMessage (liDebug,'Sender is UserRecNr '+Word2String (Msg.DeliveringUserRecNr));

          IF (Msg.ExportAreaRecNr <> NILRecordNr) THEN
             LogMessage (liDebug,'Is export from area '+Word2String (Msg.ExportAreaRecNr));
     END;

     PeekMem; { nu zit het geheugen propje vol }
     Slice_Now;

     { Kijk of we te maken hebben met een te groot bericht        }
     { als dat het geval is, mag het bericht NOOIT geexporteerd   }
     { worden.                                                    }
     IF MsgTrashAllNewLines THEN
        GOTO LogEnd;

     Address_CheckRFCRaw;

     FOR Lp:=1 TO Msg.ExportedCount DO
         Msg.Exported^[Lp]:=etReady;

     IF (Msg.DeliveringUserRecNr <> NILRecordNr) THEN
        IF (Msg.Ready_F = Echomail) OR (Msg.Ready_U = News) THEN
           Msg.Exported^[Msg.DeliveringUserRecNr]:=etIsSource;

     {## have to get rid of these some day.. }
     UserDataRecNr:=Msg.DeliveringUserRecNr;
     AreaCreatorUserBaseRecNr:=Msg.DeliveringUserRecNr;

     { voor Usenet Dupe nog geen afhandelings routine }
     IF (Msg.Ready_U = Dupe) THEN
     BEGIN
          LogMessage (liFatal,'Deleting DUPE message from RFC side');
          GOTO LogEnd;
     END;

     { Als een bad bericht is, toss het dan naar de BADMAIL directory  }
     IF (Msg.Ready_F = Bad) THEN
     BEGIN
          WriteMessageToBad;
          GOTO LogEnd;
     END;

     { Als het een Dupe bericht is, schrijf het naar de dupe directory }
     IF (Msg.Ready_F = Dupe) THEN
     BEGIN
          WriteMessageToDupe;
          GOTO LogEnd;
     END;

     {$IFDEF Pre}
     Msgs_SanityCheck;
     {$ENDIF}

     { Fix the TO: field if necessary }
     IF (Msg.ToUser_F = '') THEN
        FixEmptyToUser;

     Mappers_Detect (Msg.DeliveringUserRecNr = NILRecordNr{IsOutbound});

     { handle final destination mappers here at once }
     IF (Msg.MapperAction = matDelete) THEN
     BEGIN
          MsgsFreeAllDestRecords({silent:}TRUE);
          LogMessage (liGeneral,'Message stops here');
          GOTO LogEnd;
     END;

     IF (Msg.MapperAction IN [matSave,matToFile]) THEN
     BEGIN
          Mappers_SaveMessage;
          IF (Msg.MapperAction = matToFile) THEN
             GOTO LogEnd;
     END;

     IF (Msg.MapperAction IN [matBounce,matBounceAddr]) THEN
     BEGIN
          Deliver_FilterBounce;
          GOTO LogEnd;
     END;

     IF (Msg.Ready_U = Mail) THEN
     BEGIN
          { check for bounce(from) statements from the route.tdb }
          IF CheckForRouteTdbBounce THEN
          BEGIN
               Deliver_RouteTdbBounce;
               GOTO LogEnd;
          END;
     END;

     { do not leave this routine until the message has been delivered to }
     { all possible destinations.                                        }

     MaxLoops:=5;

     WHILE (Msg.FirstDest <> NIL) DO
     BEGIN
          {LogAllDestinations;}

          PeekMem; { nu zit het geheugen propje vol }
          Slice_Now;

          IF (Msg.Ready_U <> NotReady) AND (Msg.Ready_F <> NotReady) THEN
          BEGIN
               LogMessage (liReport,'Ready for two formats!');
               GOTO LogEnd;
          END;

          { AAT 000709: Dropped messages should not trigger next case }
          IF (Msg.Ready_F = Bad) OR (Msg.Ready_U = Bad) THEN
          BEGIN
               LogMessage (liGeneral, 'Message dropped at delivery');
               GOTO LogEnd;
          END;

          IF (Msg.Ready_F = NotReady) AND (Msg.Ready_U = NotReady) THEN
          BEGIN
               LogMessage (liReport,'Message not ready in either format!');
               GOTO LogEnd;
          END;

          { deliver in current format }
          IF (Msg.Ready_U = Mail) THEN
             DeliverMail;

          IF (Msg.Ready_U = News) THEN
             DeliverNews;

          IF (Msg.Ready_F IN [Local_Netmail,Netmail]) THEN
             UpdateResult (DeliverNetmail);

          IF (Msg.Ready_F IN [Local_Echomail,Echomail]) THEN
             DeliverEchomail;

          IF (Msg.FirstDest <> NIL) THEN
          BEGIN
               { decide to gate to what format next }
               Deliver_TranslateNow;

               IF (MaxLoops = 0) THEN
               BEGIN
                    LogMessage (liFatal,'Detected too many loops; aborting');
                    Break; { from the while }
               END;

               Dec (MaxLoops);
          END;
     END; { while }

LogEnd:

     IF Config.LogDebug THEN
        LogMessage (liDebug,'DeliverNow exit ('+Byte2String (Byte (Result))+')');

     LogClose; { flush }

     DeliverNow:=Result;
END;


{--------------------------------------------------------------------------}
{ Unit Initialisation                                                      }
{                                                                          }
BEGIN
     FoundBagReturnUser:=0; { not found yet }
     SmartHostUserRecNr:=NILRecordNr; { not found (yet) }
END.

