galegoga

Arquivo ACBrCTeWebServices.pas atualizado Refere-se a primeira postagem. ACBrCTeWebServices.pas

Bom dia! Além desse ajuste é necessário ajustar o arquivo pcnRetDistDFeInt. if (oLeitorInfZip.rExtrai(1, LowerCase(FtpDFe) + 'Proc') <> '') or (oLeitorInfZip.rExtrai(1, LowerCase(FtpDFe) + 'OSProc') <> '') or (oLeitorInfZip.rExtrai(1, LowerCase(FtpDFe) + 'SimpProc') <> '') or (oLeitorInfZip.rExtrai(1, 'GTVeProc') <> '') then begin FdocZip.Items[i].XML := InserirDeclaracaoXMLSeNecessario(oLeitorInfZip.Grupo); Ajuste no arquivo em anexo. @douglaswf, após o ajuste o sistema parou de apresentar erro mas está havendo perda de arquivo se você utiliza o código padrão acbr para salvar a distribuição. Você pode efetuar o ajuste ou aguardar os moderadores ajustarem. São dois ajustes esse e o acima. pcnRetDistDFeInt.pas

Boa tarde, @Italo Giurizzato Junior! Foi postado um ajuste seu na distribuição cte. Veja aqui. O ajuste funcionou, agora está faltando adicionar o novo valor enumerado (schprocCTeSimp) na rotina que salva os documentos na pasta, localizado no método TDistribuicaoDFe.TratarResposta acredito o código deva ficar da seguinte forma: schprocCTe, schprocCTeOS, schprocGTVe, schprocCTeSimp: FNomeArq := FretDistDFeInt.docZip.Items[I].resDFe.chDFe + '-cte.xml'; Segue em anexo o arquivo com a correção. ACBrCTeWebServices.pas

@Arimateia Jr Blz, Vou dar um olhada nesses links.

Boa tarde, Arimateia! Fiz o teste e funcionou muito bem. Você conseguiu através do link em que postei ? Pergunto porque esse método "OPENSSL_sk_pop_free" não está informado, lá falava sobre "sk_X509_pop_free". Ele são similares ou equivalentes ? (Levando em conta que o artigo no fórum já tem 22 anos e muita coisa pode ter mudado).

Tudo bem. Irei aguardar.

Boa tarde, Daniel. Você chegou a ver o post acima ? No dia em que postei tive um problema e acabei quebrando ele em dois. Tentei editar para ficar em um só, mas o tempo de edição havia expirado.

Continuação do post acima // Set Certificate Verification chain if Result and (ca <> nil) then SslCtxCtrl(Fctx, SSL_CTRL_CHAIN, 0, ca); // <---- AQUI Adicionei esse código e fiz os testes e vi que parou de vazar memória. meu código de teste foi (loop de 1000): procedure TForm2.MetodoTeste(ALoop: Integer); var vDFeSSL: TDFeSSL; vCT: Integer; vSenha: String; vFileName: String; begin vFileName := edtPfxFileName.Text; vSenha := edtSenhaPFX.Text; for vCT := 1 to ALoop do begin vDFeSSL := TDFeSSL.Create; try vDFeSSL.SSLCryptLib := cryOpenSSL; vDFeSSL.SSLType := LT_TLSv1_2; vDFeSSL.DadosPFX := LoadCertificado(vFileName); vDFeSSL.Senha := AnsiString(vSenha); vDFeSSL.CarregarCertificado; finally vDFeSSL.Free; end; end; end; Realmente os sistema com ReportMemoryLeaksOnShutdown := True; não acusa nada. Mas o memory ocorre. Aproveitando essa discussão. Acho que você não acompanhou a discussão desde o início. Digo isso porque quando tive o problema cheguei a achar algo parecido com o meu problema. chequei a mencionar no fórum antes de propor essa modificação no código. Um certo usuário mencionava despejo de memória relacionado a variável "Ca". A solução veio do Dr. Stephen Henson, que informava que ele devia chamar sk_X509_pop_free(Ca, X509_free) ao final. Achei que fosse isso. No acbr também possui ela com o nome SkX509PopFree, mas ela nunca é executada por que me parece que ela não existe na dll. _SkX509PopFree dentro de ssl_openssl_lib.pas sempre está nula. A solução é antiga, acho que no inicio dos anos 2000. O link é : https://openssl-users.openssl.narkive.com/F1OAAID0/pkcs12-memory-leak#post2 Vou adicionar o código fonte de teste. Se precisar do certificado digital é só me falar. PrjReadPfx02.zip

Boa tarde, Daniel! Fiz o teste e continua apresentando o problema. Primeiramente quero dizer que meu conhecimento referente as bibliotecas OpenSSL é zero. Também pouco sei sobre certificado digital. Nesses aspectos sou usuário final, dessa forma eu não tenho a capacidade de discutir os detalhes internos da biblioteca. Mas vou te passar os passos que levaram até esse ponto. Desenvolvi uma aplicação para consultar a Distribuição, é um serviço que roda 24 horas, com mais de 1000 empresas, mas acho que certificados são uns 500, visto que tem muitas filiais. No decorrer do tempo a aplicação ia crescendo até ficar sem memória. Fiz um rastreio, fui isolando as partes até que descobri que o despejo era quando acessava a certificado. Um detalhe importante é que o problema ocorre somente com alguns certificados. Depois que descobri em qual unit (ACBrDFeOpenSSL.pas) estava o problema eu comecei estudar o que estava sendo criado e que ficava para trás. Nesse processo descobrir a unit ssl_openssl.pas na qual me ajudou, fui comparando o código vendo as diferenças até que cheguei a um certo ponto, onde existia um código na ssl_openssl.pas que não existia na unit do acbr. O código era:

Arquivo em anexo. ACBrDFeOpenSSL.pas

Boa tarde! No meus testes essa modificação não funcionou. Continua vazando memória. A linha 576, código: SslCtxCtrl(Fctx, SSL_CTRL_CHAIN, 0, ca); não está sendo executada de acordo com a condicional estabelecida. Por que ela não pode ser executada somente através da condicional "if Result and (ca <> nil) then" ? porque ela tem que depender da condicional "if LibVersionIsGreaterThan1_0_0 then begin" ser falsa ? Assim não funcionou: // Set Certificate Verification chain if Result and (ca <> nil) then begin if LibVersionIsGreaterThan1_0_0 then begin iTotal := OPENSSL_sk_num(ca); if iTotal > 0 then begin Store := SSL_CTX_get_cert_store(Fctx); for I := 0 to iTotal - 1 do begin certx := OPENSSL_sk_value(ca, I); if certx <> nil then begin if X509_STORE_add_cert(Store, pX509(certx)) = 0 then begin // already exists end; //X509_free(Cert); end; end; end; end else SslCtxCtrl(Fctx, SSL_CTRL_CHAIN, 0, ca); end; Assim funcionou: // Set Certificate Verification chain if Result and (ca <> nil) then begin if LibVersionIsGreaterThan1_0_0 then begin iTotal := OPENSSL_sk_num(ca); if iTotal > 0 then begin Store := SSL_CTX_get_cert_store(Fctx); for I := 0 to iTotal - 1 do begin certx := OPENSSL_sk_value(ca, I); if certx <> nil then begin if X509_STORE_add_cert(Store, pX509(certx)) = 0 then begin // already exists end; //X509_free(Cert); end; end; end; end; SslCtxCtrl(Fctx, SSL_CTRL_CHAIN, 0, ca); end;

Sim, vou efetuar os testes. Reporto assim que tiver os resultados.

Desculpe, só vi sua mensagem agora. Devo ter recebido o e-mail de notificação do fórum, mas também não vi. Segue em anexo o arquivo atualizado. Modificações somente no arquivo ACBrDFeOpenSSL.pas. ACBrDFeOpenSSL.pas

Seria bom que colocasse esse ajuste, recentemente tive que atualizar o ACBr e tive que modificar novamente a unit. Não consegui solucionar utilizando a versão que utiliza componentes do Windows. Ele gera diversos arquivos numa pasta do AppData ficando enorme. Usando o OpenSSL consegui resolver o problema que consumia muita memória, em uma hora de uso a aplicação consumia 500MB só de leitura de certificado e continuava a crescer até dar crash no aplicativo.

Boa noite! Segue o arquivo com a sugestão de correção para evitar memoryLeak na leitura de alguns certificados. ACBrDFeOpenSSL.pas

Boa tarde! Acho que consegui algo. Consegui reproduzir o teste do inicio do post sem que ocorra vazamento de memória na leitura do certificado. Mas antes de prosseguir volto ao post anterior, onde é mencionado uma solução com o método sk_X509_pop_free, ele até existe no arquivo ssl_openssl.pas, mas é inócuo, já que o método não existe na DLL. "_SkX509PopFree := GetProcAddr(SSLUtilHandle, 'SK_X509_POP_FREE');" sempre retorna nulo. A solução que encontrei foi uma comparação dos arquivos ssl_openssl.pas e ACBrDFeOpenSSL.pas. Comparei os métodos TSSLOpenSSL.LoadPFX e TDFeOpenSSL.LerPFXInfo e peguei trechos de código de um e adicionei ao outro. Código comparados: Código da classe: ssl_openssl.TSSLOpenSSL function TSSLOpenSSL.LoadPFX(pfxdata: Ansistring): Boolean; var cert, pkey, ca: SslPtr; b: PBIO; p12: SslPtr; begin Result := False; b := BioNew(BioSMem); try BioWrite(b, pfxdata, Length(PfxData)); p12 := d2iPKCS12bio(b, nil); if not Assigned(p12) then Exit; try cert := nil; pkey := nil; ca := nil; try {pf} if PKCS12parse(p12, FKeyPassword, pkey, cert, ca) > 0 then if SSLCTXusecertificate(Fctx, cert) > 0 then if SSLCTXusePrivateKey(Fctx, pkey) > 0 then Result := True; // Set Certificate Verification chain if Result and (ca <> nil) then SslCtxCtrl(Fctx, SSL_CTRL_CHAIN, 0, ca); {pf} finally EvpPkeyFree(pkey); X509free(cert); SkX509PopFree(ca,_X509Free); // for ca=nil a new STACK was allocated... end; {/pf} finally PKCS12free(p12); end; finally BioFreeAll(b); end; end; Código da classe ACBrDFeOpenSSL.TDFeOpenSSL: function TDFeOpenSSL.LerPFXInfo(const PFXData: Ansistring): Boolean; var ca, p12: Pointer; b: PBIO; begin Result := False; DestroyKey; b := BioNew(BioSMem); try BioWrite(b, PFXData, Length(PFXData)); p12 := d2iPKCS12bio(b, nil); if not Assigned(p12) then Exit; try DestroyCert; DestroyKey; ca := nil; if PKCS12parse(p12, FpDFeSSL.Senha, FPrivKey, FCert, ca) > 0 then begin if (FCert <> nil) then begin GetCertInfo( FCert ); Result := True; end; end; finally PKCS12free(p12); end; finally BioFreeAll(b); end; end; Basicamente o que encontrei diferente foi o código, que passei para ACBrDFeOpenSSL : if SSLCTXusecertificate(Fctx, Fcert) > 0 then if SSLCTXusePrivateKey(Fctx, FPrivKey) > 0 then Result := True; // Set Certificate Verification chain if Result and (ca <> nil) then SslCtxCtrl(Fctx, SSL_CTRL_CHAIN, 0, ca); A modificação Final ficou assim: TDFeOpenSSL = class(TDFeSSLCryptClass) private .... Fctx: PSSL_CTX; // Adicionado proteced ... procedure FreeContext; // Adicionado end; constructor TDFeOpenSSL.Create(ADFeSSL: TDFeSSL); begin inherited Create(ADFeSSL); ... Fctx := nil; // Adicionado end; destructor TDFeOpenSSL.Destroy; begin ... FreeContext; // Adicionado inherited Destroy; end; procedure TDFeOpenSSL.FreeContext; // Adicionado begin if assigned (Fctx) then begin SslCtxFree(Fctx); Fctx := nil; ErrRemoveState(0); end; end; function TDFeOpenSSL.LerPFXInfo(const PFXData: Ansistring): Boolean; procedure SetContex; // Adicionado begin FreeContext; Fctx := nil; case FpDFeSSL.SSLType of LT_SSLv2: Fctx := SslCtxNew(SslMethodV2); LT_SSLv3: Fctx := SslCtxNew(SslMethodV3); LT_TLSv1: Fctx := SslCtxNew(SslMethodTLSV1); LT_TLSv1_1: Fctx := SslCtxNew(SslMethodTLSV1_1); LT_TLSv1_2: Fctx := SslCtxNew(SslMethodTLSV1_2); LT_TLSv1_3: Fctx := SslCtxNew(SslMethodTLSV1_3); LT_all: begin //try new call for OpenSSL 1.1.0 first Fctx := SslCtxNew(SslTLSMethod); if Fctx=nil then //callback to previous versions Fctx := SslCtxNew(SslMethodV23); end; else Exit; end; end; var ca, p12: Pointer; b: PBIO; begin Result := False; DestroyKey; SetContex; // Adicionado b := BioNew(BioSMem); try BioWrite(b, PFXData, Length(PFXData)); p12 := d2iPKCS12bio(b, nil); if not Assigned(p12) then Exit; try DestroyCert; DestroyKey; ca := nil; if PKCS12parse(p12, FpDFeSSL.Senha, FPrivKey, FCert, ca) > 0 then begin // Adicionado Inicio ================================================= if SSLCTXusecertificate(Fctx, Fcert) > 0 then if SSLCTXusePrivateKey(Fctx, FPrivKey) > 0 then Result := True; // Set Certificate Verification chain if Result and (ca <> nil) then SslCtxCtrl(Fctx, SSL_CTRL_CHAIN, 0, ca); // Adicionado Fim ==================================================== if (FCert <> nil) then begin GetCertInfo( FCert ); Result := True; end; end; finally PKCS12free(p12); end; finally BioFreeAll(b); end; end; Depois dessa modificação o memoryleak parou de acontecer. Não sei o que esses métodos fazem, mas me parece que ele cria um vinculação da Variável "ca" com Fctx e quando o método FreeContex finaliza Fctx ele também deve estar eliminando os objetos apontados por "ca". Li na documentação de PKCS12parse que quando é passado "ca" como null ele cria um objeto internamente. Talvez seja isso.

Acho que encontrei alguma coisa. O problema está na chamada "PKCS12parse" dentro do método TDFeOpenSSL.LerPFXInfo. Efetuei uma pesquisa e encontrei um link que menciona memoryleak nesse método, não exatamente no método, mas a falta de execução de um método para Limpar o conteúdo. A solução é data por Stephen Henson, veja o problema relatado com a solução: in order to try and prove that the memory leak i am seeing in PKCS12_parse() is not specific to my embedded system, i compiled the following using OpenSSL 0.9.6 on solaris void parsetest(BIO *databio) { EVP_PKEY *Pkey=NULL; X509 *Cert=NULL; STACK_OF(X509) *Ca=NULL; PKCS12 *PK12=NULL; PK12 = d2i_PKCS12_bio(databio, NULL); PKCS12_parse(PK12, NULL, &Pkey, &Cert, &Ca); PKCS12_free(PK12); if (Pkey) EVP_PKEY_free(Pkey); if (Cert) X509_free(Cert); if (Ca) sk_X509_free(Ca); The above line is the problem, it just frees up the STACK, not its contents. It should be: sk_X509_pop_free(Ca, X509_free); Steve. Link oficial do problema relatado. Ele menciona que o método sk_X509_pop_free deve ser executado para limpar o conteúdo e não somente o STACK(não sei o que é). Tentei localizar esse método na Unit OpenSSLExt, mas não encontrei. Mas no arquivo ssl_openssl_lib.pas dentro da pasta "ACBr\Fontes\Terceiros\synalist" eu encontrei. Tentei transpo-lo para o arquivo OpenSSLExt para utiliza-lo mas não consegui. Existem algumas diferenças entre os arquivos e me falta conhecimento para código de mais baixo nível, além de não conhecer nada sobre a documentação do OpenSSL. Se alguém puder ajudar eu agradeço.

Esse código é de teste. Criei para ver o comportamento do componente. Na aplicação real recebo ele via REST em Base64. Agora, existe algum problema no componente em carregar o arquivo físico do disco ?

Juliomar, o arquivo, na aplicação real, recebe do banco de dados. O arquivo encontra-se em base64 armazenado na variavel FDadosPFXBase64, converto ele para para um StreamByte depois converto para Ansi para passar ao ACBr. Não sei se estou fazendo algo errado mas se estiver aceito sugestões, veja código abaixo da aplicação real: function TDistribuicaoEngineDFeModel.GetDadosPFXToAnsi: AnsiString; var vMemory: TMemoryStream; vOut: TBytesStream; vBytes: TArray<Byte>; begin Result := ''; if (FDadosPFXBase64.Trim.IsEmpty) then begin Exit; end; vMemory := TStringStream.Create(FDadosPFXBase64); vOut := TBytesStream.Create; try TNetEncoding.Base64.Decode( vMemory, vOut ); vBytes := vOut.Bytes; SetString(Result, PAnsiChar(@vBytes[0]), Length(vBytes)); finally vOut.Free; vMemory.Free; end; end; Agora eu não entendi seu posicionamento, ler um arquivo físico do disco é problema ? ao meu ver deveria ser a mesma coisa. O código do início do post, lendo um arquivo físico do disco, é o código de teste que criei para constatar onde estava o problema. É um código de teste. Agora, vou fazer um outro teste, vi que há uma atualização do openSSL "3.1.3" com dll nomeada libcrypto-3..., meus teste foram com a dll versão "1.1.1.10" libcrypto-1_1-... Vou atualizar meu acbr e fazer novos teste. Reporto aqui o resultado.

Bom dia, Renato! O vazamento pode ser reproduzido com o exemplo de código no início do post. No exemplo acima está cryWinCrypt, mas o teste que fiz agora foi com cryOpenSSL. Fiz um Loop de 1000. Mas o problema ocorre somente com alguns certificados. Só para ressaltar, meu teste foi com a ultima versão da dll.

Realmente, acabei de concluir que a classe TDFeOpenSSL, localizada na unit ACBrDFeOpenSSL, está vazando memória. Custei a descobrir devido ao fato que o despejo ocorre com alguns certificados e outros não. Porém o defeito é silencioso, não retornando nenhuma exceção, além do mais o certificado é lido corretamente. Vou trabalhar aqui para tentar descobrir o que se trata. se alguém souber de alguma coisa....

Não entendi. Porque eu crio TDFeSSL ou porque eu dou load no pfx no memoryStream para depois passar pro TDFeSSL ? Na rotina original eu pego o PFX através do banco de dados. E crio o TDFeSSL para obter as informações do pfx, no caso, quero saber se o certificado é da empresa e se está vencido antes de entrar na rotina.

Boa tarde! Estou com um problema de vazamento de memória no componente ACBr. Mas não consegui localizar exatamente onde ocorre. O vazamento é relacionado ao certificado digital. Utilizo carregamento de PFX com a configuração cryWinCrypt, além do lixo na memória ele também cria diversos arquivos na pasta "..\AppData\Roaming\Microsoft\Crypto\RSA". OBS: Se alguém souber uma forma de evitar a criação dos arquivos na pasta RSA ou a exclusão automática ao termino da execução seria de grande ajuda. Minha rotina é com milhares de empresas e com diversas ações, em um dia está estourando o disco. Mas vamos ao caso da MemoryLeak, no exemplo abaixo eu rodei um loop de 1000, nele é possível ver que a memória sobe. Fazendo esse teste com cryOpenSSL a memória permanece estável (OBS: Usando ACBr com cryOpenSSL em consultas(Distribuicao e consulta de status) o consumo da memória também sobe, mas não sei se é o acbr ou falha do meu código, ainda estou tentando localizar): unit ACBrDFeSSL; function LoadCertificado( const AFileName: String ): AnsiString; var vMemory: TBytesStream; vBytes: TArray<Byte>; begin vMemory := TBytesStream.Create(); try vMemory.LoadFromFile( AFileName ); vBytes := vMemory.Bytes; SetString(Result, PAnsiChar(@vBytes[0]), Length(vBytes)); finally vMemory.Free; end; end; procedure TForm2.MetodoTeste( ALoop: Integer ); var vDFeSSL: TDFeSSL; vPFX: Boolean; vCT: Integer; vMetodo: TSSLCryptLib; begin vPFX := True; vMetodo := cryWinCrypt; for vCT := 1 to ALoop do begin vDFeSSL := TDFeSSL.Create; // TSSLCryptLib = (cryNone, cryOpenSSL, cryCapicom, cryWinCrypt); try if vPFX then begin vDFeSSL.DadosPFX := LoadCertificado(ExtractFilePath( Application.ExeName )+'certificado.pfx'); vDFeSSL.Senha := '123456'; end else begin vDFeSSL.NumeroSerie := ''; end; vDFeSSL.SSLCryptLib := vMetodo; vDFeSSL.CarregarCertificado; finally vDFeSSL.DescarregarCertificado; FreeAndNil( vDFeSSL ); end; end; end;

Bom dia! Recebi um a resposta ontem! Não mencionaram o problema, mas voltou a funcionar.

Ainda não. Enviei um e-mail para eles e estou aguardando retorno.