Add Certificate.fold_decode_pem_multiple (#169)

lib/certificate.ml

@@ -146,6 +146,18 @@ let decode_pem_multiple cs =
   in
   Pem.foldM (fun (_, cs) -> decode_der cs) certs
 
+let fold_decode_pem_multiple fn acc cs =
+  List.fold_left
+    (fun acc data ->
+      let data = match data with
+        | Ok ("CERTIFICATE", cs) -> decode_der cs
+        | Ok _ -> Error (`Msg "ignore non certificate")
+        | Error e -> Error e
+      in
+      fn acc data)
+    acc
+    (Pem.parse_with_errors cs)
+
 let decode_pem cs =
   let* certs = decode_pem_multiple cs in
   Pem.exactly_one ~what:"certificate" certs

lib/pem.ml

@@ -54,24 +54,27 @@ module Cs = struct
       | `Data cs :: tail -> accumulate t (cs :: acc) tail
       | `End t' :: tail ->
         if String.equal t t' then
-          Ok (concat "" (List.rev acc), tail)
+          let data = match Base64.decode (concat "" (List.rev acc)) with
+            | Ok data -> Ok (t, data)
+            | Error e -> Error e
+          in
+          data, tail
         else
-          Error (`Msg ("invalid end, expected " ^ t ^ ", found " ^ t'))
-      | _ :: _ -> Error (`Msg "invalid line, expected data or end")
-      | [] -> Error (`Msg "end of input")
+          Error (`Msg ("invalid end, expected " ^ t ^ ", found " ^ t')), tail
+      | _ :: tail -> Error (`Msg "invalid line, expected data or end"), tail
+      | [] -> Error (`Msg "end of input"), []
     in
 
     let rec block acc = function
       | `Begin t :: tail ->
-        let* body, tail = accumulate t [] tail in
-        let* data = Base64.decode body in
-        block ((t, data) :: acc) tail
+        let body, tail = accumulate t [] tail in
+        block (body :: acc) tail
       | _::xs -> block acc xs
-      | []    -> Ok (List.rev acc)
+      | [] -> List.rev acc
     in
     block [] ilines
 
-  let parse data= combine (lines data)
+  let parse_with_errors data = combine (lines data)
 
   let unparse ~tag value =
     let rec split_at_64 acc = function
@@ -91,7 +94,17 @@ module Cs = struct
     concat "" (first @ lines @ last)
 end
 
-let parse, unparse = Cs.(parse, unparse)
+let parse_with_errors, unparse = Cs.(parse_with_errors, unparse)
+
+let parse data =
+  let entries, errors =
+    List.partition_map
+      (function Ok v -> Either.Left v | Error e -> Either.Right e)
+      (parse_with_errors data)
+  in
+  match errors with
+  | [] -> Ok entries
+  | first_error :: _ -> Error first_error
 
 let exactly_one ~what = function
   | []  -> Error (`Msg ("No " ^ what))

lib/x509.mli

@@ -504,6 +504,11 @@ module Certificate : sig
        are extracted *)
   val decode_pem_multiple : string -> (t list, [> `Msg of string ]) result
 
+  (** [fold_decode_pem_multiple fn acc pem] is a fold of the function [fn],
+      with the initial accumulator [acc], over the certificates extracted
+      (and potential parsing errors) from the [pem]. *)
+  val fold_decode_pem_multiple : ('a -> (t, [> `Msg of string ]) result -> 'a) -> 'a -> string -> 'a
+
   (** [decode_pem pem] is [t], where the single certificate of the
       [pem] is extracted *)
   val decode_pem : string -> (t, [> `Msg of string ]) result