mysticbbs/mystic/mis_client_ftp.pas

// ====================================================================
// Mystic BBS Software               Copyright 1997-2013 By James Coyle
// ====================================================================
//
// This file is part of Mystic BBS.
//
// Mystic BBS is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
// (at your option) any later version.
//
// Mystic BBS is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with Mystic BBS.  If not, see <http://www.gnu.org/licenses/>.
//
// ====================================================================

Unit MIS_Client_FTP;

{$I M_OPS.PAS}

{.$DEFINE FTPDEBUG}

Interface

Uses
  DOS,
  SysUtils,  //for wordrec only?
  m_io_Base,
  m_io_Sockets,
  m_Strings,
  m_FileIO,
  m_DateTime,
  MIS_Server,
  MIS_NodeData,
  MIS_Common,
  BBS_Records,
  BBS_DataBase;

Function CreateFTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;

Type
  TFTPServer = Class(TServerClient)
    Server     : TServerManager;
    UserName   : String[40];
    Password   : String[20];
    LoggedIn   : Boolean;
    GotQuit    : Boolean;
    IsPassive  : Boolean;
    InTransfer : Boolean;
    Cmd        : String;
    Data       : String;
    DataPort   : Word;
    DataIP     : String;
    DataSocket : TIOSocket;
    User       : RecUser;
    UserPos    : LongInt;
    FBasePos   : LongInt;
    FBase      : RecFileBase;
    SecLevel   : RecSecurity;
    FileMask   : String;

    Constructor Create (Owner: TServerManager; CliSock: TIOSocket);
    Procedure   Execute; Override;
    Destructor  Destroy; Override;

    Function    OpenDataSession : Boolean;
    Procedure   CloseDataSession;
    Procedure   ResetSession;
    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    GetFTPDate      (DD: LongInt) : String;
    Function    SendFile        (Str: String) : Boolean;
    Function    RecvFile        (Str: String; IsAppend: Boolean) : Boolean;

    Function    QWKCreatePacket : Boolean;
    Procedure   QWKProcessREP;

    Procedure   cmdUSER;
    Procedure   cmdPASS;
    Procedure   cmdREIN;
    Procedure   cmdPORT;
    Procedure   cmdPASV;
    Procedure   cmdCWD;
    Procedure   cmdCDUP;
    Procedure   cmdNLST;
    Procedure   cmdLIST;
    Procedure   cmdPWD;
    Procedure   cmdRETR;
    Procedure   cmdSTOR (IsAppend: Boolean);
    Procedure   cmdSTRU;
    Procedure   cmdMODE;
    Procedure   cmdSYST;
    Procedure   cmdTYPE;
    Procedure   cmdEPRT;
    Procedure   cmdEPSV;
    Procedure   cmdSIZE;
  End;

Implementation

Uses
  BBS_MsgBase_QWK;

Const
  FileBufSize    =  4 * 1024;
  FileXferSize   = 32 * 1024;

  re_DataOpen    = '125 Data connection already open';
  re_DataOpening = '150 File status okay; about to open data connection.';
  re_CommandOK   = '200 Command okay.';
  re_NoCommand   = '202 Command not implemented, superfluous at this site.';
  re_Greeting    = '220 Mystic FTP server ready';
  re_Goodbye     = '221 Goodbye';
  re_DataClosed  = '226 Closing data connection.';
  re_XferOK      = '226 Transfer OK';
  re_PassiveOK   = '227 Entering Passive Mode ';
  re_LoggedIn    = '230 User logged in, proceed.';
  re_DirOkay     = '250 Working directory is now ';
  re_UserOkay    = '331 User name okay, need password.';
  re_NoData      = '425 Unable to open data connection';
  re_BadCommand  = '503 Bad sequence of commands.';
//  re_UserUnknown = '530 Not logged in.';
  re_BadPW       = '530 Invalid login';
  re_BadDir      = '550 Directory change failed';
  re_BadFile     = '550 File not found';
  re_NoAccess    = '550 Access denied';
  re_DLLimit     = '550 Download limit would be exceeded';
  re_DLRatio     = '550 Download/upload ratio would be exceeded';

{$IFDEF FTPDEBUG}
Procedure LOG (Str: String);
Var
  T : Text;
Begin
  Assign (T, 'ftpdebug.txt');
  {$I-} Append(T); {$I+}

  If IoResult <> 0 Then ReWrite(T);

  WriteLn(T, Str);

  Close(T);
End;
{$ENDIF}

Function CreateFTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Begin
  Result := TFTPServer.Create(Owner, CliSock);
End;

Constructor TFTPServer.Create (Owner: TServerManager; CliSock: TIOSocket);
Begin
  Inherited Create(Owner, CliSock);

  Server := Owner;
End;

Procedure TFTPServer.ResetSession;
Begin
  If Assigned(DataSocket) Then DataSocket.Free;

  LoggedIn   := False;
  GotQuit    := False;
  UserName   := '';
  Password   := '';
  UserPos    := -1;
  DataIP     := '';
  DataPort   := Random(bbsCfg.inetFTPPortMax - bbsCfg.inetFTPPortMin) + bbsCfg.inetFTPPortMin;
  DataSocket := NIL;
  IsPassive  := False;
  FBasePos   := -1;
  InTransfer := False;
End;

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;
Begin
  // change to getuserbypos
  Assign  (UserFile, bbsCfg.DataPath + 'users.dat');
  ioReset (UserFile, SizeOf(RecUser), fmRWDW);
  ioSeek  (UserFile, UserPos - 1);
  ioRead  (UserFile, User);

  If DateDos2Str(User.LastOn, 1) <> DateDos2Str(CurDateDos, 1) Then Begin
    User.CallsToday := 0;
    User.DLsToday   := 0;
    User.DLkToday   := 0;
    User.TimeLeft   := SecLevel.Time;
    User.LastOn     := CurDateDos;
  End;

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

    Assign  (FDirFile, bbsCfg.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  (HistFile, bbsCfg.DataPath + 'history.dat');
  ioReset (HistFile, SizeOf(RecHistory), fmRWDW);

  If IoResult <> 0 Then ReWrite(HistFile);

  History.Date := CurDateDos;

  While Not Eof(HistFile) Do Begin
    ioRead (HistFile, History);

    If DateDos2Str(History.Date, 1) = DateDos2Str(CurDateDos, 1) Then Begin
      ioSeek (HistFile, FilePos(HistFile) - 1);
      Break;
    End;
  End;

  If Eof(HistFile) Then Begin
    FillChar(History, SizeOf(History), 0);

    History.Date := CurDateDos;
  End;

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

Function TFTPServer.CheckFileLimits (TempFBase: RecFileBase; FDir: RecFileList) : Byte;
{ 0 = OK to download }
{ 1 = Offline or Invalid or Failed or NO ACCESS or no file (prompt 224)}
{ 2 = DL per day limit exceeded (prompt 58) }
{ 3 = UL/DL file ratio bad (prompt 211) }
Begin
  Result := 1;

  If Not FileExist(TempFBase.Path + FDir.Filename) Then Exit;

  If Not CheckAccess(User, True, TempFBase.DLACS) Then Exit;

  If FDir.Flags And FDirOffline <> 0 Then Exit;

  If (FDir.Flags And FDirInvalid <> 0) And Not CheckAccess(User, True, bbsCfg.AcsDLUnvalid) Then Exit;
  If (FDir.Flags And FDirFailed  <> 0) And Not CheckAccess(User, True, bbsCfg.AcsDLFailed)  Then Exit;

  If (FDir.Flags And FDirFree <> 0) or (User.Flags and UserNoRatio <> 0) or (TempFBase.Flags and FBFreeFiles <> 0) Then Begin
    Result := 0;
    Exit;
  End;

  If (User.DLsToday + 1 > SecLevel.MaxDLs) and (SecLevel.MaxDLs > 0) Then Begin
    Result := 2;
    Exit;
  End;

  If (SecLevel.DLRatio > 0) and ((User.DLs <> 0) or (User.ULs <> 0)) Then
    If (User.ULs * SecLevel.DLRatio) <= (User.DLs + 1) Then Begin
      Result := 3;
      Exit;
    End;

  If (SecLevel.DLKRatio > 0) and ((User.DLs <> 0) or (User.ULs <> 0)) Then
    If (User.ULk * SecLevel.DLkRatio) <= (User.DLk + (FDir.Size DIV 1024)) Then Begin
      Result := 3;
      Exit;
    End;

  If (User.DLkToday + (FDir.Size DIV 1024) > SecLevel.MaxDLk) and (SecLevel.MaxDLk > 0) Then Begin
    Result := 2;
    Exit;
  End;

  Result := 0;
End;

Function TFTPServer.OpenDataSession : Boolean;
Var
  WaitSock : TIOSocket;
Begin
  Result := False;

  If DataSocket <> NIL Then Begin
    Client.WriteLine(re_DataOpen);

    Result := True;
    Exit;
  End;

  Client.WriteLine(re_DataOpening);

  If IsPassive Then Begin
    WaitSock := TIOSocket.Create;

    WaitSock.FTelnetServer := False;
    WaitSock.FTelnetClient := False;

    WaitSock.WaitInit(bbsCfg.inetInterface, DataPort);

    DataSocket := WaitSock.WaitConnection(10000);

    If Not Assigned(DataSocket) Then Begin
      WaitSock.Free;
      Client.WriteLine(re_NoData);

      Exit;
    End;

    WaitSock.Free;
  End Else Begin
    DataSocket := TIOSocket.Create;

    If Not DataSocket.Connect(DataIP, DataPort) Then Begin
      Client.WriteLine(re_NoData);
      DataSocket.Free;
      DataSocket := NIL;

      Exit;
    End;
  End;

  Result := True;
End;

Procedure TFTPServer.CloseDataSession;
Begin
  If DataSocket <> NIL Then Begin
    Client.WriteLine(re_DataClosed);
    DataSocket.Free;
    DataSocket := NIL;
  End;
End;

Function TFTPServer.ValidDirectory (TempBase: RecFileBase) : Boolean;
Begin
  Result := CheckAccess(User, True, TempBase.FtpACS) and (TempBase.FtpName <> '');
End;

Function TFTPServer.FindDirectory (Var TempBase: RecFileBase) : LongInt;
Var
  FBaseFile : TFileBuffer;
  Found     : Boolean;
Begin
  Result   := FBasePos;
  TempBase := FBase;
  FileMask := '*.*';

  If Not LoggedIn Then Exit;
  If Data = '' Then Exit;

  If (Pos('*', Data) > 0) or (Pos('.', Data) > 0) Then Begin
    FileMask := JustFile(Data);
    Data     := JustPath(Data);
  End;

  If Data = '/' Then Begin
    Result := -1;
    Exit;
  End;

  If ((Data[1] = '/') or (Data[1] = '\')) Then Delete(Data, 1, 1);
  If ((Data[Length(Data)] = '/') or (Data[Length(Data)] = '\')) Then Delete(Data, Length(Data), 1);

  If Data = '' Then Exit;

  FBaseFile := TFileBuffer.Create(FileBufSize);

  If FBaseFile.OpenStream (bbsCfg.DataPath + 'fbases.dat', SizeOf(TempBase), fmOpen, fmRWDN) Then Begin
    Found := False;

    While Not FBaseFile.EOF Do Begin
      FBaseFile.ReadRecord (TempBase);

      If (strUpper(TempBase.FtpName) = strUpper(Data)) and ValidDirectory(TempBase) Then Begin
        Result := FBaseFile.FilePosRecord;
        Found  := True;
        Break;
      End;
    End;
  End;

  FBaseFile.Free;

  If Not Found Then Begin
    If Pos('-', Data) > 0 Then
      FileMask := '*.*'
    Else
      FileMask := Data;

    TempBase := FBase;
    Result   := FBasePos;
  End;
End;

Function TFTPServer.GetFTPDate (DD: LongInt) : String;
Var
  Today  : DateTime;
  TempDT : DateTime;
Begin
  Today := CurDateDT;

  If DD = 0 Then DD := CurDateDos;

  UnPackTime (DD, TempDT);

  Result := FormatDate(TempDT, 'NNN DD ');

  If TempDT.Year = Today.Year Then
    Result := Result + FormatDate(TempDT, 'HH:II')
  Else
    Result := Result + FormatDate(TempDT, ' YYYY');
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 (ProcessID, 'Receiving: ' + Str);

  InTransfer := True;
  Result     := True;

  Assign (F, Str);

  If FileExist(Str) And IsAppend Then Begin
    ioReset (F, 1, fmRWDW);
    Seek    (F, FileSize(F));
  End Else Begin
    ioReWrite (F, 1, fmRWDW);

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

  Server.Status(ProcessID, 'Receive complete');

  If Result Then
    Client.WriteLine (re_XferOK);

  CloseDataSession;

  InTransfer := False;
End;

Function TFTPServer.SendFile (Str: String) : Boolean;
Var
  F   : File;
  Buf : Array[1..FileXferSize] of Byte;
  Tmp : LongInt;
  Res : LongInt;
Begin
  Assign  (F, Str);
  ioReset (F, 1, fmRWDN);

  InTransfer := True;

  OpenDataSession;

  Server.Status(ProcessID, '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;

  Close (F);

  Result := Res = 0;

  // need to send failed here if failed what do we send?

  Server.Status(ProcessID, 'Send complete');
  Client.WriteLine (re_XferOK);

  CloseDataSession;

  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, bbsCfg.QwkBBSID, UserPos, User);

  QWK.HasAccess   := @QWKHasAccess;
  QWK.IsNetworked := (User.Flags AND UserQWKNetwork <> 0);
  QWK.IsExtended  := User.QwkExtended;

  QWK.ExportPacket(False);

  Server.Status  (ProcessID, 'Exported ' + strI2S(QWK.TotalMessages) + ' msgs@' + bbsCfg.QwkBBSID + '.qwk');
  ExecuteArchive (TempPath, TempPath + bbsCfg.QwkBBSID + '.qwk', User.Archive, TempPath + '*', 1);

  Result := SendFile (TempPath + bbsCfg.QwkBBSID + '.qwk');

  If Result Then
    QWK.UpdateLastReadPointers;

  QWK.Free;

  DirClean (TempPath, '');
End;

Procedure TFTPServer.QWKProcessREP;
Var
  QWK : TQwkEngine;
Begin
  // need to change temppath to a unique directory created for this
  // ftp instance.  we can use the new session ID for this

  RecvFile       (TempPath + bbsCfg.QwkBBSID + '.rep', False);
  ExecuteArchive (TempPath, TempPath + bbsCfg.QwkBBSID + '.rep', User.Archive, '*', 2);

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

(*
// works with google chrome auth, not IE
Procedure TFTPServer.cmdUSER;
Begin
  ResetSession;

  If SearchForUser(Data, User, UserPos) Then Begin
    Client.WriteLine(re_UserOkay);

    UserName := Data;
  End Else
    Client.WriteLine(re_BadPW);
End;
*)
// works with IE for auth prompt, not chrome
Procedure TFTPServer.cmdUSER;
Begin
  ResetSession;

  If SearchForUser(Data, User, UserPos, '') Then
    UserName := Data
  Else
    UserPos := -1;

  Client.WriteLine(re_UserOkay);
End;
(*
Procedure TFTPServer.cmdPASS;
Begin
  If (UserName = '') or (UserPos = -1) Then Begin
    Client.WriteLine(re_BadCommand);
    Exit;
  End;

  If strUpper(Data) = User.Password Then Begin
    LoggedIn := True;

    Client.WriteLine(re_LoggedIn);

    GetSecurityLevel(User.Security, SecLevel);

    Server.Status (ProcessID, User.Handle + ' logged in');
  End Else
    Client.WriteLine(re_BadPW);
End;
*)

Procedure TFTPServer.cmdPASS;
Begin
  If UserName = '' Then Begin
    Client.WriteLine ('332 No account');
    Exit;
  End;

  If (UserPos <> -1) and (strUpper(Data) = User.Password) Then Begin
    LoggedIn := True;

    Client.WriteLine(re_LoggedIn);

    GetSecurityLevel(User.Security, SecLevel);

    Server.Status (ProcessID, User.Handle + ' logged in');
  End Else
    Client.WriteLine(re_BadPW);
End;

Procedure TFTPServer.cmdREIN;
Begin
  ResetSession;

  If Not Client.WriteFile('220', bbsCfg.DataPath + 'ftpbanner.txt') Then
    Client.WriteLine (re_Greeting);
End;

Procedure TFTPServer.cmdPORT;
Var
  Count : Byte;
Begin
  If LoggedIn Then Begin
    For Count := 1 to 3 Do
      Data[Pos(',', Data)] := '.';

    DataIP := Copy(Data, 1, Pos(',', Data) - 1);

    Delete (Data, 1, Pos(',', Data));

    WordRec(DataPort).Hi := strS2I(Copy(Data, 1, Pos(',', Data) - 1));
    WordRec(DataPort).Lo := strS2I(Copy(Data, Pos(',', Data) + 1, Length(Data)));

    Client.WriteLine(re_CommandOK);

    IsPassive := False;
  End Else
    Client.WriteLine(re_BadCommand);
End;

Procedure TFTPServer.cmdPASV;
Var
  WaitSock : TIOSocket;
Begin
  If LoggedIn Then Begin
    If Not bbsCfg.inetFTPPassive Then Begin
      Client.WriteLine(re_BadCommand);
      Exit;
    End;

    DataPort := Random(bbsCfg.inetFTPPortMax - bbsCfg.inetFTPPortMin) + bbsCfg.inetFTPPortMin;

    {$IFDEF FTPDEBUG}
      LOG('PASV on host ' + Client.HostIP + ' port ' + strI2S(DataPort));

      Server.Status(ProcessID, re_PassiveOK + '(' + strReplace(Client.HostIP, '.', ',') + ',' + strI2S(WordRec(DataPort).Hi) + ',' + strI2S(WordRec(DataPort).Lo) + ').');
    {$ENDIF}

    Client.WriteLine(re_PassiveOK + '(' + strReplace(Client.HostIP, '.', ',') + ',' + strI2S(WordRec(DataPort).Hi) + ',' + strI2S(WordRec(DataPort).Lo) + ').');

    IsPassive := True;

    WaitSock  := TIOSocket.Create;

    WaitSock.FTelnetServer := False;
    WaitSock.FTelnetClient := False;

    WaitSock.WaitInit(bbsCfg.inetInterface, DataPort);

    DataSocket := WaitSock.WaitConnection(10000);

    WaitSock.Free;
  End Else
    Client.WriteLine(re_BadCommand);
End;

Procedure TFTPServer.cmdCDUP;
Begin
  Client.WriteLine(re_DirOkay + '"/"');

  FBasePos := -1;
End;

Procedure TFTPServer.cmdCWD;
Var
  TempBase  : RecFileBase;
  TempPos   : LongInt;
Begin
  If LoggedIn Then Begin
    If (Data = '/') or (Copy(Data, 1, 2) = '..') Then Begin
      FBasePos := -1;

      Client.WriteLine(re_DirOkay + '"/"');

      Exit;
    End;

    TempPos := FindDirectory(TempBase);

    If (TempPos = -1) Or Not ValidDirectory(TempBase) Then Begin
      Client.WriteLine(re_BadDir);

      Exit;
    End;

    Client.WriteLine(re_DirOkay + '"/' + TempBase.FtpName + '"');

    FBase    := TempBase;
    FBasePos := TempPos;
  End Else
    Client.WriteLine(re_BadCommand);
End;

Procedure TFTPServer.cmdNLST;
Var
  TempBase : RecFileBase;
  TempPos  : LongInt;
  DirFile  : TFileBuffer;
  Dir      : RecFileList;
Begin
  If LoggedIn Then Begin
    TempPos := FindDirectory(TempBase);

    If (TempPos = -1) Or Not ValidDirectory(TempBase) Then Begin
      OpenDataSession;
      CloseDataSession;

      Exit;
    End;

    OpenDataSession;

    If Not bbsCfg.inetFTPHideQWK Then
      DataSocket.WriteLine(bbsCfg.QwkBBSID + '.qwk');

    DirFile := TFileBuffer.Create(FileBufSize);

    If DirFile.OpenStream (bbsCfg.DataPath + TempBase.FileName + '.dir', SizeOf(RecFileList), fmOpenCreate, fmRWDN) Then Begin
      While Not DirFile.EOF Do Begin
        DirFile.ReadRecord (Dir);

        If (Dir.Flags And FDirDeleted <> 0) Then Continue;
        If (Dir.Flags And FDirInvalid <> 0) And (Not CheckAccess(User, True, bbsCfg.AcsSeeUnvalid)) Then Continue;
        If (Dir.Flags And FDirFailed <> 0) And (Not CheckAccess(User, True, bbsCfg.AcsSeeFailed)) Then Continue;

        If WildMatch(FileMask, Dir.FileName, False) Then
          DataSocket.WriteLine(Dir.FileName);
      End;
    End;

    DirFile.Free;

    CloseDataSession;
  End Else
    Client.WriteLine(re_BadCommand);
End;

Procedure TFTPServer.cmdPWD;
Begin
  If LoggedIn Then Begin
    If FBasePos = -1 Then
      Client.WriteLine(re_DirOkay + '"/"')
    Else
      Client.WriteLine(re_DirOkay + '"/' + FBase.FtpName + '"');
  End Else
    Client.WriteLine(re_BadCommand);
End;

Procedure TFTPServer.cmdLIST;
Var
  TempBase  : RecFileBase;
  TempPos   : LongInt;
  FBaseFile : TFileBuffer;
  DirFile   : TFileBuffer;
  Dir       : RecFileList;
Begin
  {$IFDEF FTPDEBUG} LOG('LIST Calling FindDirectory'); {$ENDIF}

  If LoggedIn Then Begin
    TempPos := FindDirectory(TempBase);

    {$IFDEF FTPDEBUG} LOG('Back From FindDirectory.  Result ' + strI2S(TempPos)); {$ENDIF}

    If TempPos = -1 Then Begin
      {$IFDEF FTPDEBUG} LOG('Opening data session'); {$ENDIF}

      OpenDataSession;

      {$IFDEF FTPDEBUG} LOG('Back from data session'); {$ENDIF}

      If Not bbsCfg.inetFTPHideQWK Then
        DataSocket.WriteLine('-rw-r--r--   1 ftp      ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + bbsCfg.QwkBBSID + '.qwk');

      FBaseFile := TFileBuffer.Create(FileBufSize);

      If FBaseFile.OpenStream (bbsCfg.DataPath + 'fbases.dat', SizeOf(RecFileBase), fmOpen, fmRWDN) Then Begin
        While Not FBaseFile.EOF Do Begin
          FBaseFile.ReadRecord (TempBase);

          If ValidDirectory(TempBase) and WildMatch(FileMask, TempBase.FtpName, False) Then
            DataSocket.WriteLine('drwxr-xr-x   1 ftp      ftp             0 ' + GetFTPDate(TempBase.Created) + ' ' + TempBase.FtpName)
        End;
      End;

      FBaseFile.Free;

      CloseDataSession;

      Exit;
    End;

    If Not ValidDirectory(TempBase) Then Begin
      Client.WriteLine(re_BadCommand);

      Exit;
    End;

    OpenDataSession;

    DirFile := TFileBuffer.Create(FileBufSize);

    If DirFile.OpenStream (bbsCfg.DataPath + TempBase.FileName + '.dir', SizeOf(RecFileList), fmOpenCreate, fmRWDN) Then Begin
      While Not DirFile.EOF Do Begin
        DirFile.ReadRecord (Dir);

        If (Dir.Flags And FDirDeleted <> 0) Then Continue;
        If (Dir.Flags and FDirOffline <> 0) And (Not CheckAccess(User, True, bbsCfg.AcsSeeOffline)) Then Continue;
        If (Dir.Flags And FDirInvalid <> 0) And (Not CheckAccess(User, True, bbsCfg.AcsSeeUnvalid)) Then Continue;
        If (Dir.Flags And FDirFailed  <> 0) And (Not CheckAccess(User, True, bbsCfg.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)
      End;
    End;

    DirFile.Free;

    If Not bbsCfg.inetFTPHideQWK Then
      DataSocket.WriteLine('-rw-r--r--   1 ftp      ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + bbsCfg.QwkBBSID + '.qwk');

    CloseDataSession;
  End Else
    Client.WriteLine(re_BadCommand);
End;

Procedure TFTPServer.cmdSTOR (IsAppend: Boolean);
Var
  TempPos  : LongInt;
  TempBase : RecFileBase;
  BaseFile : File;
  CurDIR   : String;
  Desc     : FileDescBuffer;
  DescSize : Byte;
  Dir      : RecFileList;
  DirPos   : LongInt = -1;
  DesFile  : File;
  Count    : Byte;
Begin
  If Not LoggedIn Then Begin
    Client.WriteLine(re_BadCommand);

    Exit;
  End;

  If strUpper(Data) = strUpper(bbsCfg.QwkBBSID + '.rep') Then Begin
    QWKProcessREP;

    Exit;
  End;

  TempPos := FindDirectory(TempBase);

  If (TempPos = -1) Or Not ValidDirectory(TempBase) Then Begin
    Client.WriteLine(re_NoAccess + ': Directory not found');

    Exit;
  End;

  If bbsCfg.UploadBase > 0 Then Begin
    Assign  (BaseFile, bbsCfg.DataPath + 'fbases.dat');
    ioReset (BaseFile, SizeOf(RecMessageBase), fmRWDN);

    If ioSeek (BaseFile, bbsCfg.UploadBase - 1) Then
      ioRead (BaseFile, TempBase);

    Close (BaseFile);
  End;

  If (Not CheckAccess (User, True, TempBase.ULACS)) or
     (TempBase.Flags AND FBSlowMedia <> 0) or
     (Length(FileMask) > 70) Then Begin

       Client.WriteLine(re_NoAccess);

       Exit;
  End;

  If bbsCfg.FreeUL > 0 Then Begin
    GetDIR (0, CurDIR);

    {$I-} ChDIR (TempBase.Path); {$I+}

    If (IoResult <> 0) or (DiskFree(0) DIV 1024 < bbsCfg.FreeUL) Then Begin
      ChDIR (CurDIR);

      Client.WriteLine(re_NoAccess + ': No disk space');

      Exit;
    End;

    ChDIR (CurDIR);
  End;

  If Not IsAppend And IsDuplicateFile (TempBase, FileMask, bbsCfg.FDupeScan = 2) Then Begin
    Client.WriteLine(re_BadFile);

    Exit;
  End;

  RecvFile (TempBase.Path + JustFile(Data), IsAppend);

  ImportFileDIZ(Desc, DescSize, TempPath, TempBase.Path + JustFile(Data));

  If DescSize = 0 Then Begin
    DescSize := 1;
    Desc[1]  := 'No Description';
  End;

  Assign (BaseFile, BbsCfg.DataPath + TempBase.FileName + '.dir');

  If Not ioReset (BaseFile, SizeOf(RecFileList), fmRWDW) Then
    ioReWrite (BaseFile, SizeOf(RecFileList), fmRWDW);

  If IsAppend Then Begin
    While Not Eof(BaseFile) Do Begin
      ioRead (BaseFile, Dir);

      If JustFile(Data) = Dir.FileName Then Begin
        DirPos := FilePos(BaseFile);

        Break;
      End;
    End;
  End;

  If DirPos = -1 Then Begin
    FillChar (Dir, SizeOf(Dir), 0);

    Dir.FileName  := JustFile(Data);
    Dir.DateTime  := CurDateDOS;
    Dir.Uploader  := User.Handle;
  End;

  Dir.DescLines := DescSize;
  Dir.Size      := FileByteSize(TempBase.Path + JustFile(Data));

  Assign (DesFile, BbsCfg.DataPath + TempBase.FileName + '.des');

  If Not ioReset (DesFile, 1, fmRWDW) Then
    ioReWrite (DesFile, 1, fmRWDW);

  Dir.DescPtr := FileSize(DesFile);

  Seek (DesFile, Dir.DescPtr);

  For Count := 1 to DescSize Do
    BlockWrite (DesFile, Desc[Count][0], Length(Desc[Count]) + 1);

  Close (DesFile);

  If DirPos = -1 Then
    Seek (BaseFile, FileSize(BaseFile))
  Else
    Seek (BaseFile, DirPos - 1);

  ioWrite (BaseFile, Dir);
  Close   (BaseFile);

  // dreadful things required to do for upload process:

  // find upload base -- done
  // check diskspace -- done
  // check slowmedia -- done
  // check access -- done
  // check filename length -- done
  // duplicate file checking -- done
  // get file -- done
  // update user statistics
  // update history statistics
  // archive testing
  // file_id.diz importing -- done?
  // save file to db (or update if append)
  // test all of it.

  // other things: add no desc and ftp test batch to configuration?
End;

Procedure TFTPServer.cmdRETR;
Var
  TempPos  : LongInt;
  TempBase : RecFileBase;
  DirFile  : TFileBuffer;
  Dir      : RecFileList;
  Found    : LongInt;
Begin
  If LoggedIn Then Begin

    If strUpper(JustFile(Data)) = strUpper(bbsCfg.QwkBBSID + '.qwk') Then Begin
      QWKCreatePacket;

      Exit;
    End;

    TempPos := FindDirectory(TempBase);

    If TempPos = -1 Then Begin
      Client.WriteLine(re_BadFile);

      Exit;
    End;

    DirFile := TFileBuffer.Create(FileBufSize);
    Found   := -1;

    If DirFile.OpenStream (bbsCfg.DataPath + TempBase.FileName + '.dir', SizeOf(RecFileList), fmOpenCreate, fmRWDN) Then Begin
      While Not DirFile.EOF Do Begin
        DirFile.ReadRecord (Dir);

        If WildMatch(FileMask, Dir.FileName, False) Then Begin
          Found := DirFile.FilePosRecord;

          Break;
        End;
      End;

      DirFile.Free;

      If Found = -1 Then Begin
        Client.WriteLine(re_BadFile);

        Exit;
      End;

      Case CheckFileLimits(TempBase, Dir) of
        0 : Begin
              SendFile        (TempBase.Path + Dir.FileName);
              UpdateUserStats (TempBase, Dir, Found, False);
            End;
        1 : Client.WriteLine(re_NoAccess);
        2 : Client.WriteLine(re_DLLimit);
        3 : Client.WriteLine(re_DLRatio);
      End;
    End Else
      Client.WriteLine(re_BadFile);
  End Else
    Client.WriteLine(re_BadCommand);
End;

Procedure TFTPServer.cmdSTRU;
Begin
  If strUpper(Data) = 'F' Then
    Client.WriteLine('200 FILE structure.')
  Else
    Client.WriteLine('504 Only FILE structure supported.');
End;

Procedure TFTPServer.cmdMODE;
Begin
  If strUpper(Data) = 'S' Then
    Client.WriteLine('200 STREAM mode.')
  Else
    Client.WriteLine('504 Only STREAM mode supported.');
End;

Procedure TFTPServer.cmdSYST;
Begin
  Client.WriteLine('215 UNIX Type: L8');
End;

Procedure TFTPServer.cmdTYPE;
Begin
  Client.WriteLine('200 All files sent in BINARY mode.');
End;

Procedure TFTPServer.cmdEPRT;
Var
  DataType : String;
Begin
  If LoggedIn Then Begin
    DataType := strWordGet(1, Data, '|');

    If DataType = '1' Then Begin
      DataIP    := strWordGet(2, Data, '|');
      DataPort  := strS2I(strWordGet(3, Data, '|'));
      IsPassive := False;

      Client.WriteLine(re_CommandOK);
    End Else
      Client.WriteLine('522 Network protocol not supported, use (1)');
  End Else
    Client.WriteLine(re_BadCommand);
End;

Procedure TFTPServer.cmdEPSV;
Var
  WaitSock : TIOSocket;
Begin
  If LoggedIn Then Begin
    If Data = '' Then Begin
      DataPort  := Random(bbsCfg.inetFTPPortMax - bbsCfg.inetFTPPortMin) + bbsCfg.inetFTPPortMin;
      IsPassive := True;

      Client.WriteLine('229 Entering Extended Passive Mode (|||' + strI2S(DataPort) + '|)');

      WaitSock := TIOSocket.Create;

      WaitSock.WaitInit(bbsCfg.inetInterface, DataPort);

      DataSocket := WaitSock.WaitConnection(10000);

      If Not Assigned(DataSocket) Then Begin
        WaitSock.Free;
        Client.WriteLine(re_NoData);
        Exit;
      End;

      WaitSock.Free;
    End Else
    If Data = '1' Then
      Client.WriteLine(re_CommandOK)
    Else
      Client.WriteLine('522 Network protocol not supported, use (1)');

  End Else
    Client.WriteLine(re_BadCommand);
End;

Procedure TFTPServer.cmdSIZE;
Begin
  Client.WriteLine('550 Not implemented');
End;

Procedure TFTPServer.Execute;
Var
  Str : String;
Begin
  cmdREIN;

  Repeat
    {$IFDEF FTPDEBUG} LOG('Execute loop'); {$ENDIF}

    If Client.WaitForData(bbsCfg.inetFTPTimeout * 1000) = 0 Then Break;

    If Terminated Then Exit;

    If Client.ReadLine(Str) = -1 Then Exit;

    Cmd := strUpper(strWordGet(1, Str, ' '));

    If Pos(' ', Str) > 0 Then
      Data := strStripB(Copy(Str, Pos(' ', Str) + 1, Length(Str)), ' ')
    Else
      Data := '';

    {$IFDEF FTPDEBUG}
      LOG('Cmd: ' + Cmd + ' Data: ' + Data);
    {$ENDIF}

    Server.Status (ProcessID, 'Cmd: ' + Cmd + ' Data: ' + Data);

    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
    If Cmd = 'EPRT' Then cmdEPRT Else
    If Cmd = 'EPSV' Then cmdEPSV Else
    If Cmd = 'LIST' Then cmdLIST Else
    If Cmd = 'MKD'  Then Client.WriteLine(re_NoAccess) Else
    If Cmd = 'MODE' Then cmdMODE Else
    If Cmd = 'NLST' Then cmdNLST Else
    If Cmd = 'NOOP' Then Client.WriteLine(re_CommandOK) Else
    If Cmd = 'PASS' Then cmdPASS Else
    If Cmd = 'PASV' Then cmdPASV Else
    If Cmd = 'PORT' Then cmdPORT Else
    If Cmd = 'PWD'  Then cmdPWD  Else
    If Cmd = 'REIN' Then cmdREIN Else
    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(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
    If Cmd = 'USER' Then cmdUSER Else
    If Cmd = 'XPWD' Then cmdPWD  Else
    If Cmd = 'QUIT' Then Begin
      GotQuit := True;

      Break;
    End Else
      Client.WriteLine(re_NoCommand);
  Until Terminated;

  If GotQuit Then Begin
    Client.WriteLine(re_Goodbye);

    If UserPos <> -1 Then
      Server.Status (ProcessID, User.Handle + ' logged out');
  End;
End;

Destructor TFTPServer.Destroy;
Begin
  If Assigned(DataSocket) Then DataSocket.Free;

  Inherited Destroy;
End;

End.