Attribute VB_Name = "XML_UTF8chars"
Option Compare Text
Option Explicit

' $Id: XML_UTF8chars.bas $
' $Date: 2010-12-04 17:36 $
' $Author: dai $

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

' *************************** COPYRIGHT NOTICE ******************************
' This code was originally written by David Ireland and is copyright
' (C) 2010 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 **************************

Sub Main()
    Call XML_UTF8chars_Compute_Digest
    Call XML_UTF8chars_MakeSignature
    Call XML_UTF8chars_GetXMLPublicKeyFromCert
    Call XML_UTF8chars_GetXMLPublicKeyFromPrivate
End Sub


Public Function XML_UTF8chars_Compute_Digest() As String
    Dim strData As String
    Dim abData() As Byte
    Dim strDigest As String
    Dim nRet As Long
    Dim nDataLen As Long
    Dim strSig64 As String
    
    ' Input as (would be) read from original file (with LATIN SMALL LETTER N WITH TILDE)
    strData = "<Book xml:id=""F01"">" & vbCrLf & _
        "<FirstName>Bruceñ</FirstName>" & vbCrLf & _
        "</Book>"
    Debug.Print strData
    Debug.Print "ORIG= " & cnvHexStrFromString(strData)
    ' Line breaks are normalized to "#xA": i.e. convert CR-LF pairs to LF
    strData = Replace(strData, vbCrLf, vbLf)
    ' Convert to UTF-8
    nDataLen = CNV_UTF8BytesFromLatin1(vbNull, 0, strData)
    ReDim abData(nDataLen - 1)
    nDataLen = CNV_UTF8BytesFromLatin1(abData(0), nDataLen, strData)
    ' Display input as sequence of bytes in hex form
    Debug.Print "INPUT=" & cnvHexStrFromBytes(abData)
    ' Form SHA-1 digest of input
    strDigest = String(PKI_SHA1_CHARS, " ")
    nRet = HASH_HexFromBytes(strDigest, Len(strDigest), abData(0), nDataLen, PKI_HASH_SHA1)
    Debug.Print "DIGEST(hex)=" & strDigest
    ' Encode in base64
    strSig64 = cnvB64StrFromHexStr(strDigest)
    ' Return base64-encoded digest...
    Debug.Print "DIGEST(base64)=" & strSig64
End Function

Public Function XML_UTF8chars_MakeSignature()
    Dim strData As String
    Dim abData() As Byte
    Dim abBlock() As Byte
    Dim strSig As String
    Dim nRet As Long
    Dim nDataLen As Long
    Dim nBlkLen As Long
    Dim strInternalKey As String
    Dim strKeyFile As String
    Dim strPassword As String
    
    strData = "<SignedInfo xmlns=""http://www.w3.org/2000/09/xmldsig#"">" & vbCrLf & _
        "<CanonicalizationMethod Algorithm=""http://www.w3.org/TR/2001/REC-xml-c14n-20010315""></CanonicalizationMethod>" & vbCrLf & _
        "<SignatureMethod Algorithm=""http://www.w3.org/2000/09/xmldsig#rsa-sha1""></SignatureMethod>" & vbCrLf & _
        "<Reference URI=""#F01"">" & vbCrLf & _
        "<Transforms>" & vbCrLf & _
        "<Transform Algorithm=""http://www.w3.org/TR/2001/REC-xml-c14n-20010315""></Transform>" & vbCrLf & _
        "</Transforms>" & vbCrLf & _
        "<DigestMethod Algorithm=""http://www.w3.org/2000/09/xmldsig#sha1""></DigestMethod>" & vbCrLf & _
        "<DigestValue>/xrjkAVvCuoE3I5tudGdIyU5Gh0=</DigestValue>" & vbCrLf & _
        "</Reference>" & vbCrLf & _
        "</SignedInfo>"
    ' Convert CR-LF to LF
    strData = Replace(strData, vbCrLf, vbLf)
    ' No non-ASCII characters in input, so convert directly to byte array
    abData = StrConv(strData, vbFromUnicode)
    nDataLen = UBound(abData) + 1
    Debug.Print "Data length = " & nDataLen & " bytes"
    
    ' Read in the private key from the key file (encrypted "internal" format)
    strKeyFile = "AlicePrivRSASign.epk"
    strPassword = "password"
    strInternalKey = rsaReadPrivateKey(strKeyFile, strPassword)
    ' How long is it?
    nBlkLen = RSA_KeyBytes(strInternalKey)
    Debug.Print "Key length = " & nBlkLen & " bytes"
    If nBlkLen <= 0 Then Exit Function ' CATCH ERROR
    ReDim abBlock(nBlkLen - 1)
    ' Encode for PKCS1v1.5 signature (CAUTION: does not return the length)
    nRet = RSA_EncodeMsg(abBlock(0), nBlkLen, abData(0), nDataLen, PKI_EMSIG_PKCSV1_5)
    Debug.Print "RSA_EncodeMsg returns " & nRet
    Debug.Print "BLK=" & cnvHexStrFromBytes(abBlock)
    ' Sign using RSA private key
    nRet = RSA_RawPrivate(abBlock(0), nBlkLen, strInternalKey, 0)
    Debug.Print "SIG=" & cnvHexStrFromBytes(abBlock)
    ' Convert to base64 string
    strSig = cnvB64StrFromBytes(abBlock)
    ' Return the signature value in base64 form...
    Debug.Print "SIG=" & strSig

End Function

Public Sub XML_UTF8chars_GetXMLPublicKeyFromCert()
' How to get the XML <RSAKeyValue> field from an X.509 certificate file
    Dim strInternalKey As String
    Dim strCertFile As String
    Dim nLen As Long
    Dim strXml As String
    
    ' Read in the public key from the X.509 certificate file as an "internal" string
    strCertFile = "AliceRSASignByCarl.pem.cer"
    strInternalKey = rsaGetPublicKeyFromCert(strCertFile)
    
    ' Output the public key in XML form
    nLen = RSA_ToXMLString("", 0, strInternalKey, 0)
    If nLen <= 0 Then Exit Sub  'CATCH ERROR
    strXml = String(nLen, " ")
    nLen = RSA_ToXMLString(strXml, nLen, strInternalKey, 0)
    Debug.Print strXml

End Sub

Public Sub XML_UTF8chars_GetXMLPublicKeyFromPrivate()
' How to get the XML <RSAKeyValue> field from a PKCS-8 private key file
' DANGER!!!
' The RSA private key contains the public key, too, as a sub-set.
' So we can extract the public key in XML <RsaKeyValue> form.
' But be careful doing this trick. You may accidentally give away your private key!!!

    Dim strInternalKey As String
    Dim strKeyFile As String
    Dim strPassword As String
    Dim nLen As Long
    Dim strXml As String
    
    ' Read in the private key from the key file as an "internal" string (a one-off, ephemeral value)
    strKeyFile = "AlicePrivRSASign.epk"
    strPassword = "password"
    strInternalKey = rsaReadPrivateKey(strKeyFile, strPassword)
    
    ' Output the public key in XML form
    ' DANGER: Use the EXCLPRIVATE option or you will output your private key!!!
    nLen = RSA_ToXMLString("", 0, strInternalKey, PKI_XML_EXCLPRIVATE)
    If nLen <= 0 Then Exit Sub  'CATCH ERROR
    strXml = String(nLen, " ")
    nLen = RSA_ToXMLString(strXml, nLen, strInternalKey, PKI_XML_EXCLPRIVATE)
    ' CHECK: this should only contain <Modulus> and <Exponent> fields.
    ' If you see a <D> or <P> or <Q> field, you have made a mistake.
    Debug.Print strXml

End Sub