´╗┐Imports System
Imports System.Text
Imports System.Diagnostics
Imports System.IO
Imports Sc14n
Imports Pki = CryptoSysPKI

'  
' * $Id: TestSc14nPKI.vb $
' * Last updated:
' *   $Date: 2017-07-15 16:37 $
' *   $Version: 0.9.0a $
' 

' Some tests using the SC14N .NET interface with CryptoSys PKI.
' * 
' * Requires `Sc14n` and `CryptoSys PKI` to be installed on your system,
' * Available from <http://di-mgt.com.au/sc14n/> and <http://www.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://www.di-mgt.com.au/contact>
' 

'****************************** LICENSE ***********************************
' * Copyright (C) 2017 David Ireland, DI Management Services Pty Limited.
' * All rights reserved. <www.di-mgt.com.au> <www.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.ExcludeByTag, 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