Attribute VB_Name = "X509_TestCerts"
' $Id: X509_TestCerts.bas $

' $Date: 2006-05-26 12:28:00 $

' This module uses functions from the CryptoSys (tm) PKI Toolkit
' available from <www.cryptosys.net/pki/>.
' Include the module `basCrPKI.bas' in your project.

'***************** COPYRIGHT NOTICE ********************
' This code was originally written by David Ireland and
' is copyright (C) 2006 DI Management Services Pty Ltd
' <www.di-mgt.com.au>.
' Provided "as is". No warranties. Use at your own risk.
' You must make your own assessment of its accuracy and
' suitability for your own purposes.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided this copyright notice is left unchanged.
'************** END OF COPYRIGHT NOTICE ****************

Option Explicit
Option Base 0

Public Function TestTheChain() As Boolean
    Dim nRet As Long
    Dim strCertName As String
    Dim strIssuerCert As String
    Dim strThumbPrint As String
    
    ' Chain: [Enid] issued by [Ian] issued by [Carl] self-issued by [Carl].
    ' Given the three certs, can we trust that Enid's certificate really is the one issued to her?
    ' Assumes we trust the CA's certificate and all certificates issued by it.
    ' Does not deal with certificate revokation (CRL) issues.
    
    ' 1. Is Enid's certificate currently valid?
    strCertName = "EnidRSASignedByIan.cer"
    nRet = X509_CertIsValidNow(strCertName, 0)
    If nRet > 0 Then
        Debug.Print "Error: " & nRet & " " & pkiGetLastError()
    ElseIf nRet < 0 Then
        MsgBox "Validation error: cert '" & strCertName & "' is no longer valid at this time.", vbCritical
        Exit Function
    Else
        Debug.Print "Cert '" & strCertName & "' is currently valid."
    End If
    
    ' 2. Was Enid's certificate issued by Ian?
    strIssuerCert = "IanRSASignedByCarl.cer"
    nRet = X509_VerifyCert(strCertName, strIssuerCert, 0)
    If nRet > 0 Then
        Debug.Print "Error: " & nRet & " " & pkiGetLastError()
    ElseIf nRet < 0 Then
        MsgBox "Validation error: cert '" & strCertName & "' was not issued by '" & strIssuerCert & "'.", vbCritical
        Exit Function
    Else
        Debug.Print "Verified that cert '" & strCertName & "' was issued by '" & strIssuerCert & "'."
    End If
    
    ' Continuing up the chain...
    ' 3. Is Ian's certificate currently valid?
    strCertName = "IanRSASignedByCarl.cer"
    nRet = X509_CertIsValidNow(strCertName, 0)
    If nRet > 0 Then
        Debug.Print "Error: " & nRet & " " & pkiGetLastError()
    ElseIf nRet < 0 Then
        MsgBox "Validation error: cert '" & strCertName & "' is no longer valid at this time.", vbCritical
        Exit Function
    Else
        Debug.Print "Cert '" & strCertName & "' is currently valid."
    End If
    
    ' 4. Was Ian's certificate issued by Carl?
    strIssuerCert = "CarlRSASelf.cer"
    nRet = X509_VerifyCert(strCertName, strIssuerCert, 0)
    If nRet > 0 Then
        Debug.Print "Error: " & nRet & " " & pkiGetLastError()
    ElseIf nRet < 0 Then
        MsgBox "Validation error: cert '" & strCertName & "' was not issued by '" & strIssuerCert & "'.", vbCritical
        Exit Function
    Else
        Debug.Print "Verified that cert '" & strCertName & "' was issued by '" & strIssuerCert & "'."
    End If
    
    ' At the top of the chain we have a self-signed certificate...
    ' 5. Is Carl's certificate currently valid?
    strCertName = "CarlRSASelf.cer"
    nRet = X509_CertIsValidNow(strCertName, 0)
    If nRet > 0 Then
        Debug.Print "Error: " & nRet & " " & pkiGetLastError()
    ElseIf nRet < 0 Then
        MsgBox "Validation error: cert '" & strCertName & "' is no longer valid at this time.", vbCritical
        Exit Function
    Else
        Debug.Print "Cert '" & strCertName & "' is currently valid."
    End If
    
    ' 6. Was Carl's certificate issued by Carl?
    strIssuerCert = "CarlRSASelf.cer"
    nRet = X509_VerifyCert(strCertName, strIssuerCert, 0)
    If nRet > 0 Then
        Debug.Print "Error: " & nRet & " " & pkiGetLastError()
    ElseIf nRet < 0 Then
        MsgBox "Validation error: cert '" & strCertName & "' was not issued by '" & strIssuerCert & "'.", vbCritical
        Exit Function
    Else
        Debug.Print "Verified that cert '" & strCertName & "' was issued by '" & strIssuerCert & "'."
    End If
    
    ' Finally, we can hard-code the "thumbprint" (hash digest) of the ultimate CA's certificate
    ' and check that it matches what we have in hand
    ' (you can get this value using CERTMGR.EXE).
    
    ' 7. Is Carl's certificate the one we expected?
    Const HARD_CODED_THUMBPRINT As String = "4110908F77C64C0EDFC2DE6273BFA9A98A9C5CE5"
    strCertName = "CarlRSASelf.cer"
    strThumbPrint = String(PKI_SHA1_CHARS, " ")
    nRet = X509_CertThumb(strCertName, strThumbPrint, Len(strThumbPrint), PKI_HASH_SHA1)
    Debug.Print "ThumbPrint(SHA-1, '" & strCertName & "')=" & strThumbPrint
    If UCase(strThumbPrint) = HARD_CODED_THUMBPRINT Then
        Debug.Print "CA cert's thumbprint matches what we expect."
    Else
        MsgBox "Validation error: cert '" & strCertName & "' does not have the thumbprint we expect.", vbCritical
        Exit Function
    End If
    
    ' If we got to here, we have validated the entire chain
    Debug.Print "OK, certificate chain has been validated."
    
    ' RETURN SUCCESS
    TestTheChain = True
    
End Function

Public Sub MakeAChain()
    Dim nRet As Long
    Dim strCertCA As String
    Dim strCertInt As String
    Dim strCertEnd As String
    Dim strPriKeyCA As String
    Dim strPriKeyInt As String
    Dim strPriKeyEnd As String
    Dim strPubKeyInt As String
    Dim strPubKeyEnd As String
    Dim nKeyUsageFlags As Long
    Dim nCertOptions As Long
    Dim nYears As Long
    
    ' Use S/MIME's Carl as CA
    strCertCA = "CarlRSASelf.cer"
    strPriKeyCA = "CarlPrivRSASign.epk"

    ' Intermediate authority Ian creates a pair of RSA keys
    strPubKeyInt = "IanPublicKey.bin"
    strPriKeyInt = "IanEncPrivKey.bin"
    nRet = RSA_MakeKeys(strPubKeyInt, strPriKeyInt, 512, PKI_RSAEXP_EQ_3, 50, 1000, "ianspassword", "", 0, PKI_KEYGEN_INDICATE)
    Debug.Print "RSA_MakeKeys returns " & nRet & " (expecting 0)"
    
    ' End user Enid creates a pair of RSA keys
    strPubKeyEnd = "EnidPublicKey.bin"
    strPriKeyEnd = "EnidEncPrivKey.bin"
    nRet = RSA_MakeKeys(strPubKeyEnd, strPriKeyEnd, 512, PKI_RSAEXP_EQ_3, 50, 1000, "enidspassword", "", 0, PKI_KEYGEN_INDICATE)
    Debug.Print "RSA_MakeKeys returns " & nRet & " (expecting 0)"
    
    ' Carl issues an "intermediate CA" certificate to Ian valid for 5 years
    strCertInt = "IanRSASignedByCarl.cer"
    nYears = 5
    nKeyUsageFlags = PKI_X509_KEYUSAGE_KEYCERTSIGN + PKI_X509_KEYUSAGE_CRLSIGN + PKI_X509_KEYUSAGE_DIGITALSIGNATURE
    nCertOptions = PKI_X509_CA_TRUE + PKI_X509_UTF8
    nRet = X509_MakeCert(strCertInt, strCertCA, strPubKeyInt, strPriKeyCA, &H3001, nYears, "CN=Ian", "", nKeyUsageFlags, "password", nCertOptions)
    Debug.Print "X509_MakeCert returns " & nRet & " (expecting 0)"
    
    ' Ian issues a certificate to Enid valid for 2 years
    strCertEnd = "EnidRSASignedByIan.cer"
    nYears = 2
    nKeyUsageFlags = 0
    nCertOptions = PKI_X509_NO_BASIC + PKI_X509_UTF8
    nRet = X509_MakeCert(strCertEnd, strCertInt, strPubKeyEnd, strPriKeyInt, &H1, nYears, "CN=Enid", "", nKeyUsageFlags, "ianspassword", nCertOptions)
    Debug.Print "X509_MakeCert returns " & nRet & " (expecting 0)"
    
End Sub


Public Sub X509_TestParentAndChild()
    ' Returns 0 if OK, -1 if fails to validate, or +ve other error
    Dim nRet As Long
    nRet = X509_VerifyCert("EnidRSASignedByIan.cer", "IanRSASignedByCarl.cer", 0)
    If nRet = 0 Then
        Debug.Print "Verification is OK"
    ElseIf nRet > 0 Then
        Debug.Print "Error: " & nRet & " " & pkiGetLastError()
    Else
        Debug.Print "Cert not issued by this Issuer"
    End If
End Sub

Public Sub MakeCertHash()
    Dim nRet As Long
    Dim strCertName As String
    Dim strThumbPrint As String
    
    strCertName = "CarlRSASelf.cer"
    strThumbPrint = String(PKI_SHA1_CHARS, " ")
    nRet = X509_CertThumb(strCertName, strThumbPrint, Len(strThumbPrint), PKI_HASH_SHA1)
    Debug.Print "ThumbPrint(SHA-1, '" & strCertName & "')=" & strThumbPrint
    
End Sub