UNIT Import;

{$i platform.inc}

{ this unit contains the generic interfaces to all the message base }
{ formats supported plus the code generic to all these bases.       }

INTERFACE

USES Database,
     Msgs;

PROCEDURE ImportEchomail (VAR AreaRec : AreaBaseRecord; MsgID : STRING);
PROCEDURE ImportNetmail (AreaRecNr : AreaBaseRecordNrType);
PROCEDURE ImportNetmail_InPrimaryNetmailArea (ToUser : STRING; ToAka : FidoAddrType);
PROCEDURE ImportNetmailForBBSUser (DestPtr : DestRecordPtr);
PROCEDURE WriteMessageToBad;
PROCEDURE WriteMessageToRFCBad (Reason : STRING; BadDestPtr : DestRecordPtr);
PROCEDURE WriteMessageToDupe;
{$IFDEF WtrUtil}
PROCEDURE RFCBadManager;
{$ENDIF}


IMPLEMENTATION

USES Ramon,
     Dos,
     Logs,
     Cfg,
     Decode,
     FidoMsg,
     Jam,
     Squish,
     Routing,
     Fido,
     Start,
     Trans,
     Globals,
     NewStats,
     UnixTime;

{$I wtrhlp.inc}

{--------------------------------------------------------------------------}
{ ImportEchomail                                                           }
{                                                                          }
{ This routine imports a message that is now in echomail format into the   }
{ area with the AreaRecNr given. The MsgID is an 8 digit hex string.       }
{                                                                          }
PROCEDURE ImportEchomail (VAR AreaRec : AreaBaseRecord; MsgId : STRING);

VAR Original_FromAddr_F : FidoAddrType;

BEGIN
     IF (AreaRec.FidoMsgStyle = NoneType) THEN
     BEGIN
          {
          IF Config.LogDebug THEN
             LogMessage (liConfig,'Pass-through area (no msgbase): '+AreaRec.AreaName_F);
          }
          Exit; { ## EXIT ## }
     END;

     LogMessage (liDebug,'Importing echomail message');

     { translation code towards Echomail must fill in ToUser_F }
     Msg.Stored_ToUser:=Msg.ToUser_F;
     Msg.Stored_ToAddr:=NullAdres;

     { remove all flags before importing echomail }
     Msg.Attr_F:=0;
     Msg.ExtAttr_F:=0;

     Original_FromAddr_F:=Msg.FromAddr_F;

     IF (Msg.FromAddr_F.Domain = #1#2#3) THEN
     BEGIN
          { news to echo translation has not set the from address   }
          { sinc we want to match the system aka used with the      }
          { origin aka. We do that here by replacing the FromAddr_F }
          { Since we can import this message in multiple areas, we  }
          { restore it back to #1#2#3 afterwards.                   }
          Msg.FromAddr_F:=Config.NodeNrs[AreaRec.OriginAKA];
          LogMessage (liDebug,'Set From AKA to '+Fido2Str (Msg.FromAddr_F));
     END;

     TransFix_Load (AreaRec,MsgId);

     { info nr is updated here to avoid conflicts with bad and dupe }
     CASE AreaRec.FidoMsgStyle OF
          FidoMsgType :
              FidoMsg_ImportMessage (AreaRec.AreaName_F,AreaRec.FidoMsgPath,AreaRec.DecodePath,AreaRec.Decode);

          SquishType :
              Squish_ImportMessage (AreaRec.AreaName_F,AreaRec.FidoMsgPath,AreaRec.DecodePath,AreaRec.Decode);

          JamType :
              Jam_ImportMessage (AreaRec.AreaName_F,AreaRec.FidoMsgPath,AreaRec.DecodePath,AreaRec.Decode);
     END; { case }

     TransFix_Unload;

     Msg.FromAddr_F:=Original_FromAddr_F;
END;


{--------------------------------------------------------------------------}
{ ImportNetmail                                                            }
{                                                                          }
{ This routine imports a message into a netmail area. This is used with    }
{ Move/Copy filters.                                                       }
{                                                                          }
PROCEDURE ImportNetmail (AreaRecNr : AreaBaseRecordNrType);

VAR AreaRec : AreaBaseRecord;

BEGIN
     ReadAreaBaseRecord (AreaRecNr,AreaRec);

     IF (AreaRec.FidoMsgStyle = NoneType) THEN
     BEGIN
          IF Config.LogDebug THEN
             LogMessage (liConfig,'No message base defined for '+AreaRec.AreaName_F);
          Exit; { ## EXIT ## }
     END;

     { after silent check }
     LogMessage (liDebug,'Importing (area) netmail');

     { take the first address }
     IF (Msg.FirstDest <> NIL) THEN
     BEGIN
          Msg.Stored_ToUser:=Msg.FirstDest^.ToUser_F;
          Msg.Stored_ToAddr:=Msg.FirstDest^.ToAddr_F;
     END ELSE
     BEGIN
          Msg.Stored_ToUser:='?';
          Msg.Stored_ToAddr:=NullAdres;
     END;

     { probably used by the message base routines }
     TransFix_Load (AreaRec,'00000000'{MsgId});

     { info nr is updated here to avoid conflicts with bad and dupe }
     CASE AreaRec.FidoMsgStyle OF
          FidoMsgType :
              FidoMsg_ImportMessage (AreaRec.AreaName_F,AreaRec.FidoMsgPath,AreaRec.DecodePath,AreaRec.Decode);

          SquishType :
              Squish_ImportMessage (AreaRec.AreaName_F,AreaRec.FidoMsgPath,AreaRec.DecodePath,AreaRec.Decode);

          JamType :
              Jam_ImportMessage (AreaRec.AreaName_F,AreaRec.FidoMsgPath,AreaRec.DecodePath,AreaRec.Decode);
     END; { case }

     TransFix_Unload;
END;


{--------------------------------------------------------------------------}
{ ImportNetmail_InPrimaryNetmailArea                                       }
{                                                                          }
{ Importeerd een netmail bericht in de juiste messagebase.                 }
{                                                                          }
PROCEDURE ImportNetmail_InPrimaryNetmailArea (ToUser : STRING; ToAka : FidoAddrType);

VAR FlagFile : TEXT;
    IORes    : BYTE;

    DecodePath  : STRING;
    DecodeFiles : BOOLEAN;

BEGIN
{$IFDEF WtrTest}
     LogMessage (liGeneral,'Target: Import in primary netmail area');
{$ELSE}
     IF Config.LogNetmailImport THEN
        LogMessage (liDebug,'Importing (primary) netmail for "'+ToUser+'" at '+Fido2Str (ToAka));

     IF FidoOurAdres (ToAka) THEN
     BEGIN
          DecodePath:=Config.NetmailDecodePath;
          DecodeFiles:=Config.NetmailDecode;
     END ELSE
     BEGIN
          DecodePath:='';
          DecodeFiles:=FALSE;
     END;

     Msg.Stored_ToUser:=ToUser;
     Msg.Stored_ToAddr:=ToAka;

     CASE Config.FidoNetmailType OF
          FidoMsgType :
              BEGIN
                   FidoMsg_ImportMessage ('Primary netmail',Config.FidoNetmailPath,DecodePath,DecodeFiles);
                   GoSetFMRescan:=TRUE;
              END;

          SquishType :
              Squish_ImportMessage ('Primary Netmail',Config.FidoNetmailPath,DecodePath,DecodeFiles);

          JamType :
              Jam_ImportMessage ('Primary Netmail',Config.FidoNetmailPath,DecodePath,DecodeFiles);

     END; { case }

     { schrijf een IMPORTED.WG indicatie behalve voor body-loze f/a's }
     {## set a flag and let START.PAS do this at the end?}
     IF (Msg.BodyParts[1] <> NIL) THEN
     BEGIN
          Assign (FlagFile,Config.SystemDir+'IMPORTED.WG');
          {$I-} ReWrite (FlagFile); {$I+} IORes:=IOResult;
          IF (IORes = 0) THEN
          BEGIN
               {$IFDEF LogFileIO}PostOpenT (FlagFile);{$ENDIF}
               {$IFDEF LogFileIO}PreCloseT (FlagFile);{$ENDIF}
               {$I-} Close (FlagFile); {$I+} IORes:=IOResult;
          END;

          IF (IORes <> 0) THEN
             LogDiskIOError (IORes,'Error creating IMPORTED.WG');
     END;
{$ENDIF (WtrTest)}
END;


{--------------------------------------------------------------------------}
{ WriteMessageToBad                                                        }
{                                                                          }
{ Fido berichten die niet verwerkt konden worden, moeten afhankelijk van   }
{ de instellingen geplaatst worden in een bepaalde area.                   }
{                                                                          }
PROCEDURE WriteMessageToBad;
BEGIN
{$IFDEF WtrTest}
     LogMessage (liGeneral,'Target: Import in BAD area');
{$ELSE}
     IF (Config.FidoBadAreaType = NoneType) THEN
     BEGIN
          IF Config.LogDebug THEN
             LogMessage (liConfig,'No BAD area defined');
          Exit;
     END;

     LogMessage (liGeneral,'Writing message to BAD: '+Msg.BadReason);

     { RAWI 980111: not required anymore. AREA: kludge is left out   }
     {              of message and instead added when creating a PKT }
     (*
     IF (Msg.Area_F <> '') THEN
        MsgsDeleteFirstRowFromHeader; { remove the AREA: kludge }
     *)

     { voeg de reden waarom... toe aan het bericht einde }
     IF (Msg.BadReason <> '') THEN
        MsgsAddFirstLineTo (Header_F,#1'WTRBAD_REASON: '+Msg.BadReason);

     { plug de orginele area name in het begin van het bericht }
     IF (Msg.Area_F <> '') THEN
        MsgsAddFirstLineTo (Header_F,#1'WTRBAD_AREA: '+DeleteBackSpaces (Msg.Area_F));

     (*
     RAWI 981029: the Dest list is now ignored and the Stored_* fields
                  are expected to be correct. For echomail, the following
                  code was changing all addresses to ? 0:0/0...

     { Bad for _F is mostly for echomail, so set Stored_* fields }
     { take the first address }
     IF (Msg.FirstDest <> NIL) THEN
     BEGIN
          Msg.Stored_ToUser:=Msg.FirstDest^.ToUser_F;
          Msg.Stored_ToAddr:=Msg.FirstDest^.ToAddr_F;
     END ELSE
     BEGIN
          Msg.Stored_ToUser:='?';
          Msg.Stored_ToAddr:=NullAdres;
     END;
     *)

     { en probeer het bericht naar de geconfigureerde bad area te schrijven }

     Start_CountDupBad:=TRUE;

     CASE Config.FidoBadAreaType OF
          FidoMsgType :
              FidoMsg_ImportMessage ('WtrBad',Config.FidoBadPath,'',FALSE);

          SquishType :
              Squish_ImportMessage ('WtrBad',Config.FidoBadPath,'',FALSE);

          JamType :
              Jam_ImportMessage ('WtrBad',Config.FidoBadPath,'',FALSE);

     END; { case }

     Start_CountDupBad:=FALSE;
{$ENDIF (WtrTest)}
END;


VAR RFCBadFile : TEXT;

{--------------------------------------------------------------------------}
{ WriteLineToRFCBadFile                                                    }
{                                                                          }
FUNCTION WriteLineToRFCBadFile (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     { it's guaranteed to have only one #13 in a line }
     { otherwise it will hit the normal write anyway }
     IF (Regel[Length (Regel)] = #13) THEN
        WriteLn (RFCBadFile,Copy (Regel,1,Length (Regel)-1))
     ELSE
         Write (RFCBadFile,Regel);

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


{--------------------------------------------------------------------------}
{ WriteMessageToRFCBad                                                     }
{                                                                          }
{ Bounced/whatever RFC messages are written to the RFCBadPath directory.   }
{ Each message is given a unique filename, and an index is written.        }
{ ## Notify administrator?                                                 }
{                                                                          }
PROCEDURE WriteMessageToRFCBad (Reason : STRING; BadDestPtr : DestRecordPtr);

    PROCEDURE WriteDestInfoToRFCBadFile (DestPtr : DestRecordPtr);

    VAR AreaRec : AreaBaseRecord;

    BEGIN
         WriteLn (RFCBadFile,'Destination: '+Status2Str[DestPtr^.Status]);

         CASE DestPtr^.ToType OF
              destTo,
              destNotSure :
                  Write (RFCBadFile,'  To  : ');

              destCc :
                  Write (RFCBadFile,'  Cc  : ');

              destBcc :
                  Write (RFCBadFile,'  Bcc : ');
         END; { case }

         IF (DestPtr^.ToUser_F <> '') OR (NOT FidoCompare (DestPtr^.ToAddr_F,NullAdres)) THEN
         BEGIN
              { FTN info is present }
              Write (RFCBadFile,'"'+DestPtr^.ToUser_F+'" at '+Fido2Str (DestPtr^.ToAddr_F));

              IF (DestPtr^.To_U <> '') THEN
                 Write (RFCBadFile,' ('+DestPtr^.To_U+')');

              WriteLn (RFCBadFile);
         END ELSE
         BEGIN
              { no FTN info present }
              WriteLn (RFCBadFile,DestPtr^.To_U);
         END;

         IF (DestPtr^.AreaRecNr <> NILRecordNr) AND
            (DestPtr^.AreaRecNr <> 0{after init}) THEN
         BEGIN
              ReadAreaBaseRecord (Destptr^.AreaRecNr,AreaRec);
              WriteLn (RFCBadFile,'  Area: '+Word2String (DestPtr^.AreaRecNr)+
                                  ' / '+AreaRec.AreaName_U);
         END;
    END;

VAR IORes    : BYTE;
    Filename : STRING;
    DestPtr  : DestRecordPtr;
    Lp       : 1..MAX_BODY_PARTS;

BEGIN
{$IFDEF WtrTest}
     LogMessage (liGeneral,'Target: Dump to RFC bad directory');
{$ELSE}
     LogMessage (liGeneral,'Writing message to RFC bad directory');

     Filename:=GetUniqueFilename (Config.RFCBadPath,'.TXT');

     Assign (RFCBadFile,Filename);
     {$I-} ReWrite (RFCBadFile); {$I+} IORes:=IOResult;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to create dump file: '+Filename);
          Exit; { ## EXIT ## }
     END;

     LogExtraMessage (Filename);

     { write a header }
     WriteLn (RFCBadFile,'RFC bad file');
     WriteLn (RFCBadFile);
     WriteLn (RFCBadFile,'Created: '+UnixTimeToString (GetCurrentUnixTime));
     WriteLn (RFCBadFile,'Reason: '+Reason);
     WriteLn (RFCBadFile);

     { verify that the BadDestPtr is valid }
     IF (BadDestPtr <> NIL) THEN
     BEGIN
          { see if we can find it }
          DestPtr:=Msg.FirstDest;
          WHILE (DestPtr <> NIL) AND (DestPtr <> BadDestPtr) DO
                DestPtr:=DestPtr^.NextDest;

          IF (DestPtr = NIL) THEN
          BEGIN
               LogMessage (liReport,'Invalid BadDestPtr: $'+Long2HexString (Ptr2Long (BadDestPtr)));
               BadDestPtr:=NIL;
          END;
     END;

     { write info on the destination that causes the dump }
     IF (BadDestPtr <> NIL) THEN
     BEGIN
          WriteLn (RFCBadFile,'---- following destinations trigged this dump ----');
          WriteDestInfoToRFCBadFile (BadDestPtr);
          WriteLn (RFCBadFile,'---- end of destination info ----');
          WriteLn (RFCBadFile);
     END;

     { write all the destinations }
     WriteLn (RFCBadFile,'---- following were the destinations ----');

     DestPtr:=Msg.FirstDest;
     WHILE (DestPtr <> NIL) DO
     BEGIN
          WriteDestInfoToRFCBadFile (DestPtr);

          DestPtr:=DestPtr^.NextDest;

          IF (DestPtr <> NIL) THEN
             WriteLn (RFCBadFile);
     END;

     WriteLn (RFCBadFile,'---- end of destinations list ----');
     WriteLn (RFCBadFile);

     { write the RFC header }
     WriteLn (RFCBadFile,'---- message headers follow ----');
     MsgsForEach (Msg.HeaderTop_U,WriteLineToRFCBadFile);
     WriteLn (RFCBadFile,'---- end of message headers ----');
     WriteLn (RFCBadFile);

     { write all the body parts }
     WriteLn (RFCBadFile,'---- message text follows ----');

     FOR Lp:=1 TO MAX_BODY_PARTS DO
         MsgsForEach (Msg.BodyParts[Lp],WriteLineToRFCBadFile);

     WriteLn (RFCBadFile,'---- end of message text ----');

     Close (RFCBadFile);
{$ENDIF (WtrTest)}
END;


{--------------------------------------------------------------------------}
{ WriteMessageToDupe                                                       }
{                                                                          }
{ Fido berichten die niet verwerkt konden worden, moeten afhankelijk van   }
{ de instellingen geplaatst worden in een bepaalde area.                   }
{                                                                          }
PROCEDURE WriteMessageToDupe;
BEGIN
{$IFDEF WtrTest}
     LogMessage (liTrivial,'Target: Import in DUPE area');
{$ELSE}
     LogMessage (liTrivial,'Writing message to DUPE');

     { plug de orginele area name in het begin van het bericht }
     IF (Msg.Area_F <> '') THEN
        MsgsAddFirstLineTo (Header_F,#1'WTRDUPE:'+DeleteBackSpaces (Msg.Area_F));

     {## SEEN-BY and PATH lines must be replaced with the origin ones!}

     { en probeer het bericht naar de geconfigureerde dupe area te schrijven }

     { Dupe for _F is mostly for echomail, so set Stored_* fields }
     { take the first address }
     IF (Msg.FirstDest <> NIL) THEN
     BEGIN
          Msg.Stored_ToUser:=Msg.FirstDest^.ToUser_F;
          Msg.Stored_ToAddr:=Msg.FirstDest^.ToAddr_F;
     END ELSE
     BEGIN
          Msg.Stored_ToUser:='?';
          Msg.Stored_ToAddr:=NullAdres;
     END;

     Start_CountDupBad:=TRUE;

     CASE Config.FidoDupeAreaType OF
          FidoMsgType :
              FidoMsg_ImportMessage ('WtrDupe',Config.FidoDupePath,'',FALSE);

          SquishType :
              Squish_ImportMessage ('WtrDupe',Config.FidoDupePath,'',FALSE);

          JamType :
              Jam_ImportMessage ('WtrDupe',Config.FidoDupePath,'',FALSE);

     END; { case }

     Start_CountDupBad:=FALSE;
{$ENDIF (WtrTest)}
END;


{--------------------------------------------------------------------------}
{ ImportNetmailForBBSUser                                                  }
{                                                                          }
{ Import netmail for BBS user.                                             }
{                                                                          }
PROCEDURE ImportNetmailForBBSUser (DestPtr : DestRecordPtr);

VAR AreaRec : AreaBaseRecord;

BEGIN
     { use the BBS-EMAILAREA for gated netmails or when the normal }
     { area is not defined.                                        }
     IF (Msg.WasGated AND (BBSEmailAreaRecNr <> NILRecordNr)) OR
        (BBSNormalAreaRecNr = NILRecordNr) THEN
     BEGIN
          {$IFDEF WtrTest}
          LogMessage (liTrivial,'Target: Import in BBS e-mail area.');
          {$ELSE}
          ReadAreaBaseRecord (BBSEmailAreaRecNr,AreaRec);
          {$ENDIF}
     END ELSE
     BEGIN
          {$IFDEF WtrTest}
          LogMessage (liTrivial,'Target: Import in BBS area.');
          {$ELSE}
          ReadAreaBaseRecord (BBSNormalAreaRecNr,AreaRec);
          {$ENDIF}
     END;

     { AreaRec now loaded with area to use }

     TransFix_Load (AreaRec,'');

{$IFNDEF WtrTest}

     { strip local flag }
     Msg.Attr_F:=Msg.Attr_F AND ($FFFF-MSGLOCAL);

     CASE AreaRec.FidoMsgStyle OF
          FidoMsgType :
              FidoMsg_ImportMessage (AreaRec.AreaName_F,AreaRec.FidoMsgPath,AreaRec.DecodePath,AreaRec.Decode);

          SquishType :
              Squish_ImportMessage (AreaRec.AreaName_F,AreaRec.FidoMsgPath,AreaRec.DecodePath,AreaRec.Decode);

          JamType :
              Jam_ImportMessage (AreaRec.AreaName_F,AreaRec.FidoMsgPath,AreaRec.DecodePath,AreaRec.Decode);

     END; { case }

{$ENDIF (!WtrTest)}

     {##TransFix_Unload seems to be missing!}
END;


{$IFDEF WtrUtil}
{--------------------------------------------------------------------------}
{ ViewRFCBadFile                                                           }
{                                                                          }
{ This routine shows the contents of Filename to the user. When the user   }
{ presses Escape, we present the question to delete this file or not. If   }
{ decided to delete the file, this routine both removes the file and       }
{ returns TRUE so the file can be removed from the list. Otherwise it      }
{ returns FALSE.                                                           }
{                                                                          }
FUNCTION ViewRFCBadFile (Filename : STRING) : BOOLEAN;

VAR BadFile : TEXT;
    IORes   : BYTE;
    Regel   : STRING;

BEGIN
     ViewRFCBadFile:=FALSE; { assume not deleted }

     Assign (BadFile,Filename);
     {$I-} Reset (BadFile); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          Error ('Failed to open '+Filename+' (error '+Byte2String (IORes)+')');
          Exit; { ## EXIT ## }
     END;

     ListDefine (2,3,76,Video.Rows-4,Default,'Contents of RFC bad file '+Filename,htr_BadMgr_FileContents);

     WHILE (NOT Eof (BadFile)) DO
     BEGIN
          ReadLn (BadFile,Regel);
          ListAddItem (CleanTabs (Regel,4),0,Bottom);
     END; { while }

     Close (BadFile);

     ListSelect (NoTag,[]);

     MenuDefine (30,10,'Delete this file?');
     MenuAddItem ('No, keep it');
     MenuAddItem ('Yes, delete it');
     MenuSetHelp (htr_BadMgr_DeleteFile);
     MenuShow;

     IF (MenuSelect = mOpt02) THEN
     BEGIN
          {$I-} Erase (BadFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             Error ('Error deleting '+Filename+' (error '+Byte2String (IORes)+')')
          ELSE
              ViewRFCBadFile:=TRUE;
     END;

     MenuErase;

     ListErase;
END;


{--------------------------------------------------------------------------}
{ RFCBadManager                                                            }
{                                                                          }
{ This routine is called when the RFC bad manager is activated in WtrUtil. }
{ We present a list of all the files in the RFC bad directory and let the  }
{ user view it. Once viewed, we asked the user if the file can be deleted. }
{                                                                          }
PROCEDURE RFCBadManager;

VAR Keuze  : WORD;
    Quit   : BOOLEAN;
    Search : SearchRec;

BEGIN
     Config.RFCBadPath:=DeleteFrontAndBackSpaces (Config.RFCBadPath);

     IF (Config.RFCBadPath = '') THEN
     BEGIN
          Error ('RFC bad path is not defined');
          Exit;
     END;

     Config.RFCBadPath:=CorrectPath (Config.RFCBadPath);

     ListDefine (2,3,75,Video.Rows-4,Default,
                 'Contents of the RFC bad directory',
                 htr_BadMgr_DirectoryContents);

     Keuze:=0;

     FindFirst (Config.RFCBadPath+'*.TXT',$20,Search);
     WHILE (DosError = 0) DO
     BEGIN
          Inc (Keuze);
          ListAddItem (Search.Name,Keuze,Sorted);

          FindNext (Search);
     END; { while }

     FindClose (Search);

     IF (ListItemCount = 0) THEN
        ListAddItem ('No files found',65530,Bottom);

     Quit:=FALSE;
     REPEAT
           Keuze:=ListSelect (NoTag,[]);

           CASE Key OF
                kEsc : Quit:=TRUE;

                kRet :
                    IF ViewRFCBadFile (Config.RFCBadPath+ListGetItemTekst (Keuze)) THEN
                       ListRemoveItem (Keuze);
           END;
     UNTIL Quit;

     ListErase;
END;
{$ENDIF}


END.
