Imports System.Security.Cryptography.X509Certificates
Imports System.Text.RegularExpressions
Imports Newtonsoft.Json

Namespace Models
    Public Class CertificateLoginBridgeOptions
        Public Property PublicUrl As String = String.Empty
        Public Property ForwardedCertificateHeader As String = "X-ARR-ClientCert"
        Public Property AdditionalForwardedCertificateHeaders As List(Of String) = New List(Of String)()
        Public Property AllowedParentOrigins As List(Of String) = New List(Of String)()

        Public Shared Function LoadFromConfiguration() As CertificateLoginBridgeOptions
            Dim publicUrl = FirstNonEmpty(
                ConfigurationManager.AppSettings("CertificateLoginPublicUrl"),
                ConfigurationManager.AppSettings("UrlCertLogin"))

            Dim forwardedCertificateHeader = FirstNonEmpty(
                ConfigurationManager.AppSettings("CertificateForwardedHeader"),
                ConfigurationManager.AppSettings("CertHeaderName"),
                "X-ARR-ClientCert")

            Dim additionalHeadersSetting = FirstNonEmpty(
                ConfigurationManager.AppSettings("CertificateAdditionalForwardedHeaders"),
                ConfigurationManager.AppSettings("AdditionalCertHeaders"))

            Dim allowedOriginsSetting = FirstNonEmpty(
                ConfigurationManager.AppSettings("CertificateAllowedParentOrigins"),
                ConfigurationManager.AppSettings("AllowedParentOrigins"))

            Return New CertificateLoginBridgeOptions With {
                .PublicUrl = publicUrl,
                .ForwardedCertificateHeader = forwardedCertificateHeader,
                .AdditionalForwardedCertificateHeaders = SplitSetting(additionalHeadersSetting),
                .AllowedParentOrigins = SplitSetting(allowedOriginsSetting)
            }
        End Function

        Private Shared Function SplitSetting(value As String) As List(Of String)
            If String.IsNullOrWhiteSpace(value) Then
                Return New List(Of String)()
            End If

            Return value.Split(New Char() {";"c, "|"c}, StringSplitOptions.RemoveEmptyEntries).
                Select(Function(item) item.Trim()).
                Where(Function(item) item <> String.Empty).
                ToList()
        End Function

        Private Shared Function FirstNonEmpty(ParamArray values() As String) As String
            For Each value In values
                If Not String.IsNullOrWhiteSpace(value) Then
                    Return value.Trim()
                End If
            Next

            Return String.Empty
        End Function
    End Class

    Public Class CertificateProxyLoginResponse
        Public Property Token As String = String.Empty
        Public Property User As CertificateProxyUser
    End Class

    Public Class CertificateProxyUser
        Public Property NIF As String = String.Empty
        Public Property NOMBRE As String = String.Empty
        Public Property APELLIDOS As String = String.Empty
        Public Property ADMINISTRARPTYREGISTRO As Boolean?
    End Class

    Public Module CertificateLoginBridgeHelper
        Private ReadOnly DefaultCertificateHeaders As String() = {
            "X-ARR-ClientCert",
            "X-Client-Cert",
            "X-Client-Cert-Der-Base64",
            "X-Client-Certificate",
            "X-Client-Certificate-Der-Base64",
            "X-SSL-CERT",
            "X-SSL-Client-Cert",
            "X-SSL-Client-Cert-Base64",
            "X-Tls-Client-Cert",
            "X-Tls-Client-Cert-Der-Base64",
            "X-Forwarded-Tls-Client-Cert",
            "Ssl-Client-Cert"
        }

        Private ReadOnly DefaultCertificateServerVariables As String() = {
            "SSL_CLIENT_CERT",
            "HTTP_SSL_CLIENT_CERT",
            "HTTP_X_SSL_CLIENT_CERT",
            "HTTP_X_CLIENT_CERT",
            "HTTP_X_CLIENT_CERTIFICATE",
            "HTTP_X_ARR_CLIENTCERT",
            "CERT_CERTIFICATE"
        }

        Public Function IsCertificateHostRequest(request As HttpRequest, publicUrl As String) As Boolean
            If request Is Nothing OrElse String.IsNullOrWhiteSpace(publicUrl) Then
                Return False
            End If

            Dim configuredUri As Uri = Nothing
            If Not Uri.TryCreate(publicUrl, UriKind.Absolute, configuredUri) Then
                Return False
            End If

            Dim forwardedHostRaw = GetFirstHeaderValue(request, "X-Forwarded-Host")
            Dim forwardedProtoRaw = GetFirstHeaderValue(request, "X-Forwarded-Proto")
            Dim forwardedPortRaw = GetFirstHeaderValue(request, "X-Forwarded-Port")
            Dim hasForwardedInfo =
                Not String.IsNullOrWhiteSpace(forwardedHostRaw) OrElse
                Not String.IsNullOrWhiteSpace(forwardedProtoRaw) OrElse
                Not String.IsNullOrWhiteSpace(forwardedPortRaw)

            Dim requestHost = ExtractHost(If(hasForwardedInfo, forwardedHostRaw, Nothing))
            If String.IsNullOrWhiteSpace(requestHost) AndAlso request.Url IsNot Nothing Then
                requestHost = request.Url.Host
            End If

            If Not String.Equals(requestHost, configuredUri.Host, StringComparison.OrdinalIgnoreCase) Then
                Return False
            End If

            If Not hasForwardedInfo Then
                Return True
            End If

            Dim requestScheme = FirstToken(forwardedProtoRaw)
            If String.IsNullOrWhiteSpace(requestScheme) Then
                requestScheme = configuredUri.Scheme
            End If

            Dim requestPort = ParseNullableInt(forwardedPortRaw)
            If Not requestPort.HasValue Then
                requestPort = ExtractPort(forwardedHostRaw)
            End If
            If Not requestPort.HasValue Then
                requestPort = GetDefaultPort(requestScheme)
            End If

            Dim configuredPort = If(configuredUri.IsDefaultPort, GetDefaultPort(configuredUri.Scheme), configuredUri.Port)
            Return String.Equals(requestScheme, configuredUri.Scheme, StringComparison.OrdinalIgnoreCase) AndAlso
                requestPort.Value = configuredPort
        End Function

        Public Function IsAllowedParentOrigin(parentOrigin As String, allowedParentOrigins As IEnumerable(Of String)) As Boolean
            Dim normalizedParentOrigin = NormalizeOrigin(parentOrigin)
            If String.IsNullOrWhiteSpace(normalizedParentOrigin) Then
                Return False
            End If

            Return allowedParentOrigins.
                Where(Function(origin) Not String.IsNullOrWhiteSpace(origin)).
                Select(Function(origin) NormalizeOrigin(origin)).
                Any(Function(origin) String.Equals(origin, normalizedParentOrigin, StringComparison.OrdinalIgnoreCase))
        End Function

        Public Function ReadCertificate(
            request As HttpRequest,
            forwardedCertificateHeader As String,
            additionalForwardedCertificateHeaders As IEnumerable(Of String)) As X509Certificate2

            Dim directCertificate = ReadDirectCertificate(request)
            If directCertificate IsNot Nothing Then
                Return directCertificate
            End If

            Dim headerCandidates As New List(Of String)()
            AddHeaderCandidate(headerCandidates, forwardedCertificateHeader)

            If additionalForwardedCertificateHeaders IsNot Nothing Then
                For Each headerName In additionalForwardedCertificateHeaders
                    AddHeaderCandidate(headerCandidates, headerName)
                Next
            End If

            For Each headerName In DefaultCertificateHeaders
                AddHeaderCandidate(headerCandidates, headerName)
            Next

            For Each headerName In headerCandidates.Distinct(StringComparer.OrdinalIgnoreCase)
                Dim rawHeader = request.Headers(headerName)
                If String.IsNullOrWhiteSpace(rawHeader) Then
                    Continue For
                End If

                Dim certificate = TryCreateCertificate(rawHeader)
                If certificate IsNot Nothing Then
                    Return certificate
                End If
            Next

            For Each serverVariableName In DefaultCertificateServerVariables
                Dim rawValue = request.ServerVariables(serverVariableName)
                If String.IsNullOrWhiteSpace(rawValue) Then
                    Continue For
                End If

                Dim certificate = TryCreateCertificate(rawValue)
                If certificate IsNot Nothing Then
                    Return certificate
                End If
            Next

            Return Nothing
        End Function

        Public Function ObtenerDni(certificado As X509Certificate2) As String
            Try
                If certificado Is Nothing Then
                    Return String.Empty
                End If

                Dim candidateValues As New List(Of String) From {
                    ExtractDistinguishedNameValue(certificado.Subject, "OID.2.5.4.97"),
                    ExtractDistinguishedNameValue(certificado.Subject, "2.5.4.97"),
                    ExtractDistinguishedNameValue(certificado.Subject, "SERIALNUMBER"),
                    ExtractDistinguishedNameValue(certificado.Subject, "OID.2.5.4.5"),
                    ExtractDistinguishedNameValue(certificado.Subject, "2.5.4.5"),
                    certificado.GetNameInfo(X509NameType.SimpleName, False)
                }

                For Each candidateValue In candidateValues
                    Dim nif = NormalizarIdentificadorFiscal(candidateValue)
                    If nif <> String.Empty Then
                        Return nif
                    End If
                Next

                Return NormalizarIdentificadorFiscal(certificado.Subject)
            Catch
                Return String.Empty
            End Try
        End Function

        Public Function BuildIframeDniHtml(dni As String, parentOrigin As String) As String
            Dim payloadJson = JsonConvert.SerializeObject(New With {
                .dni = dni
            })
            Dim targetOriginJson = JsonConvert.SerializeObject(NormalizeOrigin(parentOrigin))

            Return BuildIframePostMessageHtml(
                payloadJson,
                targetOriginJson,
                "Validando acceso con certificado...")
        End Function

        Public Function BuildIframeLoginHtml(response As CertificateProxyLoginResponse, parentOrigin As String) As String
            Dim payloadJson = JsonConvert.SerializeObject(New With {
                .token = response.Token,
                .user = response.User
            })
            Dim targetOriginJson = JsonConvert.SerializeObject(NormalizeOrigin(parentOrigin))

            Return BuildIframePostMessageHtml(
                payloadJson,
                targetOriginJson,
                "Validando acceso con certificado...")
        End Function

        Public Function BuildIframeErrorHtml(message As String, parentOrigin As String) As String
            Dim payloadJson = JsonConvert.SerializeObject(New With {
                .error = message
            })
            Dim targetOriginJson = JsonConvert.SerializeObject(NormalizeOrigin(parentOrigin))
            Dim safeMessage = If(String.IsNullOrWhiteSpace(message), "No se pudo completar el acceso con certificado.", message)

            Return BuildIframePostMessageHtml(
                payloadJson,
                targetOriginJson,
                safeMessage)
        End Function

        Private Function BuildIframePostMessageHtml(
            payloadJson As String,
            targetOriginJson As String,
            visibleMessage As String) As String

            Dim visibleMessageJson = JsonConvert.SerializeObject(visibleMessage)

            Return "<!DOCTYPE html>" &
                "<html>" &
                "<head><meta charset=""utf-8"" /><title>Autenticacion Certificado</title></head>" &
                "<body>" &
                "<div id=""bridgeStatus"" style=""font-family:Arial,sans-serif;font-size:14px;padding:16px;""></div>" &
                "<script>" &
                "(function(){" &
                "var payload = " & payloadJson & ";" &
                "var targetOrigin = " & targetOriginJson & ";" &
                "var visibleMessage = " & visibleMessageJson & ";" &
                "var targetWindow = null;" &
                "function renderMessage(){" &
                "var container = document.getElementById('bridgeStatus');" &
                "if (container && visibleMessage) { container.innerText = visibleMessage; }" &
                "}" &
                "if (window.opener && !window.opener.closed) {" &
                "targetWindow = window.opener;" &
                "} else if (window.parent && window.parent !== window) {" &
                "targetWindow = window.parent;" &
                "}" &
                "try {" &
                "if (targetWindow) {" &
                "targetWindow.postMessage(payload, targetOrigin);" &
                "}" &
                "} catch (postMessageError) {}" &
                "renderMessage();" &
                "if (window.opener && !window.opener.closed) {" &
                "setTimeout(function(){ try { window.close(); } catch (closeError) {} }, 150);" &
                "}" &
                "})();" &
                "</script>" &
                "</body>" &
                "</html>"
        End Function

        Private Function ReadDirectCertificate(request As HttpRequest) As X509Certificate2
            Try
                If request Is Nothing OrElse request.ClientCertificate Is Nothing OrElse Not request.ClientCertificate.IsPresent Then
                    Return Nothing
                End If

                Dim rawCertificate = request.ClientCertificate.Certificate
                If rawCertificate Is Nothing OrElse rawCertificate.Length = 0 Then
                    Return Nothing
                End If

                Return New X509Certificate2(rawCertificate)
            Catch
                Return Nothing
            End Try
        End Function

        Private Function TryCreateCertificate(rawHeader As String) As X509Certificate2
            Dim normalizedValue = Uri.UnescapeDataString(rawHeader).Trim()
            If normalizedValue = String.Empty Then
                Return Nothing
            End If

            If normalizedValue.IndexOf("BEGIN CERTIFICATE", StringComparison.OrdinalIgnoreCase) >= 0 Then
                Try
                    Dim pemPayload = Regex.Replace(
                        normalizedValue,
                        "-+BEGIN CERTIFICATE-+|-+END CERTIFICATE-+|\s+",
                        String.Empty,
                        RegexOptions.IgnoreCase)

                    If pemPayload <> String.Empty Then
                        Return New X509Certificate2(Convert.FromBase64String(pemPayload))
                    End If
                Catch
                End Try
            End If

            Dim compactValue = Regex.Replace(normalizedValue, "\s+", String.Empty)
            If compactValue.Length > 0 AndAlso compactValue.Length Mod 2 = 0 AndAlso Regex.IsMatch(compactValue, "^[0-9a-fA-F]+$") Then
                Try
                    Return New X509Certificate2(HexStringToBytes(compactValue))
                Catch
                End Try
            End If

            Try
                Return New X509Certificate2(Convert.FromBase64String(compactValue))
            Catch
                Return Nothing
            End Try
        End Function

        Private Function NormalizarIdentificadorFiscal(value As String) As String
            If String.IsNullOrWhiteSpace(value) Then
                Return String.Empty
            End If

            Dim normalizedValue = value.Trim().Trim(""""c).ToUpperInvariant()
            If normalizedValue.StartsWith("IDCES-", StringComparison.OrdinalIgnoreCase) OrElse
                normalizedValue.StartsWith("VATES-", StringComparison.OrdinalIgnoreCase) Then
                normalizedValue = normalizedValue.Split("-"c).Last().Trim()
            End If

            Dim match = Regex.Match(normalizedValue, "\b[0-9XYZ]\d{7}[A-Z]\b", RegexOptions.IgnoreCase)
            If match.Success Then
                Return match.Value.ToUpperInvariant()
            End If

            Return String.Empty
        End Function

        Private Function ExtractDistinguishedNameValue(subject As String, attributeName As String) As String
            If String.IsNullOrWhiteSpace(subject) OrElse String.IsNullOrWhiteSpace(attributeName) Then
                Return String.Empty
            End If

            Dim pattern = "(?:^|,\s*)" & Regex.Escape(attributeName) & "\s*=\s*(""[^""]+""|[^,]+)"
            Dim match = Regex.Match(subject, pattern, RegexOptions.IgnoreCase)
            If Not match.Success Then
                Return String.Empty
            End If

            Return match.Groups(1).Value.Trim().Trim(""""c)
        End Function

        Private Function HexStringToBytes(value As String) As Byte()
            Dim bytes((value.Length \ 2) - 1) As Byte
            For i = 0 To bytes.Length - 1
                bytes(i) = Convert.ToByte(value.Substring(i * 2, 2), 16)
            Next

            Return bytes
        End Function

        Private Function NormalizeOrigin(value As String) As String
            Dim uri As Uri = Nothing
            If Not Uri.TryCreate(value, UriKind.Absolute, uri) Then
                Return String.Empty
            End If

            Return uri.GetLeftPart(UriPartial.Authority).TrimEnd("/"c)
        End Function

        Private Function ExtractHost(value As String) As String
            Dim token = FirstToken(value)
            If String.IsNullOrWhiteSpace(token) Then
                Return String.Empty
            End If

            Dim uri As Uri = Nothing
            If Uri.TryCreate("http://" & token, UriKind.Absolute, uri) Then
                Return uri.Host
            End If

            Return token
        End Function

        Private Function ExtractPort(value As String) As Integer?
            Dim token = FirstToken(value)
            If String.IsNullOrWhiteSpace(token) Then
                Return Nothing
            End If

            Dim uri As Uri = Nothing
            If Uri.TryCreate("http://" & token, UriKind.Absolute, uri) AndAlso Not uri.IsDefaultPort Then
                Return uri.Port
            End If

            Return Nothing
        End Function

        Private Function ParseNullableInt(value As String) As Integer?
            Dim parsedValue As Integer
            If Integer.TryParse(FirstToken(value), parsedValue) Then
                Return parsedValue
            End If

            Return Nothing
        End Function

        Private Function FirstToken(value As String) As String
            If String.IsNullOrWhiteSpace(value) Then
                Return String.Empty
            End If

            Return value.Split(","c)(0).Trim()
        End Function

        Private Function GetFirstHeaderValue(request As HttpRequest, headerName As String) As String
            If request Is Nothing OrElse String.IsNullOrWhiteSpace(headerName) Then
                Return String.Empty
            End If

            Return request.Headers(headerName)
        End Function

        Private Function GetDefaultPort(scheme As String) As Integer
            If String.Equals(scheme, Uri.UriSchemeHttp, StringComparison.OrdinalIgnoreCase) Then
                Return 80
            End If

            Return 443
        End Function

        Private Sub AddHeaderCandidate(headerCandidates As ICollection(Of String), headerName As String)
            If Not String.IsNullOrWhiteSpace(headerName) Then
                headerCandidates.Add(headerName.Trim())
            End If
        End Sub
    End Module
End Namespace