723 lines
22 KiB
Plaintext
723 lines
22 KiB
Plaintext
{
|
|
$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.
|