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

FTP QWK download

This commit is contained in:
mysticbbs 2013-09-01 01:42:24 -04:00
parent f8ba97804e
commit 641bac34ef
13 changed files with 204 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
mystic/bbs_database.pas
View File

@ -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);

70
mystic/bbs_msgbase_qwk.pas
View File

@ -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,12 +400,33 @@ 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;
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);

3
mystic/mis.pas
View File

@ -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;

3
mystic/mis_client_binkp.pas
View File

@ -14,7 +14,8 @@ Uses
m_Protocol_Queue,
MIS_Server,
MIS_NodeData,
MIS_Common;
MIS_Common,
BBS_Records;
Const
M_NUL = 0;

61
mystic/mis_client_ftp.pas
View File

@ -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);

3
mystic/mis_client_nntp.pas
View File

@ -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;

3
mystic/mis_client_pop3.pas
View File

@ -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;

3
mystic/mis_client_smtp.pas
View File

@ -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;

3
mystic/mis_client_telnet.pas
View File

@ -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';

7
mystic/mis_common.pas
View File

@ -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;

3
mystic/mis_nodedata.pas
View File

@ -37,7 +37,8 @@ Implementation
Uses
m_FileIO,
m_Strings;
m_Strings,
BBS_Records;
Procedure TNodeData.SynchronizeNodeData;
Var

3
mystic/mis_server.pas
View File

@ -9,7 +9,8 @@ Uses
m_io_Base,
m_io_Sockets,
MIS_Common,
MIS_NodeData;
MIS_NodeData,
BBS_Records;
Const
MaxStatusText = 20;

3
mystic/whatsnew.txt
View File

@ -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.
<ALPHA 37 RELEASED>