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