This commit is contained in:
Hannes Mehnert 2018-03-22 13:36:50 +01:00
parent b9d5fa94f9
commit d3941e70c6
4 changed files with 22 additions and 31 deletions

View file

@ -123,35 +123,27 @@ let handle s addr () =
(if not (version_eq hdr.version my_version) then (if not (version_eq hdr.version my_version) then
Lwt.return (Error (`Msg "ignoring data with bad version")) Lwt.return (Error (`Msg "ignoring data with bad version"))
else else
match Console.int_to_op hdr.tag with match decode_str data with
| Some Add -> | Error e -> Lwt.return (Error e)
(match decode_str data with | Ok (name, off) ->
| Error e -> Lwt.return (Error e) match Console.int_to_op hdr.tag with
| Ok (name, _) -> add_fifo s name) | Some Add -> add_fifo s name
| Some Attach -> | Some Attach -> attach name
(match decode_str data with | Some Detach -> detach name
| Error e -> Lwt.return (Error e) | Some History ->
| Ok (name, _) -> attach name) (match decode_ts ~off data with
| Some Detach -> | Error e -> Lwt.return (Error e)
(match decode_str data with | Ok since -> history s name since)
| Error e -> Lwt.return (Error e) | _ ->
| Ok (name, _) -> detach name) Lwt.return (Error (`Msg "unknown command"))) >>= (function
| Some History ->
(match decode_str data with
| Error e -> Lwt.return (Error e)
| Ok (name, off) -> match decode_ts ~off data with
| Error e -> Lwt.return (Error e)
| Ok since -> history s name since)
| _ ->
Lwt.return (Error (`Msg "unknown command"))) >>= (function
| Ok msg -> Vmm_lwt.write_raw s (success ~msg hdr.id my_version) | Ok msg -> Vmm_lwt.write_raw s (success ~msg hdr.id my_version)
| Error (`Msg msg) -> | Error (`Msg msg) ->
Logs.err (fun m -> m "error while processing command: %s" msg) ; Logs.err (fun m -> m "error while processing command: %s" msg) ;
Vmm_lwt.write_raw s (fail ~msg hdr.id my_version)) >>= function Vmm_lwt.write_raw s (fail ~msg hdr.id my_version)) >>= function
| Ok () -> loop () | Ok () -> loop ()
| Error _ -> | Error _ ->
Logs.err (fun m -> m "exception while writing to socket") ; Logs.err (fun m -> m "exception while writing to socket") ;
Lwt.return_unit Lwt.return_unit
in in
loop () >>= fun () -> loop () >>= fun () ->
Lwt.catch (fun () -> Lwt_unix.close s) (fun _ -> Lwt.return_unit) Lwt.catch (fun () -> Lwt_unix.close s) (fun _ -> Lwt.return_unit)

View file

@ -85,8 +85,7 @@ let handle fd ring s addr () =
in in
Ok (`Out out) Ok (`Out out)
end end
| _ -> | _ -> Error (`Msg "unknown command"))
Error (`Msg "unknown command"))
in in
match out with match out with
| Error (`Msg msg) -> | Error (`Msg msg) ->

View file

@ -13,7 +13,7 @@ let subca_csr key name cpus mem vms block bridges =
| Some x -> [ (false, `Unsupported (Oid.block, int_to_cstruct x)) ] | Some x -> [ (false, `Unsupported (Oid.block, int_to_cstruct x)) ]
and bridge = match bridges with and bridge = match bridges with
| [] -> [] | [] -> []
| xs -> [ (false, `Unsupported (Oid.bridges, bridges_to_cstruct bridges)) ] | xs -> [ (false, `Unsupported (Oid.bridges, bridges_to_cstruct xs)) ]
in in
let exts = let exts =
[ (false, `Unsupported (Oid.version, version_to_cstruct asn_version)) ; [ (false, `Unsupported (Oid.version, version_to_cstruct asn_version)) ;

View file

@ -345,7 +345,7 @@ let handle_revocation t s leaf chain ca prefix =
| None -> Ok () | None -> Ok ()
| Some local -> match X509.CRL.crl_number local, X509.CRL.crl_number crl with | Some local -> match X509.CRL.crl_number local, X509.CRL.crl_number crl with
| None, _ -> Ok () | None, _ -> Ok ()
| Some x, None -> Error (`Msg "CRL number not present") | Some _, None -> Error (`Msg "CRL number not present")
| Some x, Some y -> if y > x then Ok () else Error (`Msg "CRL number not increased")) >>= fun () -> | Some x, Some y -> if y > x then Ok () else Error (`Msg "CRL number not increased")) >>= fun () ->
(* filename should be whatever_dir / crls / <id> *) (* filename should be whatever_dir / crls / <id> *)
let filename = Fpath.(t.dir / "crls" / string_of_id prefix) in let filename = Fpath.(t.dir / "crls" / string_of_id prefix) in
@ -355,7 +355,7 @@ let handle_revocation t s leaf chain ca prefix =
let crls = let crls =
match local with match local with
| None -> crl :: t.crls | None -> crl :: t.crls
| Some x -> crl :: List.filter (fun c -> c <> crl) t.crls | Some _ -> crl :: List.filter (fun c -> c <> crl) t.crls
in in
(* iterate over revoked serials, find active resources, and kill them *) (* iterate over revoked serials, find active resources, and kill them *)
let newly_revoked = let newly_revoked =
@ -508,7 +508,7 @@ let handle_log state hdr buf =
state, [] state, []
end else match IM.find hdr.id state.log_requests with end else match IM.find hdr.id state.log_requests with
| exception Not_found -> | exception Not_found ->
Logs.err (fun m -> m "coudn't find log request") ; Logs.warn (fun m -> m "(ignored) coudn't find log request") ;
(state, []) (state, [])
| (s, rid) -> | (s, rid) ->
let r = match int_to_op hdr.tag with let r = match int_to_op hdr.tag with