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

{$i platform.inc}

{ all outbound handling code for FTN, UUCP and SMTP gathered in this }
{ module, dynamically handling the handles used. UUCP mail and news  }
{ in separate outbound archives. Outbound archives are identified by }
{ the mail/news flag and the user base record number.                }

INTERFACE

USES Database;

TYPE OutboundTypes = (otSmtpMail,
                      otUucpMail,
                      otUucpNews,
                      otFtnNet,
                      otFtnEcho,
                      otSoupMail,
                      otSoupNews,
                      otInetMail);

TYPE
     SoupEnvelopeRecordPtr = ^SoupEnvelopeRecord;
     SoupEnvelopeRecord= RECORD
                              Address:  STRING [MaxLenDomain];
                              Next:     SoupEnvelopeRecordPtr;
                         END;

     OutboundRecordPtr = ^OutboundRecord;
     OutboundRecord    = RECORD
                               OutType   : OutboundTypes;
                               UserRecNr : UserBaseRecordNrType;

                               OutFile   : FILE;
                               OutName   : STRING[90]; { for logging }
                               IsOpen    : BOOLEAN;
                               AccessCnt : BYTE;
                               Limit     : LONGINT;
                               PktFormat : PktFormatType;
                               Offset    : LONGINT; { P2K/rnews }

                               EnvelopeLeft : WORD;
                               SoupEnvelope : SoupEnvelopeRecordPtr;

                               { Statistics }
                               DestSystem: STRING[22]; {xxxx:yyyy/zzzzz.ppppp}
                               MsgsEcho,
                               MsgsMail,
                               MsgsBytes:  LONGINT;

                               NextPtr   : OutboundRecordPtr;
                         END;

PROCEDURE Outbound_Init;
PROCEDURE Outbound_FinishNow;
PROCEDURE Outbound_Done;

FUNCTION  SmtpMailOut_StartNewJob (UserRecNr : UserBaseRecordNrType; TargetDomain,WrkFileFrom : STRING) : OutboundRecordPtr;
PROCEDURE SmtpMailOut_AddRecipient (OutPtr : OutboundRecordPtr; Recipient : STRING);
FUNCTION  SmtpMailOut_CloseEnvelope (OutPtr : OutboundRecordPtr) : BOOLEAN;
PROCEDURE SmtpMailOut_WriteToJob (OutPtr : OutboundRecordPtr; Count: WORD; VAR Buffer);
PROCEDURE SmtpMailOut_CloseJob (OutPtr : OutboundRecordPtr);

FUNCTION  InetMailOut_StartNewJob (UserRecNr : UserBaseRecordNrType; WrkFileFrom : STRING) : OutboundRecordPtr;
PROCEDURE InetMailOut_AddRecipient (OutPtr : OutboundRecordPtr; Recipient : STRING);
FUNCTION  InetMailOut_CloseEnvelope (OutPtr : OutboundRecordPtr) : BOOLEAN;
PROCEDURE InetMailOut_WriteToJob (OutPtr : OutboundRecordPtr; Count: WORD; VAR Buffer);
PROCEDURE InetMailOut_CloseJob (OutPtr : OutboundRecordPtr);

FUNCTION  UucpMailOut_StartNewJob (UserRecNr : UserBaseRecordNrType) : OutboundRecordPtr;
FUNCTION  UucpMailOut_AddRecipient (OutPtr : OutboundRecordPtr; Recipient : STRING) : BOOLEAN;
FUNCTION  UucpMailOut_CloseEnvelope (OutPtr : OutboundRecordPtr) : BOOLEAN;
PROCEDURE UucpMailOut_WriteToJob (OutPtr : OutboundRecordPtr; Count: WORD; VAR Buffer);
PROCEDURE UucpMailOut_CloseJob (OutPtr : OutboundRecordPtr);

FUNCTION  UucpNewsOut_StartOfMessage (UserRecNr : UserBaseRecordNrType) : OutboundRecordPtr;
PROCEDURE UucpNewsOut_WriteRNewsHeader (OutPtr : OutboundRecordPtr);
PROCEDURE UucpNewsOut_WriteToBatch (OutPtr : OutboundRecordPtr; Count : WORD; VAR Buffer);
PROCEDURE UucpNewsOut_EndOfMessage (OutPtr : OutboundRecordPtr);

FUNCTION  SoupMailOut_StartOfMessage (IsNews: BOOLEAN; UserRecNr : UserBaseRecordNrType) : OutboundRecordPtr;
PROCEDURE SoupMailOut_WriteMessageHeader (OutPtr : OutboundRecordPtr);
PROCEDURE SoupMailOut_WriteToBatch (OutPtr : OutboundRecordPtr; Count: WORD; VAR Buffer);
FUNCTION  SoupMailOut_AddRecipient (OutPtr : OutboundRecordPtr; Recipient : STRING) : BOOLEAN;
FUNCTION  SoupMailOut_CloseEnvelope (OutPtr : OutboundRecordPtr) : BOOLEAN;
PROCEDURE SoupMailOut_EndOfMessage (OutPtr : OutboundRecordPtr);
PROCEDURE SoupMailOut_CloseJob (OutPtr : OutboundRecordPtr);

PROCEDURE Outbound_StoreP2KOffset (OutPtr : OutboundRecordPtr);
PROCEDURE Outbound_UpdateP2kHeader (OutPtr : OutboundRecordPtr; Count : WORD; VAR Buffer);

FUNCTION  FtnNetOut_StartOfMessage (UserRecNr : UserBaseRecordNrType; PktSenderAddress : FidoAddrType;
                                    HasCrashStatus : BOOLEAN) : OutboundRecordPtr;
FUNCTION  FtnNetOut_UnknownSystem_StartOfMessage (ToAddress,PktSenderAddress : FidoAddrType;
                                                  HasCrashStatus : BOOLEAN) : OutboundRecordPtr;
PROCEDURE FtnNetOut_WriteToPkt (OutPtr : OutboundRecordPtr; Count : WORD; VAR Buffer);
PROCEDURE FtnNetOut_EndOfMessage (OutPtr : OutboundRecordPtr);

FUNCTION  FtnEchoOut_StartOfMessage (UserRecNr : UserBaseRecordNrType;
                                     PktSenderAddress : FidoAddrType) : OutboundRecordPtr;
PROCEDURE FtnEchoOut_WriteToPkt (OutPtr : OutboundRecordPtr; Count : WORD; VAR Buffer);
PROCEDURE FtnEchoOut_EndOfMessage (OutPtr : OutboundRecordPtr);


{ configuration items through ROUTE.TDB }
VAR GZipBatchLetter : CHAR;
    GigoMinusFLine  : STRING[80];
    FakeUserRecNr   : UserBaseRecordNrType;


IMPLEMENTATION

USES Ramon,
     Cfg,
     Logs,
     Globals,
     Usenet,
     Start,
     Fido,
     NewExec,   { GoExec }
     Cun,       { AddCun }
     FidoPkt,
     Pkt2000,
     NewStats,
     UnixTime,  { For Inet.Mail queues }
     Dos;       { GetDate/GetTime }

VAR FirstOutPtr : OutboundRecordPtr;


{--------------------------------------------------------------------------}
{ CreateNewOutboundRecord                                                  }
{                                                                          }
FUNCTION CreateNewOutboundRecord : OutboundRecordPtr;

VAR FindPtr,
    OutPtr  : OutboundRecordPtr;

BEGIN
     GetMem (OutPtr,SizeOf (OutboundRecord));
     {$IFDEF LogGetMem} LogGetMem (OutPtr,SizeOf (OutboundRecord),'OutboundRecord'); {$ENDIF}

     FillChar (OutPtr^,SizeOf (OutboundRecord),0);

     { add to chain }
     IF (FirstOutPtr = NIL) THEN
        FirstOutPtr:=OutPtr
     ELSE BEGIN
          FindPtr:=FirstOutPtr;
          WHILE (FindPtr^.NextPtr <> NIL) DO
                FindPtr:=FindPtr^.NextPtr;
          FindPtr^.NextPtr:=OutPtr;
     END;

     CreateNewOutboundRecord:=OutPtr;
END;


{--------------------------------------------------------------------------}
{ DeleteOutboundRecord                                                     }
{                                                                          }
{ This routine unchains the given outbound record and then deletes it.     }
{                                                                          }
PROCEDURE DeleteOutboundRecord (OutPtr : OutboundRecordPtr);

VAR FindPtr : OutboundRecordPtr;

BEGIN
     IF (FirstOutPtr = OutPtr) THEN
        FirstOutPtr:=FirstOutPtr^.NextPtr
     ELSE BEGIN
          FindPtr:=FirstOutPtr;
          WHILE (FindPtr <> NIL) AND (FindPtr^.NextPtr <> OutPtr) DO
                FindPtr:=FindPtr^.NextPtr;

          IF (FindPtr <> NIL) THEN
             FindPtr^.NextPtr:=OutPtr^.NextPtr;
     END;

     {$IFDEF LogGetMem} LogGetMem (OutPtr,SizeOf (OutboundRecord),'free OutboundRecord'); {$ENDIF}
     FreeMem (OutPtr,SizeOf (OutboundRecord));
END;


{--------------------------------------------------------------------------}
{ FindLeastUsed                                                            }
{                                                                          }
{ This routine is called to find the least used and now open file that we  }
{ can close. A pointer to the record is returned.                          }
{                                                                          }
FUNCTION FindLeastUsed : OutboundRecordPtr;

VAR LeastPtr,
    FindPtr  : OutboundRecordPtr;

BEGIN
     LeastPtr:=NIL;
     FindPtr:=FirstOutPtr;

     WHILE (FindPtr <> NIL) DO
     BEGIN
          IF (FindPtr^.IsOpen) THEN
          BEGIN
               IF (LeastPtr = NIL) THEN
                  LeastPtr:=FindPtr
               ELSE
                   IF (FindPtr^.AccessCnt < LeastPtr^.AccessCnt) THEN
                      LeastPtr:=FindPtr;
          END;

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

     IF (LeastPtr = NIL) THEN
        LogMessage (liFatal,'No files left to close!! Get ready for trouble ;)');

     FindLeastUsed:=LeastPtr;
END;


{--------------------------------------------------------------------------}
{ CheckFreeHandle                                                          }
{                                                                          }
{ Deze routine kijkt of het mogelijk is om een file te openen. Als dat     }
{ niet zo is, dan wordt er een dichtgegooid volgens het gebruikelijke      }
{ algoritme: oudste eerst.                                                 }
{ This function returns FALSE if no file could be closed, otherwise TRUE.  }
{                                                                          }
FUNCTION CheckFreeHandle : BOOLEAN;

VAR IORes    : BYTE;
    TestFile : FILE;
    OutPtr   : OutboundRecordPtr;

BEGIN
     REPEAT
           Assign (TestFile,TempPath+'TESTFILE');
           {$I-} ReWrite (TestFile); {$I+} IORes:=IOResult;
           IF (IORes <> 0) THEN
           BEGIN
                OutPtr:=FindLeastUsed;

                IF (OutPtr = NIL) THEN
                BEGIN
                     CheckFreeHandle:=FALSE; { could not close a file }
                     Exit;
                END;

                {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
                Close (OutPtr^.OutFile);
                OutPtr^.IsOpen:=FALSE;
           END;
     UNTIL (IORes = 0);

     {$IFDEF LogFileIO}PostOpenF (TestFile);{$ENDIF}
     {$IFDEF LogFileIO}PreCloseF (TestFile);{$ENDIF}
     Close (TestFile);

     Erase (TestFile);

     CheckFreeHandle:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ ReOpenOutFile                                                            }
{                                                                          }
{ This routine tries to re-open the outbound file if it had been closed.   }
{ FALSE is returned if this fails.                                         }
{                                                                          }
FUNCTION ReOpenOutFile (OutPtr : OutboundRecordPtr) : BOOLEAN;

VAR IORes : BYTE;

BEGIN
     ReOpenOutFile:=FALSE; { assume error }

     IF (OutPtr = NIL) THEN
     BEGIN
          LogMessage (liFatal,'[ReOpenOutFile] No admin!!');
          Exit;
     END;

     IF (NOT OutPtr^.IsOpen) THEN
     BEGIN
          IF (NOT CheckFreeHandle) THEN
          BEGIN
               LogMessage (liFatal,'No free handle to re-open '+OutPtr^.OutName);
               Exit; { with FALSE }
          END;

          {$I-} Reset (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Failed to re-open '+OutPtr^.OutName);
               Exit;
          END;

          Seek (OutPtr^.OutFile,FileSize (OutPtr^.OutFile));

          OutPtr^.IsOpen:=TRUE;
     END;

     ReOpenOutFile:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ FindOutboundRecord                                                       }
{                                                                          }
{ This routine searches all outbound records for one with the matching     }
{ type and user record. This is used by UUCP news and FTN to add messages  }
{ to an open outbound job.                                                 }
{                                                                          }
FUNCTION FindOutboundRecord (UserRecNr : UserBaseRecordNrType; OutType : OutboundTypes) : OutBoundRecordPtr;

VAR FindPtr : OutboundRecordPtr;

BEGIN
     FindPtr:=FirstOutPtr;

     WHILE (FindPtr <> NIL) DO
     BEGIN
          IF (FindPtr^.OutType = OutType) AND
             (FindPtr^.UserRecNr = UserRecNr)
          THEN
              Break; { from the while }

          FindPtr:=FindPtr^.NextPtr;
     END;

     FindOutboundRecord:=FindPtr;
END;


{==========================================================================}
{                            SMTP MAIL                                     }
{==========================================================================}


{--------------------------------------------------------------------------}
{ GetNextSmtpOutSequence                                                   }
{                                                                          }
{ Deze routine leests de sequence.seq file in verhoogt deze met 1 en geeft }
{ dat nummer terug na het weer in de file geschreven te hebben.            }
{                                                                          }
FUNCTION GetNextSmtpOutSequence (Path : STRING) : STRING;

VAR Nr      : LONGINT;
    SeqFile : TEXT;
    IORes   : BYTE;

BEGIN
     Path:=Path+'SEQUENCE.SEQ';
     Nr:=1; { in case it doesn't exist yet }

     Assign (SeqFile,Path);
     {$I-} Reset (SeqFile); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          {$IFDEF LogFileIO}PostOpenT (SeqFile);{$ENDIF}
          ReadLn (SeqFile,Nr);
     END ELSE
         IF (IORes <> 2) THEN
            LogDiskIOError (IORes,'Failed to open '+Path);

     { dit nummer gebruiken }
     GetNextSmtpOutSequence:=Longint2String (Nr);

     { en daarna pas verhogen }
     Inc (Nr);

     { Close And Rewrite }
     {$I-} ReWrite (SeqFile); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          {$IFDEF LogFileIO}PostOpenT (SeqFile);{$ENDIF}
          WriteLn (SeqFile,Nr);
          {$IFDEF LogFileIO}PreCloseT (SeqFile);{$ENDIF}
          Close (SeqFile);
     END ELSE
     BEGIN
          LogDiskIOError (IORes,'Failed to create '+Path);
          GetNextSmtpOutSequence:=''; { indicate that it failed! }

          { close, just in case }
          {$IFDEF LogFileIO}PreCloseT (SeqFile);{$ENDIF}
          {$I-} Close (SeqFile); {$I+} IORes:=IOResult;
     END;
END;


{--------------------------------------------------------------------------}
{ SmtpMailOut_StartNewJob                                                  }
{                                                                          }
{ This routine is called to create a new outbound SMTP job for this user.  }
{ It starts a .WRK file with the extension .WR$ and keeps it open when it  }
{ returns the pointer, so _AddRecipient can be used to add lots recipient  }
{ addresses.                                                               }
{                                                                          }
FUNCTION SmtpMailOut_StartNewJob (UserRecNr : UserBaseRecordNrType; TargetDomain,WrkFileFrom : STRING) : OutboundRecordPtr;

VAR OutPtr  : OutboundRecordPtr;
    OutNr   : STRING[8];
    Temp    : STRING;
    IORes   : BYTE;
    UserRec : UserBaseRecord;

BEGIN
     SmtpMailOut_StartNewJob:=NIL; { in case of errors }

     IF (NOT CheckFreeHandle) THEN
     BEGIN
          LogMessage (liFatal,'No free handle to create a SMTP job; aborting');
          Exit; { met NIL }
     END;

     OutPtr:=CreateNewOutboundRecord;

     OutPtr^.OutType:=otSmtpMail;
     OutPtr^.UserRecNr:=UserRecNr;

     ReadUserBaseRecord (UserRecNr,UserRec);
     Temp:=CorrectPath (UserRec.SmtpOutPath);

     OutNr:=GetNextSmtpOutSequence (Temp);

     IF (OutNr = '') THEN
     BEGIN
          LogMessage (liFatal,'Failed to get SMTP job number; aborting');
          DeleteOutboundRecord (OutPtr); { RAWI 980215 }
          Exit;
     END;

     OutPtr^.OutName:=Temp+OutNr+'.WR$';

     { .LCK file zetten }

     { maak een .WRK file aan }
     Assign (OutPtr^.OutFile,OutPtr^.OutName);
     {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to create '+OutPtr^.OutName);
          { .LCK verwijderen }
          DeleteOutboundRecord (OutPtr);
          Exit; { met NIL }
     END;

     {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

     OutPtr^.IsOpen:=TRUE;
     OutPtr^.AccessCnt:=0;
     OutPtr^.Limit:=MaxLongint;
     OutPtr^.EnvelopeLeft:=63000; { fictive limit }

     IF Config.LogSMTPOutbound THEN
        LogMessage (liTrivial,'Created SMTP job '+OutNr+' for '+UserRec.UUCPname);

     UpdateInfoNr (INFO_SmtpOut_Jobs,1);
     UpdateInfoNr (INFO_SmtpOut_Msgs,1);
     UpdateInfoNr (INFO_SmtpOut_Mail,1);

     { Statistics }
     OutPtr^.DestSystem := UserRec.UUCPName;
     OutPtr^.MsgsMail := 1;

     Temp:=TargetDomain+#13#10;
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     Temp:=WrkFileFrom+#13#10;
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     SmtpMailOut_StartNewJob:=OutPtr;
END;


{--------------------------------------------------------------------------}
{ SmtpMailOut_AddRecipient                                                 }
{                                                                          }
{ This routine adds the given recipient address to the envelope file.      }
{                                                                          }
PROCEDURE SmtpMailOut_AddRecipient (OutPtr : OutboundRecordPtr; Recipient : STRING);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding '+Recipient);
          Exit;
     END;

     Recipient:=Recipient+#13#10;
     BlockWrite (OutPtr^.OutFile,Recipient[1],Length (Recipient));
END;


{--------------------------------------------------------------------------}
{ SmtpMailOut_CloseEnvelope                                                }
{                                                                          }
{ This routine must be called to indicate that all recipient addresses     }
{ have been added to the envelope we can close the that file and open the  }
{ body file instead.                                                       }
{ Returns TRUE on success, FALSE when it failed to create the .TX$ file.   }
{                                                                          }
FUNCTION SmtpMailOut_CloseEnvelope (OutPtr : OutboundRecordPtr) : BOOLEAN;

VAR L     : BYTE;
    IORes : BYTE;

BEGIN
     SmtpMailOut_CloseEnvelope:=FALSE; { assume failure }

     IF (OutPtr^.IsOpen) THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
          Close (OutPtr^.OutFile);
          OutPtr^.IsOpen:=FALSE;
     END;

     { nog niet renamen }
     { wel .TX$ file openen }

     L:=Length (OutPtr^.OutName);
     OutPtr^.OutName[L-2]:='T';
     OutPtr^.OutName[L-1]:='X';

     IF (NOT CheckFreeHandle) THEN
     BEGIN
          LogMessage (liFatal,'No free handle to create '+OutPtr^.OutName);
          Exit; { with FALSE }
     END;

     Assign (OutPtr^.OutFile,OutPtr^.OutName);
     {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error creating '+OutPtr^.OutName);
          { .WR$ verwijderen }
          { .LCK verwijderen }
          DeleteOutboundRecord (OutPtr);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

     OutPtr^.IsOpen:=TRUE;

     SmtpMailOut_CloseEnvelope:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ SmtpMailOut_WriteToJob                                                   }
{                                                                          }
{ This routine writes a block of raw data to the outbound file.            }
{                                                                          }
PROCEDURE SmtpMailOut_WriteToJob (OutPtr : OutboundRecordPtr; Count: WORD; VAR Buffer);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding '+Word2String (Count)+' bytes');
          Exit;
     END;

     BlockWrite (OutPtr^.OutFile,Buffer,Count);
     UpdateInfoNr (INFO_SmtpOut_Bytes,Count);
     Inc (OutPtr^.MsgsBytes,Count);

     IF (OutPtr^.AccessCnt < 255) THEN
        Inc (OutPtr^.AccessCnt);
END;


{--------------------------------------------------------------------------}
{ SmtpMailOut_CloseJob                                                     }
{                                                                          }
{ This routine is call when all lines have been written to the body of the }
{ .TX$ file. Here, we close the file and rename both the .WR$ to .WRK and  }
{ the .TX$ file to .TXT. The OutboundRecord is then disposed off.          }
{                                                                          }
PROCEDURE SmtpMailOut_CloseJob (OutPtr : OutboundRecordPtr);

VAR L     : BYTE;
    IORes : BYTE;

BEGIN
     { close .TX$, if not already closed }
     IF (OutPtr^.IsOpen) THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
          Close (OutPtr^.OutFile);
          OutPtr^.IsOpen:=FALSE;
     END;

     { rename .TX$ to .TXT }
     L:=Length (OutPtr^.OutName);
     OutPtr^.OutName[L]:='T';

     {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'Error renaming .TX$ to '+OutPtr^.OutName)
     ELSE BEGIN
          { rename .WR$ file to .WRK }
          OutPtr^.OutName[L-2]:='W';
          OutPtr^.OutName[L-1]:='R';
          OutPtr^.OutName[L]:='$';
          Assign (OutPtr^.OutFile,OutPtr^.OutName);

          OutPtr^.OutName[L]:='K';
          {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             LogDiskIOError (IORes,'Error renaming .WR$ to '+OutPtr^.OutName);
     END;

     { Statistics }
     StatEntry_SmtpJob (stdOutbound, 'LOCAL', OutPtr^.DestSystem, OutPtr^.MsgsBytes, OutPtr^.MsgsMail);

     DeleteOutboundRecord (OutPtr);
END;

{==========================================================================}
{                       INET.MAIL SUPPORT                                  }
{==========================================================================}


{--------------------------------------------------------------------------}
{ GetNextInetMailFilename                                                  }
{                                                                          }
{ This routine figures out what the next avilable message file is (count-  }
{ ing from 1 and up).                                                      }
{                                                                          }
FUNCTION GetNextInetMailFilename (Path : STRING) : STRING;

VAR Nr      : LONGINT;
    IORes   : BYTE;
    TempF   : FILE;
    Filename: STRING [12];

BEGIN
     Nr := 1;

     { Unlikely that we'd ever get this high, but ... }
     WHILE (Nr < MaxLongInt) DO
     BEGIN
          Filename := AddUpWithPre0s (8, LongInt2String (Nr)) + '.MSG';

          Assign (TempF, Path+Filename);
          {$I-} Reset (TempF, 1); IORes := IOResult; {$I+}
          IF IORes = 2 THEN
          BEGIN
               { Remove .MSG from the end }
               Delete (Filename, Length (Filename)-3, 4);

               GetNextInetMailFilename := Path+Filename;
               Exit;          {## EXIT ##}
          END;

          IF (IORes = 0) THEN
               Close (TempF);

          Inc (Nr);
     END;

     GetNextInetMailFilename := '';         { fail }
END;


{--------------------------------------------------------------------------}
{ InetMailOut_StartNewJob                                                  }
{                                                                          }
{ This routine is called to create a new outbound INET.MAIL job for this   }
{ user.  It starts the .QUE file (envelope).                               }
{                                                                          }
VAR
     LastInetMail_MSGID: LONGINT;

FUNCTION InetMailOut_StartNewJob (UserRecNr : UserBaseRecordNrType; WrkFileFrom : STRING) : OutboundRecordPtr;

VAR OutPtr  : OutboundRecordPtr;
    OutFile : STRING;
    Temp    : STRING;
    IORes   : BYTE;
    UserRec : UserBaseRecord;
    TimeStmp: LONGINT;

BEGIN
     InetMailOut_StartNewJob:=NIL; { in case of errors }

     IF (NOT CheckFreeHandle) THEN
     BEGIN
          LogMessage (liFatal,'No free handle to create a INET.MAIL job; aborting');
          Exit; { met NIL }
     END;

     OutPtr:=CreateNewOutboundRecord;

     OutPtr^.OutType:=otInetMail;
     OutPtr^.UserRecNr:=UserRecNr;

     ReadUserBaseRecord (UserRecNr,UserRec);
     Temp:=CorrectPath (UserRec.InetMailQueue);

     OutFile:=GetNextInetMailFilename (Temp);

     IF (OutFile = '') THEN
     BEGIN
          LogMessage (liFatal,'Failed to get INET.MAIL job number; aborting');
          DeleteOutboundRecord (OutPtr); { RAWI 980215 }
          Exit;
     END;

     OutPtr^.OutName:=OutFile+'.QU$';

     Assign (OutPtr^.OutFile,OutPtr^.OutName);
     {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to create '+OutPtr^.OutName);
          DeleteOutboundRecord (OutPtr);
          Exit; { met NIL }
     END;

     {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

     OutPtr^.IsOpen:=TRUE;
     OutPtr^.AccessCnt:=0;
     OutPtr^.Limit:=MaxLongint;
     OutPtr^.EnvelopeLeft:=63000; { no limit really }

{## add LogINETMAILOutbound

     IF Config.LogSMTPOutbound THEN
        LogMessage (liTrivial,'Created SMTP job '+OutNr+' for '+UserRec.UUCPname);
}
     LogMessage (liTrivial, 'Created INET.MAIL job '+OutFile+' for '+UserRec.UUCPName);
     
     {## add INET.MAIL stats
     UpdateInfoNr (INFO_SmtpOut_Jobs,1);
     UpdateInfoNr (INFO_SmtpOut_Msgs,1);
     UpdateInfoNr (INFO_SmtpOut_Mail,1);
     }

     { Statistics }
     OutPtr^.DestSystem := UserRec.UUCPName;
     OutPtr^.MsgsMail := 1;

     { Format for .QUE file:
          1:   format (q5)
          2:   last time message was read (0)
          3:   time put into queue
          4:   delay notice time (0)
          5:   message-id (calculated from timestamp)
          6:   source mail domain
          7:   FROM address (used for MAIL FROM)
          8:   recipients, one per line
     }


     { 1: Format (q5) }
     Temp := 'q5'+#13+#10;
     BlockWrite (OutPtr^.OutFile, Temp[1], Length (Temp));

     { 2: Last time message was read (0) }
     Temp := '0'+#13+#10;
     BlockWrite (OutPtr^.OutFile, Temp[1], Length (Temp));

     { 3: Time message was put into queue }
     TimeStmp := GetCurrentUnixTime;
     Temp := Longint2String (TimeStmp)+#13+#10;
     BlockWrite (OutPtr^.OutFile, Temp[1], Length (Temp));

     { 4: Delay notice time (0) }
     Temp := '0'+#13+#10;
     BlockWrite (OutPtr^.OutFile, Temp[1], Length (Temp));

     { 5: Message-id calculated from time-stamp }
     { In case we generate more than one message per second. }
     IF (LastInetMail_MSGID = TimeStmp) THEN
          Inc (TimeStmp);

     LastInetMail_MSGID := TimeStmp;
     Temp:=Longint2String (TimeStmp)+#13+#10;
     BlockWrite (OutPtr^.OutFile, Temp[1], Length (Temp));

     { 6: Source domain }
     Temp := UserRec.InetMailSourceDomain+#13+#10;
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     { 7: FROM address }
     Temp := WrkFileFrom+#13+#10;
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     { 8: Recipients, one per line.. }

     InetMailOut_StartNewJob:=OutPtr;
END;


{--------------------------------------------------------------------------}
{ InetMailOut_AddRecipient                                                 }
{                                                                          }
{ This routine adds the given recipient address to the envelope file.      }
{                                                                          }
PROCEDURE InetMailOut_AddRecipient (OutPtr : OutboundRecordPtr; Recipient : STRING);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding '+Recipient);
          Exit;
     END;


     Recipient:=Recipient+#13#10;
     Recipient := DeleteFrontAndBackSpaces (Recipient);

     {LogMessage (liDebug, 'INET RECIP=`'+Recipient+'''');}

     BlockWrite (OutPtr^.OutFile,Recipient[1],Length (Recipient));
END;


{--------------------------------------------------------------------------}
{ InetMailOut_CloseEnvelope                                                }
{                                                                          }
{ This routine must be called to indicate that all recipient addresses     }
{ have been added to the envelope we can close the that file and open the  }
{ body file instead.                                                       }
{ Returns TRUE on success, FALSE when it failed to create the .MS$ file.   }
{                                                                          }
FUNCTION InetMailOut_CloseEnvelope (OutPtr : OutboundRecordPtr) : BOOLEAN;

VAR L     : BYTE;
    IORes : BYTE;

BEGIN
     InetMailOut_CloseEnvelope:=FALSE; { assume failure }

     IF (OutPtr^.IsOpen) THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
          Close (OutPtr^.OutFile);
          OutPtr^.IsOpen:=FALSE;
     END;

     L:=Length (OutPtr^.OutName);
     OutPtr^.OutName[L-2]:='M';
     OutPtr^.OutName[L-1]:='S';

     IF (NOT CheckFreeHandle) THEN
     BEGIN
          LogMessage (liFatal,'No free handle to create '+OutPtr^.OutName);
          Exit; { with FALSE }
     END;

     Assign (OutPtr^.OutFile,OutPtr^.OutName);
     {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error creating '+OutPtr^.OutName);
          DeleteOutboundRecord (OutPtr);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

     OutPtr^.IsOpen:=TRUE;

     InetMailOut_CloseEnvelope:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ InetMailOut_WriteToJob                                                   }
{                                                                          }
{ This routine writes a block of raw data to the outbound file.            }
{                                                                          }
PROCEDURE InetMailOut_WriteToJob (OutPtr : OutboundRecordPtr; Count: WORD; VAR Buffer);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding '+Word2String (Count)+' bytes');
          Exit;
     END;

     BlockWrite (OutPtr^.OutFile,Buffer,Count);

     {## add stats
     UpdateInfoNr (INFO_SmtpOut_Bytes,Count);
     }

     Inc (OutPtr^.MsgsBytes,Count);

     IF (OutPtr^.AccessCnt < 255) THEN
        Inc (OutPtr^.AccessCnt);
END;


{--------------------------------------------------------------------------}
{ InetMailOut_CloseJob                                                     }
{                                                                          }
{ This routine is call when all lines have been written to the body of the }
{ .MS$ file. Here, we close the file and rename both the .QU$ to .QUE and  }
{ the .MS$ file to .MSG. The OutboundRecord is then disposed off.          }
{                                                                          }
PROCEDURE InetMailOut_CloseJob (OutPtr : OutboundRecordPtr);

VAR L     : BYTE;
    IORes : BYTE;

BEGIN
     { close .MS$, if not already closed }
     IF (OutPtr^.IsOpen) THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
          Close (OutPtr^.OutFile);
          OutPtr^.IsOpen:=FALSE;
     END;

     { rename .MS$ to .MSG }
     L:=Length (OutPtr^.OutName);
     OutPtr^.OutName[L]:='G';

     {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'Error renaming .MS$ to '+OutPtr^.OutName)
     ELSE BEGIN
          { rename .WR$ file to .WRK }
          OutPtr^.OutName[L-2]:='Q';
          OutPtr^.OutName[L-1]:='U';
          OutPtr^.OutName[L]:='$';
          Assign (OutPtr^.OutFile,OutPtr^.OutName);

          OutPtr^.OutName[L]:='E';
          {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             LogDiskIOError (IORes,'Error renaming .QU$ to '+OutPtr^.OutName);
     END;

     { Statistics }
     {## stats
     StatEntry_SmtpJob (stdOutbound, 'LOCAL', OutPtr^.DestSystem, OutPtr^.MsgsBytes, OutPtr^.MsgsMail);
     }

     DeleteOutboundRecord (OutPtr);
END;

{==========================================================================}
{                            UUCP MAIL                                     }
{==========================================================================}


{--------------------------------------------------------------------------}
{ CalcOutBitmask                                                           }
{                                                                          }
{ Deze routine berekent de bitmask voor uitgaande files. Dit is de eerste  }
{ letter voor de echte naam.                                               }
{                                                                          }
FUNCTION CalcOutBitmask (Name : STRING) : STRING;
BEGIN
     { dit is heel simpel, want we gebruiken nog geen kleine letters  }
     { in de namen die we aanmaken. We moeten alleen even met de vlag }
     { rekening houden die ons forceert de oude method te gebruiken   }
     { in plaats van de nieuwe.                                       }
     IF Config.ForceNoBitmask THEN
        CalcOutBitmask:=Name
     ELSE BEGIN
          { toch maar even checken }
          IF (Name <> UpCaseString (Name)) THEN
             LogMessage (liReport,'Bitmask will fail!');

          { omdat er geen kleine lettertjes in zitten is de mask '0' }
          CalcOutBitmask:='0'+Name;
     END;
END;


{--------------------------------------------------------------------------}
{ UucpMailOut_StartNewJob                                                  }
{                                                                          }
{ This routine is called to create a new outbound UUCP job for the given   }
{ user. The record will be loaded from disk and a .XQ$ file will be        }
{ started. The caller can then add addresses using the _AddRecipient       }
{ functions below.
{                                                                          }
FUNCTION UucpMailOut_StartNewJob (UserRecNr : UserBaseRecordNrType) : OutboundRecordPtr;

VAR OutPtr   : OutboundRecordPtr;
    OutNr    : STRING[8];
    IORes    : BYTE;
    UserRec  : UserBaseRecord;
    UUCPName : STRING;
    Temp     : STRING;
    P        : BYTE;
    CmdFile  : TEXT;

BEGIN
     UucpMailOut_StartNewJob:=NIL; { in case of errors }

     IF (NOT CheckFreeHandle) THEN
     BEGIN
          LogMessage (liFatal,'No free handle to start a new UUCP mail job; aborting');
          Exit; { met NIL }
     END;

     OutPtr:=CreateNewOutboundRecord;

     OutPtr^.OutType:=otUucpMail;
     OutPtr^.UserRecNr:=UserRecNr;

     ReadUserBaseRecord (UserRecNr,UserRec);

     OutNr:=CalcOutBitmask (GetUsenetUniqueName (UserRec.MailGrade));
     OutPtr^.OutName:=Config.SpoolBaseDir+UserRec.UUCPName+'\'+OutNr+'.XQ$';

     {## check if a .CMD file exists with this name. If so, keep on  }
     {## testing with a new filename until the file does not exit.   }

     { create a .XQ$ file }
     Assign (OutPtr^.OutFile,OutPtr^.OutName);
     {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to create '+OutPtr^.OutName);
          DeleteOutboundRecord (OutPtr);
          Exit; { met NIL }
     END;

     {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

     OutPtr^.IsOpen:=TRUE;
     OutPtr^.AccessCnt:=0;
     OutPtr^.Limit:=MaxLongint; { no limit for mail }
     OutPtr^.EnvelopeLeft:=63000; { fictive limit }

     IF (Config.MaxRMailLineLen > 0) THEN
        OutPtr^.EnvelopeLeft:=Config.MaxRMailLineLen;

     IF Config.LogUUCPOutbound THEN
        LogMessage (liTrivial,'Created UUCP job (mail) '+OutNr+' for '+UserRec.UUCPname);

     UpdateInfoNr (INFO_UucpOut_Jobs,1);
     UpdateInfoNr (INFO_UucpOut_Msgs,1);
     UpdateInfoNr (INFO_UucpOut_Mail,1); { count 1 regardless how many recipients }
     OutPtr^.DestSystem := UserRec.UUCPName;
     OutPtr^.MsgsMail := 1;

     UUCPName:=Config.UUCPName;
     P:=2;

     IF Config.ForceNoBitmask THEN
     BEGIN
          UUCPName:=Copy (UUCPName,1,6);
          P:=1;
     END;

     IF UserRec.GigoT THEN
     BEGIN
          Temp:='#-f '+GigoMinusFLine+#10; { errors-to-addres }
          BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));
     END;

     Temp:='U '+ProgramUserName+' '+Config.UUCPName+#10+'Z'+#10;
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     Temp:='F D.'+UUCPName+Copy (OutNr,P,255)+#10;
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     Temp:='I D.'+UUCPName+Copy (OutNr,P,255)+#10+'C rmail';
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     IF (NOT UserRec.GigoT) THEN
     BEGIN
          { create a .CM$ file }
          Temp:=OutPtr^.OutName;
          Temp[Length (Temp)-2]:='C';
          Temp[Length (Temp)-1]:='M';

          Assign (CmdFile,Temp);
          {$I-} ReWrite (CmdFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             LogDiskIOError (IORes,'Cannot create '+Temp)
          ELSE BEGIN
               {$IFDEF LogFileIO}PostOpenT (CmdFile);{$ENDIF}

               Write (CmdFile,'S '+OutNr+'.DAT D.'+UUCPName+Copy (OutNr,P,255)+' '+
                              ProgramUserName+' - '+OutNr+'.DAT 0666'+#10);
               Write (CmdFile,'S '+OutNr+'.XQT X.'+UUCPName+Copy (OutNr,P,255)+' '+
                              ProgramUserName+' - '+OutNr+'.XQT 0666'+#10);

               {$IFDEF LogFileIO}PreCloseT (CmdFile);{$ENDIF}
               Close (CmdFile);
          END;
     END;

     UucpMailOut_StartNewJob:=OutPtr;
END;


{--------------------------------------------------------------------------}
{ UucpMailOut_AddRecipient                                                 }
{                                                                          }
{ This routine can be called to add a new recipient to the rmail line in   }
{ the .XQ$ file. TRUE is returned if the address could not be added        }
{ because of the rmail line length limit. Otherwise FALSE is returned.     }
{                                                                          }
FUNCTION UucpMailOut_AddRecipient (OutPtr : OutboundRecordPtr; Recipient : STRING) : BOOLEAN;
BEGIN
     UucpMailOut_AddRecipient:=TRUE; { stop adding }

     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding '+Recipient);
          Exit;
     END;

     Recipient:=' '+Recipient;

     { check if this would go over the limit }
     IF (Length (Recipient) > OutPtr^.EnvelopeLeft) THEN
        Exit; { stop adding }

     BlockWrite (OutPtr^.OutFile,Recipient[1],Length (Recipient));

     Dec (OutPtr^.EnvelopeLeft,Length (Recipient));

     UucpMailOut_AddRecipient:=FALSE; { not full }
END;


{--------------------------------------------------------------------------}
{ UucpMailOut_CloseEnvelope                                                }
{                                                                          }
{ This routine must be called to indicate that all recipient addresses     }
{ have been added to the envelope we can close the that file and open the  }
{ body file instead.                                                       }
{ The From_ contents if written to the first line of the body file. It     }
{ must not be empty.                                                       }
{ Returns TRUE on success, FALSE when it failed to create the .DA$ file.   }
{                                                                          }
FUNCTION UucpMailOut_CloseEnvelope (OutPtr : OutboundRecordPtr) : BOOLEAN;

VAR L     : BYTE;
    IORes : BYTE;

BEGIN
     UucpMailOut_CloseEnvelope:=FALSE; { assume failure }

     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not able to finialize.');
          Exit; { with FALSE }
     END;

     { write the line feed behind all the addresses }
     L:=10;
     BlockWrite (OutPtr^.OutFile,L,1);

     { close the .XQ$ file }
     {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
     Close (OutPtr^.OutFile);
     OutPtr^.IsOpen:=FALSE;

     { start the .DA$ file }
     L:=Length (OutPtr^.OutName);
     OutPtr^.OutName[L-2]:='D';
     OutPtr^.OutName[L-1]:='A';

     IF (NOT CheckFreeHandle) THEN
     BEGIN
          LogMessage (liFatal,'No free handle to create '+OutPtr^.OutName);
          Exit; { with FALSE }
     END;

     Assign (OutPtr^.OutFile,OutPtr^.OutName);
     {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error creating '+OutPtr^.OutName);
          { delete .XQ$ file }
          { delete .CM$ file }
          DeleteOutboundRecord (OutPtr);
          Exit; { with FALSE }
     END;

     {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

     UucpMailOut_CloseEnvelope:=TRUE; { succes }
END;


{--------------------------------------------------------------------------}
{ UucpMailOut_WriteToJob                                                   }
{                                                                          }
{ This routine writes a block of data to the outbound file.                }
{                                                                          }
PROCEDURE UucpMailOut_WriteToJob (OutPtr : OutboundRecordPtr; Count : WORD; VAR Buffer);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding '+Word2String (Count)+' bytes');
          Exit;
     END;

     BlockWrite (OutPtr^.OutFile,Buffer,Count);
     UpdateInfoNr (INFO_UucpOut_Bytes,Count);
     Inc (OutPtr^.MsgsBytes,Count);

     IF (OutPtr^.AccessCnt < 255) THEN
        Inc (OutPtr^.AccessCnt);
END;


{--------------------------------------------------------------------------}
{ UucpMailOut_CloseJob                                                     }
{                                                                          }
{ This routine is called when a UUCP mail job has been written out to disk }
{ and the .DA$ file can be closed and renamed to .DAT. The .XQ$ file is    }
{ renamed to .XQT and the .CM$ file is renamed to .CMD as well, except     }
{ when in GigoT mode, because there are no .CMD files then.                }
{ After all this, the OutboundRecord is destroyed.                         }
{                                                                          }
PROCEDURE UucpMailOut_CloseJob (OutPtr : OutboundRecordptr);

VAR UserRec : UserBaseRecord;
    IORes   : BYTE;
    L       : BYTE;

BEGIN
     IF (OutPtr^.IsOpen) THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
          Close (OutPtr^.OutFile);
          OutPtr^.IsOpen:=FALSE;
     END;

     { rename .DA$ to .DAT }
     L:=Length (OutPtr^.OutName);
     OutPtr^.OutName[L]:='T';
     {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error renaming .DA$ to '+OutPtr^.OutName);
          { continue anyway }
     END;

     { rename .XQ$ to .XQT }
     OutPtr^.OutName[L-2]:='X';
     OutPtr^.OutName[L-1]:='Q';
     OutPtr^.OutName[L]:='$';
     Assign (OutPtr^.OutFile,OutPtr^.OutName);

     OutPtr^.OutName[L]:='T';
     {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error renaming .XQ$ to '+OutPtr^.OutName);
          { continue anyway }
     END;

     ReadUserBaseRecord (OutPtr^.UserRecNr,UserRec);

     IF (NOT UserRec.GigoT) THEN
     BEGIN
          { rename .CM$ to .CMD }

          OutPtr^.OutName[L-2]:='C';
          OutPtr^.OutName[L-1]:='M';
          OutPtr^.OutName[L]:='$';
          Assign (OutPtr^.OutFile,OutPtr^.OutName);

          OutPtr^.OutName[L]:='D';
          {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Error renaming .CM$ to '+OutPtr^.OutName);
               { continue anyway }
          END;
     END;

     { Statistics }
     StatEntry_UUCPJob (stdOutbound, 'LOCAL', OutPtr^.DestSystem, OutPtr^.MsgsBytes, OutPtr^.MsgsEcho,
                                                       OutPtr^.MsgsMail);

     DeleteOutboundRecord (OutPtr);
END;


{==========================================================================}
{                            UUCP NEWS                                     }
{==========================================================================}


{--------------------------------------------------------------------------}
{ UucpNewsOut_StartOfMessage                                               }
{                                                                          }
{ This routine must be called when a news article has to be written out to }
{ a news batch. This routine checks for an existing outbound record for    }
{ this user. If found, this message will be added to it. Otherwise, a new  }
{ job is started.                                                          }
{                                                                          }
FUNCTION UucpNewsOut_StartOfMessage (UserRecNr : UserBaseRecordNrType) : OutboundRecordPtr;

VAR OutPtr   : OutboundRecordPtr;
    UserRec  : UserBaseRecord;
    OutNr    : STRING[8];
    IORes    : BYTE;
    UUCPName : STRING;
    Temp     : STRING;
    P        : BYTE;
    CmdFile  : TEXT;

BEGIN
     UucpNewsOut_StartOfMessage:=NIL; { in case of problems }

     { check for a free handle. If none, don't even start the job }
     IF (NOT CheckFreeHandle) THEN
     BEGIN
          LogMessage (liFatal,'No free handle to start a new UUCP news job; aborting');
          Exit; { met NIL }
     END;

     { find an existing outbound record matching this UserRecNr and type }
     OutPtr:=FindOutboundRecord (UserRecNr,otUucpNews);
     IF (OutPtr <> NIL) THEN
     BEGIN
          { Now updating for ALL messages as well }
          UpdateInfoNr (INFO_UucpOut_Msgs,1);
          UpdateInfoNr (INFO_UucpOut_News,1);
          Inc (OutPtr^.MsgsEcho);

          UucpNewsOut_StartOfMessage:=OutPtr;
          Exit;
     END;

     OutPtr:=CreateNewOutboundRecord;

     OutPtr^.OutType:=otUucpNews;
     OutPtr^.UserRecNr:=UserRecNr;

     ReadUserBaseRecord (UserRecNr,UserRec);

     OutNr:=CalcOutBitmask (GetUsenetUniqueName (UserRec.NewsGrade));
     OutPtr^.OutName:=Config.SpoolBaseDir+UserRec.UUCPName+'\'+OutNr+'.XQ$';

     { maak een .XQ$ file aan }
     Assign (OutPtr^.OutFile,OutPtr^.OutName);
     {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to create '+OutPtr^.OutName);
          DeleteOutboundRecord (OutPtr);
          Exit; { met NIL }
     END;

     {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

     OutPtr^.IsOpen:=TRUE;
     OutPtr^.AccessCnt:=0;
     OutPtr^.Limit:=Config.MaxDatLength; { uncompressed limit }
     OutPtr^.EnvelopeLeft:=0; { unused }

     IF Config.LogUUCPOutbound THEN
        LogMessage (liTrivial,'Created UUCP job (news) '+OutNr+' for '+UserRec.UUCPname);

     UpdateInfoNr (INFO_UucpOut_Jobs,1);
     UpdateInfoNr (INFO_UucpOut_Msgs,1);
     UpdateInfoNr (INFO_UucpOut_News,1);
     OutPtr^.DestSystem := UserRec.UUCPName;
     OutPtr^.MsgsEcho := 1;

     UUCPName:=Config.UUCPName;
     P:=2;

     IF Config.ForceNoBitmask THEN
     BEGIN
          UUCPName:=Copy (UUCPName,1,6);
          P:=1;
     END;

     Temp:='U '+ProgramUserName+' '+Config.UUCPName+#10+'Z'+#10;
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     Temp:='F D.'+UUCPName+Copy (OutNr,P,255)+#10;
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     Temp:='I D.'+UUCPName+Copy (OutNr,P,255)+#10+'C rnews'+#10;
     BlockWrite (OutPtr^.OutFile,Temp[1],Length (Temp));

     { .XQ$ file is ready now. Close it }
     {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
     Close (OutPtr^.OutFile);
     OutPtr^.IsOpen:=FALSE;

     IF (NOT UserRec.GigoT) THEN
     BEGIN
          { create a .CM$ file }
          Temp:=OutPtr^.OutName;
          Temp[Length (Temp)-2]:='C';
          Temp[Length (Temp)-1]:='M';

          Assign (CmdFile,Temp);
          {$I-} ReWrite (CmdFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             LogDiskIOError (IORes,'Cannot create '+Temp)
          ELSE BEGIN
               {$IFDEF LogFileIO}PostOpenT (CmdFile);{$ENDIF}
               Write (CmdFile,'S '+OutNr+'.DAT D.'+UUCPName+Copy (OutNr,P,255)+' '+
                              ProgramUserName+' - '+OutNr+'.DAT 0666'+#10);
               Write (CmdFile,'S '+OutNr+'.XQT X.'+UUCPName+Copy (OutNr,P,255)+' '+
                              ProgramUserName+' - '+OutNr+'.XQT 0666'+#10);

               {$IFDEF LogFileIO}PreCloseT (CmdFile);{$ENDIF}
               Close (CmdFile);
          END;
     END;

     { start the .DA$ file }
     P:=Length (OutPtr^.OutName);
     OutPtr^.OutName[P-2]:='D';
     OutPtr^.OutName[P-1]:='A';

     Assign (OutPtr^.OutFile,OutPtr^.OutName);
     {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to create '+OutPtr^.OutName);
          { delete .XQ$ and .CM$ file }
          DeleteOutboundRecord (OutPtr);
          Exit; { met NIL }
     END;

     {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

     OutPtr^.IsOpen:=TRUE;

     UucpNewsOut_StartOfMessage:=OutPtr;
END;


{--------------------------------------------------------------------------}
{ UucpNewsOut_WriteRNewsHeader                                             }
{                                                                          }
{ This routine writes the "#! rnews <n>" header to the batch, but fills in }
{ the size as 00000000 for the moment and stores the position of this      }
{ number. When UucpNewsOut_EndOfMessage is called, the value is updated.   }
{                                                                          }
PROCEDURE UucpNewsOut_WriteRNewsHeader (OutPtr : OutboundRecordPtr);

VAR RNewsHeader : STRING[30];

BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding rnews header');
          Exit;
     END;

     RNewsHeader:='#! rnews 00000000'#10;

     OutPtr^.Offset:=FileSize (OutPtr^.OutFile);
     Seek (OutPtr^.OutFile,OutPtr^.Offset);
     BlockWrite (OutPtr^.OutFile,RNewsHeader[1],Length (RNewsHeader));
END;


{--------------------------------------------------------------------------}
{ UucpNewsOut_WriteToBatch                                                 }
{                                                                          }
{ This routine writes a block of data to a outbound UUCP news job.         }
{                                                                          }
PROCEDURE UucpNewsOut_WriteToBatch (OutPtr : OutboundRecordPtr; Count : WORD; VAR Buffer);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding '+Word2String (Count)+' bytes');
          Exit;
     END;

     BlockWrite (OutPtr^.OutFile,Buffer,Count);
     UpdateInfoNr (INFO_UucpOut_Bytes,Count);
     Inc (OutPtr^.MsgsBytes, Count);

     IF (OutPtr^.AccessCnt < 255) THEN
        Inc (OutPtr^.AccessCnt);
END;


{--------------------------------------------------------------------------}
{ UucpNewsOut_CloseJob                                                     }
{                                                                          }
{ This routine is called from UucpNewsOut_EndOfMessage and                 }
{ Outbound_FinishNow to finish a UUCP news job. The .DA$ file is closed    }
{ and renamed to .DAT. According to the settings it is then compressed and }
{ c/g/zunbatched. The .XQ$ is renamed to .XQT and the .CM$ to .CMD (if     }
{ present). The outbound record is then deleted.                           }
{                                                                          }
PROCEDURE UucpNewsOut_CloseJob (OutPtr : OutboundRecordPtr);

VAR UserRec : UserBaseRecord;
    IORes   : BYTE;
    L       : BYTE;

BEGIN
     IF (OutPtr^.IsOpen) THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
          Close (OutPtr^.OutFile);
          OutPtr^.IsOpen:=FALSE;
     END;

     { rename the .DA$ file to .DAT (just for compatibility - we can }
     { compress the .DA$ directly.                                   }
     L:=Length (OutPtr^.OutName);
     OutPtr^.OutName[L]:='T';

     {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error renaming .DA$ to '+OutPtr^.OutName);
          DeleteOutboundRecord (OutPtr);
          Exit;
     END;

     { get the compress/cunbatch information }
     ReadUserBaseRecord (OutPtr^.UserRecNr,UserRec);

     { compressen }
     IF (UserRec.Compress <> uctNone) THEN
     BEGIN
          { compress the .DAT file to .DAZ }
          IF (UserRec.Compress = uctCompress) THEN
             GoExec (Config.ComprPrg_U[Compress,Compr],
                     OutPtr^.OutName,
                     'Compressing for '+UserRec.UUCPName)
          ELSE
              GoExec (Config.ComprPrg_U[GZip,Compr],
                      OutPtr^.OutName,
                      'GZipping for '+UserRec.UUCPName);

          { rename the .DAZ file to .DAT }
          OutPtr^.OutName[L]:='Z';
          Assign (OutPtr^.OutFile,OutPtr^.OutName);

          OutPtr^.OutName[L]:='T';
          {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               {## this could mean that the compressor failed}
               {## we could still send it off uncompressed!!}
               LogDiskIOError (IORes,'Error renaming .DAZ to '+OutPtr^.OutName);
               DeleteOutboundRecord (OutPtr);
               Exit;
          END;

          { cunbatch toevoegen aan het begin van de file }
          IF UserRec.CunBatch THEN
          BEGIN
               IF (UserRec.Compress = uctCompress) THEN
                  AddCun (OutPtr^.OutName,'c');    { c = cunbatch }

               IF (UserRec.Compress = uctGZip) THEN
                  AddCun (OutPtr^.OutName,GZipBatchLetter);
          END;
     END; { if compress at all }

     { rename the .XQ$ to .XQT }
     OutPtr^.OutName[L-2]:='X';
     OutPtr^.OutName[L-1]:='Q';
     OutPtr^.OutName[L]:='$';

     Assign (OutPtr^.OutFile,OutPtr^.OutName);

     OutPtr^.OutName[L]:='T';
     {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error renaming .XQ$ to '+OutPtr^.OutName);
          DeleteOutboundRecord (OutPtr);
          Exit;
     END;

     { rename the .CM$ to .CMD, if existing }
     IF (NOT UserRec.GigoT) THEN
     BEGIN
          OutPtr^.OutName[L-2]:='C';
          OutPtr^.OutName[L-1]:='M';
          OutPtr^.OutName[L]:='$';

          Assign (OutPtr^.OutFile,OutPtr^.OutName);

          OutPtr^.OutName[L]:='D';
          {$I-} Rename (OutPtr^.OutFile,OutPtr^.OutName); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             LogDiskIOError (IORes,'Error renaming .CM$ to '+OutPtr^.OutName);
     END;

     { Statistics }
     StatEntry_UUCPJob (stdOutbound, 'LOCAL', OutPtr^.DestSystem, OutPtr^.MsgsBytes, OutPtr^.MsgsEcho,
                                                       OutPtr^.MsgsMail);

     DeleteOutboundRecord (OutPtr);
END;


{--------------------------------------------------------------------------}
{ UucpNewsOut_EndOfMessage                                                 }
{                                                                          }
{ This routine must be called when a complete news article has been        }
{ written to the job. This routine checks updates the #! rnews header so   }
{ the size of the message is correct. It then checks the size of the job   }
{ against the maximum size and calls the compressor and adds the ?unbatch  }
{ header, both if configured.                                              }
{                                                                          }
PROCEDURE UucpNewsOut_EndOfMessage (OutPtr : OutboundRecordPtr);

VAR RNewsValue : STRING[8];

BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not checking limit');
          Exit;
     END;

     { update the value in the rnews header }
     RNewsValue:=AddUpWithPre0s (8,Longint2String (FileSize (OutPtr^.OutFile)-OutPtr^.Offset-18));

     Seek (OutPtr^.OutFile,OutPtr^.Offset+9);
     BlockWrite (OutPtr^.OutFile,RNewsValue[1],8);
     
     IF (OutPtr^.Limit <> 0) AND (FileSize (OutPtr^.OutFile) >= OutPtr^.Limit) THEN
        UucpNewsOut_CloseJob (OutPtr);
END;


{==========================================================================}
{                          PKT2000 support                                 }
{==========================================================================}


{--------------------------------------------------------------------------}
{ Outbound_StoreP2KOffset                                                  }
{                                                                          }
{ This routine stores the current size of the P2K file minus four, which   }
{ is exactly the spot where the TextBytes field has to be written.         }
{                                                                          }
PROCEDURE Outbound_StoreP2KOffset (OutPtr : OutboundRecordPtr);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
        LogMessage (liFatal,'File not re-opened; header offset not stored')
     ELSE
         OutPtr^.Offset:=FileSize (OutPtr^.OutFile);
END;


{--------------------------------------------------------------------------}
{ Outbound_UpdateP2kHeader                                                 }
{                                                                          }
{ This routine updates the P2K message header at the stored position.      }
{                                                                          }
PROCEDURE Outbound_UpdateP2kHeader (OutPtr : OutboundRecordPtr; Count : WORD; VAR Buffer);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; P2K message header not updated');
          Exit;
     END;

     { return to the stored position }
     Seek (OutPtr^.OutFile,OutPtr^.Offset);

     { overwrite the header }
     BlockWrite (OutPtr^.OutFile,Buffer,Count);

     { make sure we return to the end of the file to avoid }
     { overwriting more than we want.                      }
     Seek (OutPtr^.OutFile,FileSize (OutPtr^.OutFile));
END;


{==========================================================================}
{                          NETMAIL TO .PKT                                 }
{==========================================================================}


{--------------------------------------------------------------------------}
{ WritePktHeader                                                           }
{                                                                          }
{ This routine creates a type 2+ .PKT file header and writes it to the     }
{ newly created .PKT file pointed to by OutPtr. The first must be oped.    }
{ The System, Address and SystemAka (BBS Interface) fields in UserRec are  }
{ used for the destination address and the PktSenderAdres is used as the   }
{ source address and must be one of our AKAs, possibly modified into a     }
{ point address.                                                           }
{                                                                          }
PROCEDURE WritePktHeader (OutPtr : OutboundRecordPtr;
                          VAR UserRec : UserBaseRecord;
                          PktSenderAdres : FidoAddrType);

VAR cYear,cMonth,cDay,
    cHour,cMin,cSec,
    Nop              : WordLong;
    Len,Lp           : BYTE;
    Header           : FidoPktHdr;
    IORes            : BYTE;

BEGIN
     GetDate (cYear,cMonth,cDay,Nop);
     GetTime (cHour,cMin,cSec,Nop);

     { Output van type 2+ pakketten                                   }
     {                                                                }
     { Vraag niet waarom, als ik me aan FSC-0039 of FSC-0048 hou, dan }
     { herkent Squish het niet als een 2+ pakket, als ik echter       }
     { na wat random geklooi met Squish PKT's dit formaat gebruikt    }
     { loopt het wel....                                              }
     {                                                                }

     FillChar (Header,SizeOf (FidoPktHdr),0);
     WITH Header DO
     BEGIN
          Orig_Zone:=PktSenderAdres.Zone;
          Orig_Net:=PktSenderAdres.Net;
          Orig_Node:=PktSenderAdres.Node;
          Orig_Point:=PktSenderAdres.Point;

          IF (UserRec.System = _BBS) THEN
          BEGIN
               Dest_Zone:=Config.NodeNrs[UserRec.SystemAka].Zone;
               Dest_Net:=Config.NodeNrs[UserRec.SystemAka].Net;
               Dest_Node:=Config.NodeNrs[UserRec.SystemAka].Node;
               Dest_Point:=0;
          END ELSE
          BEGIN
               Dest_Zone:=UserRec.Address.Zone;
               Dest_Net:=UserRec.Address.Net;
               Dest_Node:=UserRec.Address.Node;
               Dest_Point:=UserRec.Address.Point;
          END;

          Qm_Orig_Zone:=Orig_Zone;
          Qm_Dest_Zone:=Dest_Zone;

          Year:=cYear;
          Month:=cMonth-1;
          Day:=cDay;
          Hour:=cHour;
          Minute:=cMin;
          Second:=cSec;

          Baud:=0;
          Ver:=2;

          Product:=OurFidoProductCode;
          Rev_lev:=OurFidoRevLevel;

          F48_AuxNet:=PktSenderAdres.Net;
          F48_ValidationCopy:=$100; {Squish?}
          F48_ProduktCode:=00;   {OurFidoProductCode;}
          F48_Revision:=00;   {OurFidoRevLevel;}
          F48_Capability:=1;

          IF (UserRec.System = _F) THEN
          BEGIN
               Len:=Length (DeleteBackSpaces (UserRec.PacketPwd));
               Move (UserRec.PacketPwd[1],Password,8);
          END ELSE
              Len:=0; { _BBS: no password }

          IF (Len < 8) THEN
             FOR Lp:=Len+1 TO 8 DO Password[Lp]:=0;

     END; { with }

     {$I-} BlockWrite (OutPtr^.OutFile,Header,SizeOf (FidoPktHdr)); {$I-} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'Error writing PKT header');

     UpdateInfoNr (INFO_PktOut_Bytes,SizeOf (FidoPktHdr));
END;


{--------------------------------------------------------------------------}
{ FtnNetOut_StartOfMessage                                                 }
{                                                                          }
{ This routine must be called when a netmail message needs to be written   }
{ to a .PKT file for a certain user. This routine checks for such a .PKT   }
{ file and if we are not working on any, then a new one is started.        }
{ Netmail messages are kept separated from echomail messages. Also, it is  }
{ possible to write each netmail to their own private .PKT files.          }
{                                                                          }
FUNCTION FtnNetOut_StartOfMessage (UserRecNr : UserBaseRecordNrType;
                                   PktSenderAddress : FidoAddrType;
                                   HasCrashStatus : BOOLEAN) : OutboundRecordPtr;

VAR OutPtr   : OutboundRecordPtr;
    OutNr    : STRING[8];
    IORes    : BYTE;
    UserRec  : UserBaseRecord;
    L        : BYTE;
    PktStr   : STRING[10];

BEGIN
     FtnNetOut_StartOfMessage:=NIL; { in case of errors }

     { see if a netmail .PKT file for this destination is already }
     { created and being written to.                              }
     { find an existing outbound record matching this UserRecNr and type }
     OutPtr:=FindOutboundRecord (UserRecNr,otFtnNet);
     IF (OutPtr = NIL) THEN
     BEGIN
          IF (NOT CheckFreeHandle) THEN
          BEGIN
               LogMessage (liFatal,'No free handle to start a new PKT file for netmail; aborting');
               Exit; { met NIL }
          END;

          OutPtr:=CreateNewOutboundRecord;

          OutPtr^.OutType:=otFtnNet;
          OutPtr^.UserRecNr:=UserRecNr;

          ReadUserBaseRecord (UserRecNr,UserRec);

          IF (UserRec.System = _F) THEN
             OutPtr^.PktFormat:=UserRec.PktFormat
          ELSE
              { _BBS }
              OutPtr^.PktFormat:=fptPkt;

          OutNr:=GetFidoPktName;

          IF (UserRec.System = _BBS) THEN
             OutPtr^.OutName:=UserRec.Outbound+OutNr
          ELSE
              Outptr^.OutName:=Config.Outbound_F+OutNr;

          OutPtr^.OutName:=OutPtr^.OutName+'.';

          IF (OutPtr^.PktFormat = fptPkt) THEN
             OutPtr^.OutName:=OutPtr^.OutName+Config.OutboundPktExtension
          ELSE
              OutPtr^.OutName:=OutPtr^.OutName+'P2K';

          { change first digit of extension to 'C' if this is a crash message }
          { otherwise make sure it is NOT a 'C'.                              }
          L:=Length (OutPtr^.OutName);

          IF HasCrashStatus THEN
             OutPtr^.OutName[L-2]:='C'
          ELSE
              IF (OutPtr^.OutName[L-2] = 'C') THEN
                 OutPtr^.OutName[L-2]:='$';

          { create a new file }
          Assign (OutPtr^.OutFile,OutPtr^.OutName);
          {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Failed to create '+OutPtr^.OutName);
               DeleteOutboundRecord (OutPtr);
               Exit; { met NIL }
          END;

          {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

          OutPtr^.IsOpen:=TRUE;
          OutPtr^.AccessCnt:=0;
          OutPtr^.Limit:=UserRec.MaxPktLength;
          IF (OutPtr^.Limit = 0) THEN
             OutPtr^.Limit:=MAXLONGINT;

          IF (OutPtr^.PktFormat = fptPkt) THEN
             PktStr:='PKT'
          ELSE
              PktStr:='PKT2000';

          OutPtr^.DestSystem := Fido2Str (UserRec.Address);

          LogMessage (liTrivial,'Created (netmail) '+PktStr+' file '+OutNr+' for '+Fido2Str (UserRec.Address));
          UpdateInfoNr (INFO_PktOut_Jobs,1);

          { write the .PKT header for this new .PKT file }
          IF (OutPtr^.PktFormat = fptPkt) THEN
             WritePktHeader (OutPtr,UserRec,PktSenderAddress)
          ELSE
              Pkt2000_WriteHeader (OutPtr,UserRec,PktSenderAddress);
     END;

     UpdateInfoNr (INFO_PktOut_Msgs,1);
     Inc (OutPtr^.MsgsMail);

     FtnNetOut_StartOfMessage:=OutPtr;
END;


{--------------------------------------------------------------------------}
{ FtnNetOut_UnknownSystem_StartOfMessage                                   }
{                                                                          }
{ This routine must be called when a netmail message needs to be written   }
{ to a .PKT file for a certain user. This routine checks for such a .PKT   }
{ file and if we are not working on any, then a new one is started.        }
{ Netmail messages are kept separated from echomail messages. Also, it is  }
{ possible to write each netmail to their own private .PKT files.          }
{                                                                          }
FUNCTION FtnNetOut_UnknownSystem_StartOfMessage (ToAddress,
                                                 PktSenderAddress : FidoAddrType;
                                                 HasCrashStatus : BOOLEAN) : OutboundRecordPtr;

VAR OutPtr    : OutboundRecordPtr;
    OutNr     : STRING[8];
    IORes     : BYTE;
    L         : BYTE;
    UserRecNr : UserBaseRecordNrType;
    UserRec   : UserBaseRecord;

BEGIN
     FtnNetOut_UnknownSystem_StartOfMessage:=NIL; { in case of errors }

     UserRecNr:=FakeUserRecNr;
     Inc (FakeUserRecNr);
     LogMessage (liDebug,'[Outbound] Assigned fake UserRecNr '+Word2String (UserRecNr));

     { see if a netmail .PKT file for this destination is already }
     { created and being written to.                              }
     { find an existing outbound record matching this UserRecNr and type }
     OutPtr:=FindOutboundRecord (UserRecNr,otFtnNet);
     IF (OutPtr = NIL) THEN
     BEGIN
          IF (NOT CheckFreeHandle) THEN
          BEGIN
               LogMessage (liFatal,'No free handle to start a new PKT file for netmail; aborting');
               Exit; { met NIL }
          END;

          OutPtr:=CreateNewOutboundRecord;

          OutPtr^.OutType:=otFtnNet;
          OutPtr^.UserRecNr:=UserRecNr;
          OutPtr^.PktFormat:=fptPkt;

          OutNr:=GetFidoPktName;

          Outptr^.OutName:=Config.Outbound_F+OutNr;

          OutPtr^.OutName:=OutPtr^.OutName+'.'+Config.OutboundPktExtension;

          { change first digit of extension to 'C' if this is a crash message }
          { otherwise make sure it is NOT a 'C'.                              }
          L:=Length (OutPtr^.OutName);

          IF HasCrashStatus THEN
             OutPtr^.OutName[L-2]:='C'
          ELSE
              IF (OutPtr^.OutName[L-2] = 'C') THEN
                 OutPtr^.OutName[L-2]:='$';

          { create a new file }
          Assign (OutPtr^.OutFile,OutPtr^.OutName);
          {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Failed to create '+OutPtr^.OutName);
               DeleteOutboundRecord (OutPtr);
               Exit; { met NIL }
          END;

          {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

          OutPtr^.IsOpen:=TRUE;
          OutPtr^.AccessCnt:=0;
          OutPtr^.Limit:=MAXLONGINT;

          LogMessage (liTrivial,'Created (netmail) PKT file '+OutNr+' for '+Fido2Str (ToAddress));
          UpdateInfoNr (INFO_PktOut_Jobs,1);
          
          { fake a UserRec so WritePktHeader has the required fields }
          UserRec.System:=_F;
          UserRec.Address:=ToAddress;
          UserRec.PacketPwd:='';

          OutPtr^.DestSystem := Fido2Str(UserRec.Address);

          { write the .PKT header for this new .PKT file }
          WritePktHeader (OutPtr,UserRec,PktSenderAddress);
     END;

     UpdateInfoNr (INFO_PktOut_Msgs,1);
     Inc (OutPtr^.MsgsMail);

     FtnNetOut_UnknownSystem_StartOfMessage:=OutPtr;
END;


{--------------------------------------------------------------------------}
{ FtnNetOut_WriteToPkt                                                     }
{                                                                          }
{ This routine is used to write (part of) a binary packed netmail message  }
{ to a .PKT file. The packed message header must be written first,         }
{ followed by the actual message.                                          }
{                                                                          }
PROCEDURE FtnNetOut_WriteToPkt (OutPtr : OutboundRecordPtr; Count : WORD; VAR Buffer);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding '+Word2String (Count)+' bytes');
          Exit;
     END;

     BlockWrite (OutPtr^.OutFile,Buffer,Count);
     UpdateInfoNr (INFO_PktOut_Bytes,Count);
     Inc (OutPtr^.MsgsBytes,Count);

     IF (OutPtr^.AccessCnt < 255) THEN
        Inc (OutPtr^.AccessCnt);
END;


{--------------------------------------------------------------------------}
{ FtnNetOut_CloseJob                                                       }
{                                                                          }
{ This routine can be called both from FtnNetOut_EndOfMessage and          }
{ Outbound_FinishNow. It has to finish a .PKT file by writing a            }
{ terminating #0 to it, closing it and then deleting the OutboundRecord    }
{ for it.                                                                  }
{ The PACK code will take care of renaming and archiving it.               }
{                                                                          }
PROCEDURE FtnNetOut_CloseJob (OutPtr : OutboundRecordPtr);

VAR Buffer : STRING[2];

BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; cannot finish message');
          Exit;
     END;

     IF (OutPtr^.PktFormat = fptPkt) THEN
     BEGIN
          { write end of .PKT file indicator to the outbound file }
          Buffer:=#0#0;
          BlockWrite (OutPtr^.OutFile,Buffer[1],2);
          UpdateInfoNr (INFO_PktOut_Bytes,2);
     END;

     {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
     Close (OutPtr^.OutFile);

     { Statistics }
     StatEntry_FidoPkt (stdOutbound, 'LOCAL', OutPtr^.DestSystem, OutPtr^.MsgsBytes,
                                   OutPtr^.MsgsEcho, OutPtr^.MsgsMail);

     DeleteOutboundRecord (OutPtr);
END;


{--------------------------------------------------------------------------}
{ FtnNetOut_EndOfMessage                                                   }
{                                                                          }
{ When the entire netmail message has been written to this .PKT file, this }
{ routine must be called. A message separating #0 is written to the file.  }
{ If netmails are to be written to their own private .PKT file, then this  }
{ archive can be closed.                                                   }
{                                                                          }
PROCEDURE FtnNetOut_EndOfMessage (OutPtr : OutboundRecordPtr);

VAR Buffer : CHAR;

BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; cannot finish message');
          Exit;
     END;

     IF (OutPtr^.PktFormat = fptPkt) THEN
     BEGIN
          { write message separator to .PKT file }
          Buffer:=#0;
          BlockWrite (OutPtr^.OutFile,Buffer,1);
          UpdateInfoNr (INFO_PktOut_Bytes,1);
     END;

     IF (FileSize (OutPtr^.OutFile) >= OutPtr^.Limit) THEN
        FtnNetOut_CloseJob (OutPtr);
END;


{==========================================================================}
{                         ECHOMAIL TO .PKT                                 }
{==========================================================================}


{--------------------------------------------------------------------------}
{ FtnEchoOut_StartOfMessage                                                }
{                                                                          }
{ This routine must be called when a echomail message needs to be written  }
{ to a .PKT file for a certain user. This routine checks for such a .PKT   }
{ file and if we are not working on any, then a new one is started.        }
{                                                                          }
FUNCTION FtnEchoOut_StartOfMessage (UserRecNr : UserBaseRecordNrType;
                                    PktSenderAddress : FidoAddrType) : OutboundRecordPtr;

VAR OutPtr   : OutboundRecordPtr;
    OutNr    : STRING[8];
    IORes    : BYTE;
    UserRec  : UserBaseRecord;
    L        : BYTE;
    AkaStr   : STRING[50];
    PktStr   : STRING[10];

BEGIN
     FtnEchoOut_StartOfMessage:=NIL; { in case of errors }

     { see if an echomail .PKT file for this destination is already }
     { created and being written to.                                }
     { find an existing outbound record matching this UserRecNr and type }
     OutPtr:=FindOutboundRecord (UserRecNr,otFtnEcho);
     IF (OutPtr = NIL) THEN
     BEGIN
          IF (NOT CheckFreeHandle) THEN
          BEGIN
               LogMessage (liFatal,'No free handle to start a new PKT file for echomail; aborting');
               Exit; { met NIL }
          END;

          OutPtr:=CreateNewOutboundRecord;

          OutPtr^.OutType:=otFtnEcho;
          OutPtr^.UserRecNr:=UserRecNr;

          ReadUserBaseRecord (UserRecNr,UserRec);

          IF (UserRec.System = _F) THEN
             OutPtr^.PktFormat:=UserRec.PktFormat
          ELSE
              { _BBS }
              OutPtr^.PktFormat:=fptPkt;

          { make up a filename for this new job }
          OutNr:=GetFidoPktName;

          IF (UserRec.System = _BBS) THEN
             OutPtr^.OutName:=UserRec.Outbound+OutNr
          ELSE
              OutPtr^.OutName:=Config.Outbound_F+OutNr;

          OutPtr^.OutName:=OutPtr^.OutName+'.'+Config.OutboundPktExtension;
          { note: rename to PKT/P2K is decided in FidoPack }

          { make sure there is no crash indication in the extension }
          L:=Length (OutPtr^.Outname);
          IF (OutPtr^.OutName[L-2] = 'C') THEN
             OutPtr^.OutName[L-2]:='$';

          { maak een outbound file aan }
          Assign (OutPtr^.OutFile,OutPtr^.OutName);
          {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Failed to create '+OutPtr^.OutName);
               DeleteOutboundRecord (OutPtr);
               Exit; { met NIL }
          END;

          {$IFDEF LogFileIO}PostOpenF (OutPtr^.OutFile);{$ENDIF}

          OutPtr^.IsOpen:=TRUE;
          OutPtr^.AccessCnt:=0;
          OutPtr^.Limit:=UserRec.MaxPktLength;
          IF (OutPtr^.Limit = 0) THEN
             OutPtr^.Limit:=MAXLONGINT;

          IF (UserRec.System = _BBS) THEN
             AkaStr:='(BBS i/f) '+
                     Word2String (UserRec.FakeZone)+':'+
                     Word2String (UserRec.FakeNet)+'/'+
                     Word2String (UserRec.FakeNode)
          ELSE
              AkaStr:=Fido2Str (UserRec.Address);

          IF (OutPtr^.PktFormat = fptPkt) THEN
             PktStr:='PKT'
          ELSE
              PktStr:='PKT2000';
               
          OutPtr^.DestSystem := Fido2Str (UserRec.Address);

          LogMessage (liTrivial,'Created (echomail) '+PktStr+' file '+OutNr+' for '+AkaStr);

          UpdateInfoNr (INFO_PktOut_Jobs,1);

          { write the .PKT header }
          IF (OutPtr^.PktFormat = fptPkt) THEN
             WritePktHeader (OutPtr,UserRec,PktSenderAddress)
          ELSE
              Pkt2000_WriteHeader (OutPtr,UserRec,PktSenderAddress);
     END;

     UpdateInfoNr (INFO_PktOut_Msgs,1);
     Inc (OutPtr^.MsgsEcho);

     FtnEchoOut_StartOfMessage:=OutPtr;
END;


{--------------------------------------------------------------------------}
{ FtnEchoOut_WriteToPkt                                                    }
{                                                                          }
{ This routine is used to write (part of) a binary packed echomail message }
{ to a .PKT file. The packed message header must be written first,         }
{ followed by the actual message.                                          }
{                                                                          }
PROCEDURE FtnEchoOut_WriteToPkt (OutPtr : OutboundRecordPtr; Count : WORD; VAR Buffer);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not adding '+Word2String (Count)+' bytes');
          Exit;
     END;

     BlockWrite (OutPtr^.OutFile,Buffer,Count);
     UpdateInfoNr (INFO_PktOut_Bytes,Count);
     Inc (OutPtr^.MsgsBytes,Count);

     IF (OutPtr^.AccessCnt < 255) THEN
        Inc (OutPtr^.AccessCnt);
END;


{--------------------------------------------------------------------------}
{ FtnEchoOut_CloseJob                                                      }
{                                                                          }
{ This routine can be called both from FtnNetOut_EndOfMessage and          }
{ Outbound_FinishNow. It has to finish a .PKT file by writing a            }
{ terminating #0 to it, closing it and then deleting the OutboundRecord    }
{ for it.                                                                  }
{ The PACK code will take care of renaming and archiving it.               }
{                                                                          }
PROCEDURE FtnEchoOut_CloseJob (OutPtr : OutboundRecordPtr);

VAR Buffer    : STRING[2];
    TextBytes : LONGINT;

BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; cannot finish message');
          Exit;
     END;

     IF (OutPtr^.PktFormat = fptPkt) THEN
     BEGIN
          { write end of .PKT file indicator to outbound job }
          Buffer:=#0#0;
          BlockWrite (OutPtr^.OutFile,Buffer[1],2);
          UpdateInfoNr (INFO_PktOut_Bytes,2);
     END;

     { Statistics }
     StatEntry_FidoPkt (stdOutbound, 'LOCAL', OutPtr^.DestSystem, OutPtr^.MsgsBytes,
                                   OutPtr^.MsgsEcho, OutPtr^.MsgsMail);

     {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
     Close (OutPtr^.OutFile);
     DeleteOutboundRecord (OutPtr);
END;


{--------------------------------------------------------------------------}
{ FtnEchoOut_EndOfMessage                                                  }
{                                                                          }
{ When the entire echomail message has been written to this .PKT file,     }
{ this routine must be called. A message separating #0 is written to the   }
{ file. If the .PKT file has reached its length limit then it is added to  }
{ the archive. If a new archive has been created, then a job file for the  }
{ mailer is created, with can be a netmail with f/a or Binkley/d'Bridge    }
{ job.                                                                     }
{                                                                          }
PROCEDURE FtnEchoOut_EndOfMessage (OutPtr : OutboundRecordPtr);

VAR Buffer : CHAR;

BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'File not re-opened; not checking limit');
          Exit;
     END;

     IF (OutPtr^.PktFormat = fptPkt) THEN
     BEGIN
          { write message separator to .PKT file }
          Buffer:=#0;
          BlockWrite (OutPtr^.OutFile,Buffer,1);
          UpdateInfoNr (INFO_PktOut_Bytes,1);
     END;

     IF (FileSize (OutPtr^.OutFile) >= OutPtr^.Limit) THEN
        FtnEchoOut_CloseJob (OutPtr);
END;


{==========================================================================}
{                            SOUP MAIL                                     }
{==========================================================================}

{ NOTE:  We can use the same routines for both mail and news, and simply   }
{        pass an IsNews boolean to the 'open' and 'close' functions.       }

{--------------------------------------------------------------------------}
{ GetNextSoupFilename                                                      }
{                                                                          }
{ This routine looks through the directory to determine the next available }
{ filename (0000001.MSG).                                                  }
{                                                                          }
FUNCTION GetNextSoupFilename (Path : STRING) : STRING;

VAR Nr      : LONGINT;
    IORes   : BYTE;
    TempF   : FILE;
    Filename: STRING [12];

BEGIN
     Nr := 1;

     { Unlikely that we'd ever get this high, but ... }
     WHILE (Nr < MaxLongInt) DO
     BEGIN
          Filename := AddUpWithPre0s (8, LongInt2String (Nr)) + '.MSG';

          Assign (TempF, Path+Filename);
          {$I-} Reset (TempF, 1); IORes := IOResult; {$I+}
          IF IORes = 2 THEN
          BEGIN
               GetNextSoupFilename := Path+Filename;
               Exit;          {## EXIT ##}
          END;

          IF (IORes = 0) THEN
               Close (TempF);

          Inc (Nr);
     END;

     GetNextSoupFilename := '';         { fail }
END;

{--------------------------------------------------------------------------}
{ Soup_SaveJobForLater                                                     }
{                                                                          }
{ If we are unable to add a job to the REPLIES file for some reason (it is }
{ locked or otherwise inaccessible), we must requeue the job for later.    }
{                                                                          }
{ Rename it to *.$SG, and create a .WG file with the same base name that   }
{ contains the correct REPLIES line                                        }
{                                                                          }
FUNCTION Soup_SaveJobForLater (OutPtr: OutboundRecordPtr) : BOOLEAN;
BEGIN
{     FSplit (OutPtr^.OutName, Garbage, Name, Garbage);}
END;

{--------------------------------------------------------------------------}
{ SoupMailOut_StartOfmessage                                               }
{                                                                          }
{ This routine is called to create a new outbound SOUP mail job for this   }
{ user.  If a .MSG file has already been started, we can just use that.    }
{ If one hasn't, we can start a new one.                                   }
{                                                                          }
FUNCTION SoupMailOut_StartOfMessage (IsNews: BOOLEAN; UserRecNr : UserBaseRecordNrType) : OutboundRecordPtr;

VAR OutPtr  : OutboundRecordPtr;
    Temp    : STRING;
    IORes   : BYTE;
    UserRec : UserBaseRecord;

BEGIN
     SoupMailOut_StartOfMessage:=NIL; { in case of errors }

     IF (NOT CheckFreeHandle) THEN
     BEGIN
          LogMessage (liFatal,'No free handle to create a SOUP job; aborting');
          Exit; { met NIL }
     END;

     IF (IsNews) THEN
          OutPtr := FindOutboundRecord (UserRecNr, otSoupNews)
     ELSE
          OutPtr := FindOutboundRecord (UserRecNr, otSoupMail);
          
     IF (OutPtr <> NIL) THEN
     BEGIN
          UpdateInfoNr (INFO_SoupOut_Msgs,1);
          IF (IsNews) THEN
          BEGIN
               UpdateInfoNr (INFO_SoupOut_News,1);
               Inc (OutPtr^.MsgsEcho);
          END ELSE
          BEGIN
               UpdateInfoNr (INFO_SoupOut_Mail,1);
               Inc (OutPtr^.MsgsMail);
          END;

          SoupMailOut_StartOfMessage := OutPtr;
          Exit;
     END;


     OutPtr:=CreateNewOutboundRecord;

     IF (IsNews) THEN
          OutPtr^.OutType:=otSoupNews
     ELSE
          OutPtr^.OutType:=otSoupMail;

     OutPtr^.UserRecNr:=UserRecNr;

     ReadUserBaseRecord (UserRecNr,UserRec);
     Temp:=CorrectPath (UserRec.SoupOutPath);

     Temp := GetNextSoupFilename (Temp);
     
     IF (Temp = '') THEN
     BEGIN
          LogMessage (liFatal,'Failed to get SOUP message number; aborting');
          DeleteOutboundRecord (OutPtr);
          Exit;          {## EXIT ##}
     END;

     OutPtr^.OutName := Temp;

     Assign (OutPtr^.OutFile,OutPtr^.OutName);
     {$I-} ReWrite (OutPtr^.OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to create '+OutPtr^.OutName);
          DeleteOutboundRecord (OutPtr);
          Exit;
     END;

     OutPtr^.IsOpen:=TRUE;
     OutPtr^.AccessCnt:=0;
     OutPtr^.Limit:=MaxLongint;

     OutPtr^.DestSystem := UserRec.UUCPName;
     IF (IsNews) THEN
          Inc (OutPtr^.MsgsEcho)
     ELSE
          Inc (OutPtr^.MsgsMail);

     {## have to add Config.LogSOUPOutbound}
     {
     IF Config.LogSMTPOutbound THEN
        LogMessage (liTrivial,'Created SMTP job '+OutNr+' for '+UserRec.UUCPname);
     }
     LogMessage (liTrivial, 'Created SOUP job '+Temp+' for '+UserRec.UUCPname);

     UpdateInfoNr (INFO_SoupOut_Jobs,1);

     UpdateInfoNr (INFO_SoupOut_Msgs,1);
     IF (IsNews) THEN
          UpdateInfoNr (INFO_SoupOut_News,1)
     ELSE
          UpdateInfoNr (INFO_SoupOut_Mail,1);
         

     SoupMailOut_StartOfMessage:=OutPtr;
END;


{--------------------------------------------------------------------------}
{ SoupMailOut_WriteMessageHeader                                           }
{                                                                          }
{ This routine writes the binary 'length' header to the file, but uses all }
{ #0 (NULL) for the moment and stores the position of this number.  When   }
{ we call SoupMailOut_EndOfMessage, this will be re-written with the       }
{ correct message length.                                                  }
PROCEDURE SoupMailOut_WriteMessageHeader (OutPtr: OutboundRecordPtr);
VAR
     Tmp: LONGINT;


BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal, 'SOUP job not re-opened; not setting message length');
          Exit;
     END;

     OutPtr^.Offset := FileSize (OutPtr^.OutFile);
     Seek (OutPtr^.OutFile, OutPtr^.Offset);

     { No need to do byte-swap here, as this will be replaced... }
     BlockWrite (OutPtr^.OutFile, Tmp, SizeOf (LONGINT));
END;


{--------------------------------------------------------------------------}
{ SoupMailOut_WriteToBatch                                                 }
{                                                                          }
{ This routine writes a block of raw data to the outbound file.            }
{                                                                          }
PROCEDURE SoupMailOut_WriteToBatch (OutPtr : OutboundRecordPtr; Count: WORD; VAR Buffer);
BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal,'SOUP job not re-opened; not adding '+Word2String (Count)+' bytes');
          Exit;
     END;

     BlockWrite (OutPtr^.OutFile,Buffer,Count);
     UpdateInfoNr (INFO_SoupOut_Bytes,Count);
     Inc (OutPtr^.MsgsBytes, Count);

     IF (OutPtr^.AccessCnt < 255) THEN
        Inc (OutPtr^.AccessCnt);
END;

{--------------------------------------------------------------------------}
{ SoupMailOut_AddRecipient                                                 }
{                                                                          }
{ Adds the specified user to the list of addresses this message has to be  }
{ delivered to.  When DeliverMail_AddSoupHeaderLine is called, it will     }
{ replace the To: line with these addresses.                               }
{                                                                          }
FUNCTION SoupMailOut_AddRecipient (OutPtr : OutboundRecordPtr; Recipient : STRING) : BOOLEAN;
VAR
     P: SoupEnvelopeRecordPtr;

BEGIN
     SoupMailOut_AddRecipient := TRUE;                 { Always return TRUE }

     P := OutPtr^.SoupEnvelope;
     IF (P = NIL) THEN
     BEGIN
          GetMem (OutPtr^.SoupEnvelope, SizeOf (SoupEnvelopeRecord));
          P := OutPtr^.SoupEnvelope;
     END ELSE
     BEGIN
          WHILE (P^.Next <> NIL) DO
               P := P^.Next;

          GetMem (P^.Next, SizeOf (SoupEnvelopeRecord));
          P := P^.Next;
     END;

     P^.Address := Recipient;
     P^.Next := NIL;
END;

{--------------------------------------------------------------------------}
{ SoupMailOut_CloseEnvelope                                                }
{                                                                          }
{ This routine must be called to indicate that all recipient addresses     }
{ have been added to the envelope.  If we are using WGSOUP, we must write  }
{ the .ENV(elope) file now.  If we are not using WGSOUP, this function     }
{ does not do anything.  (Note: One of the recipients should be            }
{ *SENDER*<address> (not in brackets), which should normally come from the }
{ Sender field.                                                            }
{                                                                          }
FUNCTION SoupMailOut_CloseEnvelope (OutPtr : OutboundRecordPtr) : BOOLEAN;

VAR L          : BYTE;
    IORes      : BYTE;
    Name       : STRING;
    Envelope   : FILE;

    FindPtr,
    TempPtr    : SoupEnvelopeRecordPtr;

    UserRec    : UserBaseRecord;

BEGIN
     SoupMailOut_CloseEnvelope:=FALSE; { assume failure }

     ReadUserBaseRecord (OutPtr^.UserRecNr, UserRec);
     IF (UserRec.UsingWGSOUP = FALSE) THEN
     BEGIN
          SoupMailOut_CloseEnvelope:=TRUE; { success }
          Exit;
     END;

     Name := OutPtr^.OutName;
     Name [Length (Name) - 2] := 'E';
     Name [Length (Name) - 1] := 'N';
     Name [Length (Name) - 0] := 'V';

     Assign (Envelope, Name);
     {$I-} Rewrite (Envelope, 1); {$I+}
     IORes := IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes, 'Unable to open SOUP envelope!');
          Exit;     { ## EXIT ## }
     END;

     { Write recipients }
     FindPtr := OutPtr^.SoupEnvelope;
     WHILE (FindPtr <> NIL) DO
     BEGIN
          Name := FindPtr^.Address + #13 + #10;
          BlockWrite (Envelope, Name[1], Length (Name));

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

     Close (Envelope);
     SoupMailOut_CloseEnvelope:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ SoupMailOut_EndOfMessage                                                 }
{                                                                          }
{ This routine is call when all lines have been written to the body of the }
{ message.  This updates the message length.                               }
{## support for 'maximum length' option                                    }
{                                                                          }
PROCEDURE SoupMailOut_EndOfMessage (OutPtr : OutboundRecordPtr);

VAR L     : BYTE;
    IORes : BYTE;
    Tmp   : LONGINT;
    TempBytes : array [1..4] of byte;
    Ch: Byte;

     UserRec: UserBaseRecord;

BEGIN
     IF (NOT ReOpenOutFile (OutPtr)) THEN
     BEGIN
          LogMessage (liFatal, 'SOUP job not re-opened; not setting message length');
          Exit;
     END;

     { Update the value for the message length }
     Tmp := FileSize (OutPtr^.OutFile)-OutPtr^.Offset-4;
     Seek (OutPtr^.OutFile, OutPtr^.Offset);

     { Swap the bytes }
     Move (Tmp, TempBytes, 4);
     Ch := TempBytes [1];
     TempBytes [1] := TempBytes [4];
     TempBytes [4] := Ch;

     Ch := TempBytes [2];
     TempBytes [2] := TempBytes [3];
     TempBytes [3] := Ch;

     Move (TempBytes, Tmp, 4);

     BlockWrite (OutPtr^.OutFile, Tmp, SizeOf (LONGINT));

     { Move back to EOF }
     Seek (OutPtr^.OutFile, FileSize (OutPtr^.OutFile));

     { If we are using WGSOUP, and this was an e-mail message, we must }
     { close the job now (each e-mail is put in it's own file).        }
     ReadUserBaseRecord (OutPtr^.UserRecNr, UserRec);

     IF (UserRec.UsingWGSOUP) THEN
          SoupMailOut_CloseJob (OutPtr);
END;


{--------------------------------------------------------------------------}
{ SoupMailOut_CloseJob                                                     }
{                                                                          }
{ This routine is called when all messages have been added to the SOUP     }
{ package (either news or mail).  This closes the .MSG file, and updates   }
{ the REPLIES file accordingly.                                            }
{                                                                          }
{ If REPLIES cannot be updated (f.i. it is locked by another node) we      }
{ rename the packet to *.$sg, and create a *.WG  with the Replies line     }
{ that must be added.  The next time WTRGATE SOUP is run, it will look for }
{ *.$SG files, and attempt to add their corresponding line to the REPLIES  }
{ file.                                                                    }
PROCEDURE SoupMailOut_CloseJob (OutPtr : OutboundRecordPtr);

VAR UserRec : UserBaseRecord;
    IORes   : BYTE;
    L       : BYTE;
    Tmp     : STRING;
    Fp      : TEXT;
    Name,
    Garbage : STRING;

BEGIN
     IF (OutPtr^.IsOpen) THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseF (OutPtr^.OutFile);{$ENDIF}
          Close (OutPtr^.OutFile);
          OutPtr^.IsOpen:=FALSE;
     END;

     ReadUserBaseRecord (OutPtr^.UserRecNr,UserRec);

     { Update the .DAT file }
     Tmp := CorrectPath (UserRec.SoupOutPath);         { Adds trailing \ }
     Tmp := Tmp + 'REPLIES';

     FSplit (OutPtr^.OutName, Garbage, Name, Garbage);

     Assign (Fp, Tmp);
     {$I-} Append (Fp); {$I+} IORes := IOResult;
     IF (IORes <> 0) AND (IORes <> 2) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to append '+Tmp);

          Soup_SaveJobForLater (OutPtr);
          DeleteOutboundRecord (OutPtr);
          Exit;
     END;

     IF (IORes = 2) THEN
     BEGIN
          {$I-} Rewrite (Fp); {$I+} IORes := IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes, 'Failed to create '+Tmp);

               DeleteOutboundRecord (OutPtr);
               Exit;
          END;
     END;

     IF (OutPtr^.OutType = otSoupNews) THEN
          Write (Fp, Name, #9, 'news', #9, 'Bn')
     ELSE
          Write (Fp, Name, #9, 'mail', #9, 'bn');

     Write (Fp, #10);

     Close (Fp);

     { Statistics }
     StatEntry_SoupJob (stdOutbound, 'LOCAL', OutPtr^.DestSystem, OutPtr^.MsgsBytes,
                                   OutPtr^.MsgsEcho, OutPtr^.MsgsMail);

     DeleteOutboundRecord (OutPtr);
END;

{==========================================================================}
{                            GLOBAL                                        }
{==========================================================================}


{--------------------------------------------------------------------------}
{ Outbound_Init                                                            }
{                                                                          }
{ This routine must be called before any of the other routines are called, }
{ preferably at program entry.                                             }
{                                                                          }
PROCEDURE Outbound_Init;
BEGIN
     FirstOutPtr:=NIL;
     GZipBatchLetter:='g';
     GigoMinusFLine:='';
     FakeUserRecNr:=32768;
END;


{--------------------------------------------------------------------------}
{ Outbound_Done                                                            }
{                                                                          }
{ This function must be called before the program is exitted. All the      }
{ outbound administration blocks are freed.                                }
{                                                                          }
PROCEDURE Outbound_Done;

VAR ErasePtr : OutboundRecordPtr;

BEGIN
     Outbound_FinishNow; { just in case }

     { there should be no jobs left now.. }
     WHILE (FirstOutPtr <> NIL) DO
     BEGIN
          ErasePtr:=FirstOutPtr;
          FirstOutPtr:=FirstOutPtr^.NextPtr;
          FreeMem (ErasePtr,SizeOf (OutboundRecord));
     END; { while }
END;


{--------------------------------------------------------------------------}
{ Outbound_FinishNow                                                       }
{                                                                          }
{ This routine simply closes all outbound jobs to free their handles. This }
{ is usually done before a pack operation.                                 }
{                                                                          }
PROCEDURE Outbound_FinishNow;

VAR NextOut,
    OutPtr  : OutboundRecordPtr;

BEGIN
     OutPtr:=FirstOutPtr;
     WHILE (OutPtr <> NIL) DO
     BEGIN
          { store the pointer to the next entry in case this record }
          { is deleted by one of the finilisation routines.         }

          NextOut:=OutPtr^.NextPtr;

          CASE OutPtr^.OutType OF
               otUucpNews :
                   UucpNewsOut_CloseJob (OutPtr);

               otFtnNet :
                   FtnNetOut_CloseJob (OutPtr);

               otFtnEcho :
                   FtnEchoOut_CloseJob (OutPtr);

               otSoupMail, otSoupNews:
                   SoupMailOut_CloseJob (OutPtr);

               ELSE
                   LogMessage (liReport,'Outbound_FinishNow: Unsupported type '+
                               Byte2String (Byte (OutPtr^.OutType)));

          END; { case }

          OutPtr:=NextOut;
     END; { while }
END;


BEGIN
     LastInetMail_MSGID := 0;
END.

