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

A37

This commit is contained in:
mysticbbs 2013-09-10 00:48:27 -04:00
parent e6f5478ded
commit 5ceb74a3f4
6 changed files with 218 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
mystic/bbs_cfg_qwknet.pas
View File

@ -37,7 +37,7 @@ Begin
Form.AddTog ('M', ' Member Type', 19, 8, 34, 8, 13, 4, 0, 1, 'HUB Node', @QwkNet.MemberType, Topic + 'Are you a HUB or a Node of this network?');
Form.AddStr ('H', ' FTP Host', 22, 9, 34, 9, 10, 30, 60, @QwkNet.HostName, Topic + 'Hostname:Port of HUB (if you are a node)');
Form.AddStr ('L', ' Login', 25, 10, 34, 10, 7, 20, 20, @QwkNet.Login, Topic + 'FTP login');
Form.AddPass ('P', ' Password', 22, 11, 34, 11, 10, 20, 20, @QwkNet.Password, Topic + 'FTP password');
Form.AddMask ('P', ' Password', 22, 11, 34, 11, 10, 20, 20, @QwkNet.Password, Topic + 'FTP password');
Form.AddBol ('U', ' Use Passive', 19, 12, 34, 12, 13, 3, @QwkNet.UsePassive, Topic + 'Use passive FTP with HUB');
Form.AddStr ('I', ' Packet ID', 21, 13, 34, 13, 11, 20, 20, @QwkNet.PacketID, Topic + 'QWK packet name to use with HUB');
Form.AddCaps ('A', ' Archive Type', 18, 14, 34, 14, 14, 4, 4, @QwkNet.ArcType, Topic + 'Archive type used for packets');

23
mystic/bbs_msgbase.pas
View File

@ -4666,7 +4666,13 @@ Begin
If TempBase.NetType > 0 Then Begin
MsgBase^.DoStringLn (#13 + '--- ' + mysSoftwareID + '/QWK v' + mysVersion + ' (' + OSID + ')');
MsgBase^.DoStringLn (' * Origin: ' + ResolveOrigin(TempBase) + ' (' + strAddr2Str(MsgBase^.GetOrigAddr) + ')');
Line := ' * Origin: ' + ResolveOrigin(MBase);
If MBase.QwkNetID = 0 Then
Line := Line + ' (' + strAddr2Str(MsgBase^.GetOrigAddr) + ')';
MsgBase^.DoStringLn (Line);
End;
If Not IsControl Then Begin
@ -4717,18 +4723,3 @@ Begin
End;
End.
// need one of these for the file list compiler now too which MAYBE can be
// used in MUTIL also. lets template and build that out first.. then...
// create and upload QWK/REP packets without relying on BBS specific stuff
Type
TMsgBaseQWK = Class
User : RecUser;
Extended : Boolean;
Constructor Create (UD: RecUser; Ext: Boolean);
Function CreatePacket : Boolean;
Function ProcessReply (bbsid, temppath, usernum, var user, forcefrom ): Boolean;
Destructor Destroy; Override;
End;

78
mystic/bbs_msgbase_qwk.pas
View File

@ -78,6 +78,7 @@ Type
Procedure WriteCONTROLDAT;
Function WriteMSGDAT (IsRep: Boolean) : LongInt;
Procedure UpdateLastReadPointers;
Procedure ResetSentFlagByQLR;
Procedure ExportPacket (IsRep: Boolean);
Function ImportPacket (IsQwk: Boolean) : Boolean;
End;
@ -277,8 +278,9 @@ Var
End;
Var
TempStr : String;
SkipMsg : Boolean;
TempStr : String;
SkipMsg : Boolean;
FirstMsg : LongInt = 0;
Begin
MsgAdded := 0;
@ -312,6 +314,9 @@ Begin
End;
If IsRep Then Begin
If FirstMsg = 0 Then
FirstMsg := MsgBase^.GetMsgNum;
MsgBase^.SetSent(True);
MsgBase^.ReWriteHdr;
End;
@ -331,7 +336,7 @@ Begin
If TempStr[1] = #1 Then Begin
// Do not export msgs to a node if the msg came from the node
If IsNetworked And Not IsRep And (Copy(TempStr, 2, 4) = 'QSRC') Then
SkipMsg := strUpper(strWordGet(2, TempStr, ' ')) = strUpper(PacketID);
SkipMsg := strUpper(strWordGet(2, TempStr, ' ')) = strUpper(UserRecord.Handle);
Continue;
End;
@ -353,9 +358,12 @@ Begin
Else
Chunks := Chunks DIV 128 + 2;
Header :=
' ' +
strPadR(strI2S(MsgBase^.GetMsgNum), 7, ' ') +
If IsNetworked Then
Header := ' ' + strPadR(strI2S(MBase.QwkConfID), 7, ' ')
Else
Header := ' ' + strPadR(strI2S(MsgBase^.GetMsgNum), 7, ' ');
Header := Header +
MsgBase^.GetDate +
MsgBase^.GetTime +
strPadR(MsgBase^.GetTo, 25, ' ') +
@ -434,7 +442,46 @@ Begin
Dispose (MsgBase, Done);
Result := LastRead;
If IsRep Then
Result := FirstMsg
Else
Result := LastRead;
End;
Procedure TQWKEngine.ResetSentFlagByQLR;
Begin
Reset (QwkLRFile);
ioReset (MBaseFile, SizeOf(RecMessageBase), fmRWDN);
While Not Eof(QwkLRFile) Do Begin
Read (QwkLRFile, QwkLR);
If (QwkLR.Pos > 0) and (ioSeek(MBaseFile, QwkLR.Base - 1)) Then Begin
ioRead (MBaseFile, MBase);
If MBaseOpenCreate (MsgBase, MBase, WorkPath) Then Begin
MsgBase^.SeekFirst (QwkLR.Pos);
While MsgBase^.SeekFound Do Begin
MsgBase^.MsgStartUp;
If MsgBase^.IsSent Then Begin
MsgBase^.SetSent(False);
MsgBase^.ReWriteHdr;
End;
MsgBase^.SeekNext;
End;
MsgBase^.CloseMsgBase;
Dispose(MsgBase, Done);
End;
End;
End;
Close (QwkLRFile);
Close (MBaseFile);
End;
Procedure TQWKEngine.UpdateLastReadPointers;
@ -451,9 +498,9 @@ Begin
If MBaseOpenCreate (MsgBase, MBase, WorkPath) Then Begin
MsgBase^.SetLastRead (UserNumber, QwkLR.Pos);
MsgBase^.CloseMsgBase;
End;
Dispose(MsgBase, Done);
Dispose(MsgBase, Done);
End;
End;
End;
@ -714,19 +761,14 @@ Begin
End;
If Not IsControl Then Begin
// ISQWK = a node importing from HUB
If (IsQwk) or (HasAccess(Self, MBase.PostACS)) Then Begin
// If ((IsQwk) or (HasAccess(Self, MBase.PostACS))) and
// ((IsNetworked And (UserRecord.QwkNetwork = MBase.QwkNetID)) or (Not IsNetworked)) Then Begin
If IsNetworked And Not IsQWK Then
MsgBase^.DoStringLn (#1'QSRC ' + UserRecord.Handle);
If IsNetworked And Not IsQWK Then
MsgBase^.DoStringLn (#1'QSRC ' + PacketID);
// ^^ needs to change to UserRecord.Handle
MsgBase^.WriteMsg;
MsgBase^.WriteMsg;
Inc (RepOK); // must increase user and history posts by repOK
Inc (RepOK); // must increase user and history posts by repOK
End Else
Inc (RepFailed);
End;

42
mystic/mis_client_ftp.pas
View File

@ -54,7 +54,6 @@ Type
Function CheckFileLimits (TempFBase: RecFileBase; FDir: RecFileList) : Byte;
Function ValidDirectory (TempBase: RecFileBase) : Boolean;
Function FindDirectory (Var TempBase: RecFileBase) : LongInt;
Function GetQWKName : String;
Function GetFTPDate (DD: LongInt) : String;
Function SendFile (Str: String) : Boolean;
Function RecvFile (Str: String; IsAppend: Boolean) : Boolean;
@ -419,18 +418,6 @@ Begin
Result := Result + FormatDate(TempDT, ' YYYY');
End;
Function TFTPServer.GetQWKName : String;
Begin
Result := '';
If LoggedIn Then Begin // and allow qwk via ftp
If (User.Flags AND UserQwkNetwork <> 0) Then
Result := strLower(User.Handle)
Else
Result := strLower(BbsConfig.QwkBBSID);
End;
End;
Function TFTPServer.RecvFile (Str: String; IsAppend: Boolean) : Boolean;
Var
F : File;
@ -537,7 +524,7 @@ Begin
// ftp instance. before that we need to push a unique ID to this
// session.
QWK := TQwkEngine.Create(TempPath, GetQWKName, UserPos, User);
QWK := TQwkEngine.Create(TempPath, bbsCfg.QwkBBSID, UserPos, User);
QWK.HasAccess := @QWKHasAccess;
QWK.IsNetworked := (User.Flags AND UserQWKNetwork <> 0);
@ -545,9 +532,10 @@ Begin
QWK.ExportPacket(False);
ExecuteArchive (TempPath, TempPath + GetQWKName + '.qwk', User.Archive, TempPath + '*', 1);
Server.Status (ProcessID, 'Exported ' + strI2S(QWK.TotalMessages) + ' msgs@' + bbsCfg.QwkBBSID + '.qwk');
ExecuteArchive (TempPath, TempPath + bbsCfg.QwkBBSID + '.qwk', User.Archive, TempPath + '*', 1);
If SendFile (TempPath + GetQWKName + '.qwk') Then
If SendFile (TempPath + bbsCfg.QwkBBSID + '.qwk') Then
QWK.UpdateLastReadPointers;
QWK.Free;
@ -560,19 +548,21 @@ Var
QWK : TQwkEngine;
Begin
// need to change temppath to a unique directory created for this
// ftp instance. before that we need to push a unique ID to this
// session.
// ftp instance. we can use the new session ID for this
RecvFile (TempPath + GetQWKName + '.rep', False);
ExecuteArchive (TempPath, TempPath + GetQWKName + '.rep', User.Archive, '*', 2);
RecvFile (TempPath + bbsCfg.QwkBBSID + '.rep', False);
ExecuteArchive (TempPath, TempPath + bbsCfg.QwkBBSID + '.rep', User.Archive, '*', 2);
QWK := TQwkEngine.Create(TempPath, GetQWKName, UserPos, User);
QWK := TQwkEngine.Create(TempPath, bbsCfg.QwkBBSID, UserPos, User);
QWK.HasAccess := @QWKHasAccess;
QWK.IsNetworked := (User.Flags AND UserQWKNetwork <> 0);
QWK.IsExtended := User.QwkExtended;
QWK.ImportPacket(False);
Server.Status(ProcessID, 'Imported ' + strI2S(QWK.RepOK) + ' msgs, ' + strI2S(QWK.RepFailed) + ' failed');
QWK.Free;
// update user stats posts and bbs history if not networked
@ -660,6 +650,7 @@ Begin
Client.WriteLine(re_PassiveOK + '(' + strReplace(Client.HostIP, '.', ',') + ',' + strI2S(WordRec(DataPort).Hi) + ',' + strI2S(WordRec(DataPort).Lo) + ').');
IsPassive := True;
(*
WaitSock := TIOSocket.Create;
WaitSock.FTelnetServer := False;
@ -682,6 +673,7 @@ Begin
End;
WaitSock.Free;
*)
End Else
Client.WriteLine(re_BadCommand);
End;
@ -798,7 +790,7 @@ Begin
{$IFDEF FTPDEBUG} LOG('Back from data session'); {$ENDIF}
// if qwlbyFTP.acs then
DataSocket.WriteLine('-rw-r--r-- 1 ftp ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + GetQWKName + '.qwk');
DataSocket.WriteLine('-rw-r--r-- 1 ftp ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + bbsCfg.QwkBBSID + '.qwk');
FBaseFile := TFileBuffer.Create(FileBufSize);
@ -844,7 +836,7 @@ Begin
DirFile.Free;
DataSocket.WriteLine('-rw-r--r-- 1 ftp ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + GetQWKName + '.qwk');
DataSocket.WriteLine('-rw-r--r-- 1 ftp ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + bbsCfg.QwkBBSID + '.qwk');
CloseDataSession;
End Else
@ -871,7 +863,7 @@ Begin
Exit;
End;
If strUpper(Data) = strUpper(GetQWKName + '.rep') Then Begin
If strUpper(Data) = strUpper(bbsCfg.QwkBBSID + '.rep') Then Begin
QWKProcessREP;
Exit;
@ -1014,7 +1006,7 @@ Var
Begin
If LoggedIn Then Begin
If strUpper(Data) = strUpper(GetQWKName + '.qwk') Then Begin
If strUpper(Data) = strUpper(bbsCfg.QwkBBSID + '.qwk') Then Begin
QWKCreatePacket;
Exit;

165
mystic/qwkpoll.pas
View File

@ -3,10 +3,6 @@ Program QwkPoll;
{$I M_OPS.PAS}
Uses
{$IFDEF DEBUG}
HeapTrc,
LineInfo,
{$ENDIF}
m_DateTime,
m_Strings,
m_FileIO,
@ -18,13 +14,17 @@ Uses
Var
TempPath : String;
(*
Function PollByQWKNet (QwkNet: RecQwkNetwork) : Boolean;
Var
QWK : TQwkEngine;
FTP : TFTPClient;
User : RecUser;
QWK : TQwkEngine;
FTP : TFTPClient;
User : RecUser;
SentFile : Boolean;
ExpTotal : LongInt;
Begin
Result := False;
Result := False;
SentFile := False;
If (QwkNet.MemberType <> 1) or
(QwkNet.PacketID = '') or
@ -46,8 +46,94 @@ Begin
ExecuteArchive (TempPath, TempPath + QwkNet.PacketID + '.rep', QwkNet.ArcType, TempPath + '*', 1);
WriteLn (' - Exported @' + QwkNet.PacketID + '.rep -> ', QWK.TotalMessages, ' msgs ');
WriteLn (' - Connecting via FTP to ' + QWkNet.HostName);
WriteLn (' - Exported @' + QwkNet.PacketID + '.rep -> ', QWK.TotalMessages, ' msgs ');
WriteLn (' - Connecting via FTP to ' + QWkNet.HostName);
ExpTotal := QWK.TotalMessages;
If ExpTotal = 0 Then
DirClean (TempPath, '');
FTP := TFTPClient.Create(bbsCfg.inetInterface);
If FTP.OpenConnection(QwkNet.HostName) Then Begin
WriteLn (' - Connected');
If FTP.Authenticate(QwkNet.Login, QwkNet.Password) Then Begin
WriteLn (' - Logged in as ', QwkNet.Login);
WriteLn (' - Sending reply packet');
SentFile := FTP.SendFile (QwkNet.UsePassive, TempPath + QwkNet.PacketID + '.rep');
WriteLn (' - Downloading QWK packet');
DirClean (TempPath, '');
FTP.GetFile (QwkNet.UsePassive, TempPath + QwkNet.PacketID + '.qwk');
If FileExist(TempPath + QwkNet.PacketID + '.qwk') Then Begin
WriteLn (' - Unpacking QWK packet');
ExecuteArchive (TempPath, TempPath + QwkNet.PacketID + '.qwk', QwkNet.ArcType, '*', 2);
WriteLn (' - Importing QWK packet');
If QWK.ImportPacket(True) Then
WriteLn (' - Imported ', QWK.RepOK, ' messages (', QWK.RepFailed, ' failed)')
Else
WriteLn (' - Unable to find QWK packet');
End Else
Writeln (' - No QWK file received');
End;
End;
If (ExpTotal > 0) and Not SentFile Then Begin
WriteLn (' - Send of REP failed; reseting export pointers');
QWK.ResetSentFlagByQLR;
writeln('DEBUG done');
End;
FTP.Free;
QWK.Free;
DirClean (TempPath, '');
WriteLn;
End;
*)
Function PollByQWKNet (QwkNet: RecQwkNetwork) : Boolean;
Var
QWK : TQwkEngine;
FTP : TFTPClient;
User : RecUser;
SentFile : Boolean;
Begin
Result := False;
SentFile := False;
If (QwkNet.MemberType <> 1) or
(QwkNet.PacketID = '') or
(QwkNet.ArcType = '') Then Exit;
WriteLn ('- Exchanging Mail for ' + QwkNet.Description);
DirClean (TempPath, '');
User.Handle := QwkNet.Login;
User.QwkNetwork := QwkNet.Index;
QWK := TQwkEngine.Create (TempPath, QwkNet.PacketID, 1, User);
QWK.IsNetworked := True;
QWK.IsExtended := QwkNet.UseQWKE;
QWK.ExportPacket(True);
ExecuteArchive (TempPath, TempPath + QwkNet.PacketID + '.rep', QwkNet.ArcType, TempPath + '*', 1);
WriteLn (' - Exported @' + QwkNet.PacketID + '.rep -> ', QWK.TotalMessages, ' msgs ');
WriteLn (' - Connecting via FTP to ' + QWkNet.HostName);
If QWK.TotalMessages = 0 Then
DirClean (TempPath, '');
@ -55,36 +141,42 @@ Begin
FTP := TFTPClient.Create(bbsCfg.inetInterface);
If FTP.OpenConnection(QwkNet.HostName) Then Begin
WriteLn (' - Connected');
WriteLn (' - Connected');
If FTP.Authenticate(QwkNet.Login, QwkNet.Password) Then Begin
WriteLn (' - Logged in as ', QwkNet.Login);
WriteLn (' - Logged in as ', QwkNet.Login);
WriteLn (' - Sending reply packet');
FTP.SendFile (QwkNet.UsePassive, TempPath + QwkNet.PacketID + '.rep');
SentFile := FTP.SendFile (QwkNet.UsePassive, TempPath + QwkNet.PacketID + '.rep');
// if was sent successfully THEN update by setting
// isSent on all messages UP until the QLR.DAT information?
// also need to remove the SetLocal crap and make an UpdateSentFlags
// in QWK class if we do this.
WriteLn (' - Downloading QWK packet');
DirClean (TempPath, '');
FTP.GetFile (QwkNet.UsePassive, TempPath + QwkNet.PacketID + '.qwk');
WriteLn (' - Unpacking QWK packet');
ExecuteArchive (TempPath, TempPath + QwkNet.PacketID + '.qwk', QwkNet.ArcType, '*', 2);
WriteLn (' - Importing QWK packet');
QWK.ImportPacket(True);
WriteLn (' - Imported ', QWK.RepOK, ' messages (', QWK.RepFailed, ' failed)');
FTP.GetFile (QwkNet.UsePassive, TempPath + QwkNet.PacketID + '.qwk');
End;
End;
writeln ('DEBUG disposing memory');
FTP.Free;
If (QWK.TotalMessages > 0) and Not SentFile Then Begin
WriteLn (' - Send of REP failed; reseting export pointers');
QWK.ResetSentFlagByQLR;
End;
If FileExist(TempPath + QwkNet.PacketID + '.qwk') Then Begin
WriteLn (' - Unpacking QWK packet');
ExecuteArchive (TempPath, TempPath + QwkNet.PacketID + '.qwk', QwkNet.ArcType, '*', 2);
WriteLn (' - Importing QWK packet');
If QWK.ImportPacket(True) Then
WriteLn (' - Imported ', QWK.RepOK, ' messages (', QWK.RepFailed, ' failed)')
Else
WriteLn (' - Unable to find QWK packet');
End Else
Writeln (' - No QWK file received');
QWK.Free;
DirClean (TempPath, '');
@ -101,7 +193,7 @@ Begin
ExecuteArchive (TempPath, Path + QwkNet.PacketID + '.qwk', QwkNet.ArcType, '*', 2);
User.Handle := QwkNet.PacketID;
User.Handle := QwkNet.Login;
User.QwkNetwork := QwkNet.Index;
QWK := TQwkEngine.Create (TempPath, QwkNet.PacketID, 1, User);
@ -109,9 +201,10 @@ Begin
QWK.IsNetworked := True;
QWK.IsExtended := QwkNet.UseQWKE;
QWK.ImportPacket(True);
WriteLn (' - Imported ', QWK.RepOK, ' messages (', QWK.RepFailed, ' failed)');
If QWK.ImportPacket(True) Then
WriteLn (' - Imported ', QWK.RepOK, ' messages (', QWK.RepFailed, ' failed)')
Else
WriteLn (' - Unable to find QWK packet');
QWK.Free;
End;
@ -123,7 +216,7 @@ Var
Begin
WriteLn ('- Exporting ' + Path + QwkNet.PacketID + '.rep');
User.Handle := QwkNet.PacketID;
User.Handle := QwkNet.Login;
User.QwkNetwork := QwkNet.Index;
QWK := TQwkEngine.Create (TempPath, QwkNet.PacketID, 1, User);

9
mystic/whatsnew.txt
View File

@ -3647,11 +3647,6 @@
+ Mystic's QWK system no longer forces all upper case user names and
subjects.
+ New MCI code QE returns the user's QWKE packet setting (Yes or No).
+ New GE menu command option: 33. Toggles users QWKE packet setting. The
default install now includes updated qwk.mnu and qwknetwork.mnu
+ A new temporary QWK mailer has been included called QWKPOLL. This will
allow you to function as a node of a QWK network. It will connect via FTP
to your network hub, send them a REP packet of new messages, download a
@ -3663,6 +3658,10 @@
even HUB them in addition to being members of several - all with separate
access management.
NOTE: All setups require you to have defined your QWK packet ID in
the Local QWK settings. This is the filename of the QWK packets
generated from your BBS or uploaded to your BBS.
SETTING UP AS A NODE OF A QWK NETWORK
=====================================
1. Create a new QWK network profile in the System Configuration ->