eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A31

This commit is contained in:
mysticbbs 2013-04-13 00:57:02 -04:00
parent ac6c2cc3df
commit d08486a89f
7 changed files with 362 additions and 241 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
mystic/bbs_msgbase.pas
View File

@ -1114,8 +1114,31 @@ Var
DoWrap : Boolean = True;
QuoteFile : Text;
Lines : SmallInt;
ReplyBase : RecMessageBase;
Begin
If Not Session.User.Access(MBase.PostACS) Then Begin
ReplyBase := MBase;
(*
Session.io.OutFull('|CR|09Reply |01[|10ENTER|01] |09Current Base, |01[|10B|01]|09ase, |01[|10N|01]|09etmail, |01[|10E|01]|09mail, |01[|10ESC|01] |09Abort: |11');
Case Session.io.OneKey (#13#27 + 'BNE', True) of
#27 : Exit;
'B' : Begin
//Total := ListAreas(Config.MCompress);
//NEW something like: (and use it in other areas too)
//PromptMessageBase (Var Base: RMB, IgnoreGroups): LongInt; -1 is abort, otherwise = physical area
End;
'E' : Begin
Reset (MBaseFile);
Read (MBaseFile, ReplyBase);
Close (MBaseFile);
Email := True;
End; // load email area set email := true
'N' : ; // load netmail area
End;
*)
If Not Session.User.Access(ReplyBase.PostACS) Then Begin
Session.io.OutFullLn (Session.GetPrompt(105));
Exit;
End;
@ -1144,7 +1167,7 @@ Begin
Break;
Until False;
If MBase.NetType = 3 Then Begin
If ReplyBase.NetType = 3 Then Begin
MsgBase^.GetOrig(Addr);
TempStr := NetmailLookup(False, ToWho, strAddr2Str(Addr));
@ -1218,15 +1241,15 @@ Begin
If Editor(Lines, ColumnValue[Session.Theme.ColumnSize] - 2, mysMaxMsgLines, False, fn_tplMsgEdit, Subj) Then Begin
Session.io.OutFull (Session.GetPrompt(107));
If Not OpenCreateBase(MsgNew, MBase) Then Exit;
If Not OpenCreateBase(MsgNew, ReplyBase) Then Exit;
AssignMessageData(MsgNew, MBase);
AssignMessageData(MsgNew, ReplyBase);
Case MBase.NetType of
Case ReplyBase.NetType of
2 : MsgNew^.SetTo('All');
3 : Begin
MsgNew^.SetDest (Addr);
MsgNew^.SetOrig (GetMatchedAddress(Config.NetAddress[MBase.NetAddr], Addr));
MsgNew^.SetOrig (GetMatchedAddress(Config.NetAddress[ReplyBase.NetAddr], Addr));
MsgNew^.SetCrash (Config.netCrash);
MsgNew^.SetHold (Config.netHold);
MsgNew^.SetKillSent (Config.netKillSent);
@ -1256,7 +1279,7 @@ Begin
Inc (Session.User.ThisUser.Emails);
Inc (Session.HistoryEmails);
End Else Begin
Session.SystemLog ('Posted #' + strI2S(MsgNew^.GetMsgNum) + ': "' + Subj + '" to ' + strStripMCI(MBase.Name));
Session.SystemLog ('Posted #' + strI2S(MsgNew^.GetMsgNum) + ': "' + Subj + '" to ' + strStripMCI(ReplyBase.Name));
Inc (Session.User.ThisUser.Posts);
Inc (Session.HistoryPosts);

4
mystic/mutil.ini
View File

@ -57,7 +57,7 @@
; Level 2 = verbose
; Level 3 = debug
loglevel=2
loglevel=1
; list of functions to perform on startup
@ -72,7 +72,7 @@
PostTextFiles = false
PackMessageBases = false
ImportEchoMail = false
ExportEchoMail = true
ExportEchoMail = false
; ==========================================================================
; ==========================================================================

16
mystic/mutil_common.pas
View File

@ -93,6 +93,7 @@ Function GetFTNArchiveName (Orig, Dest: RecEchoMailAddr) : String;
Function GetFTNFlowName (Dest: RecEchoMailAddr) : String;
Function GetFTNOutPath (EchoNode: RecEchoMailNode) : String;
Function GetNodeByIndex (Num: LongInt; Var TempNode: RecEchoMailNode) : Boolean;
Function IsValidAKA (Zone, Net, Node: Word) : Boolean;
Implementation
@ -581,4 +582,19 @@ Begin
Close (F);
End;
Function IsValidAKA (Zone, Net, Node: Word) : Boolean;
Var
Count : Byte;
Begin
Result := False;
For Count := 1 to 30 Do Begin
Result := (bbsConfig.NetAddress[Count].Zone = Zone) And
(bbsConfig.NetAddress[Count].Net = Net) And
(bbsConfig.NetAddress[Count].Node = Node);
If Result Then Break;
End;
End;
End.

34
mystic/mutil_echocore.pas
View File

@ -114,7 +114,8 @@ Type
Procedure DisposeText;
Function Open (FN: String) : Boolean;
Function GetMessage (NetMail: Boolean) : Boolean;
Procedure Close;
Function GetMessage : Boolean;
End;
Implementation
@ -218,6 +219,13 @@ Begin
MsgLines := 0;
End;
Procedure TPKTReader.Close;
Begin
DisposeText;
If MsgFile.Opened Then MsgFile.Close;
End;
Function TPKTReader.Open (FN: String) : Boolean;
Var
Res : LongInt;
@ -230,6 +238,7 @@ Begin
If (Res <> SizeOf(PKTHeader)) or (PKTHeader.PKTType <> $0002) Then Begin
MsgFile.Close;
Opened := False;
End Else Begin
Orig.Zone := PKTHeader.OrigZone;
@ -243,10 +252,11 @@ Begin
End;
End;
Function TPKTReader.GetMessage (NetMail: Boolean) : Boolean;
Function TPKTReader.GetMessage : Boolean;
Var
Res : LongInt;
Ch : Char;
First : Boolean;
Function GetStr (TermChar: Char) : String;
Begin
@ -278,12 +288,6 @@ Begin
MsgSubj := GetStr (#0);
MsgTime := Copy(MsgDate, 12, 5);
If Not NetMail Then Begin
MsgArea := GetStr (#13);
Delete (MsgArea, Pos('AREA:', MsgArea), 5);
End;
Tmp := strUpper(Copy(MsgDate, 4, 3));
For Res := 1 to 12 Do
@ -296,6 +300,7 @@ Begin
DisposeText;
First := True;
MsgSize := 0;
Result := True;
MsgLines := 1;
@ -321,6 +326,19 @@ Begin
Break;
End;
If First Then Begin
First := False;
If Pos('AREA:', MsgText[MsgLines]^) = 1 Then Begin
MsgArea := Copy(MsgText[MsgLines]^, 6, 255);
MsgText[MsgLines]^ := '';
Continue;
End Else
MsgArea := 'NETMAIL';
End;
Inc (MsgSize, Length(MsgText[MsgLines]^));
Inc (MsgLines);

240
mystic/mutil_echoimport.pas
View File

@ -12,6 +12,7 @@ Uses
DOS,
m_FileIO,
m_Strings,
AView,
BBS_Common,
BBS_MsgBase_ABS,
BBS_MsgBase_JAM,
@ -71,89 +72,72 @@ Var
DupeIndex : LongInt;
DupeMBase : RecMessageBase;
CreateBases : Boolean;
PKT : TPKTReader;
Dupes : TPKTDupe;
Status : LongInt;
Procedure ImportNetMailpacket (ArcFN: String);
Procedure ImportPacketFile (PktFN: String);
Var
PKT : TPKTReader;
MBase : RecMessageBase;
MsgBase : PMsgBaseABS;
Begin
PKT := TPKTReader.Create;
If PKT.Open (bbsConfig.InboundPath + ArcFN) Then Begin
If GetMBaseByNetZone (PKT.PKTHeader.DestZone, MBase) Then Begin
MessageBaseOpen(MsgBase, MBase);
While PKT.GetMessage(True) Do Begin
// Check for AreaFix, etc here
SavePKTMsgToBase(MsgBase, PKT, True);
Log (2, '+', ' Netmail ' + MBase.EchoTag + ' from ' + PKT.MsgFrom + ' to ' + PKT.MsgTo);
Inc (TotalNet);
End;
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
End Else
Log (3, '!', ' No NETMAIL base for zone ' + strI2S(PKT.PKTHeader.DestZone));
End Else
Log (3, '!', ' ' + ArcFN + ' is not valid PKT');
PKT.Free;
FileErase (bbsConfig.InBoundPath + ArcFN);
End;
Procedure ImportEchoMailPacket (ArcFN: String);
Var
DirInfo : SearchRec;
FoundPKT : Boolean;
CurTag : String;
MsgBase : PMsgBaseABS;
PKT : TPKTReader;
MBase : RecMessageBase;
Part : LongInt;
Whole : LongInt;
Count : LongInt;
Begin
FoundPKT := False;
PKT := TPKTReader.Create;
MsgBase := NIL;
Part := 0;
If Not PKT.Open(PktFN) Then Begin
Log (3, '!', ' ' + JustFile(PktFN) + ' is not valid PKT');
ProcessStatus (ArcFN + ' from ' + strAddr2Str(EchoNode.Address), False);
Exit;
End;
ExecuteArchive (bbsConfig.InboundPath + ArcFN, EchoNode.ArcType, '*', 2);
If Not IsValidAKA(PKT.Dest.Zone, PKT.Dest.Net, PKT.Dest.Node) Then Begin
Log (3, '!', ' ' + JustFile(PktFN) + ' does not match an AKA');
Whole := DirFiles(TempPath);
PKT.Close;
Exit;
End;
ProcessStatus ('Importing ' + JustFile(PktFN), False);
BarOne.Reset;
FindFirst (TempPath + '*', AnyFile, DirInfo);
// set status for PKT name
// do percentage bar init
While DosError = 0 Do Begin
If DirInfo.Attr And Directory = 0 Then Begin
Inc (Part);
CurTag := '';
MsgBase := NIL;
Status := 20;
BarOne.Update (Part, Whole);
While PKT.GetMessage Do Begin
If Status MOD 20 = 0 Then
BarOne.Update (PKT.MsgFile.FilePos, PKT.MsgFile.FileSize);
If strUpper(JustFileExt(DirInfo.Name)) = 'PKT' Then Begin
FoundPKT := True;
Inc (Status);
If PKT.MsgArea = 'NETMAIL' Then Begin
// areafix etc here
If GetMBaseByNetZone (PKT.PKTHeader.DestZone, MBase) Then Begin
CurTag := '';
If Not PKT.Open(TempPath + DirInfo.Name) Then Begin
Log (3, '!', ' ' + DirInfo.Name + ' is not valid PKT');
If MsgBase <> NIL Then Begin
MsgBase^.CloseMsgBase;
FindNext(DirInfo);
Dispose (MsgBase, Done);
Continue;
MsgBase := NIL;
End;
While PKT.GetMessage(False) Do Begin
MessageBaseOpen(MsgBase, MBase);
SavePKTMsgToBase(MsgBase, PKT, True);
Log (2, '+', ' Netmail from ' + PKT.MsgFrom + ' to ' + PKT.MsgTo);
Inc (TotalNet);
End Else
Log (3, '!', ' No NETMAIL base for zone ' + strI2S(PKT.PKTHeader.DestZone));
End Else Begin
If Dupes.IsDuplicate(PKT.MsgCRC) Then Begin
Log (3, '!', ' Duplicate message found in ' + PKT.MsgArea);
@ -179,7 +163,7 @@ Var
If Not GetMBaseByTag(PKT.MsgArea, MBase) Then Begin
Log (2, '!', ' Area ' + PKT.MsgArea + ' does not exist');
If Not CreateBases then Continue;
If Not CreateBases Then Continue;
If FileExist(bbsConfig.MsgsPath + PKT.MsgArea + '.sqd') or
FileExist(bbsConfig.MsgsPath + PKT.MsgArea + '.jhr') Then Continue;
@ -257,6 +241,7 @@ Var
Log (2, '+', ' Added Msg #' + strI2S(MsgBase^.GetHighMsgNum) + ' to ' + strStripPipe(MBase.Name));
End;
End;
End;
If MsgBase <> NIL Then Begin
MsgBase^.CloseMsgBase;
@ -266,10 +251,72 @@ Var
MsgBase := NIL;
End;
PKT.MsgFile.Close;
PKT.Close;
FileErase (PktFN);
BarOne.Update (1, 1);
End;
FileErase (TempPath + DirInfo.Name);
Procedure ImportPacketBundle (PktBundle: String);
Var
PKTFound : Boolean;
PKTMatched : Boolean;
DirInfo : SearchRec;
NodeFile : File of RecEchoMailNode;
EchoNode : RecEchoMailNode;
ArcType : String[4];
Count : Byte;
Begin
PKTMatched := False;
Assign (NodeFile, bbsConfig.DataPath + 'echonode.dat');
If ioReset(NodeFile, Sizeof(RecEchoMailNode), fmRWDN) Then Begin
While Not Eof(NodeFile) Do Begin
Read (NodeFile, EchoNode);
For Count := 1 to 30 Do Begin
If strUpper(JustFileName(PktBundle)) = strUpper(GetFTNArchiveName(EchoNode.Address, bbsConfig.NetAddress[Count])) Then Begin
PKTMatched := True;
ArcType := EchoNode.ArcType;
Break;
End;
End;
End;
Close (NodeFile);
End;
If Not PKTMatched Then Begin
Case GetArchiveType(bbsConfig.InboundPath + PktBundle) of
'A' : ArcType := 'ARJ';
'R' : ArcType := 'RAR';
'Z' : ArcType := 'ZIP';
'L' : ArcType := 'LZH';
Else
Log (2, '!', ' Cannot find arctype for ' + PktBundle + '; skipping');
Exit;
End;
End;
PKTFound := False;
ProcessStatus ('Extracting ' + PktBundle, False);
ExecuteArchive (bbsConfig.InboundPath + PktBundle, ArcType, '*', 2);
FindFirst (TempPath + '*', AnyFile, DirInfo);
While DosError = 0 Do Begin
If DirInfo.Attr And Directory = 0 Then Begin
If strUpper(JustFileExt(DirInfo.Name)) = 'PKT' Then Begin
PKTFound := True;
ImportPacketFile (TempPath + DirInfo.Name);
End;
End;
FindNext (DirInfo);
@ -277,27 +324,16 @@ Var
FindClose (DirInfo);
If MsgBase <> NIL Then Begin
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
MsgBase := NIL;
End;
If Not FoundPKT Then
Log (2, '!', ' Unable to find PKT in packet. Archive issue?');
PKT.Free;
FileErase (bbsConfig.InboundPath + ArcFN);
If Not PKTFound Then
Log (2, '!', ' Unable to extract bundle; skipping')
Else
FileErase (bbsConfig.InboundPath + PktBundle);
End;
Var
DirInfo : SearchRec;
NodeFile : File of RecEchoMailNode;
Count : LongInt;
FoundPacket : Byte;
FileExt : String;
Begin
TotalEcho := 0;
TotalNet := 0;
@ -322,6 +358,7 @@ Begin
Count := INI.ReadInteger(Header_ECHOIMPORT, 'dupe_db_size', 32000);
Dupes := TPKTDupe.Create(Count);
PKT := TPKTReader.Create;
If DupeIndex <> -1 Then
If Not GetMBaseByIndex (DupeIndex, DupeMBase) Then
@ -331,37 +368,21 @@ Begin
While DosError = 0 Do Begin
If DirInfo.Attr And Directory = 0 Then Begin
FoundPacket := 0;
FileExt := Copy(strUpper(JustFileExt(DirInfo.Name)), 1, 2);
If strUpper(JustFileExt(DirInfo.Name)) = 'PKT' Then Begin
FoundPacket := 2;
// NETMAIL
End Else Begin
// ECHOMAIL
Assign (NodeFile, bbsConfig.DataPath + 'echonode.dat');
If ioReset(NodeFile, Sizeof(RecEchoMailNode), fmRWDN) Then Begin
While Not Eof(NodeFile) Do Begin
Read (NodeFile, EchoNode);
For Count := 1 to 30 Do Begin
If strUpper(JustFileName(DirInfo.Name)) = strUpper(GetFTNArchiveName(EchoNode.Address, bbsConfig.NetAddress[Count])) Then Begin
FoundPacket := 1;
Break;
End;
End;
End;
Close (NodeFile);
End;
End;
Case FoundPacket of
0 : Log (2, '!', ' Unknown inbound file: ' + DirInfo.Name);
1 : ImportEchoMailPacket (DirInfo.Name);
2 : ImportNetMailPacket (DirInfo.Name);
End;
If FileExt = 'PK' Then
ImportPacketFile(bbsConfig.InboundPath + DirInfo.Name)
Else
If (FileExt = 'SU') or
(FileExt = 'MO') or
(FileExt = 'TU') or
(FileExt = 'WE') or
(FileExt = 'TH') or
(FileExt = 'FR') or
(FileExt = 'SA') Then
ImportPacketBundle(DirInfo.Name)
Else
Log (2, '!', ' Unknown inbound file: ' + DirInfo.Name);
End;
FindNext (DirInfo);
@ -369,6 +390,7 @@ Begin
FindClose (DirInfo);
PKT.Free;
Dupes.Free;
ProcessStatus ('Total |15' + strI2S(TotalEcho) + ' |07echo |15' + strI2S(TotalNet) + ' |07net |15' + strI2S(TotalDupes) + ' |07dupe', True);

1
mystic/todo.pas
View File

@ -8,6 +8,7 @@ design elements/issues.
BUGS AND POSSIBLE ISSUES
========================
! Weird console slowdown with test.txt in Win7 use MVIEW to test
! GE option 32 (change def protocol) might be broken
! Node chat goes haywire at 1000 lines scrollback
! Node chat needs to actualy word wrap not nickname wrap.

43
mystic/whatsnew.txt
View File

@ -3069,7 +3069,7 @@
default upload filebase.
+ Installation now creates a DOCS directory off the root installation. This
will eventually contain documentation.
will eventually contain documentation that hopefully doesn't suck. :)
+ Installation now creates default echomail in/out directories.
@ -3082,3 +3082,44 @@
mail it will not allow nodes to connect to you to exchange mail.
<ALPHA 30 RELEASED>
+ Lots of changes to the MUTIL echomail import functions:
1. MUTIL will now process all PKT files with no regard of message type
(ie echo or netmail). It should now also process PKT files that
have a mix of each without crashing.
2. MUTIL will now ignore the base filename of PKT files meaning it will
attempt to process ALL incoming PKT files. MUTIL will check the PKT
header against the configured AKAs and if there is a match it will
import. If a PKT is found that is not addressed to a configured AKA
address, MUTIL will delete it.
3. For incoming echomail bundles, MUTIL will continue to first attempt
to match the bundle filename to a configured echomail node, but if a
configured node cannot be linked, it will attempt to find an archive
signature and use that to extract the bundle. Currently supported
signatures are ZIP, RAR, LZH, and ARJ.
If either a signature is found OR a link to an echomail node is found
it will attempt to import. Should both fail, MUTIL will no longer
delete the bundle instead it will only log the issue. This allows
the issue to be resolved without loss of echomail.
If it DOES succeed, MUTIL will process all PKT files using the same
logic that is described in #2 above.
4. MUTIL now reports status and percentage bars for each individual PKT
file when tossing a bundle, rather than just the bundle itself. In
addition, the logging will contain both the bundle and the PKT files
contained within it.
! Fixed a bug with the windows local console bleeding colors on a clear EOL
that was introduced in A30.
+ Added the footprint for the new reply functions (reply by current base,
email, netmail, or a selectable msg base). These are not functional yet,
but the internal changes have been made to allow for it. If you notice
wierdness during message replies let me know.
<ALPHA 31 RELEASED>