PROGRAM WtrTest;

{ test program for WaterGate configuration. Simulates WaterGate }

{$I platform.inc}

{$IFNDEF WtrTest} ## Check your conditional defines! ## {$ENDIF}

{$IFDEF PLATFORM_DPMI}    ## wrong platform! ### {$ENDIF}
{$IFDEF PLATFORM_OVERLAY} ## wrong platform! ### {$ENDIF}

{$IFNDEF PLATFORM_OS2_WIN32}
{$IFOPT G+} ## Switch of 286 mode! ## {$ENDIF}
{$ENDIF}

{$IFOPT B+} ## DISABLE Complete Boolean Evaluation ## {$ENDIF}

USES Globals,
     Ramon,
     Dos,
     Err_Func,
     Cfg,
     Database,
     Logs,
     Keys,
     Routing,
     ReadRout,
     ListSrv,
     UUCPRout,
     Msgs,
     Fido,
     Usenet,
     Language,
     Charsets,
     Tdb,
     BBSUsers,
     Gateway,
     FlexCfg,
     RunCfg,
     Address,
     Deliver,
     Copyrigh;

{$I wtrhlp.inc}

VAR FromUser : STRING[MaxLenUserName_F];
    FromAddr : STRING[MaxLenFidoAddrString];
    ToUser   : STRING[MaxLenUserName_F];
    ToAddr   : STRING[MaxLenFidoAddrString];
    ToLine   : STRING[50];
    RMail    : STRING;
    DTo      : STRING;
    DFrom    : STRING;

{--------------------------------------------------------------------------}
{ SimulateNetmailMapping                                                   }
{                                                                          }
PROCEDURE SimulateNetmailMapping;

CONST Xb = 5;
      Yb = 2;

VAR Quit    : BOOLEAN;
    Regel   : STRING;
    FromAka : FidoAddrType;
    ToAka   : FidoAddrType;

BEGIN
     WindowPush (Xb,Yb,73,7);
     BoxDraw (Double,Xb,Yb,73,7);

     FieldInit;

     WriteXY (Xb+2,Yb+1,'From User');
     FieldAutoDefineOne (Xb+12,Yb+1,@FromUser,RepChar (MaxLenUserName_F,'$'));
     FieldSetHelp (0,htr_SimNet_FromUser);

     WriteXY (Xb+2,Yb+2,'From AKA');
     FieldAutoDefineCheckOne (Xb+12,Yb+2,@FromAddr,RepChar (MaxLenFidoAddrString,'$'),CheckFidoAddr);
     FieldSetHelp (0,htr_SimNet_FromAKA);

     WriteXY (Xb+2,Yb+3,'To User');
     FieldAutoDefineOne (Xb+12,Yb+3,@ToUser,RepChar (MaxLenUserName_F,'$'));
     FieldSetHelp (0,htr_SimNet_ToUser);

     WriteXY (Xb+2,Yb+4,'To AKA');
     FieldAutoDefineCheckOne (Xb+12,Yb+4,@ToAddr,RepChar (MaxLenFidoAddrString,'$'),CheckFidoAddr);
     FieldSetHelp (0,htr_SimNet_ToAKA);

     WriteXY (Xb+2,Yb+5,'To: line');
     FieldAutoDefineOne (Xb+12,Yb+5,@ToLine,RepChar (50,'$'));
     FieldSetHelp (0,htr_SimNet_ToLine);

     Quit:=FALSE;
     REPEAT
           FieldEdit;

           CASE Key OF
                kEsc : Quit:=TRUE;

                kF10 :
                    BEGIN
                         FidoSplit (DeleteBackSpaces (FromAddr),FromAka);
                         FidoSplit (DeleteBackSpaces (ToAddr),ToAka);
                         Regel:=DeleteFrontAndBackSpaces (ToLine);

                         LogExtraMessage ('');
                         LogExtraMessage ('-- Processing Simulated Netmail --');

                         LogExtraMessage ('|From "'+DeleteFrontAndBackSpaces (FromUser)+'" '+Fido2Str (FromAka));
                         LogExtraMessage ('|To "'+DeleteFrontAndBackSpaces (ToUser)+'" '+Fido2Str (ToAka));
                         LogExtraMessage ('|To: '+Regel);

                         FTN_CreateNetmail (FromAka,
                                            DeleteFrontAndBackSpaces (FromUser),
                                            'WtrTest Subject');

                         Address_AddFTN (DeleteFrontAndBackSpaces (ToUser),
                                         ToAka,
                                         FALSE,FALSE);

                         IF (DeleteBackSpaces (Regel) <> '') THEN
                            MsgsAddLineTo (Body,'To: '+DeleteFrontAndBackSpaces (Regel));

                         DeliverNow;

                         MsgsEmpty;
                    END;
           END;

     UNTIL Quit;

     WindowPop;
END;


{--------------------------------------------------------------------------}
{ SimulateEMailMapping                                                     }
{                                                                          }
PROCEDURE SimulateEMailMapping;

CONST Xb = 3;
      Yb = 3;

VAR Quit  : BOOLEAN;
    Regel : STRING;

BEGIN
     WindowPush (Xb,Yb,75,5);
     BoxDraw (Double,Xb,Yb,75,5);

     FieldInit;

     {## extend this with multiple recipients}
     WriteXY (Xb+2,Yb+1,'Envelope address');
     FieldAutoDefineLongOne (Xb+19,Yb+1,54,@RMail,RepChar (255,'$'));
     FieldSetHelp (0,htr_SimEmail_EnvelopeHeader);

     {## extend this with loads of other headers}
     WriteXY (Xb+2,Yb+2,'To: header');
     FieldAutoDefineLongOne (Xb+19,Yb+2,54,@DTo,RepChar (255,'$'));
     FieldSetHelp (0,htr_SimEmail_ToHeader);

     WriteXY (Xb+2,Yb+3,'From: header');
     FieldAutoDefineLongOne (Xb+19,Yb+3,54,@DFrom,RepChar (255,'$'));
     FieldSetHelp (0,htr_SimEmail_FromHeader);

     Quit:=FALSE;
     REPEAT
           FieldEdit;

           CASE Key OF
                kEsc :
                     Quit:=TRUE;

                kF10 :
                    BEGIN
                         MsgsEmpty;

                         {Msg.XqtTo_U:=DeleteFrontAndBackSpaces (RMail);}
                         Address_AddRfcRaw (DeleteFrontAndBackSpaces (RMail),destTo,FALSE,FALSE);
                         Msg.ToUser_U:='To: '+DeleteFrontAndBackSpaces (DTo);
                         Msg.FromUser_U:='From: '+DeleteFrontAndBackSpaces (DFrom);
                         Msg.MessageID_U:='Message-ID: <wtrtest@nowhere>';

                         IF (DeleteFrontAndBackSpaces (RMail) = '') THEN
                            Error ('The Envelope Address is required!')
                         ELSE BEGIN
                              Msg.Ready_U:=Mail;

                              LogExtraMessage ('');
                              LogExtraMessage ('-- Processing Simulated E-mail --');

                              LogExtraMessage ('|Envelope: '+DeleteFrontAndBackSpaces (RMail));
                              LogExtraMessage ('|'+Msg.ToUser_U);
                              LogExtraMessage ('|'+Msg.FromUser_U);

                              {
                              FinishUsenetMsgBuildup;
                              UsenetRouteMail;
                              }
                              Address_CheckRFCRaw;
                              DeliverNow;

                              MsgsEmpty; { reports delivery errors }
                         END;
                    END; { kF10 }
           END; { case }

     UNTIL Quit;

     WindowPop;
END;


{--------------------------------------------------------------------------}
{ ShowRoutingTables                                                        }
{                                                                          }
PROCEDURE ShowRoutingTables;
BEGIN
     ListDefine (1,2,Video.Cols-2,Video.Rows-2,Default,
                 'Routing Tables',
                 htr_WtrTest_Routing_Tables);
     Routing_ListTables;
     UUCPRouting_ListTables;
     ListSelect (DoTag,[]);
     ListErase;
END;


{--------------------------------------------------------------------------}
{ ChangeControlFlags                                                       }
{                                                                          }
PROCEDURE ChangeControlFlags;

CONST Xb = 25;
      Yb = 10;
      Xl = 42;
      Yl = 9;

      Xb2 = Xb+14;

BEGIN
     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     FieldInit;

     WriteXY (Xb+2,Yb+1,'Processing Controls');

     WriteXY (Xb+2,Yb+3,'-NONETMAIL');
     FieldAutoDefineToggles (Xb2,Yb+3,ForceNoRoute,'no|yes',0);
     FieldSetHelp (0,htr_TestCtrl_NoNetmail);

     WriteXY (Xb+2,Yb+4,'-NOEXPORT');
     FieldAutoDefineToggles (Xb2,Yb+4,ForceNoExport,'no|yes',0);
     FieldSetHelp (0,htr_TestCtrl_NoExport);

     WriteXY (Xb+2,Yb+5,'-NOLOCAL');
     FieldAutoDefineToggles (Xb2,Yb+5,ForceNoImport,'no|yes',0);
     FieldSetHelp (0,htr_TestCtrl_NoLocal);

     WriteXY (Xb+2,Yb+7,'System mode');
     FieldAutoDefineToggles (Xb2,Yb+7,Config.FidoSystem,'binkley|frontdoor|d''bridge',0);
     FieldSetHelp (0,htr_TestCtrl_SystemMode);

     FieldEdit;

     WindowPop;
END;


{$I wtrstart.pas}

{--------------------------------------------------------------------------}
{ main                                                                     }
{                                                                          }

VAR Quit   : BOOLEAN;
    ReMenu : BOOLEAN;

BEGIN
     WriteLn (FullProgramName+' v'+FullProgramVersion);
     WriteLn (CopyrightLine);
     WriteLn;

     { lees de configuratie file }
     IF (NOT ReadConfigFile) THEN
        Exit;

     IF (NOT OpenDatabases) OR
        (NOT InitLang (Config.SystemDir)) OR
        (NOT CharSets_Init) THEN
     BEGIN
          CloseDatabases;
          WriteLn;
          WriteLn ('# Unable to open configuration files'#7);
          WriteLn;
          Halt (1);
     END;

     { check configuration & set global smarthost info }
     IF (NOT StartUpWtrGate) THEN
     BEGIN
          CloseDatabases;
          Halt (2);
     END;

     DesktopCopyright:='WSD';
     OpenDesktop (FullProgramName,FullProgramVersion);
     WriteKeysLine (' Initializing...');

     Log_SetWindowSize(Video.Rows-12);
     ScreenToo:=TRUE; { logs ook op het scherm afdrukken }

     AssignHelpFile (Config.SystemDir+'WTRGATE.HLP',HTR_HELP_VERSION_CRC);

     RunCfg_Init;
     ReadUserBaseIndexTable;
     ReadAreaBaseIndexTable;
     InitRoutingTable;
     ListServerTabelInit;
     CharSets_LoadDefault;

     IF (BBSNormalAreaRecNr <> NILRecordNr) OR
        (BBSEMailAreaRecNr <> NILRecordNr) OR
        (BBSViaRecNr <> NILRecordNr)
     THEN
         ReadBBSUsersIndex (DebugMem);

     LogClose;

     FromUser:=AddUpWithSpaces (MaxLenUserName_F,Config.Sysop);

     FromAddr:=AddUpWithSpaces (MaxLenFidoAddrString,'0');
     ToUser:=Spaces (MaxLenUserName_F);
     ToAddr:=AddUpWithSpaces (MaxLenFidoAddrString,'0');
     ToLine:=Spaces (50);
     {
     FromAddr:=AddUpWithSpaces (MaxLenFidoAddrString,'2:200/111.15');
     ToUser:=AddUpWithSpaces (MaxLenFromUser_F,'UUCP');
     ToAddr:=FromAddr;
     ToLine:=AddUpWithSpaces (50,'freetex!Jan.Botter@relay.nl.net');
     }

     RMail:=Spaces (255);
     DTo:=Spaces (255);
     DFrom:=AddUpWithSpaces (255,'ramon@wsd.wline.se (Ramon van der Winkel)');

     Delete (FieldSelectKeysLine,1,Length (F1Help));
     Delete (FieldSelectKeysLine,Pos (',^F10',FieldSelectKeysLine),5);
     Delete (FieldEditKeysLine,1,Length (F1Help));
     Delete (MenuKeysLine,1,Length (F1Help));

     FieldSelectKeysLine:=FieldSelectKeysLine+'    --> ^F10 Execute <--';

     ForceNoRoute:=FALSE;
     ForceNoExport:=FALSE;
     ForceNoImport:=FALSE;

     {$IFDEF Alfa}
     ShowCopyright;
     {$ENDIF}

     {$IFDEF Beta}
     ShowCopyright;
     {$ENDIF}

     {$IFDEF Gamma}
     ShowCopyright;
     {$ENDIF}

     ReMenu:=TRUE;
     Quit:=FALSE;
     REPEAT
           IF ReMenu THEN
           BEGIN
                MenuDefine (30,4,'Main Menu');
                MenuSetHelp (htr_WtrTest_Main_Menu);
                MenuAddItem ('Simulate netmail');
                MenuAddItem ('Simulate e-mail');
                MenuAddItem ('Control flags');
                MenuAddItem ('Routing tables');
                MenuAddItem ('About '+FullProgramName);
                MenuAddItem ('Exit program');
                MenuShow;
                ReMenu:=FALSE;
           END;

           CASE MenuSelect OF

                mOpt01 :
                    BEGIN
                         MenuErase;
                         ReMenu:=TRUE;
                         SimulateNetmailMapping;
                    END;

                mOpt02 :
                    BEGIN
                         MenuErase;
                         ReMenu:=TRUE;
                         SimulateEmailMapping;
                    END;

                mOpt03 :
                    ChangeControlFlags;

                mOpt04 :
                    ShowRoutingTables;

                mOpt05 :
                    ShowAboutBox;

                kEsc,
                mOpt06 :
                    Quit:=TRUE;

           END; { case }

     UNTIL Quit;

     IF (NOT ReMenu) THEN
        MenuErase;

     CloseDatabases;
     JunkBBSUsersIndex;
     JunkUserBaseIndexTable;
     JunkAreaBaseIndexTable;
     JunkListServerTable;
     JunkRoutingTable;
     DeleteUUCPRoutingTable; { RWI 951028: moved here }
     JunkLang;
     CharSets_Junk;
     JunkGatewayChecks;
     RunCfg_Done;

     LogMessage (liTrivial,'Ending program');
     LogExtraMessage ('');
     LogClose;

     CloseDesktop;
     ScreenToo:=FALSE;

     WriteLn ('Ending '+FullProgramName+' v',FullProgramVersion);

     TdbDone;
     DumpMem;
END.
