75 lines
2.4 KiB
OCaml
75 lines
2.4 KiB
OCaml
|
let src = Logs.Src.create "x509.decoding" ~doc:"X509 decoding"
|
||
|
|
module Log = (val Logs.src_log src : Logs.LOG)
|
||
|
|
|
||
|
|
let ( let* ) = Result.bind
|
||
|
|
|
||
|
|
let decode codec cs =
|
||
|
|
let* a, cs = Asn.decode codec cs in
|
||
|
|
if String.length cs = 0 then Ok a else Error (`Parse "Leftover")
|
||
|
|
|
||
|
|
let projections_of encoding asn =
|
||
|
|
let c = Asn.codec encoding asn in (decode c, Asn.encode c)
|
||
|
|
|
||
|
|
module Hashtbl(T : Hashtbl.HashedType) = struct
|
||
|
|
include Hashtbl.Make (T)
|
||
|
|
let of_assoc xs =
|
||
|
|
let ht = create 16 in List.iter (fun (a, b) -> add ht a b) xs; ht
|
||
|
|
end
|
||
|
|
|
||
|
|
module OID_H = Hashtbl (struct
|
||
|
|
type t = Asn.oid let (equal, hash) = Asn.OID.(equal, hash)
|
||
|
|
end)
|
||
|
|
|
||
|
|
let case_of_oid ~default xs =
|
||
|
|
let ht = OID_H.of_assoc xs in fun a ->
|
||
|
|
try OID_H.find ht a with Not_found -> default a
|
||
|
|
|
||
|
|
let case_of_oid_f ~default xs =
|
||
|
|
let ht = OID_H.of_assoc xs in fun (a, b) ->
|
||
|
|
(try OID_H.find ht a with Not_found -> default a) b
|
||
|
|
|
||
|
|
(*
|
||
|
|
* A way to parse by propagating (and contributing to) exceptions, so those can
|
||
|
|
* be handles up in a single place. Meant for parsing embedded structures.
|
||
|
|
*
|
||
|
|
* XXX Would be nicer if combinators could handle embedded structures.
|
||
|
|
*)
|
||
|
|
let project_exn asn =
|
||
|
|
let c = Asn.(codec der) asn in
|
||
|
|
let dec cs = match decode c cs with
|
||
|
|
| Ok a -> a
|
||
|
|
| Error err -> Asn.S.error err in
|
||
|
|
(dec, Asn.encode c)
|
||
|
|
|
||
|
|
let err_to_msg f = Result.map_error (function `Parse msg -> `Msg msg) f
|
||
|
|
|
||
|
|
(* specified in RFC 5280 4.1.2.5.2 - "MUST NOT include fractional seconds" *)
|
||
|
|
let generalized_time_no_frac_s =
|
||
|
|
Asn.S.(map
|
||
|
|
(fun x ->
|
||
|
|
if Ptime.Span.(equal zero (Ptime.frac_s x)) then
|
||
|
|
x
|
||
|
|
else
|
||
|
|
parse_error "generalized time has fractional seconds")
|
||
|
|
(fun y -> Ptime.truncate ~frac_s:0 y)
|
||
|
|
generalized_time)
|
||
|
|
|
||
|
|
(* serial number, as defined in RFC 5280 4.1.2.2: must be > 0 and not be longer
|
||
|
|
than 20 octets. we accept 0.
|
||
|
|
we also accept < 0, but when encoding mandate >= 0!
|
||
|
|
*)
|
||
|
|
let serial =
|
||
|
|
Asn.S.(map
|
||
|
|
(fun x ->
|
||
|
|
if String.length x > 20 then parse_error "serial exceeds 20 octets";
|
||
|
|
if String.length x > 0 && String.get_uint8 x 0 > 0x7F then
|
||
|
|
Log.warn (fun m -> m "negative serial number %a" Ohex.pp x);
|
||
|
|
x)
|
||
|
|
(fun y ->
|
||
|
|
if String.length y > 20 then failwith "serial exceeds 20 octets";
|
||
|
|
if String.length y > 0 && String.get_uint8 y 0 > 0x7F then
|
||
|
|
"\x00" ^ y
|
||
|
|
else
|
||
|
|
y)
|
||
|
|
integer)
|