long ago I created an application that could create a certificate request, submit it to a Web Service that would submit it to an internal Enterprise CA, send the signed certificate back, and then accept the certificate on the client. Once done, the application would the (if needed) install SCOM (System Center Operation Manager Client) and configure it for Certificate Authentication.
We needed this application to work on everything from Windows 2000 and up, and that turned out to be one hell of a lot of “messy” code, since Microsoft changed the API for handling Certificates around Server 2008 (and now again in Windows 8/ Server 2012)
So I had to do an update to the application and instantly I started getting a ton of errors. After fixing those, suddenly the application didn’t work on old client’s (2003 servers) After spending several hour’s I just had a flip and decided there had to be something smarter you could do. I came across this blog post and though to my self, that seemed simple and elegant, and if Bouncy Castle could help create a PFX file, it would be simple to import the certificate, on all versions of operation systems. I cleaned up the code, removed a few bits and pieces and added links to where I got the difference pieces of code from.
Imports Org.BouncyCastle.Crypto.Generators
Imports Org.BouncyCastle.Crypto
Imports System.Security.Cryptography.X509Certificates
Public Class CertificateRequest
#Region "Internals"
Private _CSR As String
Public ReadOnly Property CSR() As String
Get
Return _CSR
End Get
End Property
Private PrivateKeyPem As String
Private ackp As AsymmetricCipherKeyPair
#End Region
#Region "Constants"
Const CRYPT_EXPORTABLE = 1
Const AT_KEYEXCHANGE = 1
Const CERT_SYSTEM_STORE_LOCAL_MACHINE = &H20000
Const OID_MSTEMPLATE_v1 As String = "1.3.6.1.4.1.311.20.2"
Const OID_MSTEMPLATE_v2 As String = "1.3.6.1.4.1.311.20.7"
Private Const CC_DEFAULTCONFIG As Integer = 0
Private Const CC_UIPICKCONFIG As Integer = &H1
Private Const CR_IN_BASE64 As Integer = &H1
Private Const CR_IN_FORMATANY As Integer = 0
Private Const CR_IN_PKCS10 As Integer = &H100
Private Const CR_DISP_ISSUED As Integer = &H3
Private Const CR_DISP_UNDER_SUBMISSION As Integer = &H5
Private Const CR_OUT_BASE64 As Integer = &H1
Private Const CR_OUT_CHAIN As Integer = &H100
#End Region
''' <summary>
''' Create a new Certificate Request, with a 2048 bits key pair
''' </summary>
''' <param name="FQDN">Fully qualified domain name</param>
''' <returns>An instance of CertificateRequest containing private key and CSR</returns>
''' <remarks></remarks>
Shared Function CreateRequest(FQDN As String) As CertificateRequest
Return CreateRequest(FQDN, 2048)
End Function
''' <summary>
''' Create a new Certificate Request
''' </summary>
''' <param name="FQDN">Fully qualified domain name</param>
''' <param name="Strength">Strength of key in bits</param>
''' <returns>An instance of CertificateRequest containing private key and CSR</returns>
''' <remarks></remarks>
Shared Function CreateRequest(FQDN As String, Strength As Integer) As CertificateRequest
' http://stackoverflow.com/questions/949727/bouncycastle-rsaprivatekey-to-net-rsaprivatekey
'Key generation
Dim rkpg As New RsaKeyPairGenerator()
rkpg.Init(New KeyGenerationParameters(New Org.BouncyCastle.Security.SecureRandom(), Strength))
Dim ackp As AsymmetricCipherKeyPair = rkpg.GenerateKeyPair()
'Requested Certificate Name
Dim name As New Org.BouncyCastle.Asn1.X509.X509Name("CN=" & FQDN)
Dim csr As New Org.BouncyCastle.Pkcs.Pkcs10CertificationRequest("SHA1WITHRSA", name, ackp.[Public], Nothing, ackp.[Private])
'Convert BouncyCastle CSR to .PEM file.
Dim CSRPem As New System.Text.StringBuilder()
Dim CSRPemWriter As New Org.BouncyCastle.OpenSsl.PemWriter(New System.IO.StringWriter(CSRPem))
CSRPemWriter.WriteObject(csr)
CSRPemWriter.Writer.Flush()
'Convert BouncyCastle Private Key to .PEM file.
Dim PrivateKeyPem As New System.Text.StringBuilder()
Dim PrivateKeyPemWriter As New Org.BouncyCastle.OpenSsl.PemWriter(New System.IO.StringWriter(PrivateKeyPem))
PrivateKeyPemWriter.WriteObject(ackp.[Private])
CSRPemWriter.Writer.Flush()
'Push the CSR Text to a Label on a Page
'Dim PrivateKeyLabel As String = PrivateKeyPem.ToString()
Return New CertificateRequest With {.ackp = ackp, ._CSR = CSRPem.ToString(), .PrivateKeyPem = PrivateKeyPem.ToString()}
End Function
''' <summary>
''' Submit request to CA and get signed certificate back
''' </summary>
''' <param name="CA">CA to use, leaving blank will open default UI to select an CA</param>
''' <param name="Template">Certificate Template to use, can be blank if standalone CA, or template specefied in CSR. If specefied, will override what is specefied in CSR</param>
''' <param name="base64">CSR as Base54</param>
''' <returns>Signed Certificate as Base64</returns>
''' <remarks></remarks>
Public Function submitRequest(ByVal CA As String, Template As String, ByVal base64 As String) As String
' Create all the objects that will be required
Dim objCertConfig As CERTCLIENTLib.CCertConfig = New CERTCLIENTLib.CCertConfig()
Dim objCertRequest As CERTCLIENTLib.CCertRequest = New CERTCLIENTLib.CCertRequest()
Dim strCAConfig As String
Dim iDisposition As Integer
Dim strDisposition As String
Dim strCert As String
Try
If CA = "" Then
' Get CA config from UI
'strCAConfig = objCertConfig.GetConfig(CC_DEFAULTCONFIG);
strCAConfig = objCertConfig.GetConfig(CC_UIPICKCONFIG)
Else
strCAConfig = CA ' "AD01.int.wingu.dk\int-AD01-CA"
End If
Dim strAttributes As String = Nothing
If Not String.IsNullOrEmpty(Template) Then strAttributes = "CertificateTemplate: " & Template
' Submit the request
iDisposition = objCertRequest.Submit(CR_IN_BASE64 Or CR_IN_FORMATANY, base64, strAttributes, strCAConfig)
' Check the submission status
If CR_DISP_ISSUED <> iDisposition Then
' Not enrolled
strDisposition = objCertRequest.GetDispositionMessage()
If CR_DISP_UNDER_SUBMISSION = iDisposition Then
' Pending
Console.WriteLine("The submission is pending: " & strDisposition)
Return ""
Else
Throw New Exception("The submission failed: " & strDisposition & vbCrLf & "Last status: " & objCertRequest.GetLastStatus().ToString())
' Failed
Console.WriteLine("The submission failed: " & strDisposition)
Console.WriteLine("Last status: " & objCertRequest.GetLastStatus().ToString())
Return ""
End If
End If
' Get the certificate
strCert = objCertRequest.GetCertificate(CR_OUT_BASE64 Or CR_OUT_CHAIN)
Return strCert
Catch ex As Exception
Throw ex
Console.WriteLine(ex.Message)
End Try
End Function
''' <summary>
''' Pair Private Key with signed certificate and save to local machine store
''' </summary>
''' <param name="CertResponse"></param>
''' <param name="allowExport"></param>
''' <remarks></remarks>
Sub AcceptRequest(ByVal CertResponse As String, allowExport As Boolean)
Dim s As String = CertResponse
' Response from Microsoft CA will not contain filetype specefication, to add it to make BouncyCastle happy
If Not s.Contains("-----BEGIN CERTIFICATE-----") Then
s = "-----BEGIN CERTIFICATE-----" & vbCrLf & s & vbCrLf & "-----END CERTIFICATE-----"
End If
' Load signed Certificate as a BouncyCastle Certificate
Dim pr As New Org.BouncyCastle.OpenSsl.PemReader(New System.IO.StringReader(s))
Dim prObj = pr.ReadObject()
Dim cert As Org.BouncyCastle.X509.X509Certificate = DirectCast(prObj, Org.BouncyCastle.X509.X509Certificate)
' Convert certificate to a "microsoft" Certificate
Dim _netcert As System.Security.Cryptography.X509Certificates.X509Certificate = Org.BouncyCastle.Security.DotNetUtilities.ToX509Certificate(cert)
Dim netcert As New System.Security.Cryptography.X509Certificates.X509Certificate2(_netcert)
' Add Private Key to the Certificate
Dim rcsp As New System.Security.Cryptography.RSACryptoServiceProvider()
'And the privateKeyParameters
Dim parms As New System.Security.Cryptography.RSAParameters()
'Translate ackp.PrivateKey to parms;
Dim BCKeyParms As Parameters.RsaPrivateCrtKeyParameters = DirectCast(ackp.[Private], Parameters.RsaPrivateCrtKeyParameters)
parms.Modulus = BCKeyParms.Modulus.ToByteArrayUnsigned()
parms.P = BCKeyParms.P.ToByteArrayUnsigned()
parms.Q = BCKeyParms.Q.ToByteArrayUnsigned()
parms.DP = BCKeyParms.DP.ToByteArrayUnsigned()
parms.DQ = BCKeyParms.DQ.ToByteArrayUnsigned()
parms.InverseQ = BCKeyParms.QInv.ToByteArrayUnsigned()
parms.D = BCKeyParms.Exponent.ToByteArrayUnsigned()
parms.Exponent = BCKeyParms.PublicExponent.ToByteArrayUnsigned()
'import the RSAParameters into the RSACryptoServiceProvider
rcsp.ImportParameters(parms)
netcert.PrivateKey = rcsp
' I'm sure there is a smarter way, but this works for now
' If you add the certificate now, it will be lacking the MachineKeySet/PersistKeySet and Exportable
' Parameter, so we export the certificate and load it again, with Cryptography.CspParameters set correctly
' http://stackoverflow.com/questions/9810887/export-x509certificate2-to-byte-array-with-the-private-key
Dim certBytes As Byte() = netcert.Export(X509ContentType.Pkcs12, "Password1!")
'System.IO.File.WriteAllBytes("c:\certificate.pfx", certBytes)
Dim certToImport As System.Security.Cryptography.X509Certificates.X509Certificate2
If allowExport Then
certToImport = New System.Security.Cryptography.X509Certificates.X509Certificate2(certBytes, "Password1!", X509KeyStorageFlags.MachineKeySet Or X509KeyStorageFlags.Exportable Or X509KeyStorageFlags.PersistKeySet)
Else
certToImport = New System.Security.Cryptography.X509Certificates.X509Certificate2(certBytes, "Password1!", X509KeyStorageFlags.MachineKeySet Or X509KeyStorageFlags.PersistKeySet)
End If
If Not certToImport.HasPrivateKey Then Throw New Exception("Certificate failed to load with Private key")
'Test that we can encrypt and decrypt with the certificate
'Dim PlainString As String = "Encrypt this string"
'Dim EncryptedString As String = CertUtilities.GetEncryptedText(certToImport, PlainString)
'Dim result As String = CertUtilities.GetDecryptedText(certToImport, EncryptedString)
'If PlainString <> result Then Throw New Exception("Certificate failed the encryption/decryption test")
' Finally, add the certificate to the LocalMachine store
Dim store As New Security.Cryptography.X509Certificates.X509Store(Security.Cryptography.X509Certificates.StoreName.My, Security.Cryptography.X509Certificates.StoreLocation.LocalMachine)
store.Open(OpenFlags.ReadWrite)
store.Add(certToImport)
store.Close()
End Sub
End Class
And a few tools for testing
' http://blogs.msdn.com/b/cagatay/archive/2009/02/08/removing-acls-from-csp-key-containers.aspx
Sub RemoveEveryoneFromPrivateKey(Cert As System.Security.Cryptography.X509Certificates.X509Certificate2)
Dim rsa As Cryptography.RSACryptoServiceProvider = Cert.PrivateKey
Dim id As New Principal.SecurityIdentifier(Principal.WellKnownSidType.WorldSid, Nothing) ' Indicates a SID that matches everyone.
Dim cspParams As New Cryptography.CspParameters(rsa.CspKeyContainerInfo.ProviderType, rsa.CspKeyContainerInfo.ProviderName, rsa.CspKeyContainerInfo.KeyContainerName)
cspParams.Flags = Cryptography.CspProviderFlags.UseMachineKeyStore
Dim container As New Cryptography.CspKeyContainerInfo(cspParams)
'get the original acls first
cspParams.CryptoKeySecurity = container.CryptoKeySecurity
'Search for the account given to us and remove it from accessrules
'For Each rule As CryptoKeyAccessRule In cspParams.CryptoKeySecurity.GetAccessRules(True, False, GetType(Principal.NTAccount))
For Each rule As CryptoKeyAccessRule In cspParams.CryptoKeySecurity.GetAccessRules(True, False, GetType(Principal.SecurityIdentifier))
If rule.IdentityReference.Equals(id) Then
cspParams.CryptoKeySecurity.RemoveAccessRule(rule)
End If
Next
'persist accessrules on key container.
Dim cryptoServiceProvider As New Cryptography.RSACryptoServiceProvider(cspParams)
End Sub
'http://social.msdn.microsoft.com/Forums/hu/vbgeneral/thread/7e0f513f-cd09-492a-8748-a4aea024cff0
'http://stackoverflow.com/questions/425688/how-to-set-read-permission-on-the-private-key-file-of-x-509-certificate-from-ne
Sub AddEveryoneToPrivateKey(Cert As System.Security.Cryptography.X509Certificates.X509Certificate2)
Dim id As New Principal.SecurityIdentifier(Principal.WellKnownSidType.WorldSid, Nothing) ' Indicates a SID that matches everyone.
Dim rsa As Cryptography.RSACryptoServiceProvider = Cert.PrivateKey
If Cert.HasPrivateKey Then
Dim cspParams = New Cryptography.CspParameters(rsa.CspKeyContainerInfo.ProviderType, _
rsa.CspKeyContainerInfo.ProviderName, _
rsa.CspKeyContainerInfo.KeyContainerName) _
With {.Flags = Cryptography.CspProviderFlags.UseExistingKey Or Cryptography.CspProviderFlags.UseMachineKeyStore, _
.CryptoKeySecurity = rsa.CspKeyContainerInfo.CryptoKeySecurity}
cspParams.CryptoKeySecurity.AddAccessRule(
New CryptoKeyAccessRule(id, CryptoKeyRights.FullControl, AccessControlType.Allow))
' Once we create a new RSACryptoServiceProvider, we override the existing one.
Dim rsa2 As Cryptography.RSACryptoServiceProvider = New Cryptography.RSACryptoServiceProvider(cspParams)
End If
End Sub
Function GetEncryptedText(cert As System.Security.Cryptography.X509Certificates.X509Certificate2, PlainStringToEncrypt As String) As String
Dim cipherbytes As Byte() = Text.ASCIIEncoding.ASCII.GetBytes(PlainStringToEncrypt)
Dim rsa As Security.Cryptography.RSACryptoServiceProvider = cert.PublicKey.Key
Dim cipher As Byte() = rsa.Encrypt(cipherbytes, False)
Return Convert.ToBase64String(cipher)
End Function
Function GetDecryptedText(cert As System.Security.Cryptography.X509Certificates.X509Certificate2, EncryptedStringToDecrypt As String) As String
Dim cipherbytes As Byte() = Convert.FromBase64String(EncryptedStringToDecrypt)
If cert.HasPrivateKey Then
Dim rsa As Security.Cryptography.RSACryptoServiceProvider = cert.PrivateKey
Dim plainbytes As Byte() = rsa.Decrypt(cipherbytes, False)
Dim enc As System.Text.ASCIIEncoding = New System.Text.ASCIIEncoding()
Return enc.GetString(plainbytes)
Else
Throw New Exception("Certificate used for has no private key.")
End If
End Function
