From 5ceb74a3f4186a4c29c25f7e47a818921b7429f1 Mon Sep 17 00:00:00 2001 From: mysticbbs Date: Tue, 10 Sep 2013 00:48:27 -0400 Subject: [PATCH] A37 --- mystic/bbs_cfg_qwknet.pas | 2 +- mystic/bbs_msgbase.pas | 23 ++---- mystic/bbs_msgbase_qwk.pas | 78 ++++++++++++++---- mystic/mis_client_ftp.pas | 42 ++++------ mystic/qwkpoll.pas | 165 +++++++++++++++++++++++++++++-------- mystic/whatsnew.txt | 9 +- 6 files changed, 218 insertions(+), 101 deletions(-) diff --git a/mystic/bbs_cfg_qwknet.pas b/mystic/bbs_cfg_qwknet.pas index 99e1e9c..9af5f69 100644 --- a/mystic/bbs_cfg_qwknet.pas +++ b/mystic/bbs_cfg_qwknet.pas @@ -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'); diff --git a/mystic/bbs_msgbase.pas b/mystic/bbs_msgbase.pas index e66d759..65a0b2d 100644 --- a/mystic/bbs_msgbase.pas +++ b/mystic/bbs_msgbase.pas @@ -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; diff --git a/mystic/bbs_msgbase_qwk.pas b/mystic/bbs_msgbase_qwk.pas index 709a04a..5977b80 100644 --- a/mystic/bbs_msgbase_qwk.pas +++ b/mystic/bbs_msgbase_qwk.pas @@ -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; diff --git a/mystic/mis_client_ftp.pas b/mystic/mis_client_ftp.pas index 5c4e099..6d5783f 100644 --- a/mystic/mis_client_ftp.pas +++ b/mystic/mis_client_ftp.pas @@ -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; diff --git a/mystic/qwkpoll.pas b/mystic/qwkpoll.pas index a35c8df..80a388c 100644 --- a/mystic/qwkpoll.pas +++ b/mystic/qwkpoll.pas @@ -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); diff --git a/mystic/whatsnew.txt b/mystic/whatsnew.txt index 66506c3..11ab57c 100644 --- a/mystic/whatsnew.txt +++ b/mystic/whatsnew.txt @@ -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 ->