Attribute VB_Name = "XML_MakeSig"
Option Explicit
' $Id: XML_MakeSig.bas $
' $Date: 2009-01-16 $
' This module uses functions from the CryptoSys (tm) PKI Toolkit available from
' <www.cryptosys.net/pki/>.
' Include the module `basCrPKI' in your project.
' Ref: XML-Signature Syntax and Processing <http://www.w3.org/TR/xmldsig-core/>
' RFC 3275 <http://www.ietf.org/rfc/rfc3275.txt>
' XML Signature WG <http://www.w3.org/Signature/>
' Canonical XML Version 1.0 <http://www.w3.org/TR/2001/REC-xml-c14n-20010315/>
' RFC 3076 <http://www.ietf.org/rfc/rfc3076.txt>
' Test with the XML Security Library `Online XML Digital Signature Verifer'
' at <http://www.aleksey.com/xmlsec/xmldsig-verifier.html>
'***************************** COPYRIGHT NOTICE ****************************
' This code was originally written by David Ireland and is copyright
' (C) 2006-9 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 ************************
Public Sub Test_XMLMakeSig()
' User to change:
Const TEST_PATH As String = "C:\Test\"
' Input parameters:
Dim strTextTBS As String ' = raw text to be signed
Dim strPriKeyFile As String ' Encrypted pkcs-8 private key file
Dim strPassword As String
Dim strCertFile As String ' Signer's X.509 certificate file that matches the private key
' Output parameters:
Dim strXMLFileName As String
strTextTBS = "some text" & vbCrLf & " with spaces and CR-LF."
strPriKeyFile = TEST_PATH & "AlicePrivRSASign_epk.pem"
strPassword = "password"
strXMLFileName = TEST_PATH & "XmlAliceSig.xml"
If XMLMakeSigWithKeyData(strXMLFileName, strTextTBS, strPriKeyFile, strPassword) Then
Debug.Print "XMLMakeSig succeeded."
End If
End Sub
Public Function XMLMakeSigWithKeyData(strXMLFileName As String, strTextTBS As String, _
strPriKeyFile As String, strPassword As String) As Boolean
' Creates XML signature file given raw text-to-be-signed, encrypted pkcs-8 private key file and password.
Dim strCanonData As String
Dim abMessage() As Byte
Dim abDigest() As Byte
Dim nDataLen As Long
Dim nRet As Long
Dim strDigestBase64 As String
Dim strSignature64 As String
Dim abBlock() As Byte
Dim strPrivateKey As String
Dim nmLen As Long
Dim nkLen As Long
Dim abCertData() As Byte
Dim strXmlData As String
Dim strX509Data As String
Dim strSignedInfoDisplay As String
Dim strSignedInfoCanonic As String
Dim strXmlKey As String
Dim nXmlKeyLen As Long
' Canonicalize the data into the form to be digested
' Convert any CR-LF pairs to single LF
' TODO: convert non-US-ASCII to UTF-8
strCanonData = Replace(strTextTBS, vbCrLf, vbLf)
strCanonData = "<Object xmlns=""http://www.w3.org/2000/09/xmldsig#"" Id=""object"">" & strCanonData & "</Object>"
Debug.Print "CANON DATA='" & strCanonData & "'"
' Convert data string to unambiguous array of bytes
abMessage = StrConv(strCanonData, vbFromUnicode)
' Display data in hex format
Debug.Print "HEX(DATA)=" & cnvHexStrFromBytes(abMessage)
nDataLen = UBound(abMessage) - LBound(abMessage) + 1
' Create SHA-1 message digest of data in byte format
ReDim abDigest(PKI_SHA1_BYTES - 1) ' Don't forget to do this!
nRet = HASH_Bytes(abDigest(0), PKI_SHA1_BYTES, abMessage(0), nDataLen, PKI_HASH_SHA1)
Debug.Print "SHA-1(DATA)=" & cnvHexStrFromBytes(abDigest)
' Convert SHA-1 digest to base64 format
strDigestBase64 = cnvB64StrFromBytes(abDigest)
Debug.Print strDigestBase64
' Now we create the display and canonical forms of the SignedInfo element
' We cheat and do this by hard-coding.
strSignedInfoDisplay = "<SignedInfo>" & vbCrLf & _
" <CanonicalizationMethod Algorithm=""http://www.w3.org/TR/2001/REC-xml-c14n-20010315"" />" & vbCrLf & _
" <SignatureMethod Algorithm=""http://www.w3.org/2000/09/xmldsig#rsa-sha1"" />" & vbCrLf & _
" <Reference URI=""#object"">" & vbCrLf & _
" <DigestMethod Algorithm=""http://www.w3.org/2000/09/xmldsig#sha1"" />" & vbCrLf & _
" <DigestValue>" & strDigestBase64 & "</DigestValue>" & vbCrLf & _
" </Reference>" & vbCrLf & _
"</SignedInfo>"
' To canonicalize the SignedInfo, do the following:-
' 1. Replace any CR-LF pairs with single LF char
' 2. Add the xmlns attribute to the SignedInfo tag
' 3. Convert the three empty 'Method' elements to start-end tag pairs
' 4. Do NOT change any other whitespace chars outside the tags
' -- assumes all other c14n aspects are dealt with in the hard-coding
strSignedInfoCanonic = "<SignedInfo xmlns=""http://www.w3.org/2000/09/xmldsig#"">" & vbLf & _
" <CanonicalizationMethod Algorithm=""http://www.w3.org/TR/2001/REC-xml-c14n-20010315""></CanonicalizationMethod>" & vbLf & _
" <SignatureMethod Algorithm=""http://www.w3.org/2000/09/xmldsig#rsa-sha1""></SignatureMethod>" & vbLf & _
" <Reference URI=""#object"">" & vbLf & _
" <DigestMethod Algorithm=""http://www.w3.org/2000/09/xmldsig#sha1""></DigestMethod>" & vbLf & _
" <DigestValue>" & strDigestBase64 & "</DigestValue>" & vbLf & _
" </Reference>" & vbLf & _
"</SignedInfo>"
' And sign the canonical form using rsa-sha1
' Convert ANSI text to bytes
abMessage = StrConv(strSignedInfoCanonic, vbFromUnicode)
Debug.Print "M (ansi): '" & StrConv(abMessage, vbUnicode) & "'"
Debug.Print "M (hex): " & cnvHexStrFromBytes(abMessage)
' Compute SHA-1 digest as a check...
nRet = HASH_Bytes(abDigest(0), PKI_SHA1_BYTES, abMessage(0), nDataLen, PKI_HASH_SHA1)
Debug.Print "SHA-1(M)=" & cnvHexStrFromBytes(abDigest)
' Read in the private key from encrypted file
strPrivateKey = rsaReadPrivateKey(strPriKeyFile, "password")
If Len(strPrivateKey) = 0 Then
MsgBox "Cannot read RSA key file '" & strPriKeyFile & "'", vbCritical
Exit Function
End If
' To sign: first encode the message, then "encrypt" with RSA
' Compute lengths
nmLen = UBound(abMessage) - LBound(abMessage) + 1
nkLen = RSA_KeyBytes(strPrivateKey)
Debug.Print "Key is " & nkLen & " bytes long"
Debug.Print "Message is " & nmLen & " bytes long"
' Encode for signature
ReDim abBlock(nkLen - 1)
nRet = RSA_EncodeMsg(abBlock(0), nkLen, abMessage(0), nmLen, PKI_EMSIG_PKCSV1_5)
Debug.Print "RSA_EncodeMsg returns " & nRet & " (expected 0)"
Debug.Print "EM: " & cnvHexStrFromBytes(abBlock)
' Sign using RSA private key
nRet = RSA_RawPrivate(abBlock(0), nkLen, strPrivateKey, 0)
Debug.Print "SG: " & cnvHexStrFromBytes(abBlock)
' Create an XML version of the public key
' (the RSA public key is kept in the private key info)
' DANGER: do NOT export the private part as well!
nXmlKeyLen = RSA_ToXMLString("", 0, strPrivateKey, PKI_XML_EXCLPRIVATE)
If (nXmlKeyLen < 0) Then
MsgBox "Unable to create XML version of public key.", vbCritical
Exit Function
End If
strXmlKey = String(nXmlKeyLen, " ")
nRet = RSA_ToXMLString(strXmlKey, Len(strXmlKey), strPrivateKey, PKI_XML_EXCLPRIVATE)
' Clear the internal private key for security
Call WIPE_String(strPrivateKey, Len(strPrivateKey))
' Convert the signature value to base64
strSignature64 = cnvB64StrFromBytes(abBlock)
Debug.Print "SG: " & strSignature64
' Now we have all we need to compose the standard XML document
' and insert our own base64 elements
' NOTE: this assumes the text-to-be-signed is UTF-8
strXmlData = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf & _
"<Signature xmlns=""http://www.w3.org/2000/09/xmldsig#"">" & vbCrLf & _
"" & strSignedInfoDisplay & vbCrLf & _
"<SignatureValue>" & strSignature64 & "</SignatureValue>" & vbCrLf & _
"<KeyInfo>" & vbCrLf & _
" <KeyValue>" & vbCrLf & _
" " & strXmlKey & vbCrLf & _
" </KeyValue>" & vbCrLf & _
"</KeyInfo>" & vbCrLf & _
"<Object Id=""object"">" & strTextTBS & "</Object>" & vbCrLf & _
"</Signature>" & vbCrLf
' Save XML as a text file - clobbering any existing file without question
If WriteFileFromString(strXMLFileName, strXmlData) Then
' SUCCESS!
Debug.Print "Created file '" & strXMLFileName & "'"
XMLMakeSigWithKeyData = True
Else
MsgBox "Failed to create XML file", vbCritical
End If
End Function
Private Function WriteFileFromString(sFilePath As String, strIn As String) As Boolean
' Creates a file from a string. Clobbers any existing file.
On Error GoTo OnError
Dim hFile As Integer
If Len(Dir(sFilePath)) > 0 Then
Kill sFilePath
End If
hFile = FreeFile
Open sFilePath For Binary Access Write As #hFile
Put #hFile, , strIn
Close #hFile
WriteFileFromString = True
Done:
Exit Function
OnError:
Resume Done
End Function