491 lines
20 KiB
VB.net
491 lines
20 KiB
VB.net
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
|
|
|
|
|