From 641bac34ef7c1c6f7d3dfb1da4db6f87acfaebab Mon Sep 17 00:00:00 2001 From: mysticbbs Date: Sun, 1 Sep 2013 01:42:24 -0400 Subject: [PATCH] FTP QWK download --- mystic/bbs_database.pas | 83 ++++++++++++++++++++++++++++++++++++ mystic/bbs_msgbase_qwk.pas | 74 ++++++++++++++++++++------------ mystic/mis.pas | 3 +- mystic/mis_client_binkp.pas | 3 +- mystic/mis_client_ftp.pas | 61 ++++++++++++++++++++++---- mystic/mis_client_nntp.pas | 3 +- mystic/mis_client_pop3.pas | 3 +- mystic/mis_client_smtp.pas | 3 +- mystic/mis_client_telnet.pas | 3 +- mystic/mis_common.pas | 7 ++- mystic/mis_nodedata.pas | 3 +- mystic/mis_server.pas | 3 +- mystic/whatsnew.txt | 3 ++ 13 files changed, 204 insertions(+), 48 deletions(-) diff --git a/mystic/bbs_database.pas b/mystic/bbs_database.pas index fdb66a7..1d194d1 100644 --- a/mystic/bbs_database.pas +++ b/mystic/bbs_database.pas @@ -24,6 +24,7 @@ Const Function GetBaseConfiguration (UseEnv: Boolean; Var TempCfg: RecConfig) : Byte; Function PutBaseConfiguration (Var TempCfg: RecConfig) : Boolean; +Function ShellDOS (ExecPath: String; Command: String) : LongInt; // MESSAGE BASE @@ -34,6 +35,7 @@ Procedure PutMessageScan (UN: Cardinal; TempBase: RecMessageBase; TempSca // FILE BASE +Procedure ExecuteArchive (TempP: String; FName: String; Temp: String; Mask: String; Mode: Byte); Function GetTotalFiles (Var TempBase: RecFileBase) : LongInt; // USER @@ -90,6 +92,29 @@ Begin End; End; +Function ShellDOS (ExecPath: String; Command: String) : LongInt; +Var + CurDIR : String; +Begin + GetDIR (0, CurDIR); + + If ExecPath <> '' Then DirChange(ExecPath); + + {$IFDEF UNIX} + Result := Shell(Command); + {$ENDIF} + + {$IFDEF WINDOWS} + If Command <> '' Then Command := '/C' + Command; + + Exec (GetEnv('COMSPEC'), Command); + + Result := DosExitCode; + {$ENDIF} + + DirChange(CurDIR); +End; + Function GetMBaseByIndex (Num: LongInt; Var TempBase: RecMessageBase) : Boolean; Var F : File; @@ -213,6 +238,64 @@ Begin Result := (strUpper(U.RealName) = Str) or (strUpper(U.Handle) = Str); End; +Procedure ExecuteArchive (TempP: String; FName: String; Temp: String; Mask: String; Mode: Byte); +Var + ArcFile : File; + Arc : RecArchive; + Count : LongInt; + Str : String; +Begin + If Temp <> '' Then + Temp := strUpper(Temp) + Else + Temp := strUpper(JustFileExt(FName)); + + Assign (ArcFile, bbsCfg.DataPath + 'archive.dat'); + + If Not ioReset (ArcFile, SizeOf(RecArchive), fmRWDN) Then Exit; + + Repeat + If Eof(ArcFile) Then Begin + Close (ArcFile); + + Exit; + End; + + ioRead (ArcFile, Arc); + + If (Not Arc.Active) or ((Arc.OSType <> OSType) and (Arc.OSType <> 3)) Then Continue; + + If strUpper(Arc.Ext) = Temp Then Break; + Until False; + + Close (ArcFile); + + Case Mode of + 1 : Str := Arc.Pack; + 2 : Str := Arc.Unpack; + End; + + If Str = '' Then Exit; + + Temp := ''; + Count := 1; + + While Count <= Length(Str) Do Begin + If Str[Count] = '%' Then Begin + Inc (Count); + + If Str[Count] = '1' Then Temp := Temp + FName Else + If Str[Count] = '2' Then Temp := Temp + Mask Else + If Str[Count] = '3' Then Temp := Temp + TempP; + End Else + Temp := Temp + Str[Count]; + + Inc (Count); + End; + + ShellDOS ('', Temp); +End; + Initialization bbsCfgStatus := GetBaseConfiguration(True, bbsCfg); diff --git a/mystic/bbs_msgbase_qwk.pas b/mystic/bbs_msgbase_qwk.pas index b32d177..648bf83 100644 --- a/mystic/bbs_msgbase_qwk.pas +++ b/mystic/bbs_msgbase_qwk.pas @@ -7,7 +7,10 @@ Interface Uses m_FileIO, BBS_Records, - BBS_DataBase; + BBS_DataBase, + BBS_MsgBase_ABS, + BBS_MsgBase_JAM, + BBS_MsgBase_Squish; Const QWK_EOL = #13#10; @@ -42,7 +45,7 @@ Type Pos : LongInt; End; - TQWKEngine_HasAccess = Function (AcsStr: String) : Boolean; + TQWKEngine_HasAccess = Function (Sender: Pointer; AcsStr: String) : Boolean; TQWKEngine_Status = Procedure (Sender: Pointer; State: Byte); TQWKEngine = Class @@ -61,7 +64,11 @@ Type RepBaseAdd : LongInt; RepBaseDel : LongInt; DataFile : TFileBuffer; + MBaseFile : File; MBase : RecMessageBase; + QwkLR : QwkLRRec; + QwkLRFile : File of QwkLRRec; + MsgBase : PMsgBaseABS; Constructor Create (QwkPath, QwkID: String; UN: Cardinal; UR: RecUser); Procedure LONG2MSB (Index: LongInt; Var MS: BSingle); @@ -69,6 +76,7 @@ Type Procedure WriteTOREADEREXT; Procedure WriteCONTROLDAT; Function WriteMSGDAT : LongInt; + Procedure UpdateLastReadPointers; Procedure CreatePacket; Function ProcessReply : Boolean; End; @@ -77,10 +85,7 @@ Implementation Uses m_Strings, - m_DateTime, - BBS_MsgBase_ABS, - BBS_MsgBase_JAM, - BBS_MsgBase_Squish; + m_DateTime; Constructor TQWKEngine.Create (QwkPath, QwkID: String; UN: Cardinal; UR: RecUser); Begin @@ -98,6 +103,8 @@ Begin RepFailed := 0; RepBaseAdd := 0; RepBaseDel := 0; + + Assign (MBaseFile, bbsCfg.DataPath + 'mbases.dat'); End; Procedure TQWKEngine.LONG2MSB (Index : LongInt; Var MS : BSingle); @@ -142,7 +149,6 @@ End; Procedure TQWKEngine.WriteTOREADEREXT; Var TempFile : Text; - BaseFile : File; Flags : String; Base : RecMessageBase; Begin @@ -152,14 +158,12 @@ Begin ReWrite (TempFile); Write (TempFile, 'ALIAS ' + UserRecord.Handle + QWK_EOL); - Assign (BaseFile, bbsCfg.DataPath + 'mbases.dat'); + If ioReset (MBaseFile, SizeOf(RecMessageBase), fmRWDN) Then Begin - If ioReset (BaseFile, SizeOf(RecMessageBase), fmRWDN) Then Begin + While Not Eof(MBaseFile) Do Begin + ioRead (MBaseFile, Base); - While Not Eof(BaseFile) Do Begin - ioRead (BaseFile, Base); - - If HasAccess(Base.ReadACS) Then Begin + If HasAccess(Self, Base.ReadACS) Then Begin Flags := ' '; If Base.Flags AND MBPrivate = 0 Then @@ -170,7 +174,7 @@ Begin If Base.Flags AND MBRealNames = 0 Then Flags := Flags + 'H'; - If Not HasAccess(Base.PostACS) Then + If Not HasAccess(Self, Base.PostACS) Then Flags := Flags + 'BRZ'; Case Base.NetType of @@ -187,7 +191,7 @@ Begin End; End; - Close (BaseFile); + Close (MBaseFile); End; Close (TempFile); @@ -216,14 +220,12 @@ Begin Write (TempFile, TotalMessages, QWK_EOL); Write (TempFile, TotalBases - 1, QWK_EOL); - Assign (BaseFile, bbsCfg.DataPath + 'mbases.dat'); - If ioReset (BaseFile, SizeOf(RecMessageBase), fmRWDN) Then Begin While Not Eof(BaseFile) Do Begin ioRead (BaseFile, Base); - If HasAccess(Base.ReadACS) Then Begin + If HasAccess(Self, Base.ReadACS) Then Begin Write (TempFile, Base.Index, QWK_EOL); If IsExtended Then @@ -254,7 +256,6 @@ Var LastRead : LongInt; QwkIndex : LongInt; TooBig : Boolean; - MsgBase : PMsgBaseABS; Procedure DoString (Str: String); Var @@ -399,13 +400,34 @@ Begin Result := LastRead; End; +Procedure TQWKEngine.UpdateLastReadPointers; +Begin + Reset (QwkLRFile); + ioReset (MBaseFile, SizeOf(RecMessageBase), fmRWDN); + + While Not Eof(QwkLRFile) Do Begin + Read (QwkLRFile, QwkLR); + + If ioSeek (MBaseFile, QwkLR.Base - 1) Then Begin + ioRead (MBaseFile, MBase); + + If MBaseOpenCreate (MsgBase, MBase, WorkPath) Then Begin + MsgBase^.SetLastRead (UserNumber, QwkLR.Pos); + MsgBase^.CloseMsgBase; + End; + + Dispose(MsgBase, Done); + End; + End; + + Close (QwkLRFile); + Close (MBaseFile); +End; + Procedure TQWKEngine.CreatePacket; Var - Temp : String; - QwkLR : QwkLRRec; - QwkLRFile : File of QwkLRRec; - MBaseFile : File; - MScan : MScanRec; + Temp : String; + MScan : MScanRec; Begin DataFile := TFileBuffer.Create(4 * 1024); @@ -418,8 +440,6 @@ Begin Assign (QwkLRFile, WorkPath + 'qlr.dat'); ReWrite (QwkLRFile); - Assign (MBaseFile, bbsCfg.DataPath + 'mbases.dat'); - If ioReset (MBaseFile, SizeOf(RecMessageBase), fmRWDN) Then Begin If IsNetworked Then @@ -431,7 +451,7 @@ Begin If IsNetworked And (MBase.Flags AND MBAllowQWKNet = 0) Then Continue; - If HasAccess(MBase.ReadACS) Then Begin + If HasAccess(Self, MBase.ReadACS) Then Begin GetMessageScan (UserNumber, MBase, MScan); diff --git a/mystic/mis.pas b/mystic/mis.pas index d8c09da..643122e 100644 --- a/mystic/mis.pas +++ b/mystic/mis.pas @@ -49,7 +49,8 @@ Uses MIS_Client_POP3, MIS_Client_FTP, MIS_Client_NNTP, - MIS_Client_BINKP; + MIS_Client_BINKP, + BBS_Records; Const FocusTelnet = 0; diff --git a/mystic/mis_client_binkp.pas b/mystic/mis_client_binkp.pas index 50ed278..56b0fab 100644 --- a/mystic/mis_client_binkp.pas +++ b/mystic/mis_client_binkp.pas @@ -14,7 +14,8 @@ Uses m_Protocol_Queue, MIS_Server, MIS_NodeData, - MIS_Common; + MIS_Common, + BBS_Records; Const M_NUL = 0; diff --git a/mystic/mis_client_ftp.pas b/mystic/mis_client_ftp.pas index 0cead46..7efadcb 100644 --- a/mystic/mis_client_ftp.pas +++ b/mystic/mis_client_ftp.pas @@ -2,7 +2,7 @@ Unit MIS_Client_FTP; {$I M_OPS.PAS} -{$DEFINE FTPDEBUG} +{.$DEFINE FTPDEBUG} // does not send file/directory datestamps // does not support uploading (need to make bbs functions generic for this @@ -20,7 +20,9 @@ Uses m_DateTime, MIS_Server, MIS_NodeData, - MIS_Common; + MIS_Common, + BBS_Records, + BBS_DataBase; Function CreateFTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient; @@ -60,6 +62,8 @@ Type Function GetFTPDate (DD: LongInt) : String; Procedure SendFile (Str: String); + Function QWKCreatePacket : Boolean; + Procedure cmdUSER; Procedure cmdPASS; Procedure cmdREIN; @@ -83,6 +87,9 @@ Type Implementation +Uses + BBS_MsgBase_QWK; + Const FileBufSize = 4 * 1024; FileXferSize = 32 * 1024; @@ -407,9 +414,9 @@ Begin If LoggedIn Then Begin // and allow qwk via ftp If (User.Flags AND UserQwkNetwork <> 0) Then - Result := strLower(User.Handle) + '.qwk' + Result := strLower(User.Handle) Else - Result := strLower(BbsConfig.QwkBBSID) + '.qwk'; + Result := strLower(BbsConfig.QwkBBSID); End; End; @@ -445,6 +452,35 @@ Begin InTransfer := False; End; +Function QWKHasAccess (Owner: Pointer; ACS: String) : Boolean; +Begin + Result := CheckAccess(TQWKEngine(Owner).UserRecord, True, ACS); +End; + +Function TFTPServer.QWKCreatePacket : Boolean; +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. + + QWK := TQwkEngine.Create(TempPath, GetQWKName, UserPos, User); + + QWK.HasAccess := @QWKHasAccess; + QWK.IsNetworked := User.Flags AND UserQWKNetwork <> 0; + QWK.IsExtended := User.QwkExtended; + + QWK.CreatePacket; + QWK.UpdateLastReadPointers; + QWK.Free; + + Server.Status ('Created packet in ' + TempPath); + + ExecuteArchive (TempPath, TempPath + GetQWKName + '.qwk', User.Archive, TempPath + '*', 1); + SendFile (TempPath + GetQWKName + '.qwk'); +End; + Procedure TFTPServer.cmdUSER; Begin ResetSession; @@ -664,7 +700,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); + DataSocket.WriteLine('-rw-r--r-- 1 ftp ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + GetQWKName + '.qwk'); FBaseFile := TFileBuffer.Create(FileBufSize); @@ -710,7 +746,7 @@ Begin DirFile.Free; - DataSocket.WriteLine('-rw-r--r-- 1 ftp ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + GetQWKName); + DataSocket.WriteLine('-rw-r--r-- 1 ftp ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + GetQWKName + '.qwk'); CloseDataSession; End Else @@ -758,13 +794,18 @@ Var Found : LongInt; Begin If LoggedIn Then Begin - // if name = bbsid.qwk or if user is network and name is userid.qwk then - // send file here - // else do the normal stuff + + If strUpper(Data) = strUpper(GetQWKName + '.qwk') Then Begin + QWKCreatePacket; + + Exit; + End; + TempPos := FindDirectory(TempBase); If TempPos = -1 Then Begin Client.WriteLine(re_BadFile); + Exit; End; @@ -785,6 +826,7 @@ Begin If Found = -1 Then Begin Client.WriteLine(re_BadFile); + Exit; End; @@ -940,6 +982,7 @@ Begin If Cmd = 'XPWD' Then cmdPWD Else If Cmd = 'QUIT' Then Begin GotQuit := True; + Break; End Else Client.WriteLine(re_NoCommand); diff --git a/mystic/mis_client_nntp.pas b/mystic/mis_client_nntp.pas index 030feda..8f80684 100644 --- a/mystic/mis_client_nntp.pas +++ b/mystic/mis_client_nntp.pas @@ -15,7 +15,8 @@ Uses m_DateTime, MIS_Server, MIS_NodeData, - MIS_Common; + MIS_Common, + BBS_Records; Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient; diff --git a/mystic/mis_client_pop3.pas b/mystic/mis_client_pop3.pas index 62ec066..ba629c6 100644 --- a/mystic/mis_client_pop3.pas +++ b/mystic/mis_client_pop3.pas @@ -22,7 +22,8 @@ Uses MIS_Common, BBS_MsgBase_ABS, BBS_MsgBase_JAM, - BBS_MsgBase_Squish; + BBS_MsgBase_Squish, + BBS_Records; Function CreatePOP3 (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient; diff --git a/mystic/mis_client_smtp.pas b/mystic/mis_client_smtp.pas index a2b942f..1ae59bc 100644 --- a/mystic/mis_client_smtp.pas +++ b/mystic/mis_client_smtp.pas @@ -20,7 +20,8 @@ Uses bbs_MsgBase_Squish, MIS_Server, MIS_NodeData, - MIS_Common; + MIS_Common, + BBS_Records; Function CreateSMTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient; diff --git a/mystic/mis_client_telnet.pas b/mystic/mis_client_telnet.pas index e82a5ff..cbe494c 100644 --- a/mystic/mis_client_telnet.pas +++ b/mystic/mis_client_telnet.pas @@ -39,7 +39,8 @@ Uses m_Strings, MIS_Common, MIS_NodeData, - MIS_Server; + MIS_Server, + BBS_Records; {$IFDEF USEFORK} function forkpty(__amaster:Plongint; __name:Pchar; __termp:Pointer; __winp:Pointer):longint;cdecl;external 'c' name 'forkpty'; diff --git a/mystic/mis_common.pas b/mystic/mis_common.pas index 089965d..6115413 100644 --- a/mystic/mis_common.pas +++ b/mystic/mis_common.pas @@ -6,15 +6,14 @@ Interface Uses m_Output, - m_Term_Ansi; - -{$I RECORDS.PAS} + m_Term_Ansi, + BBS_Records; Var - bbsConfig : RecConfig; TempPath : String; Console : TOutput; Term : TTermAnsi; + bbsConfig : RecConfig; Function SearchForUser (UN: String; Var Rec: RecUser; Var RecPos: LongInt) : Boolean; Function CheckAccess (User: RecUser; IgnoreGroup: Boolean; Str: String) : Boolean; diff --git a/mystic/mis_nodedata.pas b/mystic/mis_nodedata.pas index f7226ad..8b6b471 100644 --- a/mystic/mis_nodedata.pas +++ b/mystic/mis_nodedata.pas @@ -37,7 +37,8 @@ Implementation Uses m_FileIO, - m_Strings; + m_Strings, + BBS_Records; Procedure TNodeData.SynchronizeNodeData; Var diff --git a/mystic/mis_server.pas b/mystic/mis_server.pas index 2ddef71..c8efefd 100644 --- a/mystic/mis_server.pas +++ b/mystic/mis_server.pas @@ -9,7 +9,8 @@ Uses m_io_Base, m_io_Sockets, MIS_Common, - MIS_NodeData; + MIS_NodeData, + BBS_Records; Const MaxStatusText = 20; diff --git a/mystic/whatsnew.txt b/mystic/whatsnew.txt index 9f84e86..ec328a6 100644 --- a/mystic/whatsnew.txt +++ b/mystic/whatsnew.txt @@ -3604,4 +3604,7 @@ you have existing FTP names set for your file bases, you must open them in the file base editor for their names to be automatically changed. + + Users can now download QWK packets using the FTP server. A QWK packet + filename will be shown in all FTP listings. +