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

' $Date: 2019-01-20 18:37:00 $

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

'******************************* LICENSE ***********************************
' Copyright (C) 2006-19 David Ireland, DI Management Services Pty Limited.
' All rights reserved. <https://di-mgt.com.au> <https://cryptosys.net>
' The code in this module is licensed under the terms of the MIT license.
' For a copy, see <http://opensource.org/licenses/MIT>
'***************************************************************************

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


''' Get the SHA-1 hash digest of Carl's certificate
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