CODEWITHSUNDEEP
web-servicesdelphicertificatedelphi-xe7
jRicardo
jRicardo

Reputation: 864

Delphi HTTPRIO: any way to disable certificate prompt?

I'm using HTTPRIO with WSDLImporter to communicate with a web service which requires a certificate. What I need to do is write a XML, sign it with a certificate and send it to the webservice using the same certificate to authenticate the webservice. I'm taking a certificate from windows store and signing my certificate, and I am able to send it correctly via HTTPRIO. But when I call the webservice, it shows me a window wih all certificates from windows store so I can choose which one I want to authenticate the webservice.

This would be fine, but I need it to be the same certificate. So, as I see it, I'd either have to sign the XML after choosing the certificate in this window (AFAIK not possible, as I have to send the XML already signed as a parameter to the WS method) or I'd have to disable this certificate prompt and set the certificate by hand in HTTPRIO, which would be fine if I knew how to do that. I already tried to set the certificate by hand in HTTPRIO's onBeforePost, hoping it would automatically disable the certificate prompt (using InternetSetOption) but it still showed the prompt, and I'm not sure this has indeed set the certificate.

Is there a way to disable this prompt? Should I solve this another way?

Upvotes: 1

Views: 4964

Answers (2)

jRicardo
jRicardo

Reputation: 864

So I finally found a way. Please note that I had to change Soap.SOAPHTTPTrans.pas and you should NOT change standard Delphi files. But I did and it solved my problem. First, I wrote a function to set the certificate:

class procedure TMyCertificate.setCertificate(request:HINTERNET);
  var
    i: integer;
    store: TStore;
    c:ICertificate2;
    cert: TCertificate;
    certs: TCertificates;
    ov: OleVariant;

    CertContext  : ICertContext;
    PCertContext : PCCERT_CONTEXT;
  begin
    store := TStore.Create(pai);
    store.Open(CAPICOM_CURRENT_USER_STORE, 'My', CAPICOM_STORE_OPEN_READ_ONLY);
    certs := TCertificates.Create(pai);
    certs.ConnectTo(store.Certificates as ICertificates2);
    cert := TCertificate.Create(pai);

    for i := 1 to certs.Count do
    begin
      ov := (certs.Item[i]);
      c := IDispatch(ov) as ICertificate2;
      cert.ConnectTo(IDispatch(ov) as ICertificate2);

      if cert.HasPrivateKey And (cert.ValidFromDate <= Now) And
        (cert.ValidToDate >= Now) then
      begin
       CertContext := c as ICertContext;
       CertContext.Get_CertContext( Integer( PCertContext ) );

        if InternetSetOption( request, INTERNET_OPTION_CLIENT_CERT_CONTEXT,
                      PCertContext, Sizeof( CERT_CONTEXT ) ) = False then
                 ShowMessage( 'Error setting certificate');
        Break;
      end;
    end;

    store.Close;

    certs.Free;
    store.Free;
  end;

The code is ugly, and just set the certificate to the first one found, but you get the idea. This uses CAPICOM to get the certificates.

Then, I found the following function in SOAPHTTPTrans:

  function CallInternetErrorDlg: DWord;
  var
    P: Pointer;
  begin
    Result := InternetErrorDlg(GetDesktopWindow(), Request, LastError,
                               FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
                               FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
                               FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);

    { After selecting client certificate send request again,
      Note: InternetErrorDlg always returns ERROR_SUCCESS when called with
            ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED }
    if LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then
      Result := ERROR_INTERNET_FORCE_RETRY;
  end;

And changed it to:

  function CallInternetErrorDlg: DWord;
  var
    P: Pointer;
  begin
    if LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then begin

      TMyCertificate.setCertificate(Request);

      Result := ERROR_INTERNET_FORCE_RETRY;
    end

    else
    Result := InternetErrorDlg(GetDesktopWindow(), Request, LastError,
                               FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
                               FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
                               FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);
  end;

Problem solved.

One interesting fact I found is that before POSTing, HTTPRIO sends a GET, and it asks for the certificate in this GET operation, so setting certificate in the onBeforePost is no use, as it gets executed after this GET.

Upvotes: 1

Andr&#233;
Andr&#233;

Reputation: 9112

I solved something similar (because I needed client side SSL certificates too) using the OnBeforePost event. 

procedure TDataModule1.HTTPRIO1HTTPWebNode1BeforePost(
  const HTTPReqResp: THTTPReqResp; aRequest: Pointer);
var lCertContext: PCCERT_CONTEXT;
begin

  ...
  if not InternetSetOption(Request, INTERNET_OPTION_CLIENT_CERT_CONTEXT, lCertContext, SizeOf(CERT_CONTEXT)) then RaiseLastOSError
  ...

However in my case I had to load the certificate dynamically from memory (from database) so we are using SecureBlackBox now (using USE_INDY and their TElClientIndySSLIOHandlerSocket iohandler and an TElX509Certificate object).

In your case, you need to get a CERT_CONTEXT record from the Windows certificate store somehow, but you already have that?

By the way: you need to pass your own HTTPRIO object to the generated SOAP function, otherwise a new THTTPRIO is created and your OnBeforePost event wont get fired:

function GetMySOAP(UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO = nil): IMySOAP;

Upvotes: 2

Related Questions