uso

Off-topic: UTF-8 is 1 to 4 byte(s) per char depending on the respective code point. @PizzaProgram It is not a trival task to get the exact byte size of an UTF-8 coded string. You need to put into consideration every code point. If you know your input languages, you may be able to approximate it - most of the time...

I once had this sort of problem (leaking GDI handles) by creating (and releasing) > 46 TBitmap(s) per second. The problem was not the TBitmap itself, the problem was somehow based on GDI ressources created in non UI threads have not been released propperly. The only solution I found in my particular case was to redesign the code. I created a pool of bitmaps in the VCL main thread and reused the TBitmap instances in the other threads.

Hi Angus, if a certificate is imported with the "Is Exportable" option into the Windows certificate storage, ICS is able to fetch the private keys for RSA/DSA certs. For ECC certificates a workaround is required as they are missing the NCRYPT_ALLOW_PLAINTEXT_EXPORT_FLAG per default (no UI option to set it on import): diff --git "a/overbyte/ics/Source/OverbyteIcsMsSslUtils.pas" "b/overbyte/ics/Source/OverbyteIcsMsSslUtils.pas" index 7932c54..cce85e7 100644 --- "a/overbyte/ics/Source/OverbyteIcsMsSslUtils.pas" +++ "b/overbyte/ics/Source/OverbyteIcsMsSslUtils.pas" @@ -234,6 +234,23 @@ implementation {$IFDEF MSWINDOWS} {$IFDEF USE_SSL} +const + RGB_SALT_SIZE = 8; + +type + CRYPT_PKCS12_PBE_PARAMS = record + iIterations: Int32; + cbSalt: Int32; + end; + + PBE_PARAMS = record + const + RgbSaltSize: Int32 = RGB_SALT_SIZE; + var + Params: CRYPT_PKCS12_PBE_PARAMS; + rgbSalt: array [0..(RGB_SALT_SIZE-1)] of Byte; + end; + const CRYPT_E_REVOKED = $80092010; CRYPT_E_EXISTS = $80092005; @@ -241,6 +258,12 @@ const sCryptoApiError = 'CryptoAPI Error. Code: %d.'+#13#10+'%s'; sUnKnownCryptoApi = 'A call to a CryptoAPI function failed'; + NTE_BAD_FLAGS: Cardinal = $80090009; + NTE_BAD_KEY_STATE: Cardinal = $8009000B; + NTE_FAIL: Cardinal = $80090020; + NTE_INVALID_HANDLE: Cardinal = $80090026; + NTE_NOT_SUPPORTED: Cardinal = $80090029; + PBE_SHA1_3DES: AnsiString = '1.2.840.113549.1.12.1.3'#0; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure RaiseOSSLError(AErrCode: LongWord); @@ -769,6 +792,137 @@ end; { load a Windows store into the list of certificates, optionally not emptying it first } function TMsX509List.LoadFromStore(MsCertStoreType: TMsCertStoreType; MsCertLocation: TMsCertLocation; Empty: Boolean = True): Integer; + function CngTrySetEccPrivateKeyExportable(const ACertStore: HCERTSTORE; var AKeyHandle: NCRYPT_KEY_HANDLE; var AError: string): Boolean; + var + LKeyData: RawByteString; + LParameterList: TNCryptBufferDesc; + LCryptBuffers: array[0..4] of TNCryptBuffer; + LParams: PBE_PARAMS; + dwRes: DWORD; + dwFlags: DWORD; + LKeyLen: Cardinal; + LError: Cardinal; + LKeyPol: DWORD; + LhProvider: NCRYPT_PROV_HANDLE; + begin + Result := False; + + // Prepare ECC private key export in a way that requirements of Crypto-API/CNG are statisfied + FillChar(LCryptBuffers[0], SizeOf(LCryptBuffers), #0); + FillChar(LParams, SizeOf(LParams), #0); + LParams.Params.cbSalt := LParams.RgbSaltSize; + + LCryptBuffers[0].BufferType := NCRYPTBUFFER_PKCS_ALG_OID; + LCryptBuffers[0].cbBuffer := Length(PBE_SHA1_3DES); + LCryptBuffers[0].pvBuffer := @PBE_SHA1_3DES[1]; + + LCryptBuffers[1].BufferType := NCRYPTBUFFER_PKCS_SECRET; + LCryptBuffers[1].cbBuffer := 0; + LCryptBuffers[1].pvBuffer := nil; + + LCryptBuffers[2].BufferType := NCRYPTBUFFER_PKCS_ALG_PARAM; + LCryptBuffers[2].cbBuffer := SizeOf(LParams); + LCryptBuffers[2].pvBuffer := @LParams; + + dwRes := 0; + dwFlags := NCRYPT_SILENT_FLAG; + + LParameterList.ulVersion := NCRYPTBUFFER_VERSION; + LParameterList.cBuffers := 3; + LParameterList.pBuffers := @LCryptBuffers[0]; + + // Get private key length + LError := NCryptExportKey(AKeyHandle, 0, NCRYPT_PKCS8_PRIVATE_KEY_BLOB, @LParameterList, nil, 0, dwRes, dwFlags); + if ERROR_SUCCESS <> LError then + begin + AError := AError + 'Could not export private key - ' + GetWindowsErr(LError); + Exit; + end; + + // Get private key + LKeyLen := dwRes; + SetLength(LKeyData, LKeyLen); + FillChar(LKeyData[1], LKeyLen, #0); + LError := NCryptExportKey(AKeyHandle, 0, NCRYPT_PKCS8_PRIVATE_KEY_BLOB, @LParameterList, @LKeyData[1], LKeyLen, LKeyLen, dwFlags); + if ERROR_SUCCESS <> LError then + begin + SetLength(LKeyData, 0); + AError := AError + 'Could not export private key - ' + GetWindowsErr(LError); + Exit; + end; + + // Get current key export policy + LKeyPol := 0; + LError := NCryptGetProperty(AKeyHandle, NCRYPT_EXPORT_POLICY_PROPERTY, @LKeyPol, SizeOf(LKeyPol), dwRes, dwFlags); + if ERROR_SUCCESS <> LError then + begin + SetLength(LKeyData, 0); + AError := AError + 'Error fetching private key properties - ' + GetWindowsErr(LError); + Exit; + end; + + if NCRYPT_ALLOW_PLAINTEXT_EXPORT_FLAG = (LKeyPol and NCRYPT_ALLOW_PLAINTEXT_EXPORT_FLAG) then + begin + AError := AError + 'Key already marked as exportable. Don''t know what went wrong.'; + Exit; + end; + + LError := NCryptFreeObject(AKeyHandle); + if ERROR_SUCCESS <> LError then + begin + AError := AError + 'Error freeing previous key handle - ' + GetWindowsErr(LError); + Exit; + end; + + LhProvider := 0; + try + LError := NCryptOpenStorageProvider(LhProvider, MS_KEY_STORAGE_PROVIDER, 0); + if ERROR_SUCCESS <> LError then + begin + AError := AError + 'Error opening key storage provider - ' + GetWindowsErr(LError); + Exit; + end; + + // Reimport the private key + FillChar(LCryptBuffers[0], SizeOf(LCryptBuffers), #0); + LCryptBuffers[0].BufferType := NCRYPTBUFFER_PKCS_SECRET; + LCryptBuffers[0].cbBuffer := 0; + LCryptBuffers[0].pvBuffer := nil; + LParameterList.cBuffers := 1; + dwFlags := NCRYPT_SILENT_FLAG or NCRYPT_SILENT_FLAG OR NCRYPT_OVERWRITE_KEY_FLAG OR NCRYPT_DO_NOT_FINALIZE_FLAG; + LError := NCryptImportKey(LhProvider, 0, NCRYPT_PKCS8_PRIVATE_KEY_BLOB, @LParameterList, AKeyHandle, @LKeyData[1], LKeyLen, dwFlags); + if ERROR_SUCCESS <> LError then + begin + AError := AError + 'Error reimporting private key - ' + GetWindowsErr(LError); + Exit; + end; + + // Allow plain text export. + // It seems the NCRYPT_ALLOW_PLAINTEXT_EXPORT_FLAG is volatile in the context of ECC private keys. + dwFlags := NCRYPT_SILENT_FLAG; + LKeyPol := LKeyPol or NCRYPT_ALLOW_PLAINTEXT_EXPORT_FLAG; + LError := NCryptSetProperty(AKeyHandle, NCRYPT_EXPORT_POLICY_PROPERTY, @LKeyPol, SizeOf(LKeyPol), dwFlags); + if ERROR_SUCCESS <> LError then + begin + AError := AError + 'Error adjusting private key properties - ' + GetWindowsErr(LError); + Exit; + end; + + LError := NCryptFinalizeKey(AKeyHandle, dwFlags); + if ERROR_SUCCESS <> LError then + begin + AError := AError + 'Error finalizing private key - ' + GetWindowsErr(LError); + Exit; + end; + finally + if 0 <> LhProvider then + begin + NCryptFreeObject(LhProvider); + end; + end; + Result := True; + end; + var hSystemStore: HCERTSTORE; pCertContext: PCCERT_CONTEXT; @@ -859,6 +1013,14 @@ begin ParameterList.cBuffers := 1; ParameterList.pBuffers := @CryptBuffers[0]; Ret := NCryptExportKey(hKey, 0, NCRYPT_PKCS8_PRIVATE_KEY_BLOB, @ParameterList, Nil, 0, dwResLen, dwFlags); + if NTE_NOT_SUPPORTED = Cardinal(Ret) then + begin + if CngTrySetEccPrivateKeyExportable(hSystemStore, hKey, PKeyInfo) then + begin + Ret := NCryptExportKey(hKey, 0, NCRYPT_PKCS8_PRIVATE_KEY_BLOB, @ParameterList, Nil, 0, dwResLen, dwFlags); + end; + end; + if Ret <> ERROR_SUCCESS then PKeyInfo := PKeyInfo + 'Could not export private key - ' + GetWindowsErr(Ret) else begin I have to admit that this code is not testet with the ICS server components (haven't figured out how to get ICS proxy in reverse mode to load certs from the MS cert storage until now - but that is another story). It is more or less a proof of concept with the apparent result, that TMsX509List was able to fetch an ECC private key from the MS cert store. I also hope that it is of any help for all the folks out there that have the problem to figure out how to NCryptExportKey the private part of an ECC based certificate from the Microsoft Certificate Storage. Regards, uso

Hi Angus, thanks for your effort! We are going to test internally - too. PemTool: Same here - had to fiddle arround with it to get it to work. But ultimately I switched to XCA for creating my certs.

No. We are developing against customer specifications and a full-fledged web server is not on the "wishlist". The backend is using std. SOAP components from Delphi - yes. But one of the requirements is a state of the art encryption so we are stuck with the SOAP components and I tried to handle the encryption by a proxy in front of the main service. The proxy is working so far - encryption too. Last thing, I couldn't figure out, is how to get the proxy to deny client connections, if the client does not send the right certificate. At the moment the proxy processes every client request, even if the client sends a cert that is not signed by "my" CA. I set TIcsProxy.RootCA to my own root certificate and I cleared TIcsProxy.SourceServer.RootCAList - but no success. TIcsProxy Settings: MProxy := TIcsProxy.Create(nil); MProxy.Name := 'xxx'; MLogger := TIcsLogger.Create(MProxy); if Assigned(MProxy.FIcsLog) then begin FreeAndNil(MProxy.FIcsLog); end; MLogger.LogOptions := [ TLogOption.loDestEvent, TLogOption.loDestFile, TLogOption.loAddStamp, TLogOption.loWsockErr, TLogOption.loWsockInfo, TLogOption.loWsockDump, TLogOption.loSslErr, TLogOption.loSslInfo, TLogOption.loSslDevel, TLogOption.loSslDump, TLogOption.loProtSpecErr, TLogOption.loProtSpecInfo, TLogOption.loProtSpecDump, TLogOption.loProgress]; MLogger.LogFileName := GetLogfilePath(); {$IFDEF DEBUG} MLogger.OnIcsLogEvent := OnOnIcsLogEvent; {$ENDIF} MLogger.OpenLogFile; MLogger.DoDebugLog(MLogger, TLogOption.loProgress, Format(RSTR_LOGGER_CREATED_s, [MLogger.LogFileName])); MProxy.FIcsLog := MLogger; MProxy.onProxyProg := MLogger.DoDebugLog; MProxy.SourceServer.RootCAList.Clear; MProxy.RootCA := 'xxx'; LIcsHost := MProxy.IcsHosts.Add() as TIcsHost; LIcsHost.HostNames.Add('*'); LIcsHost.HostEnabled := True; LIcsHost.BindIpAddr := '0.0.0.0'; LIcsHost.BindSslPort := 8080; LIcsHost.BindNonPort := 0; LIcsHost.HostTag := '<Your host tag>'; LIcsHost.ForwardProxy := False; LIcsHost.WebLogDir := ''; LIcsHost.WebLogIdx := 0; LIcsHost.SslCert := {$DEFINE SSL_CERT}{$INCLUDE 'SslSettings.inc'}; LIcsHost.SslKey := {$DEFINE SSL_PRIV_KEY}{$INCLUDE 'SslSettings.inc'}; LIcsHost.SslInter := {$DEFINE SSL_INTER_CERT}{$INCLUDE 'SslSettings.inc'}; LIcsHost.SslPassword := {$DEFINE SSL_PASSWORD}{$INCLUDE 'SslSettings.inc'}; LIcsHost.SslSrvSecurity := sslSrvSecHigh; LIcsHost.WebRedirectStat := 0; LIcsHost.CliCertMethod := sslCliCertRequire; LIcsHost.CertSupplierProto := SuppProtoNone; LIcsHost.CertChallenge := ChallNone; LIcsHost.CertPKeyType := PrivKeyECsecp512; LIcsHost.CertSignDigest := Digest_sha3_512; LIcsHost.AuthForceSsl := True; LIcsHost.AuthSslCmd:= True; LIcsTarget := MProxy.ProxyTargets.Add() as TProxyTarget; LIcsTarget.TarHost := 'localhost'; LIcsTarget.TarPort := 8081; LIcsTarget.TarSsl := False; LIcsTarget.HostTag := '<Your host tag>'; LIcsTarget.HostEnabled := True;

Hello Delphians, following scenario: A server w/o support for encryption needs to be "guarded" by a encrypting reverse proxy (server <=> proxy - no encryption; proxy <=> client - encrypted) Each valid client should authenticate against the proxy with a specific SSL certificate ("sslCliCertRequire") configured using IcsHosts. For testing purposes I generated a root CA cert and one "child" certificate signed by this CA. Now I set up proxy and client (for the sake of simplicity the client is "Firefox") to connect a demo SOAP service (client => proxy => SOAP-Service). Firefox is asking for a certificate to authenticate against the proxy but connection is always closed with "SSL_ERROR_HANDSHAKE_FAILED". openssl c_client -connect localhost:4711 gives the following: CONNECTED(000000FC) Can't use SSL_get_servername depth=0 CN = localhost, OU = Child OU, ST = Some State, O = "Some Company", C = DE, L = City, emailAddress = info@contoso.com verify error:num=20:unable to get local issuer certificate verify return:1 depth=0 CN = localhost, OU = Child OU, ST = Some State, O = "Some Company", C = DE, L = City, emailAddress = info@contoso.com verify error:num=21:unable to verify the first certificate verify return:1 depth=0 CN = localhost, OU = Child OU, ST = Some State, O = "Some Company", C = DE, L = City, emailAddress = info@contoso.com verify return:1 --- Certificate chain 0 s:CN = localhost, OU = Child OU, ST = Some State, O = "Some Company", C = DE, L = City, emailAddress = info@contoso.com i:CN = Personal Root CA, OU = Personal Root CA, ST = Some State, O = "Some Company", C = DE, L = City, emailAddress = info@contoso.com a:PKEY: id-ecPublicKey, 521 (bit); sigalg: ecdsa-with-SHA512 v:NotBefore: Apr 24 12:29:14 2023 GMT; NotAfter: Apr 25 12:29:14 2033 GMT -----BEGIN CERTIFICATE----- [...] -----END CERTIFICATE----- --- Server certificate subject=CN = localhost, OU = Child OU, ST = Some State, O = "Some Company", C = DE, L = City, emailAddress = info@contoso.com issuer=CN = Personal Root CA, OU = Personal Root CA, ST = Some State, O = "Some Company", C = DE, L = City, emailAddress = info@contoso.com --- No client certificate CA names sent Requested Signature Algorithms: ECDSA+SHA256:ECDSA+SHA384:ECDSA+SHA512:Ed25519:Ed448:RSA-PSS+SHA256:RSA-PSS+SHA384:RSA-PSS+SHA512:RSA-PSS+SHA256:RSA-PSS+SHA384:RSA-PSS+SHA512:RSA+SHA256:RSA+SHA384:RSA+SHA512:ECDSA+SHA224:RSA+SHA224 Shared Requested Signature Algorithms: ECDSA+SHA256:ECDSA+SHA384:ECDSA+SHA512:Ed25519:Ed448:RSA-PSS+SHA256:RSA-PSS+SHA384:RSA-PSS+SHA512:RSA-PSS+SHA256:RSA-PSS+SHA384:RSA-PSS+SHA512:RSA+SHA256:RSA+SHA384:RSA+SHA512 Peer signing digest: SHA512 Peer signature type: ECDSA Server Temp Key: X25519, 253 bits --- SSL handshake has read 1334 bytes and written 403 bytes Verification error: unable to verify the first certificate --- New, TLSv1.3, Cipher is TLS_AES_256_GCM_SHA384 Server public key is 521 bit This TLS version forbids renegotiation. Compression: NONE Expansion: NONE No ALPN negotiated Early data was not sent Verify return code: 21 (unable to verify the first certificate) --- read:errno=10054 What I'm doing wrong, what am I missing to get such a simple setup up and running?! Thanks!