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.