IdTrivialFTPServer.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.6 2/7/2004 7:20:20 PM JPMugaas
  18. DotNET to go!! and YES - I want fries with that :-).
  19. Rev 1.5 2004.02.03 5:44:38 PM czhower
  20. Name changes
  21. Rev 1.4 1/21/2004 4:21:06 PM JPMugaas
  22. InitComponent
  23. Rev 1.3 10/25/2003 06:52:20 AM JPMugaas
  24. Updated for new API changes and tried to restore some functionality.
  25. Rev 1.2 2003.10.24 10:43:12 AM czhower
  26. TIdSTream to dos
  27. Rev 1.1 2003.10.12 6:36:48 PM czhower
  28. Now compiles.
  29. Rev 1.0 11/13/2002 08:03:42 AM JPMugaas
  30. }
  31. unit IdTrivialFTPServer;
  32. interface
  33. {$i IdCompilerDefines.inc}
  34. uses
  35. Classes,
  36. {$IFDEF HAS_UNIT_Generics_Collections}
  37. System.Generics.Collections,
  38. {$ENDIF}
  39. IdAssignedNumbers,
  40. IdGlobal,
  41. IdThreadSafe,
  42. IdTrivialFTPBase,
  43. IdSocketHandle,
  44. IdUDPServer
  45. {$IFDEF HAS_GENERICS_TObjectList}
  46. , IdThread
  47. {$ENDIF}
  48. ;
  49. type
  50. TPeerInfo = record
  51. PeerIP: string;
  52. PeerPort: Integer;
  53. end;
  54. TAccessFileEvent = procedure (Sender: TObject; var FileName: String; const PeerInfo: TPeerInfo;
  55. var GrantAccess: Boolean; var AStream: TStream; var FreeStreamOnComplete: Boolean) of object;
  56. TTransferCompleteEvent = procedure (Sender: TObject; const Success: Boolean;
  57. const PeerInfo: TPeerInfo; var AStream: TStream; const WriteOperation: Boolean) of object;
  58. TIdTFTPThreadList = TIdThreadSafeObjectList{$IFDEF HAS_GENERICS_TObjectList}<TIdThread>{$ENDIF};
  59. TIdTrivialFTPServer = class(TIdUDPServer)
  60. protected
  61. FThreadList: TIdTFTPThreadList;
  62. FOnTransferComplete: TTransferCompleteEvent;
  63. FOnReadFile,
  64. FOnWriteFile: TAccessFileEvent;
  65. function StrToMode(mode: string): TIdTFTPMode;
  66. protected
  67. procedure DoReadFile(FileName: String; const Mode: TIdTFTPMode;
  68. const PeerInfo: TPeerInfo; RequestedBlockSize: Integer; IncludeTransferSize: Boolean); virtual;
  69. procedure DoWriteFile(FileName: String; const Mode: TIdTFTPMode;
  70. const PeerInfo: TPeerInfo; RequestedBlockSize: Integer; RequestedTransferSize: TIdStreamSize); virtual;
  71. procedure DoTransferComplete(const Success: Boolean; const PeerInfo: TPeerInfo; var SourceStream: TStream; const WriteOperation: Boolean); virtual;
  72. procedure DoUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); override;
  73. procedure InitComponent; override;
  74. public
  75. //should deactivate server, check all threads finished, before destroying
  76. function ActiveThreads:Integer;
  77. destructor Destroy;override;
  78. published
  79. property OnReadFile: TAccessFileEvent read FOnReadFile write FOnReadFile;
  80. property OnWriteFile: TAccessFileEvent read FOnWriteFile write FOnWriteFile;
  81. property OnTransferComplete: TTransferCompleteEvent read FOnTransferComplete write FOnTransferComplete;
  82. property DefaultPort default IdPORT_TFTP;
  83. end;
  84. implementation
  85. uses
  86. {$IFDEF DOTNET}
  87. {$IFDEF USE_INLINE}
  88. System.Threading,
  89. {$ENDIF}
  90. {$ENDIF}
  91. {$IFDEF VCL_2010_OR_ABOVE}
  92. {$IFDEF WINDOWS}
  93. Windows,
  94. {$ENDIF}
  95. {$ENDIF}
  96. {$IFDEF USE_VCL_POSIX}
  97. Posix.SysSelect,
  98. Posix.SysTime,
  99. {$ENDIF}
  100. IdExceptionCore,
  101. IdGlobalProtocols,
  102. IdResourceStringsProtocols,
  103. IdStack,
  104. {$IFNDEF HAS_GENERICS_TObjectList}
  105. IdThread,
  106. {$ENDIF}
  107. {$IFDEF VCL_XE3_OR_ABOVE}
  108. System.Types,
  109. {$ENDIF}
  110. IdUDPClient,
  111. SysUtils;
  112. type
  113. TIdTFTPServerThread = class(TIdThread)
  114. protected
  115. FStream: TStream;
  116. FBlkCounter: UInt16;
  117. FResponse: TIdBytes;
  118. FRetryCtr: Integer;
  119. FUDPClient: TIdUDPClient;
  120. FRequestedBlkSize: Integer;
  121. FEOT, FFreeStrm: Boolean;
  122. FOwner: TIdTrivialFTPServer;
  123. procedure AfterRun; override;
  124. procedure BeforeRun; override;
  125. function HandleRunException(AException: Exception): Boolean; override;
  126. procedure TransferComplete;
  127. public
  128. constructor Create(AOwner: TIdTrivialFTPServer; const Mode: TIdTFTPMode;
  129. const PeerInfo: TPeerInfo; AStream: TStream; const FreeStreamOnTerminate: Boolean;
  130. const RequestedBlockSize: Integer); reintroduce;
  131. destructor Destroy; override;
  132. end;
  133. TIdTFTPServerSendFileThread = class(TIdTFTPServerThread)
  134. private
  135. FSendTransferSize: Boolean;
  136. protected
  137. procedure BeforeRun; override;
  138. procedure Run; override;
  139. public
  140. constructor Create(AOwner: TIdTrivialFTPServer; const Mode: TIdTFTPMode;
  141. const PeerInfo: TPeerInfo; AStream: TStream; const FreeStreamOnTerminate: Boolean;
  142. const RequestedBlockSize: Integer; SendTransferSize: Boolean); reintroduce;
  143. end;
  144. TIdTFTPServerReceiveFileThread = class(TIdTFTPServerThread)
  145. protected
  146. FTransferSize: TIdStreamSize;
  147. FReceivedSize: TIdStreamSize;
  148. protected
  149. procedure BeforeRun; override;
  150. {$IFNDEF DOTNET}
  151. function HandleRunException(AException: Exception): Boolean; override;
  152. {$ENDIF}
  153. procedure Run; override;
  154. public
  155. constructor Create(AOwner: TIdTrivialFTPServer; const Mode: TIdTFTPMode;
  156. const PeerInfo: TPeerInfo; AStream: TStream; const FreeStreamOnTerminate: Boolean;
  157. const RequestedBlockSize: Integer; const RequestedTransferSize: TIdStreamSize); reintroduce;
  158. end;
  159. { TIdTrivialFTPServer }
  160. procedure TIdTrivialFTPServer.InitComponent;
  161. begin
  162. inherited InitComponent;
  163. DefaultPort := IdPORT_TFTP;
  164. FThreadList := TIdTFTPThreadList.Create;
  165. end;
  166. procedure TIdTrivialFTPServer.DoReadFile(FileName: String; const Mode: TIdTFTPMode;
  167. const PeerInfo: TPeerInfo; RequestedBlockSize: Integer; IncludeTransferSize: Boolean);
  168. var
  169. CanRead,
  170. FreeOnComplete: Boolean;
  171. LStream: TStream;
  172. begin
  173. CanRead := True;
  174. LStream := nil;
  175. FreeOnComplete := True;
  176. {$IFNDEF DOTNET}
  177. try
  178. {$ENDIF}
  179. if Assigned(FOnReadFile) then begin
  180. FOnReadFile(Self, FileName, PeerInfo, CanRead, LStream, FreeOnComplete);
  181. end;
  182. if not CanRead then begin
  183. raise EIdTFTPAccessViolation.CreateFmt(RSTFTPAccessDenied, [FileName]);
  184. end;
  185. if LStream = nil then begin
  186. LStream := TIdReadFileExclusiveStream.Create(FileName);
  187. FreeOnComplete := True;
  188. end;
  189. TIdTFTPServerSendFileThread.Create(Self, Mode, PeerInfo, LStream, FreeOnComplete, RequestedBlockSize, IncludeTransferSize);
  190. {$IFNDEF DOTNET}
  191. except
  192. // TODO: implement this in a platform-neutral manner. EFOpenError is VCL-specific
  193. on E: EFOpenError do begin
  194. IndyRaiseOuterException(EIdTFTPFileNotFound.Create(E.Message));
  195. end;
  196. end;
  197. {$ENDIF}
  198. end;
  199. procedure TIdTrivialFTPServer.DoTransferComplete(const Success: Boolean;
  200. const PeerInfo: TPeerInfo; var SourceStream: TStream; const WriteOperation: Boolean);
  201. begin
  202. if Assigned(FOnTransferComplete) then begin
  203. FOnTransferComplete(Self, Success, PeerInfo, SourceStream, WriteOperation)
  204. end else begin
  205. FreeAndNil(SourceStream); // free the stream regardless, unless the component user steps up to the plate
  206. end;
  207. end;
  208. procedure TIdTrivialFTPServer.DoUDPRead(AThread: TIdUDPListenerThread;
  209. const AData: TIdBytes; ABinding: TIdSocketHandle);
  210. var
  211. wOp: UInt16;
  212. FileName, LOptName, LOptValue: String;
  213. Idx, LOffset, RequestedBlkSize: Integer;
  214. RequestedTxSize: Int64;
  215. Mode: TIdTFTPMode;
  216. PeerInfo: TPeerInfo;
  217. begin
  218. inherited DoUDPRead(AThread, AData, ABinding);
  219. try
  220. if Length(AData) > 1 then begin
  221. wOp := GStack.NetworkToHost(BytesToUInt16(AData));
  222. end else begin
  223. wOp := 0;
  224. end;
  225. if not (wOp in [TFTP_RRQ, TFTP_WRQ]) then begin
  226. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
  227. end;
  228. LOffset := 2;
  229. Idx := ByteIndex(0, AData, LOffset);
  230. if Idx = -1 then begin
  231. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
  232. end;
  233. FileName := BytesToString(AData, LOffset, Idx-LOffset, IndyTextEncoding_ASCII);
  234. LOffset := Idx+1;
  235. Idx := ByteIndex(0, AData, LOffset);
  236. if Idx = -1 then begin
  237. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
  238. end;
  239. Mode := StrToMode(BytesToString(AData, LOffset, Idx-LOffset, IndyTextEncoding_ASCII));
  240. LOffset := Idx+1;
  241. RequestedBlkSize := 512;
  242. RequestedTxSize := -1;
  243. while LOffset < Length(AData) do
  244. begin
  245. Idx := ByteIndex(0, AData, LOffset);
  246. if Idx = -1 then begin
  247. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
  248. end;
  249. LOptName := BytesToString(AData, LOffset, Idx-LOffset, IndyTextEncoding_ASCII);
  250. LOffset := Idx+1;
  251. Idx := ByteIndex(0, AData, LOffset);
  252. if Idx = -1 then begin
  253. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [ABinding.PeerIP, ABinding.PeerPort]);
  254. end;
  255. LOptValue := BytesToString(AData, LOffset, Idx-LOffset, IndyTextEncoding_ASCII);
  256. LOffset := Idx+1;
  257. if TextStartsWith(LOptName, sBlockSize) then
  258. begin
  259. RequestedBlkSize := IndyStrToInt(LOptValue);
  260. if (RequestedBlkSize < 8) or (RequestedBlkSize > 65464) then begin
  261. raise EIdTFTPOptionNegotiationFailed.CreateFmt(RSTFTPUnsupportedOptionValue, [LOptValue, LOptName]);
  262. end;
  263. end
  264. else if TextStartsWith(LOptName, sTransferSize) then
  265. begin
  266. RequestedTxSize := IndyStrToInt64(LOptValue);
  267. if wOp = TFTP_RRQ then begin
  268. if RequestedTxSize <> 0 then begin
  269. raise EIdTFTPOptionNegotiationFailed.CreateFmt(RSTFTPUnsupportedOptionValue, [LOptValue, LOptName]);
  270. end;
  271. end
  272. else if RequestedTxSize > High(TIdStreamSize) then begin
  273. raise EIdTFTPOptionNegotiationFailed.CreateFmt(RSTFTPUnsupportedOptionValue, [LOptValue, LOptName]);
  274. end;
  275. end;
  276. end;
  277. PeerInfo.PeerIP := ABinding.PeerIP;
  278. PeerInfo.PeerPort := ABinding.PeerPort;
  279. if wOp = TFTP_RRQ then begin
  280. DoReadFile(FileName, Mode, PeerInfo, RequestedBlkSize, RequestedTxSize = 0);
  281. end else begin
  282. DoWriteFile(FileName, Mode, PeerInfo, RequestedBlkSize, TIdStreamSize(RequestedTxSize));
  283. end;
  284. except
  285. on E: EIdTFTPException do begin
  286. SendError(Self, ABinding.PeerIP, ABinding.PeerPort, E);
  287. end;
  288. on E: Exception do begin
  289. SendError(Self, ABinding.PeerIP, ABinding.PeerPort, E);
  290. raise;
  291. end;
  292. end; { try..except }
  293. end;
  294. // TODO: move this into IdGlobal.pas
  295. procedure AdjustStreamSize(const AStream: TStream; const ASize: TIdStreamSize);
  296. var
  297. LStreamPos: TIdStreamSize;
  298. begin
  299. LStreamPos := AStream.Position;
  300. AStream.Size := ASize;
  301. // Must reset to original value in cases where size changes position
  302. if AStream.Position <> LStreamPos then begin
  303. AStream.Position := LStreamPos;
  304. end;
  305. end;
  306. procedure TIdTrivialFTPServer.DoWriteFile(FileName: String; const Mode: TIdTFTPMode;
  307. const PeerInfo: TPeerInfo; RequestedBlockSize: Integer; RequestedTransferSize: TIdStreamSize);
  308. var
  309. CanWrite,
  310. FreeOnComplete: Boolean;
  311. LStream: TStream;
  312. begin
  313. CanWrite := True;
  314. LStream := nil;
  315. FreeOnComplete := True;
  316. {$IFNDEF DOTNET}
  317. try
  318. {$ENDIF}
  319. if Assigned(FOnWriteFile) then begin
  320. FOnWriteFile(Self, FileName, PeerInfo, CanWrite, LStream, FreeOnComplete);
  321. end;
  322. if not CanWrite then begin
  323. raise EIdTFTPAccessViolation.CreateFmt(RSTFTPAccessDenied, [FileName]);
  324. end;
  325. if LStream = nil then begin
  326. LStream := TIdFileCreateStream.Create(FileName);
  327. FreeOnComplete := True;
  328. end;
  329. if RequestedTransferSize >= 0 then
  330. begin
  331. try
  332. AdjustStreamSize(LStream, RequestedTransferSize);
  333. except
  334. IndyRaiseOuterException(EIdTFTPAllocationExceeded.CreateFmt(RSTFTPDiskFull, [0]));
  335. end;
  336. end;
  337. TIdTFTPServerReceiveFileThread.Create(Self, Mode, PeerInfo, LStream, FreeOnComplete, RequestedBlockSize, RequestedTransferSize);
  338. {$IFNDEF DOTNET}
  339. except
  340. // TODO: implement this in a platform-neutral manner. EFCreateError is VCL-specific
  341. on E: EFCreateError do begin
  342. IndyRaiseOuterException(EIdTFTPAllocationExceeded.Create(E.Message));
  343. end;
  344. end;
  345. {$ENDIF}
  346. end;
  347. function TIdTrivialFTPServer.StrToMode(mode: string): TIdTFTPMode;
  348. begin
  349. case PosInStrArray(mode, ['octet', 'binary', 'netascii'], False) of {Do not Localize}
  350. 0, 1: Result := tfOctet;
  351. 2: Result := tfNetAscii;
  352. else
  353. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnsupportedTrxMode, [mode]); // unknown mode
  354. end;
  355. end;
  356. destructor TIdTrivialFTPServer.Destroy;
  357. begin
  358. {
  359. if (not ThreadedEvent) and (ActiveThreads>0) then
  360. begin
  361. //some kind of error/warning about deadlock or possible AV due to
  362. //soon-to-be invalid pointer in the threads? (FOwner: TIdTrivialFTPServer;)
  363. //raise CantFreeYet?
  364. end;
  365. }
  366. //wait for threads to finish before we shutdown
  367. //should we set thread[i].terminated, or just wait?
  368. if ThreadedEvent then
  369. begin
  370. while FThreadList.Count > 0 do
  371. begin
  372. IndySleep(100);
  373. end;
  374. end;
  375. FreeAndNil(FThreadList);
  376. inherited Destroy;
  377. end;
  378. function TIdTrivialFTPServer.ActiveThreads: Integer;
  379. begin
  380. Result := FThreadList.Count;
  381. end;
  382. { TIdTFTPServerThread }
  383. constructor TIdTFTPServerThread.Create(AOwner: TIdTrivialFTPServer;
  384. const Mode: TIdTFTPMode; const PeerInfo: TPeerInfo; AStream: TStream;
  385. const FreeStreamOnTerminate: boolean; const RequestedBlockSize: Integer);
  386. begin
  387. inherited Create(False);
  388. FreeOnTerminate := True;
  389. FStream := AStream;
  390. FFreeStrm := FreeStreamOnTerminate;
  391. FOwner := AOwner;
  392. FUDPClient := TIdUDPClient.Create(nil);
  393. FUDPClient.IPVersion := FOwner.IPVersion;
  394. FUDPClient.ReceiveTimeout := 1500;
  395. FUDPClient.Host := PeerInfo.PeerIP;
  396. FUDPClient.Port := PeerInfo.PeerPort;
  397. FUDPClient.BufferSize := RequestedBlockSize + 4;
  398. FOwner.FThreadList.Add(Self);
  399. end;
  400. destructor TIdTFTPServerThread.Destroy;
  401. begin
  402. if FFreeStrm then begin
  403. FreeAndNil(FStream);
  404. end;
  405. FreeAndNil(FUDPClient);
  406. FOwner.FThreadList.Remove(Self);
  407. inherited Destroy;
  408. end;
  409. procedure TIdTFTPServerThread.AfterRun;
  410. begin
  411. if FOwner.ThreadedEvent then begin
  412. TransferComplete;
  413. end else begin
  414. Synchronize(TransferComplete);
  415. end;
  416. end;
  417. procedure TIdTFTPServerThread.BeforeRun;
  418. begin
  419. FBlkCounter := 0;
  420. FRetryCtr := 0;
  421. FEOT := False;
  422. if FUDPClient.BufferSize <> 516 then
  423. begin
  424. FResponse := ToBytes(GStack.HostToNetwork(UInt16(TFTP_OACK)));
  425. AppendString(FResponse, sBlockSize, -1, IndyTextEncoding_ASCII);
  426. AppendByte(FResponse, 0);
  427. AppendString(FResponse, IntToStr(FUDPClient.BufferSize - 4), -1, IndyTextEncoding_ASCII);
  428. AppendByte(FResponse, 0);
  429. end else begin
  430. SetLength(FResponse, 0);
  431. end;
  432. end;
  433. function TIdTFTPServerThread.HandleRunException(AException: Exception): Boolean;
  434. begin
  435. Result := False;
  436. SendError(FUDPClient, AException);
  437. end;
  438. procedure TIdTFTPServerThread.TransferComplete;
  439. var
  440. PeerInfo: TPeerInfo;
  441. begin
  442. PeerInfo.PeerIP := FUDPClient.Host;
  443. PeerInfo.PeerPort := FUDPClient.Port;
  444. FOwner.DoTransferComplete(FEOT, PeerInfo, FStream, Self is TIdTFTPServerReceiveFileThread);
  445. end;
  446. { TIdTFTPServerSendFileThread }
  447. constructor TIdTFTPServerSendFileThread.Create(AOwner: TIdTrivialFTPServer;
  448. const Mode: TIdTFTPMode; const PeerInfo: TPeerInfo; AStream: TStream;
  449. const FreeStreamOnTerminate: boolean; const RequestedBlockSize: Integer;
  450. SendTransferSize: Boolean);
  451. begin
  452. inherited Create(AOwner, Mode, PeerInfo, AStream, FreeStreamOnTerminate, RequestedBlockSize);
  453. FSendTransferSize := SendTransferSize;
  454. end;
  455. procedure TIdTFTPServerSendFileThread.BeforeRun;
  456. begin
  457. inherited BeforeRun;
  458. if FSendTransferSize then
  459. begin
  460. if Length(FResponse) = 0 then begin
  461. FResponse := ToBytes(GStack.HostToNetwork(UInt16(TFTP_OACK)));
  462. end;
  463. AppendString(FResponse, sTransferSize, -1, IndyTextEncoding_ASCII);
  464. AppendByte(FResponse, 0);
  465. AppendString(FResponse, IntToStr(FStream.Size - FStream.Position), -1, IndyTextEncoding_ASCII);
  466. AppendByte(FResponse, 0);
  467. end;
  468. end;
  469. procedure TIdTFTPServerSendFileThread.Run;
  470. var
  471. Buffer: TIdBytes;
  472. LPeerIP: string;
  473. LPeerPort: TIdPort;
  474. i: Integer;
  475. begin
  476. if Length(FResponse) = 0 then begin // generate a new response packet for client
  477. if FBlkCounter = High(UInt16) then begin
  478. raise EIdTFTPAllocationExceeded.Create('');
  479. end;
  480. Inc(FBlkCounter);
  481. SetLength(FResponse, FUDPClient.BufferSize);
  482. CopyTIdUInt16(GStack.HostToNetwork(UInt16(TFTP_DATA)), FResponse, 0);
  483. CopyTIdUInt16(GStack.HostToNetwork(FBlkCounter), FResponse, 2);
  484. i := ReadTIdBytesFromStream(FStream, FResponse, FUDPClient.BufferSize - 4, 4);
  485. SetLength(FResponse, 4 + i);
  486. if i < (FUDPClient.BufferSize - 4) then begin
  487. FEOT := True;
  488. end;
  489. FRetryCtr := 0;
  490. end;
  491. if FRetryCtr = 3 then begin
  492. raise EIdTFTPIllegalOperation.Create(RSTimeOut); // Timeout
  493. end;
  494. FUDPClient.SendBuffer(FResponse);
  495. SetLength(Buffer, FUDPClient.BufferSize);
  496. i := FUDPClient.ReceiveBuffer(Buffer, LPeerIP, LPeerPort);
  497. if i <= 0 then begin
  498. if FEOT then begin
  499. Stop;
  500. Exit;
  501. end;
  502. Inc(FRetryCtr);
  503. Exit;
  504. end;
  505. SetLength(Buffer, i);
  506. // TODO: validate the correct peer is sending the data...
  507. case GStack.NetworkToHost(BytesToUInt16(Buffer)) of
  508. TFTP_ACK:
  509. begin
  510. i := GStack.NetworkToHost(BytesToUInt16(Buffer, 2));
  511. if i = FBlkCounter then begin
  512. SetLength(FResponse, 0);
  513. end;
  514. if FEOT then begin
  515. Stop;
  516. Exit;
  517. end;
  518. end;
  519. TFTP_DATA:
  520. begin
  521. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [FUDPClient.Host, FUDPClient.Port]);
  522. end;
  523. TFTP_ERROR:
  524. begin
  525. Abort;
  526. end;
  527. else
  528. begin
  529. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [FUDPClient.Host, FUDPClient.Port]);
  530. end;
  531. end;
  532. end;
  533. { TIdTFTPServerReceiveFileThread }
  534. constructor TIdTFTPServerReceiveFileThread.Create(AOwner: TIdTrivialFTPServer;
  535. const Mode: TIdTFTPMode; const PeerInfo: TPeerInfo; AStream: TStream;
  536. const FreeStreamOnTerminate: Boolean; const RequestedBlockSize: Integer;
  537. const RequestedTransferSize: TIdStreamSize);
  538. begin
  539. inherited Create(AOwner, Mode, PeerInfo, AStream, FreeStreamOnTerminate, RequestedBlockSize);
  540. FTransferSize := RequestedTransferSize;
  541. end;
  542. procedure TIdTFTPServerReceiveFileThread.BeforeRun;
  543. begin
  544. inherited BeforeRun;
  545. FReceivedSize := 0;
  546. if FTransferSize <> -1 then
  547. begin
  548. if Length(FResponse) = 0 then begin
  549. FResponse := ToBytes(GStack.HostToNetwork(UInt16(TFTP_OACK)));
  550. end;
  551. AppendString(FResponse, sTransferSize, -1, IndyTextEncoding_ASCII);
  552. AppendByte(FResponse, 0);
  553. AppendString(FResponse, IntToStr(FTransferSize), -1, IndyTextEncoding_ASCII);
  554. AppendByte(FResponse, 0);
  555. end;
  556. if Length(FResponse) > 0 then begin
  557. // RLebeau: sending an OACK instead of an ACK, so expect
  558. // the next packet received to be a DATA packet...
  559. FBlkCounter := 1;
  560. end;
  561. end;
  562. {$IFNDEF DOTNET}
  563. function TIdTFTPServerReceiveFileThread.HandleRunException(AException: Exception): Boolean;
  564. begin
  565. // TODO: implement this in a platform-neutral manner. EWriteError is VCL-specific
  566. if AException is EWriteError then
  567. begin
  568. Result := False;
  569. SendError(FUDPClient, ErrAllocationExceeded, IndyFormat(RSTFTPDiskFull, [FStream.Position]));
  570. Exit;
  571. end;
  572. Result := inherited HandleRunException(AException);
  573. end;
  574. {$ENDIF}
  575. procedure TIdTFTPServerReceiveFileThread.Run;
  576. var
  577. Buffer: TIdBytes;
  578. LPeerIP: string;
  579. LPeerPort: TIdPort;
  580. i: TIdStreamSize;
  581. begin
  582. if Length(FResponse) = 0 then begin
  583. FResponse := MakeActPkt(FBlkCounter);
  584. if FBlkCounter = High(UInt16) then begin
  585. FEOT := True;
  586. end else begin
  587. Inc(FBlkCounter);
  588. end;
  589. FRetryCtr := 0;
  590. end;
  591. if FRetryCtr = 3 then begin
  592. raise EIdTFTPIllegalOperation.Create(RSTimeOut); // Timeout
  593. end;
  594. FUDPClient.SendBuffer(FResponse);
  595. SetLength(Buffer, FUDPClient.BufferSize);
  596. i := FUDPClient.ReceiveBuffer(Buffer, LPeerIP, LPeerPort);
  597. if i <= 0 then begin
  598. if FEOT then begin
  599. Stop;
  600. Exit;
  601. end;
  602. Inc(FRetryCtr);
  603. Exit;
  604. end;
  605. SetLength(Buffer, i);
  606. // TODO: validate the correct peer is sending the data...
  607. case GStack.NetworkToHost(BytesToUInt16(Buffer)) of
  608. TFTP_ACK:
  609. begin
  610. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [FUDPClient.Host, FUDPClient.Port]);
  611. end;
  612. TFTP_DATA:
  613. begin
  614. i := GStack.NetworkToHost(BytesToUInt16(Buffer, 2));
  615. if i = FBlkCounter then
  616. begin
  617. if FEOT then begin
  618. raise EIdTFTPAllocationExceeded.CreateFmt(RSTFTPDiskFull, [FStream.Position]);
  619. end;
  620. if (FTransferSize >= 0) and ((FTransferSize - FReceivedSize) < (Length(Buffer) - 4)) then
  621. begin
  622. WriteTIdBytesToStream(FStream, Buffer, FTransferSize - FReceivedSize, 4);
  623. FReceivedSize := FTransferSize;
  624. FEOT := True;
  625. raise EIdTFTPAllocationExceeded.CreateFmt(RSTFTPDiskFull, [FStream.Position]);
  626. end;
  627. WriteTIdBytesToStream(FStream, Buffer, Length(Buffer) - 4, 4);
  628. Inc(FReceivedSize, Length(Buffer) - 4);
  629. SetLength(FResponse, 0);
  630. FEOT := (Length(Buffer) - 4) < (FUDPClient.BufferSize - 4);
  631. end;
  632. end;
  633. TFTP_ERROR:
  634. begin
  635. Abort;
  636. end;
  637. else
  638. begin
  639. raise EIdTFTPIllegalOperation.CreateFmt(RSTFTPUnexpectedOp, [FUDPClient.Host, FUDPClient.Port]);
  640. end;
  641. end;
  642. end;
  643. end.