OverbyteICS HTTP timeout when used in different threads

Question

I've been trying to figure this error our for about 4 days now. I'm using Delphi XE and have created a little tool for translators to use. I got the idea of using the Microsoft Translation API to help make things easier and a bit less tedious.

I created a class that accesses the Microsoft translator API, but I wanted to make it Thread Safe so the requests could be made in the background. I have no problem sending a request to get an Access Token, however, I run that request in a separate thread. When the user clicks a button, I spawn a new thread and run the http request to translate the term from in there. However, it times out every single time. If I run it from the same thread there's no problem.

Here is the method I use for sending the http requests (the THttpCli object that is passed is shared among threads)

function sendHTTPRequest(APost: Boolean; AURI: UTF8string;
  AContentType: UTF8string; APostData: UTF8String; AHttpCli: TSSLHttpCli): UTF8string;
var
  DataOut: TMemoryStream;
  DataIn: TMemoryStream;
  lHTMLStream: TStringStream;
  lencoding: TUTF8Encoding;
  lownClient: boolean;
begin

  lownClient := false;
  if AHttpCli = nil then
  begin
    AHttpCli := TSSLHttpCli.Create(nil);
    AHttpCli.SslContext := TSSLContext.Create(nil);
    with AHttpCli.SslContext do
    begin
      SSLCipherList := 'ALL:!ADH:RC4+RSA:+SSLv2:@STRENGTH';
      SSLVersionMethod := sslV23_CLIENT;
      SSLVerifyPeerModes := [SslVerifyMode_PEER]
    end;
    AHttpCli.MultiThreaded := true;
    lownClient := true;
  end;

  AHttpCli.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';

  if APost then
  begin
    DataOut := TMemoryStream.Create;
    DataOut.Write(APostData[1], Length(APostData));
    DataOut.Seek(0, soFromBeginning);
  end;

  AHttpCli.URL := AURI;
  AHttpCli.ContentTypePost := AContentType;
  DataIn := TMemoryStream.Create;
  if APost then AHttpCli.SendStream := DataOut;
  AHttpCli.RcvdStream := DataIn;

  try
    if apost then
      AHttpCli.Post
    else
      AHttpCli.Get;

    lHTMLStream := TStringStream.Create('', TEncoding.UTF8);
    lHtmlStream.LoadFromStream(AHttpCli.RcvdStream);
    result := lHtmlStream.DataString;
    lHtmlStream.Free;

  finally
    AHttpCli.Close;
    AHttpCli.RcvdStream := nil;
    AHttpCli.SendStream := nil;
    DataIn.Free;

    if APost then
      DataOut.Free;

    if lownClient then
      AHttpCli.free;
  end;
end;

I suppose the obvious solution is to just have one thread that waits for a signal to execute, but I was hoping to get an explanation as to why the timeout happens. I have no way to explain why the second thread times out and the first does not.

The HTTP component seems to get stuck on the dnslookup. OverbyteICS uses the Windows function WSAAsyncGetHostByName to lookup the name.

Any help is much appreciated

UPDATE May 13, 2013:

So, as it turns out, sharing the THttpCli object among threads seems to be what causes the timeout. The Solution is simply to pass nil into the AHttpCli parameter in my function above.

I'll still accept an answer as to WHY this causes a timeout. As far as I could tell the WSAAsyncGetHostByName method doesn't use any synchronous objects and the other thread was not running at the same time so there shouldn't be anything blocking the threads.

Answer 1

On Windows, OverbyteICS uses WSAAsyncSelect (here) and MsgWaitForMultipleObjects (here) to allow asynchronous notification of the socket events (FD_READ, FD_WRITE, FD_CLOSE and FD_CONNECT). Part of the design of WSAAsyncSelect requires a window that will receive the event messages, and to that end, a control class is registered using RegisterClass here, and an instance created using CreateWindowEx here, both in the call to THttpCli.Create.

This is where the issue arises; as alluded to in the documentation for GetMessage, PeekMessage and PostMessage, the message queue itself is per thread.

I've tested various permutations of each discrete step of the process (listed below) shared between 2 threads, and the only combinations that fail are when the call to CreateWindowEx and MsgWaitForMultipleObjects are performed on different threads, which reinforces the idea that a given message queue can only be accessed on the same thread.

Seemingly, without a rewrite of the OverbyteICS library itself, the only way to use it in a threaded environment is to create the THttpCli instance in the same thread as the subsequent request calls (THttpCli.Get, THttpCli.Post etc).

Appendix

• Call to RegisterClass

procedure Up0(S: PState);
var
  WndClass: TWndClass;
begin
  FillChar(WndClass, SizeOf(TWndClass), 0);
  WndClass.lpfnWndProc := @DefWindowProc;
  WndClass.hInstance := hInstance;
  WndClass.lpszClassName := 'test';
  if RegisterClass(WndClass) = 0 then
    ExitProcess(GetLastError);
end;

• Call to CreateWindowEx

procedure Up1(S: PState);
begin
  S.Window := CreateWindowEx(WS_EX_TOOLWINDOW, 'test', '', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil);
  if S.Window = 0 then
    ExitProcess(GetLastError);
end;

• Call to Ics_socket

procedure Up2(S: PState);
begin
  S.Socket := Ics_socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if S.Socket = INVALID_SOCKET then
    ExitProcess(Ics_WSAGetLastError);
end;

• Call to Ics_WSAAsyncSelect

procedure Up3(S: PState);
begin
  if Ics_WSAAsyncSelect(S.Socket, S.Window, WM_USER, FD_CONNECT) = SOCKET_ERROR then
    ExitProcess(Ics_WSAGetLastError);
end;

• Call to Ics_connect

procedure Up4(S: PState);
var
  Error: Integer;
  Sin: TSockAddrIn;
begin
  FillChar(Sin, SizeOf(TSockAddrIn), 0);
  Sin.sin_family := AF_INET;
  Sin.sin_port := Ics_htons(42);
  if Ics_connect(S.Socket, PSockAddr(@Sin)^, SizeOf(TSockAddrIn)) = SOCKET_ERROR then
  begin
    Error := Ics_WSAGetLastError;
    if Error <> WSAEWOULDBLOCK then
      ExitProcess(Error);
  end;
end;

• Call to MsgWaitForMultipleObjects

procedure Up5(S: PState);
var
  Msg: TMsg;
  WaitResult: Cardinal;
begin
  WaitResult := MsgWaitForMultipleObjects(0, Pointer(nil)^, False, 1000, QS_ALLINPUT);
  if WaitResult = WAIT_TIMEOUT then
  begin
    S.Result := 0;
    Exit;
  end;

  while PeekMessage(Msg, S.Window, WM_USER, WM_USER, PM_REMOVE) do
    if LOWORD(Msg.lParam) = FD_CONNECT then
    begin
      S.Result := 1;
      Exit;
    end;
end;