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.