Added mUtil Message Base packer for JAM/Squish

mystic/HISTORY.txt

@@ -4915,3 +4915,9 @@
  + The Toggle New Scan and Toggle QWK Scan menu commands now allow an optional
    /ALLGROUP in the optional data.  If this is supplied it will show all bases
    in all groups.  By default it only shows current group only.
+
+ - Removed MYSTPACK from Mystic BBS distribution.  Do not use this anymore.
+
+ + Added a message base packer and renumber option to mUtil.  This replaces
+   MYSTPACK with the bonus that it also works with Squish (and appears to not
+   be as buggy as MYSTPACK was).

mystic/bbs_msgbase_abs.pas

@@ -1,8 +1,9 @@
-{$I M_OPS.PAS}
-{$WARNINGS OFF}
-
 Unit BBS_MsgBase_ABS;
 
+{$I M_OPS.PAS}
+
+{$WARNINGS OFF}
+
 Interface
 
 Uses
@@ -28,8 +29,8 @@ Type
     Function  MsgBaseExists: Boolean; Virtual; {Does msg base exist}
     Function  LockMsgBase: Boolean; Virtual; {Lock the message base}
     Function  UnLockMsgBase: Boolean; Virtual; {Unlock the message base}
-    Procedure SetDest(Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest}
+    Procedure SetDest (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest}
-    Procedure SetOrig(Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig}
+    Procedure SetOrig (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig}
     Procedure SetFrom(Name: String); Virtual; {Set message from}
     Procedure SetTo(Name: String); Virtual; {Set message to}
     Procedure SetSubj(Str: String); Virtual; {Set message subject}
@@ -72,7 +73,9 @@ Type
     Function  GetMsgNum: LongInt; Virtual; {Get message number}
     Function  GetTextLen: LongInt; Virtual; {Get text length}
     Procedure GetOrig (Var Addr : RecEchoMailAddr); Virtual; {Get origin address}
+    Function  GetOrigAddr : RecEchoMailAddr; Virtual;
     Procedure GetDest (Var Addr : RecEchoMailAddr); Virtual; {Get destination address}
+    Function  GetDestAddr : RecEchoMailAddr; Virtual;
     Function  IsLocal: Boolean; Virtual; {Is current msg local}
     Function  IsCrash: Boolean; Virtual; {Is current msg crash}
     Function  IsKillSent: Boolean; Virtual; {Is current msg kill sent}
@@ -149,11 +152,11 @@ Function TMsgBaseABS.UnLockMsgBase: Boolean;
 Begin
 End;
 
-Procedure TMsgBaseABS.SetDest(Var Addr: RecEchoMailAddr);
+Procedure TMsgBaseABS.SetDest (Addr: RecEchoMailAddr);
 Begin
 End;
 
-Procedure TMsgBaseABS.SetOrig(Var Addr: RecEchoMailAddr);
+Procedure TMsgBaseABS.SetOrig (Addr: RecEchoMailAddr);
 Begin
 End;
 
@@ -413,10 +416,18 @@ Procedure TMsgBaseABS.GetOrig(Var Addr: RecEchoMailAddr);
 Begin
 End;
 
+Function TMsgBaseABS.GetOrigAddr : RecEchoMailAddr;
+Begin
+End;
+
 Procedure TMsgBaseABS.GetDest(Var Addr: RecEchoMailAddr);
 Begin
 End;
 
+Function TMsgBaseABS.GetDestAddr : RecEchoMailAddr;
+Begin
+End;
+
 Function TMsgBaseABS.IsLocal: Boolean;
 Begin
 End;

mystic/bbs_msgbase_jam.pas

@@ -152,8 +152,8 @@ Type
     Function    GetHighMsgNum  : LongInt; Virtual; {Get highest netmail msg number in area}
     Function    LockMsgBase    : Boolean; Virtual; {Lock the message base}
     Function    UnLockMsgBase  : Boolean; Virtual; {Unlock the message base}
-    Procedure   SetDest        (Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest}
+    Procedure   SetDest        (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest}
-    Procedure   SetOrig        (Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig}
+    Procedure   SetOrig        (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig}
     Procedure   SetFrom        (Name: String); Virtual; {Set message from}
     Procedure   SetTo          (Name: String); Virtual; {Set message to}
     Procedure   SetSubj        (Str: String); Virtual; {Set message subject}
@@ -198,6 +198,10 @@ Type
     Function    GetSeeAlso     : LongInt; Virtual; {Get see also of current msg}
     Function    GetMsgNum      : LongInt; Virtual; {Get message number}
     Procedure   GetOrig        (Var Addr: RecEchoMailAddr); Virtual; {Get origin address}
+
+    Function GetOrigAddr : RecEchoMailAddr; Virtual;
+    Function GetDestAddr : RecEchoMailAddr; Virtual;
+
     Procedure   GetDest        (Var Addr: RecEchoMailAddr); Virtual; {Get destination address}
     Function    GetTextLen     : LongInt; Virtual; {returns length of text in msg}
     Function    IsLocal        : Boolean; Virtual; {Is current msg local}
@@ -317,12 +321,12 @@ Begin
   GetHighMsgNum := JM^.BaseHdr.BaseMsgNum + FileSize(JM^.IdxFile) - 1;
 End;
 
-Procedure TMsgBaseJAM.SetDest(Var Addr: RecEchoMailAddr);
+Procedure TMsgBaseJAM.SetDest (Addr: RecEchoMailAddr);
 Begin
   JM^.Dest := Addr;
 End;
 
-Procedure TMsgBaseJAM.SetOrig(Var Addr: RecEchoMailAddr);
+Procedure TMsgBaseJAM.SetOrig(Addr: RecEchoMailAddr);
 Begin
   JM^.Orig := Addr;
 End;
@@ -552,6 +556,7 @@ Begin
   JM^.TxtPos      := 0;
 
   MsgHdr^.JamHdr.SubFieldLen := 0;
+
   FillChar(MsgHdr^.SubBuf, SizeOf(MsgHdr^.SubBuf), #0);
 End;
 
@@ -1200,6 +1205,16 @@ Begin
   GetMsgNum := MsgHdr^.JamHdr.MsgNum;
 End;
 
+Function TMsgBaseJAM.GetOrigAddr : RecEchoMailAddr;
+Begin
+  Result := JM^.Orig;
+End;
+
+Function TMsgBaseJAM.GetDestAddr : RecEchoMailAddr;
+Begin
+  Result := JM^.Dest;
+End;
+
 Procedure TMsgBaseJAM.GetOrig(Var Addr: RecEchoMailAddr); {Get origin address}
 Begin
   Addr := JM^.Orig;
@@ -1415,7 +1430,7 @@ Begin
 
   FillChar(MsgHdr^, SizeOf(MsgHdr^), #0);
 
-//  MsgHdr^.JamHdr.SubFieldLen := 0;
+  MsgHdr^.JamHdr.SubFieldLen := 0;
   MsgHdr^.JamHdr.MsgIdCrc    := -1;
   MsgHdr^.JamHdr.ReplyCrc    := -1;
   MsgHdr^.JamHdr.PwdCrc      := -1;

mystic/bbs_msgbase_squish.pas

@@ -197,9 +197,13 @@ Type
     Function        GetChar: Char; Virtual;
     Function        GetString(MaxLen: Word): String; Virtual;
     Procedure GetOrig(Var Addr: RecEchoMailAddr); Virtual;
-    Procedure SetOrig(Var Addr: RecEchoMailAddr); Virtual;
+    Procedure SetOrig(Addr: RecEchoMailAddr); Virtual;
     Procedure GetDest(Var Addr: RecEchoMailAddr); Virtual;
-    Procedure SetDest(Var Addr: RecEchoMailAddr); Virtual;
+    Procedure SetDest (Addr: RecEchoMailAddr); Virtual;
+
+    Function GetOrigAddr : RecEchoMailAddr; Virtual;
+    Function GetDestAddr : RecEchoMailAddr; Virtual;
+
     Function        EOM: Boolean; Virtual;
 (*
         Function        WasWrap: Boolean; Virtual;
@@ -252,7 +256,7 @@ Type
     Procedure LoadFree; Virtual; {Load freelist into memory}
     Function        NumberOfMsgs: LongInt; Virtual; {Number of messages}
     Procedure SetEcho(ES: Boolean); Virtual; {Set echo status}
-//        Function        IsEchoed: Boolean; Virtual; {Is current msg unmoved echomail msg}
+    Function        IsEchoed: Boolean; Virtual; {Is current msg unmoved echomail msg}
     Function        GetLastRead(UNum: LongInt): LongInt; Virtual; {Get last read for user num}
     Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read}
     Function        GetMsgLoc: LongInt; Virtual; {To allow reseeking to message}
@@ -570,7 +574,12 @@ Begin
   Addr := SqInfo^.MsgHdr.Orig;
 End;
 
-Procedure TMsgBaseSquish.SetOrig(Var Addr: RecEchoMailAddr);
+Function TMsgBaseSquish.GetOrigAddr : RecEchoMailAddr;
+Begin
+  Result := SqInfo^.MsgHdr.Orig;
+End;
+
+Procedure TMsgBaseSquish.SetOrig(Addr: RecEchoMailAddr);
 Begin
   SqInfo^.MsgHdr.Orig := Addr;
 End;
@@ -580,7 +589,12 @@ Begin
   Addr := SqInfo^.MsgHdr.Dest;
 End;
 
-Procedure TMsgBaseSquish.SetDest(Var Addr: RecEchoMailAddr);
+Function TMsgBaseSquish.GetDestAddr : RecEchoMailAddr;
+Begin
+  Result := SqInfo^.MsgHdr.Dest;
+End;
+
+Procedure TMsgBaseSquish.SetDest (Addr: RecEchoMailAddr);
 Begin
   SqInfo^.MsgHdr.Dest := Addr;
 End;
@@ -1310,10 +1324,10 @@ Begin
   IsPriv := ((SqInfo^.MsgHdr.Attr and SqMsgPriv) <> 0);
 End;
 
-//Function TMsgBaseSquish.IsEchoed: Boolean;
+Function TMsgBaseSquish.IsEchoed: Boolean;
-//Begin
+Begin
-//        IsEchoed := ((SqInfo^.MsgHdr.Attr and SqMsgScanned) = 0);
+        IsEchoed := ((SqInfo^.MsgHdr.Attr and SqMsgScanned) = 0);
-//End;
+End;
 
 Function TMsgBaseSquish.IsDeleted: Boolean; {Is current msg deleted}
 Begin

mystic/mutil.ini

@@ -24,6 +24,7 @@
 ;    - Import FILES.BBS into file bases
 ;    - Generate all files listing
 ;    - Purge Message bases (by age and max messages)
+;    - Pack and renumber message bases
 ;    - Post text files to message bases
 ;
 ; ==========================================================================
@@ -53,18 +54,15 @@
 
 	; list of functions to perform on startup
 
-	Import_FIDONET.NA  = false
+	Import_FIDONET.NA  = true
-	Import_FILEBONE.NA = false
+	Import_FILEBONE.NA = true
-	Import_FILES.BBS   = false
+	Import_FILES.BBS   = true
-	MassUpload         = false
+	MassUpload         = true
-	GenerateTopLists   = false
+	GenerateTopLists   = true
-	GenerateAllFiles   = false
+	GenerateAllFiles   = true
-	PurgeMessageBases  = false
+	PurgeMessageBases  = true
-	PostTextFiles      = false
+	PostTextFiles      = true
-
+	PackMessageBases   = true
-	; work in progress
-	LinkMessageBases   = false
-	PackMessageBases   = false
 
 ; ==========================================================================
 ; ==========================================================================
@@ -295,7 +293,7 @@
 
 [PackMessageBases]
 
-	; Not implmented yet
+	; No options for this function
 
 [PostTextFiles]
 

mystic/mutil_common.pas

@@ -40,6 +40,7 @@ Const
 
 Procedure Log                (Level: Byte; Code: Char; Str: String);
 Function  strAddr2Str        (Addr : RecEchoMailAddr) : String;
+Function  GetUserBaseSize    : Cardinal;
 Function  GenerateMBaseIndex : LongInt;
 Function  GenerateFBaseIndex : LongInt;
 Function  IsDupeMBase        (FN: String) : Boolean;
@@ -100,6 +101,13 @@ Begin
   Result := Temp;
 End;
 
+Function GetUserBaseSize : Cardinal;
+Begin
+  Result := FileByteSize(bbsConfig.DataPath + 'users.dat');
+
+  If Result > 0 Then Result := Result DIV SizeOf(RecUser);
+End;
+
 Function IsDupeMBase (FN: String) : Boolean;
 Var
   MBaseFile : File of RecMessageBase;

mystic/mutil_msgpack.pas

@@ -10,15 +10,259 @@ Implementation
 
 Uses
   m_Strings,
+  m_FileIO,
   mUtil_Common,
-  mUtil_Status;
+  mUtil_Status,
+  bbs_MsgBase_ABS,
+  bbs_MsgBase_JAM,
+  bbs_MsgBase_Squish;
+
+{$I RECORDS.PAS}
 
 Procedure uPackMessageBases;
+Type
+  RecMsgLink = Record
+    OldNum : Cardinal;
+    NewNum : Cardinal;
+  End;
+
+Var
+  LinkFile   : TBufFile;
+  BaseKills  : Cardinal = 0;
+  BaseTotal  : Cardinal = 0;
+  TotalKills : Cardinal = 0;
+
+  Function GetMessageLink (OldNum: Cardinal; Zero: Boolean) : Cardinal;
+  Var
+    L : RecMsgLink;
+  Begin
+    LinkFile.Reset;
+
+    While Not LinkFile.EOF Do Begin
+      LinkFile.Read(L);
+
+      If L.OldNum = OldNum Then Begin
+        Result := L.NewNum;
+        Exit;
+      End;
+    End;
+
+    If Zero Then
+      Result := 0
+    Else
+      Result := OldNum;
+  End;
+
+  Procedure PackOneBase (Var MsgBase: RecMessageBase);
+  Const
+    TempName = 'msgpacktemp';
+  Var
+    MsgData   : PMsgBaseABS;
+    NewData   : PMsgBaseABS;
+    SaveMsg   : Boolean = False;
+    UserTotal : Cardinal;
+    Link      : RecMsgLink;
+    Count     : Cardinal;
+    Addr      : RecEchoMailAddr;
+  Begin
+  FileMode := 66;
+    BaseKills := 0;
+
+    Inc (BaseTotal);
+
+    Case MsgBase.BaseType of
+      0 : Begin
+            MsgData := New(PMsgBaseJAM, Init);
+            NewData := New(PMsgBaseJAM, Init);
+          End;
+      1 : Begin
+            MsgData := New(PMsgBaseSquish, Init);
+            NewData := New(PMsgBaseSquish, Init);
+          End;
+    End;
+
+    MsgData^.SetMsgPath  (MsgBase.Path + MsgBase.FileName);
+    MsgData^.SetTempFile (TempPath + 'msgbuf.old');
+
+    NewData^.SetMsgPath  (TempPath + TempName);
+    NewData^.SetTempFile (TempPath + 'msgbuf.new');
+
+    If Not MsgData^.OpenMsgBase Then Begin
+      Dispose (MsgData, Done);
+      Dispose (NewData, Done);
+
+      Exit;
+    End;
+
+    If Not NewData^.CreateMsgBase (MsgBase.MaxMsgs, MsgBase.MaxAge) Then Begin
+      Dispose (MsgData, Done);
+      Dispose (NewData, Done);
+
+      Exit;
+    End;
+
+    If Not NewData^.OpenMsgBase Then Begin
+      Dispose (MsgData, Done);
+      Dispose (NewData, Done);
+
+      Exit;
+    End;
+
+    LinkFile := TBufFile.Create (8 * 1024);
+
+    LinkFile.Open (TempPath + TempName + '.tmp', fmCreate, fmRWDN, SizeOf(RecMsgLink));
+
+    MsgData^.SeekFirst(1);
+
+    While MsgData^.SeekFound Do Begin
+      MsgData^.MsgStartUp;
+
+      SaveMsg := True;
+
+      // option:
+      // if private/netmail message area check to make sure users are valid
+      // and delete if they are not.
+
+      // also do kludges make it successfully?  replyID etc?
+
+      If SaveMsg Then Begin
+        NewData^.StartNewMsg;
+
+        NewData^.SetFrom     (MsgData^.GetFrom);
+        NewData^.SetTo       (MsgData^.GetTo);
+        NewData^.SetSubj     (MsgData^.GetSubj);
+        NewData^.SetDate     (MsgData^.GetDate);
+        NewData^.SetTime     (MsgData^.GetTime);
+        NewData^.SetLocal    (MsgData^.IsLocal);
+        NewData^.SetPriv     (MsgData^.IsPriv);
+        NewData^.SetSent     (MsgData^.IsSent);
+        NewData^.SetCrash    (MsgData^.IsCrash);
+        NewData^.SetRcvd     (MsgData^.IsRcvd);
+//        NewData^.SetHold     (MsgData^.IsHold);
+        NewData^.SetEcho     (Not MsgData^.IsEchoed);
+        NewData^.SetKillSent (MsgData^.IsKillSent);
+        NewData^.SetRefer    (MsgData^.GetRefer);
+        NewData^.SetSeeAlso  (MsgData^.GetSeeAlso);
+
+        Case MsgBase.NetType of
+          0    : NewData^.SetMailType(mmtNormal);
+          1..2 : NewData^.SetMailType(mmtEchoMail);
+          3    : NewData^.SetMailType(mmtNetMail);
+        End;
+
+        NewData^.SetOrig(MsgData^.GetOrigAddr);
+        NewData^.SetDest(MsgData^.GetDestAddr);
+
+        MsgData^.MsgTxtStartUp;
+
+        While Not MsgData^.EOM Do
+          NewData^.DoStringLn(MsgData^.GetString(79));
+
+        NewData^.WriteMsg;
+
+        Link.OldNum := MsgData^.GetMsgNum;
+        Link.NewNum := NewData^.GetHighMsgNum;
+
+        LinkFile.Write (Link);
+      End;
+
+      MsgData^.SeekNext;
+    End;
+
+    // cycle through old lastread pointers and generate new ones
+
+    UserTotal := GetUserBaseSize;
+
+    For Count := 1 to UserTotal Do Begin
+      Link.OldNum := MsgData^.GetLastRead (Count);
+      NewData^.SetLastRead (Count, GetMessageLink(Link.OldNum, False));
+    End;
+
+    // cycle through all messages and update referto/seealso
+
+    NewData^.SeekFirst(1);
+
+    While NewData^.SeekFound Do Begin
+      NewData^.MsgStartUp;
+
+      Link.OldNum := NewData^.GetRefer;
+      Link.NewNum := NewData^.GetSeeAlso;
+
+      If (Link.OldNum <> 0) Then Link.OldNum := GetMessageLink(Link.OldNum, True);
+      If (Link.NewNum <> 0) Then Link.NewNum := GetMessageLink(Link.NewNum, True);
+
+      If (Link.OldNum <> NewData^.GetRefer) or (Link.NewNum <> NewData^.GetSeeAlso) Then Begin
+        NewData^.SetRefer   (Link.OldNum);
+        NewData^.SetSeeAlso (Link.NewNum);
+        NewData^.ReWriteHdr;
+      End;
+
+      NewData^.SeekNext;
+    End;
+
+    BaseKills := MsgData^.GetHighMsgNum - NewData^.GetHighMsgNum;
+
+    Inc (TotalKills, BaseKills);
+
+    MsgData^.CloseMsgBase;
+    NewData^.CloseMsgBase;
+
+    Dispose (MsgData, Done);
+    Dispose (NewData, Done);
+
+    LinkFile.Free;
+
+    FileErase (TempPath + TempName + '.tmp');
+
+    Case MsgBase.BaseType of
+      0 : Begin
+            FileErase (MsgBase.Path + MsgBase.FileName + '.jhr');
+            FileErase (MsgBase.Path + MsgBase.FileName + '.jdt');
+            FileErase (MsgBase.Path + MsgBase.FileName + '.jdx');
+            FileErase (MsgBase.Path + MsgBase.FileName + '.jlr');
+
+            FileRename (TempPath + TempName + '.jhr', MsgBase.Path + MsgBase.FileName + '.jhr');
+            FileRename (TempPath + TempName + '.jdt', MsgBase.Path + MsgBase.FileName + '.jdt');
+            FileRename (TempPath + TempName + '.jdx', MsgBase.Path + MsgBase.FileName + '.jdx');
+            FileRename (TempPath + TempName + '.jlr', MsgBase.Path + MsgBase.FileName + '.jlr');
+          End;
+      1 : Begin
+            FileErase (MsgBase.Path + MsgBase.FileName + '.sqd');
+            FileErase (MsgBase.Path + MsgBase.FileName + '.sqi');
+            FileErase (MsgBase.Path + MsgBase.FileName + '.sql');
+
+            FileRename (TempPath + TempName + '.sqd', MsgBase.Path + MsgBase.FileName + '.sqd');
+            FileRename (TempPath + TempName + '.sqi', MsgBase.Path + MsgBase.FileName + '.sqi');
+            FileRename (TempPath + TempName + '.sql', MsgBase.Path + MsgBase.FileName + '.sql');
+          End;
+    End;
+
+    Log (2, '+', '      Removed ' + strI2S(BaseKills) + ' msgs');
+  End;
+
+Var
+  BaseFile : File of RecMessageBase;
+  Base     : RecMessageBase;
 Begin
   ProcessName   ('Packing Message Bases', True);
   ProcessResult (rWORKING, False);
 
-  ProcessStatus ('Removed X Msgs in X Bases', True);
+  Assign (BaseFile, bbsConfig.DataPath + 'mbases.dat');
+
+  If ioReset (BaseFile, SizeOf(Base), fmRWDN) Then Begin
+    While Not Eof(BaseFile) Do Begin
+      Read (BaseFile, Base);
+
+      ProcessStatus (Base.Name, False);
+      BarOne.Update (FilePos(BaseFile), FileSize(BaseFile));
+
+      PackOneBase (Base);
+    End;
+
+    Close (BaseFile);
+  End;
+
+  ProcessStatus ('Removed |15' + strI2S(TotalKills) + ' |07msgs in |15' + strI2S(BaseTotal) + ' |07bases', True);
   ProcessResult (rDONE, True);
 End;