| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717 |
- {
- $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}
- 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) - 4) < (FUDPClient.BufferSize - 4);
- end;
- end;
- TFTP_ERROR:
- begin
- Abort;
- end;
- else
- begin
- raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [FUDPClient.Host, FUDPClient.Port]);
- end;
- end;
- end;
- end.
|