Indy SSL to plain socket pump - delphi

I have to provide an SSL front for a plain TCP server, so I'm making a "pump" application that will provide an SSL connection to the outside while the original server can stay plain.
I'm trying to use the Indy components to support my SSL needs, but I can't seem to get any data from the SSL port. I assigned the TIdTCPServer.OnExecute to the following event handler:
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
c:TIdTCPClient;
cs,ss:TIdIOHandler;
b:TBytes;
begin
c:=TIdTCPClient.Create(Self);
try
c.Host:='127.0.0.1';
c.Port:=60675;
c.ConnectTimeout:=500;
c.Connect;
ss:=c.IOHandler;
cs:=AContext.Connection.IOHandler;
while (cs.Connected) and (ss.Connected) do
begin
if cs.CheckForDataOnSource(1) then
begin
try
cs.ReadBytes(b,1,False);
except on e:Exception do
Memo1.Lines.Add(e.Message); //BAD out of Thread context
end;
if Length(b)>0 then
ss.Write(b);
end;
if ss.CheckForDataOnSource(1) then
begin
ss.ReadBytes(b,1,False);
if Length(b)>0 then
cs.Write(b);
end;
end;
finally
c.Free;
end;
end;
The TCP server has an SSL handler attached. I did the same on a plain HTTP server and it worked fine, so I'm assuming my SSL setup is not the issue.
cs=Client Side (the server socket) and ss=Server side (the client for the TCP server I'm trying to add SSL to).
Now, I know it needs cleanup and doing 1ms waits isn't pretty, but before I can attack that issue, I'd like to receive some data.
Neither of my ReadBytes get called. When I used cs.Readable(), I get true just once, but I still couldn't read.
What can I do to make a pump? Why am I not getting data?

Try using the TIdMappedPortTCP component instead of TIdTCPServer directly. TIdMappedPortTCP handles all the work of passing data back and forth between a client and another server. By default, the outbound connection to the second server is not encrypted, even if the inbound connection to TIdMappedPortTCP is encrypted.

Related

TIdHTTPProxyServer raising "Unknown Protocol" RSHTTPUnknownProtocol exception

I'm recoding an old Delphi XE program using Delphi 10.3 Rio. It uses the TIdHTTPProxyServer Indy component listening on 127.0.0.1:80.
with IdHTTPProxyServer.Bindings.Add do begin
IP := '127.0.0.1';
Port := 80;
end;
IdHTTPProxyServer.Active := True;
For testing, I added 127.0.0.1 localtest123.com and 127.0.0.1 www.localtest123.com to the hosts file and disabled the DNS cache service. Then in multiple browers I requested http://localtest123.com/ and http://www.localtest123.com/. With OutputDebugString() I can see the connections accepted but then raises an "Unknown Protocol" error.
I debugged the exception in the TIdHTTPProxyServer.CommandPassThrough procedure in IdHTTPProxyServer.pas. It seems LURI.Protocol is an empty string which is why the RSHTTPUnknownProtocol is raised.
LContext := TIdHTTPProxyServerContext(ASender.Context);
LContext.FCommand := ASender.CommandHandler.Command; //<-'GET'
LContext.FTarget := ASender.Params.Strings[0]; //<-'/'
LContext.FOutboundClient := TIdTCPClient.Create(nil);
try
LURI := TIdURI.Create(LContext.Target); //<-'/'
try
TIdTCPClient(LContext.FOutboundClient).Host := LURI.Host; //<-''
if LURI.Port <> '' then begin //<-''
TIdTCPClient(LContext.FOutboundClient).Port := IndyStrToInt(LURI.Port, 80);
end
else if TextIsSame(LURI.Protocol, 'http') then begin //<-'' {do not localize}
TIdTCPClient(LContext.FOutboundClient).Port := IdPORT_HTTP;
end
else if TextIsSame(LURI.Protocol, 'https') then begin //<-'' {do not localize}
TIdTCPClient(LContext.FOutboundClient).Port := IdPORT_https;
end else begin
raise EIdException.Create(RSHTTPUnknownProtocol);
end;
I'm probably missing something but TIdHTTPProxyServer just works without much code so I have to ask for help on this exception. Thanks in advance!
You can't just redirect the domains in your HOSTS file and expect things to magically work. That is not how proxying works.
You must explicitly configure web browsers to make HTTP requests through an HTTP proxy so that they format the proper requests that a proxy would understand. Sending an HTTP request directly to a target web server is handled differently than sending the same HTTP request through a proxy.
You are getting the exception because the browser requests are not targeting your proxy properly.
For example, when a browser sends an HTTP GET request directly to a target web server, it connects directly to that server and then sends a request that looks something like this:
GET /path HTTP/1.1
Host: server.com
But, when it sends the same request through an HTTP proxy, it connects to the proxy and sends a request that looks more like this instead:
GET http://server.com/path HTTP/1.1
That extra path information in the GET line is missing in your browser requests, because you do not have your browsers configured for proxying, thus the exception when TIdHTTPProxyServer is trying to determine the info it needs to make a connection to the target web server and forward the current request to it.
This is fundamentally to how HTTP works, and how TIdHTTPProxyServer is designed to work.
Things are a bit more complicated when HTTPS is involved, but I'm leaving that detail out for now, as it is not relevant to your question about the exception.
UPDATE: in comments, you say:
In the XE version it never raised an exception when checking for the protocol which would still work today because I manually set the host and port in DoHTTPBeforeCommand.
In that old version, there was no exception raised, because TIdHTTPProxyServer did not check the protocol yet to differentiate between HTTP and HTTPS. You were able to manually fill in missing info when a request was received that was not specifically targeting your proxy. That is why things worked for you before.
In a later version, TIdHTTPProxyServer was updated to differentiate between HTTP and HTTPS when no port is explicitly specified in the request, so a default port is set based on protocol requested. That check happens before DoHTTPBeforeCommand() is called.
To get the old behavior back, you would have to alter TIdHTTPProxyServer's source code to delay the raising of the exception until after DoHTTPBeforeCommand() returns, so you have a chance to fill in missing values again.
If you file a feature request for that, I might consider adding it to Indy's official code.

Delphi send HTTP GET request without wait for the server response

I want send HTTP request (GET) without wait for the server response.
I have tried with IdHTTP by ignoring the response, eg.:
aIdHTTP := TIdHTTP.create;
try
aIdHTTP.Get('https://stackoverflow.com/');
finally
aIdHTTP.free;
free
but it always wait for the server response...
A trick is close the connection by raising an exception in the TIdHTTP.OnWork event when AWorkMode is wmRead, this close the connection sooner... but wait for the "first byte" response.
There is a way for send data without waiting for the response?
The short answer is NO, well not with TIdHTTP, anyway. HTTP is a protocol, and TIdHTTP follows the protocol, which includes reading the server's response.
As you discovered, you could raise an exception in the TIdHTTP.OnWork event, but that will only work once at least 1 byte is received from the server. You could specify a short TIdHTTP.ReadTimeout value to avoid that, though.
Another option is to close the socket connection in the TIdHTTP.OnHeadersAvailable event, but that requires TIdHTTP reading the server's complete response headers.
IF the response is using HTTP 1.1 chunking, you could enable the hoNoReadChunked flag in the TIdHTTP.HTTPOptions property. But that also requires reading the server's complete response header.
Really, the only way to accomplish what you are asking for is to not use TIdHTTP at all. Use TIdTCPClient instead, and manually send your own HTTP request and then close the connection after sending it, eg:
aIdClient := TIdTCPClient.Create;
try
aIdClient.Host := 'stackoverflow.com';
aIdClient.Port := 443;
aIdClient.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(aIdClient);
TIdSSLIOHandlerSocketOpenSSL(aIdClient.IOHandler).PassThrough := False;
aIdClient.Connect;
try
aIdClient.IOHandler.WriteLn('GET / HTTP/1.1');
aIdClient.IOHandler.WriteLn('Host: stackoverflow.com');
aIdClient.IOHandler.WriteLn('Connection: close');
aIdClient.IOHandler.WriteLn;
finally
aIdClient.Disconnect;
end;
finally
aIdClient.free;
end;
But what is the point of requesting a file and not actually downloading it?
If you just want to check that the server can be connected to, you don't have to send anything at all
aIdClient := TIdTCPClient.Create;
try
aIdClient.Host := 'stackoverflow.com';
aIdClient.Port := 443;
aIdClient.Connect;
aIdClient.Disconnect;
finally
aIdClient.free;
end;
If you are just trying to avoid downloading a file's actual content over HTTP, you could use TIdHTTP.Head() instead of TIdHTTP.Get():
aIdHTTP.Head('https://stackoverflow.com/');

SendMail with TIdSMTP Connection Time Out

I am not able to send emails using TIdSMTP I am getting the following message: Socket Error # 10060 / Connection timed out.
I am using version Delphi XE6
Here is my code:
procedure TForm1.Button1Click(Sender: TObject);
var
IdSMTP : TIdSMTP;
IdMessage : TIdMessage;
begin
IdSMTP := TIdSMTP.Create (Nil);
IdMessage := TIdMessage.Create (Nil);
IdSMTP.Host := 'mail.mysmtp.com';
IdSMTP.Port := 25;
IdSMTP.Connect ();
IdMessage.From.Address := 'test#mysmtp.com';
IdMessage.From.Name := 'Contato';
IdMessage.Recipients.EMailAddresses := 'test#hotmail.com';
IdMessage.Subject := 'Contato test';
IdMessage.Body.Text := 'test';
IdSMTP.Send (IdMessage);
IdSMTP.Disconnect ();
FreeAndNil (IdMessage);
FreeAndNil (IdSMTP);
end;
From Google: A socket error in the 10060 range is a Winsock error. It is generally caused by either outgoing connection problems or connection problems on the host end.
I don't know if you sanitized this code to post it or not, but I'd say the culprit is either the hostname or the username on the from address.
Winsock will attempt to create a connection to the hostname. If it fails to get the expected ACK, it'll generate a timeout error. I've also seen this happen when the domain name isn't resolved by DNS.
Also, what was mentioned earlier regarding authentication ... the lack of response from the SMTP host could be due to improper authentication. It all depends on how the host's SMTP service was configured, so it could just ignore unauthorized requests.
You need to see if you must pass in a username/pwd with the SMTP request, or read the mailbox first (read before write, so to speak). I cannot imagine anybody configuring an SMTP server without requiring some kind of authentication, because otherwise you've got what amounts to an "open relay" where any process can send out unlimited traffic through it.
Also, the from address might be required to be valid. That is, 'test#mysmtp.com' would require a user/mailbox for 'test' to exist, as opposed to '*#mysmtp.com' that would work with ANY user/mailbox name.
All of these could result in a timeout because the SMTP host could be configured to simply ignore improper and unauthenticated requests.

Check remote port access using Delphi - Telnet style

I deploy my application in environments heavily stricken with firewalls. Frequently I find myself using Telnet to check if a port is open and accessible in the network.
Now I would like to implement an equivalent functionality of the command, Telnet [domainname or ip] [port], in Delphi.
Is it adequate that I just attempt to open and close a TCP/IP socket without sending or receiving any data?
Is there any risk that I might crash the arbitrary application/service listening on the other end?
Here's my code:
function IsPortActive(AHost : string; APort : Word):boolean;
var IdTCPClient : TIdTCPClient;
begin
IdTCPClient := TIdTCPClient.Create(nil);
try
try
IdTCPClient.Host := AHost;
IdTCPClient.Port := APort;
IdTCPClient.Connect;
except
//Igonre exceptions
end;
finally
result := IdTCPClient.Connected;
IdTCPClient.Disconnect;
FreeAndNil(IdTCPClient);
end;
end;
If you just want to check whether the port is open, then you can use this:
function IsPortActive(AHost : string; APort : Word): boolean;
var
IdTCPClient : TIdTCPClient;
begin
Result := False;
try
IdTCPClient := TIdTCPClient.Create(nil);
try
IdTCPClient.Host := AHost;
IdTCPClient.Port := APort;
IdTCPClient.Connect;
Result := True;
finally
IdTCPClient.Free;
end;
except
//Ignore exceptions
end;
end;
But that only tells you if any server app has opened the port. If you want to make sure that YOUR server app opened the port, then you will have to actually communicate with the server and make sure its responses are what you are expecting. For this reason, many common server protocols provide an initial greeting so clients can identify the type of server they are connected to. You might consider adding a similar greeting to your server, if you are at liberty to make changes to your communication protocol.
Simply opening a connection to the server does not impose any risk of crashing the server, all it does is momentarily occupy a slot in the server's client list. However, if you actually send data to the server, and the server app you are connected to is not your app, then you do run a small risk if the server cannot handle arbitrary data that does not conform it its expected protocol. But that is pretty rare. Sending a small command is not uncommon and usually pretty safe, you will either get back a reply (which may be in a format that does not conform to your protocol, so just assume failure), or you may not get any reply at all (like if the server is waiting for more data, or simply is not designed to return a reply) in which case you can simply time out the reading and assume failure.

Start Communication from server first in delphi by Indy 10

In Socket applications programmed by TCPServer/Client components, usually we active server side, then connect client to server, and when we need to get or send data from one side to other, first we send a command from client to server and a communication will starts.
But the problem is that always we need to start conversation from client side!
I want to ask is any idea for start conversation randomly from server side without client side request?
I need this functionality for notify client(s) from server side. for example, when a registered user (client-side) connected to server, other connected users (on other client-sides), a notification must send from server to all users (like Yahoo Messenger).
I'm using TIdCmdTCPServer and TIdTCPClient components
You are using TIdCmdTCPServer. By definition, it sends responses to client-issued commands. For what you are asking, you should use TIdTCPServer instead, then you can do whatever you want in the TIdTCPServer.OnExecute event.
What you ask for is doable, but its implementation depends on your particular needs for your protocol.
If you just want to send unsolicited server-to-client messages, and never responses to client-to-server commands, then the implementation is fairly straight forward. Use TIdContext.Connection.IOHandler when needed. You can loop through existing clients in the TIdTCPServer.Contexts list, such as inside the TIdTCPServer.OnConnect and TIdTCPServer.OnDisconnect events. On the client side, you need a timer or thread to check for server messages periodically. Look at TIdCmdTCPClient and TIdTelnet for examples of that.
But if you need to mix both client-to-server commands and unsolicited server-to-client messages on the same connection, you have to design your protocol to work asynchronously, which makes the implementation more complex. Unsolicited server messages can appear at anytime, even before the response to a client command. Commands need to include a value that is echoed in the response so clients can match up responses, and the packets need to be able to differentiate between a response and an unsolicited message. You also have to give each client its own outbound queue on the server side. You can use the TIdContext.Data property for that. You can then add server messages to the queue when needed, and have the OnExecute event send the queue periodically when it is not doing anything else. You still need a timer/thread on the client side, and it needs to handle both responses to client commands and unsolicited server messages, so you can't use TIdConnection.SendCmd() or related methods, as it won't know what it will end up reading.
I have posted examples of both approaches in the Embarcadero and Indy forums many times before.
Clients initiate communication. That is the definition of a client–the actor that initiates the communication. Once the connection is established though, both sides can send data. So, the clients connect to the server. The server maintains a list of all connected clients. When the server wants to send out communications it just sends the data to all connected clients.
Since clients initiate communication, it follows that, in the event of broken communication, it is the client's job to re-establish connection.
If you want to see working code examples where server sends data, check out Indy IdTelnet: the telnet client uses a thread to listen to server messages. There is only one socket, created by the client, but the server uses the same socket for its messages to the client, at any time.
The client starts the connection, but does not have to start a conversation by saying 'HELLO' or something like that.
Technically, the client only needs to open the socket connection, without sending any additional data. The client can remain quiet as long as he wants, even until the end of the connection.
The server has a socket connection to the client as soon as the client has connected. And over this socket, the server can send data to the client.
Of course, the client has to read from the connection socket to see the server data. This can be done in a loop in a background thread, or even in the main thread (not in a VCL application of course as it would block).
Finally, this is the code that I used to solve my problem:
// Thread at client-side
procedure FNotifRecieverThread.Execute;
var
str: string;
MID: Integer;
TCP1: TIdTCPClient;
begin
if frmRecieverMain.IdTCPClient1.Connected then
begin
TCP1 := TIdTCPClient.Create(nil);
TCP1.Host := frmRecieverMain.IdTCPClient1.Host;
TCP1.Port := frmRecieverMain.IdTCPClient1.Port;
TCP1.ConnectTimeout := 20000;
while True do
begin
try
TCP1.Connect;
while True do
begin
try
str := '';
TCP1.SendCmd('checkmynotif');
TCP1.Socket.WriteLn(IntToStr(frmRecieverMain.UserID));
str := TCP1.Socket.ReadLn;
if Pos('showmessage_', str) = 1 then
begin
MID := StrToInt(Copy(str, Pos('_', str) + 1, 5));
frmRecieverMain.NotifyMessage(MID);
end
else
if str = 'updateusers' then
begin
LoadUsers;
frmRecieverMain.sgMsgInbox.Invalidate;
frmRecieverMain.sgMsgSent.Invalidate;
frmRecieverMain.cbReceipent.Invalidate;
end
else
if str = 'updatemessages' then
begin
LoadMessages;
frmRecieverMain.DisplayMessages;
end;
except
// be quite and try next time :D
end;
Sleep(2000);
end;
finally
TCP1.Disconnect;
TCP1.Free;
end;
Sleep(5000);
end;
end;
end;
// And command handlers at server-side
procedure TfrmServer.cmhCheckMyNotifCommand(ASender: TIdCommand);
var
UserID, i: Integer;
str: string;
begin
str := 'notifnotfound';
UserID := StrToIntDef(ASender.Context.Connection.Socket.ReadLn, -1);
for i := 0 to NotificationStack.Count - 1 do
if NotificationStack.Notifs[i].Active and
(NotificationStack.Notifs[i].UserID = UserID)
then
begin
NotificationStack.Notifs[i].Active := False;
str := NotificationStack.Notifs[i].NotiffText;
Break;
end;
ASender.Context.Connection.Socket.WriteLn(str);
end;
// And when i want to some client notificated from server, I use some methodes like this:
procedure TfrmServer.cmhSetUserOnlineCommand(ASender: TIdCommand);
var
UserID, i: Integer;
begin
UserID := StrToIntDef(ASender.Context.Connection.Socket.ReadLn, -1);
if UserID <> -1 then
begin
for i := 0 to OnLineUsersCount - 1 do // search for duplication...
if OnLineUsers[i].Active and (OnLineUsers[i].UserID = UserID) then
Exit; // duplication rejected!
Inc(OnLineUsersCount);
SetLength(OnLineUsers, OnLineUsersCount);
OnLineUsers[OnLineUsersCount - 1].UserID := UserID;
OnLineUsers[OnLineUsersCount - 1].Context := ASender.Context;
OnLineUsers[OnLineUsersCount - 1].Active := True;
for i := 0 to OnLineUsersCount - 1 do // notify all other users for refresh users list
if OnLineUsers[i].Active and (OnLineUsers[i].UserID <> UserID) then
begin
Inc(NotificationStack.Count);
SetLength(NotificationStack.Notifs, NotificationStack.Count);
NotificationStack.Notifs[NotificationStack.Count - 1].UserID := OnLineUsers[i].UserID;
NotificationStack.Notifs[NotificationStack.Count - 1].NotiffText := 'updateusers';
NotificationStack.Notifs[NotificationStack.Count - 1].Active := True;
end;
end;
end;

Resources