pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

new SSL plugin for OpenSSL with CAPI Windows certificate storage (by Pepak)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@234 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
2021-06-23 17:30:09 +00:00
parent 9eba46e654
commit b2cdc37595
2 changed files with 1582 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

675
Crypt32.pas Normal file
View File

@@ -0,0 +1,675 @@
{==============================================================================|
| Project : Ararat Synapse | 001.000.000 |
|==============================================================================|
| Content: minimal support for crypt32 windows API |
|==============================================================================|
| Copyright (c)2018, Pepak |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
| modification, are permitted provided that the following conditions are met: |
| |
| Redistributions of source code must retain the above copyright notice, this |
| list of conditions and the following disclaimer. |
| |
| Redistributions in binary form must reproduce the above copyright notice, |
| this list of conditions and the following disclaimer in the documentation |
| and/or other materials provided with the distribution. |
| |
| Neither the name of Lukas Gebauer nor the names of its contributors may |
| be used to endorse or promote products derived from this software without |
| specific prior written permission. |
| |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Pepak (Czech Republic). |
| Portions created by Pepak are Copyright (c)2018. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
unit Crypt32;
// Pozor, tohle je naprosto minimalni mnozina toho, co Crypt32.dll nabizi.
// Prevedl jsem jen to, co jsem potreboval.
interface
uses
Windows;
const
AdvapiLib = 'advapi32.dll';
CryptoLib = 'crypt32.dll';
CryptDlgLib = 'cryptdlg.dll';
type
HCERTSTORE = THandle;
HCRYPTPROV = THandle;
HCRYPTKEY = THandle;
PCRYPT_DATA_BLOB = ^CRYPT_DATA_BLOB;
CRYPT_DATA_BLOB = record
cbData: DWORD;
pbData: PByte;
end;
const
CRYPT_EXPORTABLE = $00000001;
CRYPT_USER_PROTECTED = $00000002;
CRYPT_MACHINE_KEYSET = $00000020;
CRYPT_USER_KEYSET = $00001000;
const
PKCS12_PREFER_CNG_KSP = $00000100;
PKCS12_ALWAYS_CNG_KSP = $00000200;
PKCS12_ALLOW_OVERWRITE_KEY = $00004000;
PKCS12_NO_PERSIST_KEY = $00008000;
PKCS12_INCLUDE_EXTENDED_PROPERTIES = $0010;
type
CRYPT_ALGORITHM_IDENTIFIER = record
pszObjId: PAnsiChar;
Parameters: CRYPT_DATA_BLOB;
end;
CERT_PUBLIC_KEY_INFO = record
Algorithm: CRYPT_ALGORITHM_IDENTIFIER;
PublicKey: CRYPT_DATA_BLOB;
end;
PCERT_EXTENSION = ^CERT_EXTENSION;
CERT_EXTENSION = record
pszObjId: PAnsiChar;
bCritical: BOOL;
Value: CRYPT_DATA_BLOB;
end;
PCERT_INFO = ^CERT_INFO;
CERT_INFO = record
dwVersion: DWORD;
SerialNumber: CRYPT_DATA_BLOB;
SignatureAlgorithm: CRYPT_ALGORITHM_IDENTIFIER;
Issuer: CRYPT_DATA_BLOB;
NotBefore: FILETIME;
NotAfter: FILETIME;
Subject: CRYPT_DATA_BLOB;
SubjectPublicKeyInfo: CERT_PUBLIC_KEY_INFO;
IssuerUniqueId: CRYPT_DATA_BLOB;
SubjectUniqueId: CRYPT_DATA_BLOB;
cExtension: DWORD;
rgExtension: PCERT_EXTENSION;
end;
PPCCERT_CONTEXT = ^PCCERT_CONTEXT;
PCCERT_CONTEXT = ^CERT_CONTEXT;
CERT_CONTEXT = record
dwCertEncodingType: DWORD;
pbCertEncoded: PByte;
cbCertEncoded: DWORD;
pCertInfo: PCERT_INFO;
hCertStore: HCERTSTORE;
end;
PCRYPT_KEY_PROV_PARAM = ^CRYPT_KEY_PROV_PARAM;
CRYPT_KEY_PROV_PARAM = record
dwParam: DWORD;
pbData: PByte;
cbData: DWORD;
dwFlags: DWORD;
end;
PCRYPT_KEY_PROV_INFO = ^CRYPT_KEY_PROV_INFO;
CRYPT_KEY_PROV_INFO = record
pwszContainerName: PWideChar;
pwszProvName: PWideChar;
dwProvType: DWORD;
dwFlags: DWORD;
cProvParam: DWORD;
rgProvParam: PCRYPT_KEY_PROV_PARAM;
dwKeySpec: DWORD;
__dummy: array[0..65535] of byte;
end;
PCRYPT_HASH_BLOB = ^CRYPT_HASH_BLOB;
CRYPT_HASH_BLOB = record
cbData: DWORD;
pbData: Pointer;
end;
PCRL_ENTRY = ^CRL_ENTRY;
CRL_ENTRY = record
SerialNumber: CRYPT_DATA_BLOB;
RevocationDate: FILETIME;
cExtension: DWORD;
rgExtension: PCERT_EXTENSION;
end;
PCRL_INFO = ^CRL_INFO;
CRL_INFO = record
dwVersion: DWORD;
SignatureAlgorithm: CRYPT_ALGORITHM_IDENTIFIER;
Issuer: CRYPT_DATA_BLOB;
ThisUpdate: FILETIME;
NextUpdate: FILETIME;
cCRLEntry: DWORD;
rgCRLEntry: PCRL_ENTRY;
cExtension: DWORD;
rgExtension: PCERT_EXTENSION;
end;
PCCRL_CONTEXT = ^CRL_CONTEXT;
CRL_CONTEXT = record
dwCertEncodingType: DWORD;
pbCrlEncoded: Pointer;
cbCrlEncoded: DWORD;
pCrlInfo: PCRL_INFO;
hCertStore: HCERTSTORE;
end;
PCRYPT_ATTRIBUTE = ^CRYPT_ATTRIBUTE;
CRYPT_ATTRIBUTE = record
pszObjId: LPSTR;
cValue: DWORD;
rgValue: PCRYPT_DATA_BLOB;
end;
PCRYPT_SIGN_MESSAGE_PARA = ^CRYPT_SIGN_MESSAGE_PARA;
CRYPT_SIGN_MESSAGE_PARA = record
cbSize: DWORD;
dwMsgEncodingType: DWORD;
pSigningCert: PCCERT_CONTEXT;
HashAlgorithm: CRYPT_ALGORITHM_IDENTIFIER;
pvHashAuxInfo: Pointer;
cMsgCert: DWORD;
rgpMsgCert: PCCERT_CONTEXT;
cMsgCrl: DWORD;
rgpMsgCrl: PCCRL_CONTEXT;
cAuthAttr: DWORD;
rgAuthAttr: PCRYPT_ATTRIBUTE;
cUnauthAttr: DWORD;
rgUnauthAttr: PCRYPT_ATTRIBUTE;
dwFlags: DWORD;
dwInnerContentType: DWORD;
HashEncryptionAlgorithm: CRYPT_ALGORITHM_IDENTIFIER;
pvHashEncryptionAuxInfo: Pointer;
end;
PPtrArray = ^TPtrArray;
TPtrArray = array[0..32767] of Pointer;
PDWORDArray = ^TDWORDArray;
TDWORDArray = array[0..32767] of DWORD;
const
CERT_STORE_PROV_MSG = LPCSTR(1);
CERT_STORE_PROV_MEMORY = LPCSTR(2);
CERT_STORE_PROV_FILE = LPCSTR(3);
CERT_STORE_PROV_REG = LPCSTR(4);
CERT_STORE_PROV_PKCS7 = LPCSTR(5);
CERT_STORE_PROV_SERIALIZED = LPCSTR(6);
CERT_STORE_PROV_FILENAME_A = LPCSTR(7);
CERT_STORE_PROV_FILENAME_W = LPCSTR(8);
CERT_STORE_PROV_FILENAME = CERT_STORE_PROV_FILENAME_W;
CERT_STORE_PROV_SYSTEM_A = LPCSTR(9);
CERT_STORE_PROV_SYSTEM_W = LPCSTR(10);
CERT_STORE_PROV_SYSTEM = CERT_STORE_PROV_SYSTEM_W;
CERT_STORE_PROV_COLLECTION = LPCSTR(11);
CERT_STORE_PROV_SYSTEM_REGISTRY_A = LPCSTR(12);
CERT_STORE_PROV_SYSTEM_REGISTRY_W = LPCSTR(13);
CERT_STORE_PROV_SYSTEM_REGISTRY = CERT_STORE_PROV_SYSTEM_REGISTRY_W;
CERT_STORE_PROV_PHYSICAL_W = LPCSTR(14);
CERT_STORE_PROV_PHYSICAL = CERT_STORE_PROV_PHYSICAL_W;
CERT_STORE_PROV_SMART_CARD_W = LPCSTR(15);
CERT_STORE_PROV_SMART_CARD = CERT_STORE_PROV_SMART_CARD_W;
CERT_STORE_PROV_LDAP_W = LPCSTR(16);
CERT_STORE_PROV_LDAP = CERT_STORE_PROV_LDAP_W;
sz_CERT_STORE_PROV_MEMORY = 'Memory';
sz_CERT_STORE_PROV_FILENAME_W = 'File';
sz_CERT_STORE_PROV_FILENAME = sz_CERT_STORE_PROV_FILENAME_W;
sz_CERT_STORE_PROV_SYSTEM_W = 'System';
sz_CERT_STORE_PROV_SYSTEM = sz_CERT_STORE_PROV_SYSTEM_W;
sz_CERT_STORE_PROV_PKCS7 = 'PKCS7';
sz_CERT_STORE_PROV_SERIALIZED = 'Serialized';
sz_CERT_STORE_PROV_COLLECTION = 'Collection';
sz_CERT_STORE_PROV_SYSTEM_REGISTRY_W = 'SystemRegistry';
sz_CERT_STORE_PROV_SYSTEM_REGISTRY = sz_CERT_STORE_PROV_SYSTEM_REGISTRY_W;
sz_CERT_STORE_PROV_PHYSICAL_W = 'Physical';
sz_CERT_STORE_PROV_PHYSICAL = sz_CERT_STORE_PROV_PHYSICAL_W;
sz_CERT_STORE_PROV_SMART_CARD_W = 'SmartCard';
sz_CERT_STORE_PROV_SMART_CARD = sz_CERT_STORE_PROV_SMART_CARD_W;
sz_CERT_STORE_PROV_LDAP_W = 'Ldap';
sz_CERT_STORE_PROV_LDAP = sz_CERT_STORE_PROV_LDAP_W;
const
X509_ASN_ENCODING = 1;
PKCS_7_ASN_ENCODING = 65536;
const
CERT_SYSTEM_STORE_UNPROTECTED_FLAG = $40000000;
CERT_SYSTEM_STORE_LOCATION_MASK = $ff0000;
CERT_SYSTEM_STORE_LOCATION_SHIFT = 16;
CERT_SYSTEM_STORE_CURRENT_USER_ID = 1;
CERT_SYSTEM_STORE_LOCAL_MACHINE_ID = 2;
CERT_SYSTEM_STORE_CURRENT_SERVICE_ID = 4;
CERT_SYSTEM_STORE_SERVICES_ID = 5;
CERT_SYSTEM_STORE_USERS_ID = 6;
CERT_SYSTEM_STORE_CURRENT_USER_GROUP_POLICY_ID = 7;
CERT_SYSTEM_STORE_LOCAL_MACHINE_GROUP_POLICY_ID = 8;
CERT_SYSTEM_STORE_LOCAL_MACHINE_ENTERPRISE_ID = 9;
CERT_SYSTEM_STORE_CURRENT_USER = (CERT_SYSTEM_STORE_CURRENT_USER_ID shl CERT_SYSTEM_STORE_LOCATION_SHIFT);
CERT_SYSTEM_STORE_LOCAL_MACHINE = (CERT_SYSTEM_STORE_LOCAL_MACHINE_ID shl CERT_SYSTEM_STORE_LOCATION_SHIFT);
CERT_SYSTEM_STORE_CURRENT_SERVICE = (CERT_SYSTEM_STORE_CURRENT_SERVICE_ID shl CERT_SYSTEM_STORE_LOCATION_SHIFT);
CERT_SYSTEM_STORE_SERVICES = (CERT_SYSTEM_STORE_SERVICES_ID shl CERT_SYSTEM_STORE_LOCATION_SHIFT);
CERT_SYSTEM_STORE_USERS = (CERT_SYSTEM_STORE_USERS_ID shl CERT_SYSTEM_STORE_LOCATION_SHIFT);
CERT_SYSTEM_STORE_CURRENT_USER_GROUP_POLICY = (CERT_SYSTEM_STORE_CURRENT_USER_GROUP_POLICY_ID shl CERT_SYSTEM_STORE_LOCATION_SHIFT);
CERT_SYSTEM_STORE_LOCAL_MACHINE_GROUP_POLICY = (CERT_SYSTEM_STORE_LOCAL_MACHINE_GROUP_POLICY_ID shl CERT_SYSTEM_STORE_LOCATION_SHIFT);
CERT_SYSTEM_STORE_LOCAL_MACHINE_ENTERPRISE = (CERT_SYSTEM_STORE_LOCAL_MACHINE_ENTERPRISE_ID shl CERT_SYSTEM_STORE_LOCATION_SHIFT);
CERT_STORE_READONLY_FLAG = $8000;
const
CERT_FIND_ANY = 0;
CERT_FIND_CERT_ID = 1048576;
CERT_FIND_CTL_USAGE = 655360;
CERT_FIND_ENHKEY_USAGE = 655360;
CERT_FIND_EXISTING = 851968;
CERT_FIND_HASH = 65536;
CERT_FIND_ISSUER_ATTR = 196612;
CERT_FIND_ISSUER_NAME = 131076;
CERT_FIND_ISSUER_OF = 786432;
CERT_FIND_KEY_IDENTIFIER = 983040;
CERT_FIND_KEY_SPEC = 589824;
CERT_FIND_MD5_HASH = 262144;
CERT_FIND_PROPERTY = 327680;
CERT_FIND_PUBLIC_KEY = 393216;
CERT_FIND_SHA1_HASH = 65536;
CERT_FIND_SIGNATURE_HASH = 917504;
CERT_FIND_SUBJECT_ATTR = 196615;
CERT_FIND_SUBJECT_CERT = 720896;
CERT_FIND_SUBJECT_NAME = 131079;
CERT_FIND_SUBJECT_STR_A = 458759;
CERT_FIND_SUBJECT_STR_W = 524295;
CERT_FIND_ISSUER_STR_A = 458756;
CERT_FIND_ISSUER_STR_W = 524292;
CERT_FIND_OR_ENHKEY_USAGE_FLAG = 16;
CERT_FIND_OPTIONAL_ENHKEY_USAGE_FLAG = 1;
CERT_FIND_NO_ENHKEY_USAGE_FLAG = 8;
CERT_FIND_VALID_ENHKEY_USAGE_FLAG = 32;
CERT_FIND_EXT_ONLY_ENHKEY_USAGE_FLAG = 2;
const
CERT_NAME_EMAIL_TYPE = 1;
CERT_NAME_RDN_TYPE = 2;
CERT_NAME_ATTR_TYPE = 3;
CERT_NAME_SIMPLE_DISPLAY_TYPE = 4;
CERT_NAME_FRIENDLY_DISPLAY_TYPE = 5;
CERT_NAME_DNS_TYPE = 6;
CERT_NAME_URL_TYPE = 7;
CERT_NAME_UPN_TYPE = 8;
const
CERT_NAME_ISSUER_FLAG = 1;
const
CERT_KEY_PROV_HANDLE_PROP_ID = 1;
CERT_KEY_PROV_INFO_PROP_ID = 2;
CERT_SHA1_HASH_PROP_ID = 3;
CERT_MD5_HASH_PROP_ID = 4;
CERT_HASH_PROP_ID = CERT_SHA1_HASH_PROP_ID;
CERT_KEY_CONTEXT_PROP_ID = 5;
CERT_KEY_SPEC_PROP_ID = 6;
CERT_IE30_RESERVED_PROP_ID = 7;
CERT_PUBKEY_HASH_RESERVED_PROP_ID = 8;
CERT_ENHKEY_USAGE_PROP_ID = 9;
CERT_CTL_USAGE_PROP_ID = CERT_ENHKEY_USAGE_PROP_ID;
CERT_NEXT_UPDATE_LOCATION_PROP_ID = 10;
CERT_FRIENDLY_NAME_PROP_ID = 11;
CERT_PVK_FILE_PROP_ID = 12;
CERT_DESCRIPTION_PROP_ID = 13;
CERT_ACCESS_STATE_PROP_ID = 14;
CERT_SIGNATURE_HASH_PROP_ID = 15;
CERT_SMART_CARD_DATA_PROP_ID = 16;
CERT_EFS_PROP_ID = 17;
CERT_FORTEZZA_DATA_PROP_ID = 18;
CERT_ARCHIVED_PROP_ID = 19;
CERT_KEY_IDENTIFIER_PROP_ID = 20;
CERT_AUTO_ENROLL_PROP_ID = 21;
CERT_PUBKEY_ALG_PARA_PROP_ID = 22;
CERT_CROSS_CERT_DIST_POINTS_PROP_ID = 23;
CERT_ISSUER_PUBLIC_KEY_MD5_HASH_PROP_ID = 24;
CERT_SUBJECT_PUBLIC_KEY_MD5_HASH_PROP_ID = 25;
CERT_ENROLLMENT_PROP_ID = 26;
CERT_DATE_STAMP_PROP_ID = 27;
CERT_ISSUER_SERIAL_NUMBER_MD5_HASH_PROP_ID = 28;
CERT_SUBJECT_NAME_MD5_HASH_PROP_ID = 29;
CERT_EXTENDED_ERROR_INFO_PROP_ID = 30;
CERT_RENEWAL_PROP_ID = 64;
CERT_ARCHIVED_KEY_HASH_PROP_ID = 65;
CERT_AUTO_ENROLL_RETRY_PROP_ID = 66;
CERT_AIA_URL_RETRIEVED_PROP_ID = 67;
CERT_AUTHORITY_INFO_ACCESS_PROP_ID = 68;
CERT_BACKED_UP_PROP_ID = 69;
CERT_OCSP_RESPONSE_PROP_ID = 70;
CERT_REQUEST_ORIGINATOR_PROP_ID = 71;
CERT_SOURCE_LOCATION_PROP_ID = 72;
CERT_SOURCE_URL_PROP_ID = 73;
CERT_NEW_KEY_PROP_ID = 74;
CERT_OCSP_CACHE_PREFIX_PROP_ID = 75;
CERT_SMART_CARD_ROOT_INFO_PROP_ID = 76;
CERT_NO_AUTO_EXPIRE_CHECK_PROP_ID = 77;
CERT_NCRYPT_KEY_HANDLE_PROP_ID = 78;
CERT_HCRYPTPROV_OR_NCRYPT_KEY_HANDLE_PROP_ID = 79;
CERT_SUBJECT_INFO_ACCESS_PROP_ID = 80;
CERT_CA_OCSP_AUTHORITY_INFO_ACCESS_PROP_ID = 81;
CERT_CA_DISABLE_CRL_PROP_ID = 82;
CERT_ROOT_PROGRAM_CERT_POLICIES_PROP_ID = 83;
CERT_ROOT_PROGRAM_NAME_CONSTRAINTS_PROP_ID = 84;
CERT_SUBJECT_OCSP_AUTHORITY_INFO_ACCESS_PROP_ID = 85;
CERT_SUBJECT_DISABLE_CRL_PROP_ID = 86;
CERT_CEP_PROP_ID = 87;
CERT_SIGN_HASH_CNG_ALG_PROP_ID = 89;
CERT_SCARD_PIN_ID_PROP_ID = 90;
CERT_SCARD_PIN_INFO_PROP_ID = 91;
CERT_SUBJECT_PUB_KEY_BIT_LENGTH_PROP_ID = 92;
CERT_PUB_KEY_CNG_ALG_BIT_LENGTH_PROP_ID = 93;
CERT_ISSUER_PUB_KEY_BIT_LENGTH_PROP_ID = 94;
CERT_ISSUER_CHAIN_SIGN_HASH_CNG_ALG_PROP_ID = 95;
CERT_ISSUER_CHAIN_PUB_KEY_CNG_ALG_BIT_LENGTH_PROP_ID = 96;
CERT_NO_EXPIRE_NOTIFICATION_PROP_ID = 97;
CERT_AUTH_ROOT_SHA256_HASH_PROP_ID = 98;
CERT_NCRYPT_KEY_HANDLE_TRANSFER_PROP_ID = 99;
CERT_HCRYPTPROV_TRANSFER_PROP_ID = 100;
CERT_SMART_CARD_READER_PROP_ID = 101;
CERT_SEND_AS_TRUSTED_ISSUER_PROP_ID = 102;
CERT_KEY_REPAIR_ATTEMPTED_PROP_ID = 103;
CERT_DISALLOWED_FILETIME_PROP_ID = 104;
CERT_ROOT_PROGRAM_CHAIN_POLICIES_PROP_ID = 105;
CERT_SMART_CARD_READER_NON_REMOVABLE_PROP_ID = 106;
CERT_FIRST_RESERVED_PROP_ID = 107;
CERT_LAST_RESERVED_PROP_ID = $00007fff;
CERT_FIRST_USER_PROP_ID = $8000;
CERT_LAST_USER_PROP_ID = $0000ffff;
const
CRYPT_DELETEKEYSET = 16;
const
CRYPT_E_NOT_FOUND = $80092004;
const
CRYPT_ACQUIRE_CACHE_FLAG = $1;
CRYPT_ACQUIRE_USE_PROV_INFO_FLAG = $2;
CRYPT_ACQUIRE_COMPARE_KEY_FLAG = $4;
CRYPT_ACQUIRE_NO_HEALING = $8;
CRYPT_ACQUIRE_SILENT_FLAG = $40;
CRYPT_ACQUIRE_WINDOW_HANDLE_FLAG = $80;
CRYPT_ACQUIRE_NCRYPT_KEY_FLAGS_MASK = $70000;
CRYPT_ACQUIRE_ALLOW_NCRYPT_KEY_FLAG = $10000;
CRYPT_ACQUIRE_PREFER_NCRYPT_KEY_FLAG = $20000;
CRYPT_ACQUIRE_ONLY_NCRYPT_KEY_FLAG = $40000;
const
szOID_RSA = '1.2.840.113549';
szOID_PKCS = '1.2.840.113549.1';
szOID_RSA_HASH = '1.2.840.113549.2';
szOID_RSA_ENCRYPT = '1.2.840.113549.3';
szOID_PKCS_1 = '1.2.840.113549.1.1';
szOID_PKCS_2 = '1.2.840.113549.1.2';
szOID_PKCS_3 = '1.2.840.113549.1.3';
szOID_PKCS_4 = '1.2.840.113549.1.4';
szOID_PKCS_5 = '1.2.840.113549.1.5';
szOID_PKCS_6 = '1.2.840.113549.1.6';
szOID_PKCS_7 = '1.2.840.113549.1.7';
szOID_PKCS_8 = '1.2.840.113549.1.8';
szOID_PKCS_9 = '1.2.840.113549.1.9';
szOID_PKCS_10 = '1.2.840.113549.1.10';
szOID_PKCS_12 = '1.2.840.113549.1.12';
szOID_RSA_RSA = '1.2.840.113549.1.1.1';
szOID_RSA_MD2RSA = '1.2.840.113549.1.1.2';
szOID_RSA_MD4RSA = '1.2.840.113549.1.1.3';
szOID_RSA_MD5RSA = '1.2.840.113549.1.1.4';
szOID_RSA_SHA1RSA = '1.2.840.113549.1.1.5';
szOID_RSA_SETOAEP_RSA = '1.2.840.113549.1.1.6';
szOID_RSAES_OAEP = '1.2.840.113549.1.1.7';
szOID_RSA_MGF1 = '1.2.840.113549.1.1.8';
szOID_RSA_PSPECIFIED = '1.2.840.113549.1.1.9';
szOID_RSA_SSA_PSS = '1.2.840.113549.1.1.10';
szOID_RSA_SHA256RSA = '1.2.840.113549.1.1.11';
szOID_RSA_SHA384RSA = '1.2.840.113549.1.1.12';
szOID_RSA_SHA512RSA = '1.2.840.113549.1.1.13';
szOID_RSA_DH = '1.2.840.113549.1.3.1';
szOID_RSA_data = '1.2.840.113549.1.7.1';
szOID_RSA_signedData = '1.2.840.113549.1.7.2';
szOID_RSA_envelopedData = '1.2.840.113549.1.7.3';
szOID_RSA_signEnvData = '1.2.840.113549.1.7.4';
szOID_RSA_digestedData = '1.2.840.113549.1.7.5';
szOID_RSA_hashedData = '1.2.840.113549.1.7.5';
szOID_RSA_encryptedData = '1.2.840.113549.1.7.6';
szOID_RSA_emailAddr = '1.2.840.113549.1.9.1';
szOID_RSA_unstructName = '1.2.840.113549.1.9.2';
szOID_RSA_contentType = '1.2.840.113549.1.9.3';
szOID_RSA_messageDigest = '1.2.840.113549.1.9.4';
szOID_RSA_signingTime = '1.2.840.113549.1.9.5';
szOID_RSA_counterSign = '1.2.840.113549.1.9.6';
szOID_RSA_challengePwd = '1.2.840.113549.1.9.7';
szOID_RSA_unstructAddr = '1.2.840.113549.1.9.8';
szOID_RSA_extCertAttrs = '1.2.840.113549.1.9.9';
szOID_RSA_certExtensions = '1.2.840.113549.1.9.14';
szOID_RSA_SMIMECapabilities = '1.2.840.113549.1.9.15';
szOID_RSA_preferSignedData = '1.2.840.113549.1.9.15.1';
szOID_TIMESTAMP_TOKEN = '1.2.840.113549.1.9.16.1.4';
szOID_RFC3161_counterSign = '1.3.6.1.4.1.311.3.3.1';
szOID_RSA_SMIMEalg = '1.2.840.113549.1.9.16.3';
szOID_RSA_SMIMEalgESDH = '1.2.840.113549.1.9.16.3.5';
szOID_RSA_SMIMEalgCMS3DESwrap = '1.2.840.113549.1.9.16.3.6';
szOID_RSA_SMIMEalgCMSRC2wrap = '1.2.840.113549.1.9.16.3.7';
szOID_RSA_MD2 = '1.2.840.113549.2.2';
szOID_RSA_MD4 = '1.2.840.113549.2.4';
szOID_RSA_MD5 = '1.2.840.113549.2.5';
szOID_RSA_RC2CBC = '1.2.840.113549.3.2';
szOID_RSA_RC4 = '1.2.840.113549.3.4';
szOID_RSA_DES_EDE3_CBC = '1.2.840.113549.3.7';
szOID_RSA_RC5_CBCPad = '1.2.840.113549.3.9';
szOID_ANSI_X942 = '1.2.840.10046';
szOID_ANSI_X942_DH = '1.2.840.10046.2.1';
szOID_X957 = '1.2.840.10040';
szOID_X957_DSA = '1.2.840.10040.4.1';
szOID_X957_SHA1DSA = '1.2.840.10040.4.3';
szOID_ECC_PUBLIC_KEY = '1.2.840.10045.2.1';
szOID_ECC_CURVE_P256 = '1.2.840.10045.3.1.7';
szOID_ECC_CURVE_P384 = '1.3.132.0.34';
szOID_ECC_CURVE_P521 = '1.3.132.0.35';
szOID_ECDSA_SHA1 = '1.2.840.10045.4.1';
szOID_ECDSA_SPECIFIED = '1.2.840.10045.4.3';
szOID_ECDSA_SHA256 = '1.2.840.10045.4.3.2';
szOID_ECDSA_SHA384 = '1.2.840.10045.4.3.3';
szOID_ECDSA_SHA512 = '1.2.840.10045.4.3.4';
szOID_NIST_AES128_CBC = '2.16.840.1.101.3.4.1.2';
szOID_NIST_AES192_CBC = '2.16.840.1.101.3.4.1.22';
szOID_NIST_AES256_CBC = '2.16.840.1.101.3.4.1.42';
szOID_NIST_AES128_WRAP = '2.16.840.1.101.3.4.1.5';
szOID_NIST_AES192_WRAP = '2.16.840.1.101.3.4.1.25';
szOID_NIST_AES256_WRAP = '2.16.840.1.101.3.4.1.45';
szOID_DH_SINGLE_PASS_STDDH_SHA1_KDF = '1.3.133.16.840.63.0.2';
szOID_DH_SINGLE_PASS_STDDH_SHA256_KDF = '1.3.132.1.11.1';
szOID_DH_SINGLE_PASS_STDDH_SHA384_KDF = '1.3.132.1.11.2';
szOID_DS = '2.5';
szOID_DSALG = '2.5.8';
szOID_DSALG_CRPT = '2.5.8.1';
szOID_DSALG_HASH = '2.5.8.2';
szOID_DSALG_SIGN = '2.5.8.3';
szOID_DSALG_RSA = '2.5.8.1.1';
szOID_OIW = '1.3.14';
szOID_OIWSEC = '1.3.14.3.2';
szOID_OIWSEC_md4RSA = '1.3.14.3.2.2';
szOID_OIWSEC_md5RSA = '1.3.14.3.2.3';
szOID_OIWSEC_md4RSA2 = '1.3.14.3.2.4';
szOID_OIWSEC_desECB = '1.3.14.3.2.6';
szOID_OIWSEC_desCBC = '1.3.14.3.2.7';
szOID_OIWSEC_desOFB = '1.3.14.3.2.8';
szOID_OIWSEC_desCFB = '1.3.14.3.2.9';
szOID_OIWSEC_desMAC = '1.3.14.3.2.10';
szOID_OIWSEC_rsaSign = '1.3.14.3.2.11';
szOID_OIWSEC_dsa = '1.3.14.3.2.12';
szOID_OIWSEC_shaDSA = '1.3.14.3.2.13';
szOID_OIWSEC_mdc2RSA = '1.3.14.3.2.14';
szOID_OIWSEC_shaRSA = '1.3.14.3.2.15';
szOID_OIWSEC_dhCommMod = '1.3.14.3.2.16';
szOID_OIWSEC_desEDE = '1.3.14.3.2.17';
szOID_OIWSEC_sha = '1.3.14.3.2.18';
szOID_OIWSEC_mdc2 = '1.3.14.3.2.19';
szOID_OIWSEC_dsaComm = '1.3.14.3.2.20';
szOID_OIWSEC_dsaCommSHA = '1.3.14.3.2.21';
szOID_OIWSEC_rsaXchg = '1.3.14.3.2.22';
szOID_OIWSEC_keyHashSeal = '1.3.14.3.2.23';
szOID_OIWSEC_md2RSASign = '1.3.14.3.2.24';
szOID_OIWSEC_md5RSASign = '1.3.14.3.2.25';
szOID_OIWSEC_sha1 = '1.3.14.3.2.26';
szOID_OIWSEC_dsaSHA1 = '1.3.14.3.2.27';
szOID_OIWSEC_dsaCommSHA1 = '1.3.14.3.2.28';
szOID_OIWSEC_sha1RSASign = '1.3.14.3.2.29';
szOID_OIWDIR = '1.3.14.7.2';
szOID_OIWDIR_CRPT = '1.3.14.7.2.1';
szOID_OIWDIR_HASH = '1.3.14.7.2.2';
szOID_OIWDIR_SIGN = '1.3.14.7.2.3';
szOID_OIWDIR_md2 = '1.3.14.7.2.2.1';
szOID_OIWDIR_md2RSA = '1.3.14.7.2.3.1';
szOID_INFOSEC = '2.16.840.1.101.2.1';
szOID_INFOSEC_sdnsSignature = '2.16.840.1.101.2.1.1.1';
szOID_INFOSEC_mosaicSignature = '2.16.840.1.101.2.1.1.2';
szOID_INFOSEC_sdnsConfidentiality = '2.16.840.1.101.2.1.1.3';
szOID_INFOSEC_mosaicConfidentiality = '2.16.840.1.101.2.1.1.4';
szOID_INFOSEC_sdnsIntegrity = '2.16.840.1.101.2.1.1.5';
szOID_INFOSEC_mosaicIntegrity = '2.16.840.1.101.2.1.1.6';
szOID_INFOSEC_sdnsTokenProtection = '2.16.840.1.101.2.1.1.7';
szOID_INFOSEC_mosaicTokenProtection = '2.16.840.1.101.2.1.1.8';
szOID_INFOSEC_sdnsKeyManagement = '2.16.840.1.101.2.1.1.9';
szOID_INFOSEC_mosaicKeyManagement = '2.16.840.1.101.2.1.1.10';
szOID_INFOSEC_sdnsKMandSig = '2.16.840.1.101.2.1.1.11';
szOID_INFOSEC_mosaicKMandSig = '2.16.840.1.101.2.1.1.12';
szOID_INFOSEC_SuiteASignature = '2.16.840.1.101.2.1.1.13';
szOID_INFOSEC_SuiteAConfidentiality = '2.16.840.1.101.2.1.1.14';
szOID_INFOSEC_SuiteAIntegrity = '2.16.840.1.101.2.1.1.15';
szOID_INFOSEC_SuiteATokenProtection = '2.16.840.1.101.2.1.1.16';
szOID_INFOSEC_SuiteAKeyManagement = '2.16.840.1.101.2.1.1.17';
szOID_INFOSEC_SuiteAKMandSig = '2.16.840.1.101.2.1.1.18';
szOID_INFOSEC_mosaicUpdatedSig = '2.16.840.1.101.2.1.1.19';
szOID_INFOSEC_mosaicKMandUpdSig = '2.16.840.1.101.2.1.1.20';
szOID_INFOSEC_mosaicUpdatedInteg = '2.16.840.1.101.2.1.1.21';
szOID_NIST_sha256 = '2.16.840.1.101.3.4.2.1';
szOID_NIST_sha384 = '2.16.840.1.101.3.4.2.2';
szOID_NIST_sha512 = '2.16.840.1.101.3.4.2.3';
const
CERT_STORE_ADD_NEW = 1;
CERT_STORE_ADD_USE_EXISTING = 2;
CERT_STORE_ADD_REPLACE_EXISTING = 3;
CERT_STORE_ADD_ALWAYS = 4;
CERT_STORE_ADD_REPLACE_EXISTING_INHERIT_PROPERTIES = 5;
CERT_STORE_ADD_NEWER = 6;
CERT_STORE_ADD_NEWER_INHERIT_PROPERTIES = 7;
function PFXImportCertStore(pPFX: PCRYPT_DATA_BLOB; szPassword: PWideChar; dwFlags: DWORD): HCERTSTORE; stdcall; external CryptoLib;
function CertOpenSystemStore(hProv: HCRYPTPROV; szSubsystemProtocol: PChar): HCERTSTORE; stdcall; external CryptoLib name {$IFDEF UNICODE} 'CertOpenSystemStoreW' {$ELSE} 'CertOpenSystemStoreA' {$ENDIF} ;
function CertOpenStore(szStoreProvider: LPCSTR; dwMsgAndCertEncodingType: DWORD; hCryptProv: HCRYPTPROV; dwFlags: DWORD; pvPara: Pointer): HCERTSTORE; stdcall; external CryptoLib name 'CertOpenStore';
function CertCloseStore(hCertStore: HCERTSTORE; dwFlags: DWORD): BOOL; stdcall; external CryptoLib;
function CertEnumCertificatesInStore(hCertStore: HCERTSTORE; pPrevCertContext: PCCERT_CONTEXT): PCCERT_CONTEXT; stdcall; external CryptoLib;
function CertFindCertificateInStore(hCertStore: HCERTSTORE; dwCertEncodingType: DWORD; dwFindFlags: DWORD; dwFindType: DWORD; pvFindPara: Pointer; pPrevCertContext: PCCERT_CONTEXT): PCCERT_CONTEXT; stdcall; external CryptoLib;
function CertFreeCertificateContext(pCertContext: PCCERT_CONTEXT): BOOL; stdcall; external CryptoLib;
function CertDuplicateCertificateContext(pCertContext: PCCERT_CONTEXT): PCCERT_CONTEXT; stdcall; external CryptoLib;
function CertGetNameStringA(pCertContext: PCCERT_CONTEXT; dwType, dwFlags: DWORD; pvTypePara: Pointer; pszNameString: PAnsiChar; cchNameString: DWORD): DWORD; stdcall; external CryptoLib name 'CertGetNameStringA';
function CertGetNameStringW(pCertContext: PCCERT_CONTEXT; dwType, dwFlags: DWORD; pvTypePara: Pointer; pszNameString: PWideChar; cchNameString: DWORD): DWORD; stdcall; external CryptoLib name 'CertGetNameStringW';
function CertGetNameString(pCertContext: PCCERT_CONTEXT; dwType, dwFlags: DWORD; pvTypePara: Pointer; pszNameString: PChar; cchNameString: DWORD): DWORD; stdcall; external CryptoLib name {$IFDEF UNICODE} 'CertGetNameStringW' {$ELSE} 'CertGetNameStringA' {$ENDIF} ;
function GetFriendlyNameOfCert(pCertContext: PCCERT_CONTEXT; pchBuffer: PChar; cchBuffer: DWORD): DWORD; stdcall; external CryptDlgLib name {$IFDEF UNICODE} 'GetFriendlyNameOfCertW' {$ELSE} 'GetFriendlyNameOfCertA' {$ENDIF} ;
function CertGetCertificateContextProperty(pCertContext: PCCERT_CONTEXT; dwPropId: DWORD; pvData: Pointer; var pcbData: DWORD): BOOL; stdcall; external CryptoLib;
function CryptAcquireContextA(var phProv: HCRYPTPROV; pszContainer, pszProvider: PAnsiChar; dwProvType, dwFlags: DWORD): BOOL; stdcall; external AdvapiLib;
function CryptAcquireContextU(var phProv: HCRYPTPROV; pszContainer, pszProvider: PWideChar; dwProvType, dwFlags: DWORD): BOOL; stdcall; external AdvapiLib name 'CryptAcquireContextW';
function CryptAcquireContextW(var phProv: HCRYPTPROV; pszContainer, pszProvider: PWideChar; dwProvType, dwFlags: DWORD): BOOL; stdcall; external AdvapiLib;
function CryptAcquireContext(var phProv: HCRYPTPROV; pszContainer, pszProvider: PChar; dwProvType, dwFlags: DWORD): BOOL; stdcall; external AdvapiLib name {$IFDEF UNICODE} 'CryptAcquireContextW' {$ELSE} 'CryptAcquireContextA' {$ENDIF} ;
function CryptAcquireCertificatePrivateKey(pCertContext: PCCERT_CONTEXT; dwFlags: DWORD; pvParameters: Pointer; var phCryptProv: HCRYPTPROV; var pdwKeySpec: DWORD; pfCallerFreeProv: PBOOL): BOOL; stdcall; external CryptoLib;
function CertAddCertificateContextToStore(hCertStore: HCERTSTORE; pCertContext: PCCERT_CONTEXT; dwAddDisposition: DWORD; ppStoreContext: PPCCERT_CONTEXT): BOOL; stdcall; external CryptoLib;
function CryptSignMessage(pSignPara: PCRYPT_SIGN_MESSAGE_PARA; fDetachedSignature: BOOL; cToBeSigned: DWORD; rgpbToBeSigned: PPtrArray; rgcbToBeSigned: PDWORDArray; pbSignedBlob: PByte; var pcbSignedBlob: DWORD): BOOL; stdcall external CryptoLib;
function CertGetNameStringPAS(pCertContext: PCCERT_CONTEXT; dwType, dwFlags: DWORD; pvTypePara: Pointer; out Name: string): boolean; overload;
function CertGetNameStringPAS(pCertContext: PCCERT_CONTEXT; dwType, dwFlags: DWORD; pvTypePara: Pointer): string; overload;
function CertGetCertificateContextPropertyPAS(pCertContext: PCCERT_CONTEXT; dwPropId: DWORD; out Data: AnsiString): BOOL; overload;
function CertGetCertificateContextPropertyPAS(pCertContext: PCCERT_CONTEXT; dwPropId: DWORD): AnsiString; overload;
implementation
function CertGetNameStringPAS(pCertContext: PCCERT_CONTEXT; dwType, dwFlags: DWORD; pvTypePara: Pointer; out Name: string): boolean; overload;
var
n: DWORD;
begin
Result := False;
Name := '';
n := CertGetNameString(pCertContext, dwType, dwFlags, pvTypePara, nil, 0);
if n > 0 then
begin
SetLength(Name, n);
n := CertGetNameString(pCertContext, dwType, dwFlags, pvTypePara, @Name[1], n);
if n > 0 then
begin
SetLength(Name, n-1);
Result := True;
end
else
Name := '';
end;
end;
function CertGetNameStringPAS(pCertContext: PCCERT_CONTEXT; dwType, dwFlags: DWORD; pvTypePara: Pointer): string;
begin
if not CertGetNameStringPAS(pCertContext, dwType, dwFlags, pvTypePara, Result) then
Result := '';
end;
function CertGetCertificateContextPropertyPAS(pCertContext: PCCERT_CONTEXT; dwPropId: DWORD; out Data: AnsiString): BOOL;
var
n: DWORD;
begin
Result := False;
Data := '';
n := 0;
if CertGetCertificateContextProperty(pCertContext, dwPropId, nil, n) then
begin
SetLength(Data, n);
if CertGetCertificateContextProperty(pCertContext, dwPropId, @Data[1], n) then
begin
SetLength(Data, n);
Result := True;
end
else
Data := '';
end;
end;
function CertGetCertificateContextPropertyPAS(pCertContext: PCCERT_CONTEXT; dwPropId: DWORD): AnsiString;
begin
if not CertGetCertificateContextPropertyPAS(pCertContext, dwPropId, Result) then
Result := '';
end;
end.

907
ssl_openssl_capi.pas Normal file
View File

@@ -0,0 +1,907 @@
{==============================================================================|
| Project : Ararat Synapse | 001.003.000 |
|==============================================================================|
| Content: SSL support by OpenSSL and the CAPI engine |
|==============================================================================|
| Copyright (c)2018, Pepak |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
| modification, are permitted provided that the following conditions are met: |
| |
| Redistributions of source code must retain the above copyright notice, this |
| list of conditions and the following disclaimer. |
| |
| Redistributions in binary form must reproduce the above copyright notice, |
| this list of conditions and the following disclaimer in the documentation |
| and/or other materials provided with the distribution. |
| |
| Neither the name of Lukas Gebauer nor the names of its contributors may |
| be used to endorse or promote products derived from this software without |
| specific prior written permission. |
| |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Pepak (Czech Republic). |
| Portions created by Pepak are Copyright (c)2018. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
//requires OpenSSL libraries, including the CAPI engine (capi.dll)!
//recommended source: Stunnel (https://www.stunnel.org)
{:@abstract(SSL plugin for OpenSSL and the CAPI engine)
Compatibility with OpenSSL versions:
1.0.2 works fine.
1.1.x does not work properly out of the box. I was never able to get CAPI
to work with pre-built binaries or binaries that I built myself, even in
third party applications such as STunnel. The only config which works for
me involves custom-building OpenSSL with engines statically compiled into
libcrypto:
1) Install PERL (e.g. C:\PERL). Make sure the BIN subdirectory is in
the PATH (SET PATH=%PATH%;C:\PERL\BIN).
2) Download DMAKE ( https://metacpan.org/release/dmake ) and unpack it
into the Perl directory (you will get C:\PERL\DMAKE\DMAKE.EXE and
other files). Add the DMAKE directory to PATH as well.
3) Start Visual Studio Development Prompt, either 32 or 64bit. All the
following commands should be run in this prompt.
4) Install the Text::Template module by running:
cpan -i Text::Template
5) Download and unpack the OpenSSL sources into e.g. C:\SOURCE\OPENSSL.
6) Download and unpack the Zlib sources into e.g. C:\SOURCE\ZLIB.
7) Go to the ZLIB directory and run:
nmake -f win32/Makefile.msc
8) Go to the OpenSSL directory and run:
32bit:
perl Configure shared enable-static-engine enable-zlib --with-zlib-include=C:\SOURCE\ZLIB --with-zlib-lib=C:\SOURCE\ZLIB\zlib.lib VC-WIN32
64bit:
perl Configure shared enable-static-engine enable-zlib --with-zlib-include=C:\SOURCE\ZLIB --with-zlib-lib=C:\SOURCE\ZLIB\zlib.lib VC-WIN64A
Make sure to replace both instances of C:\SOURCE\ZLIB with the actual
path to the Zlib library.
9) If you want to build the OpenSSL DLLs without external dependencies
(e.g. on the Visual Studio Runtime), edit the generated makefile:
- Change the "/MD" flag in CNF_FLAGS to "/MT".
- Add "/NODEFAULTLIB:MSVCRT" to CNF_LDFLAGS.
10) In the OpenSSL directory, run:
nmake
11) When all is done, copy LIBCRYPTO-1_1*.DLL and LIBSSH-1_1*.DLL to
your application's binary directory.
OpenSSL libraries are loaded dynamically - you do not need the librares even if
you compile your application with this unit. SSL just won't work if you don't
have the OpenSSL libraries.
The plugin is built on the standard OpenSSL plugin, giving it all the features
of it. In fact, if you do not have the CAPI engine, the plugin will behave in
exactly the same way as the original plugin - the CAPI engine is completely
optional, the plugin will work without it - obviously without the support for
Windows Certificate Stores.
The windows certificate stores are supported through the following properties:
@link(TSSLOpenSSLCapi.SigningCertificate) - expects pointer to the certificate
context of the signing certificate (PCCERT_CONTENT). @br
Note that due to the limitations of OpenSSL, it is not possible to switch
between different engines (e.g. CAPI and default) on the fly - the engine is
a global setting for the whole of OpenSSL. For that reason, once the engine
is enabled (either explicitly or by using a Windows certificate for a connection),
it will stay enabled and there is no method for disabling it.
}
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$H+}
{$INCLUDE 'jedi.inc'}
{$DEFINE USE_ENGINE_POOL}
unit ssl_openssl_capi;
interface
uses
Windows, Crypt32, SysUtils, Classes, SyncObjs,
blcksock, ssl_openssl, ssl_openssl_lib;
type
PENGINE = Pointer;
type
TWindowsCertStoreLocation = (
wcslCurrentUser
, wcslCurrentUserGroupPolicy
, wcslUsers
, wcslCurrentService
, wcslServices
, wcslLocalMachine
, wcslLocalMachineGroupPolicy
, wcslLocalMachineEnterprise
);
type
{:@abstract(class extending the OpenSSL SSL plugin with CAPI support.)
Instance of this class will be created for each @link(TTCPBlockSocket).
You not need to create instance of this class, all is done by Synapse itself!}
TSSLOpenSSLCapi = class(TSSLOpenSSL)
private
FEngine: PENGINE;
FEngineInitialized: boolean;
FSigningCertificateLocation: TWindowsCertStoreLocation;
FSigningCertificateStore: string;
FSigningCertificateID: string;
function GetEngine: PENGINE;
protected
{:Loads a certificate context into the CAPI engine for signing/decryption.}
function LoadSigningCertificate: boolean;
{:See @inherited}
function SetSslKeys: boolean; override;
{:See @inherited}
function NeedSigningCertificate: boolean; override;
{:Returns true if the signing certificate should be used.}
function SigningCertificateSpecified: boolean;
{:Provides a cryptographic engine for OpenSSL}
property Engine: PENGINE read GetEngine;
public
{:See @inherited}
constructor Create(const Value: TTCPBlockSocket); override;
{:See @inherited}
destructor Destroy; override;
{:See @inherited}
procedure Assign(const Value: TCustomSSL); override;
{:Use this function to load the CAPI engine and/or verify that the engine
is available. The plugin will load CAPI itself when it is needed, so you
may skip this function completely, but it may be useful to perform a manual
CAPI load early during the application startup to make sure all connection
use the same cryptographic engine (and, as a result, behave the same way).}
class function InitEngine: boolean;
{:Location of the certificate store used for the communication.}
property SigningCertificateLocation: TWindowsCertStoreLocation read FSigningCertificateLocation write FSigningCertificateLocation;
{:Certificate store used for the communication. The most common is "MY",
or the user's private certificates.}
property SigningCertificateStore: string read FSigningCertificateStore write FSigningCertificateStore;
{:ID of the certificate to use. For standard CAPI, this is the friendly name
of the certificate. For the client-side SSL it is not really necessary, as
long as it is non-empty (which signifies that the CAPI engine should be
used). For the server side, it must be a substring of the SubjectName of
the certificate. The first matching certificate will be used.}
property SigningCertificateID: string read FSigningCertificateID write FSigningCertificateID;
end;
implementation
{$IFDEF SUPPORTS_REGION}{$REGION 'Support and compatibility functions'}{$ENDIF}
{==============================================================================}
{Support and compatibility functions }
{------------------------------------------------------------------------------}
function GetModuleFileNamePAS(Handle: THandle; out FileName: string): boolean;
var
FN: string;
n: integer;
begin
Result := False;
if Handle = 0 then
Exit;
SetLength(FN, MAX_PATH);
n := GetModuleFileName(Handle, @FN[1], Length(FN));
if (n > 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
begin
SetLength(FN, n);
n := GetModuleFileName(Handle, @FN[1], Length(FN));
end;
if (n > 0) and (GetLastError = ERROR_SUCCESS) then
begin
SetLength(FN, n);
FileName := FN;
Result := True;
end;
end;
{$IFNDEF UNICODE}
type
PPointer = ^Pointer;
procedure RaiseLastOSError;
begin
RaiseLastWin32Error;
end;
{$ENDIF}
{$IFDEF SUPPORTS_REGION}{$ENDREGION}{$ENDIF}
{$IFDEF SUPPORTS_REGION}{$REGION 'Imported functions'}{$ENDIF}
{==============================================================================}
{Imported functions }
{------------------------------------------------------------------------------}
const
CapiEngineID = 'capi';
DLLCapiName = CapiEngineID + '.dll';
const
SSL_CTRL_OPTIONS = 32;
SSL_OP_NO_TLSv1_2 = $08000000;
const
ENGINE_METHOD_ALL = $ffff;
type
PPX509 = ^PX509;
var
FEngineCS: TCriticalSection = nil;
FEngineNeedsSHA2Workaround: boolean = False;
var
FEngineInterfaceInitialized: boolean = False;
FENGINE_cleanup: procedure; cdecl = nil;
FENGINE_load_builtin_engines: procedure; cdecl = nil;
FENGINE_by_id: function(id: PAnsiChar): PENGINE; cdecl = nil;
FENGINE_ctrl_cmd_string: function(e: PENGINE; cmd_name, arg: PAnsiChar; cmd_optional: integer): integer; cdecl = nil;
FENGINE_init: function(e: PENGINE): integer; cdecl = nil;
FENGINE_finish: function(e: PENGINE): integer; cdecl = nil;
FENGINE_free: function(e: PENGINE): integer; cdecl = nil;
FENGINE_set_default: function(e: PENGINE; flags: DWORD): integer; cdecl = nil;
FENGINE_load_private_key: function(e: PENGINE; key_id: PAnsiChar; ui_method: Pointer; callback_data: Pointer): EVP_PKEY; cdecl = nil;
FSSL_CTX_set_client_cert_engine: function(ctx: PSSL_CTX; e: PENGINE): integer; cdecl = nil;
Fd2i_X509: function(px: PPX509; data: PPointer; len: integer): PX509; cdecl = nil;
function InitEngineInterface: boolean;
var
OpenSSLFileName: string;
VerInfoSize: DWORD;
VerInfo: Pointer;
VerHandle: DWORD;
SpecVerInfo: PVsFixedFileInfo;
begin
if FEngineInterfaceInitialized then
begin
Result := True;
Exit;
end;
FEngineCS.Enter;
try
if FEngineInterfaceInitialized then
begin
Result := True;
Exit;
end;
Result := False;
if not InitSSLInterface then
Exit;
if SSLUtilHandle = 0 then
Exit;
if SSLLibHandle = 0 then
Exit;
FENGINE_cleanup := GetProcAddress(SSLUtilHandle, 'ENGINE_cleanup');
FENGINE_load_builtin_engines := GetProcAddress(SSLUtilHandle, 'ENGINE_load_builtin_engines');
FENGINE_by_id := GetProcAddress(SSLUtilHandle, 'ENGINE_by_id');
FENGINE_ctrl_cmd_string := GetProcAddress(SSLUtilHandle, 'ENGINE_ctrl_cmd_string');
FENGINE_init := GetProcAddress(SSLUtilHandle, 'ENGINE_init');
FENGINE_finish := GetProcAddress(SSLUtilHandle, 'ENGINE_finish');
FENGINE_free := GetProcAddress(SSLUtilHandle, 'ENGINE_free');
FENGINE_set_default := GetProcAddress(SSLUtilHandle, 'ENGINE_set_default');
FENGINE_load_private_key := GetProcAddress(SSLUtilHandle, 'ENGINE_load_private_key');
FSSL_CTX_set_client_cert_engine := GetProcAddress(SSLLibHandle, 'SSL_CTX_set_client_cert_engine');
Fd2i_X509 := GetProcAddress(SSLUtilHandle, 'd2i_X509');
FEngineInterfaceInitialized := True;
//---- Workaround for a CAPI engine bug ------------------------------------
// https://www.stunnel.org/pipermail/stunnel-users/2017-February/005720.html
//
// The capi ENGINE in OpenSSL 1.0.2 and earlier uses the CSP attached
// to the key for cryptographic operations. Unfortunately this means that
// SHA2 algorithms are not supported for client authentication.
//
// OpenSSL 1.1.0 adds a workaround for this issue. If you disable TLS 1.2
// in earlier versions of OpenSSL it will not use SHA2 for client auth so
// that will also work.
begin
FEngineNeedsSHA2Workaround := False;
if GetModuleFileNamePAS(SSLUtilHandle, OpenSSLFileName) then
begin
VerInfoSize := GetFileVersionInfoSize(PChar(OpenSSLFileName), VerHandle);
if VerInfoSize > 0 then
begin
GetMem(VerInfo, VerInfoSize);
try
if GetFileVersionInfo(PChar(OpenSSLFileName), VerHandle, VerInfoSize, VerInfo) then
if VerQueryValue(VerInfo, '\', Pointer(SpecVerInfo), VerInfoSize) then
begin
if SpecVerInfo^.dwFileVersionMS < (65536*1 + 1) then
FEngineNeedsSHA2Workaround := True;
end;
finally
FreeMem(VerInfo);
end;
end;
end;
end;
//---- Workaround end ------------------------------------------------------
Result := True;
finally
FEngineCS.Leave;
end;
end;
procedure DestroyEngineInterface;
begin
FEngineCS.Enter;
try
if Assigned(FENGINE_cleanup) then
FENGINE_cleanup;
FENGINE_cleanup := nil;
FENGINE_load_builtin_engines := nil;
FENGINE_by_id := nil;
FENGINE_ctrl_cmd_string := nil;
FENGINE_init := nil;
FENGINE_finish := nil;
FENGINE_free := nil;
FENGINE_set_default := nil;
FENGINE_load_private_key := nil;
FSSL_CTX_set_client_cert_engine := nil;
Fd2i_X509 := nil;
FEngineInterfaceInitialized := False;
finally
FEngineCS.Leave;
end;
end;
procedure ENGINE_load_builtin_engines;
begin
if InitEngineInterface and Assigned(FENGINE_load_builtin_engines) then
FENGINE_load_builtin_engines;
end;
function ENGINE_by_id(id: PAnsiChar): PENGINE;
begin
if InitEngineInterface and Assigned(FENGINE_by_id) then
Result := FENGINE_by_id(id)
else
Result := nil;
end;
function ENGINE_ctrl_cmd_string(e: PENGINE; cmd_name, arg: PAnsiChar; cmd_optional: integer): integer;
begin
if InitEngineInterface and Assigned(FENGINE_ctrl_cmd_string) then
Result := FENGINE_ctrl_cmd_string(e, cmd_name, arg, cmd_optional)
else
Result := 0;
end;
function ENGINE_init(e: PENGINE): integer;
begin
if InitEngineInterface and Assigned(FENGINE_init) then
Result := FENGINE_init(e)
else
Result := 0;
end;
function ENGINE_finish(e: PENGINE): integer;
begin
if InitEngineInterface and Assigned(FENGINE_finish) then
Result := FENGINE_finish(e)
else
Result := 0;
end;
function ENGINE_free(e: PENGINE): integer;
begin
if InitEngineInterface and Assigned(FENGINE_free) then
Result := FENGINE_free(e)
else
Result := 0;
end;
function ENGINE_set_default(e: PENGINE; flags: DWORD): integer;
begin
if InitEngineInterface and Assigned(FENGINE_set_default) then
Result := FENGINE_set_default(e, flags)
else
Result := 0;
end;
function ENGINE_load_private_key(e: PENGINE; key_id: PAnsiChar; ui_method: Pointer; callback_data: Pointer): EVP_PKEY;
begin
if InitEngineInterface and Assigned(FENGINE_load_private_key) then
Result := FENGINE_load_private_key(e, key_id, ui_method, callback_data)
else
Result := nil;
end;
function SSL_CTX_set_client_cert_engine(ctx: PSSL_CTX; e: PENGINE): integer;
begin
if InitEngineInterface and Assigned(FSSL_CTX_set_client_cert_engine) then
Result := FSSL_CTX_set_client_cert_engine(ctx, e)
else
Result := 0;
end;
function d2i_X509(px: PPX509; data: PPointer; len: integer): PX509;
begin
if InitEngineInterface and Assigned(Fd2i_X509) then
Result := Fd2i_X509(px, data, len)
else
Result := nil;
end;
{$IFDEF SUPPORTS_REGION}{$ENDREGION}{$ENDIF}
{$IFDEF SUPPORTS_REGION}{$REGION 'CAPI engine support'}{$ENDIF}
{==============================================================================}
{CAPI engine support }
{------------------------------------------------------------------------------}
var
FGlobalEngineInitialized: boolean = False;
FGlobalEngine: PENGINE = nil;
function PrepareCapiEngine(out Engine: PENGINE): boolean;
function LoadCapiEngine(Engine: PENGINE; const FileName: string): boolean;
begin
Result := False;
if ENGINE_ctrl_cmd_string(Engine, 'SO_PATH', PAnsiChar(AnsiString(FileName)), 0) <> 0 then
if ENGINE_ctrl_cmd_string(Engine, 'LOAD', nil, 0) <> 0 then
Result := True;
end;
function LoadCapiEngineDynamic(out Engine: PENGINE): boolean;
var
OpenSSLFileName: string;
TempEngine: PENGINE;
begin
Result := False;
if not GetModuleFileNamePAS(SSLUtilHandle, OpenSSLFileName) then
Exit;
TempEngine := ENGINE_by_id('dynamic');
try
if TempEngine <> nil then
begin
if LoadCapiEngine(TempEngine, ExtractFilePath(OpenSSLFileName) + DLLCapiName) then // need a version match! Same dir suggests the versions could be the same
if ENGINE_init(TempEngine) <> 0 then
begin
Engine := TempEngine;
TempEngine := nil;
Result := True;
end;
end;
finally
if TempEngine <> nil then
begin
ENGINE_free(TempEngine);
//TempEngine := nil; // triggers a hint
end;
end;
end;
function LoadCapiEngineStatic(out Engine: PENGINE): boolean;
var
TempEngine: PENGINE;
begin
Result := False;
TempEngine := ENGINE_by_id(CapiEngineID);
try
if TempEngine <> nil then
begin
if ENGINE_init(TempEngine) <> 0 then
begin
Engine := TempEngine;
TempEngine := nil;
Result := True;
end;
end;
finally
if TempEngine <> nil then
begin
ENGINE_free(TempEngine);
//TempEngine := nil; // triggers a hint
end;
end;
end;
begin
Result := LoadCapiEngineStatic(Engine) or LoadCapiEngineDynamic(Engine);
end;
function InitCapiEngine: boolean;
var
E: PENGINE;
begin
Result := FGlobalEngine <> nil;
if FGlobalEngineInitialized then
Exit;
FEngineCS.Enter;
try
if FGlobalEngineInitialized then
Exit;
ENGINE_load_builtin_engines();
if PrepareCapiEngine(E) then
begin
if not Assigned(FSSL_CTX_set_client_cert_engine) then
begin
if ENGINE_set_default(E, ENGINE_METHOD_ALL) = 0 then
begin
ENGINE_finish(E);
ENGINE_free(E);
E := nil;
end;
end;
FGlobalEngine := E;
end;
FGlobalEngineInitialized := True;
Result := FGlobalEngine <> nil;
finally
FEngineCS.Leave;
end;
end;
{$IFDEF SUPPORTS_REGION}{$ENDREGION}{$ENDIF}
{$IFDEF SUPPORTS_REGION}{$REGION 'Pool of engines'}{$ENDIF}
{==============================================================================}
{Pool of engines, to reduce the time to get a working connection }
{------------------------------------------------------------------------------}
{$IFDEF USE_ENGINE_POOL}
type
TEnginePool = class
private
fLock: TCriticalSection;
fAvailableList: TList;
protected
procedure Lock;
procedure Unlock;
public
constructor Create;
destructor Destroy; override;
function Acquire(out Engine: PENGINE): boolean;
procedure Release(var Engine: PENGINE);
procedure Clear;
end;
var
FEnginePool: TEnginePool = nil;
{ TEnginePool }
function TEnginePool.Acquire(out Engine: PENGINE): boolean;
var
n: integer;
begin
if fAvailableList.Count > 0 then
begin
Lock;
try
for n := Pred(fAvailableList.Count) downto 0 do
begin
Engine := fAvailableList[n];
if Engine <> nil then
begin
fAvailableList.Delete(n);
Result := True;
Exit;
end;
end;
finally
Unlock;
end;
end;
Result := InitCapiEngine and PrepareCapiEngine(Engine);
end;
procedure TEnginePool.Clear;
var
i: integer;
E: PENGINE;
begin
Lock;
try
for i := 0 to Pred(fAvailableList.Count) do
begin
E := fAvailableList[i];
fAvailableList[i] := nil;
if E <> nil then
begin
ENGINE_finish(E);
ENGINE_free(E);
end;
end;
fAvailableList.Clear;
finally
Unlock;
end;
end;
constructor TEnginePool.Create;
begin
inherited Create;
fLock := TCriticalSection.Create;
fAvailableList := TList.Create;
end;
destructor TEnginePool.Destroy;
begin
Clear;
FreeAndNil(fAvailableList);
FreeAndNil(fLock);
inherited;
end;
procedure TEnginePool.Lock;
begin
fLock.Enter;
end;
procedure TEnginePool.Release(var Engine: PENGINE);
begin
if Engine = nil then
Exit;
Lock;
try
fAvailableList.Add(Engine);
Engine := nil;
finally
Unlock;
end;
end;
procedure TEnginePool.Unlock;
begin
fLock.Leave;
end;
{$ENDIF}
{$IFDEF SUPPORTS_REGION}{$ENDREGION}{$ENDIF}
{$IFDEF SUPPORTS_REGION}{$REGION 'The plugin'}{$ENDIF}
{==============================================================================}
{The plugin }
{------------------------------------------------------------------------------}
{ TSSLOpenSSLCapi }
class function TSSLOpenSSLCapi.InitEngine: boolean;
begin
Result := InitCapiEngine;
end;
procedure TSSLOpenSSLCapi.Assign(const Value: TCustomSSL);
var
CAPIValue: TSSLOpenSSLCapi;
begin
inherited;
if (Value <> nil) and (Value is TSSLOpenSSLCapi) then
begin
CAPIValue := TSSLOpenSSLCapi(Value);
Self.FSigningCertificateLocation := CAPIValue.FSigningCertificateLocation;
Self.FSigningCertificateStore := CAPIValue.FSigningCertificateStore;
Self.FSigningCertificateID := CAPIValue.FSigningCertificateID;
end;
end;
constructor TSSLOpenSSLCapi.Create(const Value: TTCPBlockSocket);
begin
inherited;
FEngine := nil;
FEngineInitialized := False;
FSigningCertificateLocation := wcslCurrentUser;
FSigningCertificateStore := 'MY';
FSigningCertificateID := '';
end;
destructor TSSLOpenSSLCapi.Destroy;
begin
if FEngine <> nil then
begin
{$IFDEF USE_ENGINE_POOL}
FEnginePool.Release(FEngine);
{$ELSE}
ENGINE_finish(FEngine);
ENGINE_free(FEngine);
{$ENDIF}
FEngineInitialized := False;
end;
inherited;
end;
function TSSLOpenSSLCapi.GetEngine: PENGINE;
begin
if not FEngineInitialized then
begin
{$IFDEF USE_ENGINE_POOL}
if not FEnginePool.Acquire(FEngine) then
FEngine := nil;
{$ELSE}
if (not InitEngine) or (not PrepareCapiEngine(FEngine)) then
FEngine := nil;
{$ENDIF}
FEngineInitialized := True;
end;
Result := FEngine;
end;
function TSSLOpenSSLCapi.LoadSigningCertificate: boolean;
var
pkey: EVP_PKEY;
pdata: Pointer;
cert: PX509;
store: HCERTSTORE;
certctx: PCCERT_CONTEXT;
flags: DWORD;
begin
Result := False;
if not SigningCertificateSpecified then
Exit;
if not InitEngine then
Exit;
if Engine = nil then
Exit;
if not Assigned(FSSL_CTX_set_client_cert_engine) then
Exit;
if SSL_CTX_set_client_cert_engine(Fctx, Engine) = 0 then
Exit;
if ENGINE_ctrl_cmd_string(Engine, 'store_name', PAnsiChar( {$IFDEF UNICODE} AnsiString {$ENDIF} (SigningCertificateStore)), 0) = 0 then
Exit;
if ENGINE_ctrl_cmd_string(Engine, 'lookup_method', '1', 0) = 0 then
Exit;
case SigningCertificateLocation of
wcslCurrentUser:
if ENGINE_ctrl_cmd_string(Engine, 'store_flags', '0', 0) = 0 then
Exit;
wcslLocalMachine:
if ENGINE_ctrl_cmd_string(Engine, 'store_flags', '1', 0) = 0 then
Exit;
else
Exit; // other store flags are not supported by the CAPI engine
end;
if Server then
begin
cert := nil;
pkey := nil;
try
// Need to find the context and the store for the certificate. Unfortunately,
// due to the CAPI engine limitations (see capi_load_privkey), I can only use
// a very limited set of criteria for finding the certificate
flags := 0;
case SigningCertificateLocation of
wcslCurrentUser:
flags := flags or CERT_SYSTEM_STORE_CURRENT_USER;
wcslLocalMachine:
flags := flags or CERT_SYSTEM_STORE_LOCAL_MACHINE;
else
Exit; // other store flags are not supported by the CAPI engine
end;
store := CertOpenStore(CERT_STORE_PROV_SYSTEM_W, 0, 0, flags, PWideChar(WideString(SigningCertificateStore)));
if store <> 0 then
begin
try
certctx := CertFindCertificateInStore(store, X509_ASN_ENCODING, 0, CERT_FIND_SUBJECT_STR_A, PAnsiChar( {$IFDEF UNICODE} AnsiString {$ENDIF} (SigningCertificateID)), nil);
if certctx = nil then
Exit;
pkey := ENGINE_load_private_key(Engine, PAnsiChar( {$IFDEF UNICODE} AnsiString {$ENDIF} (SigningCertificateID)), nil, nil);
if pkey = nil then
Exit;
pdata := certctx.pbCertEncoded;
cert := d2i_X509(nil, @pdata, certctx.cbCertEncoded);
if cert = nil then
Exit;
if SSLCTXusecertificate(Fctx, cert) <= 0 then
Exit;
if SSLCTXusePrivateKey(Fctx, pkey) <= 0 then
Exit;
Result := True;
finally
CertCloseStore(store, 0);
end;
end;
finally
if pkey <> nil then
EvpPkeyFree(pkey);
if cert <> nil then
X509free(cert);
end;
end
else
begin
Result := True;
end;
if Result then
if FEngineNeedsSHA2Workaround then
SslCtxCtrl(Fctx, SSL_CTRL_OPTIONS, SslCtxCtrl(Fctx, SSL_CTRL_OPTIONS, 0, nil) or SSL_OP_NO_TLSv1_2, nil);
end;
function TSSLOpenSSLCapi.NeedSigningCertificate: boolean;
begin
Result := SigningCertificateSpecified and inherited NeedSigningCertificate;
end;
function TSSLOpenSSLCapi.SetSslKeys: boolean;
begin
Result := False;
if not assigned(FCtx) then
Exit;
try
if SigningCertificateSpecified and InitEngine then
begin
if not LoadSigningCertificate then
Exit;
Result := True;
end;
if inherited SetSslKeys then
Result := True;
finally
SSLCheck;
end;
end;
function TSSLOpenSSLCapi.SigningCertificateSpecified: boolean;
begin
Result := (SigningCertificateID <> '');
end;
{$IFDEF SUPPORTS_REGION}{$ENDREGION}{$ENDIF}
{$IFDEF SUPPORTS_REGION}{$REGION 'Initialization and finalization'}{$ENDIF}
{==============================================================================}
{Initialization and finalization }
{------------------------------------------------------------------------------}
initialization
begin
FEngineCS := TCriticalSection.Create;
if InitSSLInterface and ((SSLImplementation = TSSLNone) or (SSLImplementation = TSSLOpenSSL)) then
SSLImplementation := TSSLOpenSSLCapi;
{$IFDEF USE_ENGINE_POOL}
FEnginePool := TEnginePool.Create;
{$ENDIF}
end;
finalization
begin
DestroyEngineInterface;
{$IFDEF USE_ENGINE_POOL}
FreeAndNil(FEnginePool);
{$ENDIF}
FreeAndNil(FEngineCS);
end;
{$IFDEF SUPPORTS_REGION}{$ENDREGION}{$ENDIF}
end.