unikernel/duniverse/ocaml-x509/lib/asn_grammars.ml

@@ -0,0 +1,74 @@
+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)