93 lines
2.2 KiB
OCaml
93 lines
2.2 KiB
OCaml
|
open Rresult
|
||
|
|
open Wire_commands
|
||
|
|
|
||
|
|
let oid = Asn.OID.(base 1 3 <| 6 <| 1 <| 4 <| 1 <| 49836 <| 5171)
|
||
|
|
|
||
|
|
let decode_strict codec cs =
|
||
|
|
match Asn.decode codec cs with
|
||
|
|
| Ok (a, cs) ->
|
||
|
|
if Cstruct.len cs > 0
|
||
|
|
then R.error_msg "trailing bytes"
|
||
|
|
else Ok a
|
||
|
|
| Error (`Parse msg) -> Error (`Msg msg)
|
||
|
|
|
||
|
|
let projections_of asn =
|
||
|
|
let c = Asn.codec Asn.der asn in
|
||
|
|
(decode_strict c, Asn.encode c)
|
||
|
|
|
||
|
|
let my_explicit ?cls id ~label:_ asn = Asn.S.explicit ?cls id asn
|
||
|
|
|
||
|
|
let version =
|
||
|
|
let f = function
|
||
|
|
| 1 -> `V1
|
||
|
|
| x -> Asn.S.error (`Parse (Printf.sprintf "unknown version number 0x%X" x))
|
||
|
|
and g `V1 = 1
|
||
|
|
in
|
||
|
|
Asn.S.map f g Asn.S.int
|
||
|
|
|
||
|
|
let header =
|
||
|
|
let f (version, _) = { version }
|
||
|
|
and g h = h.version, 0
|
||
|
|
in
|
||
|
|
Asn.S.map f g @@
|
||
|
|
Asn.S.(sequence2
|
||
|
|
(required ~label:"version" version)
|
||
|
|
(required ~label:"placeholder" int))
|
||
|
|
|
||
|
|
let csr =
|
||
|
|
let f data =
|
||
|
|
match X509.Signing_request.decode_der data with
|
||
|
|
| Ok csr -> csr
|
||
|
|
| Error (`Msg e) -> Asn.S.error (`Parse e)
|
||
|
|
and g csr =
|
||
|
|
X509.Signing_request.encode_der csr
|
||
|
|
in
|
||
|
|
Asn.S.map f g Asn.S.octet_string
|
||
|
|
|
||
|
|
let cert =
|
||
|
|
let f data =
|
||
|
|
match X509.Certificate.decode_der data with
|
||
|
|
| Ok cert -> cert
|
||
|
|
| Error (`Msg e) -> Asn.S.error (`Parse e)
|
||
|
|
and g cert =
|
||
|
|
X509.Certificate.encode_der cert
|
||
|
|
in
|
||
|
|
Asn.S.map f g Asn.S.octet_string
|
||
|
|
|
||
|
|
|
||
|
|
let wire_command =
|
||
|
|
let f = function
|
||
|
|
| `C1 csr ->
|
||
|
|
`Sign_request csr
|
||
|
|
| `C2 () -> assert false
|
||
|
|
and g = function
|
||
|
|
| `Sign_request csr -> `C1 csr
|
||
|
|
in
|
||
|
|
Asn.S.map f g @@
|
||
|
|
Asn.S.(choice2
|
||
|
|
(my_explicit 0 ~label:"sign-request" csr)
|
||
|
|
(my_explicit 1 ~label:"placeholder" null))
|
||
|
|
|
||
|
|
let payload =
|
||
|
|
let f = function
|
||
|
|
| `C1 cmd -> `Command cmd
|
||
|
|
| `C2 cert -> `Sign cert
|
||
|
|
| `C3 e -> `Failure e
|
||
|
|
and g = function
|
||
|
|
| `Command cmd -> `C1 cmd
|
||
|
|
| `Sign cert -> `C2 cert
|
||
|
|
| `Failure e -> `C3 e
|
||
|
|
in
|
||
|
|
Asn.S.map f g @@
|
||
|
|
Asn.S.(choice3
|
||
|
|
(my_explicit 0 ~label:"command" wire_command)
|
||
|
|
(my_explicit 1 ~label:"sign" cert)
|
||
|
|
(my_explicit 2 ~label:"failure" utf8_string))
|
||
|
|
|
||
|
|
let wire =
|
||
|
|
Asn.S.(sequence2
|
||
|
|
(required ~label:"header" header)
|
||
|
|
(required ~label:"payload" payload))
|
||
|
|
|
||
|
|
let wire_of_cstruct, wire_to_cstruct = projections_of wire
|