QWK and REP by FTP complete
This commit is contained in:
mysticbbs
parent
641bac34ef
commit
9ee5efdf96
|
|
@ -25,13 +25,16 @@ Const
|
|||
Function GetBaseConfiguration (UseEnv: Boolean; Var TempCfg: RecConfig) : Byte;
|
||||
Function PutBaseConfiguration (Var TempCfg: RecConfig) : Boolean;
|
||||
Function ShellDOS (ExecPath: String; Command: String) : LongInt;
|
||||
Function Addr2Str (Addr : RecEchoMailAddr) : String;
|
||||
|
||||
// MESSAGE BASE
|
||||
|
||||
Function MBaseOpenCreate (Var Msg: PMsgBaseABS; Var Area: RecMessageBase; TP: String) : Boolean;
|
||||
Function GetOriginLine (Var mArea: RecMessageBase) : String;
|
||||
Function GetMBaseByIndex (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
|
||||
Procedure GetMessageScan (UN: Cardinal; TempBase: RecMessageBase; Var TempScan: MScanRec);
|
||||
Procedure PutMessageScan (UN: Cardinal; TempBase: RecMessageBase; TempScan: MScanRec);
|
||||
Procedure MBaseAssignData (Var User: RecUser; Var Msg: PMsgBaseABS; Var TempBase: RecMessageBase);
|
||||
|
||||
// FILE BASE
|
||||
|
||||
|
|
@ -47,8 +50,87 @@ Implementation
|
|||
Uses
|
||||
DOS,
|
||||
m_FileIO,
|
||||
m_DateTime,
|
||||
m_Strings;
|
||||
|
||||
Function Addr2Str (Addr : RecEchoMailAddr) : String;
|
||||
Var
|
||||
Temp : String[20];
|
||||
Begin
|
||||
Temp := strI2S(Addr.Zone) + ':' + strI2S(Addr.Net) + '/' +
|
||||
strI2S(Addr.Node);
|
||||
|
||||
If Addr.Point <> 0 Then Temp := Temp + '.' + strI2S(Addr.Point);
|
||||
|
||||
Result := Temp;
|
||||
End;
|
||||
|
||||
Function GetOriginLine (Var mArea: RecMessageBase) : String;
|
||||
Var
|
||||
Loc : Byte;
|
||||
FN : String;
|
||||
TF : Text;
|
||||
Buf : Array[1..2048] of Char;
|
||||
Str : String;
|
||||
Count : LongInt;
|
||||
Pick : LongInt;
|
||||
Begin
|
||||
Result := '';
|
||||
Loc := Pos('@RANDOM=', strUpper(mArea.Origin));
|
||||
|
||||
If Loc > 0 Then Begin
|
||||
FN := strStripB(Copy(mArea.Origin, Loc + 8, 255), ' ');
|
||||
|
||||
If Pos(PathChar, FN) = 0 Then FN := bbsCfg.DataPath + FN;
|
||||
|
||||
FileMode := 66;
|
||||
|
||||
Assign (TF, FN);
|
||||
SetTextBuf (TF, Buf, SizeOf(Buf));
|
||||
|
||||
{$I-} Reset (TF); {$I+}
|
||||
|
||||
If IoResult <> 0 Then Exit;
|
||||
|
||||
Count := 0;
|
||||
|
||||
While Not Eof(TF) Do Begin
|
||||
ReadLn (TF, Str);
|
||||
|
||||
If strStripB(Str, ' ') = '' Then Continue;
|
||||
|
||||
Inc (Count);
|
||||
End;
|
||||
|
||||
If Count = 0 Then Begin
|
||||
Close (TF);
|
||||
Exit;
|
||||
End;
|
||||
|
||||
Pick := Random(Count) + 1;
|
||||
|
||||
Reset (TF);
|
||||
|
||||
Count := 0;
|
||||
|
||||
While Not Eof(TF) Do Begin
|
||||
ReadLn (TF, Str);
|
||||
|
||||
If strStripB(Str, ' ') = '' Then Continue;
|
||||
|
||||
Inc (Count);
|
||||
|
||||
If Count = Pick Then Begin
|
||||
Result := Str;
|
||||
Break;
|
||||
End;
|
||||
End;
|
||||
|
||||
Close (TF);
|
||||
End Else
|
||||
Result := mArea.Origin;
|
||||
End;
|
||||
|
||||
Function GetBaseConfiguration (UseEnv: Boolean; Var TempCfg: RecConfig) : Byte;
|
||||
Var
|
||||
TempFile : File;
|
||||
|
|
@ -220,6 +302,43 @@ Begin
|
|||
Result := True;
|
||||
End;
|
||||
|
||||
Procedure MBaseAssignData (Var User: RecUser; Var Msg: PMsgBaseABS; Var TempBase: RecMessageBase);
|
||||
Var
|
||||
SemFile : Text;
|
||||
Begin
|
||||
Msg^.StartNewMsg;
|
||||
|
||||
If TempBase.Flags And MBRealNames <> 0 Then
|
||||
Msg^.SetFrom(User.RealName)
|
||||
Else
|
||||
Msg^.SetFrom(User.Handle);
|
||||
|
||||
Msg^.SetLocal (True);
|
||||
|
||||
If TempBase.NetType > 0 Then Begin
|
||||
If TempBase.NetType = 3 Then
|
||||
Msg^.SetMailType(mmtNetMail)
|
||||
Else
|
||||
Msg^.SetMailType(mmtEchoMail);
|
||||
|
||||
Msg^.SetOrig(bbsCfg.NetAddress[TempBase.NetAddr]);
|
||||
|
||||
Case TempBase.NetType of
|
||||
1 : Assign (SemFile, bbsCfg.SemaPath + fn_SemFileEcho);
|
||||
2 : Assign (SemFile, bbsCfg.SemaPath + fn_SemFileNews);
|
||||
3 : Assign (SemFile, bbsCfg.SemaPath + fn_SemFileNet);
|
||||
End;
|
||||
|
||||
ReWrite (SemFile);
|
||||
Close (SemFile);
|
||||
End Else
|
||||
Msg^.SetMailType(mmtNormal);
|
||||
|
||||
Msg^.SetPriv (TempBase.Flags and MBPrivate <> 0);
|
||||
Msg^.SetDate (DateDos2Str(CurDateDos, 1));
|
||||
Msg^.SetTime (TimeDos2Str(CurDateDos, 0));
|
||||
End;
|
||||
|
||||
Function GetTotalFiles (Var TempBase: RecFileBase) : LongInt;
|
||||
Begin
|
||||
Result := 0;
|
||||
|
|
|
|||
|
|
@ -13,7 +13,8 @@ Uses
|
|||
BBS_MsgBase_Squish;
|
||||
|
||||
Const
|
||||
QWK_EOL = #13#10;
|
||||
QWK_EOL = #13#10;
|
||||
QWK_CONTROL = 'MYSTICQWK';
|
||||
|
||||
Type
|
||||
BSingle = Array [0..3] of Byte;
|
||||
|
|
@ -140,7 +141,7 @@ Begin
|
|||
Write (TempFile, 'DOOR = ' + mysSoftwareID + QWK_EOL);
|
||||
Write (TempFile, 'VERSION = ' + mysVersion + QWK_EOL);
|
||||
Write (TempFile, 'SYSTEM = ' + mysSoftwareID + ' ' + mysVersion + QWK_EOL);
|
||||
Write (TempFile, 'CONTROLNAME = MYSTICQWK' + QWK_EOL);
|
||||
Write (TempFile, 'CONTROLNAME = ' + QWK_CONTROL + QWK_EOL);
|
||||
Write (TempFile, 'CONTROLTYPE = ADD' + QWK_EOL);
|
||||
Write (TempFile, 'CONTROLTYPE = DROP' + QWK_EOL);
|
||||
Close (TempFile);
|
||||
|
|
@ -286,7 +287,7 @@ Begin
|
|||
While MsgBase^.SeekFound Do Begin
|
||||
|
||||
If Not IsNetworked Then
|
||||
If ((bbsCfg.QwkMaxBase > 0) and (MsgAdded = bbsCfg.QwkMaxBase)) or
|
||||
If ((bbsCfg.QwkMaxBase > 0) and (MsgAdded = bbsCfg.QwkMaxBase)) or
|
||||
((bbsCfg.QwkMaxPacket > 0) and (TotalMessages = bbsCfg.QwkMaxPacket)) Then Break;
|
||||
|
||||
MsgBase^.MsgStartUp;
|
||||
|
|
@ -453,13 +454,13 @@ Begin
|
|||
|
||||
If HasAccess(Self, MBase.ReadACS) Then Begin
|
||||
|
||||
GetMessageScan (UserNumber, MBase, MScan);
|
||||
GetMessageScan (UserNumber, MBase, MScan);
|
||||
|
||||
If MScan.QwkScan > 0 Then Begin
|
||||
Inc (TotalBases);
|
||||
If MScan.QwkScan > 0 Then Begin
|
||||
Inc (TotalBases);
|
||||
|
||||
QwkLR.Base := FilePos(MBaseFile);
|
||||
QwkLR.Pos := WriteMSGDAT;
|
||||
QwkLR.Base := FilePos(MBaseFile);
|
||||
QwkLR.Pos := WriteMSGDAT;
|
||||
|
||||
Write (QwkLRFile, QwkLR);
|
||||
End;
|
||||
|
|
@ -481,8 +482,190 @@ Begin
|
|||
End;
|
||||
|
||||
Function TQWKEngine.ProcessReply : Boolean;
|
||||
|
||||
Procedure QwkControl (Idx: LongInt; Mode: Byte);
|
||||
Var
|
||||
TempBase : RecMessageBase;
|
||||
TempScan : MScanRec;
|
||||
Begin
|
||||
If GetMBaseByIndex(Idx, TempBase) Then Begin
|
||||
GetMessageScan (UserNumber, TempBase, TempScan);
|
||||
|
||||
TempScan.QwkScan := Mode;
|
||||
|
||||
If Mode = 0 Then Inc (RepBaseDel);
|
||||
If Mode = 1 Then Inc (RepBaseAdd);
|
||||
|
||||
PutMessageScan (UserNumber, TempBase, TempScan);
|
||||
End;
|
||||
End;
|
||||
|
||||
Var
|
||||
QwkBlock : String[128];
|
||||
QwkHeader : QwkDATHdr;
|
||||
Chunks : SmallInt;
|
||||
Line : String;
|
||||
LineCount : SmallInt;
|
||||
IsControl : Boolean;
|
||||
GotControl : Boolean;
|
||||
ExtFile : Text;
|
||||
Count1 : SmallInt;
|
||||
Count2 : SmallInt;
|
||||
Begin
|
||||
Result := False;
|
||||
|
||||
DataFile := TFileBuffer.Create(4 * 1024);
|
||||
|
||||
If Not DataFile.OpenStream (FileFind(WorkPath + PacketID + '.msg'), 1, fmOpen, fmRWDN) Then Begin
|
||||
DataFile.Free;
|
||||
|
||||
DirClean (WorkPath, '');
|
||||
|
||||
Exit;
|
||||
End;
|
||||
|
||||
DataFile.ReadBlock(QwkBlock[1], 128);
|
||||
QwkBlock[0] := #128;
|
||||
|
||||
If Pos(strUpper(PacketID), strUpper(QwkBlock)) = 0 Then Begin
|
||||
DataFile.Free;
|
||||
|
||||
DirClean(WorkPath, '');
|
||||
|
||||
Exit;
|
||||
End;
|
||||
|
||||
While Not DataFile.EOF Do Begin
|
||||
DataFile.ReadBlock(QwkHeader, SizeOf(QwkHeader));
|
||||
|
||||
Move (QwkHeader.MsgNum, QwkBlock[1], 7);
|
||||
|
||||
QwkBlock[0] := #7;
|
||||
|
||||
If GetMBaseByIndex(strS2I(QwkBlock), MBase) Then Begin
|
||||
|
||||
If MBaseOpenCreate(MsgBase, MBase, WorkPath) Then Begin
|
||||
|
||||
MBaseAssignData(UserRecord, MsgBase, MBase);
|
||||
|
||||
QwkBlock[0] := #25;
|
||||
Move (QwkHeader.UpTo, QwkBlock[1], 25);
|
||||
MsgBase^.SetTo(strStripR(QwkBlock, ' '));
|
||||
|
||||
Move (QwkHeader.Subject, QwkBlock[1], 25);
|
||||
MsgBase^.SetSubj(strStripR(QwkBlock, ' '));
|
||||
|
||||
Move (QwkHeader.ReferNum, QwkBlock[1], 6);
|
||||
QwkBlock[0] := #6;
|
||||
|
||||
MsgBase^.SetRefer(strS2I(strStripR(QwkBlock, ' ')));
|
||||
|
||||
Move (QwkHeader.NumChunk, QwkBlock[1], 6);
|
||||
|
||||
Chunks := strS2I(QwkBlock) - 1;
|
||||
Line := '';
|
||||
LineCount := 0;
|
||||
IsControl := MsgBase^.GetTo = QWK_CONTROL;
|
||||
GotControl := False;
|
||||
|
||||
// disable control in network packets (for now?)
|
||||
|
||||
If IsNetworked Then
|
||||
IsControl := False;
|
||||
|
||||
If IsControl And ((MsgBase^.GetSubj = 'ADD') or (MsgBase^.GetSubj = 'DROP')) Then
|
||||
QwkControl (MBase.Index, Ord(MsgBase^.GetSubj = 'ADD'));
|
||||
|
||||
For Count1 := 1 to Chunks Do Begin
|
||||
DataFile.ReadBlock (QwkBlock[1], 128);
|
||||
|
||||
QwkBlock[0] := #128;
|
||||
QwkBlock := strStripR(QwkBlock, ' ');
|
||||
|
||||
For Count2 := 1 to Length(QwkBlock) Do Begin
|
||||
If QwkBlock[Count2] = #227 Then Begin
|
||||
Inc (LineCount);
|
||||
|
||||
If (LineCount < 4) and (Copy(Line, 1, 5) = 'From:') Then Begin
|
||||
GotControl := True;
|
||||
|
||||
// ignore from name unless its networked
|
||||
|
||||
If IsNetworked Then
|
||||
MsgBase^.SetTo(strStripB(Copy(Line, 6, Length(Line)), ' '));
|
||||
End Else
|
||||
If (LineCount < 4) and (Copy(Line, 1, 3) = 'To:') Then Begin
|
||||
MsgBase^.SetTo(strStripB(Copy(Line, 4, Length(Line)), ' '));
|
||||
GotControl := True;
|
||||
End Else
|
||||
If (LineCount < 4) and (Copy(Line, 1, 8) = 'Subject:') Then Begin
|
||||
MsgBase^.SetSubj(strStripB(Copy(Line, 9, Length(Line)), ' '));
|
||||
GotControl := True;
|
||||
End Else
|
||||
If GotControl And (Line = '') Then
|
||||
GotControl := False
|
||||
Else
|
||||
MsgBase^.DoStringLn(Line);
|
||||
|
||||
Line := '';
|
||||
End Else
|
||||
Line := Line + QwkBlock[Count2];
|
||||
End;
|
||||
End;
|
||||
|
||||
If Line <> '' Then
|
||||
MsgBase^.DoStringLn(Line);
|
||||
|
||||
If MBase.NetType > 0 Then Begin
|
||||
If IsNetworked Then Begin
|
||||
MsgBase^.DoStringLn (#13 + '--- ' + mysSoftwareID + '/QWK v' + mysVersion + ' (' + OSID + ')');
|
||||
MsgBase^.DoStringLn (' * Origin: ' + GetOriginLine(MBase));
|
||||
End Else Begin
|
||||
MsgBase^.DoStringLn (#13 + '--- ' + mysSoftwareID + '/QWK v' + mysVersion + ' (' + OSID + ')');
|
||||
MsgBase^.DoStringLn (' * Origin: ' + GetOriginLine(MBase) + ' (' + Addr2Str(MsgBase^.GetOrigAddr) + ')');
|
||||
End;
|
||||
End;
|
||||
|
||||
If Not IsControl Then Begin
|
||||
If HasAccess(Self, MBase.PostACS) Then Begin
|
||||
MsgBase^.WriteMsg;
|
||||
Inc (RepOK); // must increase user and history posts by repOK
|
||||
End Else
|
||||
Inc (RepFailed);
|
||||
End;
|
||||
|
||||
MsgBase^.CloseMsgBase;
|
||||
|
||||
Dispose (MsgBase, Done);
|
||||
End Else
|
||||
Inc (RepFailed);
|
||||
End Else
|
||||
Inc (RepFailed);
|
||||
End;
|
||||
|
||||
DataFile.Free;
|
||||
|
||||
Assign (ExtFile, FileFind(WorkPath + 'todoor.ext'));
|
||||
{$I-} Reset (ExtFile); {$I+}
|
||||
|
||||
If IoResult = 0 Then Begin
|
||||
While Not Eof(ExtFile) Do Begin
|
||||
ReadLn (ExtFile, Line);
|
||||
|
||||
If strWordGet(1, Line, ' ') = 'AREA' Then Begin
|
||||
QwkBlock := strWordGet(3, Line, ' ');
|
||||
|
||||
If Pos('a', QwkBlock) > 0 Then QwkControl(strS2I(strWordGet(2, Line, ' ')), 1);
|
||||
If Pos('D', QwkBlock) > 0 Then QwkControl(strS2I(strWordGet(2, Line, ' ')), 0);
|
||||
End;
|
||||
End;
|
||||
|
||||
Close (ExtFile);
|
||||
End;
|
||||
|
||||
DirClean (WorkPath, '');
|
||||
|
||||
Result := True;
|
||||
End;
|
||||
|
||||
End.
|
||||
|
|
|
|||
|
|
@ -4,10 +4,6 @@ Unit MIS_Client_FTP;
|
|||
|
||||
{.$DEFINE FTPDEBUG}
|
||||
|
||||
// does not send file/directory datestamps
|
||||
// does not support uploading (need to make bbs functions generic for this
|
||||
// and for mbbsutil -fupload command)
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
|
|
@ -54,15 +50,17 @@ Type
|
|||
Function OpenDataSession : Boolean;
|
||||
Procedure CloseDataSession;
|
||||
Procedure ResetSession;
|
||||
Procedure UpdateUserStats (TFBase: RecFileBase; FDir: RecFileList; DirPos: LongInt);
|
||||
Procedure UpdateUserStats (TFBase: RecFileBase; FDir: RecFileList; DirPos: LongInt; IsUpload: Boolean);
|
||||
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;
|
||||
Procedure SendFile (Str: String);
|
||||
Function RecvFile (Str: String; IsAppend: Boolean) : Boolean;
|
||||
|
||||
Function QWKCreatePacket : Boolean;
|
||||
Procedure QWKProcessREP;
|
||||
|
||||
Procedure cmdUSER;
|
||||
Procedure cmdPASS;
|
||||
|
|
@ -75,7 +73,7 @@ Type
|
|||
Procedure cmdLIST;
|
||||
Procedure cmdPWD;
|
||||
Procedure cmdRETR;
|
||||
Procedure cmdSTOR;
|
||||
Procedure cmdSTOR (IsAppend: Boolean);
|
||||
Procedure cmdSTRU;
|
||||
Procedure cmdMODE;
|
||||
Procedure cmdSYST;
|
||||
|
|
@ -161,17 +159,16 @@ Begin
|
|||
InTransfer := False;
|
||||
End;
|
||||
|
||||
Procedure TFTPServer.UpdateUserStats (TFBase: RecFileBase; FDir: RecFileList; DirPos: LongInt);
|
||||
Procedure TFTPServer.UpdateUserStats (TFBase: RecFileBase; FDir: RecFileList; DirPos: LongInt; IsUpload: Boolean);
|
||||
Var
|
||||
HistFile: File of RecHistory;
|
||||
History : RecHistory;
|
||||
FDirFile: File of RecFileList;
|
||||
UserFile: File of RecUser;
|
||||
HistFile : File of RecHistory;
|
||||
History : RecHistory;
|
||||
FDirFile : File of RecFileList;
|
||||
UserFile : File of RecUser;
|
||||
Begin
|
||||
Inc (FDir.Downloads);
|
||||
|
||||
// change to getuserbypos
|
||||
Assign (UserFile, bbsConfig.DataPath + 'users.dat');
|
||||
ioReset (UserFile, SizeOf(RecUser), fmReadWrite + fmDenyWrite);
|
||||
ioReset (UserFile, SizeOf(RecUser), fmRWDW);
|
||||
ioSeek (UserFile, UserPos - 1);
|
||||
ioRead (UserFile, User);
|
||||
|
||||
|
|
@ -179,28 +176,33 @@ Begin
|
|||
User.CallsToday := 0;
|
||||
User.DLsToday := 0;
|
||||
User.DLkToday := 0;
|
||||
User.TimeLeft := SecLevel.Time
|
||||
User.TimeLeft := SecLevel.Time;
|
||||
User.LastOn := CurDateDos;
|
||||
End;
|
||||
|
||||
// need to check if it were an upload and do things accordingly
|
||||
If IsUpload Then Begin
|
||||
Inc (User.ULs);
|
||||
Inc (User.ULk, FDir.Size DIV 1024);
|
||||
End Else Begin
|
||||
Inc (FDir.Downloads);
|
||||
Inc (User.DLs);
|
||||
Inc (User.DLsToday);
|
||||
Inc (User.DLk, FDir.Size DIV 1024);
|
||||
Inc (User.DLkToday, FDir.Size DIV 1024);
|
||||
|
||||
Inc (User.DLs);
|
||||
Inc (User.DLsToday);
|
||||
Inc (User.DLk, FDir.Size DIV 1024);
|
||||
Inc (User.DLkToday, FDir.Size DIV 1024);
|
||||
Assign (FDirFile, bbsConfig.DataPath + TFBase.FileName + '.dir');
|
||||
ioReset (FDirFile, SizeOf(RecFileList), fmRWDW);
|
||||
ioSeek (FDirFile, DirPos - 1);
|
||||
ioWrite (FDirFile, FDir);
|
||||
Close (FDirFile);
|
||||
End;
|
||||
|
||||
ioSeek (UserFile, UserPos - 1);
|
||||
ioWrite (UserFile, User);
|
||||
Close (UserFile);
|
||||
|
||||
Assign (FDirFile, bbsConfig.DataPath + TFBase.FileName + '.dir');
|
||||
ioReset (FDirFile, SizeOf(RecFileList), fmReadWrite + fmDenyWrite);
|
||||
ioSeek (FDirFile, DirPos - 1);
|
||||
ioWrite (FDirFile, FDir);
|
||||
Close (FDirFile);
|
||||
|
||||
Assign (HistFile, bbsConfig.DataPath + 'history.dat');
|
||||
ioReset (HistFile, SizeOf(RecHistory), fmReadWrite + fmDenyWrite);
|
||||
ioReset (HistFile, SizeOf(RecHistory), fmRWDW);
|
||||
|
||||
If IoResult <> 0 Then ReWrite(HistFile);
|
||||
|
||||
|
|
@ -217,11 +219,17 @@ Begin
|
|||
|
||||
If Eof(HistFile) Then Begin
|
||||
FillChar(History, SizeOf(History), 0);
|
||||
|
||||
History.Date := CurDateDos;
|
||||
End;
|
||||
|
||||
Inc (History.Downloads, 1);
|
||||
Inc (History.DownloadKB, FDir.Size DIV 1024);
|
||||
If IsUpload Then Begin
|
||||
Inc (History.Uploads);
|
||||
Inc (History.UploadKB, FDir.Size DIV 1024);
|
||||
End Else Begin
|
||||
Inc (History.Downloads);
|
||||
Inc (History.DownloadKB, FDir.Size DIV 1024);
|
||||
End;
|
||||
|
||||
ioWrite (HistFile, History);
|
||||
Close (HistFile);
|
||||
|
|
@ -282,6 +290,7 @@ Begin
|
|||
|
||||
If DataSocket <> NIL Then Begin
|
||||
Client.WriteLine(re_DataOpen);
|
||||
|
||||
Result := True;
|
||||
Exit;
|
||||
End;
|
||||
|
|
@ -301,6 +310,7 @@ Begin
|
|||
If Not Assigned(DataSocket) Then Begin
|
||||
WaitSock.Free;
|
||||
Client.WriteLine(re_NoData);
|
||||
|
||||
Exit;
|
||||
End;
|
||||
|
||||
|
|
@ -312,6 +322,7 @@ Begin
|
|||
Client.WriteLine(re_NoData);
|
||||
DataSocket.Free;
|
||||
DataSocket := NIL;
|
||||
|
||||
Exit;
|
||||
End;
|
||||
End;
|
||||
|
|
@ -420,6 +431,57 @@ Begin
|
|||
End;
|
||||
End;
|
||||
|
||||
Function TFTPServer.RecvFile (Str: String; IsAppend: Boolean) : Boolean;
|
||||
Var
|
||||
F : File;
|
||||
Buf : Array[1..FileXferSize] of Byte;
|
||||
Res : LongInt;
|
||||
Begin
|
||||
Result := False;
|
||||
|
||||
If FileExist(Str) And Not IsAppend Then Begin
|
||||
Client.WriteLine(re_BadFile);
|
||||
|
||||
Exit;
|
||||
End;
|
||||
|
||||
If Not OpenDataSession Then Exit;
|
||||
|
||||
Server.Status ('Receiving: ' + Str);
|
||||
|
||||
InTransfer := True;
|
||||
Result := True;
|
||||
|
||||
Assign (F, Str);
|
||||
|
||||
If FileExist(Str) And IsAppend Then Begin
|
||||
Reset (F, 1);
|
||||
Seek (F, FileSize(F));
|
||||
End Else Begin
|
||||
ReWrite (F, 1);
|
||||
|
||||
IsAppend := False;
|
||||
End;
|
||||
|
||||
Repeat
|
||||
Res := DataSocket.ReadBuf(Buf[1], SizeOf(Buf));
|
||||
|
||||
If Res > 0 Then
|
||||
BlockWrite (F, Buf[1], Res)
|
||||
Else
|
||||
Break;
|
||||
Until False;
|
||||
|
||||
Close (F);
|
||||
|
||||
If Result Then
|
||||
Client.WriteLine (re_XferOK);
|
||||
|
||||
CloseDataSession;
|
||||
|
||||
InTransfer := False;
|
||||
End;
|
||||
|
||||
Procedure TFTPServer.SendFile (Str: String);
|
||||
Var
|
||||
F : File;
|
||||
|
|
@ -434,11 +496,14 @@ Begin
|
|||
|
||||
OpenDataSession;
|
||||
|
||||
Server.Status('Sending: ' + Str);
|
||||
|
||||
While Not Eof(F) Do Begin
|
||||
BlockRead (F, Buf, SizeOf(Buf), Res);
|
||||
|
||||
Repeat
|
||||
Tmp := DataSocket.WriteBuf(Buf, Res);
|
||||
|
||||
Dec (Res, Tmp);
|
||||
Until Res <= 0;
|
||||
End;
|
||||
|
|
@ -475,10 +540,33 @@ Begin
|
|||
QWK.UpdateLastReadPointers;
|
||||
QWK.Free;
|
||||
|
||||
Server.Status ('Created packet in ' + TempPath);
|
||||
|
||||
ExecuteArchive (TempPath, TempPath + GetQWKName + '.qwk', User.Archive, TempPath + '*', 1);
|
||||
SendFile (TempPath + GetQWKName + '.qwk');
|
||||
|
||||
DirClean (TempPath, '');
|
||||
End;
|
||||
|
||||
Procedure TFTPServer.QWKProcessREP;
|
||||
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.
|
||||
|
||||
RecvFile (TempPath + GetQWKName + '.rep', False);
|
||||
ExecuteArchive (TempPath, TempPath + GetQWKName + '.rep', User.Archive, '*', 2);
|
||||
|
||||
QWK := TQwkEngine.Create(TempPath, GetQWKName, UserPos, User);
|
||||
|
||||
QWK.HasAccess := @QWKHasAccess;
|
||||
QWK.IsNetworked := User.Flags AND UserQWKNetwork <> 0;
|
||||
QWK.IsExtended := User.QwkExtended;
|
||||
|
||||
QWK.ProcessReply;
|
||||
QWK.Free;
|
||||
|
||||
// update user stats posts and bbs history if not networked
|
||||
End;
|
||||
|
||||
Procedure TFTPServer.cmdUSER;
|
||||
|
|
@ -737,7 +825,7 @@ Begin
|
|||
If (Dir.Flags And FDirDeleted <> 0) Then Continue;
|
||||
If (Dir.Flags and FDirOffline <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeOffline)) Then Continue;
|
||||
If (Dir.Flags And FDirInvalid <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeUnvalid)) Then Continue;
|
||||
If (Dir.Flags And FDirFailed <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeFailed)) Then Continue;
|
||||
If (Dir.Flags And FDirFailed <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeFailed)) Then Continue;
|
||||
|
||||
If WildMatch(FileMask, Dir.FileName, False) Then
|
||||
DataSocket.WriteLine('-rw-r--r-- 1 ftp ftp ' + strPadL(strI2S(Dir.Size), 13, ' ') + ' ' + GetFTPDate(Dir.DateTime) + ' ' + Dir.FileName)
|
||||
|
|
@ -753,7 +841,7 @@ Begin
|
|||
Client.WriteLine(re_BadCommand);
|
||||
End;
|
||||
|
||||
Procedure TFTPServer.cmdSTOR;
|
||||
Procedure TFTPServer.cmdSTOR (IsAppend: Boolean);
|
||||
Var
|
||||
TempPos : LongInt;
|
||||
TempBase : RecFileBase;
|
||||
|
|
@ -764,6 +852,12 @@ Begin
|
|||
Exit;
|
||||
End;
|
||||
|
||||
If strUpper(Data) = strUpper(GetQWKName + '.rep') Then Begin
|
||||
QWKProcessREP;
|
||||
|
||||
Exit;
|
||||
End;
|
||||
|
||||
TempPos := FindDirectory(TempBase);
|
||||
|
||||
If (TempPos = -1) Or Not ValidDirectory(TempBase) Then Begin
|
||||
|
|
@ -772,17 +866,27 @@ Begin
|
|||
Exit;
|
||||
End;
|
||||
|
||||
Client.WriteLine(re_BadFile);
|
||||
server.status('calling recvfile');
|
||||
|
||||
//reasons why i haven't finished this (todo):
|
||||
RecvFile ('d:\code\mystic1\temp0\infile.tmp', IsAppend);
|
||||
|
||||
// ratios
|
||||
// diskspace
|
||||
// Client.WriteLine(re_BadFile);
|
||||
|
||||
// dreadful things required to do for upload process:
|
||||
|
||||
// find upload base
|
||||
// check diskspace
|
||||
// check slowmedia
|
||||
// check access
|
||||
// check filename length
|
||||
// duplicate file checking
|
||||
// get file
|
||||
// update user statistics
|
||||
// update history statistics
|
||||
// archive testing
|
||||
// file_id.diz importing
|
||||
// forcing uploads to upload base (if non-zero)
|
||||
// duplicate file checking
|
||||
// upload statistic tracking
|
||||
|
||||
// other things: add no desc and ftp test batch to configuration?
|
||||
End;
|
||||
|
||||
Procedure TFTPServer.cmdRETR;
|
||||
|
|
@ -818,6 +922,7 @@ Begin
|
|||
|
||||
If WildMatch(FileMask, Dir.FileName, False) Then Begin
|
||||
Found := DirFile.FilePosRecord;
|
||||
|
||||
Break;
|
||||
End;
|
||||
End;
|
||||
|
|
@ -833,7 +938,7 @@ Begin
|
|||
Case CheckFileLimits(TempBase, Dir) of
|
||||
0 : Begin
|
||||
SendFile (TempBase.Path + Dir.FileName);
|
||||
UpdateUserStats (TempBase, Dir, Found);
|
||||
UpdateUserStats (TempBase, Dir, Found, False);
|
||||
End;
|
||||
1 : Client.WriteLine(re_NoAccess);
|
||||
2 : Client.WriteLine(re_DLLimit);
|
||||
|
|
@ -956,6 +1061,7 @@ Begin
|
|||
Server.Status ('Cmd: ' + Cmd + ' Data: ' + Data);
|
||||
{$ENDIF}
|
||||
|
||||
//If Cmd = 'APPE' Then cmdSTOR(True) Else
|
||||
If Cmd = 'CDUP' Then cmdCDUP Else
|
||||
If Cmd = 'CWD' Then cmdCWD Else
|
||||
If Cmd = 'DELE' Then Client.WriteLine(re_NoAccess) Else
|
||||
|
|
@ -974,7 +1080,8 @@ Begin
|
|||
If Cmd = 'RETR' Then cmdRETR Else
|
||||
If Cmd = 'RMD' Then Client.WriteLine(re_NoAccess) Else
|
||||
If Cmd = 'SIZE' Then cmdSIZE Else
|
||||
If Cmd = 'STOR' Then cmdSTOR Else
|
||||
If Cmd = 'STOR' Then cmdSTOR(False) Else
|
||||
// implement STOU which in turn calls cmdSTOR after getting filename
|
||||
If Cmd = 'STRU' Then cmdSTRU Else
|
||||
If Cmd = 'SYST' Then cmdSYST Else
|
||||
If Cmd = 'TYPE' Then cmdTYPE Else
|
||||
|
|
|
|||
|
|
@ -3605,6 +3605,12 @@
|
|||
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.
|
||||
filename will be shown in all FTP listings. If the user is flagged as a
|
||||
FTP network account, their handle will be used as the BBSID for the QWK
|
||||
packet (handle.qwk).
|
||||
|
||||
+ Users can now upload QWK reply packets using the FTP server. If the user
|
||||
is flagged as a FTP network account, their reply packet will need to be
|
||||
"handle.rep".
|
||||
|
||||
<ALPHA 37 RELEASED>
|
||||
|
|
|
|||
Loading…
Reference in New Issue