From ae134dbb391c7cb56418cb58bf4da6bdd416c16c Mon Sep 17 00:00:00 2001 From: mysticbbs Date: Sun, 18 Nov 2012 08:51:55 -0500 Subject: [PATCH] Added mUtil Message Base packer for JAM/Squish --- mystic/HISTORY.txt | 6 + mystic/bbs_msgbase_abs.pas | 25 +++- mystic/bbs_msgbase_jam.pas | 25 +++- mystic/bbs_msgbase_squish.pas | 32 +++-- mystic/mutil.ini | 24 ++-- mystic/mutil_common.pas | 8 ++ mystic/mutil_msgpack.pas | 248 +++++++++++++++++++++++++++++++++- mystic/mutil_msgpurge.pas | 2 +- 8 files changed, 333 insertions(+), 37 deletions(-) diff --git a/mystic/HISTORY.txt b/mystic/HISTORY.txt index e3e8a40..73df0e6 100644 --- a/mystic/HISTORY.txt +++ b/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). diff --git a/mystic/bbs_msgbase_abs.pas b/mystic/bbs_msgbase_abs.pas index 43a30f3..cd509a4 100644 --- a/mystic/bbs_msgbase_abs.pas +++ b/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 SetOrig(Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig} + Procedure SetDest (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest} + 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; diff --git a/mystic/bbs_msgbase_jam.pas b/mystic/bbs_msgbase_jam.pas index 3401075..4d81e35 100644 --- a/mystic/bbs_msgbase_jam.pas +++ b/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 SetOrig (Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig} + Procedure SetDest (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest} + 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; diff --git a/mystic/bbs_msgbase_squish.pas b/mystic/bbs_msgbase_squish.pas index b8b0ce8..cd4c39d 100644 --- a/mystic/bbs_msgbase_squish.pas +++ b/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; -//Begin -// IsEchoed := ((SqInfo^.MsgHdr.Attr and SqMsgScanned) = 0); -//End; +Function TMsgBaseSquish.IsEchoed: Boolean; +Begin + IsEchoed := ((SqInfo^.MsgHdr.Attr and SqMsgScanned) = 0); +End; Function TMsgBaseSquish.IsDeleted: Boolean; {Is current msg deleted} Begin diff --git a/mystic/mutil.ini b/mystic/mutil.ini index 854c5c2..99e46ba 100644 --- a/mystic/mutil.ini +++ b/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_FILEBONE.NA = false - Import_FILES.BBS = false - MassUpload = false - GenerateTopLists = false - GenerateAllFiles = false - PurgeMessageBases = false - PostTextFiles = false - - ; work in progress - LinkMessageBases = false - PackMessageBases = false + Import_FIDONET.NA = true + Import_FILEBONE.NA = true + Import_FILES.BBS = true + MassUpload = true + GenerateTopLists = true + GenerateAllFiles = true + PurgeMessageBases = true + PostTextFiles = true + PackMessageBases = true ; ========================================================================== ; ========================================================================== @@ -295,7 +293,7 @@ [PackMessageBases] - ; Not implmented yet + ; No options for this function [PostTextFiles] diff --git a/mystic/mutil_common.pas b/mystic/mutil_common.pas index d655585..309bb98 100644 --- a/mystic/mutil_common.pas +++ b/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; diff --git a/mystic/mutil_msgpack.pas b/mystic/mutil_msgpack.pas index f8ed3e6..04bc2ec 100644 --- a/mystic/mutil_msgpack.pas +++ b/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; diff --git a/mystic/mutil_msgpurge.pas b/mystic/mutil_msgpurge.pas index 7d0ab24..ae8d11f 100644 --- a/mystic/mutil_msgpurge.pas +++ b/mystic/mutil_msgpurge.pas @@ -97,4 +97,4 @@ Begin ProcessResult (rDONE, True); End; -End. +End. \ No newline at end of file