From afb7175a37aa63f675454671a8294a815b6affb9 Mon Sep 17 00:00:00 2001 From: manuel Date: Thu, 31 Jul 2025 09:30:48 +0200 Subject: [PATCH] =?UTF-8?q?=20=20=20-=202025-07-29=201.1.0=20Se=20a=C3=B1a?= =?UTF-8?q?de=20UtilsCert=20para=20manejo=20de=20certificados=20=20=20=20-?= =?UTF-8?q?=202025-07-29=201.1.0=20Se=20elimina=20funci=C3=B3n=20Descompon?= =?UTF-8?q?erCNsuscriptor=20de=20la=20clase=20crypt?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- UtilsCert.vb | 2314 +++++++++++++++++++++++++++++++++++++++++++ crypt.vb | 66 -- tsUtilidades.vbproj | 4 +- 3 files changed, 2317 insertions(+), 67 deletions(-) create mode 100644 UtilsCert.vb diff --git a/UtilsCert.vb b/UtilsCert.vb new file mode 100644 index 0000000..25d1e8c --- /dev/null +++ b/UtilsCert.vb @@ -0,0 +1,2314 @@ +'--------------------------------------------------------------------------- +' 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 = " (CodRev=)" o "Causa no disponible (CodRev=-1)" + + Indeterminado = 2 ' MsjEstadoRevoc = "" + + 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 = "", " ", vbCrLf & Indent(MsjEstadoRevoc, 8)) & vbCrLf + End If + End If + + res &= " Información de revocación válida desde: " & If(ThisUpdateUTC = Nothing, "", DateToString(ThisUpdateUTC.ToLocalTime())) & vbCrLf & _ + " Información de revocación válida hasta: " & If(NextUpdateUTC = Nothing, "", DateToString(NextUpdateUTC.ToLocalTime())) & vbCrLf & _ + " Respuesta OCSP efectiva: " & If(RespuestaEfectiva, "Sí", "No") & vbCrLf & _ + " URL del servidor OCSP: " & UrlResponder & vbCrLf + + If ResponderBin Is Nothing Then + res &= " Certificado 'Responder': " + 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, "", 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, "", _ + 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, "Sí", "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 = "" + 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 "" + + 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 & "" + + If a.Rank <> 1 Then Throw New Exception("ArrayToString: Array NO unidimensional.") + + If a.Length = 0 Then Return globalIndent & "" + + '------ + + ' 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 = "" + 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 ) = 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 diff --git a/crypt.vb b/crypt.vb index ccef21b..853ad88 100644 --- a/crypt.vb +++ b/crypt.vb @@ -564,71 +564,5 @@ Public Class crypt Return Encoding.UTF8.GetString(ms.ToArray()) End Function - Public Shared Function DescomponerCNsuscriptor(CNsuscriptor As String, - Optional ByRef nombre As String = Nothing, - Optional ByRef docIdentidad As String = Nothing, - Optional ByRef numPersonal As String = Nothing) As Boolean - - nombre = CNsuscriptor - docIdentidad = Nothing - numPersonal = Nothing - - If String.Compare(CNsuscriptor, "", False) = 0 Then - Return False - End If - - Dim text As String = Nothing - Dim text2 As String = Nothing - Dim array() As String = Regex.Split(CNsuscriptor, " DI=") - - If array.Length > 2 Then - Return False - End If - - Dim text3 As String - - If array.Length = 2 Then - text3 = array(0) - array = Regex.Split(array(1), " N=") - - If array.Length > 2 Then - Return False - End If - - text = array(0) - If array.Length = 2 Then - text2 = array(1) - End If - Else - array = Regex.Split(CNsuscriptor, " N=") - - If array.Length > 2 Then - Return False - End If - - text3 = array(0) - If array.Length = 2 Then - text2 = array(1) - End If - End If - - If String.IsNullOrWhiteSpace(text3) OrElse text3.Contains("=") Then - Return False - End If - - If text IsNot Nothing AndAlso (String.IsNullOrWhiteSpace(text.Trim()) OrElse text.Contains("=")) Then - Return False - End If - - If text2 IsNot Nothing AndAlso (String.IsNullOrWhiteSpace(text2.Trim()) OrElse text2.Contains("=")) Then - Return False - End If - - nombre = text3 - docIdentidad = text - numPersonal = text2 - Return True - End Function - End Class \ No newline at end of file diff --git a/tsUtilidades.vbproj b/tsUtilidades.vbproj index 06bbf15..9c4b233 100644 --- a/tsUtilidades.vbproj +++ b/tsUtilidades.vbproj @@ -16,11 +16,13 @@ net8.0 tsUtilidades net8.0, libreria - 1.0.11 + 1.1.0 Manuel Tecnosis S.A Utilidades Varias + - 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-28 1.0.11 Se modifica funcion SHA256 para que no use métodos obsoletos y para que admita un encoding diferente a unicode - 2025-07-28 1.0.10 Nueva función DescomponerCNsuscriptor - 2025-07-28 1.0.9 Correccion ObtenerValorDesdeNombre