restemplate/indy/Protocols/IdTrivialFTPServer.pas

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.6    2/7/2004 7:20:20 PM  JPMugaas
  DotNET to go!! and YES - I want fries with that :-).

  Rev 1.5    2004.02.03 5:44:38 PM  czhower
  Name changes

  Rev 1.4    1/21/2004 4:21:06 PM  JPMugaas
  InitComponent

  Rev 1.3    10/25/2003 06:52:20 AM  JPMugaas
  Updated for new API changes and tried to restore some functionality.

  Rev 1.2    2003.10.24 10:43:12 AM  czhower
  TIdSTream to dos

  Rev 1.1    2003.10.12 6:36:48 PM  czhower
  Now compiles.

  Rev 1.0    11/13/2002 08:03:42 AM  JPMugaas
}

unit IdTrivialFTPServer;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  {$IFDEF HAS_UNIT_Generics_Collections}
  System.Generics.Collections,
  {$ENDIF}
  IdAssignedNumbers,
  IdGlobal,
  IdThreadSafe,
  IdTrivialFTPBase,
  IdSocketHandle,
  IdUDPServer
  {$IFDEF HAS_GENERICS_TObjectList}
  , IdThread
  {$ENDIF}
  ;

type
  TPeerInfo = record
    PeerIP: string;
    PeerPort: Integer;
  end;

  TAccessFileEvent = procedure (Sender: TObject; var FileName: String; const PeerInfo: TPeerInfo;
    var GrantAccess: Boolean; var AStream: TStream; var FreeStreamOnComplete: Boolean) of object;
  TTransferCompleteEvent = procedure (Sender: TObject; const Success: Boolean;
    const PeerInfo: TPeerInfo; var AStream: TStream; const WriteOperation: Boolean) of object;

  TIdTFTPThreadList = TIdThreadSafeObjectList{$IFDEF HAS_GENERICS_TObjectList}<TIdThread>{$ENDIF};

  TIdTrivialFTPServer = class(TIdUDPServer)
  protected
    FThreadList: TIdTFTPThreadList;
    FOnTransferComplete: TTransferCompleteEvent;
    FOnReadFile,
    FOnWriteFile: TAccessFileEvent;
    function StrToMode(mode: string): TIdTFTPMode;
  protected
    procedure DoReadFile(FileName: String; const Mode: TIdTFTPMode;
      const PeerInfo: TPeerInfo; RequestedBlockSize: Integer; IncludeTransferSize: Boolean); virtual;
    procedure DoWriteFile(FileName: String; const Mode: TIdTFTPMode;
      const PeerInfo: TPeerInfo; RequestedBlockSize: Integer; RequestedTransferSize: TIdStreamSize); virtual;
    procedure DoTransferComplete(const Success: Boolean; const PeerInfo: TPeerInfo; var SourceStream: TStream; const WriteOperation: Boolean); virtual;
    procedure DoUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); override;
    procedure InitComponent; override;
  public
    //should deactivate server, check all threads finished, before destroying
    function ActiveThreads:Integer;
    destructor Destroy;override;
  published
    property OnReadFile: TAccessFileEvent read FOnReadFile write FOnReadFile;
    property OnWriteFile: TAccessFileEvent read FOnWriteFile write FOnWriteFile;
    property OnTransferComplete: TTransferCompleteEvent read FOnTransferComplete write FOnTransferComplete;
    property DefaultPort default IdPORT_TFTP;
  end;

implementation

uses
  {$IFDEF DOTNET}
    {$IFDEF USE_INLINE}
  System.Threading,
    {$ENDIF}
  {$ENDIF}
  {$IFDEF VCL_2010_OR_ABOVE}
    {$IFDEF WINDOWS}
  Windows,
    {$ENDIF}
  {$ENDIF}
  {$IFDEF USE_VCL_POSIX}
  Posix.SysSelect,
  Posix.SysTime,
  {$ENDIF}
  {$IFDEF DOTNET}
  IdStreamNET,
  {$ELSE}
  IdStreamVCL,
  {$ENDIF}
  IdExceptionCore,
  IdGlobalProtocols,
  IdResourceStringsProtocols,
  IdStack,
  {$IFNDEF HAS_GENERICS_TObjectList}
  IdThread,
  {$ENDIF}
  {$IFDEF VCL_XE3_OR_ABOVE}
  System.Types,
{$ENDIF}
  IdUDPClient,
  SysUtils;

type
  TIdTFTPServerThread = class(TIdThread)
  protected
    FStream: TStream;
    FBlkCounter: UInt16;
    FResponse: TIdBytes;
    FRetryCtr: Integer;
    FUDPClient: TIdUDPClient;
    FRequestedBlkSize: Integer;
    FEOT, FFreeStrm: Boolean;
    FOwner: TIdTrivialFTPServer;
    procedure AfterRun; override;
    procedure BeforeRun; override;
    function HandleRunException(AException: Exception): Boolean; override;
    procedure TransferComplete;
  public
    constructor Create(AOwner: TIdTrivialFTPServer; const Mode: TIdTFTPMode;
      const PeerInfo: TPeerInfo; AStream: TStream; const FreeStreamOnTerminate: Boolean;
      const RequestedBlockSize: Integer); reintroduce;
    destructor Destroy; override;
  end;

  TIdTFTPServerSendFileThread = class(TIdTFTPServerThread)
  private
    FSendTransferSize: Boolean;
  protected
    procedure BeforeRun; override;
    procedure Run; override;
  public
    constructor Create(AOwner: TIdTrivialFTPServer; const Mode: TIdTFTPMode;
      const PeerInfo: TPeerInfo; AStream: TStream; const FreeStreamOnTerminate: Boolean;
      const RequestedBlockSize: Integer; SendTransferSize: Boolean); reintroduce;
  end;

  TIdTFTPServerReceiveFileThread = class(TIdTFTPServerThread)
  protected
    FTransferSize: TIdStreamSize;
    FReceivedSize: TIdStreamSize;
  protected
    procedure BeforeRun; override;
    {$IFNDEF DOTNET}
    function HandleRunException(AException: Exception): Boolean; override;
    {$ENDIF}
    procedure Run; override;
  public
    constructor Create(AOwner: TIdTrivialFTPServer; const Mode: TIdTFTPMode;
      const PeerInfo: TPeerInfo; AStream: TStream; const FreeStreamOnTerminate: Boolean;
      const RequestedBlockSize: Integer; const RequestedTransferSize: TIdStreamSize); reintroduce;
  end;

{ TIdTrivialFTPServer }

procedure TIdTrivialFTPServer.InitComponent;
begin
  inherited InitComponent;
  DefaultPort := IdPORT_TFTP;
  FThreadList := TIdTFTPThreadList.Create;
end;

procedure TIdTrivialFTPServer.DoReadFile(FileName: String; const Mode: TIdTFTPMode;
  const PeerInfo: TPeerInfo; RequestedBlockSize: Integer; IncludeTransferSize: Boolean);
var
  CanRead,
  FreeOnComplete: Boolean;
  LStream: TStream;
begin
  CanRead := True;
  LStream := nil;
  FreeOnComplete := True;

  {$IFNDEF DOTNET}
  try
  {$ENDIF}

    if Assigned(FOnReadFile) then begin
      FOnReadFile(Self, FileName, PeerInfo, CanRead, LStream, FreeOnComplete);
    end;
    if not CanRead then begin
      raise EIdTFTPAccessViolation.CreateFmt(RSTFTPAccessDenied, [FileName]);
    end;
    if LStream = nil then begin
      LStream := TIdReadFileExclusiveStream.Create(FileName);
      FreeOnComplete := True;
    end;

    TIdTFTPServerSendFileThread.Create(Self, Mode, PeerInfo, LStream, FreeOnComplete, RequestedBlockSize, IncludeTransferSize);

  {$IFNDEF DOTNET}
  except
    // TODO: implement this in a platform-neutral manner.  EFOpenError is VCL-specific
    on E: EFOpenError do begin
      IndyRaiseOuterException(EIdTFTPFileNotFound.Create(E.Message));
    end;
  end;
  {$ENDIF}
end;

procedure TIdTrivialFTPServer.DoTransferComplete(const Success: Boolean;
  const PeerInfo: TPeerInfo; var SourceStream: TStream; const WriteOperation: Boolean);
begin
  if Assigned(FOnTransferComplete) then begin
    FOnTransferComplete(Self, Success, PeerInfo, SourceStream, WriteOperation)
  end else begin
    FreeAndNil(SourceStream); // free the stream regardless, unless the component user steps up to the plate
  end;
end;

procedure TIdTrivialFTPServer.DoUDPRead(AThread: TIdUDPListenerThread;
  const AData: TIdBytes; ABinding: TIdSocketHandle);
var
  wOp: UInt16;
  FileName, LOptName, LOptValue: String;
  Idx, LOffset, RequestedBlkSize: Integer;
  RequestedTxSize: Int64;
  Mode: TIdTFTPMode;
  PeerInfo: TPeerInfo;
begin
  inherited DoUDPRead(AThread, AData, ABinding);
  try
    if Length(AData) > 1 then begin
      wOp := GStack.NetworkToHost(BytesToUInt16(AData));
    end else begin
      wOp := 0;
    end;

    if not (wOp in [TFTP_RRQ, TFTP_WRQ]) then begin
      raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
    end;

    LOffset := 2;

    Idx := ByteIndex(0, AData, LOffset);
    if Idx = -1 then begin
      raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
    end;

    FileName := BytesToString(AData, LOffset, Idx-LOffset, IndyTextEncoding_ASCII);
    LOffset := Idx+1;

    Idx := ByteIndex(0, AData, LOffset);
    if Idx = -1 then begin
      raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
    end;

    Mode := StrToMode(BytesToString(AData, LOffset, Idx-LOffset, IndyTextEncoding_ASCII));
    LOffset := Idx+1;

    RequestedBlkSize := 512;
    RequestedTxSize := -1;

    while LOffset < Length(AData) do
    begin
      Idx := ByteIndex(0, AData, LOffset);
      if Idx = -1 then begin
        raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
      end;

      LOptName := BytesToString(AData, LOffset, Idx-LOffset, IndyTextEncoding_ASCII);
      LOffset := Idx+1;
      
      Idx := ByteIndex(0, AData, LOffset);
      if Idx = -1 then begin
        raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
      end;

      LOptValue := BytesToString(AData, LOffset, Idx-LOffset, IndyTextEncoding_ASCII);
      LOffset := Idx+1;

      if TextStartsWith(LOptName, sBlockSize) then
      begin
        RequestedBlkSize := IndyStrToInt(LOptValue);
        if (RequestedBlkSize < 8) or (RequestedBlkSize > 65464) then begin
          raise EIdTFTPOptionNegotiationFailed.CreateFmt(RSTFTPUnsupportedOptionValue, [LOptValue, LOptName]);
        end;
      end
      else if TextStartsWith(LOptName, sTransferSize) then
      begin
        RequestedTxSize := IndyStrToInt64(LOptValue);
        if wOp = TFTP_RRQ then begin
          if RequestedTxSize <> 0 then begin
            raise EIdTFTPOptionNegotiationFailed.CreateFmt(RSTFTPUnsupportedOptionValue, [LOptValue, LOptName]);
          end;
        end
        else if RequestedTxSize > High(TIdStreamSize) then begin
          raise EIdTFTPOptionNegotiationFailed.CreateFmt(RSTFTPUnsupportedOptionValue, [LOptValue, LOptName]);
        end;
      end;
    end;

    PeerInfo.PeerIP := ABinding.PeerIP;
    PeerInfo.PeerPort := ABinding.PeerPort;

    if wOp = TFTP_RRQ then begin
      DoReadFile(FileName, Mode, PeerInfo, RequestedBlkSize, RequestedTxSize = 0);
    end else begin
      DoWriteFile(FileName, Mode, PeerInfo, RequestedBlkSize, TIdStreamSize(RequestedTxSize));
    end;
  except
    on E: EIdTFTPException do begin
      SendError(Self, ABinding.PeerIP, ABinding.PeerPort, E);
    end;
    on E: Exception do begin
      SendError(Self, ABinding.PeerIP, ABinding.PeerPort, E);
      raise;
    end;
  end;  { try..except }
end;

// TODO: move this into IdGlobal.pas
procedure AdjustStreamSize(const AStream: TStream; const ASize: TIdStreamSize);
var
  LStreamPos: TIdStreamSize;
begin
  LStreamPos := AStream.Position;
  AStream.Size := ASize;
  // Must reset to original value in cases where size changes position
  if AStream.Position <> LStreamPos then begin
    AStream.Position := LStreamPos;
  end;
end;

procedure TIdTrivialFTPServer.DoWriteFile(FileName: String; const Mode: TIdTFTPMode;
  const PeerInfo: TPeerInfo; RequestedBlockSize: Integer; RequestedTransferSize: TIdStreamSize);
var
  CanWrite,
  FreeOnComplete: Boolean;
  LStream: TStream;
begin
  CanWrite := True;
  LStream := nil;
  FreeOnComplete := True;

  {$IFNDEF DOTNET}
  try
  {$ENDIF}

    if Assigned(FOnWriteFile) then begin
      FOnWriteFile(Self, FileName, PeerInfo, CanWrite, LStream, FreeOnComplete);
    end;
    if not CanWrite then begin
      raise EIdTFTPAccessViolation.CreateFmt(RSTFTPAccessDenied, [FileName]);
    end;
    if LStream = nil then begin
      LStream := TIdFileCreateStream.Create(FileName);
      FreeOnComplete := True;
    end;

    if RequestedTransferSize >= 0 then
    begin
      try
        AdjustStreamSize(LStream, RequestedTransferSize);
      except
        IndyRaiseOuterException(EIdTFTPAllocationExceeded.CreateFmt(RSTFTPDiskFull, [0]));
      end;
    end;

    TIdTFTPServerReceiveFileThread.Create(Self, Mode, PeerInfo, LStream, FreeOnComplete, RequestedBlockSize, RequestedTransferSize);

  {$IFNDEF DOTNET}
  except
    // TODO: implement this in a platform-neutral manner.  EFCreateError is VCL-specific
    on E: EFCreateError do begin
      IndyRaiseOuterException(EIdTFTPAllocationExceeded.Create(E.Message));
    end;
  end;
  {$ENDIF}
end;

function TIdTrivialFTPServer.StrToMode(mode: string): TIdTFTPMode;
begin
  case PosInStrArray(mode, ['octet', 'binary', 'netascii'], False) of    {Do not Localize}
    0, 1: Result := tfOctet;
    2: Result := tfNetAscii;
    else
      raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnsupportedTrxMode, [mode]); // unknown mode
  end;
end;

destructor TIdTrivialFTPServer.Destroy;
begin
  {
  if (not ThreadedEvent) and (ActiveThreads>0) then
    begin
    //some kind of error/warning about deadlock or possible AV due to
    //soon-to-be invalid pointer in the threads? (FOwner: TIdTrivialFTPServer;)
    //raise CantFreeYet?
    end;
  }

  //wait for threads to finish before we shutdown
  //should we set thread[i].terminated, or just wait?
  if ThreadedEvent then
  begin
    while FThreadList.Count > 0 do
    begin
      IndySleep(100);
    end;
  end;

  FreeAndNil(FThreadList);
  inherited Destroy;
end;

function TIdTrivialFTPServer.ActiveThreads: Integer;
begin
  Result := FThreadList.Count;
end;

{ TIdTFTPServerThread }

constructor TIdTFTPServerThread.Create(AOwner: TIdTrivialFTPServer;
  const Mode: TIdTFTPMode; const PeerInfo: TPeerInfo; AStream: TStream;
  const FreeStreamOnTerminate: boolean; const RequestedBlockSize: Integer);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FStream := AStream;
  FFreeStrm := FreeStreamOnTerminate;
  FOwner := AOwner;
  FUDPClient := TIdUDPClient.Create(nil);
  FUDPClient.IPVersion := FOwner.IPVersion;
  FUDPClient.ReceiveTimeout := 1500;
  FUDPClient.Host := PeerInfo.PeerIP;
  FUDPClient.Port := PeerInfo.PeerPort;
  FUDPClient.BufferSize := RequestedBlockSize + 4;
  FOwner.FThreadList.Add(Self);
end;

destructor TIdTFTPServerThread.Destroy;
begin
  if FFreeStrm then begin
    FreeAndNil(FStream);
  end;
  FreeAndNil(FUDPClient);
  FOwner.FThreadList.Remove(Self);
  inherited Destroy;
end;

procedure TIdTFTPServerThread.AfterRun;
begin
  if FOwner.ThreadedEvent then begin
    TransferComplete;
  end else begin
    Synchronize(TransferComplete);
  end;
end;

procedure TIdTFTPServerThread.BeforeRun;
begin
  FBlkCounter := 0;
  FRetryCtr := 0;
  FEOT := False;

  if FUDPClient.BufferSize <> 516 then
  begin
    FResponse := ToBytes(GStack.HostToNetwork(UInt16(TFTP_OACK)));
    AppendString(FResponse, sBlockSize, -1, IndyTextEncoding_ASCII);
    AppendByte(FResponse, 0);
    AppendString(FResponse, IntToStr(FUDPClient.BufferSize - 4), -1, IndyTextEncoding_ASCII);
    AppendByte(FResponse, 0);
  end else begin
    SetLength(FResponse, 0);
  end;
end;

function TIdTFTPServerThread.HandleRunException(AException: Exception): Boolean;
begin
  Result := False;
  SendError(FUDPClient, AException);
end;

procedure TIdTFTPServerThread.TransferComplete;
var
  PeerInfo: TPeerInfo;
begin
  PeerInfo.PeerIP := FUDPClient.Host;
  PeerInfo.PeerPort := FUDPClient.Port;
  FOwner.DoTransferComplete(FEOT, PeerInfo, FStream, Self is TIdTFTPServerReceiveFileThread);
end;

{ TIdTFTPServerSendFileThread }

constructor TIdTFTPServerSendFileThread.Create(AOwner: TIdTrivialFTPServer;
  const Mode: TIdTFTPMode; const PeerInfo: TPeerInfo; AStream: TStream;
  const FreeStreamOnTerminate: boolean; const RequestedBlockSize: Integer;
  SendTransferSize: Boolean);
begin
  inherited Create(AOwner, Mode, PeerInfo, AStream, FreeStreamOnTerminate, RequestedBlockSize);
  FSendTransferSize := SendTransferSize;
end;

procedure TIdTFTPServerSendFileThread.BeforeRun;
begin
  inherited BeforeRun;
  if FSendTransferSize then
  begin
    if Length(FResponse) = 0 then begin
      FResponse := ToBytes(GStack.HostToNetwork(UInt16(TFTP_OACK)));
    end;
    AppendString(FResponse, sTransferSize, -1, IndyTextEncoding_ASCII);
    AppendByte(FResponse, 0);
    AppendString(FResponse, IntToStr(FStream.Size - FStream.Position), -1, IndyTextEncoding_ASCII);
    AppendByte(FResponse, 0);
  end;
end;

procedure TIdTFTPServerSendFileThread.Run;
var
  Buffer: TIdBytes;
  LPeerIP: string;
  LPeerPort: TIdPort;
  i: Integer;
begin
  if Length(FResponse) = 0 then begin // generate a new response packet for client
    if FBlkCounter = High(UInt16) then begin
      raise EIdTFTPAllocationExceeded.Create('');
    end;
    Inc(FBlkCounter);
    SetLength(FResponse, FUDPClient.BufferSize);
    CopyTIdUInt16(GStack.HostToNetwork(UInt16(TFTP_DATA)), FResponse, 0);
    CopyTIdUInt16(GStack.HostToNetwork(FBlkCounter), FResponse, 2);
    i := ReadTIdBytesFromStream(FStream, FResponse, FUDPClient.BufferSize - 4, 4);
    SetLength(FResponse, 4 + i);
    if i < (FUDPClient.BufferSize - 4) then begin
      FEOT := True;
    end;
    FRetryCtr := 0;
  end;
  if FRetryCtr = 3 then begin
    raise EIdTFTPIllegalOperation.Create(RSTimeOut); // Timeout
  end;
  FUDPClient.SendBuffer(FResponse);
  SetLength(Buffer, FUDPClient.BufferSize);
  i := FUDPClient.ReceiveBuffer(Buffer, LPeerIP, LPeerPort);
  if i <= 0 then begin
    if FEOT then begin
      Stop;
      Exit;
    end;
    Inc(FRetryCtr);
    Exit;
  end;
  SetLength(Buffer, i);
  // TODO: validate the correct peer is sending the data...
  case GStack.NetworkToHost(BytesToUInt16(Buffer)) of
    TFTP_ACK:
      begin
        i := GStack.NetworkToHost(BytesToUInt16(Buffer, 2));
        if i = FBlkCounter then begin
          SetLength(FResponse, 0);
        end;
        if FEOT then begin
          Stop;
          Exit;
        end;
      end;
    TFTP_DATA:
      begin
        raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [FUDPClient.Host, FUDPClient.Port]);
      end;
    TFTP_ERROR:
      begin
        Abort;
      end;
    else
      begin
        raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [FUDPClient.Host, FUDPClient.Port]);
      end;
  end;
end;

{ TIdTFTPServerReceiveFileThread }

constructor TIdTFTPServerReceiveFileThread.Create(AOwner: TIdTrivialFTPServer;
  const Mode: TIdTFTPMode; const PeerInfo: TPeerInfo; AStream: TStream;
  const FreeStreamOnTerminate: Boolean; const RequestedBlockSize: Integer;
  const RequestedTransferSize: TIdStreamSize);
begin
  inherited Create(AOwner, Mode, PeerInfo, AStream, FreeStreamOnTerminate, RequestedBlockSize);
  FTransferSize := RequestedTransferSize;
end;

procedure TIdTFTPServerReceiveFileThread.BeforeRun;
begin
  inherited BeforeRun;
  FReceivedSize := 0;
  if FTransferSize <> -1 then
  begin
    if Length(FResponse) = 0 then begin
      FResponse := ToBytes(GStack.HostToNetwork(UInt16(TFTP_OACK)));
    end;
    AppendString(FResponse, sTransferSize, -1, IndyTextEncoding_ASCII);
    AppendByte(FResponse, 0);
    AppendString(FResponse, IntToStr(FTransferSize), -1, IndyTextEncoding_ASCII);
    AppendByte(FResponse, 0);
  end;
  if Length(FResponse) > 0 then begin
    // RLebeau:  sending an OACK instead of an ACK, so expect
    // the next packet received to be a DATA packet...
    FBlkCounter := 1;
  end;
end;

{$IFNDEF DOTNET}
function TIdTFTPServerReceiveFileThread.HandleRunException(AException: Exception): Boolean;
begin
  // TODO: implement this in a platform-neutral manner.  EWriteError is VCL-specific
  if AException is EWriteError then
  begin
    Result := False;
    SendError(FUDPClient, ErrAllocationExceeded, IndyFormat(RSTFTPDiskFull, [FStream.Position]));
    Exit;
  end;
  Result := inherited HandleRunException(AException);
end;
{$ENDIF}

procedure TIdTFTPServerReceiveFileThread.Run;
var
  Buffer: TIdBytes;
  LPeerIP: string;
  LPeerPort: TIdPort;
  i: TIdStreamSize;
begin
  if Length(FResponse) = 0 then begin
    FResponse := MakeActPkt(FBlkCounter);
    if FBlkCounter = High(UInt16) then begin
      FEOT := True;
    end else begin
      Inc(FBlkCounter);
    end;
    FRetryCtr := 0;
  end;
  if FRetryCtr = 3 then begin
    raise EIdTFTPIllegalOperation.Create(RSTimeOut); // Timeout
  end;
  FUDPClient.SendBuffer(FResponse);
  SetLength(Buffer, FUDPClient.BufferSize);
  i := FUDPClient.ReceiveBuffer(Buffer, LPeerIP, LPeerPort);
  if i <= 0 then begin
    if FEOT then begin
      Stop;
      Exit;
    end;
    Inc(FRetryCtr);
    Exit;
  end;
  SetLength(Buffer, i);
  // TODO: validate the correct peer is sending the data...
  case GStack.NetworkToHost(BytesToUInt16(Buffer)) of
    TFTP_ACK:
      begin
        raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [FUDPClient.Host, FUDPClient.Port]);
      end;
    TFTP_DATA:
      begin
        i := GStack.NetworkToHost(BytesToUInt16(Buffer, 2));
        if i = FBlkCounter then
        begin
          if FEOT then begin
            raise EIdTFTPAllocationExceeded.CreateFmt(RSTFTPDiskFull, [FStream.Position]);
          end;
          if (FTransferSize >= 0) and ((FTransferSize - FReceivedSize) < (Length(Buffer) - 4)) then
          begin
            WriteTIdBytesToStream(FStream, Buffer, FTransferSize - FReceivedSize, 4);
            FReceivedSize := FTransferSize;
            FEOT := True;
            raise EIdTFTPAllocationExceeded.CreateFmt(RSTFTPDiskFull, [FStream.Position]);
          end;
          WriteTIdBytesToStream(FStream, Buffer, Length(Buffer) - 4, 4);
          Inc(FReceivedSize, Length(Buffer) - 4);
          SetLength(FResponse, 0);
          FEOT := Length(Buffer) < (FUDPClient.BufferSize - 4);
        end;
      end;
    TFTP_ERROR:
      begin
        Abort;
      end;
    else
      begin
        raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [FUDPClient.Host, FUDPClient.Port]);
      end;
  end;
end;

end.