Leer certificado pfx para webservice

[isnagil]

Al final voy a crear dos componentes httprio, uno para cada certificado.



Al inicio le asigno a cada uno un certificado y realizo el envío del XML con cada componente según el certificado correspondiente.



Supongo que así funcionará.

[Garada]

Lo de liberar el componente es no añadirlo al form o datasource y crearlo y borrarlo en codigo:

Código Delphi [-]
procedure PeticionWebService;
var
  R: THTTPRIO;
  S: TipoServicio;
  RP: TipoRespuesta;
begin
  R := THTTPRIO.Create(nil);
  try
    // Asignar propiedades, eventos, .. a R

    S := GetTipoServicio(False, '', R);
    RP := S.Peticion();

    // Tratar RP
  finally
    R.Free;
  end;
end;

Lo del orden es raro, debería estar en el orden que los añades. 🤷

Para evitar eso recorre ACertificateList y averigua el índice del que te interesa para devolverlo. Yo usaría SerialNum, CertName o Subject.

[Garada]

Revisando como reiniciar encontré otra forma de pasar el certificado y siempre vuelve a leer el certificado en cada envío.

Lo he mirado en D11, así que la pregunta es.. en tu unidad System.Net.HttpClient.Win existe esta línea:

Código Delphi [-]
procedure TWinHTTPRequest.SetWinCertificate;

Y esta en la unidad Soap.SOAPHTTPTrans:

Código Delphi [-]
  TClientCertExt = class(TClientCert)
  private
    FStream: TStream;
    FFileName: TFileName;
    FPassword: string;
  public
    procedure Assign(ASource: TPersistent); override;
    property Stream: TStream read FStream write FStream;
  published
    property FileName: TFileName read FFileName write FFileName;
    property Password: string read FPassword write FPassword;
  end;

Si es así pon el código de procedure TWinHTTPRequest.SetWinCertificate para ver si tiene diferencias de D10.4 a D11 y podrías usar un stream para pasar el certificado antes de hacer las llamadas.

[isnagil]

Empezado por Garada

Lo de liberar el componente es no añadirlo al form o datasource y crearlo y borrarlo en codigo:

Código Delphi [-]
procedure PeticionWebService;
var
  R: THTTPRIO;
  S: TipoServicio;
  RP: TipoRespuesta;
begin
  R := THTTPRIO.Create(nil);
  try
    // Asignar propiedades, eventos, .. a R

    S := GetTipoServicio(False, '', R);
    RP := S.Peticion();

    // Tratar RP
  finally
    R.Free;
  end;
end;

Lo del orden es raro, debería estar en el orden que los añades. 🤷

Para evitar eso recorre ACertificateList y averigua el índice del que te interesa para devolverlo. Yo usaría SerialNum, CertName o Subject.

Sí, yo también creo el componente tal y como dices pero al liberarlo me da el típico error:

Invalid Pointer

Lo del orden, no hay problema ya lo solucioné consultando el serialNum

[isnagil]

Empezado por Garada

Revisando como reiniciar encontré otra forma de pasar el certificado y siempre vuelve a leer el certificado en cada envío.

Lo he mirado en D11, así que la pregunta es.. en tu unidad System.Net.HttpClient.Win existe esta línea:

Código Delphi [-]
procedure TWinHTTPRequest.SetWinCertificate;

Y esta en la unidad Soap.SOAPHTTPTrans:

Código Delphi [-]
  TClientCertExt = class(TClientCert)
  private
    FStream: TStream;
    FFileName: TFileName;
    FPassword: string;
  public
    procedure Assign(ASource: TPersistent); override;
    property Stream: TStream read FStream write FStream;
  published
    property FileName: TFileName read FFileName write FFileName;
    property Password: string read FPassword write FPassword;
  end;

Si es así pon el código de procedure TWinHTTPRequest.SetWinCertificate para ver si tiene diferencias de D10.4 a D11 y podrías usar un stream para pasar el certificado antes de hacer las llamadas.

No, en la unidad System.Net.HttpClient.Win no existe SetWinCertificate.

[Garada]

Empezado por isnagil

No, en la unidad System.Net.HttpClient.Win no existe SetWinCertificate.

Vaya, que pena. En D11 han metido código para leer de un fichero o un stream el certificado. Aunque aún así le tuve que hacer algún retoque pq no iba del todo ok.

El error que te da al liberar puede ser algo que se liberó antes de tiempo.

La opción de borrar el certificado para que lo pida de nuevo... es que no tengo de idea de como hacer que la sesión del WinHTTP borre el certificado. Si se averigua la llamada al API para hacerlo se podría añadir al código para borrar la caché SSL.

Y para terminar... ¿en tu System.Net.HttpClient.Win existe procedure TWinHTTPRequest.DoPrepare; ?
O como mínimo tu THTTPRequest tiene procedure DoPrepare; virtual; abstract; ?
Si es así se puede poner código donde cargar el certificado en cada llamada.

[isnagil]

Sí, existe TWinHTTPRequest.DoPrepare;

De todas maneras no te preocupes, con dos componentes HTTPRio, uno para cada certificado lo he solucionado.

Por otra parte, si libero el componente, como te decía, me da el error "Invalid Pointer", es posible que esté relacionado con el modo en el que se llama al webservice, mediante una función Invokable.

Código Delphi [-]
CC515CV1 = interface(IInvokable)
  ['{1526E88D-1356-5848-234A-9734B73E6ED8}']

    // Cannot unwrap:
    //     - Output part does not refer to an element
    //     - Input element wrapper name does not match operation's name
    function  CC515CV1(const CC515CV1Ent: CC515CV1Ent): CC515CV1Sal; stdcall;

Además, si libero el componente en cada llamada, también aumento el tiempo de procesamiento. En fin, no quiero perder más tiempo con esto, como funciona lo voy a dejar como ha quedado.

Muchas gracias por tu ayuda

[razorxxx]

Buenas a todos.

Hasta ahora, para cargar un certificado desde archivo antes de realizar una petición con un objeto HTTPRIO utilizaba la librería capicom.dll desde el método OnBeforePost. Pero como ya sabemos, el método había cambiado desde la versión 10.3 de Delphi, ya que el Data: Pointer lo cambiaron a Client: THTTPClient.

Pues bien, después de mucho batallar, he conseguido hacerlo funcionar simplemente usando métodos nativos de la librería crypt32.dll de Windows.

Primeramente, antes de llamar al bloque "implementation" de nuestro código, poner la siguiente línea:

Código Delphi [-]
function PFXImportCertStore(var pPFX: CRYPT_DATA_BLOB; szPassword: LPCWSTR; dwFlags: DWORD): HCERTSTORE; stdcall; external 'Crypt32.dll';

Luego en el método

Código Delphi [-]
HTTPRIOHTTPWebNodeBeforePost(const HTTPReqResp: THTTPReqResp; Client: THTTPClient)

se pone lo siguiente:

Código Delphi [-]
const
     PKCS12_INCLUDE_EXTENDED_PROPERTIES  = $0010;
     CERT_COMPARE_HAS_PRIVATE_KEY        = 21;
     CERT_FIND_HAS_PRIVATE_KEY           = CERT_COMPARE_HAS_PRIVATE_KEY shl CERT_COMPARE_SHIFT;
var
   Almacen: HCERTSTORE;
   Certificado: PCERT_CONTEXT;
   DataBlob: CRYPT_DATA_BLOB;
   PFX: TBytes;
begin
     Almacen := nil;
     Certificado := nil;
     PFX := TFile.ReadAllBytes(Cert.Text);
     Try
        DataBlob.cbData := Length(PFX);
        DataBlob.pbData := @PFX[0];

        // Defino mi almacén con el único certificado seleccionado, en lugar del almacén con todos los certificados de Windows
        Almacen := PFXImportCertStore(DataBlob, PWideChar(Pwd.Text), PKCS12_INCLUDE_EXTENDED_PROPERTIES);
        If not Assigned(Almacen) Then
            Salida.Lines.Add('[ERROR] No se pudo importar el certificado seleccionado.')  //RaiseLastOSError;
        Else
        Begin
             Certificado := CertFindCertificateInStore(Almacen, X509_ASN_ENCODING, 0, CERT_FIND_HAS_PRIVATE_KEY, nil, nil);
             If not Assigned(Certificado) Then
                 Salida.Lines.Add('[ERROR] No se pudo encontrar el certificado digital en el contexto actual, o bien no tiene clave privada.');  //RaiseLastOSError;
        End;
     Finally
            If Assigned(Certificado) Then CertFreeCertificateContext(Certificado);
            If Assigned(Almacen) Then CertCloseStore(Almacen, 0);
     End;
end;

, sabiendo que la ruta completa al certificado .pfx o .p12 está en un campo TEdit llamado 'Cert', y su contraseña en otro TEdit llamado 'Pwd'.

Creo que el código también es compatible con Delphi 12.1 Athens.

No olviden asignar este método al OnBeforePost del objeto HTTPRIO que realiza la petición al webservice, de lo contrario recibirán el error Received content of invalid Content-Type setting: text/html - SOAP expects "text/xml".

De esta manera, conseguimos 3 mejoras:
1. Poder cambiar el certificado digital y su contraseña a petición del usuario justo antes de hacer la llamada al webservice.
2. Nos libramos de tener que modificar los fuentes de las librerías de Delphi.
3. Prescindimos de la antigua librería capicom.dll.

Tenéis mi mención a esto mismo en el foro del SII: https://www.clubdelphi.com/foros/sho...387#post556387

Espero haber ayudado. Saludos.

[razorxxx]

Nada, olviden lo anterior. Seguía dando problemas para conectar, porque faltaba asignarle el certificado al objeto HTTPReqResp, parece ser que me estaba cogiendo el primero que veía en el almacén de certificados.

Pero lo he solucionado. Todo es más fácil de lo que pensaba.

El método

Código Delphi [-]
HTTPRIOHTTPWebNode1BeforePost(const HTTPReqResp: THTTPReqResp; Client: THTTPClient)

debe quedar así:

Código Delphi [-]
var
   CertStream: TMemoryStream;
begin
     CertStream := TMemoryStream.Create;
     CertStream.LoadFromFile(Cert.Text);
     HTTPReqResp.ClientCertificate.Stream := CertStream;
     HTTPReqResp.ClientCertificate.Password := Pwd.Text;
end;

Ahora ya puedo seleccionar el certificado que quiera antes de cualquier petición y prescindir de la librería CAPICOM.

Saludos.

[Garada]

Sí, más o menos es a lo que se había llegado durante el hilo.

Como añadido, un problema que tiene el sistema de selección de certificado de un PFX y que me di cuenta hace unos meses:
En la carpeta %appdata%Microsoft\Crypto\RSA\S-1-5-21-algomas se van creado archivos temporales con las claves que no se eliminan y puedes terminar con miles de archivos (o en la carpeta equivalente en %programdata% si se usa el almacén de la máquina en vez del usuario)

La solución pasa por usar este código al terminar el uso del certificado:

Código Delphi [-]
procedure CertContexFree(pCert: PCERT_CONTEXT; pStore: HCERTSTORE);
var
  hProv: HCRYPTPROV;
  c: Cardinal;
  Info: PCRYPT_KEY_PROV_INFO;
  ContainerName,
  ProvName: WideString;
  ProvType: Cardinal;
begin
  if Assigned(pCert) then
  begin
    CertGetCertificateContextProperty(pCert, CERT_KEY_PROV_INFO_PROP_ID, nil, c);
    Info := AllocMem(c);
    CertGetCertificateContextProperty(pCert, CERT_KEY_PROV_INFO_PROP_ID, Info, c);
    ContainerName := Info.pwszContainerName;
    ProvName := Info.pwszProvName;
    ProvType := Info.dwProvType;
    FreeMem(Info);

    CertFreeCertificateContext(pCert);
 
    CryptAcquireContext(hProv, PWideChar(ContainerName), PWideChar(ProvName), ProvType, CRYPT_DELETEKEYSET);
  end;

  if Assigned(pStore) then
    CertCloseStore(pStore, 0);
end;

[razorxxx]

Empezado por Garada

Sí, más o menos es a lo que se había llegado durante el hilo.

Como añadido, un problema que tiene el sistema de selección de certificado de un PFX y que me di cuenta hace unos meses:
En la carpeta %appdata%Microsoft\Crypto\RSA\S-1-5-21-algomas se van creado archivos temporales con las claves que no se eliminan y puedes terminar con miles de archivos (o en la carpeta equivalente en %programdata% si se usa el almacén de la máquina en vez del usuario)

La solución pasa por usar este código al terminar el uso del certificado:

Código Delphi [-]
procedure CertContexFree(pCert: PCERT_CONTEXT; pStore: HCERTSTORE);
var
  hProv: HCRYPTPROV;
  c: Cardinal;
  Info: PCRYPT_KEY_PROV_INFO;
  ContainerName,
  ProvName: WideString;
  ProvType: Cardinal;
begin
  if Assigned(pCert) then
  begin
    CertGetCertificateContextProperty(pCert, CERT_KEY_PROV_INFO_PROP_ID, nil, c);
    Info := AllocMem(c);
    CertGetCertificateContextProperty(pCert, CERT_KEY_PROV_INFO_PROP_ID, Info, c);
    ContainerName := Info.pwszContainerName;
    ProvName := Info.pwszProvName;
    ProvType := Info.dwProvType;
    FreeMem(Info);

    CertFreeCertificateContext(pCert);
 
    CryptAcquireContext(hProv, PWideChar(ContainerName), PWideChar(ProvName), ProvType, CRYPT_DELETEKEYSET);
  end;

  if Assigned(pStore) then
    CertCloseStore(pStore, 0);
end;

Hola Garada, tienes razón, cada vez que se hace la llamada al OnBeforePost del HTTPRIO se crea un fichero temporal con la clave privada encriptada del certificado y no se borran solos, así que al final del año puedes tener centenares o miles de estos ficheros. No obstante, en mi equipo tenía mas de 500 archivos en dicha carpeta y no ocupaban más de 2MB.

En mi caso, como ya no hago uso de la librería Crypt32.dll para cargar el certificado, pues no tengo manera de borrarlos con el método que has propuesto. Así que lo único que se me ocurre es vaciar la carpeta antes de cerrar el programa o justo tras finalizar la gestión de la respuesta del webservice. La numeración del nombre de esa carpeta es distinta según el equipo, así que si por lo menos siempre empieza por S-1-5-21, tendré que buscar por esa y borrar su contenido.

[Garada]

Imagínate, yo lo descubrí en un equipo que hace automáticamente consultas a un web service cada 30 minutos y lleva años funcionando. La de archivos que había en esa carpeta. 😲

Lo de borrar la carpeta, cuidado por que también estarían claves legítimas de los certificados que estén instalados.

Una pena que Delphi no gestione correctamente el uso de certificados en los componentes SOAP, más de 10 años y ahora empiezan a hacer algo en el código para que sea más transparente.