Delphi 10 seattle
OpenSSL 1.0.0.10 but same result with more recent libraries.
the following code has been working for about two years, but lately we are getting an error:
14094410:SSL3_read_bytes:sslv3 alert handshake failure
Have used wireshark to confirm TLSv1.2 is being used. can provide capture file if needed.
function GetAddress(ID_ID : Integer; Rijksregister : String) : Boolean;
var
gp : GetPerson;
Cor : CorrelationType;
P : RrSimplePersonService_v02PortType;
Resp : GetPersonResponse;
FHTTPRio: THTTPRio;
FReqResp : TWisaHTTPReqResp;
FSSLIOHandler: TIdSSLIOHandlerSocketOpenSSL;
Adr : PersonLegalAddressType;
CERTPath : String;
i, j : integer;
begin
CERTPath := IncludeTrailingPathDelimiter(ExtractFilePath(Paramstr(0)));
Result := false;
// declarations
Cor := CorrelationType.Create;
Cor.requestorId := '01234567890';
Cor.requestorName := 'WisaMockupService';
Cor.applicationId := 'WISA';
Cor.correlationId := getGUID;
gp := getPerson.Create;
gp.identifier := Rijksregister;
gp.correlation := Cor;
// actual call
CoInitialize(nil);
fHTTPRio:=THTTPRio.Create(Self);
fHTTPRio.URL:=fURL;
fHTTPRio.Converter.Options := fHTTPRio.Converter.Options + [soSendMultiRefObj, soTryAllSchema, soRootRefNodesToBody, soCacheMimeResponse, soUTF8EncodeXML, soSOAP12];
fHTTPRio.OnBeforeExecute := IH7BeforeExecute;
fHTTPRio.OnAfterExecute := IH7AfterExecute;
FReqResp := TWisaHTTPReqResp.Create(self);
FReqResp.URL := fURL;
FReqResp.InvokeOptions := FReqResp.InvokeOptions + [soNoSOAPActionHeader];
FReqResp.ConnectTimeout := 60000;
FReqResp.ReceiveTimeout := 60000;
FReqResp.SendTimeout := 60000;
FReqResp.WebNodeOptions:= FReqResp.WebNodeOptions+[wnoSOAP12];
fHTTPRio.HTTPwebNode := FReqResp;
fHTTPRio.HTTPwebNode.UserName := fUser;
fHTTPRio.HTTPwebNode.Password := fPaswoord;
fHTTPRio.HTTPwebNode.OnBeforePost := BeforePost;
FSSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(self);
FSSLIOHandler.SSLOptions.Method := sslvTLSv1_2;
FSSLIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2,sslvTLSv1_1,sslvTLSv1];
FSSLIOHandler.SSLOptions.CipherList := 'ALL';
FSSLIOHandler.SSLOptions.RootCertFile := CERTPath + 'CACert.crt';
FSSLIOHandler.SSLOptions.KeyFile := CERTPath + 'privateKey.key';
FSSLIOHandler.SSLOptions.CertFile := CERTPath + 'certificate.crt';
FSSLIOHandler.SSLOptions.Mode := sslmUnassigned;
FSSLIOHandler.SSLOptions.VerifyMode := [];
FSSLIOHandler.SSLOptions.VerifyDepth := 3;
FSSLIOHandler.OnGetPassword := getPassword;
FSSLIOHandler.UseNagle := true;
FSSLIOHandler.ReadTimeout := 60000;
FSSLIOHandler.ConnectTimeout := 60000;
FSSLIOHandler.OnStatusInfoEx := SSLStatusInfoEx;
FSSLIOHandler.OnVerifyPeer := VerifyPeer;
FReqResp.IOHandler := FSSLIOHandler;
// actual call
P := (fHTTPRio as RrSimplePersonService_v02PortType);
Try
Resp := P.GetPerson(gp);
Except
on e : exception do
begin
Showerror(ID_ID, e.message + ' ' + format(rsRijksregister2,
[Rijksregister]), '', '');
exit;
end;
End;
if not Assigned(Resp) then
exit;
# do something with Response
# end
Result := true;
end;
procedure IH7BeforeExecute(const MethodName: string;
SOAPRequest: TStream);
var
S : TStringStream;
MyStringList: TStringList;
CreateTime, ExpiryTime : TDateTime;
begin
MyStringList := TStringList.Create;
try
Inherited;
CreateTime := Now;
ExpiryTime := IncSecond(CreateTime,600);
SOAPRequest.Position := 0;
MyStringList.LoadFromStream(SOAPRequest);
MyStringList.Text := StringReplace(MyStringList.Text, '<soap-env:body>', Format(SoapHeader,[getTSToken, TimeToString(CreateTime), TimeToString(ExpiryTime), getToken, fGebruiker, fPaswoord]) + '<SOAP-ENV:Body>', [RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, '</GetPerson>', '</ws:GetPerson>', [RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP-ENV:', 'SOAP:', [RfReplaceAll, RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP-ENV=', 'SOAP=', [RfReplaceAll, RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, '<SOAP:Envelope xmlns:SOAP="http://www.w3.org/2003/05/soap-envelope" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">', '<soap:Envelope xmlns:soap="http://www.w3.org/2003/05/soap-envelope" xmlns:ws="http://person.ws.egov.apogado.com/SimplePersonSchema/v1_2/ws">', [RfReplaceAll, RfIgnoreCase]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP:Body', 'soap:Body', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '<GetPerson xmlns="http://person.ws.egov.apogado.com/SimplePersonSchema/v1_2/ws">', '<ws:GetPerson>', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '<transaction xmlns="" xsi:nil="true"/>', '', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '</SOAP:Envelope>', '</soap:Envelope>', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '<identifier xmlns="urn:oslo:names:specification:schema:xsd:CommonBasicComponents-1"><Identifier xmlns="http://www.w3.org/ns/corevocabulary/BasicComponents">', '<identifier>', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, '</Identifier>', '', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP:Header', 'soap:Header', [RfReplaceAll]);
MyStringList.Text := StringReplace(MyStringList.Text, 'SOAP:mustUnderstand="true"', 'soap:mustUnderstand="true"', [RfReplaceAll]);
SOAPRequest.Position := 0;
SOAPRequest.Size:=0;
MyStringList.SaveToStream(SOAPRequest);
finally
MyStringList.Free;
end;
S:=TStringStream.Create('');
try
S.CopyFrom(SOAPRequest,0);
SOAPRequest.Position:=0;
// eventueel loggen van request
//Log('HTTPRIO Verstuurd bericht:'+sLineBreak+S.DataString);
finally
S.Free;
end;
end;
procedure IH7AfterExecute(const MethodName: string;
SOAPResponse: TStream);
Var
S : TStringStream;
begin
S:=TStringStream.Create('');
try
S.CopyFrom(SOAPResponse,0);
SOAPResponse.Position:=0;
finally
S.Free;
end;
end;
Procedure GetPassword(var Password: string);
begin
Password := ansistring('********');
end;
procedure SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL;
const AWhere, Aret: Integer; const AType, AMsg: string);
begin
SSL_set_tlsext_host_name(AsslSocket, fURL);
end;
procedure BeforePost(const HTTPReqResp: THTTPReqResp; Data: Pointer);
begin
// nothing atm
end;
From the pcap it can be seen that an initial successful TLS handshake is done and also application data are transferred from the client to the server and then a new handshake is initiated by the server followed with an alert send by the server. The successful initial handshake means that neither TLS protocol version, nor cipher, nor server certificate are the problem.
While it is impossible to look at the details of the application data, the second handshake and the alert since they are encrypted the sequence of records suggests that:
After the successful initial TLS handshake a HTTP request (i.e. application data) is done for a resource which requires authentication with a client certificate.
The server therefore triggers a renegotiation. In the second TLS handshake the server will request this certificate.
The server does not like the certificate send by the client or the client does not send a certificate. The server therefore aborts the connection with an alert message.
Given that it worked before but fails now I suggest that one of these is the cause of the problem:
The existing certificate might be expired or revoked.
Changes to the server result in the server no longer accepting the certificate, for example because the CA is no longer trusted.
The certificate was replaced on the client side. But the new certificate is not what the server expects to get or is wrongly setup (like missing a chain certificate).
I am developing an email sending function in my iOS and Android apps.
It is a function to send an email via Gmail using OpenSSL.
I am using Delphi 10.2.3 Tokyo, with Indy 10.
I submitted my iOS app to iTunes Connect, but they rejected my app because this function does not work in IPv6.
They said
We discovered one or more bugs in your app when reviewed on iPad and iPhone running iOS 11.4.1 on Wi-Fi connected to an IPv6 network.
They also send me a screenshot of the error saying
An error occurred when resolving address smtp.gmail.com: (8)
How can I fix this error to work with IPv6 properly? My code is below:
Procedure MailSend;
Var
Connected: Boolean;
Begin
IdSMTP := TIdSMTP.Create(nil);
try
IdSMTP.Host := 'smtp.gmail.com';
IdSMTP.Port := 587;
IdSMTP.Username := 'xxxx#gmail.com'; // UserName
IdSMTP.Password := 'xxxx'; // Password
SSL := TIdSSLIOHandlerSocketOpenSSL.Create;
try
SSL.Host := IdSMTP.Host;
SSL.Port := IdSMTP.Port;
SSL.Destination := SSL.Host + ':' + IntToStr(SSL.Port);
IdSMTP.IOHandler := SSL;
IdSMTP.UseTLS := utUseExplicitTLS;
IdSMTP.Socket.IPVersion := Id_IPv6;
try
IdSMTP.Connect;
Connected := True;
except
Connected := False;
end;
If Connected = False then
Begin
IdSMTP.Socket.IPVersion := Id_IPv4;
IdSMTP.Connect;
End;
Msg := TIdMessage.Create(IdSMTP);
try
Msg.OnInitializeISO := IdMessage_InitializeISO;
Msg.ContentType := 'text/plain';
Msg.CharSet := 'UTF-8';
Msg.ContentTransferEncoding := 'BASE64'; // BASE64 (7bit)
//Msg.ContentTransferEncoding := '8bit'; // RAW(8bit)
Msg.From.Name := SsNoSt;
Msg.From.Address := 'xxxx#gmail.com';
Msg.Recipients.EMailAddresses := 'xxxx#gmail.com';
Msg.Subject := SsNoSt;
Msg.Body.Text := 'Unicode String (body)';
IdSMTP.Send(Msg);
finally
Msg.Free;
end;
IdSMTP.Disconnect;
finally
SSL.Free;
end;
finally
IdSMTP.Free;
End;
End;
I see a few problems with your SMTP code:
you need to set the IdSMTP.IPVersion property instead of the IdSMTP.Socket.IPVersion property. The default value of the IPVersion property is Id_IPv4 (bug - it is not respecting the ID_DEFAULT_IP_VERSION constant in the IdGlobal unit). Connect() overwrites the Socket.IPVersion property value with the IPVersion property value, so you are actually attempting to connect using Id_IPv4 twice, which will fail on an IPv6-only network (which Apple requires apps to support).
you are not catching any errors from the 2nd Connect(). That is likely the error that Apple is ultimately seeing.
you should not be setting the SSL.Host, SSL.Port, and SSL.Destination properties manually. Let Connect() handle that for you.
Try this instead:
// this accessor class is needed because TIdSMTP derives from TIdTCPClientCustom
// instead of TIdTCPClient. The IPVersion property is protected in
// TIdTCPClientCustom and not published by TIdSMTP or its ancestors.
//
// See https://github.com/IndySockets/Indy/issues/184 ...
//
type
TIdSMTPAccess = class(TIdSMTP)
end;
procedure MailSend;
var
IdSMTP: TIdSMTP;
Msg: TIdMessage;
begin
IdSMTP := TIdSMTP.Create(nil);
try
SSL := TIdSSLIOHandlerSocketOpenSSL.Create(IdSMTP);
IdSMTP.IOHandler := SSL;
IdSMTP.Host := 'smtp.gmail.com';
IdSMTP.Port := 587;
IdSMTP.Username := 'xxxx#gmail.com';
IdSMTP.Password := 'xxxx';
IdSMTP.UseTLS := utUseExplicitTLS;
TIdSMTPAccess(IdSMTP).IPVersion := Id_IPv6;
try
IdSMTP.Connect;
except
TIdSMTPAccess(IdSMTP).IPVersion := Id_IPv4;
try
IdSMTP.Connect;
except
// unable to connect!
Exit;
end;
end;
try
Msg := TIdMessage.Create(nil);
try
Msg.OnInitializeISO := IdMessage_InitializeISO;
Msg.ContentType := 'text/plain';
Msg.CharSet := 'UTF-8';
Msg.ContentTransferEncoding := 'BASE64'; // BASE64 (7bit)
//Msg.ContentTransferEncoding := '8bit'; // RAW(8bit)
Msg.From.Name := SsNoSt;
Msg.From.Address := 'xxxx#gmail.com';
Msg.Recipients.EMailAddresses := 'xxxx#gmail.com';
Msg.Subject := SsNoSt;
Msg.Body.Text := 'Unicode String (body)';
IdSMTP.Send(Msg);
finally
Msg.Free;
end;
finally
IdSMTP.Disconnect;
end;
finally
IdSMTP.Free;
end;
end;
Alternatively:
type
TIdSMTPAccess = class(TIdSMTP)
end;
procedure MailSend;
var
IdSMTP: TIdSMTP;
Msg: TIdMessage;
Connected: Boolean;
begin
IdSMTP := TIdSMTP.Create(nil);
try
SSL := TIdSSLIOHandlerSocketOpenSSL.Create(IdSMTP);
IdSMTP.IOHandler := SSL;
IdSMTP.Host := 'smtp.gmail.com';
IdSMTP.Port := 587;
IdSMTP.Username := 'xxxx#gmail.com';
IdSMTP.Password := 'xxxx';
IdSMTP.UseTLS := utUseExplicitTLS;
Connected := False;
if GStack.SupportsIPv6 then
begin
TIdSMTPAccess(IdSMTP).IPVersion := Id_IPv6;
try
IdSMTP.Connect;
Connected := True;
except
end;
end;
if (not Connected) and GStack.SupportsIPv4 then
begin
TIdSMTPAccess(IdSMTP).IPVersion := Id_IPv4;
try
IdSMTP.Connect;
Connected := True;
except
end;
end;
if not Connected then
begin
// unable to connect!
Exit;
end;
try
Msg := TIdMessage.Create(nil);
try
Msg.OnInitializeISO := IdMessage_InitializeISO;
Msg.ContentType := 'text/plain';
Msg.CharSet := 'UTF-8';
Msg.ContentTransferEncoding := 'BASE64'; // BASE64 (7bit)
//Msg.ContentTransferEncoding := '8bit'; // RAW(8bit)
Msg.From.Name := SsNoSt;
Msg.From.Address := 'xxxx#gmail.com';
Msg.Recipients.EMailAddresses := 'xxxx#gmail.com';
Msg.Subject := SsNoSt;
Msg.Body.Text := 'Unicode String (body)';
IdSMTP.Send(Msg);
finally
Msg.Free;
end;
finally
IdSMTP.Disconnect;
end;
finally
IdSMTP.Free;
end;
end;
I have to send an XML-File to a Website with a secure Connection. Delphi 2010, Indy 10.5.9. The Code used is as follows:
Params: TIdMultiPartFormDataStream;
ResponseStr: string;
begin
result := 0;
sRootCertFile := 'xxx\Digital.pem';
sCertFile := 'xxx\Digital.pem';
sKeyFile := 'xxx\Digital.pem';
with FAdminSetup.RDWSSLHandler do
begin
SSLOptions.VerifyMode := [];
SSLOptions.VerifyDepth := 0;
SSLOptions.RootCertFile := sRootCertFile;
SSLOptions.CertFile := sCertFile;
SSLOptions.KeyFile := sKeyFile;
end;
sURL := 'https://xxx/xxxservice';
begin
IdHttpVVO := TIdHttp.Create(nil);
try
// IdHttpVVO.Request.ContentType := 'multipart/form-data';
// IdHttpVVO.ProtocolVersion := pv1_1;
// IdHttpVVO.HTTPOptions := [hoKeepOrigProtocol,hoForceEncodeParams];
// IdHttpVVO.Request.Connection := 'Keep-Alive';
// IdHttpVVO.Request.CacheControl := 'no-cache';
// IdHttpVVO.Request.ContentLength := Length(sAnsiXML); // <-- new
IdHttpVVO.IOHandler := FAdminSetup.RDWSSLHandler;
Params := TIdMultiPartFormDataStream.Create;
try
with Params do
begin
AddFile('file', filename, GetMIMETypeFromFile(filename));
end;
resultStr := IdHttpVVO.Post(sURL, Params);
finally
Params.Free;
end;
ShowMessage(resultstr);
The result is always the same:
'HTTP/1.0 500 Error'
when doing the post part.
All the remarks have been tried and did not give any change. The Password for the connection is supplied as follows:
procedure TFAdminSetup.RDWSSLHandlerGetPasswordEx(ASender: TObject;
var VPassword: AnsiString; const AIsWrite: Boolean);
begin
VPassword := 'xxx';
end;
The Website is working, the certificates seem to be ok, as there is a small tool included written in C that works.
Where is my mistake? Thanks
I need to call to an ASP web api and return JSON from delphi 2007. I'm able to do it in RAD Studio XE 5 with TRestClient. I was trying to put it in a dll so that I can call it from my delphi 2007 program. But no success. How can I do this using delphi 2007?
EDIT
Here's what I'm trying to do in delphi xe 5
class function TSampleApp.Hello(AModel: TModel): Integer;
var
aRestClient: TRESTClient;
aRestRequest: TRESTRequest;
aRestResponse: TRESTResponse;
aParam: TRESTRequestParameter;
jValue: TJSONValue;
jObject: TJSONObject;
begin
Result := -1;
aRestClient := TRESTClient.Create(nil);
try
aRestResponse := TRESTResponse.Create(nil);
try
aRestRequest := TRESTRequest.Create(nil);
try
try
aRestClient.BaseURL := 'http://localhost:49272/api/test';
aRestRequest.Client := aRestClient;
aRestRequest.Response := aRestResponse;
aRestRequest.Method := rmPOST;
aRestRequest.Resource := 'hello';
aParam := aRestRequest.Params.AddItem;
aParam.Kind := pkREQUESTBODY;
aParam.name := 'helloData';
aParam.Value := TJson.ObjectToJsonString(AModel);
aRestRequest.Execute;
jValue := aRestResponse.JSONValue;
jObject := TJSONObject.ParseJSONValue(jValue.ToString) as TJSONObject;
Result := StrToIntDef((jObject.Get('status').JsonValue as TJSONString).Value, -1);
finally
FreeAndNil(jObject);
FreeAndNil(jValue);
end;
finally
FreeAndNil(aRestRequest);
end;
finally
FreeAndNil(aRestResponse);
end;
finally
FreeAndNil(aRestClient);
end;
end;
This code runs perfectly in win32 app, but fail on "aRestResponse := TRESTResponse.Create(nil);" when put into a dll.
I did not find rest client solution for delphi 2007. I end up using indy for this.
I use LkJson to handle json.
class function TSampleApp.Hello(AModel: TModel): Integer;
var
idHttp: TIdHTTP;
url, sjsonresponse, sjsonrequest: string;
strRequest: TStrings;
jsonObj: TlkJSONobject;
begin
Result := -1;
url := 'http://localhost:49272/api/test/hello';
idHttp := TIdHTTP.Create;
try
jsonObj := TlkJSONobject.Create;
try
//populate
jsonObj.Add('param1', AModel.param1);
jsonObj.Add('param2', AModel.param2);
sjsonrequest := TlkJSON.GenerateText(jsonObj);
finally
FreeAndNil(jsonObj);
end;
idHttp.Request.Accept := 'application/json';
strRequest := TStringList.Create;
try
strRequest.Values['helloData'] := sjsonrequest;
sjsonresponse := idHttp.Post(url, strRequest);
finally
FreeAndNil(strRequest);
end;
jsonObj := TlkJSON.ParseText(sjsonresponse) as TlkJSONobject;
try
Result := StrToIntDef(VarToStr((jsonObj.Field['status'] as TlkJSONnumber).Value), -1);
finally
FreeAndNil(jsonObj);
end;
finally
idHttp.Free;
end;
end;
This code works also inside a dll.
I am using indys idhttp to submit an URL (post)
Procedure submit_post(url_string,EncodedStr:string;amemo:TMemo);
var
aStream: TMemoryStream;
Params: TStringStream;
begin
aStream := TMemoryStream.create;
Params := TStringStream.create('');
try
with Fmain.IdHTTP1 do
begin
Params.WriteString(EncodedStr);
Request.ContentType := 'application/x-www-form-urlencoded';
Request.Charset := 'utf-8';
try
Response.KeepAlive := False;
Post(url_string, params, aStream);
except
on E: Exception do
begin
Screen.Cursor := crDefault;
exit;
end;
end;
end;
aStream.WriteBuffer(#0' ', 1);
aStream.Position := 0;
amemo.Lines.LoadFromStream(aStream);
Screen.Cursor := crDefault;
finally
aStream.Free;
Params.Free;
end;
end;
It works like a charm for me. I am trying to submit a URL (post) with a parameter containing 300 chars, but will be splittet automatically by adding an "&" every 90 chars. So the server only receives 90 chars instead of 300.
How can I submit an URL with a 300 character parameter without this automatic separation ?
function SubmitPost(Params:String): string;
const
URL= 'http://xxxx.com/register.php?';
var
lHTTP: TIdHTTP;
Source,
ResponseContent: TStringStream;
I:Integer;
begin
lHTTP := TIdHTTP.Create(nil);
lHTTP.Request.ContentType := 'text/xml';
lHTTP.Request.Accept := '*/*';
lHTTP.Request.Connection := 'Keep-Alive';
lHTTP.Request.Method := 'POST';
lHTTP.Request.UserAgent := 'OS Test User Agent';
Source := TStringStream.Create(nil);
ResponseContent:= TStringStream.Create;
try
try
lHTTP.Post(URL+Params, Source, ResponseContent);
Result := ResponseContent.DataString;
except
//your exception here
end;
finally
lHTTP.Free;
Source.Free;
ResponseContent.Free;
end;
end;
Usage
mmo1.Text := SubmitPost('Username=xxxx&Password=xxxx');
I found the mistake. My Post function works perfectly, but the URL is built by params coming from a memo line. With "WantReturns = FALSE", I can build a URL with the maximum line length of the memo. I guess 1024 characters per line which is okay for me.