Files
tsUtilidades/UtilsCert.vb
manuel afb7175a37 - 2025-07-29 1.1.0 Se añade UtilsCert para manejo de certificados
- 2025-07-29 1.1.0 Se elimina función DescomponerCNsuscriptor de la clase crypt
2025-07-31 09:30:48 +02:00

2315 lines
107 KiB
VB.net

'---------------------------------------------------------------------------
' UtilsCert: Utilidades relacionadas con la Certificación:
' validación,
' consulta de revocación mediante OCSP (RFC 2560, vía HTTP),
' importación de certificados desde Almacenes de Windows,
' etc.
'
' Se requiere la librería BouncyCastle.
'---------------------------------------------------------------------------
' Versión: 1.0
' Fecha: 26-2-2019
'
' Todos los miembros de esta clase son compartidos (Shared).
' No se permite crear instancias de esta clase.
'
' TECNOSIS S.A.
'---------------------------------------------------------------------------
Imports System.IO
Imports SSC = System.Security.Cryptography
Imports BC = Org.BouncyCastle
Public Class UtilsCert
' Ocultamos el constructor para evitar que se puedan crear instancias de esta clase:
Private Sub New()
End Sub
'-------------------------------------------------
Public Enum EstadoRevocEnum As Integer
'--------------------------------------
' Estado de revocación del certificado
'--------------------------------------
' Se muestran los valores correspondientes del campo MsjEstadoRevoc del objeto InfoRevoc:
NoRevocado = 0 ' MsjEstadoRevoc = Nothing
Revocado = 1 ' MsjEstadoRevoc = "<Causa de revocación> (CodRev=<N>)" o "Causa no disponible (CodRev=-1)"
Indeterminado = 2 ' MsjEstadoRevoc = "<Causa de la no determinación (OCSP, comunicaciones, servidor...)>"
End Enum
Public Class InfoRevoc
Public CertBin As Byte() ' Certificado en ASN.1 DER (.cer) objeto de la consulta OCSP.
Public EstadoRevoc As EstadoRevocEnum
Public MsjEstadoRevoc As String ' Su contenido depende del valor de EstadoRevoc (ver EstadoRevocEnum).
Public FechaRevocUTC As Date ' Fecha de la revocación si EstadoRevoc = Revocado; Nothing en otro caso.
Public ThisUpdateUTC As Date ' Valor ThisUpdate de la respuesta OCSP, o Nothing si no está presente.
Public NextUpdateUTC As Date ' Valor NextUpdate de la respuesta OCSP, o Nothing si no está presente.
Public RespuestaOCSPBin As Byte() ' Respuesta OCSP en binario, o Nothing si no se ha recibido.
Public RespuestaEfectiva As Boolean ' True si RespuestaOCSPBin es una respuesta 'efectiva' (responseStatus = successful).
Public UrlResponder As String ' URL del Responder OCSP.
Public ResponderBin As Byte() ' Certificado Responder en ASN.1 DER (.cer) usado para validar la firma de la respuesta OCSP; Nothing si no presente.
'---------------------
Public Overrides Function ToString() As String
Dim res As String
Try
If CertBin Is Nothing Then
Throw New Exception("'CertBin' es Nothing.")
End If
Dim cert As New SSC.X509Certificates.X509Certificate2(CertBin)
res = "INFORMACIÓN DEL CERTIFICADO:" & vbCrLf & _
" Titular: " & cert.Subject & vbCrLf & _
" Emisor: " & cert.Issuer & vbCrLf & _
" Certificado válido desde: " & DateToString(cert.NotBefore) & vbCrLf & _
" Certificado válido hasta: " & DateToString(cert.NotAfter) & vbCrLf & _
"INFORMACIÓN DE REVOCACIÓN:" & vbCrLf & _
" Estado: " & EstadoRevocToString(EstadoRevoc) & vbCrLf
If EstadoRevoc <> EstadoRevocEnum.NoRevocado Then
If EstadoRevoc = EstadoRevocEnum.Revocado Then
res &= " Causa de revocación: " & MsjEstadoRevoc & vbCrLf & _
" Fecha de revocación: " & DateToString(FechaRevocUTC.ToLocalTime()) & vbCrLf
Else
res &= " Mensaje:" & If(MsjEstadoRevoc = "", " <NoPresente>", vbCrLf & Indent(MsjEstadoRevoc, 8)) & vbCrLf
End If
End If
res &= " Información de revocación válida desde: " & If(ThisUpdateUTC = Nothing, "<NoPresente>", DateToString(ThisUpdateUTC.ToLocalTime())) & vbCrLf & _
" Información de revocación válida hasta: " & If(NextUpdateUTC = Nothing, "<NoPresente>", DateToString(NextUpdateUTC.ToLocalTime())) & vbCrLf & _
" Respuesta OCSP efectiva: " & If(RespuestaEfectiva, "", "No") & vbCrLf & _
" URL del servidor OCSP: " & UrlResponder & vbCrLf
If ResponderBin Is Nothing Then
res &= " Certificado 'Responder': <NoPresente>"
Else
Dim responder As New SSC.X509Certificates.X509Certificate2(ResponderBin)
res &= " Certificado 'Responder': " & responder.Subject
End If
Catch ex As Exception
Throw New Exception("Error ejecutando ToString de InfoRevoc." & vbCrLf & ex.Message, ex)
End Try
Return res
End Function
End Class
Public Class CamposRespuestaOCSP
Public responseStatus As Integer = -1
Public signatureAlgorithmOID As String = Nothing
Public signatureAlgorithmName As String = Nothing
Public numCertsResponder As Integer = 0
Public authorizedResponderBin As Byte() = Nothing
Public producedAtUTC As Date = Nothing
Public numResponseExtensions As Integer = 0
Public numResponses As Integer = 0
Public certSerialNumber As Byte() = Nothing
Public certStatus As EstadoRevocEnum = EstadoRevocEnum.Indeterminado
Public revocationTimeUTC As Date = Nothing
Public revocationReason As Integer = -1
Public thisUpdateUTC As Date = Nothing
Public nextUpdateUTC As Date = Nothing
Public numSingleExtensions As Integer = 0
End Class
'-------------------------------------------------
#Region "Métodos públicos compartidos (Shared)"
Public Shared Function ConsultarInfoRevoc(ByVal certBin As Byte(), _
ByVal certPadreBin As Byte(), _
Optional ByVal usarUrlResponderDeCert As Boolean = True, _
Optional ByVal urlResponder As String = Nothing, _
Optional ByVal arrayPadresResponderAutBin As Byte()() = Nothing, _
Optional ByVal usarResponderDeRespuestaOCSP As Boolean = True, _
Optional ByVal arrayRespondersBin As Byte()() = Nothing, _
Optional ByVal timeoutIntentoSegundos As Integer = 15, _
Optional ByVal numIntentosMax As Integer = 4, _
Optional ByVal esperaEntreIntentosMiliseg As Integer = 3000, _
Optional ByVal requestorBin As Byte() = Nothing, _
Optional ByVal chainRequestorBin As Byte()() = Nothing, _
Optional ByVal privadaRequestor As SSC.RSAParameters = Nothing) As InfoRevoc
'-----------------------------------------------------------------------------------------------------------
' Los certificados están en ASN.1 DER (.cer).
'-----------------------------------------------------------------------------------------------------------
' certBin: Certificado objeto de la consulta OCSP.
'
' certPadreBin: Certificado padre de certBin. Se asume que ha sido VALIDADO PREVIAMENTE.
'
' usarUrlResponderDeCert: True si se desea usar la URL del Responder OCSP contenida en certBin
' (en la extensión AuthorityInfoAccess).
'
' urlResponder: URL del Responder OCSP que se usará en el caso de que certBin no la contenga,
' o cuando usarUrlResponderDeCert = False.
' Si certBin contiene la URL del Responder y usarUrlResponderDeCert = True,
' entonces NO se usará la URL pasada como argumento.
'
' arrayPadresResponderAutBin: Padres permitidos para el Responder Autorizado.
' Se usarán para validar el Responder Autorizado contenido en la respuesta OCSP.
' Se asume que los padres han sido VALIDADOS PREVIAMENTE.
' Nothing equivale al array {certPadreBin} (siguiendo RFC 2560).
'
' usarResponderDeRespuestaOCSP: True si se desea usar el Responder Autorizado contenido en la respuesta OCSP
' (en el campo 'certs' del Sequence ASN.1 'BasicOCSPResponse').
' Responder Autorizado: Certificado con el OID OCSPSigning en la extensión
' ExtendedKeyUsage.
'
' arrayRespondersBin: Responders locales (se asume que han sido VALIDADOS PREVIAMENTE) que se usarán para
' validar la firma de la respuesta OCSP en el caso de que ésta no contenga un Responder
' Autorizado, o cuando usarResponderDeRespuestaOCSP = False.
' Si la respuesta contiene un Responder Autorizado y usarResponderDeRespuestaOCSP = True,
' entonces NO se usarán los Responders locales pasados como argumento.
' Nothing equivale al array {certPadreBin} (siguiendo RFC 2560).
'
' timeoutIntentoSegundos: Timeout para cada "intento" (consulta OCSP) (en segundos).
'
' numIntentosMax: Número de intentos máximo.
'
' esperaEntreIntentosMiliseg: Espera entre intentos (en milisegundos).
'
' requestorBin: Certificado Requestor. Si está presente, entonces se firmará la petición OCSP.
'
' chainRequestorBin: Cadena de certificación del Requestor que se enviará en la petición OCSP
' (en el campo opcional 'certs' del Sequence ASN.1 'Signature').
' Debe tener el ORDEN CORRECTO.
' Es OPCIONAL.
'
' privadaRequestor: Clave privada RSA con la que se firmará la petición OCSP.
' Necesaria si requestorBin está presente.
'-----------------------------------------------------------------------------------------------------------
Dim infoRev As InfoRevoc
Try
If numIntentosMax < 1 Then Throw New Exception("'numIntentosMax' es menor que 1: " & numIntentosMax)
If numIntentosMax > 10 Then Throw New Exception("'numIntentosMax' es mayor que 10: " & numIntentosMax)
If esperaEntreIntentosMiliseg < 0 Then Throw New Exception("'esperaEntreIntentosMiliseg' es menor que 0: " & esperaEntreIntentosMiliseg)
'---------------
Dim reintentable As Boolean
Dim intento As Integer
For intento = 1 To numIntentosMax
ConsultarOCSP(certBin, certPadreBin, _
usarUrlResponderDeCert, urlResponder, _
arrayPadresResponderAutBin, usarResponderDeRespuestaOCSP, arrayRespondersBin, _
timeoutIntentoSegundos, _
requestorBin, chainRequestorBin, privadaRequestor, _
reintentable, infoRev)
If reintentable AndAlso (intento < numIntentosMax) Then
System.Threading.Thread.Sleep(esperaEntreIntentosMiliseg)
Else
Exit For
End If
Next
Catch ex As Exception
Throw New Exception("Error ejecutando ConsultarInfoRevoc." & vbCrLf & ex.Message, ex)
End Try
Return infoRev
End Function
Public Shared Function ConsultarInfoRevoc(ByVal certBin As Byte(), _
ByVal arrayCertsPadresBin As Byte()(), _
Optional ByVal arrayUsarUrlResponderDeCert As Boolean() = Nothing, _
Optional ByVal arrayUrlsResponders As String() = Nothing, _
Optional ByVal arrayArraysPadresResponderAutBin As Byte()()() = Nothing, _
Optional ByVal arrayUsarResponderDeRespuestaOCSP As Boolean() = Nothing, _
Optional ByVal arrayArraysRespondersBin As Byte()()() = Nothing, _
Optional ByVal timeoutIntentoSegundos As Integer = 15, _
Optional ByVal numIntentosMax As Integer = 4, _
Optional ByVal esperaEntreIntentosMiliseg As Integer = 3000, _
Optional ByVal arrayRequestorsBin As Byte()() = Nothing, _
Optional ByVal arrayChainsRequestorsBin As Byte()()() = Nothing, _
Optional ByVal arrayPrivadasRequestors As SSC.RSAParameters() = Nothing) As InfoRevoc
'-----------------------------------------------------------------------------------------------
' arrayCertsPadresBin: Array con los certificados padres permitidos para certBin.
' Se asume que los certificados han sido VALIDADOS PREVIAMENTE.
' La función busca el padre correspondiente.
' Debe ser NO VACÍO.
'-----------------------------------------------------------------------------------------------
' Los siguientes argumentos deben ser NOTHING o tener la MISMA LONGITUD que arrayCertsPadresBin:
'
' arrayUsarUrlResponderDeCert (Nothing equivale a un array con todo True)
' arrayUrlsResponders
'
' arrayArraysPadresResponderAutBin
' arrayUsarResponderDeRespuestaOCSP (Nothing equivale a un array con todo True)
' arrayArraysRespondersBin
'
' arrayRequestorsBin
' arrayChainsRequestorsBin
' arrayPrivadasRequestors
'
' Cuando son distintos de Nothing, cada elemento i corresponde al padre i en arrayCertsPadresBin.
'-----------------------------------------------------------------------------------------------
Dim certPadreBin As Byte()
Dim usarUrlResponderDeCert As Boolean = True
Dim urlResponder As String = Nothing
Dim arrayPadresResponderAutBin As Byte()() = Nothing
Dim usarResponderDeRespuestaOCSP As Boolean = True
Dim arrayRespondersBin As Byte()() = Nothing
Dim requestorBin As Byte() = Nothing
Dim chainRequestorBin As Byte()() = Nothing
Dim privadaRequestor As SSC.RSAParameters = Nothing
Try
If certBin Is Nothing Then
Throw New Exception("'certBin' es Nothing.")
End If
If (arrayCertsPadresBin Is Nothing) OrElse (arrayCertsPadresBin.Length = 0) Then
Throw New Exception("'arrayCertsPadresBin' es Nothing o vacío.")
End If
If (arrayUsarUrlResponderDeCert IsNot Nothing) AndAlso (arrayUsarUrlResponderDeCert.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayUsarUrlResponderDeCert' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
If (arrayUrlsResponders IsNot Nothing) AndAlso (arrayUrlsResponders.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayUrlsResponders' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
If (arrayArraysPadresResponderAutBin IsNot Nothing) AndAlso (arrayArraysPadresResponderAutBin.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayArraysPadresResponderAutBin' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
If (arrayUsarResponderDeRespuestaOCSP IsNot Nothing) AndAlso (arrayUsarResponderDeRespuestaOCSP.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayUsarResponderDeRespuestaOCSP' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
If (arrayArraysRespondersBin IsNot Nothing) AndAlso (arrayArraysRespondersBin.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayArraysRespondersBin' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
If (arrayRequestorsBin IsNot Nothing) AndAlso (arrayRequestorsBin.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayRequestorsBin' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
If (arrayChainsRequestorsBin IsNot Nothing) AndAlso (arrayChainsRequestorsBin.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayChainsRequestorsBin' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
If (arrayPrivadasRequestors IsNot Nothing) AndAlso (arrayPrivadasRequestors.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayPrivadasRequestors' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
'------------
Dim iPadre As Integer = BuscarCertPadre(certBin, arrayCertsPadresBin)
If iPadre = -1 Then
Dim cert As New SSC.X509Certificates.X509Certificate2(certBin)
Throw New Exception("No se ha encontrado certificado emisor para el certificado de:" & vbCrLf & _
" " & cert.Subject)
End If
certPadreBin = arrayCertsPadresBin(iPadre)
If arrayUsarUrlResponderDeCert IsNot Nothing Then
usarUrlResponderDeCert = arrayUsarUrlResponderDeCert(iPadre)
End If
If arrayUrlsResponders IsNot Nothing Then
urlResponder = arrayUrlsResponders(iPadre)
End If
If arrayArraysPadresResponderAutBin IsNot Nothing Then
arrayPadresResponderAutBin = arrayArraysPadresResponderAutBin(iPadre)
End If
If arrayUsarResponderDeRespuestaOCSP IsNot Nothing Then
usarResponderDeRespuestaOCSP = arrayUsarResponderDeRespuestaOCSP(iPadre)
End If
If arrayArraysRespondersBin IsNot Nothing Then
arrayRespondersBin = arrayArraysRespondersBin(iPadre)
End If
If arrayRequestorsBin IsNot Nothing Then
requestorBin = arrayRequestorsBin(iPadre)
End If
If arrayChainsRequestorsBin IsNot Nothing Then
chainRequestorBin = arrayChainsRequestorsBin(iPadre)
End If
If arrayPrivadasRequestors IsNot Nothing Then
privadaRequestor = arrayPrivadasRequestors(iPadre)
End If
Catch ex As Exception
Throw New Exception("Error ejecutando ConsultarInfoRevoc (sobrecarga para múltiples servidores OCSP)." & vbCrLf & ex.Message, ex)
End Try
Return ConsultarInfoRevoc(certBin, certPadreBin, _
usarUrlResponderDeCert, urlResponder, _
arrayPadresResponderAutBin, usarResponderDeRespuestaOCSP, arrayRespondersBin, _
timeoutIntentoSegundos, numIntentosMax, esperaEntreIntentosMiliseg, _
requestorBin, chainRequestorBin, privadaRequestor)
End Function
Public Shared Function FirmaValidaRespuestaOCSP(ByVal respuestaOCSPBin As Byte(), _
ByVal fechaUTC As Date, _
ByVal arrayPadresResponderAutBin As Byte()(), _
Optional ByVal usarResponderDeRespuestaOCSP As Boolean = True, _
Optional ByVal arrayRespondersBin As Byte()() = Nothing, _
Optional ByRef responderBinUsado As Byte() = Nothing, _
Optional ByRef msjInvalidez As String = Nothing) As Boolean
'-----------------------------------------------------------------------------------------------------------
' No se tiene en cuenta (ThisUpdate, NextUpdate) de la respuesta OCSP.
' Los certificados están en ASN.1 DER (.cer).
'-----------------------------------------------------------------------------------------------------------
' fechaUTC: Fecha en la que se validará el Responder Autorizado contenido en la respuesta OCSP.
'
' arrayPadresResponderAutBin: Padres permitidos para el Responder Autorizado.
' Se usarán para validar el Responder Autorizado contenido en la respuesta OCSP.
' Se asume que los padres han sido VALIDADOS PREVIAMENTE.
' Debe ser no vacío si usarResponderDeRespuestaOCSP = True.
' El valor Nothing NO tiene ningún significado especial.
'
' usarResponderDeRespuestaOCSP: True si se desea usar el Responder Autorizado contenido en la respuesta OCSP
' (en el campo 'certs' del Sequence ASN.1 'BasicOCSPResponse').
'
' arrayRespondersBin: Responders locales (se asume que han sido VALIDADOS PREVIAMENTE) que se usarán para
' validar la firma de la respuesta OCSP en el caso de que ésta no contenga un Responder
' Autorizado, o cuando usarResponderDeRespuestaOCSP = False.
' Si la respuesta contiene un Responder Autorizado y usarResponderDeRespuestaOCSP = True,
' entonces NO se usarán los Responders locales pasados como argumento.
' El valor Nothing NO tiene ningún significado especial.
'-----------------------------------------------------------------------------------------------------------
' responderBinUsado: Se devuelve el certificado Responder usado para validar la firma de la respuesta OCSP.
' Siempre es distinto de Nothing, salvo cuando hay excepción.
'
' msjInvalidez: Nothing si la firma de la respuesta OCSP es VÁLIDA;
' mensaje con la causa de la invalidez si es INVÁLIDA.
'-----------------------------------------------------------------------------------------------------------
Try
If respuestaOCSPBin Is Nothing Then
Throw New Exception("'respuestaOCSPBin' es Nothing.")
End If
If usarResponderDeRespuestaOCSP Then
If (arrayPadresResponderAutBin Is Nothing) OrElse (arrayPadresResponderAutBin.Length = 0) Then
Throw New Exception("'usarResponderDeRespuestaOCSP' es True y 'arrayPadresResponderAutBin' es Nothing o vacío.")
End If
Else
If (arrayRespondersBin Is Nothing) OrElse (arrayRespondersBin.Length = 0) Then
Throw New Exception("'usarResponderDeRespuestaOCSP' es False y 'arrayRespondersBin' es Nothing o vacío.")
End If
End If
'======== Lectura de la respuesta OCSP ========
Dim resp As New BC.Ocsp.OcspResp(respuestaOCSPBin)
If resp.Status <> BC.Ocsp.OcspRespStatus.Successful Then Throw New Exception("Respuesta OCSP NO firmada.")
Dim basicResp As BC.Ocsp.BasicOcspResp = CType(resp.GetResponseObject(), BC.Ocsp.BasicOcspResp)
'==============================================
Dim arrayPadresResponderAut As BC.X509.X509Certificate() = LeerArrayCerts(arrayPadresResponderAutBin, "arrayPadresResponderAutBin")
Dim arrayResponders As BC.X509.X509Certificate() = LeerArrayCerts(arrayRespondersBin, "arrayRespondersBin")
'=========== Validación de la firma ===========
Dim responderUsado As BC.X509.X509Certificate
Dim firmaValida As Boolean = FirmaValidaRespuestaOCSP(basicResp, _
fechaUTC, arrayPadresResponderAut, _
usarResponderDeRespuestaOCSP, arrayResponders, _
responderUsado, msjInvalidez)
responderBinUsado = responderUsado.GetEncoded()
Return firmaValida
Catch ex As Exception
responderBinUsado = Nothing
msjInvalidez = Nothing
Throw New Exception("Error ejecutando FirmaValidaRespuestaOCSP." & vbCrLf & ex.Message, ex)
End Try
End Function
Public Shared Function CertCorrespondeARespuestaOCSP(ByVal certBin As Byte(), _
ByVal arrayCertsPadresBin As Byte()(), _
ByVal respuestaOCSPBin As Byte()) As Boolean
'----------------------------------------------------------------------------------------
' Devuelve True si el certificado 'certBin' corresponde a la respuesta OCSP, es decir,
' si la información de revocación contenida en 'respuestaOCSPBin' es de 'certBin'.
'----------------------------------------------------------------------------------------
' Lo que se comprueba es la coincidencia del CertificateID de 'certBin' con el
' CertificateID contenido en la respuesta OCSP.
'----------------------------------------------------------------------------------------
' arrayCertsPadresBin: Array con los posibles padres de 'certBin' (al menos 1).
' Se asume que los certificados han sido VALIDADOS PREVIAMENTE.
' La función busca el padre correspondiente.
'----------------------------------------------------------------------------------------
Dim cert As BC.X509.X509Certificate
Dim arrayCertsPadres As BC.X509.X509Certificate()
Dim basicResp As BC.Ocsp.BasicOcspResp
Try
If certBin Is Nothing Then
Throw New Exception("'certBin' es Nothing.")
End If
If (arrayCertsPadresBin Is Nothing) OrElse (arrayCertsPadresBin.Length = 0) Then
Throw New Exception("'arrayCertsPadresBin' es Nothing o vacío.")
End If
If respuestaOCSPBin Is Nothing Then
Throw New Exception("'respuestaOCSPBin' es Nothing.")
End If
'============
cert = LeerCert(certBin, "certBin")
arrayCertsPadres = LeerArrayCerts(arrayCertsPadresBin, "arrayCertsPadresBin")
'============
Dim resp As New BC.Ocsp.OcspResp(respuestaOCSPBin)
If resp.Status <> BC.Ocsp.OcspRespStatus.Successful Then Throw New Exception("Respuesta OCSP NO firmada.")
basicResp = CType(resp.GetResponseObject(), BC.Ocsp.BasicOcspResp)
Catch ex As Exception
Throw New Exception("Comprobando correspondencia del certificado con la respuesta OCSP." & vbCrLf & ex.Message, ex)
End Try
Return CertCorrespondeARespuestaOCSP(cert, arrayCertsPadres, basicResp)
End Function
Public Shared Function IntegrosCertYRespuestaOCSP(ByVal certBin As Byte(), _
ByVal arrayCertsPadresBin As Byte()(), _
ByVal respuestaOCSPBin As Byte(), _
ByVal fechaUTC As Date, _
Optional ByVal arrayArraysPadresResponderAutBin As Byte()()() = Nothing, _
Optional ByVal arrayUsarResponderDeRespuestaOCSP As Boolean() = Nothing, _
Optional ByVal arrayArraysRespondersBin As Byte()()() = Nothing, _
Optional ByRef responderBinUsado As Byte() = Nothing, _
Optional ByRef msjIntegridad As String = Nothing) As Boolean
'-------------------------------------------------------------------------------------------------------------
' Devuelve True si son 'íntegros' el certificado Y la respuesta OCSP, es decir, si:
'
' 1. La firma de 'certBin' es válida (NO se tiene en cuenta su periodo de validez), y
' 2. La firma de 'respuestaOCSPBin' es válida (NO se tiene en cuenta su periodo (ThisUpdate, NextUpdate)), y
' 3. 'certBin' corresponde a 'respuestaOCSPBin'.
'
'-------------------------------------------------------------------------------------------------------------
' arrayCertsPadresBin: Array con los posibles padres de 'certBin' (al menos 1).
' Se asume que los certificados han sido VALIDADOS PREVIAMENTE.
' La función busca el padre correspondiente.
'
' fechaUTC: Fecha en la que se validará el Responder Autorizado contenido en la respuesta OCSP.
'
' arrayArraysPadresResponderAutBin: Mismo significado que en ConsultarInfoRevoc().
' arrayUsarResponderDeRespuestaOCSP: Mismo significado que en ConsultarInfoRevoc().
' arrayArraysRespondersBin: Mismo significado que en ConsultarInfoRevoc().
'-------------------------------------------------------------------------------------------------------------
' responderBinUsado: Se devuelve el certificado Responder usado para validar la firma de la respuesta OCSP.
' Puede ser Nothing.
'
' msjIntegridad: Nothing si se devuelve True;
' mensaje con la causa del problema de integridad si se devuelve False.
'-------------------------------------------------------------------------------------------------------------
Try
If certBin Is Nothing Then
Throw New Exception("'certBin' es Nothing.")
End If
If (arrayCertsPadresBin Is Nothing) OrElse (arrayCertsPadresBin.Length = 0) Then
Throw New Exception("'arrayCertsPadresBin' es Nothing o vacío.")
End If
If respuestaOCSPBin Is Nothing Then
Throw New Exception("'respuestaOCSPBin' es Nothing.")
End If
If (arrayArraysPadresResponderAutBin IsNot Nothing) AndAlso (arrayArraysPadresResponderAutBin.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayArraysPadresResponderAutBin' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
If (arrayUsarResponderDeRespuestaOCSP IsNot Nothing) AndAlso (arrayUsarResponderDeRespuestaOCSP.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayUsarResponderDeRespuestaOCSP' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
If (arrayArraysRespondersBin IsNot Nothing) AndAlso (arrayArraysRespondersBin.Length <> arrayCertsPadresBin.Length) Then
Throw New Exception("'arrayArraysRespondersBin' NO tiene la misma longitud que 'arrayCertsPadresBin'.")
End If
msjIntegridad = "Comprobando integridad del certificado y de la respuesta OCSP." & vbCrLf
'===== Validación de la firma del certificado =====
Dim cert As BC.X509.X509Certificate = LeerCert(certBin, "certBin")
Dim arrayCertsPadres As BC.X509.X509Certificate() = LeerArrayCerts(arrayCertsPadresBin, "arrayCertsPadresBin")
' La búsqueda comprueba la firma de 'cert':
Dim iPadre As Integer = BuscarCertPadre(cert, arrayCertsPadres)
If iPadre = -1 Then
responderBinUsado = Nothing
msjIntegridad &= "No se ha encontrado certificado emisor para el certificado de:" & vbCrLf & _
" " & cert.SubjectDN.ToString()
Return False
End If
Dim certPadre As BC.X509.X509Certificate = arrayCertsPadres(iPadre)
'========== Lectura de la respuesta OCSP ==========
Dim resp As New BC.Ocsp.OcspResp(respuestaOCSPBin)
If resp.Status <> BC.Ocsp.OcspRespStatus.Successful Then Throw New Exception("Respuesta OCSP NO firmada.")
Dim basicResp As BC.Ocsp.BasicOcspResp = CType(resp.GetResponseObject(), BC.Ocsp.BasicOcspResp)
'==================================================
Dim arrayPadresResponderAutBin As Byte()() = Nothing
Dim usarResponderDeRespuestaOCSP As Boolean = True
Dim arrayRespondersBin As Byte()() = Nothing
If arrayArraysPadresResponderAutBin IsNot Nothing Then
arrayPadresResponderAutBin = arrayArraysPadresResponderAutBin(iPadre)
End If
If arrayUsarResponderDeRespuestaOCSP IsNot Nothing Then
usarResponderDeRespuestaOCSP = arrayUsarResponderDeRespuestaOCSP(iPadre)
End If
If arrayArraysRespondersBin IsNot Nothing Then
arrayRespondersBin = arrayArraysRespondersBin(iPadre)
End If
'======= Lectura de arrayPadresResponderAut =======
Dim arrayPadresResponderAut As BC.X509.X509Certificate()
If arrayPadresResponderAutBin Is Nothing Then
arrayPadresResponderAut = {certPadre}
Else
arrayPadresResponderAut = LeerArrayCerts(arrayPadresResponderAutBin, "arrayPadresResponderAutBin")
End If
'=========== Lectura de arrayResponders ===========
Dim arrayResponders As BC.X509.X509Certificate()
If arrayRespondersBin Is Nothing Then
arrayResponders = {certPadre}
Else
arrayResponders = LeerArrayCerts(arrayRespondersBin, "arrayRespondersBin")
End If
'===== Validación de la firma de la respuesta =====
Dim responderUsado As BC.X509.X509Certificate
Dim msjInvalidezFirmaResp As String
Dim firmaValidaResp As Boolean = FirmaValidaRespuestaOCSP(basicResp, _
fechaUTC, arrayPadresResponderAut, _
usarResponderDeRespuestaOCSP, arrayResponders, _
responderUsado, msjInvalidezFirmaResp)
responderBinUsado = responderUsado.GetEncoded()
If Not firmaValidaResp Then
msjIntegridad &= msjInvalidezFirmaResp
Return False
End If
'======== Comprobación de correspondencia =========
If Not CertCorrespondeARespuestaOCSP(cert, {certPadre}, basicResp) Then
msjIntegridad &= "El certificado de: " & cert.SubjectDN.ToString() & vbCrLf & _
"NO corresponde a la respuesta OCSP."
Return False
End If
'==================================================
msjIntegridad = Nothing
Return True
Catch ex As Exception
responderBinUsado = Nothing
msjIntegridad = Nothing
Throw New Exception("Comprobando integridad del certificado y de la respuesta OCSP." & vbCrLf & ex.Message, ex)
End Try
End Function
Public Shared Function RespuestaOCSPToString(ByVal respuestaOCSPBin As Byte(), _
Optional ByVal separador As String = vbCrLf) As String
Dim res As String
Try
If respuestaOCSPBin Is Nothing Then
Throw New Exception("'respuestaOCSPBin' es Nothing.")
End If
'==============
Dim resp As New BC.Ocsp.OcspResp(respuestaOCSPBin)
res = "responseStatus: " & resp.Status
If resp.Status = BC.Ocsp.OcspRespStatus.Successful Then
Dim basicResp As BC.Ocsp.BasicOcspResp = CType(resp.GetResponseObject(), BC.Ocsp.BasicOcspResp)
res &= separador & "signatureAlgorithmOID: " & basicResp.SignatureAlgOid
res &= separador & "signatureAlgorithmName: " & basicResp.SignatureAlgName
Dim certsResponder As BC.X509.X509Certificate() = basicResp.GetCerts()
res &= separador & "numCertsResponder: " & If(certsResponder Is Nothing, 0, certsResponder.Length)
Dim authorizedResponder As BC.X509.X509Certificate
Try
authorizedResponder = BuscarResponderAutorizado(certsResponder)
Catch ex As Exception
authorizedResponder = Nothing
End Try
res &= separador & "authorizedResponder: " & If(authorizedResponder Is Nothing, "<NoPresente>", authorizedResponder.SubjectDN.ToString())
res &= separador & "producedAtUTC: " & DateToString(basicResp.ProducedAt)
res &= separador & "numResponseExtensions: " & If(basicResp.ResponseExtensions Is Nothing, 0, basicResp.ResponseExtensions.GetExtensionOids().Length)
Dim numResponses As Integer = If(basicResp.Responses Is Nothing, 0, basicResp.Responses.Length)
res &= separador & "numResponses: " & numResponses
' Sólo mostramos la primera SingleResponse:
If numResponses >= 1 Then
Dim singleResp As BC.Ocsp.SingleResp = basicResp.Responses(0)
res &= separador & "certSerialNumber: " & Array2Hex(singleResp.GetCertID().SerialNumber.ToByteArray(), " ")
Dim certStatusObj As Object = singleResp.GetCertStatus()
If certStatusObj Is BC.Ocsp.CertificateStatus.Good Then ' Equivale a Is Nothing
res &= separador & "certStatus: 0 (good)"
ElseIf TypeOf certStatusObj Is BC.Ocsp.RevokedStatus Then
res &= separador & "certStatus: 1 (revoked)"
Dim revInfo As BC.Ocsp.RevokedStatus = CType(certStatusObj, BC.Ocsp.RevokedStatus)
res &= separador & "revocationTimeUTC: " & DateToString(revInfo.RevocationTime)
res &= separador & "revocationReason: " & If(revInfo.HasRevocationReason, revInfo.RevocationReason, -1)
ElseIf TypeOf certStatusObj Is BC.Ocsp.UnknownStatus Then
res &= separador & "certStatus: 2 (unknown)"
Else
res &= separador & "certStatus: -1"
End If
res &= separador & "thisUpdateUTC: " & DateToString(singleResp.ThisUpdate)
res &= separador & "nextUpdateUTC: " & If(singleResp.NextUpdate Is Nothing, "<NoPresente>", _
DateToString(singleResp.NextUpdate.Value))
res &= separador & "numSingleExtensions: " & If(singleResp.SingleExtensions Is Nothing, 0, singleResp.SingleExtensions.GetExtensionOids().Length)
End If
End If
Catch ex As Exception
Throw New Exception("Error ejecutando RespuestaOCSPToString." & vbCrLf & ex.Message, ex)
End Try
Return res
End Function
Public Shared Function LeerCamposRespuestaOCSP(ByVal respuestaOCSPBin As Byte()) As CamposRespuestaOCSP
Dim campos As CamposRespuestaOCSP
Try
If respuestaOCSPBin Is Nothing Then
Throw New Exception("'respuestaOCSPBin' es Nothing.")
End If
'===========
campos = New CamposRespuestaOCSP()
Dim resp As New BC.Ocsp.OcspResp(respuestaOCSPBin)
campos.responseStatus = resp.Status
If resp.Status = BC.Ocsp.OcspRespStatus.Successful Then
Dim basicResp As BC.Ocsp.BasicOcspResp = CType(resp.GetResponseObject(), BC.Ocsp.BasicOcspResp)
campos.signatureAlgorithmOID = basicResp.SignatureAlgOid
campos.signatureAlgorithmName = basicResp.SignatureAlgName
Dim certsResponder As BC.X509.X509Certificate() = basicResp.GetCerts()
campos.numCertsResponder = If(certsResponder Is Nothing, 0, certsResponder.Length)
Dim authorizedResponder As BC.X509.X509Certificate
Try
authorizedResponder = BuscarResponderAutorizado(certsResponder)
Catch ex As Exception
authorizedResponder = Nothing
End Try
campos.authorizedResponderBin = If(authorizedResponder Is Nothing, Nothing, authorizedResponder.GetEncoded())
campos.producedAtUTC = basicResp.ProducedAt
campos.numResponseExtensions = If(basicResp.ResponseExtensions Is Nothing, 0, basicResp.ResponseExtensions.GetExtensionOids().Length)
campos.numResponses = If(basicResp.Responses Is Nothing, 0, basicResp.Responses.Length)
' Sólo leemos la primera SingleResponse:
If campos.numResponses >= 1 Then
Dim singleResp As BC.Ocsp.SingleResp = basicResp.Responses(0)
campos.certSerialNumber = singleResp.GetCertID().SerialNumber.ToByteArray()
Dim certStatusObj As Object = singleResp.GetCertStatus()
If certStatusObj Is BC.Ocsp.CertificateStatus.Good Then ' Equivale a Is Nothing
campos.certStatus = EstadoRevocEnum.NoRevocado
ElseIf TypeOf certStatusObj Is BC.Ocsp.RevokedStatus Then
campos.certStatus = EstadoRevocEnum.Revocado
Dim revInfo As BC.Ocsp.RevokedStatus = CType(certStatusObj, BC.Ocsp.RevokedStatus)
campos.revocationTimeUTC = revInfo.RevocationTime
campos.revocationReason = If(revInfo.HasRevocationReason, revInfo.RevocationReason, -1)
ElseIf TypeOf certStatusObj Is BC.Ocsp.UnknownStatus Then
campos.certStatus = EstadoRevocEnum.Indeterminado
Else
campos.certStatus = -1
End If
campos.thisUpdateUTC = singleResp.ThisUpdate
campos.nextUpdateUTC = If(singleResp.NextUpdate Is Nothing, Nothing, singleResp.NextUpdate.Value)
campos.numSingleExtensions = If(singleResp.SingleExtensions Is Nothing, 0, singleResp.SingleExtensions.GetExtensionOids().Length)
End If
End If
Catch ex As Exception
Throw New Exception("Leyendo campos de la respuesta OCSP." & vbCrLf & ex.Message, ex)
End Try
Return campos
End Function
Public Shared Function ValidoCertSinRevoc(ByVal certBin As Byte(), _
ByVal certPadreBin As Byte(), _
ByVal fechaUTC As Date, _
Optional ByRef msjInvalidez As String = Nothing) As Boolean
'--------------------------------------------------------------------
' No se comprueba el estado de revocación de 'certBin'.
' Se asume que 'certPadreBin' ha sido VALIDADO PREVIAMENTE.
'--------------------------------------------------------------------
' msjInvalidez: Nothing si 'certBin' es VÁLIDO;
' mensaje con la causa de la invalidez si es INVÁLIDO.
'--------------------------------------------------------------------
Dim cert As BC.X509.X509Certificate
Dim certPadre As BC.X509.X509Certificate
Try
cert = LeerCert(certBin, "certBin")
certPadre = LeerCert(certPadreBin, "certPadreBin")
Catch ex As Exception
msjInvalidez = Nothing
Throw New Exception("Validando certificado." & vbCrLf & ex.Message, ex)
End Try
Return ValidoCertSinRevoc(cert, {certPadre}, fechaUTC, msjInvalidez)
End Function
Public Shared Function ValidoCertSinRevoc(ByVal certBin As Byte(), _
ByVal arrayCertsPadresBin As Byte()(), _
ByVal fechaUTC As Date, _
Optional ByRef msjInvalidez As String = Nothing) As Boolean
'--------------------------------------------------------------------
' No se comprueba el estado de revocación de 'certBin'.
' 'arrayCertsPadresBin' contiene los posibles padres (al menos 1).
' Se asume que los padres han sido VALIDADOS PREVIAMENTE.
'--------------------------------------------------------------------
' msjInvalidez: Nothing si 'certBin' es VÁLIDO según algún padre;
' mensaje con la causa de la invalidez si es INVÁLIDO.
'--------------------------------------------------------------------
Dim cert As BC.X509.X509Certificate
Dim arrayCertsPadres As BC.X509.X509Certificate()
Try
cert = LeerCert(certBin, "certBin")
arrayCertsPadres = LeerArrayCerts(arrayCertsPadresBin, "arrayCertsPadresBin")
Catch ex As Exception
msjInvalidez = Nothing
Throw New Exception("Validando certificado." & vbCrLf & ex.Message, ex)
End Try
Return ValidoCertSinRevoc(cert, arrayCertsPadres, fechaUTC, msjInvalidez)
End Function
Public Shared Function BuscarCertPadre(ByVal certBin As Byte(), _
ByVal arrayCertsPadresBin As Byte()()) As Integer
'--------------------------------------------------------------------
' RESULTADO: Índice del padre de 'certBin' en 'arrayCertsPadresBin',
' o -1 si no se encuentra.
'--------------------------------------------------------------------
' Se comprueban DNs y FIRMA CRIPTOGRÁFICA.
'--------------------------------------------------------------------
Dim cert As BC.X509.X509Certificate
Dim arrayCertsPadres As BC.X509.X509Certificate()
Try
cert = LeerCert(certBin, "certBin")
arrayCertsPadres = LeerArrayCerts(arrayCertsPadresBin, "arrayCertsPadresBin")
Catch ex As Exception
Throw New Exception("Buscando certificado emisor." & vbCrLf & ex.Message, ex)
End Try
Return BuscarCertPadre(cert, arrayCertsPadres)
End Function
Public Shared Function ObtenerValorAtributoDN(ByVal certBin As Byte(), _
Optional ByVal oidStr As String = "2.5.4.3", _
Optional ByVal delSubject As Boolean = True) As String
'------------------------------------------------------------------------------------------------------------
' Devuelve el valor de un atributo de un DN (DistinguishedName: Subject o Issuer) del certificado 'certBin'.
' Por defecto del DN Subject (del DN Issuer si 'delSubject' = False).
'------------------------------------------------------------------------------------------------------------
' Se devuelve NOTHING si NO existe el atributo.
' Se eleva EXCEPCIÓN si hay más de 1 atributo con el OID 'oidStr'.
'------------------------------------------------------------------------------------------------------------
' oidStr: String con el OID del atributo cuyo valor se desea obtener. Por defecto commonName (2.5.4.3).
' Ejemplos:
'
' commonName (CN): oidStr = 2.5.4.3 (suele ser: ... + APELLIDOS + NOMBRE + ...)
' surname (SN): oidStr = 2.5.4.4 (apellidos)
' givenName (G): oidStr = 2.5.4.42 (nombre propio)
' serialNumber: oidStr = 2.5.4.5 (suele ser el DNI: "12345678Z" o "IDCES-12345678Z")
' organizationIdentifier: oidStr = 2.5.4.97 (suele ser el CIF: "VATES-A12345678")
' organizationName (O): oidStr = 2.5.4.10 (suele ser la Organización o la Razón Social)
' organizationalUnitName (OU): oidStr = 2.5.4.11 (suele ser un Departamento/Sección; a veces múltiple)
' countryName (C): oidStr = 2.5.4.6 (código del país (2 caracteres): "ES")
'
' NOTA: IDCES = Identity Document Card ESpaña
' VATES = Value Added Tax identifier ESpaña
'------------------------------------------------------------------------------------------------------------
Try
Dim parser As New BC.X509.X509CertificateParser()
Dim cert As BC.X509.X509Certificate = parser.ReadCertificate(certBin)
Dim dn As BC.Asn1.X509.X509Name
If delSubject Then
dn = cert.SubjectDN
Else
dn = cert.IssuerDN
End If
Dim list As IList = dn.GetValueList(New BC.Asn1.DerObjectIdentifier(oidStr))
If (list Is Nothing) OrElse (list.Count = 0) Then Return Nothing
If list.Count > 1 Then Throw New Exception("Se ha encontrado más de 1 atributo: Count = " & list.Count)
Return If(list(0) Is Nothing, "", CStr(list(0)))
Catch ex As Exception
Throw New Exception("Obteniendo valor de un atributo del " & If(delSubject, "Subject", "Issuer") & ": OID = " & oidStr & vbCrLf & ex.Message, ex)
End Try
End Function
Public Shared Function ObtenerCertsDesdeAlmacenesWindows(Optional ByVal mensajeInteractivo As String = Nothing, _
Optional ByVal fechaReferencia As Date = Nothing, _
Optional ByVal filtroIssuer As String = Nothing, _
Optional ByVal filtroSubject As String = Nothing, _
Optional ByVal soloConPrivada As Boolean = True, _
Optional ByVal nombresAlmacenes As SSC.X509Certificates.StoreName() = Nothing, _
Optional ByVal seleccionInteractiva As Boolean = True, _
Optional ByVal exigirResultadoUnico As Boolean = True, _
Optional ByVal incluirLocalMachine As Boolean = False) _
As SSC.X509Certificates.X509Certificate2Collection
'----------------------------------------------------------------------------------------------------------
' Obtiene certificado(s) desde los almacenes de certificados de Windows.
'----------------------------------------------------------------------------------------------------------
' mensajeInteractivo: Mensaje mostrado al usuario.
' Nothing para mostrar un mensaje por defecto.
'
' fechaReferencia: Se filtrarán los certificados vigentes en 'fechaReferencia' (hora LOCAL).
' Nothing para no filtrar por fecha.
'
' filtroIssuer: Se filtrarán los certificados que contengan este string en el DN Issuer.
' Nothing para no filtrar por el Issuer.
' No se tienen en cuenta mayúsculas/minúsculas.
'
' filtroSubject: Se filtrarán los certificados que contengan este string en el DN Subject.
' Nothing para no filtrar por el Subject.
' No se tienen en cuenta mayúsculas/minúsculas.
'
' soloConPrivada: Si es True entonces se filtrarán los certificados con clave privada.
'
' nombresAlmacenes: Nombres de los almacenes de certificados a los que se accederá.
' Nothing para acceder a los almacenes por defecto ("Personal" y "Otras personas").
'
' seleccionInteractiva: Si es True entonces se mostrará al usuario una ventana de selección.
' Si es False entonces se devolverá el contenido filtrado de los almacenes.
'
' exigirResultadoUnico: Si es True entonces se exigirá que el resultado contenga exactamente 1 certificado,
' elevándose EXCEPCIÓN en caso contrario.
'
' incluirLocalMachine: Si es False entonces sólo se usará "Current User".
' Si es True entonces se incluirá "Local Machine" ADEMÁS de "Current User".
' En este caso podrán aparecer certificados duplicados si se usan almacenes
' distintos de "Personal" (por ejemplo "Raíces de confianza"), ya que los
' almacenes de "Current User" distintos de "Personal" heredan el contenido
' de los almacenes de "Local Machine".
'----------------------------------------------------------------------------------------------------------
Try
If nombresAlmacenes Is Nothing Then
nombresAlmacenes = {SSC.X509Certificates.StoreName.My, _
SSC.X509Certificates.StoreName.AddressBook}
ElseIf nombresAlmacenes.Length = 0 Then
Throw New Exception("'nombresAlmacenes' tiene 0 elementos.")
End If
'------ Extracción de certificados desde los almacenes ------
Dim i As Integer
Dim st As SSC.X509Certificates.X509Store
Dim certCol As New SSC.X509Certificates.X509Certificate2Collection()
For i = 0 To (nombresAlmacenes.Length - 1)
' Current User:
st = New SSC.X509Certificates.X509Store(nombresAlmacenes(i), SSC.X509Certificates.StoreLocation.CurrentUser)
st.Open(SSC.X509Certificates.OpenFlags.ReadOnly Or SSC.X509Certificates.OpenFlags.IncludeArchived)
certCol.AddRange(st.Certificates)
st.Close()
If incluirLocalMachine Then
' Local Machine:
st = New SSC.X509Certificates.X509Store(nombresAlmacenes(i), SSC.X509Certificates.StoreLocation.LocalMachine)
st.Open(SSC.X509Certificates.OpenFlags.ReadOnly Or SSC.X509Certificates.OpenFlags.IncludeArchived)
certCol.AddRange(st.Certificates)
st.Close()
End If
Next
'------ Filtrado de la colección de certificados ------
If fechaReferencia <> Nothing Then
certCol = certCol.Find(SSC.X509Certificates.X509FindType.FindByTimeValid, fechaReferencia, False)
End If
If filtroIssuer IsNot Nothing Then
certCol = certCol.Find(SSC.X509Certificates.X509FindType.FindByIssuerName, filtroIssuer, False)
End If
If filtroSubject IsNot Nothing Then
certCol = certCol.Find(SSC.X509Certificates.X509FindType.FindBySubjectName, filtroSubject, False)
End If
If soloConPrivada Then
For i = (certCol.Count - 1) To 0 Step -1
If Not certCol(i).HasPrivateKey Then certCol.RemoveAt(i)
Next
End If
'------ Selección interactiva del certificado ------
If seleccionInteractiva Then
If mensajeInteractivo Is Nothing Then
' Mensaje por defecto:
mensajeInteractivo = "Se muestran los siguientes certificados:" & vbCrLf & _
" Almacenes: " & StoreNameArrayToString(nombresAlmacenes) & vbCrLf & _
" Vigencia: " & If(fechaReferencia = Nothing, "Cualquiera", "En " & DateToString(fechaReferencia)) & vbCrLf & _
" Sólo con clave privada: " & If(soloConPrivada, "", "No") & vbCrLf & _
" Filtro de Titular: " & If(filtroSubject Is Nothing, "Todos", filtroSubject) & vbCrLf & _
" Filtro de Emisor: " & If(filtroIssuer Is Nothing, "Todos", filtroIssuer)
End If
certCol = SSC.X509Certificates.X509Certificate2UI.SelectFromCollection(certCol, _
If(exigirResultadoUnico, _
"SELECCIONE UN CERTIFICADO", _
"SELECCIONE CERTIFICADO(S)"), _
mensajeInteractivo, _
If(exigirResultadoUnico, _
SSC.X509Certificates.X509SelectionFlag.SingleSelection, _
SSC.X509Certificates.X509SelectionFlag.MultiSelection))
End If
'------ Devolución del resultado ------
If exigirResultadoUnico AndAlso (certCol.Count <> 1) Then
Throw New Exception("Se exige UN certificado.")
End If
Return certCol
Catch ex As Exception
Throw New Exception("Importando certificado(s) desde Almacenes de Certificados de Windows: " & _
StoreNameArrayToString(nombresAlmacenes) & vbCrLf & _
ex.Message, ex)
End Try
End Function
Public Shared Function EstadoRevocToString(ByVal estadoRevoc As EstadoRevocEnum) As String
Dim res As String
Select Case estadoRevoc
Case EstadoRevocEnum.NoRevocado : res = "Correcto (no revocado)"
Case EstadoRevocEnum.Revocado : res = "Revocado"
Case EstadoRevocEnum.Indeterminado : res = "Indeterminado"
Case Else
res = "Valor desconocido de estado de revocación: " & estadoRevoc
End Select
Return res
End Function
Public Shared Function RevocationReasonToString(ByVal reason As Integer) As String
'----------------------------------------------
' reason: Código de la causa de la revocación.
'----------------------------------------------
Dim res As String
Select Case reason
Case 0 : res = "Causa no especificada"
Case 1 : res = "Clave comprometida"
Case 2 : res = "Autoridad Certificadora comprometida"
Case 3 : res = "Cambio de afiliación"
Case 4 : res = "Sustitución del certificado"
Case 5 : res = "Cese de operación del Emisor"
Case 6 : res = "Suspensión del certificado"
Case 8 : res = "Acción: Eliminar de CRL tras suspensión"
Case 9 : res = "Retirada de privilegios"
Case 10 : res = "Autoridad de Autorización comprometida"
Case Else
res = If(reason = -1, "Causa no disponible", "Código no catalogado")
End Select
res &= " (CodRev=" & reason & ")"
Return res
End Function
Public Shared Function StoreNameToString(ByVal sn As SSC.X509Certificates.StoreName) As String
'---------------------------------------------------------------------------------
' Traduce 'sn' (valor de la enumeración StoreName) a su representación en string.
'---------------------------------------------------------------------------------
Dim res As String
Select Case sn
Case SSC.X509Certificates.StoreName.AddressBook : res = "Otras personas"
Case SSC.X509Certificates.StoreName.AuthRoot : res = "Otras CAs"
Case SSC.X509Certificates.StoreName.CertificateAuthority : res = "CAs intermedias"
Case SSC.X509Certificates.StoreName.Disallowed : res = "Certificados revocados"
Case SSC.X509Certificates.StoreName.My : res = "Personal"
Case SSC.X509Certificates.StoreName.Root : res = "Raíces de confianza"
Case SSC.X509Certificates.StoreName.TrustedPeople : res = "Personas de confianza directa"
Case SSC.X509Certificates.StoreName.TrustedPublisher : res = "Emisores de confianza directa"
Case Else
res = "<Desconocido:" & sn & ">"
End Select
Return res
End Function
Public Shared Function StoreNameArrayToString(ByVal snArray As SSC.X509Certificates.StoreName()) As String
'-----------------------------------------------------------
' Traduce el array 'snArray' a su representación en string.
'-----------------------------------------------------------
If snArray Is Nothing Then Return "<LISTA NULA>"
Dim s(snArray.Length - 1) As String
Dim i As Integer
For i = 0 To (snArray.Length - 1)
s(i) = StoreNameToString(snArray(i))
Next
Return ArrayToString(s, , , ", ")
End Function
Public Shared Function DateToString(ByVal d As Date) As String
Return d.ToString("dd\/MM\/yyyy HH\:mm\:ss")
End Function
Public Shared Function Array2Hex(ByVal a As Byte(), _
Optional ByVal separador As String = "") As String
'--------------------------------------------------------------------------------------------------
' Transforma un array de bytes a un string en hexadecimal (cada byte se representa en hexadecimal).
' Los caracteres alfabéticos hexadecimales SIEMPRE SE REPRESENTAN EN MAYÚSCULAS (ABCDEF).
'--------------------------------------------------------------------------------------------------
' 'separador' es el string separador de bytes (POR DEFECTO VACÍO).
'--------------------------------------------------------------------------------------------------
Dim res As String = ""
If (a IsNot Nothing) AndAlso (a.Length > 0) Then
Dim i As Integer
For i = 0 To (a.Length - 2)
res &= [String].Format("{0:X2}", a(i)) & separador
Next
res &= [String].Format("{0:X2}", a(a.Length - 1))
End If
Return res
End Function
Public Shared Function ArrayToString(ByVal a As Array, _
Optional ByVal lineNumberDigits As Integer = 0, _
Optional ByVal globalIndent As String = "", _
Optional ByVal separator As String = vbCrLf, _
Optional ByVal baseLineNumber As Integer = 1) As String
'-----------------------------------------------------------------------------
' Transforma el array UNIDIMENSIONAL 'a' a su representación en string.
' Se usa el método ToString() de cada elemento del array.
'-----------------------------------------------------------------------------
' lineNumberDigits --> Número de digitos reservados para el número de línea.
' Si es 0 no se mostrará número de línea.
' globalIndent --> String que se usa como indentación de todas las líneas.
' separator --> Separador de elementos del array (NO A LA COLA).
' baseLineNumber --> Número de línea inicial.
'-----------------------------------------------------------------------------
If a Is Nothing Then Return globalIndent & "<LISTA NULA>"
If a.Rank <> 1 Then Throw New Exception("ArrayToString: Array NO unidimensional.")
If a.Length = 0 Then Return globalIndent & "<LISTA VACÍA>"
'------
' Usamos un StringBuilder por eficiencia (la lista puede ser larga):
Dim sb As New System.Text.StringBuilder
Dim elemStr As String ' Representación en string de un elemento de 'a'
Dim num As String ' String con el número de elemento
Dim localIndent As String ' Indentación local a cada elemento
Dim i As Integer
For i = 0 To (a.Length - 1)
If i = (a.Length - 1) Then separator = ""
If a(i) Is Nothing Then
elemStr = "<Elemento Nulo>"
Else
elemStr = a(i).ToString()
End If
If lineNumberDigits > 0 Then
num = (i + baseLineNumber).ToString().PadLeft(lineNumberDigits) & ". "
localIndent = New String(" "c, num.Length)
sb.Append(globalIndent & num & elemStr.Replace(vbCrLf, vbCrLf & globalIndent & localIndent) & separator)
Else
sb.Append(globalIndent & elemStr.Replace(vbCrLf, vbCrLf & globalIndent) & separator)
End If
Next
Return sb.ToString()
End Function
Public Shared Function Indent(ByVal text As String, _
Optional ByVal numberOfSpaces As Integer = 4, _
Optional ByVal indentPrefix As String = "", _
Optional ByVal indentFirstLine As Boolean = True) As String
'------------------------------------------------------------------------------------
' Indenta 'text' el número de espacios 'numberOfSpaces', devolviendo el nuevo string.
' 'indentPrefix' SE AÑADE al principio de cada línea indentada.
' Si 'indentFirstLine' es False NO se indenta la primera línea de 'text'.
'------------------------------------------------------------------------------------
If text Is Nothing Then text = ""
If numberOfSpaces < 0 Then Throw New Exception("Indent: 'numberOfSpaces' < 0")
Dim indentStr As String = indentPrefix & New String(" "c, numberOfSpaces)
Return If(indentFirstLine, indentStr, "") & text.Replace(vbCrLf, vbCrLf & indentStr)
End Function
Public Shared Function Fichero2Array(ByVal nombreFich As String, _
Optional ByVal mensajeError As String = Nothing, _
Optional ByVal limiteMaxBytes As Long = Long.MaxValue, _
Optional ByVal limiteMinBytes As Long = 0) As Byte()
'--------------------------------------------------------------------
' Lee del fichero 'nombreFich' todo su contenido como array de bytes.
'--------------------------------------------------------------------
' 'mensajeError' se mostrará en los mensajes de EXCEPCIONES.
' 'limiteMaxBytes' es la longitud máxima que se permite al fichero.
' 'limiteMinBytes' es la longitud mínima que se permite al fichero.
' Si NO se cumplen los límites NO se lee nada y se eleva EXCEPCIÓN.
'--------------------------------------------------------------------
Dim res As Byte()
Dim fsFich As FileStream
Try
fsFich = New FileStream(nombreFich, FileMode.Open, FileAccess.Read)
Dim fsFichLen As Long = fsFich.Length
If fsFichLen > limiteMaxBytes Then
Throw New Exception("Fichero demasiado grande: " & fsFichLen & " Bytes")
End If
If fsFichLen < limiteMinBytes Then
Throw New Exception("Fichero demasiado pequeño: " & fsFichLen & " Bytes")
End If
Dim brFich As New BinaryReader(fsFich)
res = brFich.ReadBytes(fsFichLen)
If (fsFich.Length <> fsFichLen) OrElse (res.Length <> fsFichLen) Then
Throw New Exception("ERROR GRAVE: Longitudes de fichero y de información leída incoherentes.")
End If
Catch ex As Exception
Throw New Exception(If(mensajeError = "", "", mensajeError & vbCrLf) & _
"Leyendo array de bytes de fichero: " & nombreFich & vbCrLf & _
ex.Message, ex)
Finally
If fsFich IsNot Nothing Then fsFich.Close()
End Try
Return res
End Function
Public Shared Function CalcularSHA1Str(ByVal a As Byte()) As String
'----------------------------------------------------------------------------------
' Devuelve el hash SHA-1 de 'a' como string hexadecimal (MAYÚSCULAS) sin espacios.
'----------------------------------------------------------------------------------
Try
If a Is Nothing Then
Throw New Exception("El array 'a' es Nothing.")
End If
Dim cspSHA1 As New SSC.SHA1CryptoServiceProvider()
Dim hashSHA1 As Byte() = cspSHA1.ComputeHash(a)
Return Array2Hex(hashSHA1)
Catch ex As Exception
Throw New Exception("Calculando hash SHA-1 (String)." & vbCrLf & ex.Message, ex)
End Try
End Function
#End Region
#Region "Métodos privados compartidos (Shared)"
Private Shared Sub ConsultarOCSP(ByVal certBin As Byte(), _
ByVal certPadreBin As Byte(), _
ByVal usarUrlResponderDeCert As Boolean, _
ByVal urlResponder As String, _
ByVal arrayPadresResponderAutBin As Byte()(), _
ByVal usarResponderDeRespuestaOCSP As Boolean, _
ByVal arrayRespondersBin As Byte()(), _
ByVal timeoutSegundos As Integer, _
ByVal requestorBin As Byte(), _
ByVal chainRequestorBin As Byte()(), _
ByVal privadaRequestor As SSC.RSAParameters, _
ByRef reintentable As Boolean, _
ByRef infoRev As InfoRevoc)
'--------------------------------------------------------------------------------------
' Realiza una única consulta OCSP.
'--------------------------------------------------------------------------------------
' reintentable: Se devuelve True si después de esta petición tiene sentido reintentar.
'--------------------------------------------------------------------------------------
Try
If certBin Is Nothing Then Throw New Exception("'certBin' es Nothing.")
If certPadreBin Is Nothing Then Throw New Exception("'certPadreBin' es Nothing.")
If (Not usarUrlResponderDeCert) AndAlso (urlResponder = "") Then
Throw New Exception("'usarUrlResponderDeCert' es False y 'urlResponder' está vacía.")
End If
If usarResponderDeRespuestaOCSP Then
If (arrayPadresResponderAutBin IsNot Nothing) AndAlso (arrayPadresResponderAutBin.Length = 0) Then
Throw New Exception("'usarResponderDeRespuestaOCSP' es True y 'arrayPadresResponderAutBin' es vacío.")
End If
Else
If (arrayRespondersBin IsNot Nothing) AndAlso (arrayRespondersBin.Length = 0) Then
Throw New Exception("'usarResponderDeRespuestaOCSP' es False y 'arrayRespondersBin' es vacío.")
End If
End If
If timeoutSegundos < 1 Then Throw New Exception("'timeoutSegundos' es menor que 1.")
'--------
infoRev = New InfoRevoc()
infoRev.CertBin = certBin
infoRev.EstadoRevoc = EstadoRevocEnum.Indeterminado
infoRev.MsjEstadoRevoc = Nothing
infoRev.FechaRevocUTC = Nothing
infoRev.ThisUpdateUTC = Nothing
infoRev.NextUpdateUTC = Nothing
infoRev.RespuestaOCSPBin = Nothing
infoRev.RespuestaEfectiva = False
infoRev.UrlResponder = Nothing
infoRev.ResponderBin = Nothing
'======== Lectura de cert y de certPadre ========
Dim cert As BC.X509.X509Certificate = LeerCert(certBin, "certBin")
Dim certPadre As BC.X509.X509Certificate = LeerCert(certPadreBin, "certPadreBin")
' Para que la consulta OCSP sea correcta es MUY IMPORTANTE asegurarse
' de que 'certPadre' realmente es el padre de 'cert', tanto nominalmente
' como criptográficamente:
If Not cert.IssuerDN.Equivalent(certPadre.SubjectDN, True) Then
Throw New Exception("'certPadre' NO es el emisor de 'cert'.")
End If
If Not FirmaValidaCert(cert, certPadre.GetPublicKey()) Then
Throw New Exception("NO es válida la firma del certificado de:" & vbCrLf & _
cert.SubjectDN.ToString())
End If
'======== Lectura de la URL del Responder ========
If usarUrlResponderDeCert Then
infoRev.UrlResponder = ExtraerUrlResponder(cert)
End If
If infoRev.UrlResponder = "" Then
If urlResponder = "" Then
Throw New Exception("No se dispone de la URL del Responder OCSP.")
End If
infoRev.UrlResponder = urlResponder
End If
'======= Lectura de arrayPadresResponderAut =======
Dim arrayPadresResponderAut As BC.X509.X509Certificate()
If arrayPadresResponderAutBin Is Nothing Then
arrayPadresResponderAut = {certPadre}
Else
arrayPadresResponderAut = LeerArrayCerts(arrayPadresResponderAutBin, "arrayPadresResponderAutBin")
End If
'=========== Lectura de arrayResponders ===========
Dim arrayResponders As BC.X509.X509Certificate()
If arrayRespondersBin Is Nothing Then
arrayResponders = {certPadre}
Else
arrayResponders = LeerArrayCerts(arrayRespondersBin, "arrayRespondersBin")
End If
'============= Lectura de Requestor =============
Dim firmarPeticion As Boolean = (requestorBin IsNot Nothing)
Dim requestor As BC.X509.X509Certificate
Dim chainRequestor As BC.X509.X509Certificate()
Dim privadaRequestorBC As BC.Crypto.Parameters.RsaKeyParameters
If firmarPeticion Then
requestor = LeerCert(requestorBin, "requestorBin")
'------
If (chainRequestorBin Is Nothing) OrElse (chainRequestorBin.Length = 0) Then
' No se aporta la cadena de certificación del Requestor para el campo OPCIONAL 'certs'
' del Sequence ASN.1 'Signature' de la petición OCSP:
chainRequestor = Nothing
Else
' 'chainRequestorBin' debe tener el ORDEN CORRECTO para la petición OCSP:
chainRequestor = LeerArrayCerts(chainRequestorBin, "chainRequestorBin")
End If
'------
If (privadaRequestor.Modulus Is Nothing) OrElse (privadaRequestor.Modulus.Length = 0) Then
Throw New Exception("'privadaRequestor' no contiene Modulus RSA.")
End If
If (privadaRequestor.D Is Nothing) OrElse (privadaRequestor.D.Length = 0) Then
Throw New Exception("'privadaRequestor' no contiene clave privada RSA.")
End If
Dim modulusRequestor As New BC.Math.BigInteger(+1, privadaRequestor.Modulus)
Dim privateExponentRequestor As New BC.Math.BigInteger(+1, privadaRequestor.D)
privadaRequestorBC = New BC.Crypto.Parameters.RsaKeyParameters(True, modulusRequestor, privateExponentRequestor)
End If
'========== Generación de petición OCSP ==========
Dim reqGen As New BC.Ocsp.OcspReqGenerator()
Dim certIDpet As New BC.Ocsp.CertificateID(BC.Ocsp.CertificateID.HashSha1, certPadre, cert.SerialNumber)
reqGen.AddRequest(certIDpet)
Dim pet As BC.Ocsp.OcspReq
If firmarPeticion Then
reqGen.SetRequestorName(requestor.SubjectDN)
pet = reqGen.Generate("SHA256WITHRSA", privadaRequestorBC, chainRequestor)
Else
pet = reqGen.Generate()
End If
Dim petBin As Byte() = pet.GetEncoded()
Try
'======== Envío de petición OCSP vía HTTP POST ========
reintentable = True
Dim httpReq As Net.HttpWebRequest = CType(Net.WebRequest.Create(infoRev.UrlResponder), Net.HttpWebRequest)
httpReq.Timeout = timeoutSegundos * 1000 ' Milisegundos
httpReq.Method = "POST"
httpReq.ContentType = "application/ocsp-request"
httpReq.ContentLength = petBin.Length
Dim reqStream As IO.Stream = httpReq.GetRequestStream()
Try
reqStream.Write(petBin, 0, petBin.Length)
Finally
' IMPORTANTE cerrar la conexión:
reqStream.Close()
End Try
'============ Recepción de respuesta OCSP ============
Dim resp As BC.Ocsp.OcspResp
Dim httpResp As Net.HttpWebResponse = CType(httpReq.GetResponse(), Net.HttpWebResponse)
Try
If httpResp.StatusCode <> Net.HttpStatusCode.OK Then
Throw New Exception("Error HTTP (Código=" & CInt(httpResp.StatusCode) & "): " & httpResp.StatusDescription)
End If
Dim respStream As IO.Stream = httpResp.GetResponseStream()
resp = New BC.Ocsp.OcspResp(respStream)
Finally
' IMPORTANTE hacer el Close() de la respuesta http para cerrar la conexión.
' Este Close() también cierra el 'respStream'.
httpResp.Close()
End Try
'============== PROCESAMIENTO DE RESPUESTA OCSP ==============
infoRev.RespuestaOCSPBin = resp.GetEncoded()
If resp.Status = BC.Ocsp.OcspRespStatus.Successful Then
'------------------------------------------------------------------------
' La respuesta OCSP es EFECTIVA (es decir, debe haber respuesta FIRMADA)
'------------------------------------------------------------------------
reintentable = False
infoRev.RespuestaEfectiva = True
Dim basicResp As BC.Ocsp.BasicOcspResp = CType(resp.GetResponseObject(), BC.Ocsp.BasicOcspResp)
Dim fechaActualUTC As Date = DateTime.UtcNow
Dim responderUsado As BC.X509.X509Certificate
Dim msjInvalidez As String
Dim firmaValida As Boolean = FirmaValidaRespuestaOCSP(basicResp, _
fechaActualUTC, arrayPadresResponderAut, _
usarResponderDeRespuestaOCSP, arrayResponders, _
responderUsado, msjInvalidez)
infoRev.ResponderBin = responderUsado.GetEncoded()
If Not firmaValida Then
Throw New Exception(msjInvalidez)
End If
'------
If (basicResp.Responses Is Nothing) OrElse (basicResp.Responses.Length <> 1) Then
Throw New Exception("El número de elementos del campo 'responses' del BasicOCSPResponse es distinto de 1.")
End If
Dim singleResp As BC.Ocsp.SingleResp = basicResp.Responses(0)
If Not singleResp.GetCertID().Equals(certIDpet) Then
Throw New Exception("El 'CertificateID' de la respuesta OCSP no coincide con el de la petición.")
End If
'------
' 'ThisUpdate' ya viene en UTC, y siempre está presente (NO es un campo opcional):
infoRev.ThisUpdateUTC = singleResp.ThisUpdate
' 'NextUpdate' es un campo OPCIONAL:
If singleResp.NextUpdate Is Nothing Then
' NextUpdate NO PRESENTE:
infoRev.NextUpdateUTC = Nothing
Else
' NextUpdate PRESENTE (ya viene en UTC):
infoRev.NextUpdateUTC = singleResp.NextUpdate.Value
End If
'------
Dim certStatus As Object = singleResp.GetCertStatus()
If certStatus Is BC.Ocsp.CertificateStatus.Good Then ' Equivale a Is Nothing
infoRev.EstadoRevoc = EstadoRevocEnum.NoRevocado
infoRev.MsjEstadoRevoc = Nothing
infoRev.FechaRevocUTC = Nothing
If (infoRev.NextUpdateUTC <> Nothing) AndAlso (infoRev.NextUpdateUTC < fechaActualUTC) Then
Throw New Exception("[ERROR_NEXTUPDATE_ANTIGUO] Información de revocación obsoleta porque 'NextUpdateUTC' (" & _
DateToString(infoRev.NextUpdateUTC) & ") es anterior a 'FechaActualUTC' (" & _
DateToString(fechaActualUTC) & ").")
End If
ElseIf TypeOf certStatus Is BC.Ocsp.RevokedStatus Then
infoRev.EstadoRevoc = EstadoRevocEnum.Revocado
Dim revInfo As BC.Ocsp.RevokedStatus = CType(certStatus, BC.Ocsp.RevokedStatus)
infoRev.MsjEstadoRevoc = If(revInfo.HasRevocationReason, RevocationReasonToString(revInfo.RevocationReason), _
RevocationReasonToString(-1))
infoRev.FechaRevocUTC = revInfo.RevocationTime ' Ya viene en UTC
ElseIf TypeOf certStatus Is BC.Ocsp.UnknownStatus Then
infoRev.EstadoRevoc = EstadoRevocEnum.Indeterminado
infoRev.MsjEstadoRevoc = "[CERT_STATUS_UNKNOWN] Estado de revocación del certificado: DESCONOCIDO"
infoRev.FechaRevocUTC = Nothing
Else
Throw New Exception("'certStatus' NO CATALOGADO.")
End If
Else
'---------------------------------
' NO HA HABIDO RESPUESTA EFECTIVA
'---------------------------------
infoRev.RespuestaEfectiva = False
Dim msjStatus As String
Select Case resp.Status
Case BC.Ocsp.OcspRespStatus.MalformedRequest
reintentable = False
msjStatus = "Petición OCSP mal formada"
Case BC.Ocsp.OcspRespStatus.InternalError
reintentable = True
msjStatus = "Error interno del servidor OCSP"
Case BC.Ocsp.OcspRespStatus.TryLater
reintentable = True
msjStatus = "Servidor OCSP indica que se reintente más tarde"
Case BC.Ocsp.OcspRespStatus.SigRequired
reintentable = False
msjStatus = "Servidor OCSP exige petición firmada"
Case BC.Ocsp.OcspRespStatus.Unauthorized
reintentable = False
msjStatus = "Petición OCSP sin autorización"
Case Else
reintentable = False
msjStatus = "Código de status OCSP no catalogado"
End Select
Throw New Exception("Código de status de la respuesta OCSP: " & resp.Status & " (" & msjStatus & ")")
End If
Catch ex As Exception
infoRev.EstadoRevoc = EstadoRevocEnum.Indeterminado
infoRev.MsjEstadoRevoc = "[ERROR_COMUNICACION_OCSP] Error de comunicación con Servidor OCSP." & vbCrLf & ex.Message
infoRev.FechaRevocUTC = Nothing
End Try
Catch ex As Exception
reintentable = False
infoRev = Nothing
Throw New Exception("Error ejecutando ConsultarOCSP." & vbCrLf & ex.Message, ex)
End Try
End Sub
Private Shared Function LeerCert(ByVal certBin As Byte(),
ByVal msjExcepcion As String) As BC.X509.X509Certificate
Try
If certBin Is Nothing Then
Throw New Exception("El certificado es Nothing.")
End If
Dim parser As New BC.X509.X509CertificateParser()
Return parser.ReadCertificate(certBin)
Catch ex As Exception
Throw New Exception("Leyendo certificado (" & msjExcepcion & ")." & vbCrLf & ex.Message, ex)
End Try
End Function
Private Shared Function LeerArrayCerts(ByVal arrayCertsBin As Byte()(), _
ByVal msjExcepcion As String) As BC.X509.X509Certificate()
Try
If arrayCertsBin Is Nothing Then Return Nothing
If arrayCertsBin.Length = 0 Then Return {}
Dim parser As New BC.X509.X509CertificateParser()
Dim arrayCerts(arrayCertsBin.Length - 1) As BC.X509.X509Certificate
Dim i As Integer
For i = 0 To (arrayCertsBin.Length - 1)
If arrayCertsBin(i) Is Nothing Then
Throw New Exception("El array contiene un elemento Nothing.")
End If
arrayCerts(i) = parser.ReadCertificate(arrayCertsBin(i))
Next
Return arrayCerts
Catch ex As Exception
Throw New Exception("Leyendo array de certificados (" & msjExcepcion & ")." & vbCrLf & ex.Message, ex)
End Try
End Function
Private Shared Function BuscarCertPadre(ByVal cert As BC.X509.X509Certificate, _
ByVal arrayCertsPadres As BC.X509.X509Certificate()) As Integer
'--------------------------------------------------------------
' RESULTADO: Índice del padre de 'cert' en 'arrayCertsPadres',
' o -1 si no se encuentra.
'--------------------------------------------------------------
' Se comprueban DNs y FIRMA CRIPTOGRÁFICA.
'--------------------------------------------------------------
Try
If cert Is Nothing Then Throw New Exception("'cert' es Nothing.")
If (arrayCertsPadres Is Nothing) OrElse (arrayCertsPadres.Length = 0) Then Return -1
'---------
Dim i As Integer
For i = 0 To (arrayCertsPadres.Length - 1)
If arrayCertsPadres(i) Is Nothing Then
Throw New Exception("'arrayCertsPadres' contiene un elemento Nothing.")
End If
If cert.IssuerDN.Equivalent(arrayCertsPadres(i).SubjectDN, True) Then
' Comprobamos que cert sea hijo de arrayCertsPadres(i) CRIPTOGRÁFICAMENTE (y no sólo nominalmente):
If FirmaValidaCert(cert, arrayCertsPadres(i).GetPublicKey()) Then Return i
End If
Next
Return -1
Catch ex As Exception
Throw New Exception("Buscando certificado emisor." & vbCrLf & ex.Message, ex)
End Try
End Function
Private Shared Function ExtraerUrlResponder(ByVal cert As BC.X509.X509Certificate) As String
'------------------------------------------------------------------------------------
' Devuelve la URL del Responder OCSP almacenada en la extensión AuthorityInfoAccess,
' o Nothing si no se encuentra o si no ha sido posible su extracción.
'------------------------------------------------------------------------------------
Try
If cert Is Nothing Then
Throw New Exception("El certificado es Nothing.")
End If
' OID de la extensión AuthorityInfoAccess (AIA):
Dim oidAIA As String = "1.3.6.1.5.5.7.1.1"
Dim octetStrAIA As BC.Asn1.Asn1OctetString = cert.GetExtensionValue(New BC.Asn1.DerObjectIdentifier(oidAIA))
If octetStrAIA Is Nothing Then Return Nothing
Dim asn1objAIA As BC.Asn1.Asn1Object
Try
' Parsing ASN.1 del valor de la extensión AIA:
asn1objAIA = BC.Asn1.Asn1Object.FromByteArray(octetStrAIA.GetOctets())
Catch ex As Exception
Return Nothing
End Try
' NOTA: (TypeOf Nothing Is <TYPENAME>) = False
If Not (TypeOf asn1objAIA Is BC.Asn1.Asn1Sequence) Then Return Nothing
Dim seqAIA As BC.Asn1.Asn1Sequence = CType(asn1objAIA, BC.Asn1.Asn1Sequence)
Dim oidAccessMethodOCSP As String = "1.3.6.1.5.5.7.48.1"
Dim seqAccessDescription As BC.Asn1.Asn1Sequence
Dim oidAccessMethod As String
Dim gnAccessLocation As BC.Asn1.X509.GeneralName
Dim i As Integer
For i = 0 To (seqAIA.Count - 1)
If Not (TypeOf seqAIA(i) Is BC.Asn1.Asn1Sequence) Then Continue For
seqAccessDescription = CType(seqAIA(i), BC.Asn1.Asn1Sequence)
If seqAccessDescription.Count <> 2 Then Continue For
If Not (TypeOf seqAccessDescription(0) Is BC.Asn1.DerObjectIdentifier) Then Continue For
oidAccessMethod = CType(seqAccessDescription(0), BC.Asn1.DerObjectIdentifier).Id
If oidAccessMethod <> oidAccessMethodOCSP Then Continue For
Try
gnAccessLocation = BC.Asn1.X509.GeneralName.GetInstance(seqAccessDescription(1))
Catch ex As Exception
Continue For
End Try
If gnAccessLocation Is Nothing Then Continue For
If gnAccessLocation.TagNo <> BC.Asn1.X509.GeneralName.UniformResourceIdentifier Then Continue For
If Not (TypeOf gnAccessLocation.Name Is BC.Asn1.DerIA5String) Then Continue For
Return CType(gnAccessLocation.Name, BC.Asn1.DerIA5String).GetString()
Next
Return Nothing
Catch ex As Exception
Throw New Exception("Extrayendo URL del Responder OCSP." & vbCrLf & ex.Message, ex)
End Try
End Function
Private Shared Function TieneOCSPSigning(ByVal cert As BC.X509.X509Certificate) As Boolean
'------------------------------------------------------------------------------------
' Devuelve True si 'cert' tiene el OID OCSPSigning en la extensión ExtendedKeyUsage.
'------------------------------------------------------------------------------------
Try
If cert Is Nothing Then
Throw New Exception("El certificado es Nothing.")
End If
' Lista de OIDs (KeyPurposeIds) como STRINGS:
Dim oids As IList = cert.GetExtendedKeyUsage()
If oids Is Nothing Then Return False
Dim oidOCSPSigning As String = "1.3.6.1.5.5.7.3.9"
Dim i As Integer
For i = 0 To (oids.Count - 1)
If CType(oids(i), String) = oidOCSPSigning Then Return True
Next
Return False
Catch ex As Exception
Throw New Exception("Comprobando presencia de OCSPSigning en la extensión ExtendedKeyUsage." & vbCrLf & ex.Message, ex)
End Try
End Function
Private Shared Function BuscarResponderAutorizado(ByVal certs As BC.X509.X509Certificate()) As BC.X509.X509Certificate
'---------------------------------------------------------------------
' Devuelve la primera aparición en 'certs' de un Responder Autorizado
' (es decir, con OCSPSigning), o Nothing si no se encuentra.
'---------------------------------------------------------------------
Try
If certs Is Nothing Then Return Nothing
Dim i As Integer
For i = 0 To (certs.Length - 1)
If (certs(i) IsNot Nothing) AndAlso TieneOCSPSigning(certs(i)) Then Return certs(i)
Next
Return Nothing
Catch ex As Exception
Throw New Exception("Buscando Responder Autorizado." & vbCrLf & ex.Message, ex)
End Try
End Function
Private Shared Function FirmaValidaCert(ByVal cert As BC.X509.X509Certificate, _
ByVal clavePublica As BC.Crypto.AsymmetricKeyParameter) As Boolean
'-----------------------------------------------
' Sólo se comprueba la firma digital de 'cert'.
'-----------------------------------------------
Try
If cert Is Nothing Then Throw New Exception("'cert' es Nothing.")
If clavePublica Is Nothing Then Throw New Exception("'clavePublica' es Nothing.")
Try
' 'Verify' comprueba la firma digital. Es un Sub que eleva EXCEPCIÓN si la firma es incorrecta:
cert.Verify(clavePublica)
Catch ex As Exception
' La firma NO es válida:
Return False
End Try
' Si llegamos aquí es porque la firma es válida:
Return True
Catch ex As Exception
Throw New Exception("Validando firma de un certificado." & vbCrLf & ex.Message, ex)
End Try
End Function
Private Shared Function ValidoCertSinRevoc(ByVal cert As BC.X509.X509Certificate, _
ByVal arrayCertsPadres As BC.X509.X509Certificate(), _
ByVal fechaUTC As Date, _
Optional ByRef msjInvalidez As String = Nothing) As Boolean
'--------------------------------------------------------------------
' No se comprueba el estado de revocación de 'cert'.
' 'arrayCertsPadres' contiene los posibles padres (al menos 1).
' Se asume que los padres han sido VALIDADOS PREVIAMENTE.
'--------------------------------------------------------------------
' msjInvalidez: Nothing si 'cert' es VÁLIDO según algún padre;
' mensaje con la causa de la invalidez si es INVÁLIDO.
'--------------------------------------------------------------------
Try
If cert Is Nothing Then Throw New Exception("'cert' es Nothing.")
If (arrayCertsPadres Is Nothing) OrElse (arrayCertsPadres.Length = 0) Then
Throw New Exception("'arrayCertsPadres' es Nothing o vacío.")
End If
'-----------
If arrayCertsPadres.Length = 1 Then
If arrayCertsPadres(0) Is Nothing Then
Throw New Exception("El único elemento de 'arrayCertsPadres' es Nothing.")
End If
Dim certPadre As BC.X509.X509Certificate = arrayCertsPadres(0)
msjInvalidez = "Validando certificado de: " & cert.SubjectDN.ToString() & vbCrLf & _
" respecto a: " & certPadre.SubjectDN.ToString() & vbCrLf
If Not cert.IssuerDN.Equivalent(certPadre.SubjectDN, True) Then
msjInvalidez &= "El segundo certificado no es el emisor del primero."
Return False
End If
If Not FirmaValidaCert(cert, certPadre.GetPublicKey()) Then
msjInvalidez &= "Firma NO válida."
Return False
End If
Else
' La búsqueda siguiente comprueba DNs y firma criptográfica:
Dim iPadre As Integer = BuscarCertPadre(cert, arrayCertsPadres)
If iPadre = -1 Then
msjInvalidez = "Validando certificado de: " & cert.SubjectDN.ToString() & vbCrLf & _
"respecto a " & arrayCertsPadres.Length & " certificados emisores posibles." & vbCrLf &
"No se ha encontrado certificado emisor."
Return False
End If
msjInvalidez = "Validando certificado de: " & cert.SubjectDN.ToString() & vbCrLf & _
" respecto a: " & arrayCertsPadres(iPadre).SubjectDN.ToString() & vbCrLf
End If
'-----------
' NOTA: cert.NotBefore y cert.NotAfter están en UTC
If fechaUTC < cert.NotBefore Then
msjInvalidez &= "Certificado aún no válido en " & DateToString(fechaUTC.ToLocalTime()) & _
" (válido desde " & DateToString(cert.NotBefore.ToLocalTime()) & ")."
Return False
End If
If fechaUTC > cert.NotAfter Then
msjInvalidez &= "Certificado caducado en " & DateToString(fechaUTC.ToLocalTime()) & _
" (válido hasta " & DateToString(cert.NotAfter.ToLocalTime()) & ")."
Return False
End If
'-----------
msjInvalidez = Nothing
Return True
Catch ex As Exception
msjInvalidez = Nothing
Throw New Exception("Validando certificado." & vbCrLf & ex.Message, ex)
End Try
End Function
Private Shared Function FirmaValidaRespuestaOCSP(ByVal basicResp As BC.Ocsp.BasicOcspResp, _
ByVal fechaUTC As Date, _
ByVal arrayPadresResponderAut As BC.X509.X509Certificate(), _
ByVal usarResponderDeRespuestaOCSP As Boolean, _
ByVal arrayResponders As BC.X509.X509Certificate(), _
Optional ByRef responderUsado As BC.X509.X509Certificate = Nothing, _
Optional ByRef msjInvalidez As String = Nothing) As Boolean
'----------------------------------------------------------------------------------------------------------
' No se tiene en cuenta (ThisUpdate, NextUpdate) de la respuesta OCSP.
'----------------------------------------------------------------------------------------------------------
' fechaUTC: Fecha en la que se validará el Responder Autorizado contenido en la respuesta OCSP.
'
' arrayPadresResponderAut: Padres permitidos para el Responder Autorizado.
' Se usarán para validar el Responder Autorizado contenido en la respuesta OCSP.
' Se asume que los padres han sido VALIDADOS PREVIAMENTE.
' Debe ser no vacío si usarResponderDeRespuestaOCSP = True.
' El valor Nothing NO tiene ningún significado especial.
'
' usarResponderDeRespuestaOCSP: True si se desea usar el Responder Autorizado contenido en la respuesta OCSP
' (en el campo 'certs' del Sequence ASN.1 'BasicOCSPResponse').
'
' arrayResponders: Responders locales (se asume que han sido VALIDADOS PREVIAMENTE) que se usarán para
' validar la firma de la respuesta OCSP en el caso de que ésta no contenga un Responder
' Autorizado, o cuando usarResponderDeRespuestaOCSP = False.
' Si la respuesta contiene un Responder Autorizado y usarResponderDeRespuestaOCSP = True,
' entonces NO se usarán los Responders locales pasados como argumento.
' El valor Nothing NO tiene ningún significado especial.
'----------------------------------------------------------------------------------------------------------
' responderUsado: Se devuelve el certificado Responder usado para validar la firma de la respuesta OCSP.
' Siempre es distinto de Nothing, salvo cuando hay excepción.
'
' msjInvalidez: Nothing si la firma de la respuesta OCSP es VÁLIDA;
' mensaje con la causa de la invalidez si es INVÁLIDA.
'----------------------------------------------------------------------------------------------------------
Try
If basicResp Is Nothing Then
Throw New Exception("'basicResp' es Nothing.")
End If
If usarResponderDeRespuestaOCSP AndAlso _
((arrayPadresResponderAut Is Nothing) OrElse (arrayPadresResponderAut.Length = 0)) Then
Throw New Exception("'usarResponderDeRespuestaOCSP' es True y 'arrayPadresResponderAut' es Nothing o vacío.")
End If
'-----------
msjInvalidez = "Validando firma de la respuesta OCSP." & vbCrLf
If usarResponderDeRespuestaOCSP Then
Dim responderAut As BC.X509.X509Certificate = BuscarResponderAutorizado(basicResp.GetCerts())
If responderAut IsNot Nothing Then
' IMPORTANTE: 'responderAut' tiene OCSPSigning en la extensión ExtendedKeyUsage.
Dim msjInvalidezResponderAut As String
If Not ValidoCertSinRevoc(responderAut, arrayPadresResponderAut, fechaUTC, msjInvalidezResponderAut) Then
responderUsado = responderAut
msjInvalidez &= "Validando Responder contenido en la respuesta OCSP." & vbCrLf & _
msjInvalidezResponderAut
Return False
End If
' Sustituimos los Responders pasados como argumento con el Responder Autorizado:
arrayResponders = {responderAut}
End If
End If
If (arrayResponders Is Nothing) OrElse (arrayResponders.Length = 0) Then
Throw New Exception("No se dispone de certificado Responder.")
End If
Dim i As Integer
For i = 0 To (arrayResponders.Length - 1)
If arrayResponders(i) Is Nothing Then
Throw New Exception("'arrayResponders' contiene un elemento Nothing.")
End If
responderUsado = arrayResponders(i)
If basicResp.Verify(responderUsado.GetPublicKey()) Then
msjInvalidez = Nothing
Return True
End If
Next
msjInvalidez &= "Firma NO válida."
Return False
Catch ex As Exception
responderUsado = Nothing
msjInvalidez = Nothing
Throw New Exception("Validando firma de la respuesta OCSP." & vbCrLf & ex.Message, ex)
End Try
End Function
Private Shared Function CertCorrespondeARespuestaOCSP(ByVal cert As BC.X509.X509Certificate, _
ByVal arrayCertsPadres As BC.X509.X509Certificate(), _
ByVal basicResp As BC.Ocsp.BasicOcspResp) As Boolean
'----------------------------------------------------------------------------------------
' Devuelve True si el certificado 'cert' corresponde a la respuesta OCSP, es decir,
' si la información de revocación contenida en 'basicResp' es de 'cert'.
'----------------------------------------------------------------------------------------
' Lo que se comprueba es la coincidencia del CertificateID de 'cert' con el
' CertificateID contenido en la respuesta OCSP.
'----------------------------------------------------------------------------------------
' arrayCertsPadres: Array con los posibles padres de 'cert' (al menos 1).
' Se asume que los certificados han sido VALIDADOS PREVIAMENTE.
' La función busca el padre correspondiente.
'----------------------------------------------------------------------------------------
Try
If cert Is Nothing Then
Throw New Exception("'cert' es Nothing.")
End If
If (arrayCertsPadres Is Nothing) OrElse (arrayCertsPadres.Length = 0) Then
Throw New Exception("'arrayCertsPadres' es Nothing o vacío.")
End If
If basicResp Is Nothing Then
Throw New Exception("'basicResp' es Nothing.")
End If
'============
If (basicResp.Responses Is Nothing) OrElse (basicResp.Responses.Length <> 1) Then
Throw New Exception("El número de elementos del campo 'responses' del BasicOCSPResponse es distinto de 1.")
End If
Dim certIDResp As BC.Ocsp.CertificateID = basicResp.Responses(0).GetCertID()
'============
Dim iPadre As Integer = BuscarCertPadre(cert, arrayCertsPadres)
If iPadre = -1 Then
Throw New Exception("No se ha encontrado certificado emisor.")
End If
Dim certPadre As BC.X509.X509Certificate = arrayCertsPadres(iPadre)
Dim certID As New BC.Ocsp.CertificateID(BC.Ocsp.CertificateID.HashSha1, certPadre, cert.SerialNumber)
'============
Return certID.Equals(certIDResp)
Catch ex As Exception
Throw New Exception("Comprobando correspondencia del certificado con la respuesta OCSP." & vbCrLf & ex.Message, ex)
End Try
End Function
#End Region
End Class