unit gnutellatrans;
interface
(****************************************************************
Copyright (C) 2000, Bryan Mayland Created 2000. All rights reserved.
License to copy and use this software is granted provided that it
is identified as the "CapnBry gnutella transport algorithm"
in all material mentioning or referencing this software or this function.
License is also granted to make and use derivative works provided
that such works are identified as "derived from the CapnBry gnutella
transport algorithm" in all material mentioning or referencing the
derived work.
Bryan Mayland makes no representations concerning either
the merchantability of this software or the suitability of this
software for any particular purpose. It is provided "as is"
without express or implied warranty of any kind.
These notices must be retained in any copies of any part of this
documentation and/or software.
*******************************************************************)
(***
Quick overview:
-- Use Listen() to start accepting incoming connections
-- Use ConnectNewHost() to initiate an outgoing gnutellanet connection
-- Use BeginSearch() to ... errr, what does that do again?
-- Make sure you call Shutdown() before your form's destructor to prevent
event handlers being fired after your other visual components have been freed
***)
uses
Windows, WinSock, SysUtils, Classes, ScktComp, Messages;
const
MAX_ROUTE_LIST_SIZE = 8192;
type
Pgnutella_header = ^gnutella_header;
gnutella_header = packed record
MsgID: TGUID;
Func: byte;
TTLRemaining: byte;
HopsTaken: byte;
DataLen: integer;
end;
Pgnutella_init_response = ^gnutella_init_response;
gnutella_init_response = packed record
port: WORD;
ip: Integer;
filecnt: DWORD;
totsize: DWORD;
end;
Pgnutella_query_response_hdr = ^gnutella_query_response_hdr;
gnutella_query_response_hdr = packed record
nrecs: BYTE;
port: WORD;
ip: Integer;
speed: Integer;
end;
Pgnutella_query_response_rec_hdr = ^gnutella_query_response_rec_hdr;
gnutella_query_response_rec_hdr = packed record
FileIdx: Integer;
FileSize: Integer;
end;
Pgnutella_query_response_ftr = ^gnutella_query_response_ftr;
gnutella_query_response_ftr = packed record
clientid128: TGUID;
end;
Pgnutella_push_req = ^gnutella_push_req;
gnutella_push_req = packed record
ClientID128: TGUID;
FileIndex: integer;
RequestIP: integer;
RequestPort: WORD;
end;
TGConnection = class(TObject)
private
FSocket: TCustomWinSocket;
FRecvBuf: TMemoryStream;
FProtocolConnected: boolean;
FHost: string;
FSocketParent: TObject;
FIncoming: boolean;
FMessagesOut: DWORD;
FMessagesDropped: DWORD;
FMessagesIn: DWORD;
function GetRecvBufHead: Pgnutella_header;
function GetRecvBufPos: PChar;
public
constructor Create(ASockParent : TObject; ASocket : TCustomWinSocket;
const AHost : string);
destructor Destroy; override;
function ReadFromSocket : integer;
procedure TransmitMsg(SrcGConn : TGConnection);
property RecvBufHead: Pgnutella_header read GetRecvBufHead;
property RecvBufPos: PChar read GetRecvBufPos;
property Host: string read FHost;
property Incoming: boolean read FIncoming write FIncoming;
property ProtocolConnected: boolean read FProtocolConnected write FProtocolConnected;
property RecvBuf: TMemoryStream read FRecvBuf;
property Socket: TCustomWinSocket read FSocket;
property MessagesIn: DWORD read FMessagesIn;
property MessagesOut: DWORD read FMessagesOut;
property MessagesDropped: DWORD read FMessagesDropped;
end;
TStringEvent = procedure (Sender : TObject; const s : string) of Object;
TClientSockEvent = procedure (GConn : TGConnection) of Object;
TInitRespEvent = procedure (const HostIP : string; HostPort : WORD;
FileCnt: integer; FileSize: integer) of Object;
TSearchReqEvent = procedure (MinSpeed : WORD; const Search : string) of Object;
TSrchRespBeginEvent = procedure (const HostIP : string; HostPort : WORD;
Speed : WORD) of Object;
TSrchRespItemEvent = procedure (FileIdx, FileSize, HostSpeed : integer;
const FileName : string) of Object;
TSrchRespEndEvent = procedure (ClientID128 : TGUID) of Object;
PGnuTelMessage = ^TGnuTelMessage;
TGnuTelMessage = record
MessageID: TGUID;
SourceConn: TGConnection;
Next: PGnuTelMessage;
Prev: PGnuTelMessage;
end;
TGnuTelMessageList = class(TObject)
private
FHead: PGnuTelMessage;
FTail: PGnuTelMessage;
FCount: integer;
function RemoveNode(pMsg : PGnuTelMessage) : PGnuTelMessage;
protected
public
constructor Create;
destructor Destroy; override;
procedure Append(GConn : TGConnection);
function FindByMessageID(const Hdr : gnutella_header) : PGnuTelMessage;
procedure PurgeGConn(GConn : TGConnection);
property Count: integer read FCount;
end;
TGnutellaTrans = class(TComponent)
private
ConnList: TList;
ServerSock: TServerSocket;
FGTNAvgPing: integer;
FSearchesIn: DWORD;
FGTNHosts: integer;
FGTNSize: integer;
FGTNFiles: integer;
FMessagesIn: DWORD;
FOnLogStatus: TStringEvent;
FOnClientConnected: TClientSockEvent;
FOnClientCreated: TClientSockEvent;
FOnClientProtocolConnect: TClientSockEvent;
FMyTTL: BYTE;
FMaxTTL: BYTE;
FOnInitResponse: TInitRespEvent;
FOnSearchReq: TSearchReqEvent;
FOnPushRequest: TNotifyEvent;
FOnSrchRespBegin: TSrchRespBeginEvent;
FOnSrchRespEnd: TSrchRespEndEvent;
FOnSrchRespItem: TSrchRespItemEvent;
FOnClientDisconnect: TClientSockEvent;
FListenPort: integer;
FLocalIP: string;
FLocalFileSize: integer;
FLocalFileCount: integer;
FSendInitOnConnect: boolean;
FOnCatchHost: TStringEvent;
FConnectionSpeed: integer;
FRouteMsgList: TGnuTelMessageList;
FOnListenPortInUse: TNotifyEvent;
FRoutingErrorsIn: DWORD;
FGConnSelf: TGConnection;
FMessagesDropped: DWORD;
FFilesUploaded: DWORD;
FFilesDownloaded: DWORD;
procedure GetGNUTELLAOK(Socket: TCustomWinSocket);
procedure GetGNUTELLA_CONNECT(Socket: TCustomWinSocket);
procedure ReadSocketData(Socket: TCustomWinSocket);
procedure DealWithData(GConn : TGConnection; pData : PChar; DataSize : integer);
procedure GotMessage(GConn : TGConnection);
procedure hdr_to_text(const hdr: gnutella_header);
function FuncToStr(Func: BYTE): string;
procedure getInit(GConn : TGConnection);
procedure getInitResponse(GConn : TGConnection);
procedure getQuery(GConn : TGConnection);
procedure getQueryResponse(GConn : TGConnection);
procedure getUnknown(GConn : TGConnection);
procedure getPushReq(GConn : TGConnection);
function GetConnectionCount: integer;
function GetSocketCount: integer;
procedure SetListenPort(const Value: integer);
procedure SendMessageToAll(pBuff: Pointer; Size: integer);
function RouteMessageResponse(GConn : TGConnection) : boolean;
function BroadcastMessage(GConn : TGConnection) : boolean;
procedure HandleDisconnError(const sMsg: string; GConn: TGConnection;
var ErrorCode: integer);
function HeaderValid(const hdr: gnutella_header) : boolean;
protected
procedure Log(const s : string);
procedure sockConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure sockRead(Sender: TObject; Socket: TCustomWinSocket);
procedure sockDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure sockError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure sockAccept(Sender: TObject; Socket: TCustomWinSocket);
procedure SetupNewHdr(var hdr : gnutella_header);
procedure FreeAllSockets;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure ConnectNewHost(const Host : string);
procedure ClearGTNStats;
procedure SendInitToAll;
procedure SendOneInit(Socket : TCustomWinSocket);
procedure BeginSearch(const Query : string; MinSpeed : WORD);
procedure Listen;
procedure CancelListen;
procedure Shutdown;
procedure DisconnectHost(const Host : string);
property MessagesIn: DWORD read FMessagesIn;
property SearchesIn: DWORD read FSearchesIn;
property RoutingErrorsIn: DWORD read FRoutingErrorsIn;
property MessagesDropped: DWORD read FMessagesDropped;
property FilesUploaded: DWORD read FFilesUploaded;
property FilesDownloaded: DWORD read FFilesDownloaded;
property GTNHosts: integer read FGTNHosts;
property GTNFiles: integer read FGTNFiles;
property GTNSize: integer read FGTNSize;
property GTNAvgPing: integer read FGTNAvgPing;
property ConnectionCount: integer read GetConnectionCount;
property SocketCount: integer read GetSocketCount;
property LocalFileCount: integer read FLocalFileCount;
property LocalFileSize: integer read FLocalFileSize;
published
property ConnectionSpeed: integer read FConnectionSpeed write FConnectionSpeed;
property ListenPort: integer read FListenPort write SetListenPort;
property LocalIP: string read FLocalIP write FLocalIP;
property MyTTL: BYTE read FMyTTL write FMyTTL;
property MaxTTL: BYTE read FMaxTTL write FMaxTTL;
property SendInitOnConnect: boolean read FSendInitOnConnect write FSendInitOnConnect;
property OnCatchHost: TStringEvent read FOnCatchHost write FOnCatchHost;
property OnClientConnected: TClientSockEvent read FOnClientConnected
write FOnClientConnected;
property OnClientCreated: TClientSockEvent read FOnClientCreated
write FOnClientCreated;
property OnClientProtocolConnect: TClientSockEvent read FOnClientProtocolConnect
write FOnClientProtocolConnect;
property OnInitResponse: TInitRespEvent read FOnInitResponse write FOnInitResponse;
property OnListenPortInUse: TNotifyEvent read FOnListenPortInUse write FOnListenPortInUse;
property OnLogStatus: TStringEvent read FOnLogStatus write FOnLogStatus;
property OnSearchReq: TSearchReqEvent read FOnSearchReq write FOnSearchReq;
property OnSrchRespBegin: TSrchRespBeginEvent read FOnSrchRespBegin
write FOnSrchRespBegin;
property OnSrchRespEnd: TSrchRespEndEvent read FOnSrchRespEnd
write FOnSrchRespEnd;
property OnSrchRespItem: TSrchRespItemEvent read FOnSrchRespItem
write FOnSrchRespItem;
property OnPushRequest: TNotifyEvent read FOnPushRequest write FOnPushRequest;
property OnClientDisconnect: TClientSockEvent read FOnClientDisconnect
write FOnClientDisconnect;
end;
function CoCreateGuid(out guid: TGUID): HResult; stdcall; external 'ole32.dll';
function StringFromCLSID(const clsid: TGUID; out psz: PWideChar): HResult;
stdcall; external 'ole32.dll';
procedure CoTaskMemFree(pv: Pointer); stdcall; external 'ole32.dll';
procedure Register;
implementation
{$R *.dcr}
procedure Register;
begin
RegisterComponents('Internet', [TGnutellaTrans]);
end;
function GUIDToString(const ClassID: TGUID): string;
var
P: PWideChar;
begin
StringFromCLSID(ClassID, P);
Result := P;
CoTaskMemFree(P);
end;
function PointerToStr(P : Pointer; iSize : integer) : string;
begin
Result := '';
while iSize > 0 do begin
if iSize > 1 then
AppendStr(Result, Format('%2.2x ', [PBYTE(P)^]))
else
AppendStr(Result, Format('%2.2x', [PBYTE(P)^]));
dec(iSize);
Inc(PBYTE(P), 1)
end;
end;
function BytesToStr(ar : array of byte) : string;
var
I: integer;
begin
Result := '';
for I := low(ar) to high(ar) do
if I < high(ar) then
AppendStr(Result, Format('%2.2x ', [ar[i]]))
else
AppendStr(Result, Format('%2.2x', [ar[i]]))
end;
{ TGnutellaTrans }
function TGnutellaTrans.FuncToStr(Func : BYTE) : string;
begin
case Func of
$00: Result := 'Init';
$01: Result := 'Init response';
$40: Result := 'Client push req';
$80: Result := 'Query';
$81: Result := 'Query Response';
else
Result := '???';
end;
end;
procedure TGnutellaTrans.ClearGTNStats;
begin
FGTNAvgPing := 0;
FGTNHosts := 0;
FGTNSize := 0;
FGTNFiles := 0;
end;
procedure TGnutellaTrans.ConnectNewHost(const Host: string);
var
tmpSocket: TClientSocket;
GConn: TGConnection;
iPos: integer;
begin
if Host = '' then
exit;
tmpSocket := TClientSocket.Create(nil);
GConn := TGConnection.Create(tmpSocket, tmpSocket.Socket, Host);
ConnList.Add(GConn);
iPos := Pos(':', Host);
if iPos = 0 then
iPos := Length(Host) + 1;
tmpSocket.Host := copy(Host, 1, iPos - 1);
tmpSocket.Port := StrToIntDef(copy(Host, iPos + 1, Length(Host)), 6346);
Log('Host is: ' + tmpSocket.Host);
Log('Port is: ' + IntToStr(tmpSocket.Port));
with tmpSocket do begin
OnConnect := sockConnect;
OnDisconnect := sockDisconnect;
OnError := sockError;
OnRead := sockRead;
Open;
end;
if Assigned(FOnClientCreated) then
FOnClientCreated(GConn);
end;
constructor TGnutellaTrans.Create(AOwner: TComponent);
begin
inherited;
FRouteMsgList := TGnuTelMessageList.Create;
{ we create a bogus connection to represent ourself }
FGConnSelf := TGConnection.Create(nil, nil, 'Self');
ConnList := TList.Create;
FMyTTL := 7;
FMaxTTL := 7;
FListenPort := 6346;
FConnectionSpeed := 28;
ServerSock := TServerSocket.Create(Self);
ServerSock.Port := FListenPort;
ServerSock.OnClientConnect := sockConnect;
ServerSock.OnClientDisconnect := sockDisconnect;
ServerSock.OnClientError := sockError;
ServerSock.OnClientRead := sockRead;
ServerSock.OnAccept := sockAccept;
end;
destructor TGnutellaTrans.Destroy;
begin
Shutdown;
ConnList.Free;
FRouteMsgList.Free;
FGConnSelf.Free;
inherited;
end;
procedure TGnutellaTrans.GetGNUTELLAOK(Socket: TCustomWinSocket);
var
GConn: TGConnection;
iBytes: integer;
begin
GConn := TGConnection(Socket.Data);
{ 13 is for GNUTELLA OKaa }
GConn.FRecvBuf.Size := 13;
iBytes := GConn.ReadFromSocket;
if iBytes = SOCKET_ERROR then begin
Log('Socket error in GNUTELLA OK');
Socket.Close;
end
else begin
GConn.RecvBuf.Position := GConn.RecvBuf.Position + iBytes;
if GConn.RecvBuf.Position = GConn.RecvBuf.Size then
if StrLComp(PChar('GNUTELLA OK'#10#10), PChar(GConn.RecvBufHead),
GConn.RecvBuf.Size) = 0 then begin
GConn.RecvBuf.Clear;
GConn.ProtocolConnected := true;
if Assigned(FOnClientProtocolConnect) then
FOnClientProtocolConnect(GConn);
if FSendInitOnConnect then
SendOneInit(Socket);
end // we got GNUTELLA OK
else begin
Log('Got invalid GNUTELLA response');
Socket.Close;
end; // not GNUTELLA OK
end; // if no SOCKET_ERROR
end;
procedure TGnutellaTrans.Log(const s: string);
begin
if Assigned(FOnLogStatus) then
FOnLogStatus(Self, s);
end;
procedure TGnutellaTrans.ReadSocketData(Socket: TCustomWinSocket);
var
Buf: array[0..8195] of char;
GConn: TGConnection;
iBytes: integer;
begin
GConn := TGConnection(Socket.Data);
repeat
iBytes := Socket.ReceiveBuf(Buf, sizeof(Buf));
if iBytes <> SOCKET_ERROR then
DealWithData(GConn, @Buf, iBytes);
until iBytes < sizeof(Buf);
end;
procedure TGnutellaTrans.SendMessageToAll(pBuff : Pointer; Size : integer);
var
I: integer;
begin
for I := 0 to ConnList.Count - 1 do
with TGConnection(ConnList[I]) do
if ProtocolConnected then
Socket.SendBuf(pBuff^, Size);
end;
procedure TGnutellaTrans.SendInitToAll;
var
hdr: gnutella_header;
begin
SetupNewHdr(hdr);
hdr.Func := 0;
SendMessageToAll(@hdr, sizeof(hdr));
end;
procedure TGnutellaTrans.SetupNewHdr(var hdr: gnutella_header);
begin
FillChar(hdr, sizeof(hdr), 0);
CoCreateGUID(hdr.MsgID);
hdr.TTLRemaining := FMyTTL;
end;
procedure TGnutellaTrans.sockConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
GConn: TGConnection;
begin
{ if socket.data is not assigned, then this is an incoming connection }
if not Assigned(Socket.Data) then begin
GConn := TGConnection.Create(nil, Socket,
Format('%s:%d', [Socket.RemoteAddress, Socket.LocalPort]));
GConn.Incoming := true;
ConnList.Add(GConn);
if Assigned(FOnClientCreated) then
FOnClientCreated(GConn);
end;
{ if the socket is outboud, we need to init the protocol }
if not TGConnection(Socket.Data).Incoming then
Socket.SendText('GNUTELLA CONNECT/0.4'#10#10);
Log('SocketConnect');
if Assigned(FOnClientConnected) then
FOnClientConnected(TGConnection(Socket.Data));
end;
procedure TGnutellaTrans.sockDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log('socket diconnected');
{ here's a super kludge }
PostMessage(Socket.Handle, CM_SOCKETMESSAGE, Socket.SocketHandle,
MakeLParam(FD_CLOSE, WSAECONNRESET));
end;
procedure TGnutellaTrans.HandleDisconnError(const sMsg : string; GConn : TGConnection;
var ErrorCode : integer);
var
I: integer;
begin
Log(sMsg);
if Assigned(GConn) then begin
{ we delete the socket before we call the disconnect handler, so
the user has an accurate disconnected client count in the handler }
I := ConnList.IndexOf(GConn);
if I <> -1 then
ConnList.Delete(I);
{ remove messages destined for this guy from the RouteList }
FRouteMsgList.PurgeGConn(GConn);
if Assigned(FOnClientDisconnect) then
FOnClientDisconnect(GConn);
GConn.Free;
end;
ErrorCode := 0;
end;
procedure TGnutellaTrans.sockError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
if ErrorCode = WSAEADDRINUSE then begin // 10048
Log('Listen port in use');
if Assigned(FOnListenPortInUse) then
FOnListenPortInUse(Self);
ErrorCode := 0;
end
else case ErrorCode of
WSAEADDRNOTAVAIL: // 10049
HandleDisconnError('Host unreachable', TGConnection(Socket.Data), ErrorCode);
WSAENETUNREACH: // 10051
HandleDisconnError('Network unreachable', TGConnection(Socket.Data), ErrorCode);
WSAECONNABORTED: // 10053
HandleDisconnError('Connection aborted', TGConnection(Socket.Data), ErrorCode);
WSAECONNRESET: // 10054
HandleDisconnError('Connection reset', TGConnection(Socket.Data), ErrorCode);
WSAETIMEDOUT: // 10060
HandleDisconnError('Connection timed out', TGConnection(Socket.Data), ErrorCode);
WSAECONNREFUSED: // 10061
HandleDisconnError('Connection refused', TGConnection(Socket.Data), ErrorCode);
WSAEHOSTUNREACH: // 10065
HandleDisconnError('Host unreachable', TGConnection(Socket.Data), ErrorCode);
else
HandleDisconnError('Socket Error ' + IntToStr(ErrorCode),
TGConnection(Socket.Data), ErrorCode);
end; { case ErrorCode }
end;
procedure TGnutellaTrans.sockRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
{ if we haven't set our own IP, this is the time to do it }
if FLocalIP = '' then
if Socket.LocalAddress <> '127.0.0.1' then
FLocalIP := Socket.LocalAddress;
if not TGConnection(Socket.Data).ProtocolConnected then
if TGConnection(Socket.Data).Incoming then
GetGNUTELLA_CONNECT(Socket)
else
GetGNUTELLAOK(Socket)
else
ReadSocketData(Socket);
end;
procedure TGnutellaTrans.SendOneInit(Socket: TCustomWinSocket);
var
hdr: gnutella_header;
begin
SetupNewHdr(hdr);
hdr.Func := 0;
Socket.SendBuf(hdr, sizeof(hdr));
end;
procedure TGnutellaTrans.DealWithData(GConn: TGConnection; pData: PChar;
DataSize: integer);
var
iBytesNeeded: integer;
iBytesDealt: integer;
begin
iBytesDealt := 0;
while iBytesDealt < DataSize do begin
{ check for an previous underflow }
iBytesNeeded := sizeof(gnutella_header) + GConn.RecvBuf.Position;
if iBytesNeeded > (DataSize - iBytesDealt) then
iBytesNeeded := DataSize - iBytesDealt;
GConn.RecvBuf.Write(PChar(Integer(pData) + iBytesDealt)^, iBytesNeeded);
inc(iBytesDealt, iBytesNeeded);
{ we don't have enough data for to be a header }
if GConn.RecvBuf.Position < sizeof(gnutella_header) then
break;
iBytesNeeded := GConn.RecvBufHead^.DataLen;
if not HeaderValid(GConn.RecvBufHead^) then begin
Log('I think I''ve got a bogus packet:');
hdr_to_text(GConn.RecvBufHead^);
GConn.RecvBuf.Clear;
continue;
end;
{ check for an underflow }
if iBytesNeeded > DataSize - iBytesDealt then
iBytesNeeded := DataSize - iBytesDealt;
GConn.RecvBuf.Write(PChar(Integer(pData) + iBytesDealt)^, iBytesNeeded);
inc(iBytesDealt, iBytesNeeded);
{ we don't have the whole message yet }
if GConn.RecvBuf.Position <
(sizeof(gnutella_header) + (GConn.RecvBufHead)^.DataLen) then
break;
GotMessage(GConn);
GConn.RecvBuf.Clear;
end; { while Bytes }
end;
procedure TGnutellaTrans.hdr_to_text(const hdr: gnutella_header);
begin
{ BRY!
if hdr.Func in [$00, $01, $40, $80, $81] then
exit;
}
Log('Message ID: ' + GUIDToString(hdr.MsgID));
Log('Function ID: 0x' + Format('%2.2x', [hdr.Func]) + ' (' + FuncToStr(hdr.Func) + ')');
Log('TTL Remaining: ' + IntToStr(hdr.TTLRemaining));
Log('Hops Taken: ' + IntToStr(hdr.HopsTaken));
Log('Data Len: ' + IntToStr(hdr.DataLen));
end;
procedure TGnutellaTrans.GotMessage(GConn: TGConnection);
begin
hdr_to_text(GConn.RecvBufHead^);
inc(GConn.FMessagesIn);
if GConn.RecvBufHead^.Func and $01 = $01 then
{ if route... returns true, the message is for us! }
if RouteMessageResponse(GConn) then begin
case GConn.RecvBufHead^.Func of
$01: getInitResponse(GConn);
$81: getQueryResponse(GConn);
else
getUnknown(GConn);
end;
end { if response message for us }
else begin
end { message not for us }
else begin
{ if broadcast returns true, then we should respond }
if BroadcastMessage(GConn) then begin
case GConn.RecvBufHead^.Func of
$00: getInit(GConn);
$40: getPushReq(GConn);
$80: getQuery(GConn);
else
getUnknown(GConn);
end;
end; { if new message }
end;
inc(FMessagesIn);
end;
procedure TGnutellaTrans.getInit(GConn: TGConnection);
type
gir = packed record
hdr: gnutella_header;
ir: gnutella_init_response;
end;
var
gir_out: gir;
begin
Log('Init message in, sending response...');
fillchar(gir_out, sizeof(gir_out), 0);
move(GConn.RecvBufHead^, gir_out.hdr, sizeof(gnutella_header));
gir_out.hdr.Func := 1;
gir_out.hdr.DataLen := sizeof(gir_out.ir);
gir_out.ir.Port := FListenPort;
gir_out.ir.ip := inet_addr(PChar(FLocalIP));
gir_out.ir.filecnt := FLocalFileCount;
gir_out.ir.totsize := FLocalFileSize;
GConn.Socket.SendBuf(gir_out, sizeof(gir_out));
end;
procedure TGnutellaTrans.getInitResponse(GConn: TGConnection);
var
pir: Pgnutella_init_response;
ia: in_addr;
sAddr: string;
begin
Log('Init response:');
pir := Pgnutella_init_response(
integer(GConn.RecvBufHead) + sizeof(gnutella_header));
inc(FGTNHosts);
inc(FGTNFiles, pir^.FileCnt);
{ totsize is in KB, we want MB }
inc(FGTNSize, pir^.totsize div 1024);
Log(' Remote Port: ' + IntToStr(pir^.Port));
ia.S_addr := pir^.ip;
sAddr := inet_ntoa(ia);
Log(' Remote IP: ' + sAddr);
Log(' Files shared: ' + IntToStr(pir^.filecnt));
Log(' Total Size: ' + IntToStr(pir^.totsize) + ' KB');
if Assigned(FOnCatchHost) then
FOnCatchHost(Self, Format('%s:%d', [sAddr, pir^.Port]));
if Assigned(FOnInitResponse) then
FOnInitResponse(sAddr, pir^.Port, pir^.filecnt, pir^.totsize);
end;
procedure TGnutellaTrans.getPushReq(GConn: TGConnection);
var
ppr: Pgnutella_push_req;
sAddr: string;
ia: in_addr;
begin
Log('Client Push request:');
ppr := Pgnutella_push_req(
Integer(GConn.RecvBufHead) + sizeof(gnutella_header));
Log(' ClientID128: ' + GUIDToString(ppr^.ClientID128));
Log(' FileIndex: ' + IntToStr(ppr^.FileIndex));
ia.S_addr := ppr^.RequestIP;
sAddr := string(inet_ntoa(ia));
Log(' Requester IP: ' + sAddr);
Log(' Requester Port: ' + IntToStr(ppr^.RequestPort));
if Assigned(FOnCatchHost) then
FOnCatchHost(Self, Format('%s:%d', [sAddr, ppr^.RequestPort]));
if Assigned(FOnPushRequest) then
FOnPushRequest(Self);
end;
procedure TGnutellaTrans.getQuery(GConn: TGConnection);
var
wMinSpeed: WORD;
sSearch: string;
begin
wMinSpeed := PWORD(Integer(GConn.RecvBufHead) + sizeof(gnutella_header))^;
sSearch := string(PChar(
Integer(GConn.RecvBufHead) + sizeof(gnutella_header) + 2));
inc(FSearchesIn);
Log('Query:');
Log('Minimum Speed: ' + IntToStr(wMinSpeed));
Log('Search Criteria: ' + sSearch);
if Assigned(FOnSearchReq) then
FOnSearchReq(wMinSpeed, sSearch);
end;
procedure TGnutellaTrans.getQueryResponse(GConn: TGConnection);
var
pqrh: Pgnutella_query_response_hdr;
ia: in_addr;
P: Pointer;
PinP: PChar;
I: integer;
s: string;
iFileSize:integer;
iFileIdx: integer;
begin
Log('Query Response:');
pqrh := Pgnutella_query_response_hdr(
integer(GConn.RecvBufHead) + sizeof(gnutella_header));
Log(' Remote Port: ' + IntToStr(pqrh^.port));
ia.S_addr := pqrh^.ip;
s := inet_ntoa(ia);
Log(' Remote IP: ' + s);
Log(' Remote Speed: ' + IntToStr(pqrh^.speed));
if Assigned(FOnCatchHost) then
FOnCatchHost(Self, Format('%s:%d', [s, pqrh^.port]));
if Assigned(FOnSrchRespBegin) then
FOnSrchRespBegin(s, pqrh^.port, pqrh^.speed);
P := Pointer(integer(GConn.RecvBufHead) + sizeof(gnutella_header)
+ sizeof(gnutella_query_response_hdr));
PinP := P;
for I := 1 to pqrh^.nrecs do begin
iFileIdx := Pgnutella_query_response_rec_hdr(PinP)^.FileIdx;
Log(' File Index: ' + IntToStr(iFileIdx));
iFileSize := Pgnutella_query_response_rec_hdr(PinP)^.FileSize;
Log(' File Size: ' + IntToStr(iFileSize));
inc(PinP, sizeof(gnutella_query_response_rec_hdr));
s := string(PChar(PinP));
Log(' File Name: ' + s);
inc(PinP, Length(s) + 2);
if Assigned(FOnSrchRespItem) then
FOnSrchRespItem(iFileIdx, iFileSize, pqrh^.speed, s);
end; { for Recs }
Log(' ClientID128: ' + GUIDToString(
Pgnutella_query_response_ftr(PinP)^.clientid128
));
if Assigned(FOnSrchRespEnd) then
FOnSrchRespEnd(Pgnutella_query_response_ftr(PinP)^.clientid128);
end;
procedure TGnutellaTrans.getUnknown(GConn: TGConnection);
begin
Log('Unknown Data: ');
Log(#13#10 + PointerToStr(
PChar(Integer(GConn.RecvBufHead) + sizeof(gnutella_header)),
GConn.RecvBufHead^.DataLen));
end;
procedure TGnutellaTrans.BeginSearch(const Query: string; MinSpeed: WORD);
var
hdr: gnutella_header;
P: PChar;
I: integer;
begin
SetupNewHdr(hdr);
hdr.Func := $80;
hdr.DataLen := 2 + Length(Query) + 1;
GetMem(P, sizeof(Hdr) + 2 + Length(Query) + 1);
try
FillChar(P^, sizeof(Hdr) + 2 + Length(Query) + 1, 0);
Move(hdr, P^, sizeof(hdr));
Move(MinSpeed, Pointer(Integer(P) + sizeof(Hdr))^, sizeof(MinSpeed));
StrPCopy(PChar(Integer(P) + sizeof(Hdr) + 2), PChar(Query));
for I := 0 to ConnList.Count - 1 do
if TGConnection(ConnList[I]).ProtocolConnected then
TGConnection(ConnList[I]).Socket.SendBuf(P^, sizeof(Hdr) + 2 + Length(Query) + 1);
finally
FreeMem(P);
end;
end;
function TGnutellaTrans.GetConnectionCount: integer;
var
I: integer;
begin
Result := 0;
for I := 0 to ConnList.Count - 1 do
if TGConnection(ConnList[I]).ProtocolConnected then
inc(Result);
end;
function TGnutellaTrans.GetSocketCount: integer;
begin
Result := ConnList.Count;
end;
procedure TGnutellaTrans.FreeAllSockets;
var
I: integer;
begin
for I := 0 to ConnList.Count - 1 do
TGConnection(ConnList[I]).Free;
ConnList.Clear;
end;
procedure TGnutellaTrans.SetListenPort(const Value: integer);
begin
if FListenPort = Value then
exit;
if ServerSock.Active then
raise Exception.Create('Setting port while server open not yet supported');
FListenPort := Value;
ServerSock.Port := FListenPort;
end;
procedure TGnutellaTrans.GetGNUTELLA_CONNECT(Socket: TCustomWinSocket);
var
GConn: TGConnection;
iBytes: integer;
begin
GConn := TGConnection(Socket.Data);
{ 22 is for GNUTELLA CONNECT/0.4aa }
GConn.RecvBuf.Size := 22;
iBytes := GConn.ReadFromSocket;
if iBytes = SOCKET_ERROR then begin
Log('Socket error in GNUTELLA CONNECT/0.4');
Socket.Close;
end
else begin
GConn.RecvBuf.Position := GConn.RecvBuf.Position + iBytes;
if GConn.RecvBuf.Position = GConn.RecvBuf.Size then
if StrLComp(PChar('GNUTELLA CONNECT/0.4'#10#10), PChar(GConn.RecvBufHead),
GConn.RecvBuf.Size) = 0 then begin
GConn.RecvBuf.Clear;
Socket.SendText('GNUTELLA OK'#10#10);
GConn.ProtocolConnected := true;
if Assigned(FOnClientProtocolConnect) then
FOnClientProtocolConnect(GConn);
if FSendInitOnConnect then
SendOneInit(Socket);
end // we got GNUTELLA OK
else begin
Log('Got invalid GNUTELLA protocol init');
Socket.Close;
end; // not GNUTELLA OK
end; // if no SOCKET_ERROR
end;
procedure TGnutellaTrans.CancelListen;
var
I: integer;
Err: Integer;
begin
for I := 0 to ServerSock.Socket.ActiveConnections - 1 do begin
{ we get the disconnect message, but since we do a postmessage, we'll
never get the WSAECONNRESET, so we have to call directly to make
sure we free our stuff }
Err := WSAECONNRESET;
HandleDisconnError('Canceled Listen',
TGConnection(ServerSock.Socket.Connections[I].Data), Err);
ServerSock.Socket.Connections[I].Close;
end;
ServerSock.Close;
end;
procedure TGnutellaTrans.Listen;
begin
try
ServerSock.Open;
except
on E : ESocketError do begin
{ this is most likely an Address in Use error }
// if E. ErrorCode = WSAEADDRINUSE then begin // 10048
Log('Listen port in use');
if Assigned(FOnListenPortInUse) then
FOnListenPortInUse(Self);
end;
end;
end;
procedure TGnutellaTrans.sockAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
end;
(***
Retuns true if the message is new
***)
function TGnutellaTrans.BroadcastMessage(GConn: TGConnection) : boolean;
var
pMsg: PGnuTelMessage;
I: integer;
begin
pMsg := FRouteMsgList.FindByMessageID(GConn.RecvBufHead^);
{ if we've already seen it, eat it }
if Assigned(pMsg) then begin
Result := false;
log('Duplicate message');
inc(FMessagesDropped);
inc(GConn.FMessagesDropped);
end
else begin
Result := true;
FRouteMsgList.Append(GConn);
{ if we've got some ttl left on it, pass it on }
if GConn.RecvBufHead^.TTLRemaining > 1 then begin
GConn.RecvBufHead^.TTLRemaining := GConn.RecvBufHead^.TTLRemaining - 1;
if GConn.RecvBufHead^.TTLRemaining > FMaxTTL then
GConn.RecvBufHead^.TTLRemaining := MaxTTL;
for I := 0 to ConnList.Count - 1 do
if TGConnection(ConnList[I]) <> GConn then
TGConnection(ConnList[I]).TransmitMsg(GConn);
end;
end; { if new message }
end;
(***
Returns true if the mesage is bound for us
***)
function TGnutellaTrans.RouteMessageResponse(GConn: TGConnection) : boolean;
var
pMsg: PGnuTelMessage;
begin
Result := false;
pMsg := FRouteMsgList.FindByMessageID(GConn.RecvBufHead^);
{ if it's in the list, we've already seen it, so send it to the
owner }
if Assigned(pMsg) then
if pMsg^.SourceConn = FGConnSelf then
Result := true
else
pMsg^.SourceConn.TransmitMsg(GConn)
else
{ we don't know what to do with it! Screw it }
inc(FRoutingErrorsIn);
end;
procedure TGnutellaTrans.DisconnectHost(const Host: string);
var
I: integer;
begin
{ todo: don't do this by host:port! do it by connection id or something }
for I := 0 to ConnList.Count - 1 do
if TGConnection(ConnList[I]).Host = Host then begin
TGConnection(ConnList[I]).Socket.Close;
exit;
end;
end;
function TGnutellaTrans.HeaderValid(const hdr: gnutella_header): boolean;
begin
with hdr do
Result :=
((Func = $00) and (DataLen = 0)) or // Pings always have 0 payload
((Func = $01) and (DataLen = 14)) or // Pong = 14
((Func = $40) and (DataLen = 26)) or // Push req = 26
(
((Func = $80) or (Func = $81)) and
((DataLen > 0) and (DataLen < 5000))
);
end;
procedure TGnutellaTrans.Shutdown;
begin
CancelListen;
FreeAllSockets;
end;
{ TGnuTelMessageList }
procedure TGnuTelMessageList.Append(GConn : TGConnection);
var
pTmp: PGnuTelMessage;
begin
New(pTmp);
Move(GConn.RecvBufHead^.MsgID, pTmp^.MessageID, sizeof(TGUID));
pTmp^.SourceConn := GConn;
if Assigned(FHead) then begin
{ new messages go on the front }
FHead^.Prev := pTmp;
pTmp^.Next := FHead;
pTmp^.Prev := nil;
FHead := pTmp;
{ check to see if our list is getting to big }
if FCount < MAX_ROUTE_LIST_SIZE then
inc(FCount)
else begin
pTmp := FTail;
FTail := FTail^.Prev;
FTail^.Next := nil;
Dispose(pTmp);
end;
end { if we've got a head }
else begin
FHead := pTmp;
FTail := pTmp;
pTmp^.Next := nil;
pTmp^.Prev := nil;
FCount := 1;
end;
end;
constructor TGnuTelMessageList.Create;
begin
inherited;
FHead := nil;
FTail := nil;
FCount := 0;
end;
destructor TGnuTelMessageList.Destroy;
begin
while Assigned(FHead) do begin
{ i'm cheating and using FTail as a temp var here }
FTail := FHead;
FHead := FHead^.Next;
Dispose(FTail);
end;
inherited;
end;
function TGnuTelMessageList.FindByMessageID(const Hdr : gnutella_header) : PGnuTelMessage;
begin
{ search from the most recent messages to the least recent }
Result := FHead;
while Assigned(Result) do
if CompareMem(@Hdr.MsgID, @Result^.MessageID, sizeof(TGUID)) then
break
else
Result := Result^.Next;
end;
procedure TGnuTelMessageList.PurgeGConn(GConn: TGConnection);
var
pTmp: PGnuTelMessage;
begin
pTmp := FHead;
while Assigned(pTmp) do begin
if pTmp^.SourceConn = GConn then
pTmp := RemoveNode(pTmp);
pTmp := pTmp^.Next;
end; { while msgs in the list }
end;
(***
Removes the Msg node from the list, disposes it, and returns
the Next msg In the list
***)
function TGnuTelMessageList.RemoveNode(pMsg: PGnuTelMessage) : PGnuTelMessage;
begin
if pMsg = FHead then begin
FHead := pMsg^.Next;
Result := FHead;
if Assigned(FHead) then
FHead^.Prev := nil
else
{ when the head goes nil, the tail must be too }
FTail := nil;
end { if head }
else if pMsg = FTail then begin
{ we don't have to do the stuff like we did for head, because if
we ran out of head, we're already fixed tail }
FTail := pMsg^.Prev;
Result := nil;
end
else begin
pMsg^.Next^.Prev := pMsg^.Prev;
pMsg^.Prev^.Next := pMsg^.Next;
Result := pMsg^.Next;
end; { node in the middle }
Dispose(pMsg);
end;
{ TGConnection }
constructor TGConnection.Create(ASockParent : TObject;
ASocket : TCustomWinSocket; const AHost : string);
begin
inherited Create;
FSocketParent := ASockParent;
FSocket := ASocket;
FHost := AHost;
FRecvBuf := TMemoryStream.Create;
if Assigned(FSocket) then
FSocket.Data := Self;
end;
destructor TGConnection.Destroy;
begin
FSocketParent.Free;
FRecvBuf.Free;
inherited;
end;
function TGConnection.GetRecvBufHead: Pgnutella_header;
begin
Result := Pgnutella_header(FRecvBuf.Memory);
end;
function TGConnection.GetRecvBufPos: PChar;
begin
Result := PChar(Integer(RecvBuf.Memory) + FRecvBuf.Position);
end;
function TGConnection.ReadFromSocket: integer;
begin
if Assigned(FSocket) then
Result := FSocket.ReceiveBuf(FRecvBuf.Memory^,
FRecvBuf.Size - FRecvBuf.Position)
else
Result := 0;
end;
(***
Take the message in SrcGConn's receive buffer and put it
put on our wire
***)
procedure TGConnection.TransmitMsg(SrcGConn: TGConnection);
var
iBytesSent: integer;
begin
{ todo: check for errors }
if Assigned(FSocket) then
iBytesSent := FSocket.SendBuf(SrcGConn.RecvBuf.Memory^, SrcGConn.RecvBuf.Size);
end;
end.