Attribute VB_Name = "basSMIMEex"
Option Explicit
' $Id: basSMIMEex $
' Reproduces examples from RFC 4134 "Examples of S/MIME Messages"
' Last Updated:
' $Date: 2012-01-14 11:11:00 $
' $Revision: 3.8.0 $
' Output is directed to the Immediate Window using oDebug.PPrint
' Errors are flagged with a MsgBox and then a Stop
' Requires these test files to exist in the same directory as the executable:
' 4.2.bin
' AlicePrivRSASign.pri
' AliceRSASignByCarl.cer
' BobPrivRSAEncrypt.pri
' BobRSASignByCarl.cer
' CarlPrivRSASign.pri
' CarlRSASelf.cer
' excontent.txt
' Functions further down depend on files being created by previous functions.
Private m_strTestDir As String
Public oDebug As New CDebug
' THE MAIN PROGRAM OF TESTS...
Public Function smime_DoAll(strPath As String)
' Creates a new temp dir
' Copies test files to it from current directory
' Then does a series of tests based on "Examples of S/MIME Messages"
On Error GoTo OnError
Dim strTestDir As String
strTestDir = SetupTestDir(strPath)
oDebug.PPrint "Created new test folder '" & strTestDir & "'"
smime_Ex5_1_MakeEnvData
smime_Ex5_1b_MakeEnvDataFromString
SavePrivateKeys
smime_Ex5_1_ReadToFile
smime_Ex5_1_ReadToString
smime_Ex4_2_MakeSigData
smime_Ex4_2_MakeSigDataWithMD5
smime_MakeDetachedSig
smime_ReadSigData
smime_ReadSigDataIntoString
smime_GetSigDataDigest
smime_GetSigDataDigestMD5
sime_GetDigestFromDetSig
smime_FullSigDataDigestCheck
smime_FullSigDataDigestCheckMD5
Test_DecryptRaw
Test_X509_CertThumb
Test_X509_CertIsValidNow
Test_X509_VerifyCert
Test_X509_QueryCert
smime_Ex4_2_MakeSigDataWithSHA256
Show_Version
oDebug.PPrint ""
oDebug.PPrint "All done."
oDebug.PPrint "Files saved in temp folder " & strTestDir
ChDir ".."
Call PromptToKillFolder(strTestDir)
Done:
Exit Function
OnError:
Dim sErrMsg As String
sErrMsg = "Error " & Err.Number & " has occurred:" & vbCrLf & Err.Description
Select Case Err.Number
Case 75
sErrMsg = sErrMsg & vbCrLf & vbCrLf _
& "You do not have permission to create the test sub-folder here. Unzip the test files in a different directory."
Case 53
sErrMsg = sErrMsg & vbCrLf & vbCrLf _
& "A required test file is missing. Make sure the test files from smimetestfiles.zip are in the same folder as the executable"
End Select
MsgBox sErrMsg, vbCritical
Resume Done
End Function
' FILE AND DIRECTORY ADMIN STUFF...
Public Function SetupTestDir(strPath As String) As String
Dim strTestDir As String
Dim nRand As Long
Dim strSrcDir As String
Dim strDestDir As String
Randomize
nRand = RNG_Number(0, &H7FFFFFFF)
' Create a new random test sub-dir
strTestDir = strPath & "\pkitest." & Hex(nRand)
MkDir strTestDir
' Make this the current dir
ChDir strTestDir
oDebug.PPrint vbCrLf & "Setting up test files in directory " & strTestDir & "..."
' Set default path to empty
m_strTestDir = ""
' Copy files from app dir to test dir
CopyFileToTest "AliceRSASignByCarl.cer", App.Path, strTestDir
CopyFileToTest "AlicePrivRSASign.pri", App.Path, strTestDir
CopyFileToTest "BobRSASignByCarl.cer", App.Path, strTestDir
CopyFileToTest "BobPrivRSAEncrypt.pri", App.Path, strTestDir
CopyFileToTest "CarlRSASelf.cer", App.Path, strTestDir
CopyFileToTest "CarlPrivRSASign.pri", App.Path, strTestDir
CopyFileToTest "excontent.txt", App.Path, strTestDir
CopyFileToTest "4.2.bin", App.Path, strTestDir
' Write a text file as a memo
WriteFileFromString "!ThisFolderIsSafeToDelete.txt", _
"This folder was created as a test for the CryptoSys PKI Toolkit by the program '" _
& App.EXEName & "'. The folder and all files in it may be safely deleted at any time."
SetupTestDir = strTestDir
End Function
Public Function PromptToKillFolder(strFolder As String)
Dim sMsg As String
sMsg = "The directory '" & strFolder & "' has been created by this test program." _
& vbCrLf & vbCrLf & "Do you want to remove it now?"
If vbYes = MsgBox(sMsg, vbYesNo, "Remove test directory") Then
If apiKillDirectory(strFolder) Then
oDebug.PPrint "Temp folder has been deleted."
End If
End If
End Function
Public Function CopyFileToTest(strFileName As String, ByVal strSrcDir As String, ByVal strDestDir As String)
strSrcDir = Trim(strSrcDir)
If Right(strSrcDir, 1) = "\" Then
strSrcDir = Left(strSrcDir, Len(strSrcDir) - 1)
End If
strDestDir = Trim(strDestDir)
If Right(strDestDir, 1) = "\" Then
strDestDir = Left(strDestDir, Len(strDestDir) - 1)
End If
FileCopy strSrcDir & "\" & strFileName, strDestDir & "\" & strFileName
End Function
Public Function TrimNull(strToTrim As String) As String
' Trims a string that might contain a NULL character
Dim nPos As Long
TrimNull = strToTrim
nPos = InStr(TrimNull, Chr$(0))
If nPos > 0 Then
TrimNull = Left$(TrimNull, nPos - 1)
End If
End Function
' THE REAL PKI TESTS...
Public Function smime_Ex5_1_MakeEnvData()
' Reproduces example 5.1 - EnvelopedData from Alice to Bob
' of ExContent using TripleDES and RSA.
' NB output will always be different from smime-examples
' because the content-encryption key, encryption-IV
' and eContent will be different each time.
Dim nRet As Long
Dim strOutputFile As String
Dim strInputFile As String
Dim strCertFile As String
Dim strQuery As String
Dim strResult As String
oDebug.PPrint vbCrLf & "Alice sends EnvelopedData (encrypted data) to Bob..."
strOutputFile = m_strTestDir & "cmsalice2bob.p7m"
strInputFile = m_strTestDir & "excontent.txt"
strCertFile = m_strTestDir & "BobRSASignByCarl.cer"
' This should return 1 (indicating one successful recipient)
nRet = CMS_MakeEnvData(strOutputFile, strInputFile, strCertFile, "", 0, 0)
oDebug.PPrint "CMS_MakeEnvData returns " & nRet & " (expected 1)"
If nRet = 1 Then
oDebug.PPrint "Created file " & strOutputFile
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_MakeEnvData"
Stop
End If
' Check the algorithm details in the file we just made
strResult = String(64, " ")
strQuery = "keyEncryptionAlgorithm"
nRet = CMS_QueryEnvData(strResult, Len(strResult), strOutputFile, strQuery, 0)
If nRet < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_QueryEnvData"
Stop
End If
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
strResult = String(64, " ")
strQuery = "contentEncryptionAlgorithm"
nRet = CMS_QueryEnvData(strResult, Len(strResult), strOutputFile, strQuery, 0)
If nRet < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_QueryEnvData"
Stop
End If
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
End Function
Public Function smime_Ex5_1b_MakeEnvDataFromString()
' Reproduces example 5.1 - EnvelopedData from Alice to Bob
' of ExContent using TripleDES and RSA.
Dim nRet As Long
Dim strOutputFile As String
Dim strQuery As String
oDebug.PPrint vbCrLf & "Alice sends EnvelopedData to Bob using string input..."
strOutputFile = m_strTestDir & "cmsalice2bob1.p7m"
' This should return 1 (indicating one successful recipient)
nRet = CMS_MakeEnvDataFromString(strOutputFile, _
"This is some sample content.", m_strTestDir & "BobRSASignByCarl.cer", "", 0, 0)
oDebug.PPrint "CMS_MakeEnvDataFromString returns " & nRet & " (expected 1)"
If nRet = 1 Then
oDebug.PPrint "Created file " & strOutputFile
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_MakeEnvDataFromString"
Stop
End If
' Check the algorithm details in the file we just made
' (these particular queries don't need a result string)
strQuery = "countOfRecipientInfos"
nRet = CMS_QueryEnvData(vbNullString, 0, strOutputFile, strQuery, 0)
If nRet < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_QueryEnvData"
Stop
End If
oDebug.PPrint strQuery & "=" & nRet
strQuery = "sizeofEncryptedContent"
nRet = CMS_QueryEnvData(vbNullString, 0, strOutputFile, strQuery, 0)
If nRet < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_QueryEnvData"
Stop
End If
oDebug.PPrint strQuery & "=" & nRet
End Function
' The private keys (*.pri) given with smime-examples are in
' unencrypted private-key-info format
' We want to save them encrypted with a password
' Use a generic function to do this
Public Function CopyPriKeyToEncFile(strEPKFile As String, strPRIFile As String, strPassword As String) As Boolean
Dim strPrivateKey As String
Dim strPK1 As String
Dim nKeyLen As String
Dim nRet As Long
' Read in unencrypted PrivateKeyInfo data
nKeyLen = RSA_ReadPrivateKeyInfo("", 0, strPRIFile, 0)
If nKeyLen <= 0 Then
MsgBox pkiGetLastError(), vbCritical, "RSA_ReadPrivateKeyInfo"
Exit Function
End If
strPrivateKey = String(nKeyLen, " ")
nRet = RSA_ReadPrivateKeyInfo(strPrivateKey, nKeyLen, strPRIFile, 0)
If nRet <= 0 Then
MsgBox pkiGetLastError(), vbCritical, "RSA_ReadPrivateKeyInfo"
Exit Function
End If
oDebug.PPrint "RSA_KeyBits(strPrivateKey)=" & RSA_KeyBits(strPrivateKey)
' Now we save it with a password
nRet = RSA_SaveEncPrivateKey(strEPKFile, strPrivateKey, 1000, strPassword, 0)
oDebug.PPrint "RSA_SaveEncPrivateKey returns " & nRet
' Check we can read it
strPK1 = rsaReadPrivateKey(strEPKFile, strPassword)
oDebug.PPrint "RSA_KeyBits(strPK1)=" & RSA_KeyBits(strPK1)
oDebug.PPrint "RSA_KeyHashCode(strPK1) =" & Hex(RSA_KeyHashCode(strPK1))
oDebug.PPrint "RSA_KeyHashCode(strPrivateKey)=" & Hex(RSA_KeyHashCode(strPrivateKey))
' NB: as of ver 3.0 we can no longer compare internal key strings directly
''If strPK1 <> strPrivateKey Then
' so we use the KeyHashCode
If RSA_KeyHashCode(strPK1) <> RSA_KeyHashCode(strPrivateKey) Then
MsgBox "Private keys do not match!", vbCritical, "CopyPriKeyToEncFile"
Stop
Else
CopyPriKeyToEncFile = True
End If
End Function
Public Function SavePrivateKeys()
oDebug.PPrint vbCrLf & "Converting and saving encrypted private keys..."
If CopyPriKeyToEncFile(m_strTestDir & "AlicePrivRSASign.epk", m_strTestDir & "AlicePrivRSASign.pri", "password") Then
oDebug.PPrint "Encrypted Alice's private key"
End If
If CopyPriKeyToEncFile(m_strTestDir & "BobPrivRSAEncrypt.epk", m_strTestDir & "BobPrivRSAEncrypt.pri", "password") Then
oDebug.PPrint "Encrypted Bob's private key"
End If
If CopyPriKeyToEncFile(m_strTestDir & "CarlPrivRSASign.epk", m_strTestDir & "CarlPrivRSASign.pri", "password") Then
oDebug.PPrint "Encrypted Carl's private key"
End If
End Function
Public Function smime_Ex5_1_ReadToFile()
' Bob reads the enveloped-data message sent by Alice
' Wrting output directly to a file
Dim nRet As Long
Dim strFileIn As String
Dim strFileOut As String
Dim strPrivateKey As String
Dim strCheck As String
oDebug.PPrint vbCrLf & "Bob reads the enveloped-data message sent by Alice..."
' Bob reads his private key into a string
strPrivateKey = rsaReadPrivateKey(m_strTestDir & "BobPrivRSAEncrypt.epk", "password")
If Len(strPrivateKey) = 0 Then
MsgBox "Cannot read private key", vbCritical
Stop
Exit Function
End If
' Decrypt the input file; send plaintext to new output file
strFileIn = m_strTestDir & "cmsalice2bob.p7m"
strFileOut = m_strTestDir & "fromalice.txt"
nRet = CMS_ReadEnvData(strFileOut, strFileIn, "", strPrivateKey, 0)
oDebug.PPrint "CMS_ReadEnvData returns " & nRet & " (expected 0)"
If nRet = 0 Then
oDebug.PPrint "Created plaintext file " & strFileOut
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_ReadEnvData"
Stop
End If
' Clean up
strPrivateKey = wipeString(strPrivateKey)
End Function
Public Function smime_Ex5_1_ReadToString()
' Bob reads the enveloped-data message sent by Alice
' directly into a string
Dim nRet As Long
Dim strPrivateKey As String
Dim strFileIn As String
Dim strDataOut As String
Dim nDataLen As Long
oDebug.PPrint vbCrLf & "Bob reads the enveloped-data message sent by Alice (into a string)..."
' First, Bob reads his private key into a string
strPrivateKey = rsaReadPrivateKey(m_strTestDir & "BobPrivRSAEncrypt.epk", "password")
If Len(strPrivateKey) = 0 Then
MsgBox "Cannot read private key", vbCritical
Stop
Exit Function
End If
' Decrypt the input file - how long is the plaintext?
strFileIn = m_strTestDir & "cmsalice2bob.p7m"
nDataLen = CMS_ReadEnvDataToString("", 0, strFileIn, "", strPrivateKey, 0)
oDebug.PPrint "CMS_ReadEnvDataToString returns " & nDataLen & " (expected > 0)"
If nDataLen <= 0 Then
GoTo CleanUp
End If
' Pre-dimension string and read in the plaintext
strDataOut = String(nDataLen, " ")
nDataLen = CMS_ReadEnvDataToString(strDataOut, nDataLen, strFileIn, "", strPrivateKey, 0)
oDebug.PPrint "CMS_ReadEnvDataToString returns " & nDataLen
If nDataLen > 0 Then
oDebug.PPrint "Plaintext is '" & strDataOut & "'"
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_ReadEnvDataToString"
Stop
End If
CleanUp:
WIPE_String strPrivateKey, Len(strPrivateKey)
strPrivateKey = ""
End Function
Public Function smime_Ex4_2_MakeSigData()
' This example should reproduce exactly the signed-data
' file from Example 4.2
' The output should be identical to 4.2.bin
Dim strEPKFile As String
Dim strPrivateKey As String
Dim nRet As Long
Dim strInputFile As String
Dim strOutputFile As String
Dim strCertFile As String
oDebug.PPrint vbCrLf & "Alice makes signed-data file..."
strEPKFile = m_strTestDir & "AlicePrivRSASign.epk"
strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
strInputFile = m_strTestDir & "excontent.txt"
strOutputFile = m_strTestDir & "BasicSignByAlice.p7s"
' Alice reads in her private key (which we encrypted earlier)
strPrivateKey = rsaReadPrivateKey(strEPKFile, "password")
If Len(strPrivateKey) = 0 Then
MsgBox "Cannot read private key", vbCritical
Stop
Exit Function
End If
' Now we can sign our message
nRet = CMS_MakeSigData(strOutputFile, strInputFile, strCertFile, strPrivateKey, 0)
oDebug.PPrint "CMS_MakeSigData returns " & nRet & " (expected 0)"
If nRet = 0 Then
oDebug.PPrint "Created signed-data file " & strOutputFile
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_MakeSigData"
Stop
End If
End Function
Public Function smime_Ex4_2_MakeSigDataWithMD5()
' As above but using input directly from a string and using
' MD5 instead of SHA-1
Dim strEPKFile As String
Dim strPrivateKey As String
Dim nKeyLen As Long
Dim nRet As Long
Dim strInputFile As String
Dim strOutputFile As String
Dim strCertFile As String
oDebug.PPrint vbCrLf & "Alice makes signed-data file from string input and uses MD5..."
strEPKFile = m_strTestDir & "AlicePrivRSASign.epk"
strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
strOutputFile = m_strTestDir & "BasicSignByAliceMD5.p7s"
' Alice reads in her private string (which we encrypted earlier)
strPrivateKey = rsaReadPrivateKey(strEPKFile, "password")
If Len(strPrivateKey) = 0 Then
MsgBox "Cannot read private key", vbCritical
Stop
Exit Function
End If
' Now we can sign our message using MD5
nRet = CMS_MakeSigDataFromString(strOutputFile, "This is some sample content.", _
strCertFile, strPrivateKey, PKI_HASH_MD5)
oDebug.PPrint "CMS_MakeSigDataFromString returns " & nRet & " (expected 0)"
If nRet = 0 Then
oDebug.PPrint "Created signed-data file " & strOutputFile
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_MakeSigDataFromString"
Stop
End If
End Function
Public Function smime_MakeDetachedSig()
' Alice creates a detached signature starting with the message digest in hex format
Dim nRet As Long
Dim strEPKFile As String
Dim strCertFile As String
Dim strOutFile As String
Dim strHexDigest As String
Dim strPrivateKey As String
oDebug.PPrint vbCrLf & "Alice creates a detached signature starting with the message digest in hex format..."
strEPKFile = m_strTestDir & "AlicePrivRSASign.epk"
strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
strOutFile = m_strTestDir & "DetSignByAlice.p7s"
strHexDigest = "406aec085279ba6e16022d9e0629c0229687dd48"
' First, Alice reads her private key into a string
strPrivateKey = rsaReadPrivateKey(strEPKFile, "password")
If Len(strPrivateKey) = 0 Then
MsgBox "Cannot read private key"
Stop
Exit Function
End If
' Alice makes a detached signature using
' the hash of the content and her private key
nRet = CMS_MakeDetachedSig(strOutFile, strHexDigest, _
strCertFile, strPrivateKey, 0)
oDebug.PPrint "CMS_MakeDetachedSig returns " & nRet & " (expected 0)"
If nRet = 0 Then
oDebug.PPrint "Created detached signature file " & strOutFile
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_MakeDetachedSig"
Stop
End If
End Function
Public Function smime_ReadSigData()
' Read Alice's signed-data, writing directly to a file
Dim nRet As Long
Dim strFileIn As String
Dim strFileOut As String
oDebug.PPrint vbCrLf & "Read Alice's signed-data, writing directly to a file..."
strFileIn = m_strTestDir & "BasicSignByAlice.p7s"
strFileOut = m_strTestDir & "BasicSignByAlice.dat"
nRet = CMS_ReadSigData(strFileOut, strFileIn, 0)
oDebug.PPrint "CMS_ReadSigData returns " & nRet & " (expected > 0)"
If nRet > 0 Then
oDebug.PPrint nRet & " bytes of signed data are in file " & strFileOut
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigData"
Stop
End If
End Function
Public Function smime_ReadSigDataIntoString()
' Extract signed data from original file, reading into a string
Dim strFileIn As String
Dim strData As String
Dim nDataLen As Long
oDebug.PPrint vbCrLf & "Extract signed data from original file, reading into a string..."
strFileIn = m_strTestDir & "4.2.bin"
' How long is the content to be read?
nDataLen = CMS_ReadSigDataToString("", 0, strFileIn, 0)
oDebug.PPrint "CMS_ReadSigDataToString returns " & nDataLen & " (expected > 0)"
If nDataLen <= 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigDataToString"
Stop
Exit Function
End If
' Pre-dimension string to receive data then get it
strData = String(nDataLen, " ")
nDataLen = CMS_ReadSigDataToString(strData, nDataLen, strFileIn, 0)
If nDataLen > 0 Then
oDebug.PPrint "Signed data is [" & strData & "]"
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigDataToString"
Stop
End If
End Function
Public Function smime_GetSigDataDigest()
' Get the message digest from the original signed-data file
Dim strCmsFile As String
Dim strHexDigest As String
Dim nDigAlg As Long
oDebug.PPrint vbCrLf & "Get the message digest from the original signed-data file..."
strCmsFile = m_strTestDir & "4.2.bin"
' Dimension string ready for longest possible
strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
' Should return zero for SHA-1 algorithm
oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg & " (expected 0)"
If nDigAlg <> 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
Stop
End If
' We need to trim this string
strHexDigest = TrimNull(strHexDigest)
oDebug.PPrint "Digest is [" & strHexDigest & "]"
End Function
Public Function smime_GetSigDataDigestMD5()
' As above but this time it's an MD5 digest
Dim strCmsFile As String
Dim strHexDigest As String
Dim nDigAlg As Long
oDebug.PPrint vbCrLf & "As above but this time it's an MD5 digest..."
strCmsFile = m_strTestDir & "BasicSignByAliceMD5.p7s"
' Dimension string ready for longest possible
strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg & " (expected 1)"
If nDigAlg <> 1 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
Stop
End If
' We need to trim this string
strHexDigest = TrimNull(strHexDigest)
oDebug.PPrint "Digest is [" & strHexDigest & "]"
End Function
Public Function sime_GetDigestFromDetSig()
' Get the digest value from the detached signature
Dim nDigAlg As Long
Dim strCmsFile As String
Dim strHexDigest As String
oDebug.PPrint vbCrLf & "Get the digest value from the detached signature..."
strCmsFile = m_strTestDir & "DetSignByAlice.p7s"
' Dimension string ready for longest possible
strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg
If nDigAlg < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
Stop
End If
' We need to trim this string
strHexDigest = TrimNull(strHexDigest)
oDebug.PPrint "Digest is [" & strHexDigest & "]"
End Function
Public Function smime_FullSigDataDigestCheck()
' Do a full check on the original signed-data object
Dim strCmsFile As String
Dim strHexDigest As String
Dim nDigAlg As Long
Dim strData As String
Dim nDataLen As Long
Dim strContentDigest As String
Dim nHashLen As Long
oDebug.PPrint vbCrLf & "Do a full check on the original signed-data object..."
strCmsFile = m_strTestDir & "4.2.bin"
' Get the digest value
strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg
If nDigAlg < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
Stop
Exit Function
End If
strHexDigest = TrimNull(strHexDigest)
oDebug.PPrint "Extracted digest is"
oDebug.PPrint "[" & strHexDigest & "]"
' Go get the content - in this case it's in the signed-data object
nDataLen = CMS_ReadSigDataToString("", 0, strCmsFile, 0)
If nDataLen <= 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigDataToString"
Stop
Exit Function
End If
strData = String(nDataLen, " ")
nDataLen = CMS_ReadSigDataToString(strData, nDataLen, strCmsFile, 0)
oDebug.PPrint "CMS_ReadSigDataToString returns " & nDataLen
oDebug.PPrint "Data is [" & strData & "]"
' Compute independently the hash of what we found
strContentDigest = String(PKI_MAX_HASH_CHARS, " ")
' (Note how we use the digest algorithm code returned above)
nHashLen = HASH_HexFromString(strContentDigest, Len(strContentDigest), strData, nDataLen, nDigAlg)
oDebug.PPrint "Computed hash of content is"
oDebug.PPrint "[" & Left$(strContentDigest, nHashLen) & "]"
' Can we match this hash digest with what we extracted from the signed-data?
strContentDigest = Left(strContentDigest, nHashLen)
strHexDigest = Left(strHexDigest, nHashLen)
If strContentDigest = strHexDigest Then
oDebug.PPrint "SUCCESS - digests match!"
Else
oDebug.PPrint "FAILS! - no match"
MsgBox "Digests are not equal", vbCritical
Stop
End If
End Function
Public Function smime_FullSigDataDigestCheckMD5()
' Ditto using signed-data file with MD5 digest
Dim strCmsFile As String
Dim strHexDigest As String
Dim nDigAlg As Long
Dim strData As String
Dim nDataLen As Long
Dim strContentDigest As String
Dim nHashLen As Long
oDebug.PPrint vbCrLf & "Ditto using signed-data file with MD5 digest..."
strCmsFile = m_strTestDir & "BasicSignByAliceMD5.p7s"
' Get the digest value
strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg
If nDigAlg < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
Stop
Exit Function
End If
oDebug.PPrint "Extracted digest is"
oDebug.PPrint "[" & strHexDigest & "]"
' Go get the content - in this case it's in the signed-data object
nDataLen = CMS_ReadSigDataToString("", 0, strCmsFile, 0)
If nDataLen <= 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigDataToString"
Stop
Exit Function
End If
strData = String(nDataLen, " ")
nDataLen = CMS_ReadSigDataToString(strData, nDataLen, strCmsFile, 0)
oDebug.PPrint "CMS_ReadSigDataToString returns " & nDataLen
oDebug.PPrint "Data is [" & strData & "]"
' Compute independently the hash of what we found
strContentDigest = String(PKI_MAX_HASH_CHARS, " ")
' (Note how we use the digest algorithm code returned above)
nHashLen = HASH_HexFromString(strContentDigest, Len(strContentDigest), strData, nDataLen, nDigAlg)
oDebug.PPrint "Computed hash of content is"
oDebug.PPrint "[" & strContentDigest & "]"
' Can we match this hash digest with what we extracted from the signed-data?
' (remember to trim the strings to the correct length)
strContentDigest = Left(strContentDigest, nHashLen)
strHexDigest = Left(strHexDigest, nHashLen)
If strContentDigest = strHexDigest Then
oDebug.PPrint "SUCCESS - digests match!"
Else
oDebug.PPrint "FAILS! - no match"
MsgBox "Digests are not equal", vbCritical
Stop
End If
End Function
Public Function Test_DecryptRaw()
' This is from Example 4.2 of smime-examples-12
Dim sEncDataHex As String
Dim abData() As Byte
Dim nDataLen As Long
Dim strCertFile As String
Dim nLen As Long
Dim strPublicKey As String
Dim nRet As Long
oDebug.PPrint vbCrLf & "Verify an RSA signature using Example 4.2 of smime-examples-12..."
' Cut and paste from DUMPASN1 output
sEncDataHex = "2F 23 82 D2 F3 09 5F B8 0C 58 EB 4E" & _
"9D BF 89 9A 81 E5 75 C4 91 3D D3 D0" & _
"D5 7B B6 D5 FE 94 A1 8A AC E3 C4 84" & _
"F5 CD 60 4E 27 95 F6 CF 00 86 76 75" & _
"3F 2B F0 E7 D4 02 67 A7 F5 C7 8D 16" & _
"04 A5 B3 B5 E7 D9 32 F0 24 EF E7 20" & _
"44 D5 9F 07 C5 53 24 FA CE 01 1D 0F" & _
"17 13 A7 2A 95 9D 2B E4 03 95 14 0B" & _
"E9 39 0D BA CE 6E 9C 9E 0C E8 98 E6" & _
"55 13 D4 68 6F D0 07 D7 A2 B1 62 4C" & _
"E3 8F AF FD E0 D5 5D C7"
' Convert to bytes
abData = cnvBytesFromHexStr(sEncDataHex)
' Check
oDebug.PPrint cnvHexStrFromBytes(abData)
strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
' Read in PublicKey as base64 string - pre-dimension first
nLen = RSA_GetPublicKeyFromCert(vbNullString, 0, strCertFile, 0)
If nLen <= 0 Then
oDebug.PPrint pkiGetLastError()
MsgBox "Unable to retrieve private key"
Exit Function
End If
' Pre-dimension the string to receive data
strPublicKey = String(nLen, " ")
' Read in the Key
nLen = RSA_GetPublicKeyFromCert(strPublicKey, Len(strPublicKey), strCertFile, 0)
' Verify using the public key
nDataLen = UBound(abData) + 1
oDebug.PPrint "Input: " & cnvHexStrFromBytes(abData)
nRet = RSA_RawPublic(abData(0), nDataLen, strPublicKey, 0)
oDebug.PPrint "Output: " & cnvHexStrFromBytes(abData)
' Stripping the PKCS-1.5 header, we should get
' 3021300906052B0E03021A05000414406AEC085279BA6E16022D9E0629C0229687DD48
' which is a DigestInfo containing the 20-byte SHA-1 hash
' 406AEC085279BA6E16022D9E0629C0229687DD48
End Function
Public Function Test_X509_CertThumb()
Dim nRet As Long
Dim strCertName As String
Dim strHexHash As String
' The Windows Certificate Manager gives the correct
' SHA-1 hash as 'B30C 4885 5055 C2E6 4CE3 1964 92D4 B838 31A6 B3CB'
oDebug.PPrint vbCrLf & "Compute the SHA-1 `thumbprint' of an X.509 certificate..."
strHexHash = String(40, " ")
strCertName = m_strTestDir & "AliceRSASignByCarl.cer"
nRet = X509_CertThumb(strCertName, strHexHash, Len(strHexHash), 0)
oDebug.PPrint "X509_CertThumb returns " & nRet & " for " & strCertName
oDebug.PPrint "Thumb =" & strHexHash
oDebug.PPrint "Correct=B30C48855055C2E64CE3196492D4B83831A6B3CB"
End Function
Public Function Test_X509_CertIsValidNow()
Dim nRet As Long
Dim strCertName As String
oDebug.PPrint vbCrLf & "Check that an X.509 certificate is valid now..."
strCertName = m_strTestDir & "AliceRSASignByCarl.cer"
nRet = X509_CertIsValidNow(strCertName, 0)
oDebug.PPrint "X509_CertIsValidNow returns " & nRet & " for " & strCertName
If nRet = 0 Then
oDebug.PPrint "Certificate is still valid"
Else
oDebug.PPrint "Certificate has expired or is not yet valid"
End If
End Function
Public Function Test_X509_VerifyCert()
' Verify that Alice's certficate was signed by Carl
' Returns 0 if OK, -1 if fails to validate, or +ve if other error
Dim nRet As Long
oDebug.PPrint vbCrLf & "Verify that Alice's certficate was signed by Carl..."
nRet = X509_VerifyCert(m_strTestDir & "AliceRSASignByCarl.cer", m_strTestDir & "CarlRSASelf.cer", 0)
If nRet = 0 Then
oDebug.PPrint "Verification is OK"
ElseIf nRet > 0 Then
oDebug.PPrint "Error: " & nRet & pkiGetLastError()
Else
oDebug.PPrint "Cert not issued by this Issuer"
End If
End Function
Public Function Test_X509_QueryCert()
' Query Alice's and Carl's certificates
Dim nRet As Long
Dim strCertName As String
Dim strQuery As String
Dim strResult As String
oDebug.PPrint vbCrLf & "Query Alice's and Carl's certificates..."
' Make an output buffer
strResult = String(64, " ")
strCertName = m_strTestDir & "AliceRSASignByCarl.cer"
oDebug.PPrint "Alice's Certificate:"
strQuery = "IssuerName"
nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
If nRet < 0 Then
oDebug.PPrint "Error: " & nRet & pkiGetLastError()
Else
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
End If
strQuery = "SubjectName"
nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
If nRet < 0 Then
oDebug.PPrint "Error: " & nRet & pkiGetLastError()
Else
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
End If
strQuery = "SerialNumber"
nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
If nRet < 0 Then
oDebug.PPrint "Error: " & nRet & pkiGetLastError()
Else
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
End If
' Repeat for Carl's cert
strCertName = m_strTestDir & "CarlRSASelf.cer"
oDebug.PPrint "Carl's Certificate:"
strQuery = "IssuerName"
nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
If nRet < 0 Then
oDebug.PPrint "Error: " & nRet & pkiGetLastError()
Else
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
End If
strQuery = "SubjectName"
nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
If nRet < 0 Then
oDebug.PPrint "Error: " & nRet & pkiGetLastError()
Else
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
End If
strQuery = "SerialNumber"
nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
If nRet < 0 Then
oDebug.PPrint "Error: " & nRet & pkiGetLastError()
Else
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
End If
End Function
Public Function smime_Ex4_2_MakeSigDataWithSHA256()
' As above but using input directly from a string and using
' SHA-256 instead of SHA-1 for the signature
' and adds Signing Time
' and then query the SigData file we made
Dim strEPKFile As String
Dim strPrivateKey As String
Dim nKeyLen As Long
Dim nRet As Long
Dim strInputFile As String
Dim strOutputFile As String
Dim strCertFile As String
Dim strQuery As String
Dim strResult As String
oDebug.PPrint vbCrLf & "Alice makes signed-data file from string input and uses SHA-256..."
strEPKFile = m_strTestDir & "AlicePrivRSASign.epk"
strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
strOutputFile = m_strTestDir & "SignedByAliceSHA256.p7s"
' Alice reads in her private string (which we encrypted earlier)
strPrivateKey = rsaReadPrivateKey(strEPKFile, "password")
If Len(strPrivateKey) = 0 Then
MsgBox "Cannot read private key", vbCritical
Stop
Exit Function
End If
' Now we can sign our message using SHA-256
nRet = CMS_MakeSigDataFromString(strOutputFile, "This is some sample content.", _
strCertFile, strPrivateKey, PKI_HASH_SHA256 + PKI_CMS_INCLUDE_ATTRS + PKI_CMS_ADD_SIGNTIME)
oDebug.PPrint "CMS_MakeSigDataFromString returns " & nRet & " (expected 0)"
If nRet = 0 Then
oDebug.PPrint "Created signed-data file " & strOutputFile
Else
MsgBox pkiGetLastError(), vbCritical, "CMS_MakeSigDataFromString"
Stop
End If
' Query the signature algorithm in the file we just made
strResult = String(64, " ")
strQuery = "digestAlgorithm"
nRet = CMS_QuerySigData(strResult, Len(strResult), strOutputFile, strQuery, 0)
If nRet < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_QuerySigData"
Stop
End If
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
' And the attributes
strResult = String(64, " ")
strQuery = "signingTime"
nRet = CMS_QuerySigData(strResult, Len(strResult), strOutputFile, strQuery, 0)
If nRet < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_QuerySigData"
Stop
End If
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
strResult = String(64, " ")
strQuery = "messageDigest"
nRet = CMS_QuerySigData(strResult, Len(strResult), strOutputFile, strQuery, 0)
If nRet < 0 Then
MsgBox pkiGetLastError(), vbCritical, "CMS_QuerySigData"
Stop
End If
oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
' And verify the signature using the sender's certificate included in the file
nRet = CMS_VerifySigData(strOutputFile, "", "", 0)
oDebug.PPrint "CMS_VerifySigData returns " & nRet & " (expecting 0)"
End Function
Public Sub Show_Version()
oDebug.PPrint vbCrLf & "Current CryptoSys PKI core DLL version is " & PKI_Version(0, 0)
End Sub