Imports System
Imports System.Text
Imports System.Diagnostics
Imports System.IO
Imports Sc14n
Imports Pki = CryptoSysPKI
'
' * $Id: TestSc14nPki.vb $
' * Last updated:
' * $Date: 2019-12-13 17:51 $
' * $Version: 2.1.0 $
'
' Some tests using the SC14N .NET interface with CryptoSys PKI.
' *
' * Requires `Sc14n` and `CryptoSys PKI` to be installed on your system,
' * Available from <http://cryptosys.net/sc14n/> and <http://cryptosys.net/pki>,
' * repectively.
' * Add references to .NET libraries `diSc14nNet.dll` and `diCrSysPKINet.dll`.
' * Note we've used "Pki" as an alias for "CryptoSysPKI" to save typing.
' *
' * Test files, e.g. `olamundo.xml`, are in `sc14n-testfiles.zip`. These must be in the CWD.
' *
' * This is a Console Application written for target .NET Framework 2.0 and above
' * Please report any bugs to <http://cryptosys.net/contact>
'
'****************************** LICENSE ***********************************
' * Copyright (C) 2017-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>
'****************************************************************************
'
' Ported from C# to VB.NET using icsharpcode.net's SharpDevelop.
Namespace TestSc14nPKI
Class TestSc14nPKI
Public Shared Sub Main(args As String())
' If either of these fail, the package is not installed properly...
Console.WriteLine("Sc14n Version={0}", Sc14n.Gen.Version())
Console.WriteLine("CrPKI Version={0}", Pki.General.Version())
Dim fname As String, oname As String
Dim n As Integer
Dim isLatin1 As Boolean
' With .NET we need to "know" the encoding of the input data.
' Input XML is ISO-8859-1 encoded (aka Latin-1)
fname = "olamundo-base.xml"
oname = "olamundo-new-signed.xml"
isLatin1 = True
Console.WriteLine("FILE: {0}", fname)
n = MakeSignedXml(oname, fname, myPriKey, myPassword, isLatin1)
Console.WriteLine("MakeSignedXml->'{0}' returns {1} (expecting 0)", oname, n)
Debug.Assert(0 = n)
' Input XML contains Chinese characters UTF-8-encoded
fname = "daiwei-base.xml"
oname = "daiwei-new-signed.xml"
isLatin1 = False
Console.WriteLine("FILE: {0}", fname)
n = MakeSignedXml(oname, fname, myPriKey, myPassword, isLatin1)
Console.WriteLine("MakeSignedXml->'{0}' returns {1} (expecting 0)", oname, n)
Debug.Assert(0 = n)
' Input XML contains Chinese characters as character entities
' Note that digest value and signature value should be identical to previous one
fname = "daiwei-ents-base.xml"
oname = "daiwei-ents-new-signed.xml"
isLatin1 = False
Console.WriteLine("FILE: {0}", fname)
n = MakeSignedXml(oname, fname, myPriKey, myPassword, isLatin1)
Console.WriteLine("MakeSignedXml->'{0}' returns {1} (expecting 0)", oname, n)
Debug.Assert(0 = n)
Console.WriteLine(vbLf & "ALL DONE.")
End Sub
''' <summary>
''' Create a XML-DSIG signed file given proforma XML document
''' </summary>
''' <param name="outFile">Name of outfile to create</param>
''' <param name="baseFile">Name of input XML document</param>
''' <param name="priKey">PKCS8 encrypted private key file or PEM-string</param>
''' <param name="password">Password for private key</param>
''' <param name="isLatin1">Set true if file is known to be Latin-1 encoded (ISO-8859-1) or false if UTF-8 or US-ASCII</param>
''' <returns>Zero (0) on success otherwise nonzero error code (an integer cast of <see cref="MSXerror"/> enum)</returns>
''' <remarks>Input XML document is expected to be enveloped-signature with single reference URI="",
''' C14N method REC-xml-c14n-20010315, signature method xmldsig#rsa-sha1, and digest method xmldsig#sha1.
''' KeyValue is expected to be in RSAKeyValue form.
''' Items to be replaced should be marked "%digval%", "%sigval%" and "%keyval%".
''' </remarks>
Public Shared Function MakeSignedXml(outFile As String, baseFile As String, priKey As String, password As String, isLatin1 As Boolean) As Integer
Dim b As Byte(), dataIn As Byte(), dataOut As Byte()
Dim s As String, xmlStr As String, newStr As String
Dim digval As String, digval_si As String, sigval As String, keyval As String
Dim status As Integer
' Compute digest value of body excluding <Signature> element
' (this assumes Reference URI="" and DigestMethod is SHA-1)
digval = C14n.ToDigest(baseFile, "Signature", Tran.OmitByTag, DigAlg.Sha1)
Debug.WriteLine("DIGVAL={0}", digval)
If digval.Length = 0 Then
Return CInt(MSXerror.TransformExclSignatureFailed)
End If
' Extract the SignedInfo element into memory
' Note %digval% parameter to be completed
b = C14n.ToBytes(baseFile, "SignedInfo", Tran.SubsetByTag)
If b.Length = 0 Then
Return CInt(MSXerror.TransformSignedInfoFailed)
End If
Debug.WriteLine("SIGNEDINFO (BASE):")
Debug.WriteLine(System.Text.Encoding.UTF8.GetString(b))
' Insert the required DigestValue we prepared earlier
' Note the SignedInfo element is *always* US-ASCII encoded,
' so we can safely use the more convenient String.Replace function
s = System.Text.Encoding.UTF8.GetString(b).Replace("%digval%", digval)
Debug.WriteLine("SIGNEDINFO (COMPLETED):")
Debug.WriteLine(s)
' Now compute the digest value of this string
digval_si = C14n.ToDigest(System.Text.Encoding.UTF8.GetBytes(s), DigAlg.Sha1)
Debug.WriteLine("SHA1(signedinfo)= {0}", digval_si)
' Compute signature value from this digest value
sigval = SigValFromDigVal(digval_si, priKey, myPassword)
Debug.WriteLine("SIG= {0}", sigval)
' Get the RSA Key Value in required XML form
keyval = KeyValFromCert(priKey)
' Now compose the output file by substituting the correct values
' (Note we make no other checks of the input XML - that's up to you)
' Read in base XML file as a byte array
dataIn = ReadABinaryFile(baseFile)
If dataIn.Length = 0 Then
Return CInt(MSXerror.ReadFileFailed)
End If
' Convert to a string so we can use String.Replace
' We need to know the encoding
If isLatin1 Then
xmlStr = System.Text.Encoding.GetEncoding("ISO-8859-1").GetString(dataIn)
Else
xmlStr = System.Text.Encoding.UTF8.GetString(dataIn)
End If
Debug.WriteLine(xmlStr)
newStr = xmlStr.Replace("%digval%", digval).Replace("%sigval%", sigval).Replace("keyval", keyval)
' Convert back to bytes then write out file
If isLatin1 Then
dataOut = System.Text.Encoding.GetEncoding("ISO-8859-1").GetBytes(newStr)
Else
dataOut = System.Text.Encoding.UTF8.GetBytes(newStr)
End If
status = (If(WriteABinaryFile(outFile, dataOut), 0, CInt(MSXerror.WriteFileFailed)))
Return status
End Function
''' <summary>
''' Error codes for MakeSignedXml
''' </summary>
Public Enum MSXerror
OkSuccess = 0
WriteFileFailed
ReadFileFailed
TransformExclSignatureFailed
TransformSignedInfoFailed
End Enum
'**********************
' PKI HELPER FUNCTIONS
'**********************
''' <summary>
''' Compute the signature value from digest value.
''' </summary>
''' <param name="digval">Base64-encoded digest value of data to be signed</param>
''' <param name="priKey">PKCS8 encrypted private key file or PEM-string</param>
''' <param name="password">Password for private key</param>
''' <returns>Base64-encoded signature value or empty string on error</returns>
Public Shared Function SigValFromDigVal(digval As String, priKey As String, password As String) As String
Dim sigval As String = Pki.Sig.SignDigest(Pki.Cnv.FromBase64(digval), priKey, password, Pki.SigAlgorithm.Rsa_Sha1)
Return sigval
End Function
''' <summary>
''' Extract XML-style RSAKeyValue from X.509 certificate.
''' </summary>
''' <param name="cert">X.509 certificate file or PEM string</param>
''' <returns>RSAKeyValue as a string or empty string on error</returns>
Public Shared Function KeyValFromCert(cert As String) As String
Dim keyval As String = Pki.Rsa.ToXMLString(Pki.Rsa.ReadPublicKey(cert).ToString(), 0)
Return keyval
End Function
''' <summary>
''' Extract XML-style RSAKeyValue from RSA private key.
''' </summary>
''' <param name="priKey">PKCS8 encrypted private key file or PEM-string</param>
''' <param name="password">Password for private key</param>
''' <returns>RSAKeyValue as a string or empty string on error</returns>
Public Shared Function KeyValFromPriKey(priKey As String, password As String) As String
' CAUTION: make sure you exclude the private key parameters here
Dim keyval As String = Pki.Rsa.ToXMLString(Pki.Rsa.ReadPrivateKey(priKey, password).ToString(), Pki.Rsa.XmlOptions.ExcludePrivateParams)
Return keyval
End Function
''' <summary>
''' Return true if private key and certificate are matched.
''' </summary>
''' <param name="priKey">PKCS8 encrypted private key file or PEM-string</param>
''' <param name="password">Password for private key</param>
''' <param name="cert">X.509 certificate file or PEM string</param>
''' <returns>true if private key and certificate are matched or false if not</returns>
Public Shared Function IsKeyAndCertMatch(priKey As String, password As String, cert As String) As Boolean
Dim n As Integer = Pki.Rsa.KeyMatch(Pki.Rsa.ReadPrivateKey(priKey, password), Pki.Rsa.ReadPublicKey(cert))
Return (0 = n)
End Function
' HARD-CODED PRIVATE KEY AND CERTIFICATE (FOR OUR CONVENIENCE IN TESTING)
' Alice's PKCS8 encrypted key and X.509 certificate
' from RFC 4134 "Examples of S/MIME Messages"
' Private key password is "password"
Private Const myPassword As String = "password"
' High security practice here!!
Private Const myPriKey As String = "-----BEGIN ENCRYPTED PRIVATE KEY-----" & vbCr & vbLf & " MIICojAcBgoqhkiG9w0BDAEDMA4ECFleZ90vhGrRAgIEAASCAoA9rti16XVH" & vbCr & vbLf & " K4AJVe1CNf61NIpIogu/Xs4Yn4hXflvewiOwe6/9FkxBXLbhKdbQWn1Z4p3C" & vbCr & vbLf & " njVns2VYEO/qpJR3LciHMwp5dsqedUVVia//CqFHtEV9WfvCKWgmlkkT1YEm" & vbCr & vbLf & " 1aChZnPP5i6IhwVT9qvFluTZhvVmjW0YyF86OrOp0uxxVic7phPbnPrOMelf" & vbCr & vbLf & " ZPc3A3EGpzDPkxN+o0obw87tUgCL+s0KtUOr3c6Si4KQ3IQjrjZxQF4Se3t/" & vbCr & vbLf & " 4PEpqUl5EpYiCx9q5uqb0Lr1kWiiQ5/inZm5ETc+qO+ENcp0KjnX523CATYd" & vbCr & vbLf & " U5iOjl/X9XZeJrMpOCXogEuhmLPRauYP1HEWnAY/hLW93v10QJXY6ALlbkL0" & vbCr & vbLf & " sd5WU8Ces7T04b/p4/12yxqYqV68QePyfHpegdraDq3vRfopSwrUxtL9cisP" & vbCr & vbLf & " jsQcJ5FL/SfloFbmld4CKIjMsromsEWqo6rfo3JqNizgTVIIWExy3jDT9VvK" & vbCr & vbLf & " d9ADH0g3JCbuFzaWVOZMmZ0wlo28PKkLQ8FkW8CG/Lq/Q/bHLPM+sPdLN+ke" & vbCr & vbLf & " gpA6fvL4wpku4ST7hmeN1vWbRLlCfuFijux77hdM7knO9/MawICsA4XdzR78" & vbCr & vbLf & " p0C2hJlc6p46IWZaINQXGstTbJMh+mJ7i1lrbG2kvZ2Twf9R+RaLp2mPHjb1" & vbCr & vbLf & " +P+3f2L3tOoC31oJ18u/L1MXEWxLEZHB0+ANg+N/0/icwImcI0D+wVN2puU4" & vbCr & vbLf & " m58j81sGZUEAB3aFEbPxoX3y+qYlOnt1OfdY7WnNdyr9ZzI09fkrTvujF4LU" & vbCr & vbLf & " nycqE+MXerf0PxkNu1qv9bQvCoH8x3J2EVdMxPBtH1Fb7SbE66cNyh//qzZo" & vbCr & vbLf & " B9Je" & vbCr & vbLf & " -----END ENCRYPTED PRIVATE KEY-----"
Private Const myCert As String = "-----BEGIN CERTIFICATE-----" & vbCr & vbLf & " MIICLDCCAZWgAwIBAgIQRjRrx4AAVrwR024uxBCzsDANBgkqhkiG9w0BAQUFADAS" & vbCr & vbLf & " MRAwDgYDVQQDEwdDYXJsUlNBMB4XDTk5MDkxOTAxMDg0N1oXDTM5MTIzMTIzNTk1" & vbCr & vbLf & " OVowEzERMA8GA1UEAxMIQWxpY2VSU0EwgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJ" & vbCr & vbLf & " AoGBAOCJczmN2PX16Id2OX9OsAW7U4PeD7er3H3HdSkNBS5tEt+mhibU0m+qWCn8" & vbCr & vbLf & " l+z6glEPMIC+sVCeRkTxLLvYMs/GaG8H2bBgrL7uNAlqE/X3BQWT3166NVbZYf8Z" & vbCr & vbLf & " f8mB5vhs6odAcO+sbSx0ny36VTq5mXcCpkhSjE7zVzhXdFdfAgMBAAGjgYEwfzAM" & vbCr & vbLf & " BgNVHRMBAf8EAjAAMA4GA1UdDwEB/wQEAwIGwDAfBgNVHSMEGDAWgBTp4JAnrHgg" & vbCr & vbLf & " eprTTPJCN04irp44uzAdBgNVHQ4EFgQUd9K00bdMioqjzkWdzuw8oDrj/1AwHwYD" & vbCr & vbLf & " VR0RBBgwFoEUQWxpY2VSU0FAZXhhbXBsZS5jb20wDQYJKoZIhvcNAQEFBQADgYEA" & vbCr & vbLf & " PnBHqEjME1iPylFxa042GF0EfoCxjU3MyqOPzH1WyLzPbrMcWakgqgWBqE4lradw" & vbCr & vbLf & " FHUv9ceb0Q7pY9Jkt8ZmbnMhVN/0uiVdfUnTlGsiNnRzuErsL2Tt0z3Sp0LF6DeK" & vbCr & vbLf & " tNufZ+S9n/n+dO/q+e5jatg/SyUJtdgadq7rm9tJsCI=" & vbCr & vbLf & " -----END CERTIFICATE-----"
'*****************
' FILE UTILITIES *
'*****************
Private Shared Function ReadABinaryFile(fileName As String) As Byte()
Dim b As Byte() = New Byte(-1) {}
Dim finfo As New FileInfo(fileName)
If finfo.Exists Then
Dim fsi As FileStream = finfo.OpenRead()
Dim br As New BinaryReader(fsi)
Dim count As Integer = CInt(fsi.Length)
b = br.ReadBytes(count)
br.Close()
fsi.Close()
End If
Debug.Assert(finfo.Exists, "File '" & fileName & "' does not exist.")
Return b
End Function
Private Shared Function WriteABinaryFile(fileName As String, data As Byte()) As Boolean
Dim fs As FileStream
Dim bw As BinaryWriter
fs = New FileStream(fileName, FileMode.Create, FileAccess.Write)
bw = New BinaryWriter(fs)
bw.Write(data)
bw.Close()
fs.Close()
Return True
End Function
End Class
End Namespace