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