We have a Indy (version 10.6.1.5235) TIdHttpServer "service" that has worked well for years with Delphi 2007. After the most recent Windows Update (KB4338815 and KB4338830) we noticed the service freezes when TIdHttpServer is set to false.
I have included source code where TIdHttpServer is created. In our service "Stop" handler we set IdHttpServer1.Active to False and this is where it freezes. It seems Indy hangs when it is trying to close the http connections. Is there a work around?
Update One Per Remy Lebeau, I have created a Minimal, Complete, and Verifiable example. Here it is:
procedure TMainForm.Button1Click(Sender: TObject);
begin
memo1.clear;
iCall := 0;
IdHTTPServer1 := TIdHTTPServer.Create;
IdHTTPServer1.MaxConnections := 10;
IdHTTPServer1.AutoStartSession := True;
IdHTTPServer1.SessionState := True;
IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
IdHTTPServer1.KeepAlive := False;
idHttpServer1.DefaultPort := 80;
if ReuseSocket.checked then
IDHTTPSERVER1.ReuseSocket := rsTrue;
IdHTTPServer1.Active := True;
end;
procedure TMainForm.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
iCall := iCall + 1;
if iCall mod 100 = 0 then
memo1.lines.add(inttostr(iCall)+ ' calls made');
AResponseInfo.ContentText := '<html><body>Hello There</body></html';
end;
procedure TMainForm.StopClick(Sender: TObject);
begin
try
IdHTTPServer1.Active := False;
memo1.lines.add('IdHTTPServer1.Active := False;');
except
on e: exception do
memo1.lines.add('Exception on IdHTTPServer1.Active := False; Message:'+e.message);
end;
end;
Application will run fine but once you click the "Stop" button which sets the IdHttpServer Active property to False it hangs.
You might have encountered this similar issue:
Windows 2012 R2 closesocket() hangs on listening socket
The issue was brought by patch from Microsoft KB4338815, which caused closesocket tо hang forever on Intel Xeon processors
That issue was fixed by uninstalling KB4338815, which you do have installed. So try uninstalling that KB on your system and see if it solves your issue.
Related
I'm trying to implement UDP Hole Punching with Delphi with Indy and Firemonkey technology.
I have tried to follow this document: https://www.researchgate.net/publication/1959162_Peer-to-Peer_Communication_Across_Network_Address_Translators
The program seems to work but is NOT stable.
If I work on a system on the local intranet no problem.
If I work on an internet, it doesn't always work and I don't know why.
I have created two applications.
The first is server side.
Everytime all clients connect correctly to server.
The server registers the Local IP and Internet IP pairs in a variable (fPeers).
I created an IdUDPServer instance.
This is the “Connect push button” code:
procedure TForm1.B_ConnectClick(Sender: TObject);
var
vIdSocketHandle: TIdSocketHandle;
begin
if IdUDPServer.Active then
begin
IdUDPServer.Active := False;
B_Connect.Text := 'Connect';
end
else
begin
IdUDPServer.Bindings.Clear;
vIdSocketHandle := IdUDPServer.Bindings.Add;
vIdSocketHandle.IP := GStack.LocalAddress;
vIdSocketHandle.Port := E_POrt.Text.ToInteger;
IdUDPServer.Active := True;
B_Connect.Text := 'Disconnect';
end;
end;
During the IdUDPServerUDPRead event I capture the Local and Internet IP addresses of the clients that connect.
In the TStringLIST called fPeerIP I add the list of addresses.
procedure TForm1.IdUDPServerUDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
var vPair: string;
vData: string;
vString: string;
vLog: string;
begin
vPair := ABinding.PeerIP + ':'+ABinding.PeerPort.ToString;
vData := BytesToString(AData);
vLog := '';
if leftstr(vdata,7) = 'LOCALIP' then
begin
vString := vPair+#9+lsExtract(vData,2,',');
if fPeerIP.IndexOfName(vString) = -1 then
begin
fPeerIP.Add(vString);
M_Peers.Lines.Add(vString);
vLog := vLog + vString + #13#10;
IdUDPServer.Send(ABinding.PeerIP, ABinding.PeerPort, 'Peer aggiunto alla lista');
end;
end
else vLog := vData;
end;
On the client side, I created an IdUDPServer instance which, upon connection, sends a string to the server.
procedure TForm2.B_ConnectClick(Sender: TObject);
var vIdSocketHandle: TIdSocketHandle;
vLocalAddressList: TIdStackLocalAddressList;
vI: Integer;
vSendLIST: TStringLIST;
begin
if IdUDPServer.Active then
begin
Timer.Enabled := False;
IdUDPServer.Active := False;
B_Connect.Text := 'Connect';
M_Networks.Lines.Clear;
M_Debug.Lines.Clear;
LB_Peers.Items.Clear;
end
else
begin
try
vSendLIST := TStringLIST.Create;
IdUDPServer.Bindings.Clear;
vLocalAddressList := TIdStackLocalAddressList.Create;
GStack.GetLocalAddressList(vLocalAddressList);
M_Networks.Lines.Clear;
for vI := 0 to vLocalAddressList.Count-1 do
begin
if vLocalAddressList.Addresses[vI].IPVersion = id_IPV4 then
begin
M_Networks.Lines.Add(vLocalAddressList.Addresses[vI].IPAddress);
vSendLIST.Add(Format('LOCALIP,%s:%d',[vLocalAddressList.Addresses[vI].IPAddress,E_ClientPort.Text.ToInteger]));
end;
end;
vIdSocketHandle := IdUDPServer.Bindings.Add;
vIdSocketHandle.Port := E_ClientPort.Text.ToInteger;
vIdSocketHandle.IP := '0.0.0.0';
IdUDPServer.Active := True;
for vI := 0 to vSendLIST.Count-1 do
IdUDPServer.Send(E_Server.Text, E_Port.Text.ToInteger, vSendLIST[vI]);
B_Connect.Text := 'Disconnect';
if Assigned(vSendLIST) then FreeAndNil(vSendLIST);
finally
if Assigned(vLocalAddressList) then FreeAndnil(vLocalAddressList);
end;
end;
end;
Also on the client side, in the IdUDPServerUDPRead event I detect the list of Peers (function sent by the server) and send a "PING" to each connected peer.
I realize maybe I have given little information.
I'd like to know your opinion and possibly indicate to me if I made a mistake in the process that activates the Hole Punching.
Thanks in advance
LS
Your code is theoretically right and may work on some NAT routers but it will not work on the rest
I have been trying to achieve UDP Hole Punching for many years but it's really complicated,
you need to combine many NAT Traversal mechanisms together to make it work in the most cases
Reading about STUN, TURN and ICE mechanisms may help
I have one external program which doesn't support proxy to access internet and but I need proxy.
As a solution, I've written one simple Delphi Application using Indy 10.6.0.5040 and its TIdMappedPortTCP component. How it works simply, external application connects to IdMappedPortTCP locally and IdMappedPortTCP connects to real server using my proxy settings.
To do my proxy setting, I handled OnConnect event of IdMappedPortTCP like below:
procedure TForm1.IdMappedPortTCP1Connect(AContext: TIdContext);
var
io: TIdIOHandlerStack;
proxy: TIdConnectThroughHttpProxy;
begin
if Assigned(TIdMappedPortContext(AContext).OutboundClient) then
begin
io := TIdIOHandlerStack.Create(TIdMappedPortContext(AContext).OutboundClient);
proxy := TIdConnectThroughHttpProxy.Create(io);
proxy.Enabled := False;
proxy.Host := FSettings.ProxyAddress;
proxy.Port := FSettings.ProxyPort;
proxy.Username := FSettings.ProxyUserName;
proxy.Password := FSettings.ProxyPassword;
If (proxy.Username <> '') or (proxy.Password <> '') then proxy.AuthorizationRequired(True);
proxy.Enabled := True;
io.DefaultPort := FSettings.DestinationPort[0];
io.Port := FSettings.DestinationPort[0];
io.Destination := FSettings.DestinationHostAddress[0];
io.Host := FSettings.DestinationHostAddress[0];
io.TransparentProxy := proxy;
io.OnStatus := StackStatus;
TIdMappedPortContext(AContext).OutboundClient.IOHandler := io;
end;
Log(Format('Listener connected at %s:%d', [TIdMappedPortContext(AContext).Server.MappedHost, TIdMappedPortContext(AContext).Server.MappedPort]));
end;
{ TIdConnectThroughHttpProxyHelper }
procedure TIdConnectThroughHttpProxyHelper.AuthorizationRequired(const val: boolean);
begin
Self.FAuthorizationRequired := val;
end;
procedure TForm1.Log(const s: string);
begin
Memo1.Lines.Add(Format('(%s) %s', [FormatDateTime('hh:nn:ss:zzz', Now), s]));
end;
procedure TForm1.IdMappedPortTCP1Disconnect(AContext: TIdContext);
begin
// Log(Format('Listener disconnected at %s:%d', [TIdMappedPortContext(AContext).Server.MappedHost, TIdMappedPortContext(AContext).Server.MappedPort]));
end;
procedure TForm1.IdMappedPortTCP1Exception(AContext: TIdContext;
AException: Exception);
begin
Log(Format('Exception: %s (%s:%d)', [AException.Message,TIdMappedPortContext(AContext).Server.MappedHost, TIdMappedPortContext(AContext).Server.MappedPort]));
end;
procedure TForm1.IdMappedPortTCP1ListenException(AThread: TIdListenerThread;
AException: Exception);
begin
Log(Format('Listener Exception: %s', [AException.Message]));
end;
procedure TForm1.IdMappedPortTCP1OutboundConnect(AContext: TIdContext);
begin
Log('MappedPort Destination connected.');
end;
procedure TForm1.IdMappedPortTCP1OutboundDisconnect(AContext: TIdContext);
begin
Log('MappedPort Destination disconnected.');
end;
procedure TForm1.StackStatus(ASender: TObject;
const AStatus: TIdStatus; const AStatusText: string);
begin
Log(Format('Stack Status: %s', [AStatusText]));
end;
I have many active connections and all work flawlessly. My problem is that, if I try to deactivate IdMappedPortTCP using "IdMappedPortTCP.Active := false;" while there are active traffics, connections, it hangs there and I had to terminate delphi application using task manager.
Is there anything that I need to do manually before setting Active to false?
Thanks.
Indy servers are multi-threaded. Their events (like OnConnect, OnDisconnect, OnExecute, OnException, and OnListenException) are triggered in the context of worker threads, not the context of the main UI thread. As such, you must sync with the main thread, such as with the TThread.Synchronize() or TThread.Queue() methods, or Indy's TIdSync or TIdNotify classes, in order to access UI components safely.
If the main thread is busy deactivating the server, it cannot process sync requests, so an asynchronous approach (TThread.Queue() or
TIdNotify) is preferred over a synchronous one (TThread.Synchronize() or TIdSync) to avoid a deadlock. Alternatively, deactivate the server in a worker thread so the main thread is free to process sync requests.
I'm using the Indy 10 Http Client (latest SVN build) and a SSL Handler (Delphi 7) to get the content of the https://www.webtide.com/choose/jetty.jsp website.
It works fine on Windows 7 x64 (tested on two systems), but on WindowsXP x86 (tested on 3 systems) the test app simply hangs on TIdHTTP.Get() without the possibility of a recovery (meaning even disconnecting in a worker-procedure/thread does not work!). The test app cannot be recovered and must be closed with the task manager.
The SSL libraries (32bit x86!) are from here: http://slproweb.com/products/Win32OpenSSL.html
but I've tried 5 other versions from different sites, with the same results.
Here is a zip package with source code, compiled executable, and the SSL libraries:
https://www.dropbox.com/s/pd5soxon0qbnnl0/IndyTest.zip
And here is the source code (the form has a button and two memos):
procedure TForm1.Button1Click(Sender: TObject);
var IdHTTP1: TIdHTTP;
sl : TStringList;
SSL1: TIdSSLIOHandlerSocketOpenSSL;
begin
try
try
IdHTTP1 := TIdHTTP.Create(nil);
sl := TStringList.Create;
SSL1 := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
SSL1.SSLOptions.Method := sslvSSLv23;
with IdHTTP1 do
begin
ConnectTimeout := 10 * 1000;
ReadTimeout := 10 * 1000;
IOHandler := SSL1;
Request.UserAgent := 'Mozilla/5.0 (X11; U; Linux i586; en-US; rv:1.7.3) Gecko/20040924 Epiphany/1.4.4 (Ubuntu)';
Memo2.Text := 'connecting...';
Application.ProcessMessages;
Memo1.Text := Get('https://www.webtide.com/choose/jetty.jsp');
Memo1.Lines.Add ('response: '+ResponseText);
Memo2.Text := 'connected or timeout...';
end;
except
On e: Exception do
Memo2.Text := 'Exception: '+e.Message;
end;
finally
IdHTTP1.Free;
SSL1.Free;
sl.Free;
end;
end;
Why does it crash/hang on WindowsXP?
Indy's ConnectTimeout property only applies to the socket API connect() function when establishing the underlying TCP/IP connection. SSL_connect() is called at a later time to initiate the SSL handshake, which is application data and thus is not subject to the ConnectTimeout.
Indy does use its ReadTimeout property to assign socket level read/write timeouts on OpenSSL connections, but only on Vista+ as a workaround for an OpenSSL bug. On XP and earlier, default socket read/write timeouts apply. The ReadTimeout only tells Indy how long to wait when reading data, but it is not applied to the socket itself. If you want to do that, you can do it manually by calling the TIdSocketHandle.SetSockOpt() method after establishing the TCP/IP connection but before beginning the SSL handshake, for example:
procedure TForm1.Button1Click(Sender: TObject);
var
IdHTTP1: TIdHTTP;
SSL1: TIdSSLIOHandlerSocketOpenSSL;
begin
try
IdHTTP1 := TIdHTTP.Create(nil);
try
SSL1 := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP1);
SSL1.SSLOptions.Method := sslvSSLv23;
with IdHTTP1 do
begin
ConnectTimeout := 10 * 1000;
ReadTimeout := 10 * 1000;
IOHandler := SSL1;
OnConnected := IdHTTPConnected;
OnStatus := IdHTTPStatus;
Request.UserAgent := 'Mozilla/5.0 (X11; U; Linux i586; en-US; rv:1.7.3) Gecko/20040924 Epiphany/1.4.4 (Ubuntu)';
Memo1.Text := Get('https://www.webtide.com/choose/jetty.jsp');
Memo1.Lines.Add('response: '+ ResponseText);
Memo2.Text := 'finished...';
end;
finally
IdHTTP1.Free;
end;
except
on e: Exception do
Memo2.Text := 'Exception: ' + e.Message;
end;
end;
procedure TForm1.IdHTTPStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
begin
case AStatus of
hsResolving: Memo2.Text := 'resolving...';
hsConnecting: Memo2.Text := 'connecting...';
hsConnected: Memo2.Text := 'connected...';
hsDisconnecting: Memo2.Text := 'disconnecting...';
hsDisconnected: Memo2.Text := 'disconnected...';
end;
Update;
end;
procedure TForm1.IdHTTPConnected(Sender: TObject);
begin
with TIdHTTP(Sender).Socket.Binding do
begin
SetSockOpt(Id_SOL_SOCKET, Id_SO_RCVTIMEO, 10 * 1000);
SetSockOpt(Id_SOL_SOCKET, Id_SO_SNDTIMEO, 10 * 1000);
end;
end;
How do I enable ribbon buttons which are disabled after clicking the more commands button in a quickaccessbar using Delphi?
This is a known bug
Quality Central report 70342:
When using Ribbon Controls, if one
adds a quick access toolbar, and then
at runtime chooses "More Commands" to
customize the quick access toolbar,
many (although not always all) of the
action components in various ribbon
groups will become permanently
disabled.
Please see the report itself for more information:
http://qc.embarcadero.com/wc/qcmain.aspx?d=70342
The report is still open, so I it may not have been solved in D2011 either, but Quality Central could be lagging behind a bit.
Update
The report states there is no work around, but Jack Sudarev posted one in the comments:
procedure TForm6.ActionManager1StateChange(Sender: TObject);
begin
UpdateActions(ActionManager1);
end;
procedure TForm6.UpdateActions(ActionManager: TActionManager);
var
i: Integer;
begin
if not Assigned(ActionManager) then
Exit;
for i := 0 to ActionManager.ActionCount - 1 do
begin
(ActionManager.Actions[i] as TAction).Enabled := False;
(ActionManager.Actions[i] as TAction).Enabled := True;
end;
end;
This is what i did:
procedure TmainTranslatform.MyUpdateActions(ActionManager: TActionManager);
var
i: Integer;
begin
if not Assigned(ActionManager) then
Exit;
for i := 0 to ActionManager.ActionCount - 1 do
begin
if (ActionManager.Actions[i] is TFileOpen) then
begin
(ActionManager.Actions[i] as TFileOpen).Enabled := False;
(ActionManager.Actions[i] as TFileOpen).Enabled := True;
end;
if (ActionManager.Actions[i] is TAction) then
begin
(ActionManager.Actions[i] as TAction).Enabled := False;
(ActionManager.Actions[i] as TAction).Enabled := True;
end;
end;
end;
I had all kind of problems with Indy and following someone’s recommendations (at stackoverflow) I have updated to the latest version of Indy - at least this is what I intended to do.
Before starting the installation, I have manually deleted all files containing the "indy" word from my Delphi and from registry. Then I have followed the standard install procedure: http://www.indyproject.org/sockets/Docs/Indy10Installation.en.aspx
Now the piece of code below is not working anymore. The code just returns FALSE;
function Download(CONST aSourceURL: string; CONST aDestFileName: string; OUT aErrm: String): Boolean;
VAR
Stream: TMemoryStream;
IDAntiFreeze: TIDAntiFreeze;
fIDHTTP : TIDHTTP;
begin
fIDHTTP := TIDHTTP.Create(NIL);
// fIDHTTP.ConnectTimeout:=5000; <- not recognized
fIDHTTP.ReadTimeout:= 1000;
fIDHTTP.HandleRedirects := TRUE;
fIDHTTP.AllowCookies := FALSE;
fIDHTTP.Request.UserAgent := 'Mozilla/4.0';
fIDHTTP.Request.Connection := 'Keep-Alive';
fIDHTTP.Request.ProxyConnection := 'Keep-Alive';
fIDHTTP.Request.CacheControl := 'no-cache';
IDAntiFreeze := TIDAntiFreeze.Create(NIL);
Stream := TMemoryStream.Create;
TRY
TRY
fIDHTTP.Get(aSourceURL, Stream);
{
if FileExists(aDestFileName)
then DeleteFile(PWideChar(aDestFileName)); }
Stream.SaveToFile(aDestFileName);
Result:= TRUE;
EXCEPT
On E: Exception do
begin
Result:= FALSE;
aErrm := E.Message + ' (' + IntToStr(fIDHTTP.ResponseCode) + ')';
end;
END;
FINALLY
Stream.Free;
IDAntiFreeze.Free;
fIDHTTP.Free;
END;
end;
There is any way to see which version of Indy I have installed?
Edit:
Also I get an "Unit idHTTP was compiled with a different version of IdException.IdException" message. Fixed.
You should first use the Delphi setup to uninstall the version of Indy that is installed with Delphi - then you can cleanup any remaining file. You should not start by cleaning folders and registry by hand.
Then you can install another version. Be aware some releases are "breaking"