restemplate/indy/Protocols/IdTrivialFTP.pas

492 lines
16 KiB
Plaintext
Raw Normal View History

{
$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.7 2/8/05 6:08:04 PM RLebeau
Changed CheckOptionAck() to use TextIsSame() instead of SameText()
Rev 1.6 7/23/04 6:41:50 PM RLebeau
TFileStream access right tweak for Put()
Rev 1.5 2/7/2004 7:25:58 PM JPMugaas
Deleted error msg code in error packet. OOPS!!!
Rev 1.4 2/7/2004 7:20:16 PM JPMugaas
DotNET to go!! and YES - I want fries with that :-).
Rev 1.3 2004.02.03 5:44:38 PM czhower
Name changes
Rev 1.2 1/21/2004 4:21:04 PM JPMugaas
InitComponent
Rev 1.1 2003.10.12 6:36:46 PM czhower
Now compiles.
Rev 1.0 11/13/2002 08:03:32 AM JPMugaas
}
unit IdTrivialFTP;
interface
{$i IdCompilerDefines.inc}
uses
Classes,
IdAssignedNumbers,
IdGlobal,
IdTrivialFTPBase,
IdUDPClient;
const
GTransferMode = tfOctet;
GFRequestedBlockSize = 1500;
GReceiveTimeout = 4000;
type
TIdTrivialFTP = class(TIdUDPClient)
protected
FMode: TIdTFTPMode;
FRequestedBlockSize: Integer;
FPeerPort: TIdPort;
FPeerIP: String;
function ModeToStr: string;
procedure CheckOptionAck(const OptionPacket: TIdBytes; Reading: Boolean);
protected
procedure SendAck(const BlockNumber: UInt16);
procedure RaiseError(const ErrorPacket: TIdBytes);
procedure InitComponent; override;
public
procedure Get(const ServerFile: String; DestinationStream: TStream); overload;
procedure Get(const ServerFile, LocalFile: String); overload;
procedure Put(SourceStream: TStream; const ServerFile: String); overload;
procedure Put(const LocalFile, ServerFile: String); overload;
published
property TransferMode: TIdTFTPMode read FMode write FMode Default GTransferMode;
property RequestedBlockSize: Integer read FRequestedBlockSize write FRequestedBlockSize default 1500;
property OnWork;
property OnWorkBegin;
property OnWorkEnd;
end;
implementation
uses
{$IFDEF DOTNET}
IdStreamNET,
{$ELSE}
IdStreamVCL,
{$ENDIF}
IdComponent,
IdExceptionCore,
IdGlobalProtocols,
IdResourceStringsProtocols,
IdStack,
SysUtils;
procedure TIdTrivialFTP.CheckOptionAck(const OptionPacket: TIdBytes; Reading: Boolean);
var
LOptName, LOptValue: String;
LOffset, Idx, OptionIdx: Integer;
LRequestedBlkSize: Integer;
begin
LOffset := 2; // skip packet opcode
try
while LOffset < Length(OptionPacket) do
begin
Idx := ByteIndex(0, OptionPacket, LOffset);
if Idx = -1 then begin
raise EIdTFTPOptionNegotiationFailed.Create('');
end;
LOptName := BytesToString(OptionPacket, LOffset, Idx-LOffset, IndyTextEncoding_ASCII);
LOffset := Idx+1;
Idx := ByteIndex(0, OptionPacket, LOffset);
if Idx = -1 then begin
raise EIdTFTPOptionNegotiationFailed.Create('');
end;
LOptValue := BytesToString(OptionPacket, LOffset, Idx-LOffset, IndyTextEncoding_ASCII);
LOffset := Idx+1;
OptionIdx := PosInStrArray(LOptName, [sBlockSize, sTransferSize], False);
if OptionIdx = -1 then begin
// RLebeau 12/6/2011: workaround for bug in PicoMOD3 devices
if (LOptName = '') and (LOptValue = '') then begin
Continue;
end;
raise EIdTFTPOptionNegotiationFailed.CreateFmt(RSTFTPUnsupportedOption, [LOptName]);
end;
case OptionIdx of
0:
begin
LRequestedBlkSize := IndyStrToInt(LOptValue);
if (LRequestedBlkSize < 8) or (LRequestedBlkSize > 65464) then begin
raise EIdTFTPOptionNegotiationFailed.CreateFmt(RSTFTPUnsupportedOptionValue, [LOptValue, LOptName]);
end;
BufferSize := 4 + LRequestedBlkSize;
end;
1:
begin
if Reading then
begin
// TODO
{
if (IndyStrToInt(LOptValue) is not available) then begin
raise EIdTFTPAllocationExceeded.Create('');
end;
}
end;
end;
end;
end;
except
on E: Exception do begin
SendError(Self, FPeerIP, FPeerPort, E);
raise;
end;
end;
end;
procedure TIdTrivialFTP.InitComponent;
begin
inherited;
TransferMode := GTransferMode;
Port := IdPORT_TFTP;
FRequestedBlockSize := GFRequestedBlockSize;
ReceiveTimeout := GReceiveTimeout;
end;
procedure TIdTrivialFTP.Get(const ServerFile: String; DestinationStream: TStream);
var
Buffer, LServerFile, LMode, LBlockSize, LBlockOctets, LTransferSize, LTransferOctets: TIdBytes;
DataLen, LOffset: Integer;
ExpectedBlockCtr, RecvdBlockCtr: UInt16;
TerminateTransfer: Boolean;
begin
try
BufferSize := 4 + 512; // 512 as specified by RFC 1350
LServerFile := ToBytes(ServerFile);
LMode := ToBytes(ModeToStr);
LBlockSize := ToBytes(sBlockSize);
LBlockOctets := ToBytes(IntToStr(FRequestedBlockSize));
LTransferSize := ToBytes(sTransferSize);
LTransferOctets := ToBytes(IntToStr(0));
SetLength(Buffer, 2+Length(LServerFile)+1+Length(LMode)+1+Length(LBlockSize)+1+Length(LBlockOctets)+1+Length(LTransferSize)+1+Length(LTransferOctets)+1);
LOffset := 0;
CopyTIdUInt16(GStack.HostToNetwork(UInt16(TFTP_RRQ)), Buffer, LOffset);
Inc(LOffset, 2);
CopyTIdBytes(LServerFile, 0, Buffer, LOffset, Length(LServerFile));
Inc(LOffset, Length(LServerFile));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LMode, 0, Buffer, LOffset, Length(LMode));
Inc(LOffset, Length(LMode));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LBlockSize, 0, Buffer, LOffset, Length(LBlockSize));
Inc(LOffset, Length(LBlockSize));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LBlockOctets, 0, Buffer, LOffset, Length(LBlockOctets));
Inc(LOffset, Length(LBlockOctets));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LTransferSize, 0, Buffer, LOffset, Length(LTransferSize));
Inc(LOffset, Length(LTransferSize));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LTransferOctets, 0, Buffer, LOffset, Length(LTransferOctets));
Inc(LOffset, Length(LTransferOctets));
Buffer[LOffset] := 0;
SendBuffer(Buffer);
ExpectedBlockCtr := 1;
TerminateTransfer := False;
BeginWork(wmRead);
try
repeat
SetLength(Buffer, BufferSize);
DataLen := ReceiveBuffer(Buffer, FPeerIP, FPeerPort, ReceiveTimeout);
if DataLen <= 0 then begin
// TODO: re-transmit the last sent packet again instead of erroring...
raise EIdTFTPException.Create(RSTimeOut);
end;
SetLength(Buffer, DataLen);
// TODO: validate the correct peer is sending the data...
case GStack.NetworkToHost(BytesToUInt16(Buffer)) of
TFTP_DATA:
begin
RecvdBlockCtr := GStack.NetworkToHost(BytesToUInt16(Buffer, 2));
if RecvdBlockCtr = ExpectedBlockCtr then
begin
DataLen := Length(Buffer) - 4;
try
WriteTIdBytesToStream(DestinationStream, Buffer, DataLen, 4);
DoWork(wmRead, DataLen);
except
on E: Exception do
begin
SendError(Self, FPeerIP, FPeerPort, E);
raise;
end;
end;
SendAck(RecvdBlockCtr);
if RecvdBlockCtr = High(UInt16) then begin
if Length(Buffer) >= BufferSize then begin
// have reached the max block counter allowed, can't validate any more data...
SendError(Self, FPeerIP, FPeerPort, ErrIllegalOperation, '');
raise EIdTFTPException.CreateFmt(RSTFTPUnexpectedOp, [FPeerIP, FPeerPort]);
end;
TerminateTransfer := True; // end of transfer, a block counter cannot wrap back to 0
end else begin
ExpectedBlockCtr := RecvdBlockCtr + 1;
TerminateTransfer := Length(Buffer) < BufferSize;
end;
end;
end;
TFTP_ERROR:
begin
RaiseError(Buffer);
end;
TFTP_OACK:
begin
CheckOptionAck(Buffer, True);
SendAck(0);
end;
else
begin
SendError(Self, FPeerIP, FPeerPort, ErrIllegalOperation, '');
raise EIdTFTPException.CreateFmt(RSTFTPUnexpectedOp, [FPeerIP, FPeerPort]);
end;
end;
until TerminateTransfer;
finally
EndWork(wmRead);
end;
finally
Binding.CloseSocket;
end;
end;
procedure TIdTrivialFTP.Get(const ServerFile, LocalFile: String);
var
fs: TFileStream;
begin
fs := TIdFileCreateStream.Create(LocalFile);
try
Get(ServerFile, fs);
finally
FreeAndNil(fs);
end;
end;
function TIdTrivialFTP.ModeToStr: string;
begin
case TransferMode of
tfNetAscii: Result := 'netascii'; {Do not Localize}
tfOctet: Result := 'octet'; {Do not Localize}
end;
end;
procedure TIdTrivialFTP.Put(SourceStream: TStream; const ServerFile: String);
var
Buffer, LServerFile, LMode, LBlockSize, LBlockOctets, LTransferSize, LTransferOctets: TIdBytes;
StreamLen: TIdStreamSize;
LOffset, DataLen: Integer;
ExpectedBlockCtr, RecvdBlockCtr, wOp: UInt16;
TerminateTransfer, WaitingForAck: Boolean;
procedure SendDataPacket(const BlockNumber: UInt16);
begin
DataLen := IndyMin(BufferSize-4, StreamLen);
SetLength(Buffer, 4 + DataLen);
CopyTIdUInt16(GStack.HostToNetwork(UInt16(TFTP_DATA)), Buffer, 0);
CopyTIdUInt16(GStack.HostToNetwork(BlockNumber), Buffer, 2);
try
DataLen := ReadTIdBytesFromStream(SourceStream, Buffer, DataLen, 4);
except
on E: Exception do
begin
SendError(Self, FPeerIP, FPeerPort, E);
raise;
end;
end;
SetLength(Buffer, 4 + DataLen);
SendBuffer(FPeerIP, FPeerPort, Buffer);
WaitingForAck := True;
DoWork(wmWrite, DataLen);
Dec(StreamLen, DataLen);
TerminateTransfer := DataLen < (BufferSize - 4);
ExpectedBlockCtr := BlockNumber;
end;
begin
try
BufferSize := 4 + 512; // 512 as specified by RFC 1350
StreamLen := SourceStream.Size - SourceStream.Position;
LServerFile := ToBytes(ServerFile);
LMode := ToBytes(ModeToStr);
LBlockSize := ToBytes(sBlockSize);
LBlockOctets := ToBytes(IntToStr(FRequestedBlockSize));
LTransferSize := ToBytes(sTransferSize);
LTransferOctets := ToBytes(IntToStr(StreamLen));
SetLength(Buffer, 2+Length(LServerFile)+1+Length(LMode)+1+Length(LBlockSize)+1+Length(LBlockOctets)+1+Length(LTransferSize)+1+Length(LTransferOctets)+1);
LOffset := 0;
CopyTIdUInt16(GStack.HostToNetwork(UInt16(TFTP_WRQ)), Buffer, LOffset);
Inc(LOffset, 2);
CopyTIdBytes(LServerFile, 0, Buffer, LOffset, Length(LServerFile));
Inc(LOffset, Length(LServerFile));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LMode, 0, Buffer, LOffset, Length(LMode));
Inc(LOffset, Length(LMode));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LBlockSize, 0, Buffer, LOffset, Length(LBlockSize));
Inc(LOffset, Length(LBlockSize));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LBlockOctets, 0, Buffer, LOffset, Length(LBlockOctets));
Inc(LOffset, Length(LBlockOctets));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LTransferSize, 0, Buffer, LOffset, Length(LTransferSize));
Inc(LOffset, Length(LTransferSize));
Buffer[LOffset] := 0;
Inc(LOffset);
CopyTIdBytes(LTransferOctets, 0, Buffer, LOffset, Length(LTransferOctets));
Inc(LOffset, Length(LTransferOctets));
Buffer[LOffset] := 0;
SendBuffer(Buffer);
ExpectedBlockCtr := 0;
TerminateTransfer := False;
BeginWork(wmWrite, StreamLen);
try
repeat
SetLength(Buffer, BufferSize);
DataLen := ReceiveBuffer(Buffer, FPeerIP, FPeerPort, IndyMax(500, ReceiveTimeout));
if DataLen <= 0 then begin
// TODO: re-transmit the last sent packet again instead of erroring...
raise EIdTFTPException.Create(RSTimeOut);
end;
SetLength(Buffer, DataLen);
// TODO: validate the correct peer is sending the data...
wOp := GStack.NetworkToHost(BytesToUInt16(Buffer));
case wOp of
TFTP_ACK:
begin
RecvdBlockCtr := GStack.NetworkToHost(BytesToUInt16(Buffer, 2));
if RecvdBlockCtr = ExpectedBlockCtr then
begin
WaitingForAck := False;
if not TerminateTransfer then
begin
if RecvdBlockCtr = High(UInt16) then
begin
// end of transfer, a block counter cannot wrap back to 0
SendError(Self, FPeerIP, FPeerPort, ErrAllocationExceeded, '');
raise EIdTFTPAllocationExceeded.Create('');
end;
SendDataPacket(RecvdBlockCtr+1);
end;
end;
end;
TFTP_OACK:
begin
if ExpectedBlockCtr <> 0 then
begin
SendError(Self, FPeerIP, FPeerPort, ErrIllegalOperation, '');
raise EIdTFTPException.CreateFmt(RSTFTPUnexpectedOp, [FPeerIP, FPeerPort]);
end;
CheckOptionAck(Buffer, False);
SendDataPacket(1);
end;
TFTP_ERROR:
begin
RaiseError(Buffer);
end;
else
begin
SendError(Self, FPeerIP, FPeerPort, ErrIllegalOperation, '');
raise EIdTFTPException.CreateFmt(RSTFTPUnexpectedOp, [FPeerIP, FPeerPort]);
end;
end;
until TerminateTransfer and (not WaitingForAck);
finally
EndWork(wmWrite);
end;
finally
Binding.CloseSocket;
end;
end;
procedure TIdTrivialFTP.Put(const LocalFile, ServerFile: String);
var
fs: TIdReadFileExclusiveStream;
begin
fs := TIdReadFileExclusiveStream.Create(LocalFile);
try
Put(fs, ServerFile);
finally
fs.Free;
end;
end;
procedure TIdTrivialFTP.RaiseError(const ErrorPacket: TIdBytes);
var
ErrMsg: string;
begin
ErrMsg := BytesToString(ErrorPacket, 4, Length(ErrorPacket)-4, IndyTextEncoding_ASCII);
case GStack.NetworkToHost(BytesToUInt16(ErrorPacket, 2)) of
ErrFileNotFound: raise EIdTFTPFileNotFound.Create(ErrMsg);
ErrAccessViolation: raise EIdTFTPAccessViolation.Create(ErrMsg);
ErrAllocationExceeded: raise EIdTFTPAllocationExceeded.Create(ErrMsg);
ErrIllegalOperation: raise EIdTFTPIllegalOperation.Create(ErrMsg);
ErrUnknownTransferID: raise EIdTFTPUnknownTransferID.Create(ErrMsg);
ErrFileAlreadyExists: raise EIdTFTPFileAlreadyExists.Create(ErrMsg);
ErrNoSuchUser: raise EIdTFTPNoSuchUser.Create(ErrMsg);
ErrOptionNegotiationFailed: raise EIdTFTPOptionNegotiationFailed.Create(ErrMsg);
else
// usually ErrUndefined (see EIdTFTPException.Message if any)
raise EIdTFTPException.Create(ErrMsg);
end;
end;
procedure TIdTrivialFTP.SendAck(const BlockNumber: UInt16);
begin
SendBuffer(FPeerIP, FPeerPort, MakeActPkt(BlockNumber));
end;
end.