Leer certificado pfx para webservice

[isnagil]

De momento está todo bien menos que el compilador no me reconoce SZ_CERT_STORE_PROV_MEMORY

Voy a investigar

[isnagil]

He sustituido SZ_CERT_STORE_PROV_MEMORY por 'Memory' y ya puedo compilarlo.

El problema es que me da una excepción cuando ejecuta la función

FStore := CertOpenStore('Memory', 0, 0, 0, nil);

No creo que poner 'Memory' sea lo correcto pero no tengo más información

Se puede ver en la imagen

[isnagil]

He sustituido SZ_CERT_STORE_PROV_MEMORY por 'Memory' y ya puedo compilarlo.

El problema es que me da una excepción cuando ejecuta la función

FStore := CertOpenStore('Memory', 0, 0, 0, nil);

No creo que poner 'Memory' sea lo correcto pero no tengo más información

[isnagil]

He sustituido SZ_CERT_STORE_PROV_MEMORY por 'Memory' y ya puedo compilarlo.

El problema es que me da una excepción antes de cargar los certificados. No los llega a cargar.

Es en el FWebNode.Execute(Req, Resp);

Se puede ver en la imagen

[Garada]

Sí, la declaración es

Código Delphi [-]
sz_CERT_STORE_PROV_MEMORY           = 'Memory';

Y es un PAnsiChar.

En la última modificación eliminé el control de errores por simplificar el código pero puedes añadir de nuevo la función CheckError y comprobar los punteros devueltos por las funciones del CryptoAPI

De todas formas yo probé con la constante de cadena como tú y no me falla.

¿Cómo está declarada y dónde en tu código la función CertOpenStore?

[isnagil]

La función CertOpenStore está declarada así:

Código Delphi [-]
function CertOpenStore(lpszStoreProvider: LPCSTR; dwEncodingType: DWORD;
  hCryptProv: HCRYPTPROV; dwFlags: DWORD; pvPara: Pointer): HCERTSTORE; stdcall; external Crypt32 name 'CertOpenStoreW' delayed;
{$EXTERNALSYM CertOpenStore}

En la unidad System.Net.HttpClient.Win

Al final modificado GetCertStore queda así:

Código Delphi [-]
class function TWinHttpLib.GetCertStore: HCERTSTORE;
procedure AddPFX(path, pass: string);
  const
    CERT_STORE_ADD_USE_EXISTING = 2;
    //Pass = 'LaContraseña';
  var
    pTmpStore: HCERTSTORE;
    pCert: PCERT_CONTEXT;
    DataBlob: CRYPT_BIT_BLOB;
    PFX: TBytes;
  begin
    PFX := TFile.ReadAllBytes(path);

    DataBlob.cbData := Length(PFX);
    DataBlob.pbData := @PFX[0];

    // se lee el pfx en un almacen en memoria
    pTmpStore := PFXImportCertStore(DataBlob, PWideChar(Pass), 0);

    // se copian los certificados al almacen que usa el HttpClient
    pCert := CertEnumCertificatesInStore(pTmpStore, nil);
    while pCert <> nil do
    begin
      if not CertAddCertificateContextToStore(FStore, pCert, CERT_STORE_ADD_USE_EXISTING, nil) then
        RaiseLastOSError;

      pCert := CertEnumCertificatesInStore(pTmpStore, pCert);
    end;

    CertCloseStore(pTmpStore, 0);
  end;

begin
  FLock.Enter;
  try
    if FStore = nil then
    begin
      // almacen temporal en memoria para el HttpClient
      // FStore := CertOpenStore(SZ_CERT_STORE_PROV_MEMORY, 0, 0, 0, nil);
      FStore := CertOpenStore('Memory', 0, 0, 0, nil);

      AddPFX('XXXXXX.pfx', 'XXXXXXX');
      AddPFX('XXXXXX.pfx', 'XXXXX');
    end;

    Result := FStore;
  finally
    FLock.Leave;
  end;
end;

He cambiado DataBlob: CRYPT_DATA_BLOB; por DataBlob: CRYPT_BIT_BLOB; como la otra vez

Y el error lo da en la instrucción FStore := CertOpenStore('Memory', 0, 0, 0, nil);

[Garada]

En Delphi 11 está declarada así:

Código Delphi [-]
function CertOpenStore(lpszStoreProvider: LPCSTR; dwEncodingType: DWORD;
  hCryptProv: HCRYPTPROV; dwFlags: DWORD; pvPara: Pointer): HCERTSTORE; stdcall; external Crypt32 name 'CertOpenStore' delayed;
{$EXTERNALSYM CertOpenStore}

La diferencia está después de name
Cosa rara pq esa función no tiene versión ANSI y WideString com otras que yo haya visto.

Cambia la declaración y ponla como la del Delphi 11.

¿Por cierto cuál es el error?

[isnagil]

A mi también me resultaba extraña la W y he pensado en quitarla, pero no me he atrevido.

Por lo que he probado creo que funciona perfectamente.

No me lo acabo de creer, después de tanta guerra.

Muchas gracias

[Garada]

No hay que darlas y me alegro que haya salido todo OK al fin.

Ya tengo medio trabajo hecho para cuando tenga que actualizar el Delphi. 👍

Lo grave es que a estas alturas no hayan preparado una forma fácil de pasar un certificado a un HTTPRIO... por lo menos te deja elegir del sistema.

[isnagil]

Haciendo pruebas masivas he detectado problemas, hasta la fecha no se había necesitado cambiar de certificado.

El procedimiento que cambiamos en la unidad System.Net.HttpClient.Win, carga un certificado seguro, pero no sé si carga el segundo

Código Delphi [-]
class function TWinHttpLib.GetCertStore: HCERTSTORE; 
  procedure  AddPFX(path, pass: string); 
  const 
    CERT_STORE_ADD_USE_EXISTING = 2; 
    //Pass = 'LaContraseña'; 
  var 
  pTmpStore: HCERTSTORE; 
  pCert: PCERT_CONTEXT; 
  DataBlob: CRYPT_BIT_BLOB; 
  PFX: TBytes; 
  begin 
    //showmessage ('Cargando certificado ' + path); 
    PFX :=  TFile.ReadAllBytes(path); 
    DataBlob.cbData := Length(PFX); 
    DataBlob.pbData := @PFX[0]; 
    // se lee el pfx en un almacen en  memoria 
    pTmpStore := PFXImportCertStore(DataBlob, PWideChar(Pass),  0); 
    // se copian los certificados al almacen que usa el HttpClient 
    pCert := CertEnumCertificatesInStore(pTmpStore, nil); 
    
    while  pCert <> nil do 
    begin 
       if not  CertAddCertificateContextToStore(FStore, pCert,  CERT_STORE_ADD_USE_EXISTING, nil) then 
         RaiseLastOSError; 
       pCert := CertEnumCertificatesInStore(pTmpStore, pCert); 
    end; 


    CertCloseStore(pTmpStore, 0); 
  end; 
begin 
  try 
    FLock.Enter;  

      try 
        if FStore = nil then 
        begin 
           // almacen temporal  en memoria para el HttpClient 
           FStore := CertOpenStore('Memory',  0, 0, 0, nil); 
           AddPFX('XXXXXXX.pfx', 'XXXXXX'); 
           AddPFX('YYYYYYY.pfx', 'YYYYYY'); 
        end; 
    Result := FStore; 
  finally 
     FLock.Leave; 
  end;

Yo cambio los certificados cargados en el evento:

Código Delphi [-]
procedure TMi_HTTPRIO.httWebNodeNeedClientCertificate(const Sender:  TObject; const ARequest: TURLRequest;  const ACertificateList:  TCertificateList; var AnIndex: Integer); 
begin 
  AnIndex :=  certificado; 
end;

Certificado es una propiedad del componente HTTPRio al que le asigno un valor cuando quiero cambiar de certificado en cada envío. Pero por este evento solo pasa una vez. Con lo cual siempre envía con el primer certificado que se carga. Por ahí he leído que cada vez que se cambia de certificado hay que cerrar la conexión pero no sé dónde se hace esto.

O a lo mejor hay que seleccionar el certificado en otro evento.

Por otra parte no tengo manera exacta de saber que certificado estoy usando en cada momento. Si en el evento

Código Delphi [-]
HTTPRIO.httBeforeExecute(const MethodName: string; SOAPRequest: TStream);

Simplemente pongo un showmessage del nombre del certificado:

Código Delphi [-]
Showmessage (Self.HTTPWebNode.ClientCertificate.CertName);

Me sale un mensaje en blanco.


En fin, no sé como resolver estos dos problemas.