aksdb
/
restemplate
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
restemplate/indy/Protocols/IdFSP.pas

1334 lines
39 KiB
Plaintext
Raw Permalink Normal View History

* Replaced fphttpclient with indy10. * Added compression support
2015-10-04 14:14:55 +02:00
{
$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.17 2/10/2005 2:24:38 PM JPMugaas
Minor Restructures for some new UnixTime Service components.
Rev 1.16 1/17/2005 7:29:12 PM JPMugaas
Now uses new TIdBuffer functionality.
Rev 1.15 1/9/2005 6:08:06 PM JPMugaas
Payload size now specified for CC_GET_FILE.
Now will raise exception if you specify a packet size less than 512.
Rev 1.12 11/12/2004 8:37:36 AM JPMugaas
Minor compile error. OOPS!!!
Rev 1.11 11/11/2004 11:22:54 PM JPMugaas
Removed an $IFDEF that's no longer needed.
Rev 1.10 11/8/2004 8:36:04 PM JPMugaas
Added value for command that may appear later.
Rev 1.9 11/7/2004 11:34:16 PM JPMugaas
Now uses inherited methods again. The inherited methods now use the Binding
methods we used here.
Rev 1.8 11/6/2004 1:46:34 AM JPMugaas
Minor bug fix for when there is no data in a reply to CC_GET_PRO.
Rev 1.7 11/5/2004 7:55:02 PM JPMugaas
Changed to use, Connect, Recv, Send, and Disconnect instead of ReceiveFrom
and SendTo. This should improve performance as we do make repeated contacts
to the host and UDP connect will cause the stack to filter out packets that
aren't from the peer. There should only be one DNS resolution per session
making this more efficient (cutting down to about 87 seconds to get a dir).
Rev 1.4 10/31/2004 1:49:58 AM JPMugaas
Now uses item type from TIdFTPList for dirs and files. We don't use Skip
items or end of dir marker items.
Rev 1.2 10/30/2004 10:23:58 PM JPMugaas
Should be much faster.
Rev 1.1 10/30/2004 7:04:26 PM JPMugaas
FSP Upload.
Rev 1.0 10/29/2004 12:34:20 PM JPMugaas
File Services Protocol implementation started
}
unit IdFSP;
interface
{$i IdCompilerDefines.inc}
uses
Classes,
IdException,
IdFTPList,
IdGlobal,
IdThreadSafe,
IdUDPClient;
{This is based on:
http://cvs.sourceforge.net/viewcvs.py/fsp/fsp/doc/PROTOCOL?rev=1.4&view=markup
and the Java Lib at fsp.sourceforge.net was also referenced.
I have verified this on a CygWin build of the FSP Server at fsp.sourceforge.net.
}
{
FSP Packet format:
HEADER - size = Fixed size 12 bytes. Always present.
DATA - size = defined in header (DATA_LENGTH)
XTRA DATA- size = packet_size - header_size (12) - DATA_LENGTH
Maximal data size DATA_LENGTH + XTRA_DATA length is 1024. Clients and servers
are not required to support XTRA DATA (but in current FSP implementation does).
If XTRA DATA are provided, there must be also contained in MESSAGE_CHECKSUM.
HEADER FORMAT (12 bytes)
byte FSP_COMMAND
byte MESSAGE_CHECKSUM
word KEY
word SEQUENCE
word DATA_LENGTH
long FILE_POSITION
MESSAGE_CHECKSUM
Entire packet (HEADER + DATA + XTRA DATA) is checksumed. When computing a
checksum use zero in place of MESSAGE_CHECKSUM header field.
Due to some unknown reason, method of computing checksums is different in each
direction. For packets travelling from server to client initial checksum
value is zero, otherwise it is HEADER + DATA + XTRA DATA size.
Checksums in server->client direction are computed as follows:
/* assume that we have already zeroed checksum in packet */
unsigned int sum,checksum;
for(t = packet_start, sum = 0; t < packet_end; sum += *t++);
checksum= sum + (sum >> 8);
KEY
Client's message to server contain a KEY value that is the same as the KEY
value of the previous message received from the server. KEY is choosen random
by server.
}
{
CC_VERSION 0x10- Get server version string and setup
request
file position: ignored
data: not used
xtra data: not used
reply
file position: size of optional extra version data
data: ASCIIZ Server version string
xtra data: optional extra version data
byte - FLAGS
bit 0 set - server does logging
bit 1 set - server is read only
bit 2 set - reverse lookup required
bit 3 set - server is in private mode
bit 4 set - thruput control
if bit 4 is set thruput info follows
long - max_thruput allowed (in bytes/sec)
word - max. packet size supported by server
}
const
IdPORT_FSP = 21;
HSIZE = 12; //header size
DEF_MAXSPACE = 1012; //data length
DEF_MAXSIZE = DEF_MAXSPACE+HSIZE; //default maximum packet size
//commands
CC_VERSION = $10; //Get server version string and setup
CC_INFO = $11; //return server's extended info block
CC_ERR = $40; //error response from server
CC_GET_DIR = $41; // get a directory listing
CC_GET_FILE = $42; // get a file
CC_UP_LOAD = $43; // open a file for writing
CC_INSTALL = $44; // close and install file opened for writing
CC_DEL_FILE = $45; // delete a file
CC_DEL_DIR = $46; // delete a directory
CC_GET_PRO = $47; // get directory protection
CC_SET_PRO = $48; // set directory protection
CC_MAKE_DIR = $49; // create a directory
CC_BYE = $4A; // finish a session
CC_GRAB_FILE = $4B; // atomic get+delete a file
CC_GRAB_DONE = $4C; // atomic get+delete a file done
CC_STAT = $4D; // get information about file/directory
CC_RENAME = $4E; // rename file or directory
CC_CH_PASSW = $4F; // change password
//Reserved commands:
CC_LIMIT = $80;
{ commands > 0x7F will have extended
header. No such extensions or commands
which uses that are known today. This
header will be used in protocol version 3. }
CC_TEST = $81; //reserved for testing of new header
RDTYPE_END = $00;
RDTYPE_FILE = $01;
RDTYPE_DIR = $02;
RDTYPE_SKIP = $2A; //42
MINTIMEOUT = 1340; //1.34 seconds
MAXTIMEOUT = 300000; //300 seconds
type
EIdFSPException = class(EIdException);
EIdFSPFileAlreadyExists = class(EIdFSPException);
EIdFSPFileNotFound = class(EIdFSPException);
EIdFSPProtException = class(EIdFSPException);
EIdFSPPacketTooSmall = class(EIdFSPException);
{
RDIRENT.HEADER types:
RDTYPE_END 0x00
RDTYPE_FILE 0x01
RDTYPE_DIR 0x02
RDTYPE_SKIP 0x2A
}
TIdFSPStatInfo = class(TCollectionItem)
protected
FModifiedDateGMT : TDateTime;
FModifiedDate: TDateTime;
//Size is Int64 in case FSP 3 has an expansion, otherise, it can only handle
//file sizes up 4 GB's. It's not a bug, it's a feature.
FSize: Int64;
FItemType :TIdDirItemType;
published
property ItemType :TIdDirItemType read FItemType write FItemType;
property Size: Int64 read FSize write FSize;
property ModifiedDate: TDateTime read FModifiedDate write FModifiedDate;
property ModifiedDateGMT : TDateTime read FModifiedDateGMT write FModifiedDateGMT;
end;
TIdFSPListItem = class(TIdFSPStatInfo)
protected
FFileName: string;
published
property FileName: string read FFileName write FFileName;
end;
TIdFSPListItems = class(TCollection)
protected
function GetItems(AIndex: Integer): TIdFSPListItem;
procedure SetItems(AIndex: Integer; const Value: TIdFSPListItem);
public
function Add: TIdFSPListItem;
constructor Create; reintroduce;
function ParseEntries(const AData : TIdBytes; const ADataLen : UInt32) : Boolean;
function IndexOf(AItem: TIdFSPListItem): Integer;
property Items[AIndex: Integer]: TIdFSPListItem read GetItems write SetItems; default;
end;
TIdFSPDirInfo = class(TObject)
protected
FOwnsDir,
FCanDeleteFiles,
FCanAddFiles,
FCanMakeDir,
FOnlyOwnerCanReadFiles,
FHasReadMe,
FCanBeListed,
FCanRenameFiles : Boolean;
FReadMe : String;
public
property OwnsDir : Boolean read FOwnsDir write FOwnsDir;
property CanDeleteFiles : Boolean read FCanDeleteFiles write FCanDeleteFiles;
property CanAddFiles : Boolean read FCanAddFiles write FCanAddFiles;
property CanMakeDir : Boolean read FCanMakeDir write FCanMakeDir;
property OnlyOwnerCanReadFiles : Boolean read FOnlyOwnerCanReadFiles write FOnlyOwnerCanReadFiles;
property HasReadMe : Boolean read FHasReadMe write FHasReadMe;
{
Compatibility
Versions older than 2.8.1b6 do not uses bits 6 and 7. This
causes that directory can be listable even it do not have
6th bit set.
}
property CanBeListed : Boolean read FCanBeListed write FCanBeListed;
property CanRenameFiles : Boolean read FCanRenameFiles write FCanRenameFiles;
property ReadMe : String read FReadMe write FReadMe;
end;
TIdFSPPacket = class(TObject)
protected
FCmd: Byte;
FFilePosition: UInt32;
FData: TIdBytes;
FDataLen : Word;
FExtraData: TIdBytes;
// FExtraDataLen : UInt32;
FSequence: Word;
FKey: Word;
FValid : Boolean;
public
constructor Create;
function WritePacket : TIdBytes;
procedure ReadPacket(const AData : TIdBytes; const ALen : UInt32);
property Valid : Boolean read FValid;
property Cmd : Byte read FCmd write FCmd;
property Key : Word read FKey write FKey;
property Sequence : Word read FSequence write FSequence;
property FilePosition : UInt32 read FFilePosition write FFilePosition;
property Data : TIdBytes read FData write FData;
property DataLen : Word read FDataLen write FDataLen;
property ExtraData : TIdBytes read FExtraData write FExtraData;
// property WritePacket : TIdBytes read GetWritePacket write SetWritePacket;
end;
TIdFSPLogEvent = procedure (Sender : TObject; APacket : TIdFSPPacket) of object;
TIdFSP = class(TIdUDPClient)
protected
FConEstablished : Boolean;
FSequence : Word;
FKey : Word;
FSystemDesc: string;
FSystemServerLogs : Boolean;
FSystemReadOnly : Boolean;
FSystemReverseLookupRequired : Boolean;
FSystemPrivateMode : Boolean;
FSystemAcceptsExtraData : Boolean;
FThruputControl : Boolean;
FServerMaxThruPut : UInt32; //bytes per sec
FServerMaxPacketSize : Word; //maximum packet size server supports
FClientMaxPacketSize : Word; //maximum packet we wish to support
FDirectoryListing: TIdFSPListItems;
FDirInfo : TIdFSPDirInfo;
FStatInfo : TIdFSPStatInfo;
FOnRecv, FOnSend : TIdFSPLogEvent;
FAbortFlag : TIdThreadSafeBoolean;
FInCmd : TIdThreadSafeBoolean;
//note: This is optimized for performance - DO NOT MESS with it even if you don't like it
//or think its wrong. There is a performance penalty that is noticable with downloading,
//uploading, and dirs because those use a series of packets - not one and we limited in
//packet size. We also do not want to eat CPU cycles excessively which I've noticed
//with previous code.
procedure SendCmdOnce(ACmdPacket, ARecvPacket : TIdFSPPacket; var VTempBuf : TIdBytes; const ARaiseException : Boolean=True); overload;
procedure SendCmdOnce(const ACmd : Byte; const AData, AExtraData : TIdBytes;
const AFilePosition : Int64; //in case FSP 3.0 does support more than 4GB
var VData, VExtraData : TIdBytes; const ARaiseException : Boolean=True); overload;
procedure SendCmd(ACmdPacket, ARecvPacket : TIdFSPPacket; var VTempBuf : TIdBytes; const ARaiseException : Boolean=True); overload;
procedure SendCmd(const ACmd : Byte; const AData, AExtraData : TIdBYtes;
const AFilePosition : Int64; //in case FSP 3.0 does support more than 4GB
var VData, VExtraData : TIdBytes; const ARaiseException : Boolean=True); overload;
procedure SendCmd(const ACmd : Byte; const AData : TIdBYtes;
const AFilePosition : Int64; //in case FSP 3.0 does support more than 4GB
var VData, VExtraData : TIdBytes; const ARaiseException : Boolean=True); overload;
procedure ParseDirInfo(const ABuf, AExtraBuf: TIdBytes; ADir : TIdFSPDirInfo);
procedure InitComponent; override;
function MaxBufferSize : Word;
function PrefPayloadSize : Word;
procedure SetClientMaxPacketSize(const AValue: Word);
public
destructor Destroy; override;
procedure Connect; override; //this is so we can use it similarly to FTP
procedure Disconnect; override;
procedure Version;
procedure AbortCmd;
procedure Delete(const AFilename: string);
procedure RemoveDir(const ADirName: string);
procedure Rename(const ASourceFile, ADestFile: string);
procedure MakeDir(const ADirName: string);
//this is so we can use it similarly to FTP
//and also sends a BYE command which is the courteous thing to do.
procedure List; overload;
procedure List(const ASpecifier: string); overload;
procedure GetDirInfo(const ADIR : String); overload;
procedure GetDirInfo(const ADIR : String; ADirInfo : TIdFSPDirInfo); overload;
procedure GetStatInfo(const APath : String);
procedure Get(const ASourceFile, ADestFile: string; const ACanOverwrite: Boolean = False;
AResume: Boolean = False); overload;
procedure Get(const ASourceFile: string; ADest: TStream; AResume: Boolean = False); overload;
procedure Put(const ASource: TStream; const ADestFile: string; const AGMTTime : TDateTime = 0); overload;
procedure Put(const ASourceFile: string; const ADestFile: string=''); overload;
property SystemDesc: string read FSystemDesc;
property SystemServerLogs : Boolean read FSystemServerLogs;
property SystemReadOnly : Boolean read FSystemReadOnly;
property SystemReverseLookupRequired : Boolean read FSystemReverseLookupRequired;
property SystemPrivateMode : Boolean read FSystemPrivateMode;
property SystemAcceptsExtraData : Boolean read FSystemAcceptsExtraData;
property ThruputControl : Boolean read FThruputControl;
property ServerMaxThruPut : UInt32 read FServerMaxThruPut;
property ServerMaxPacketSize : Word read FServerMaxPacketSize;
property ClientMaxPacketSize : Word read FClientMaxPacketSize write SetClientMaxPacketSize;
property DirectoryListing: TIdFSPListItems read FDirectoryListing;
property DirInfo : TIdFSPDirInfo read FDirInfo;
property StatInfo : TIdFSPStatInfo read FStatInfo;
published
property Port default IdPORT_FSP;
property OnWork;
property OnWorkBegin;
property OnWorkEnd;
property OnRecv : TIdFSPLogEvent read FOnRecv write FOnRecv;
property OnSend : TIdFSPLogEvent read FOnSend write FOnSend;
end;
implementation
uses
//facilitate inlining only.
{$IFDEF KYLIXCOMPAT}
Libc,
{$ENDIF}
{$IFDEF USE_VCL_POSIX}
Posix.SysSelect,
Posix.SysTime,
Posix.Unistd,
{$ENDIF}
{$IFDEF WINDOWS}
{$IFDEF USE_INLINE}
Windows,
{$ELSE}
//facilitate inlining only.
{$IFDEF VCL_2009_OR_ABOVE}
Windows,
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$IFDEF DOTNET}
{$IFDEF USE_INLINE}
System.IO,
System.Threading,
{$ENDIF}
{$ENDIF}
IdComponent, IdGlobalProtocols, IdResourceStringsProtocols, IdStack, IdStream, SysUtils;
function ParseASCIIZPos(const ABytes: TIdBytes ; const ALen : UInt32; var VPos : UInt32): String;
var
i : UInt32;
begin
if VPos < ALen then begin
for i := VPos to ALen-1 do begin
if ABytes[i] = 0 then begin
Break;
end;
end;
VPos := i;
Result := BytesToString(ABytes, i);
end else begin
Result := '';
end;
end;
function ParseASCIIZLen(const ABytes : TIdBytes; const ALen : UInt32) : String;
var
LPos : UInt32;
begin
LPos := 0;
Result := ParseASCIIZPos(ABytes, ALen, LPos);
end;
function ParseASCIIZ(const ABytes : TIdBytes) : String;
var
LPos : UInt32;
begin
LPos := 0;
Result := ParseASCIIZPos(ABytes, Length(ABytes), LPos);
end;
procedure ParseStatInfo(const AData : TIdBytes; VL : TIdFSPStatInfo; var VI : UInt32);
var
LC : UInt32;
begin
//we don't parse the file type because there is some variation between CC_GET_DIR and CC_STAT
CopyBytesToHostUInt32(AData, VI, LC);
VL.FModifiedDateGMT := UnixDateTimeToDelphiDateTime(LC);
VL.FModifiedDate := VL.FModifiedDateGMT + OffSetFromUTC;
Inc(VI, 4);
CopyBytesToHostUInt32(AData, VI, LC);
VL.Size := LC;
Inc(VI, 5); //we want to skip over the type byte we processed earlier
end;
{ TIdFSP }
procedure TIdFSP.Connect;
begin
FSequence := 1;
FKey := 0;
FServerMaxThruPut := 0;
FServerMaxPacketSize := DEF_MAXSIZE;
inherited Connect;
end;
destructor TIdFSP.Destroy;
begin
Disconnect;
FreeAndNil(FDirInfo);
FreeAndNil(FDirectoryListing);
FreeAndNil(FStatInfo);
FreeAndNil(FAbortFlag);
FreeAndNil(FInCmd);
inherited Destroy;
end;
procedure TIdFSP.Disconnect;
var
LBuf, LData, LExtra : TIdBytes;
begin
AbortCmd;
if FConEstablished then begin
SetLength(LBuf, 0);
SendCmd(CC_BYE, LBuf, 0, LData, LExtra);
inherited Disconnect;
end;
FConEstablished := False;
end;
procedure TIdFSP.Get(const ASourceFile: string; ADest: TStream; AResume: Boolean);
var
LSendPacket : TIdFSPPacket;
LRecvPacket : TIdFSPPacket;
LLen : Integer;
LTmpBuf : TIdBytes;
begin
SetLength(LTmpBuf, MaxBufferSize);
LSendPacket := TIdFSPPacket.Create;
try
LRecvPacket := TIdFSPPacket.Create;
try
if AResume then begin
LSendPacket.FFilePosition := ADest.Position;
end else begin
LSendPacket.FFilePosition := 0;
end;
LSendPacket.Cmd := CC_GET_FILE;
LSendPacket.FData := ToBytes(ASourceFile+#0);
LSendPacket.FDataLen := Length(LSendPacket.FData);
//specify a preferred block size
SetLength(LSendPacket.FExtraData, 2);
CopyTIdNetworkUInt16(PrefPayloadSize, LSendPacket.FExtraData, 0);
BeginWork(wmRead);
try
repeat
SendCmd(LSendPacket, LRecvPacket, LTmpBuf);
LLen := LRecvPacket.FDataLen; //Length(LRecvPacket.Data);
if LLen > 0 then begin
TIdStreamHelper.Write(ADest, LRecvPacket.Data, LLen);
DoWork(wmRead, LLen);
Inc(LSendPacket.FFilePosition, LLen);
end else begin
Break;
end;
until False;
finally
EndWork(wmRead);
end;
finally
FreeAndNil(LRecvPacket);
end;
finally
FreeAndNil(LSendPacket);
end;
end;
procedure TIdFSP.Get(const ASourceFile, ADestFile: string; const ACanOverwrite: Boolean; AResume: Boolean);
var
LDestStream: TStream;
begin
if ACanOverwrite and (not AResume) then begin
SysUtils.DeleteFile(ADestFile);
LDestStream := TIdFileCreateStream.Create(ADestFile);
end
else if (not ACanOverwrite) and AResume then begin
LDestStream := TIdAppendFileStream.Create(ADestFile);
end
else begin
raise EIdFSPFileAlreadyExists.Create(RSDestinationFileAlreadyExists);
end;
try
Get(ASourceFile, LDestStream, AResume);
finally
FreeAndNil(LDestStream);
end;
end;
procedure TIdFSP.GetDirInfo(const ADIR: String);
begin
GetDirInfo(ADir, FDirInfo);
end;
procedure TIdFSP.InitComponent;
begin
inherited InitComponent;
FAbortFlag := TIdThreadSafeBoolean.Create;
FAbortFlag.Value := False;
//you have to use FPort or this will cause a stack overflow
FPort := IdPORT_FSP;
FSequence := 0;
FKey := 0;
FDirInfo := TIdFSPDirInfo.Create;
FDirectoryListing := TIdFSPListItems.Create;
FStatInfo := TIdFSPStatInfo.Create(nil);
BroadcastEnabled := False;
FConEstablished := False;
FClientMaxPacketSize := DEF_MAXSIZE;
FInCmd := TIdThreadSafeBoolean.Create;
FInCmd.Value := False;
end;
procedure TIdFSP.List;
begin
List('/');
end;
procedure TIdFSP.List(const ASpecifier: string);
var
LSendPacket : TIdFSPPacket;
LRecvPacket : TIdFSPPacket;
LTmpBuf : TIdBytes;
LSpecifier: String;
begin
LSpecifier := ASpecifier;
if LSpecifier = '' then begin
LSpecifier := '/';
end;
SetLength(LTmpBuf, MaxBufferSize);
LSendPacket := TIdFSPPacket.Create;
try
LRecvPacket := TIdFSPPacket.Create;
try
LSendPacket.Cmd := CC_GET_DIR;
LSendPacket.FFilePosition := 0;
SetLength(LRecvPacket.FData, MaxBufferSize);
SetLength(LSendPacket.FExtraData, 2);
CopyTIdNetworkUInt16(PrefPayloadSize, LSendPacket.FExtraData, 0);
FDirectoryListing.Clear;
repeat
LSendPacket.Data := ToBytes(LSpecifier+#0);
LSendPacket.DataLen := Length(LSendPacket.Data);
SendCmd(LSendPacket,LRecvPacket,LTmpBuf);
if LRecvPacket.DataLen > 0 then begin
Inc(LSendPacket.FFilePosition, LRecvPacket.DataLen);
end else begin
Break;
end;
if LRecvPacket.DataLen < PrefPayloadSize then begin
Break;
end;
until FDirectoryListing.ParseEntries(LRecvPacket.FData, LRecvPacket.FDataLen);
finally
FreeAndNil(LRecvPacket);
end;
finally
FreeAndNil(LSendPacket);
end;
end;
procedure TIdFSP.SendCmd(const ACmd: Byte; const AData, AExtraData: TIdBytes;
const AFilePosition: Int64; var VData, VExtraData: TIdBytes;
const ARaiseException : Boolean = True);
var
LSendPacket : TIdFSPPacket;
LRecvPacket : TIdFSPPacket;
LTmpBuf : TIdBytes;
begin
SetLength(LTmpBuf, MaxBufferSize);
LSendPacket := TIdFSPPacket.Create;
try
LRecvPacket := TIdFSPPacket.Create;
try
LSendPacket.Cmd := ACmd;
LSendPacket.FilePosition := AFilePosition;
LSendPacket.Data := AData;
LSendPacket.FDataLen := Length(AData);
LSendPacket.ExtraData := AExtraData;
SendCmd(LSendPacket, LRecvPacket, LTmpBuf, ARaiseException);
VData := LRecvPacket.Data;
VExtraData := LRecvPacket.ExtraData;
finally
FreeAndNil(LRecvPacket);
end;
finally
FreeAndNil(LSendPacket);
end;
end;
procedure TIdFSP.SendCmd(const ACmd: Byte; const AData: TIdBytes;
const AFilePosition: Int64; var VData, VExtraData: TIdBytes;
const ARaiseException : Boolean = True);
var
LExtraData : TIdBytes;
begin
SetLength(LExtraData, 0);
SendCmd(ACmd, AData, LExtraData, AFilePosition, VData, VExtraData, ARaiseException);
end;
procedure TIdFSP.Version;
var
LData, LBuf, LExtraBuf : TIdBytes;
LDetails : Byte;
begin
{
we use this instead of SendCmd because of the following note
in the protocol specification
FILE SERVICE PROTOCOL VERSION 2, OFFICIAL PROTOCOL DEFINITION, FSP v2,
Document version 0.17, Last updated 25 Dec 2004
(http://fsp.sourceforge.net/doc/PROTOCOL.txt):
Note
Some fsp servers do not responds to this command,
because this command is used by FSP scanners and
servers do not wishes to be detected.
}
SetLength(LData, 0);
SendCmdOnce(CC_VERSION, LData, LData, 0, LBuf, LExtraBuf);
if Length(LData) > 0 then begin
FSystemDesc := ParseASCIIZ(LBuf);
if Length(LExtraBuf) > 0 then begin
LDetails := LExtraBuf[0];
//bit 0 set - server does logging
FSystemServerLogs := (LDetails and $01) = $01;
//bit 1 set - server is read only
FSystemReadOnly := (LDetails and $02) = $02;
//bit 2 set - reverse lookup required
FSystemReverseLookupRequired := (LDetails and $04) = $04;
//bit 3 set - server is in private mode
FSystemPrivateMode := (LDetails and $08) = $08;
//if bit 4 is set thruput info follows
FThruputControl := (LDetails and $10) = $10;
//bit 5 set - server accept XTRA
//DATA on input
FSystemAcceptsExtraData := (LDetails and $20) = $20;
//long - max_thruput allowed (in bytes/sec)
//word - max. packet size supported by server
if FThruputControl then begin
if Length(LExtraBuf) > 4 then begin
CopyBytesToHostUInt32(LExtraBuf, 1, FServerMaxThruPut);
if Length(LExtraBuf) > 6 then begin
CopyBytesToHostUInt16(LExtraBuf, 5, FServerMaxPacketSize);
end;
end;
end else
begin
if Length(LExtraBuf) > 2 then begin
CopyBytesToHostUInt16(LExtraBuf, 1, FServerMaxPacketSize);
end;
end;
end;
end;
end;
procedure TIdFSP.SendCmd(ACmdPacket, ARecvPacket: TIdFSPPacket;
var VTempBuf : TIdBytes; const ARaiseException : Boolean = True);
var
LLen : Integer;
LSendBuf : TIdBytes;
LMSec : Integer;
begin
FInCmd.Value := True;
try
Inc(FSequence);
FAbortFlag.Value := False;
//we don't set the temp buff size here for speed.
ACmdPacket.Key := FKey;
ACmdPacket.Sequence := FSequence;
LMSec := MINTIMEOUT;
LSendBuf := ACmdPacket.WritePacket;
//It's very important that you have some way of aborting this loop
//if you do not and the server does not reply, this can go for infinity.
//AbortCmd is ThreadSafe.
while not FAbortFlag.Value do
begin
SendBuffer(LSendBuf);
if Assigned(FOnSend) then begin
FOnSend(Self, ACmdPacket);
end;
IndySleep(5); //this is so we don't eat up all of the CPU
LLen := ReceiveBuffer(VTempBuf, LMsec);
ARecvPacket.ReadPacket(VTempBuf, LLen);
if ARecvPacket.Valid then begin
if Assigned(FOnRecv) then begin
FOnRecv(Self, ARecvPacket);
end;
if ARecvPacket.Sequence = FSequence then begin
Break;
end;
end;
LMSec := Round(LMSec * 1.5);
if LMSec > MAXTIMEOUT then begin
LMSec := MAXTIMEOUT;
end;
end;
if not FAbortFlag.Value then begin
FKey := ARecvPacket.Key;
end;
FAbortFlag.Value := False;
if (ARecvPacket.Cmd = CC_ERR) and ARaiseException then begin
raise EIdFSPProtException.Create(ParseASCIIZLen(ARecvPacket.Data, ARecvPacket.DataLen));
end;
finally
FInCmd.Value := False;
end;
end;
procedure TIdFSP.GetStatInfo(const APath: String);
var
LData, LBuf,LExtraBuf : TIdBytes;
i : UInt32;
begin
{
data format is the same as in directory listing with exception
that there is no file name appended. If file do not exists or
there is other problem (no access rights) return type of file is
0.
struct STAT {
long time;
long size;
byte type;
}
i := 0;
LData := ToBytes(APath + #0);
SendCmd(CC_STAT, LData, 0, LBuf, LExtraBuf);
if Length(LBuf) > 8 then begin
case LBuf[8] of
0 : //file not found
begin
raise EIdFSPFileNotFound.Create(RSFSPNotFound);
end;
RDTYPE_FILE :
begin
FStatInfo.ItemType := ditFile;
end;
RDTYPE_DIR :
begin
FStatInfo.ItemType := ditDirectory;
end;
end;
ParseStatInfo(LBuf, FStatInfo, i);
end;
end;
procedure TIdFSP.Put(const ASource: TStream; const ADestFile: string; const AGMTTime: TDateTime);
var
LUnixDate : UInt32;
LSendPacket : TIdFSPPacket;
LRecvPacket : TIdFSPPacket;
LPosition : UInt32;
LLen : Integer;
LTmpBuf : TIdBytes;
begin
LPosition := 0;
SetLength(LTmpBuf, MaxBufferSize);
LSendPacket := TIdFSPPacket.Create;
try
LRecvPacket := TIdFSPPacket.Create;
try
SetLength(LSendPacket.FData, PrefPayloadSize);
LSendPacket.Cmd := CC_UP_LOAD;
repeat
LLen := TIdStreamHelper.ReadBytes(ASource, LSendPacket.FData, PrefPayloadSize, 0);
if LLen = 0 then begin
Break;
end;
LSendPacket.FDataLen := LLen;
LSendPacket.FilePosition := LPosition;
SendCmd(LSendPacket, LRecvPacket, LTmpBuf);
if LLen < PrefPayloadSize then begin
Break;
end;
Inc(LPosition, LLen);
until False;
//send the Install packet
LSendPacket.Cmd := CC_INSTALL;
LSendPacket.FilePosition := 0;
LSendPacket.Data := ToBytes(ADestFile+#0);
LSendPacket.FDataLen := Length(LSendPacket.Data);
//File date - optional
if AGMTTime = 0 then begin
SetLength(LSendPacket.FExtraData, 0);
end else begin
LUnixDate := DateTimeToUnix(AGMTTime);
SetLength(LSendPacket.FExtraData, 4);
CopyTIdNetworkUInt32(LUnixDate, LSendPacket.FExtraData, 0);
end;
SendCmd(LSendPacket, LRecvPacket, LTmpBuf);
finally
FreeAndNil(LRecvPacket);
end;
finally
FreeAndNil(LSendPacket);
end;
end;
procedure TIdFSP.Put(const ASourceFile, ADestFile: string);
var
LSourceStream: TStream;
LDestFileName : String;
begin
LDestFileName := ADestFile;
if LDestFileName = '' then begin
LDestFileName := ExtractFileName(ASourceFile);
end;
LSourceStream := TIdReadFileExclusiveStream.Create(ASourceFile);
try
Put(LSourceStream, LDestFileName, GetGMTDateByName(ASourceFile));
finally
FreeAndNil(LSourceStream);
end;
end;
procedure TIdFSP.Delete(const AFilename: string);
var
LData : TIdBytes;
LBuf, LExBuf : TIdBytes;
begin
LData := ToBytes(AFilename+#0);
SendCmd(CC_DEL_FILE, LData, 0, LBuf, LExBuf);
end;
procedure TIdFSP.MakeDir(const ADirName: string);
var
LData : TIdBytes;
LBuf, LExBuf : TIdBytes;
begin
LData := ToBytes(ADirName+#0);
SendCmd(CC_MAKE_DIR, LData, 0, LBuf, LExBuf);
ParseDirInfo(LBuf, LExBuf, FDirInfo);
end;
procedure TIdFSP.RemoveDir(const ADirName: string);
var
LData : TIdBytes;
LBuf, LExBuf : TIdBytes;
begin
LData := ToBytes(ADirName+#0);
SendCmd(CC_DEL_DIR, LData, 0, LBuf, LExBuf);
end;
procedure TIdFSP.Rename(const ASourceFile, ADestFile: string);
var
LBuf, LData, LDataExt : TIdBytes;
begin
SetLength(LData, 0);
SetLength(LDataExt, 0);
LBuf := ToBytes(ASourceFile+#0+ADestFile);
SendCmd(CC_RENAME, LBuf, 0, LData, LDataExt);
end;
procedure TIdFSP.ParseDirInfo(const ABuf, AExtraBuf: TIdBytes; ADir : TIdFSPDirInfo);
begin
ADir.ReadMe := ParseASCIIZ(ABuf);
if Length(AExtraBuf) > 0 then begin
//0 - caller owns the directory
ADir.OwnsDir := (AExtraBuf[0] and $01) = $01;
//1 - files can be deleted from this dir
ADir.CanDeleteFiles := (AExtraBuf[0] and $02) = $02;
// 2 - files can be added to this dir
ADir.CanAddFiles := (AExtraBuf[0] and $04) = $04;
//3 - new subdirectories can be created
ADir.CanMakeDir := (AExtraBuf[0] and $08) = $08;
//4 - files are NOT readable by non-owners
ADir.OnlyOwnerCanReadFiles := (AExtraBuf[0] and $10) = $10;
//5 - directory contain an readme file
ADir.HasReadMe := (AExtraBuf[0] and $20) = $20;
//6 - directory can be listed
ADir.CanBeListed := (AExtraBuf[0] and $40) = $40;
//7 - files can be renamed in this directory
ADir.CanRenameFiles := (AExtraBuf[0] and $80) = $80;
end;
end;
procedure TIdFSP.GetDirInfo(const ADIR: String; ADirInfo: TIdFSPDirInfo);
var
LData, LBuf, LExtraBuf : TIdBytes;
begin
LData := ToBytes(ADIR+#0);
SendCmd(CC_GET_PRO, LData, 0, LBuf, LExtraBuf);
ParseDirInfo(LBuf, LExtraBuf, ADirInfo);
end;
procedure TIdFSP.SendCmdOnce(ACmdPacket, ARecvPacket: TIdFSPPacket;
var VTempBuf: TIdBytes; const ARaiseException: Boolean);
var
LLen : Integer;
LBuf : TIdBytes;
LSendBuf : TIdBytes;
//This is for where there may not be a reply to a command from a server.
begin
Inc(FSequence);
SetLength(LBuf, MaxBufferSize);
ACmdPacket.Key := FKey;
ACmdPacket.Sequence := FSequence;
LSendBuf := ACmdPacket.WritePacket;
SendBuffer(LSendBuf);
if Assigned(FOnSend) then begin
FOnSend(Self, ACmdPacket);
end;
repeat
LLen := ReceiveBuffer(LBuf, MINTIMEOUT);
if LLen = 0 then begin
Break;
end;
ARecvPacket.ReadPacket(LBuf, LLen);
if ARecvPacket.Valid then begin
if Assigned(FOnRecv) then begin
FOnRecv(Self, ARecvPacket);
end;
if (ARecvPacket.Sequence = FSequence) then begin
FKey := ARecvPacket.Key;
Break;
end;
end;
until False;
if (ARecvPacket.Cmd = CC_ERR) and ARaiseException then begin
raise EIdFSPProtException.Create(ParseASCIIZLen(ARecvPacket.Data, ARecvPacket.DataLen));
end;
end;
procedure TIdFSP.SendCmdOnce(const ACmd: Byte; const AData,
AExtraData: TIdBytes; const AFilePosition: Int64; var VData,
VExtraData: TIdBytes; const ARaiseException: Boolean);
var
LSendPacket : TIdFSPPacket;
LRecvPacket : TIdFSPPacket;
LTmpBuf : TIdBytes;
begin
SetLength(LTmpBuf, MaxBufferSize);
LSendPacket := TIdFSPPacket.Create;
try
LRecvPacket := TIdFSPPacket.Create;
try
LSendPacket.Cmd := ACmd;
LSendPacket.FilePosition := AFilePosition;
LSendPacket.Data := AData;
LSendPacket.FDataLen := Length(AData);
LSendPacket.ExtraData := AExtraData;
SendCmdOnce(LSendPacket, LRecvPacket, LTmpBuf, ARaiseException);
VData := LRecvPacket.Data;
VExtraData := LRecvPacket.ExtraData;
finally
FreeAndNil(LRecvPacket);
end;
finally
FreeAndNil(LSendPacket);
end;
end;
function TIdFSP.MaxBufferSize: Word;
//use only for calculating buffer for reading UDP packet
begin
Result := IndyMax(FClientMaxPacketSize, DEF_MAXSIZE);
Result := IndyMax(FServerMaxPacketSize, Result);
Inc(Result, HSIZE); //just in case
end;
function TIdFSP.PrefPayloadSize: Word;
//maximum size of the data feild we want to use
begin
Result := IndyMin(FClientMaxPacketSize, FServerMaxPacketSize);
Dec(Result, HSIZE);
end;
procedure TIdFSP.SetClientMaxPacketSize(const AValue: Word);
begin
//maximal size required by RFC
//note that 512 gives a payload of 500 bytes in a packet
if AValue < 512 then begin
raise EIdFSPPacketTooSmall.Create(RSFSPPacketTooSmall);
end;
FClientMaxPacketSize := AValue;
end;
procedure TIdFSP.AbortCmd;
begin
//we don't want to go into the abort loop if there is no command
//being send. If that happens, your program could hang.
if FInCmd.Value then
begin
FAbortFlag.Value := True;
repeat
IndySleep(5);
//we need to wait until the SendCmd routine catches the Abort
//request so you don't get an AV in a worker thread.
until not FAbortFlag.Value;
end;
end;
{ TIdFSPPacket }
constructor TIdFSPPacket.Create;
begin
inherited Create;
FCmd := 0;
FFilePosition := 0;
FDataLen := 0;
SetLength(FData, 0);
SetLength(FExtraData, 0);
FSequence := 0;
FKey := 0;
end;
function TIdFSPPacket.WritePacket : TIdBytes;
var
LExtraDataLen, LW : Word;
LC, LSum : UInt32;
i : Integer;
//ported from:
//http://cvs.sourceforge.net/viewcvs.py/fsp/javalib/FSPpacket.java?rev=1.6&view=markup
begin
LExtraDataLen := Length(FExtraData);
SetLength(Result, HSIZE + FDataLen + LExtraDataLen);
//cmd
Result[0] := Cmd;
//checksum
Result[1] := 0; //this will be the checksum value
//key
LW := GStack.HostToNetwork(FKey);
CopyTIdUInt16(LW, Result, 2);
// sequence
LW := GStack.HostToNetwork(FSequence);
CopyTIdUInt16(LW, Result, 4);
// data length
LW := GStack.HostToNetwork(FDataLen);
CopyTIdUInt16(LW, Result, 6);
// position
LC := GStack.HostToNetwork(FFilePosition);
CopyTIdUInt32(LC, Result, 8);
//end of header section
//data section
if FDataLen > 0 then begin
CopyTIdBytes(FData, 0, Result, HSIZE, FDataLen);
end;
//extra data section
if LExtraDataLen > 0 then begin
CopyTIdBytes(FExtraData, 0, Result, HSIZE+FDataLen, LExtraDataLen);
end;
//checksum
LSum := Length(Result);
for i := Length(Result)-1 downto 0 do begin
Inc(LSum, Result[i]);
end;
Result[1] := Byte(LSum+(LSum shr 8));
end;
procedure TIdFSPPacket.ReadPacket(const AData : TIdBytes; const ALen : UInt32);
var
LSum, LnSum, LcSum : UInt32; //UInt32 to prevent a range-check error
LW : Word;
LExtraDataLen : UInt32;
begin
FValid := False;
if ALen < HSIZE then begin
Exit;
end;
//check data length
FDataLen := BytesToUInt16(AData, 6);
FDataLen := GStack.NetworkToHost(FDataLen);
if FDataLen > ALen then begin
Exit;
end;
//validate checksum
LSum := AData[1]; //checksum
LnSum := ALen;
for LW := ALen-1 downto 0 do begin
if LW <> 1 then begin // skip the checksum byte
Inc(LnSum, AData[LW]);
end;
end;
lcSum := Byte(LnSum + (LnSum shr 8));
if LcSum <> LSum then begin
Exit;
end;
//command
FCmd := AData[0];
//key
FKey := BytesToUInt16(AData, 2);
FKey := GStack.NetworkToHost(FKey);
// sequence
FSequence := BytesToUInt16(AData, 4);
FSequence := GStack.NetworkToHost(FSequence);
//file position
FFilePosition := BytesToUInt32(AData, 8);
FFilePosition := GStack.NetworkToHost(FFilePosition);
//extract data
if FDataLen > 0 then begin
SetLength(FData, FDataLen);
CopyTIdBytes(AData, HSIZE, FData, 0, FDataLen);
end else begin
SetLength(FData, 0);
end;
//extract extra data
LExtraDataLen := ALen - (HSIZE+FDataLen);
if LExtraDataLen > 0 then begin
SetLength(FExtraData, LExtraDataLen);
CopyTIdBytes(AData, HSIZE+FDataLen, FExtraData, 0, LExtraDataLen);
end else begin
SetLength(FExtraData, 0);
end;
FValid := True;
end;
{ TIdFSPListItems }
function TIdFSPListItems.Add: TIdFSPListItem;
begin
Result := TIdFSPListItem(inherited Add);
end;
constructor TIdFSPListItems.Create;
begin
inherited Create(TIdFSPListItem);
end;
function TIdFSPListItems.GetItems(AIndex: Integer): TIdFSPListItem;
begin
Result := TIdFSPListItem(inherited Items[AIndex]);
end;
function TIdFSPListItems.IndexOf(AItem: TIdFSPListItem): Integer;
Var
i: Integer;
begin
for i := 0 to Count - 1 do begin
if AItem = Items[i] then begin
Result := i;
Exit;
end;
end;
Result := -1;
end;
function TIdFSPListItems.ParseEntries(const AData: TIdBytes; const ADataLen : UInt32) : Boolean;
var
i : UInt32;
LI : TIdFSPListItem;
LSkip : Boolean;
begin
Result := False;
i := 0;
repeat
if i >= (ADataLen-9) then begin
Exit;
end;
LI := nil;
LSkip := False;
case AData[i+8] of
RDTYPE_END:
begin
Result := True;
Exit;
end;
RDTYPE_FILE:
begin
LI := Add;
LI.ItemType := ditFile;
end;
RDTYPE_DIR:
begin
LI := Add;
LI.ItemType := ditDirectory;
end;
RDTYPE_SKIP:
begin
LSkip := True;
end
else begin
Exit;
end;
end;
if LSkip then begin
Inc(i, 8);
end else begin
ParseStatInfo(AData, LI, i);
LI.FileName := ParseASCIIZPos(AData, ADataLen, i);
end;
repeat
Inc(i);
until (i and $03) = 0;
until False;
end;
procedure TIdFSPListItems.SetItems(AIndex: Integer; const Value: TIdFSPListItem);
begin
inherited Items[AIndex] := Value;
end;
end.