PROGRAM WtrUtil;

{$I platform.inc}

{$A+,B-,F-,O-,P-,Q-,R-,S-,V+,X+}

{$IFNDEF WtrUtil} ## Check you conditional defines! ## {$ENDIF}

{$IFNDEF PLATFORM_OS2_WIN32}
{$IFOPT G+} ## Do not compile for 80286 ## {$ENDIF}
{$ENDIF}

{ WaterUtil                                                              }
{                                                                        }
{ Om alle databases, zowel met berichten als die van het systeem te      }
{ onderhouden is een apart programma nodig. WtrUtil kan verschillende    }
{ dingen :                                                               }
{                                                                        }
{   - Linken van areas                                                   }
{   - Purgen van areas  (delete & pack oude berichten)                   }
{   - Renumber Fido *.MSG areas (toekomstig: Waffle areas?)              }
{   - Packen van de User & Area base                                     }
{                                                                        }
{ MD  08-09-93 Creatie hoofd programma                                   }
{ RWI 18-10-94 Takeover, re-layout en bug fixing                         }
{     95????   Added ShrinkLog                                           }
{     950531   Added CleanGroupZ                                         }
{                                                                        }

USES Dos,
     Ramon,
     Err_Func,
     Logs,
     MsgUtil,
     Database,
     Globals,
     Cfg,
     PackBase,
     FidoMsg,
     Slice,
     Copyrigh,
     BBSUsers,
     Tdb,
     ReadRout,
     UUCPRout,
     Nodelist,
     Extend,
     DupeChk,
     Import;

{$I WTRHLP.INC}

{---------------------------------------------------------------------------}
{ CheckShrinkDaysFunc                                                       }
{                                                                           }
{ Deze routine controleert het ingevoerde aantal shrinkdays. Als de invoer  }
{ niet legaal is, dan wordt FALSE terug gegeven.                            }
{                                                                           }
FUNCTION CheckShrinkDaysFunc (BufferPtr : StringPtr) : BOOLEAN; FAR;

VAR Days : BYTE;
    Nop  : ValNop;

BEGIN
     Val (DeleteFrontAndBackSpaces (BufferPtr^),Days,Nop);
     CheckShrinkDaysFunc:=(Nop = 0);
END;


{---------------------------------------------------------------------------}
{ InputShrinkDays                                                           }
{                                                                           }
{ Met deze routine kan het aantal shrink days ingevoerd worden. Als er op   }
{ Escape gedrukt wordt, dan wordt FALSE terug gegeven, anders is er op Ret  }
{ gedrukt en wordt TRUE terug gegeven.                                      }
{                                                                           }
FUNCTION InputShrinkDays : BOOLEAN;

CONST Xb = 25;
      Yb = 8;
      Xl = 30;
      Yl = 5;

VAR DaysStr : STRING[2];
    Nop     : ValNop;

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

     WriteXY (Xb+2,Yb+2,'Number of days to keep: ');

     DaysStr:=AddUpWithSpaces (2,Byte2String (ShrinkDays));

     FieldInit;
     FieldDefineCheckOne (1,Xb+26,Yb+2,2,0,0,@DaysStr,'%%',CheckShrinkDaysFunc);
     FieldSetHelp (1,htr_WtrUtil_ShrinkDays_Input);
     FieldEditDirect;

     IF (Key <> kEsc) THEN
        Val (DeleteFrontAndBackSpaces (DaysStr),ShrinkDays,Nop);

     WindowPop;

     InputShrinkDays:=(Key <> kEsc);
END;

(*
{---------------------------------------------------------------------------}
{ InputScriptFilename                                                       }
{                                                                           }
{ Met deze routine kan de filename van de scriptfile ingevoerd worden. Deze }
{ wordt opgeslagen in CleanZ.ScriptFilename. Als er op Escape gedrukt       }
{ wordt, dan wordt FALSE terug gegeven, anders is er op Enter gedrukt en    }
{ wordt TRUE terug gegeven.                                                 }
{                                                                           }
FUNCTION InputScriptFilename : BOOLEAN;

CONST Xb = 14;
      Yb = 8;
      Xl = 51;
      Yl = 5;

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

     WriteXY (Xb+2,Yb+2,'Script Filename: ');

     ScriptFilename:=AddUpWithSpaces (79,ScriptFilename);

     FieldInit;
     FieldDefineLongOne (1,Xb+19,Yb+2,79,30,0,0,@ScriptFilename,RepChar (79,'@'));
     FieldSetHelp (1,4301);
     FieldEditDirect;

     WindowPop;

     ScriptFilename:=DeleteFrontAndBackSpaces (ScriptFilename);

     InputScriptFilename:=((ScriptFilename <> '') AND (Key <> kEsc));
END;
*)

{--------------------------------------------------------------------------}
{ TellHelpScreen                                                           }
{                                                                          }
{ Laat de meest elementaire commando's op de command line zien.            }
{                                                                          }
PROCEDURE TellHelpScreen;
BEGIN
     WriteLn ('Usage: WTRUTIL <command> [<options>] [<argument>] [<groups filter>]');
     WriteLn;
     WriteLn ('LINK      - Link messages in each area');
     WriteLn ('PURGE     - Trims areas by age and number');
     WriteLn ('INDEX     - Rebuild index files for message bases');
     WriteLn ('RENUM     - Renumber all *.MSG areas');
     WriteLn ('RENUMJAM  - Renumber all JAM areas');
     WriteLn;
     WriteLn ('Use a group filter to limit the areas processed, like WTRUTIL LINK A1B34CDH12');
     WriteLn;
     WriteLn ('DATABASE  - Removes deleted records from WaterGate''s own databases');
     WriteLn ('            Optionally add -NOSORT to save time by not sorting the areabase');
     WriteLn ('IMPORT    - Import messages from the *.MSG netmail directory into a Squish');
     WriteLn ('            or JAM netmail base. Use "WTRUTIL IMPORT ?" for more information');
     WriteLn ('SHRINKLOG - Trash old history information out of the .log file');
     WriteLn ('            Usage: WTRUTIL SHRINKLOG <days to keep>');
     WriteLn ('SHRINKSTA - As SHRINKLOG, but for the statistics file (.sta)');
     WriteLn ('BBSUSERS  - (Re-)build the BBS users index. Needs filename argument.');
     WriteLn ('NODELIST  - (Re-)build the nodelist index. Files read from ROUTE.TDB.');
     WriteLn;
     WriteLn ('Use -NOSLICE to disable the time slicing support');
END;


PROCEDURE ShowHelpImport;
BEGIN
     WriteLn ('IMPORT - Imports messages from the *.MSG netmail area into a');
     WriteLn ('         JAM or Squish Netmail area.');
     WriteLn;
     WriteLn ('         IMPORT AREA_NAME [address] [-NOKILL]');
     WriteLn;
     WriteLn ('         Where "AREA_NAME" is the name of the area to import the');
     WriteLn ('         messages into. "Address" is one of your Fido system AKAs');
     WriteLn ('         to which the they must be addressed. If omited, messages');
     WriteLn ('         to any of the system AKAs are imported.');
     WriteLn;
     WriteLn ('         Use -NOKILL to keep the original messages in the');
     WriteLn ('         Netmail directory. They are deleted by default.');
     WriteLn;
END;


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

VAR Quit         : BOOLEAN;
    MenuAuto     : KeyType;
    Lp           : BYTE;
    Param,
    ParamCmd,
    Param2nd,
    Param3rd     : STRING;
    Nop          : ValNop;
    HadGroupArg  : BOOLEAN;
    Groups       : GroupFlagType;
    ForceNoSlice : BOOLEAN;
    ForceNoKill  : BOOLEAN;
    LastLetterNr : GroupNrType;

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

     MenuAuto:=kUnknown;
     HadGroupArg:=FALSE;

     ForceNoSort:=FALSE;  { already set by packbase.init }
     ForceNoSlice:=FALSE;
     ForceNoKill:=FALSE;

     { first word is a command, second wordt is a filter or areaname or  }
     { message base path. Rest can have -option.                         }
     ParamCmd:='';
     Param2nd:=''; { area path, aka, groups filter, keep days, msgbase path, etc. }
     Param3rd:='';

     FOR Lp:=1 TO ParamCount DO
     BEGIN
          Param:=UpCaseString (ParamStr (Lp));

          IF NOT (Param[1] IN ['-','/']) THEN
          BEGIN
               IF (ParamCmd = '') THEN
               BEGIN
                    ParamCmd:=Param;
                    Continue;
               END;

               IF (Param2nd = '') THEN
               BEGIN
                    Param2nd:=Param;
                    Continue;
               END;

               IF (Param3rd = '') THEN
               BEGIN
                    Param3rd:=Param;
                    Continue;
               END;

               WriteLn ('# Invalid argument: ',ParamStr (Lp));
               Halt (1);
          END ELSE
          BEGIN
               { is an option }
               Delete (Param,1,1);  { minus or slash }

               IF (Param = 'NOSLICE') THEN
               BEGIN
                    ForceNoSlice:=TRUE;
                    Continue;
               END;

               IF (Param = 'NOSORT') THEN
               BEGIN
                    ForceNoSort:=TRUE;
                    Continue;
               END;

               IF (Param = 'NOKILL') THEN
               BEGIN
                    ForceNoKill:=TRUE;
                    Continue;
               END;

               WriteLn ('# Invalid option: ',ParamStr (Lp));
               Halt (1);
          END;
     END; { param for }

     IF (ParamCmd = 'LINK') THEN MenuAuto:=mOpt10;
     IF (ParamCmd = 'PURGE') THEN MenuAuto:=mOpt11;
     IF (ParamCmd = 'INDEX') THEN MenuAuto:=mOpt12;
     IF (ParamCmd = 'RENUM') THEN MenuAuto:=mOpt13;
     IF (ParamCmd = 'RENUMJAM') THEN MenuAuto:=mOpt14;

     IF (MenuAuto <> kUnknown) THEN
        ParamCmd:='';

     IF (MenuAuto <> kUnknown) AND (Param2nd <> '') THEN
     BEGIN
          ParamCmd:='';

          { verwerk het groeps filter }

          IF (Param2nd = 'LINK') OR
             (Param2nd = 'DATABASE') OR
             (Param2nd = 'PURGE') OR
             (Param2nd = 'RENUM') OR
             (Param2nd = 'RENUMJAM') OR
             (Param2nd = 'INDEX') THEN
          BEGIN
               { invalid usage, for example PURGE DATABASE }
               { We zetten hier Param op iets anders, want }
               { anders triggered het hieronder weer...    }
               TellHelpScreen;
               Halt (1);
          END;

          { interpreteer het argument als een groups list }
          { syntax mogelijkheden: A123B341CDE4F12 }
          { spaties kunnen niet voorkomen         }
          { streepjes staan we niet toe (A1-4)    }

          { zeker zijn dat er geen troep in zit }
          FOR Lp:=1 TO Length (Param) DO
              IF NOT (Param[Lp] IN ['1'..'5','A'..'Z']) THEN
              BEGIN
                   WriteLn ('# Invalid group specifier: "',Param[Lp],'"  in ',Param);
                   Halt (1);
              END;

          ResetGroupFlags (Groups);
          HadGroupArg:=TRUE; { niet meer overriden met AllGroups }

          { hoe we werken: als een letter niet gevolgd wordt door een }
          { cijfer, dan nemen we de hele letter, anders onthouden we  }
          { de letter en voegen we toe aan de hand van de cijfers.    }

          Param[Length (Param)+1]:=' '; { niet een digit }

          IF (Param[1] IN ['A'..'Z']) THEN
             LastLetterNr:=(Ord (Param[Lp])-Ord ('A'))*5+1
          ELSE BEGIN
               WriteLn ('# Group specifier does not start with a letter: ',Param);
               Halt (1);
          END;

          FOR Lp:=1 TO Length (Param) DO
          BEGIN
               IF (Param[Lp] IN ['A'..'Z']) THEN
               BEGIN
                    LastLetterNr:=(Ord (Param[Lp])-Ord ('A'))*5+1;

                    IF (Lp = Length (Param)) OR (Param[Lp+1] IN ['A'..'Z']) THEN
                    BEGIN
                         { add all for this letter }
                         AddGroupToGroupList (Groups,LastLetterNr);
                         AddGroupToGroupList (Groups,LastLetterNr+1);
                         AddGroupToGroupList (Groups,LastLetterNr+2);

                         IF (Param[Lp] <> 'Z') THEN
                         BEGIN
                              AddGroupToGroupList (Groups,LastLetterNr+3);
                              AddGroupToGroupList (Groups,LastLetterNr+4);
                         END;
                    END;
               END ELSE
               BEGIN
                    { digit }
                    IF (Param[Lp] > '3') AND (LastLetterNr = 126) THEN
                    BEGIN
                         WriteLn ('Group Z',Param[Lp],' does not exist in ',Param);
                         Halt (1);
                    END;

                    AddGroupToGroupList (Groups,LastLetterNr+(Ord (Param[Lp])-Ord ('1')));
               END;
          END; { for }

     END; { 2nd arg to menuauto command }

     IF (ParamCmd = 'DATABASE') THEN
     BEGIN
          MenuAuto:=mOpt20;
          ParamCmd:='';
     END;

     IF (ParamCmd = 'IMPORT') THEN
     BEGIN
          IF (Param2nd = '?') OR (Param2nd = '') THEN
          BEGIN
               ShowHelpImport;
               Halt (1);
          END;

          MenuAuto:=mOpt15;
          ParamCmd:='';
     END;

     IF (ParamCmd = 'SHRINKLOG') THEN
     BEGIN
          Val (Param2nd,ShrinkDays,Nop);
          IF (Nop <> 0) THEN
          BEGIN
               WriteLn ('# Invalid number of history days to keep');
               Halt (1);
          END;

          MenuAuto:=mOpt16; { zonder input van aantal dagen }
          ParamCmd:=''; { known }
     END;

     IF (ParamCmd = 'SHRINKSTA') THEN
     BEGIN
          Val (Param2nd,ShrinkDays,Nop);
          IF (Nop <> 0) THEN
          BEGIN
               WriteLn ('# Invalid number of history days to keep');
               Halt (1);
          END;

          MenuAuto:=mOpt17; { zonder input van aantal dagen }
          ParamCmd:=''; { known }
     END;

     IF (ParamCmd = 'BBSUSERS') THEN
     BEGIN
          IF (Param2nd = '') THEN
          BEGIN
               WriteLn ('# Need path to file with a user name on each line');
               Halt (1);
          END;

          MenuAuto:=mOpt18;
          ParamCmd:=''; { known }
     END;

     IF (ParamCmd = 'NODELIST') THEN
     BEGIN
          MenuAuto:=mOpt19;
          ParamCmd:='';
     END;

     IF (ParamCmd <> '') THEN
     BEGIN
          TellHelpScreen;
          Halt (1);
     END;

     IF (NOT ReadConfigFile) OR (NOT OpenDatabases) THEN
     BEGIN
          CloseDatabases;
          WriteLn;
          WriteLn ('# Unable to open configuration files'#7);
          WriteLn;
          Halt (1);
     END;

     IF (NOT HadGroupArg) THEN
        Groups:=AllGroups; { AllGroups pas avail. na OpenDatabases }

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

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

     { Zorg dat we in de log verschijnen }
     Log_SetWindowSize (Video.Rows-19);
     ScreenToo:=TRUE; { logs ook op het scherm afdrukken }

     IF (NOT ForceNoSlice) THEN
     BEGIN
          Slice_Detect;

          {$IFDEF PLATFORM_OS2_OR_WIN32}
          LogMessage (liTrivial,'Giving up time slices');
          {$ELSE}
          IF (Slice_GetMultiTaskerName <> '') THEN
             LogMessage (liTrivial,'Detected '+Slice_GetMultiTaskerName+'; giving up time slices');
          {$ENDIF}
     END;

     InitRoutingTable;
     DupeCheckInit;

     IF (MenuAuto = kUnknown) THEN
     BEGIN
          {$IFDEF Alfa}
          ShowCopyRight;
          {$ENDIF}

          {$IFDEF Beta}
          ShowCopyRight;
          {$ENDIF}

          {$IFDEF Gamma}
          ShowCopyRight;
          {$ENDIF}

          MenuDefine (25,3,'Main Menu');
          MenuAddItem ('Area maintenance');
          MenuAddItem ('Pack databases');
          MenuAddItem ('RFC bad manager');
          MenuAddItem ('Shrink log file');
          MenuAddItem ('Shrink statistics file');
          MenuAddItem ('Re-build BBS users index');
          MenuAddItem ('About '+FullProgramName);
          MenuAddItem ('Exit program');

          MenuShow;
          MenuSetHelp (htr_WtrUtil_Main_Menu);
     END;

     WriteMenuKeysLine;

     Quit:=FALSE;
     REPEAT
           IF (MenuAuto <> kUnknown) THEN
           BEGIN
                Key:=MenuAuto;
                Quit:=TRUE;
           END ELSE
           BEGIN
                LogClose;
                Key:=MenuSelect;
           END;

           CASE Key OF
                mOpt01 :
                    SelectiveAreaMaintenance;

                mOpt02 :
                    UtilPackBases (FALSE{manual});

                mOpt03 :
                    RFCBadManager;

                mOpt04 :
                    IF InputShrinkDays THEN
                       ShrinkLogfile (FALSE{manual});

                mOpt05 :
                    IF InputShrinkDays THEN
                       ShrinkStaFile (FALSE{manual});

                mOpt06 :
                    RebuildBBSUsersIndex (FALSE{manual},'');

                mOpt07 :
                    ShowAboutBox;

                mOpt08 :
                    Quit:=TRUE;

                { automatic executers }
                mOpt10 : UtilLinkAllAreas (Groups);
                mOpt11 : UtilPurgeAllAreas (Groups);
                mOpt12 : UtilReIDXAllAreas (Groups);
                mOpt13 : UtilRenumberAllMSGAreas (Groups);
                mOpt14 : UtilRenumberAllJAMAreas (Groups);

                mOpt15 :
                    BEGIN
                         ReadUserBaseIndexTable;
                         ReadAreaBaseIndexTable;
                         FidoMsgImport (Param2nd,Param3rd,ForceNoKill,FALSE);
                         JunkAreaBaseIndexTable;
                         JunkUserBaseIndexTable;
                    END;

                mOpt16 :
                    ShrinkLogfile (TRUE{automatisch});

                mOpt17 :
                    ShrinkStaFile (TRUE{automatisch});

                mOpt18 :
                    RebuildBBSUsersIndex (TRUE{automatic},Param2nd);

                mOpt19 :
                    NodeList_RebuildIndex;

                mOpt20 :
                    UtilPackBases (TRUE{automatisch});

                kEsc :
                    BEGIN
                         MenuDefine (60,16,'Quit?');
                         MenuAddItem ('Yes');
                         MenuAddItem ('No');
                         MenuShow;

                         IF (MenuSelect = mOpt01) THEN
                            Quit:=TRUE;

                         MenuErase;
                    END;
           END; { case }
     UNTIL Quit;

     MenuErase;
     CloseDatabases;
     DupeCheckEnd;

     JunkRoutingTable;
     DeleteUUCPRoutingTable;

     { Sluit de log entry af }
     LogMessage (liTrivial,'Ending program');
     LogExtraMessage ('');

     CloseDesktop;
     ScreenToo:=FALSE; { prevent log from corrupting memory }

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

     TdbDone;
     UnExtendHandles;

     DumpMem;
     LogClose;

     Halt (ConditionRed);
END.

