Search the Community

Hello, I have a problem and I don't know what I'm missing. I send a GET-Request to a server, in this case https://www.google.de, and i would like to verify the server certificate. This works if my client doesn't load an own certificate. After loading an own, I get the error message "unable to get local issuer certificate" in TsslHttpCli.onSslVerifyPeer. Does anyone have any idea what's going wrong here? Here's my source: unit Unit1; // Simple Test-Client, based on which sends a GET-Request to a Google-Server via https-Protocol. // Shall verify the certificate of the Google-Server. // Only works, if I don't load an own certificate for the client. // If I do, I will get the error message "unable to get local issuer certificate" in SslVerifyPeer. interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, System.TypInfo, System.DateUtils, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, OverbyteIcsTypes, OverbyteIcsSslBase, OverbyteIcsWndControl, OverbyteIcsHttpProt, OverbyteIcsLogger; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); private MyClient: TSslHttpCli; procedure LogMyClient(Sender: TObject; LogOption: TLogOption; const Msg: String); procedure SslVerifyPeer(Sender: TObject; var Ok: Integer; Cert: TX509Base); procedure SslHandshakeDone(Sender: TObject; ErrCode: Word; PeerCert: TX509Base; var Disconnect: Boolean); procedure Info(Text: string); procedure Error(Text: string); end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Info(Text: string); var dt: string; begin DateTimeToString(dt, 'd.m.yyyy hh:nn:ss.zzz', Now); Memo1.Lines.Add(dt + ' [INFO] ' + Text); end; procedure TForm1.Error(Text: string); var dt: string; begin DateTimeToString(dt, 'd.m.yyyy hh:nn:ss.zzz', Now); Memo1.Lines.Add(dt + ' [ERROR] *********' + Text + '*********'); end; procedure TForm1.FormDestroy(Sender: TObject); begin MyClient.RcvdStream.Free; MyClient.Free; end; procedure TForm1.FormCreate(Sender: TObject); var CertFileName: string; ChainResult: TChainResult; CertString, ErrStr: string; bLoadOwnCert: Boolean; begin ReportMemoryLeaksOnShutdown := (DebugHook <> 0); MyClient := TSslHttpCli.Create(nil); MyClient.RcvdStream := TMemoryStream.Create; MyClient.SslContext := TSslContext.Create(MyClient); MyClient.OnSslVerifyPeer := SslVerifyPeer; MyClient.OnSslHandshakeDone := SslHandshakeDone; MyClient.IcsLogger := TIcsLogger.Create(MyClient); MyClient.IcsLogger.OnIcsLogEvent := LogMyClient; // MyClient.IcsLogger.LogOptions := [loWsockErr, loWsockInfo, loProtSpecErr, loProtSpecInfo, loProgress, loSslErr, loSslInfo, {loSslDevel, loSslDump,} loDestEvent]; MyClient.IcsLogger.LogOptions := [loWsockErr, loProtSpecErr, loSslErr, loDestEvent]; MyClient.SslContext.UseSharedCAStore := TRUE; // Without that: No Server Cert Check MyClient.SslContext.SslVerifyPeer := TRUE; Info('CAStoreTotal: ' + MyClient.SslContext.GetCAStoreTotal.ToString); // 0 Info('RootCAStoreTotal: ' + IcsSslRootCAStore.Count.ToString); // 311 // Load own Certificate. bLoadOwnCert := TRUE; if bLoadOwnCert then begin CertFileName := 'maleben********_dyndns_org.pfx'; // also tried pem-bundle. MyClient.SslContext.SslCertX509.LoadFromFile(CertFileName, croTry, croTry, 'pass1234'); end; // Validate Certificate Chain ChainResult := MyClient.SslContext.SslCertX509.ValidateCertChain('', IcsSslRootCAStore, CertString, ErrStr); { really need host name, V9.1 new store } case ChainResult of chainOK: Info('chainOK, CertString: ' + CertString); // I get chainOK chainFail: Info('chainFail, Error: ' +ErrStr + ', CertString: ' + CertString); chainWarn: Info('chainWarn, Error: ' +ErrStr + ', CertString: ' + CertString); chainNone: Info('chainNone, Error: ' +ErrStr + ', CertString: ' + CertString); end; end; procedure TForm1.SslVerifyPeer(Sender: TObject; var Ok: Integer; Cert: TX509Base); begin Info('SslVerifyPeer, Received certificate: Subject: ' + Cert.SubjectOneLine + ', Issuer: ' + Cert.IssuerOneLine); if OK <> 1 then Error('SslVerifyPeer, Error msg: ' + Cert.VerifyErrMsg); end; procedure TForm1.SslHandshakeDone(Sender: TObject; ErrCode: Word; PeerCert: TX509Base; var Disconnect: Boolean); begin Info('SslHandshakeDone, PeerCert.VerifyResult= ' + PeerCert.VerifyErrMsg); Info('SslHandshakeDone, PeerCert.Sha256Hex=' + PeerCert.Sha256Hex); if ErrCode = 0 then Info('SslHandshakeDone, OK') else Error('SslHandshakeDone, SslHandshake failed, error #' + IntToStr(ErrCode)); end; procedure TForm1.LogMyClient(Sender: TObject; LogOption: TLogOption; const Msg : String); var lop: string; begin lop := GetEnumName(TypeInfo(TLogOption), Integer(LogOption)); Info('IcsLog: ' + lop + ' ' + Msg); end; procedure TForm1.Button1Click(Sender: TObject); var Len: Integer; Text: Ansistring; begin Info('********** Button1Click **********'); try MyClient.URL := 'https://www.google.de'; Info('Send Get-Request: ' + MyClient.URL); MyClient.Get; Info(MyClient.RcvdHeader.Text); Len := MyClient.RcvdStream.Position; if Len > 0 then begin SetLength(Text, Len); MyClient.RcvdStream.Position := 0; MyClient.RcvdStream.ReadData(@Text[1], Len); Info(string(Text)); end; except on E: Exception do Error(E.Message); end; end; end.