From becb9c6a891b55a76e6e90675064874d4a970c44 Mon Sep 17 00:00:00 2001 From: Vadim Radovel Date: Thu, 29 Apr 2021 20:58:37 +0300 Subject: [PATCH 1/3] Implement OCSP Request Asn. --- lib/ocsp.ml | 208 ++++++++++++++++++++++++++++++++++++++++++++++++ lib/registry.ml | 9 +++ lib/x509.ml | 2 + lib/x509.mli | 52 ++++++++++++ 4 files changed, 271 insertions(+) create mode 100644 lib/ocsp.ml diff --git a/lib/ocsp.ml b/lib/ocsp.ml new file mode 100644 index 00000000..8c47e101 --- /dev/null +++ b/lib/ocsp.ml @@ -0,0 +1,208 @@ +(* https://tools.ietf.org/html/rfc6960 *) + + +module Request = struct + (* + CertID ::= SEQUENCE { + hashAlgorithm AlgorithmIdentifier, + issuerNameHash OCTET STRING, -- Hash of issuer's DN + issuerKeyHash OCTET STRING, -- Hash of issuer's public key + serialNumber CertificateSerialNumber } + *) + type cert_id = { + hashAlgorithm: Algorithm.t; + issuerNameHash: Cstruct.t; + issuerKeyHash: Cstruct.t; + serialNumber: Z.t; + } + + let pp_cert_id ppf {hashAlgorithm;issuerNameHash;issuerKeyHash;serialNumber} = + Fmt.pf ppf "CertID @[<1>{@ algo=%a;@ issuerNameHash=%a;@ issuerKeyHash=%a;@ serialNumber=%a@ }@]" + Algorithm.pp hashAlgorithm + Cstruct.hexdump_pp issuerNameHash + Cstruct.hexdump_pp issuerKeyHash + Z.pp_print serialNumber + + (* + Request ::= SEQUENCE { + reqCert CertID, + singleRequestExtensions [0] EXPLICIT Extensions OPTIONAL } + *) + type request = { + reqCert: cert_id; + singleRequestExtensions: Extension.t option; + } + + let pp_request ppf {reqCert;singleRequestExtensions;} = + Fmt.pf ppf "Request @[<1>{@ reqCert=%a;@ singleRequestExtensions=%a;@ }@]" + pp_cert_id reqCert + (Fmt.option ~none:(Fmt.any "None") Extension.pp) singleRequestExtensions + + (* + TBSRequest ::= SEQUENCE { + version [0] EXPLICIT Version DEFAULT v1, + requestorName [1] EXPLICIT GeneralName OPTIONAL, + requestList SEQUENCE OF Request, + requestExtensions [2] EXPLICIT Extensions OPTIONAL } + + *) + type tbs_request = { + version: int; + requestorName: General_name.b option; + requestList: request list; + requestExtensions: Extension.t option; + } + + let pp_tbs_request ppf {version;requestorName;requestList;requestExtensions;} = + let pp_general_name ppf x = + let open General_name in + match x with + | B (k, v) -> + General_name.pp_k k ppf v + in + Fmt.pf ppf "TBSRequest @[<1>{@ version=%d;@ requestorName=%a;@ requestList=[@ %a@ ];@ requestExtensions=%a@ }@]" + version + (Fmt.option ~none:(Fmt.any "None") pp_general_name) requestorName + (Fmt.list ~sep:Fmt.semi pp_request) requestList + (Fmt.option ~none:(Fmt.any "None") Extension.pp) requestExtensions + + let version_v1 = 0 + + (* + Signature ::= SEQUENCE { + signatureAlgorithm AlgorithmIdentifier, + signature BIT STRING, + certs [0] EXPLICIT SEQUENCE OF Certificate + OPTIONAL} + *) + type signature = { + signatureAlgorithm: Algorithm.t; + signature: Cstruct.t; + certs: Certificate.t list option; + } + + let pp_signature ppf {signatureAlgorithm;signature;certs;} = + Fmt.pf ppf "Signature @[<1>{@ signatureAlgorithm=%a;@ signature=%a;@ certs=%a}@]" + Algorithm.pp signatureAlgorithm + Cstruct.hexdump_pp signature + (Fmt.option ~none:(Fmt.any "None") @@ + Fmt.brackets @@ + Fmt.list ~sep:Fmt.semi Certificate.pp) certs + + (* + OCSPRequest ::= SEQUENCE { + tbsRequest TBSRequest, + optionalSignature [0] EXPLICIT Signature OPTIONAL } + *) + type t = { + tbsRequest: tbs_request; + optionalSignature: signature option; + } + + let pp ppf {tbsRequest;optionalSignature} = + Fmt.pf ppf "OCSPRequest @[<1>{@ tbsRequest=%a;@ optionalSignature=%a@ }@]" + pp_tbs_request tbsRequest + (Fmt.option ~none:(Fmt.any "None") pp_signature) optionalSignature + + module Asn_ = Asn + + module Asn = struct + open Asn_grammars + open Asn.S + (* open Registry *) + + let cert_id = + let f (hashAlgorithm, issuerNameHash, issuerKeyHash, serialNumber) = + {hashAlgorithm; + issuerNameHash; + issuerKeyHash; + serialNumber;} + in + let g {hashAlgorithm;issuerNameHash;issuerKeyHash;serialNumber;} = + (hashAlgorithm, issuerNameHash, issuerKeyHash, serialNumber) + in + map f g @@ + sequence4 + (required ~label:"hashAlgorithm" Algorithm.identifier) + (required ~label:"issuerNameHash" octet_string) + (required ~label:"issuerKeyHash" octet_string) + (required ~label:"serialNumber" integer) + + let request = + let f (reqCert, singleRequestExtensions) = + {reqCert; singleRequestExtensions} + in + let g {reqCert; singleRequestExtensions} = + (reqCert, singleRequestExtensions) + in + map f g @@ + sequence2 + (required ~label:"reqCert" cert_id) + (optional ~label:"singleRequestExtensions" @@ + explicit 0 Extension.Asn.extensions_der) + + let tbs_request = + let f (version,requestorName,requestList,requestExtensions) = + let version = match version with + | Some v -> v + | None -> version_v1 + in + {version;requestorName;requestList;requestExtensions;} + in + let g {version;requestorName;requestList;requestExtensions;} = + let version = Some version in + (version,requestorName,requestList,requestExtensions) + in + map f g @@ + sequence4 + (optional ~label:"version" @@ explicit 0 int) + (optional ~label:"requestorName" @@ + explicit 1 General_name.Asn.general_name) + (required ~label:"requestList" @@ sequence_of request) + (optional ~label:"requestExtensions" @@ Extension.Asn.extensions_der) + + let signature = + let f (signatureAlgorithm,signature,certs) = + let certs = match certs with + | None -> None + | Some certs -> + let encode cert = + let raw = Certificate.Asn.certificate_to_cstruct cert in + Certificate.{raw; asn=cert} + in + Some (List.map encode certs) + in + {signatureAlgorithm;signature;certs} + in + let g {signatureAlgorithm;signature;certs} = + let certs = match certs with + | None -> None + | Some certs -> + Some (List.map (fun Certificate.{asn;_} -> asn) certs) + in + (signatureAlgorithm,signature,certs) + in + map f g @@ + sequence3 + (required ~label:"signatureAlgorithm" Algorithm.identifier) + (required ~label:"signature" bit_string_cs) + (optional ~label:"certs" @@ sequence_of Certificate.Asn.certificate) + + let ocsp_request = + let f (tbsRequest,optionalSignature) = + {tbsRequest;optionalSignature;} + in + let g {tbsRequest;optionalSignature;} = + (tbsRequest,optionalSignature) + in + map f g @@ + sequence2 + (required ~label:"tbsRequest" tbs_request) + (optional ~label:"optionalSignature" signature) + + let (ocsp_request_of_cstruct, ocsp_request_to_cstruct) = + projections_of Asn.der ocsp_request + + end + +end diff --git a/lib/registry.ml b/lib/registry.ml index 7e57f053..11548b9c 100644 --- a/lib/registry.ml +++ b/lib/registry.ml @@ -255,6 +255,15 @@ module Cert_extn = struct and freshest_crl = ce <| 46 and inhibit_any_policy = ce <| 54 + (* https://tools.ietf.org/html/rfc5280#section-4.2.2.1 *) + module Private_internet_extensions = struct + let pe = pkix <| 1 + let authority_info_access = pe <| 1 + let ad = pkix <| 48 + let ad_ca_issuer = ad <| 2 + and ad_ocsp = ad <| 1 + end + module Extended_usage = struct let any = extended_key_usage <| 0 let key_purpose = pkix <| 3 diff --git a/lib/x509.ml b/lib/x509.ml index 55d2790f..a97d2297 100644 --- a/lib/x509.ml +++ b/lib/x509.ml @@ -21,3 +21,5 @@ module CRL = Crl module Authenticator = Authenticator module PKCS12 = P12 + +module OCSP = Ocsp diff --git a/lib/x509.mli b/lib/x509.mli index 0a984fe3..f63b280c 100644 --- a/lib/x509.mli +++ b/lib/x509.mli @@ -945,3 +945,55 @@ module PKCS12 : sig ?iterations:int -> ?salt:Cstruct.t -> password:string -> content_info list -> t end + + +module OCSP : sig + module Request : sig + type cert_id = { + hashAlgorithm : Algorithm.t; + issuerNameHash : Cstruct.t; + issuerKeyHash : Cstruct.t; + serialNumber : Z.t; + } + val pp_cert_id : Format.formatter -> cert_id -> unit + + type request = { + reqCert : cert_id; + singleRequestExtensions : Extension.t option; + } + val pp_request : Format.formatter -> request -> unit + + type tbs_request = { + version : int; + requestorName : General_name.b option; + requestList : request list; + requestExtensions : Extension.t option; + } + val pp_tbs_request : Format.formatter -> tbs_request -> unit + + val version_v1 : int + + type signature = { + signatureAlgorithm : Algorithm.t; + signature : Cstruct.t; + certs : Certificate.t list option; + } + val pp_signature : Format.formatter -> signature -> unit + + type t = { + tbsRequest : tbs_request; + optionalSignature : signature option; + } + val pp : Format.formatter -> t -> unit + + module Asn : sig + val cert_id : cert_id Asn.t + val request : request Asn.t + val tbs_request : tbs_request Asn.t + val signature : signature Asn.t + val ocsp_request : t Asn.t + val ocsp_request_of_cstruct : Cstruct.t -> (t, Asn.error) result + val ocsp_request_to_cstruct : t -> Cstruct.t + end + end +end From 4e4516d8351bd35a94c81a4e0f76571bd40e11d7 Mon Sep 17 00:00:00 2001 From: Vadim Radovel Date: Tue, 11 May 2021 17:04:17 +0300 Subject: [PATCH 2/3] Declare OCSP Response --- lib/extension.ml | 30 ++++ lib/ocsp.ml | 426 ++++++++++++++++++++++++++++++++++++++++++----- lib/registry.ml | 3 +- lib/x509.mli | 125 ++++++++++++-- 4 files changed, 529 insertions(+), 55 deletions(-) diff --git a/lib/extension.ml b/lib/extension.ml index 489c812c..37454dfc 100644 --- a/lib/extension.ml +++ b/lib/extension.ml @@ -103,6 +103,33 @@ type reason = [ | `AA_compromise ] +let reason_to_int = function + | `Unspecified -> 0 + | `Key_compromise -> 1 + | `CA_compromise -> 2 + | `Affiliation_changed -> 3 + | `Superseded -> 4 + | `Cessation_of_operation -> 5 + | `Certificate_hold -> 6 + (* 7 is not used *) + | `Remove_from_CRL -> 8 + | `Privilege_withdrawn -> 9 + | `AA_compromise -> 10 + +let reason_of_int = function + | 0 -> `Unspecified + | 1 -> `Key_compromise + | 2 -> `CA_compromise + | 3 -> `Affiliation_changed + | 4 -> `Superseded + | 5 -> `Cessation_of_operation + | 6 -> `Certificate_hold + (* 7 is not used *) + | 8 -> `Remove_from_CRL + | 9 -> `Privilege_withdrawn + | 10 -> `AA_compromise + | x -> Asn.S.parse_error "Unknown reason %d" x + let pp_reason ppf r = Fmt.string ppf (match r with | `Unspecified -> "unspecified" @@ -466,6 +493,9 @@ module Asn = struct ; 8, `AA_compromise ] + let reason_enumerated : reason Asn.t = + enumerated reason_of_int reason_to_int + let distribution_point_name = map (function | `C1 s -> `Full s | `C2 s -> `Relative s) (function | `Full s -> `C1 s | `Relative s -> `C2 s) diff --git a/lib/ocsp.ml b/lib/ocsp.ml index 8c47e101..16f894fd 100644 --- a/lib/ocsp.ml +++ b/lib/ocsp.ml @@ -1,28 +1,53 @@ (* https://tools.ietf.org/html/rfc6960 *) +let version_v1 = 0 + +(* + CertID ::= SEQUENCE { + hashAlgorithm AlgorithmIdentifier, + issuerNameHash OCTET STRING, -- Hash of issuer's DN + issuerKeyHash OCTET STRING, -- Hash of issuer's public key + serialNumber CertificateSerialNumber } +*) +type cert_id = { + hashAlgorithm: Algorithm.t; + issuerNameHash: Cstruct.t; + issuerKeyHash: Cstruct.t; + serialNumber: Z.t; +} + +let pp_cert_id ppf {hashAlgorithm;issuerNameHash;issuerKeyHash;serialNumber} = + Fmt.pf ppf "CertID @[<1>{@ algo=%a;@ issuerNameHash=%a;@ issuerKeyHash=%a;@ serialNumber=%a@ }@]" + Algorithm.pp hashAlgorithm + Cstruct.hexdump_pp issuerNameHash + Cstruct.hexdump_pp issuerKeyHash + Z.pp_print serialNumber + +module Asn_common = struct + (* open Asn_grammars *) + open Asn.S + + let cert_id = + let f (hashAlgorithm, issuerNameHash, issuerKeyHash, serialNumber) = + {hashAlgorithm; + issuerNameHash; + issuerKeyHash; + serialNumber;} + in + let g {hashAlgorithm;issuerNameHash;issuerKeyHash;serialNumber;} = + (hashAlgorithm, issuerNameHash, issuerKeyHash, serialNumber) + in + map f g @@ + sequence4 + (required ~label:"hashAlgorithm" Algorithm.identifier) + (required ~label:"issuerNameHash" octet_string) + (required ~label:"issuerKeyHash" octet_string) + (required ~label:"serialNumber" integer) +end -module Request = struct - (* - CertID ::= SEQUENCE { - hashAlgorithm AlgorithmIdentifier, - issuerNameHash OCTET STRING, -- Hash of issuer's DN - issuerKeyHash OCTET STRING, -- Hash of issuer's public key - serialNumber CertificateSerialNumber } - *) - type cert_id = { - hashAlgorithm: Algorithm.t; - issuerNameHash: Cstruct.t; - issuerKeyHash: Cstruct.t; - serialNumber: Z.t; - } - let pp_cert_id ppf {hashAlgorithm;issuerNameHash;issuerKeyHash;serialNumber} = - Fmt.pf ppf "CertID @[<1>{@ algo=%a;@ issuerNameHash=%a;@ issuerKeyHash=%a;@ serialNumber=%a@ }@]" - Algorithm.pp hashAlgorithm - Cstruct.hexdump_pp issuerNameHash - Cstruct.hexdump_pp issuerKeyHash - Z.pp_print serialNumber +module Request = struct (* Request ::= SEQUENCE { reqCert CertID, @@ -66,8 +91,6 @@ module Request = struct (Fmt.list ~sep:Fmt.semi pp_request) requestList (Fmt.option ~none:(Fmt.any "None") Extension.pp) requestExtensions - let version_v1 = 0 - (* Signature ::= SEQUENCE { signatureAlgorithm AlgorithmIdentifier, @@ -111,23 +134,6 @@ module Request = struct open Asn.S (* open Registry *) - let cert_id = - let f (hashAlgorithm, issuerNameHash, issuerKeyHash, serialNumber) = - {hashAlgorithm; - issuerNameHash; - issuerKeyHash; - serialNumber;} - in - let g {hashAlgorithm;issuerNameHash;issuerKeyHash;serialNumber;} = - (hashAlgorithm, issuerNameHash, issuerKeyHash, serialNumber) - in - map f g @@ - sequence4 - (required ~label:"hashAlgorithm" Algorithm.identifier) - (required ~label:"issuerNameHash" octet_string) - (required ~label:"issuerKeyHash" octet_string) - (required ~label:"serialNumber" integer) - let request = let f (reqCert, singleRequestExtensions) = {reqCert; singleRequestExtensions} @@ -137,7 +143,7 @@ module Request = struct in map f g @@ sequence2 - (required ~label:"reqCert" cert_id) + (required ~label:"reqCert" Asn_common.cert_id) (optional ~label:"singleRequestExtensions" @@ explicit 0 Extension.Asn.extensions_der) @@ -206,3 +212,343 @@ module Request = struct end end + + +module Response = struct + + (* OCSPResponseStatus ::= ENUMERATED { + * successful (0), -- Response has valid confirmations + * malformedRequest (1), -- Illegal confirmation request + * internalError (2), -- Internal error in issuer + * tryLater (3), -- Try again later + * -- (4) is not used + * sigRequired (5), -- Must sign the request + * unauthorized (6) -- Request unauthorized + * } *) + type status = [ + | `Successful + | `MalformedRequest + | `InternalError + | `TryLater + | `SigRequired + | `Unauthorized + ] + + let status_to_int = function + | `Successful -> 0 + | `MalformedRequest -> 1 + | `InternalError -> 2 + | `TryLater -> 3 + | `SigRequired -> 5 + | `Unauthorized -> 6 + + let status_of_int = function + | 0 -> `Successful + | 1 -> `MalformedRequest + | 2 -> `InternalError + | 3 -> `TryLater + | 5 -> `SigRequired + | 6 -> `Unauthorized + | x -> Asn.S.parse_error "Unknown status %d" x + + + let pp_status ppf = function + | `Successful -> Fmt.string ppf "Successful" + | `MalformedRequest -> Fmt.string ppf "MalformedRequest" + | `InternalError -> Fmt.string ppf "InternalError" + | `TryLater -> Fmt.string ppf "TryLater" + | `SigRequired -> Fmt.string ppf "SigRequired" + | `Unauthorized -> Fmt.string ppf "Unauthorized" + + (* ResponseBytes ::= SEQUENCE { + * responseType OBJECT IDENTIFIER, + * response OCTET STRING } *) + + (* OCSPResponse ::= SEQUENCE { + * responseStatus OCSPResponseStatus, + * responseBytes [0] EXPLICIT ResponseBytes OPTIONAL } *) + + type t = { + responseStatus: status; + responseBytes: (Asn.oid * Cstruct.t) option; + } + + let pp ppf {responseStatus;responseBytes;} = + Fmt.pf ppf "OCSPResponse @[<1>{@ responseStatus=%a;@ responseBytes=%a@ }@]" + pp_status responseStatus + (Fmt.option ~none:(Fmt.any "None") @@ + Fmt.pair ~sep:Fmt.comma Asn.OID.pp Cstruct.hexdump_pp) + responseBytes + + (* RevokedInfo ::= SEQUENCE { + * revocationTime GeneralizedTime, + * revocationReason [0] EXPLICIT CRLReason OPTIONAL } *) + type revoked_info = { + revocationTime: Ptime.t; + revocationReason: Extension.reason option; + } + + let pp_revoked_info ppf {revocationTime;revocationReason;} = + Fmt.pf ppf "RevokedInfo @[<1>{@ revocationTime=%a;@ revocationReason=%a;@ }@]" + Ptime.pp revocationTime + (Fmt.option ~none:(Fmt.any "None") @@ Extension.pp_reason) + revocationReason + + (* CertStatus ::= CHOICE { + * good [0] IMPLICIT NULL, + * revoked [1] IMPLICIT RevokedInfo, + * unknown [2] IMPLICIT UnknownInfo } *) + + type cert_status = [ + | `Good + | `Revoked of revoked_info + | `Unknown + ] + + let pp_cert_status ppf = function + | `Good -> Fmt.pf ppf "Good" + | `Revoked info -> Fmt.pf ppf "Revoked of %a" pp_revoked_info info + | `Unknown -> Fmt.pf ppf "Unknown" + + (* SingleResponse ::= SEQUENCE { + * certID CertID, + * certStatus CertStatus, + * thisUpdate GeneralizedTime, + * nextUpdate [0] EXPLICIT GeneralizedTime OPTIONAL, + * singleExtensions [1] EXPLICIT Extensions OPTIONAL } *) + + type single_response = { + certID: cert_id; + certStatus: cert_status; + thisUpdate: Ptime.t; + nextUpdate: Ptime.t option; + singleExtensions: Extension.t option; + } + + let pp_single_response ppf {certID;certStatus;thisUpdate;nextUpdate;singleExtensions;} = + Fmt.pf ppf "SingleResponse @[<1>{@ certID=%a;@ certStatus=%a;@ thisUpdate=%a;@ nextUpdate=%a;@ singleExtensions=%a;@ }@]" + pp_cert_id certID + pp_cert_status certStatus + Ptime.pp thisUpdate + (Fmt.option ~none:(Fmt.any "None") @@ Ptime.pp) nextUpdate + (Fmt.option ~none:(Fmt.any "None") @@ Extension.pp) singleExtensions + + + (* ResponderID ::= CHOICE { + * byName [1] Name, + * byKey [2] KeyHash } + * KeyHash ::= OCTET STRING -- SHA-1 hash of responder's public key + (excluding the tag and length fields) + *) + type responder_id = [ + | `ByName of Distinguished_name.t + | `ByKey of Cstruct.t + ] + + let pp_responder_id ppf = function + | `ByName dn -> Fmt.pf ppf "ByName %a" Distinguished_name.pp dn + | `ByKey hash -> Fmt.pf ppf "ByKey %a" Cstruct.hexdump_pp hash + + (* ResponseData ::= SEQUENCE { + * version [0] EXPLICIT Version DEFAULT v1, + * responderID ResponderID, + * producedAt GeneralizedTime, + * responses SEQUENCE OF SingleResponse, + * responseExtensions [1] EXPLICIT Extensions OPTIONAL } *) + type response_data = { + version: int; + responderID: responder_id; + producedAt: Ptime.t; + responses: single_response list; + responseExtensions: Extension.t option; + } + + let pp_response_data ppf {version;responderID;producedAt;responses;responseExtensions;} = + Fmt.pf ppf "ResponseData @[<1>{@ version=%d;@ responderID=%a;@ producedAt=%a;@ responses=%a;@ responseExtensions=%a@ }@]" + version + pp_responder_id responderID + Ptime.pp producedAt + (Fmt.list ~sep:Fmt.semi @@ pp_single_response) responses + (Fmt.option ~none:(Fmt.any "None") @@ Extension.pp) responseExtensions + + (* BasicOCSPResponse ::= SEQUENCE { + * tbsResponseData ResponseData, + * signatureAlgorithm AlgorithmIdentifier, + * signature BIT STRING, + * certs [0] EXPLICIT SEQUENCE OF Certificate OPTIONAL } *) + type basic_ocsp_response = { + tbsResponseData: response_data; + signatureAlgorithm: Algorithm.t; + signature: Cstruct.t; + certs: Certificate.t list option; + } + + let pp_basic_ocsp_response ppf {tbsResponseData;signatureAlgorithm;signature;certs;} = + Fmt.pf ppf "BasicOCSPResponse @[<1>{@ tbsResponseData=%a;@ signatureAlgorithm=%a;@ signature=%a;@ certs=%a@ }@]" + pp_response_data tbsResponseData + Algorithm.pp signatureAlgorithm + Cstruct.hexdump_pp signature + (Fmt.option ~none:(Fmt.any "None") @@ + Fmt.list ~sep:Fmt.semi @@ Certificate.pp) certs + + + module Asn = struct + open Asn_grammars + open Asn.S + (* open Registry *) + + let status : status Asn.t = + enumerated status_of_int status_to_int + + let ocsp_response = + let f (responseStatus,responseBytes) = + {responseStatus;responseBytes} + in + let g {responseStatus;responseBytes} = + (responseStatus,responseBytes) + in + map f g @@ + sequence2 + (required ~label:"responseStatus" status) + (optional ~label:"responseBytes" @@ explicit 0 @@ + sequence2 + (required ~label:"responseType" oid) + (required ~label:"response" octet_string)) + + let ocsp_response_of_cs, ocsp_response_to_cs = + projections_of Asn.der ocsp_response + + let revoked_info = + let f (revocationTime,revocationReason) = + {revocationTime;revocationReason} + in + let g {revocationTime;revocationReason} = + (revocationTime,revocationReason) + in + map f g @@ + sequence2 + (required ~label:"revocationTime" generalized_time_no_frac_s) + (optional ~label:"revocationReason" @@ explicit 0 @@ Extension.Asn.reason_enumerated) + + let cert_status : cert_status Asn.t = + let f = function + | `C1 () -> `Good + | `C2 ri -> `Revoked ri + | `C3 () -> `Unknown + in + let g = function + | `Good -> `C1 () + | `Revoked ri -> `C2 ri + | `Unknown -> `C3 () + in + map f g @@ + choice3 + (implicit 0 @@ null) + (implicit 1 @@ revoked_info) + (implicit 2 @@ null) + + let single_response = + let f (certID,certStatus,thisUpdate,nextUpdate,singleExtensions) = + {certID;certStatus;thisUpdate;nextUpdate;singleExtensions;} + in + let g {certID;certStatus;thisUpdate;nextUpdate;singleExtensions;} = + (certID,certStatus,thisUpdate,nextUpdate,singleExtensions) + in + map f g @@ + sequence5 + (required ~label:"certID" @@ Asn_common.cert_id) + (required ~label:"certStatus" @@ cert_status) + (required ~label:"thisUpdate" @@ generalized_time_no_frac_s) + (optional ~label:"nextUpdate" @@ explicit 0 @@ generalized_time_no_frac_s) + (optional ~label:"singleExtensions" @@ explicit 1 @@ + Extension.Asn.extensions_der) + + let responder_id : responder_id Asn.t = + let f = function + | `C1 dn -> `ByName dn + | `C2 hash -> `ByKey hash + in + let g = function + | `ByName dn -> `C1 dn + | `ByKey hash -> `C2 hash + in + map f g @@ + choice2 Distinguished_name.Asn.name octet_string + + let response_data = + let f (version,responderID,producedAt,responses,responseExtensions) = + let version = match version with + | Some v -> v + | None -> version_v1 + in + {version;responderID;producedAt;responses;responseExtensions;} + in + let g {version;responderID;producedAt;responses;responseExtensions;} = + let version = Some version in + (version,responderID,producedAt,responses,responseExtensions) + in + map f g @@ + sequence5 + (optional ~label:"version" @@ explicit 0 @@ int) + (required ~label:"responderID" responder_id) + (required ~label:"producedAt" generalized_time_no_frac_s) + (required ~label:"responses" @@ sequence_of single_response) + (optional ~label:"responseExtensions" @@ explicit 1 @@ + Extension.Asn.extensions_der) + + let response_data_of_cs,response_data_to_cs = + projections_of Asn.der response_data + + let basic_ocsp_response = + let f (tbsResponseData,signatureAlgorithm,signature,certs) = + let certs = match certs with + | None -> None + | Some certs -> + let encode cert = + let raw = Certificate.Asn.certificate_to_cstruct cert in + Certificate.{raw; asn=cert} + in + Some (List.map encode certs) + in + {tbsResponseData;signatureAlgorithm;signature;certs} + in + let g {tbsResponseData;signatureAlgorithm;signature;certs} = + let certs = match certs with + | None -> None + | Some certs -> + Some (List.map (fun Certificate.{asn;_} -> asn) certs) + in + (tbsResponseData,signatureAlgorithm,signature,certs) + in + map f g @@ + sequence4 + (required ~label:"tbsResponseData" response_data) + (required ~label:"signatureAlgorithm" Algorithm.identifier) + (required ~label:"signature" bit_string_cs) + (optional ~label:"certs" @@ sequence_of Certificate.Asn.certificate) + + let basic_ocsp_response_of_cs,basic_ocsp_response_to_cs = + projections_of Asn.der basic_ocsp_response + + end + + let make_basic_ocsp_response ?(digest=`SHA256) ?certs ~private_key tbsResponseData = + let signatureAlgorithm = Algorithm.of_signature_algorithm + (Private_key.keytype private_key) + digest + in + let response_data_der = Asn.response_data_to_cs tbsResponseData in + let signature = match private_key with + | `RSA priv -> + Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:digest ~key:priv + (`Message response_data_der) + in + {tbsResponseData;signatureAlgorithm;signature;certs;} + + let make_ocsp_response_success basic_ocsp_response = + let oid = Registry.Cert_extn.Private_internet_extensions.ad_ocsp_basic in + let response = Asn.basic_ocsp_response_to_cs basic_ocsp_response in + {responseStatus=`Successful; + responseBytes=Some (oid, response);} + +end diff --git a/lib/registry.ml b/lib/registry.ml index 11548b9c..cb1e104f 100644 --- a/lib/registry.ml +++ b/lib/registry.ml @@ -261,7 +261,8 @@ module Cert_extn = struct let authority_info_access = pe <| 1 let ad = pkix <| 48 let ad_ca_issuer = ad <| 2 - and ad_ocsp = ad <| 1 + let ad_ocsp = ad <| 1 + let ad_ocsp_basic = ad_ocsp <| 1 end module Extended_usage = struct diff --git a/lib/x509.mli b/lib/x509.mli index f63b280c..192681f7 100644 --- a/lib/x509.mli +++ b/lib/x509.mli @@ -948,20 +948,27 @@ end module OCSP : sig + val version_v1 : int + + type cert_id = { + hashAlgorithm : Algorithm.t; + issuerNameHash : Cstruct.t; + issuerKeyHash : Cstruct.t; + serialNumber : Z.t; + } + val pp_cert_id : cert_id Fmt.t + + module Asn_common : sig + val cert_id : cert_id Asn.t + end + module Request : sig - type cert_id = { - hashAlgorithm : Algorithm.t; - issuerNameHash : Cstruct.t; - issuerKeyHash : Cstruct.t; - serialNumber : Z.t; - } - val pp_cert_id : Format.formatter -> cert_id -> unit type request = { reqCert : cert_id; singleRequestExtensions : Extension.t option; } - val pp_request : Format.formatter -> request -> unit + val pp_request : request Fmt.t type tbs_request = { version : int; @@ -969,25 +976,22 @@ module OCSP : sig requestList : request list; requestExtensions : Extension.t option; } - val pp_tbs_request : Format.formatter -> tbs_request -> unit + val pp_tbs_request : tbs_request Fmt.t - val version_v1 : int - type signature = { signatureAlgorithm : Algorithm.t; signature : Cstruct.t; certs : Certificate.t list option; } - val pp_signature : Format.formatter -> signature -> unit + val pp_signature : signature Fmt.t type t = { tbsRequest : tbs_request; optionalSignature : signature option; } - val pp : Format.formatter -> t -> unit + val pp : t Fmt.t module Asn : sig - val cert_id : cert_id Asn.t val request : request Asn.t val tbs_request : tbs_request Asn.t val signature : signature Asn.t @@ -996,4 +1000,97 @@ module OCSP : sig val ocsp_request_to_cstruct : t -> Cstruct.t end end + + module Response : sig + type status = + [ `InternalError + | `MalformedRequest + | `SigRequired + | `Successful + | `TryLater + | `Unauthorized ] + + val status_to_int : status -> int + val status_of_int : int -> status + val pp_status : status Fmt.t + + type revoked_info = { + revocationTime : Ptime.t; + revocationReason : Extension.reason option; + } + + val pp_revoked_info : revoked_info Fmt.t + + type cert_status = [ `Good | `Revoked of revoked_info | `Unknown ] + + val pp_cert_status : cert_status Fmt.t + + type single_response = { + certID : cert_id; + certStatus : cert_status; + thisUpdate : Ptime.t; + nextUpdate : Ptime.t option; + singleExtensions : Extension.t option; + } + + val pp_single_response : single_response Fmt.t + + type responder_id = + [ `ByKey of Cstruct.t | `ByName of Distinguished_name.t ] + + val pp_responder_id : responder_id Fmt.t + + type response_data = { + version : int; + responderID : responder_id; + producedAt : Ptime.t; + responses : single_response list; + responseExtensions : Extension.t option; + } + + val pp_response_data : response_data Fmt.t + + type basic_ocsp_response = { + tbsResponseData : response_data; + signatureAlgorithm : Algorithm.t; + signature : Cstruct.t; + certs : Certificate.t list option; + } + + val pp_basic_ocsp_response : basic_ocsp_response Fmt.t + + val make_basic_ocsp_response : + ?digest:Mirage_crypto.Hash.hash -> + ?certs:Certificate.t list -> + private_key:Private_key.t -> + response_data -> basic_ocsp_response + + type t = { + responseStatus : status; + responseBytes : (Asn.oid * Cstruct.t) option; + } + + val make_ocsp_response_success : basic_ocsp_response -> t + + val pp : t Fmt.t + + + module Asn : + sig + val status : status Asn.t + val ocsp_response : t Asn.t + val ocsp_response_of_cs : Cstruct.t -> (t, Asn.error) Result.result + val ocsp_response_to_cs : t -> Cstruct.t + val revoked_info : revoked_info Asn.t + val cert_status : cert_status Asn.t + val single_response : single_response Asn.t + val responder_id : responder_id Asn.t + val response_data : response_data Asn.t + val response_data_of_cs : Cstruct.t -> (response_data, Asn.error) Result.result + val response_data_to_cs : response_data -> Cstruct.t + val basic_ocsp_response : basic_ocsp_response Asn.t + val basic_ocsp_response_of_cs : Cstruct.t -> (basic_ocsp_response, Asn.error) result + val basic_ocsp_response_to_cs : basic_ocsp_response -> Cstruct.t + end + end end From 82e39b9ee9f76bb3ac1656eded572f57850e6e36 Mon Sep 17 00:00:00 2001 From: Vadim Radovel Date: Tue, 18 May 2021 21:41:30 +0300 Subject: [PATCH 3/3] Fix OCSP asn scheme. --- lib/ocsp.ml | 28 ++++++++++++++++++++-------- lib/x509.mli | 2 ++ 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/lib/ocsp.ml b/lib/ocsp.ml index 16f894fd..47e73411 100644 --- a/lib/ocsp.ml +++ b/lib/ocsp.ml @@ -294,6 +294,10 @@ module Response = struct (Fmt.option ~none:(Fmt.any "None") @@ Extension.pp_reason) revocationReason + let make_revoked_info ?reason revocationTime = + let revocationReason = reason in + {revocationTime;revocationReason} + (* CertStatus ::= CHOICE { * good [0] IMPLICIT NULL, * revoked [1] IMPLICIT RevokedInfo, @@ -465,15 +469,16 @@ module Response = struct let responder_id : responder_id Asn.t = let f = function - | `C1 dn -> `ByName dn - | `C2 hash -> `ByKey hash + | `C1 _ -> Asn.S.parse_error "wtf" + | `C2 dn -> `ByName dn + | `C3 hash -> `ByKey hash in let g = function - | `ByName dn -> `C1 dn - | `ByKey hash -> `C2 hash + | `ByName dn -> `C2 dn + | `ByKey hash -> `C3 hash in map f g @@ - choice2 Distinguished_name.Asn.name octet_string + choice3 int Distinguished_name.Asn.name octet_string let response_data = let f (version,responderID,producedAt,responses,responseExtensions) = @@ -484,13 +489,19 @@ module Response = struct {version;responderID;producedAt;responses;responseExtensions;} in let g {version;responderID;producedAt;responses;responseExtensions;} = - let version = Some version in + let version = + if version = version_v1 then + None + else + Some version + in (version,responderID,producedAt,responses,responseExtensions) in map f g @@ sequence5 (optional ~label:"version" @@ explicit 0 @@ int) - (required ~label:"responderID" responder_id) + (* there must not be [explicit 1], but openssl do so:( *) + (required ~label:"responderID" @@ explicit 1 @@ responder_id) (required ~label:"producedAt" generalized_time_no_frac_s) (required ~label:"responses" @@ sequence_of single_response) (optional ~label:"responseExtensions" @@ explicit 1 @@ @@ -525,7 +536,8 @@ module Response = struct (required ~label:"tbsResponseData" response_data) (required ~label:"signatureAlgorithm" Algorithm.identifier) (required ~label:"signature" bit_string_cs) - (optional ~label:"certs" @@ sequence_of Certificate.Asn.certificate) + (optional ~label:"certs" @@ explicit 0 @@ + sequence_of Certificate.Asn.certificate) let basic_ocsp_response_of_cs,basic_ocsp_response_to_cs = projections_of Asn.der basic_ocsp_response diff --git a/lib/x509.mli b/lib/x509.mli index 192681f7..50990c34 100644 --- a/lib/x509.mli +++ b/lib/x509.mli @@ -1021,6 +1021,8 @@ module OCSP : sig val pp_revoked_info : revoked_info Fmt.t + val make_revoked_info : ?reason:Extension.reason -> Ptime.t -> revoked_info + type cert_status = [ `Good | `Revoked of revoked_info | `Unknown ] val pp_cert_status : cert_status Fmt.t