From 4e37e6a660f410bb20549d46ca85e057507dce37 Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Fri, 27 Sep 2019 09:34:00 +0100 Subject: [PATCH] Upgrade from uint to stdint The latest uint is just a wrapper around stdint anyway. Also, switch to smaller Alpine image for Dockerfile build. --- Dockerfile | 7 +++---- README.md | 14 ++------------ capnp-rpc-lwt/capnp_rpc_lwt.ml | 10 +++++----- capnp-rpc-lwt/msg.ml | 2 +- capnp-rpc-lwt/parse.ml | 2 +- capnp-rpc-lwt/service.ml | 2 +- capnp-rpc-lwt/xform.ml | 2 +- capnp-rpc.opam | 2 +- capnp-rpc/debug.ml | 2 +- capnp-rpc/debug.mli | 2 +- capnp-rpc/dune | 2 +- capnp-rpc/id.ml | 2 ++ examples/calc.ml | 4 ++-- test-bin/calc.ml | 2 +- test/test.ml | 2 +- test/testbed/test_utils.ml | 2 +- 16 files changed, 25 insertions(+), 34 deletions(-) diff --git a/Dockerfile b/Dockerfile index 804fea0d1..1e79c9a12 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,7 +1,6 @@ -FROM ocaml/opam2@sha256:95a87466c507b160bb18e696951b55fe0ace0bdc1fe7f16cbb827ae74ef74198 -#FROM ocaml/opam2:debian-10-ocaml-4.08 -RUN sudo apt-get update -RUN git fetch && git reset --hard 22aca1413d66271baf995f79feecf7430fc988f1 && opam update +FROM ocurrent/opam@sha256:4d2dc158efda4a5920440e007638ff08dc2ad8c3af1d0a9ed777924ce6db94fa +#FROM ocurrent/opam:alpine-3.10-ocaml-4.08 +RUN cd ~/opam-repository && git fetch && git reset --hard 69f81992a5b3ca023f34da67e68c8054d18c7776 && opam update RUN opam depext -i capnp afl-persistent conf-capnproto tls mirage-flow-lwt mirage-kv-lwt mirage-clock ptime cmdliner mirage-dns ADD --chown=opam *.opam /home/opam/capnp-rpc/ WORKDIR /home/opam/capnp-rpc/ diff --git a/README.md b/README.md index 0978056d5..17f86b2fc 100644 --- a/README.md +++ b/README.md @@ -1106,18 +1106,8 @@ Note that calling `wait_forever` prevents further use of the session, however. ### How can I use this with Mirage? -`capnp` uses the `uint` library, which has C stubs and does not work on most Mirage backends. -As a quick hack, you can do: - -``` -opam pin add uint 'https://github.com/talex5/ocaml-uint.git#dummy' -``` - -This allows it to compile and run as a unikernel, by defining `type Uint64.t = Int64.t`, etc. -However, this changes the behaviour of unsigned integers, so you should be careful with it. -In particular, OCaml's built-in polymorphic comparison operators (`>`, etc) may give incorrect -results. -Ideally, someone would add proper Mirage support to the `uint` library. +Note: `capnp` uses the `stdint` library, which has C stubs and +[might need patching](https://github.com/mirage/mirage/issues/885) to work with the Xen backend. explains why OCaml doesn't have unsigned integer support. Here is a suitable `config.ml`: diff --git a/capnp-rpc-lwt/capnp_rpc_lwt.ml b/capnp-rpc-lwt/capnp_rpc_lwt.ml index 8b24561a6..fa4f58f76 100644 --- a/capnp-rpc-lwt/capnp_rpc_lwt.ml +++ b/capnp-rpc-lwt/capnp_rpc_lwt.ml @@ -41,21 +41,21 @@ module Untyped = struct x (StructStorage.cast_reader req) release let get_cap a i = - Core_types.Attachments.cap (Uint32.to_int i) (Msg.unwrap_attachments a) + Core_types.Attachments.cap (Stdint.Uint32.to_int i) (Msg.unwrap_attachments a) let add_cap a cap = - Core_types.Attachments.add_cap (Msg.unwrap_attachments a) cap |> Uint32.of_int + Core_types.Attachments.add_cap (Msg.unwrap_attachments a) cap |> Stdint.Uint32.of_int let clear_cap a i = - Core_types.Attachments.clear_cap (Msg.unwrap_attachments a) (Uint32.to_int i) + Core_types.Attachments.clear_cap (Msg.unwrap_attachments a) (Stdint.Uint32.to_int i) let unknown_interface ~interface_id _req release_params = release_params (); - Core_types.fail ~ty:`Unimplemented "Unknown interface %a" Uint64.printer interface_id + Core_types.fail ~ty:`Unimplemented "Unknown interface %a" Stdint.Uint64.printer interface_id let unknown_method ~interface_id ~method_id _req release_params = release_params (); - Core_types.fail ~ty:`Unimplemented "Unknown method %a.%d" Uint64.printer interface_id method_id + Core_types.fail ~ty:`Unimplemented "Unknown method %a.%d" Stdint.Uint64.printer interface_id method_id class type generic_service = Service.generic end diff --git a/capnp-rpc-lwt/msg.ml b/capnp-rpc-lwt/msg.ml index fa67e6392..f828f72aa 100644 --- a/capnp-rpc-lwt/msg.ml +++ b/capnp-rpc-lwt/msg.ml @@ -109,7 +109,7 @@ module Response = struct let msg = B.Message.init_root () in let ret = B.Message.return_init msg in let p = B.Return.results_init ret in - B.Payload.content_set_interface p (Some Uint32.zero); (* Cap index 0 *) + B.Payload.content_set_interface p (Some Stdint.Uint32.zero); (* Cap index 0 *) Builder ret let of_builder x = Builder x diff --git a/capnp-rpc-lwt/parse.ml b/capnp-rpc-lwt/parse.ml index 1df810000..0c2c5c00a 100644 --- a/capnp-rpc-lwt/parse.ml +++ b/capnp-rpc-lwt/parse.ml @@ -138,7 +138,7 @@ module Make_basic let parse_release x = let open Reader in let export_id = Release.id_get x |> ExportId.of_uint32 in - let ref_count = Release.reference_count_get x |> Uint32.to_int in + let ref_count = Release.reference_count_get x |> Stdint.Uint32.to_int in `Release (export_id, ref_count) (* Parse a message received from our peer. Returns [`Not_implemented`] if we couldn't understand it. *) diff --git a/capnp-rpc-lwt/service.ml b/capnp-rpc-lwt/service.ml index 487a4b07f..2b768bf40 100644 --- a/capnp-rpc-lwt/service.ml +++ b/capnp-rpc-lwt/service.ml @@ -19,7 +19,7 @@ type ('a, 'b) method_t = 'a -> (unit -> unit) -> Core_types.struct_ref let pp_method = Capnp.RPC.Registry.pp_method class type generic = object - method dispatch : interface_id:Uint64.t -> method_id:int -> abstract_method_t + method dispatch : interface_id:Stdint.Uint64.t -> method_id:int -> abstract_method_t method release : unit method pp : Format.formatter -> unit end diff --git a/capnp-rpc-lwt/xform.ml b/capnp-rpc-lwt/xform.ml index 4d9a6d322..1b87aa049 100644 --- a/capnp-rpc-lwt/xform.ml +++ b/capnp-rpc-lwt/xform.ml @@ -6,7 +6,7 @@ let pp f = function let to_cap_index = function | None -> None - | Some i -> Some (Uint32.to_int i) + | Some i -> Some (Stdint.Uint32.to_int i) (* [walk ss x xs] is the interface cap index at path [x :: xs] within struct storage [ss]. *) let rec walk ss x = function diff --git a/capnp-rpc.opam b/capnp-rpc.opam index 710112a17..22b5ee3c4 100644 --- a/capnp-rpc.opam +++ b/capnp-rpc.opam @@ -13,7 +13,7 @@ bug-reports: "https://github.com/mirage/capnp-rpc/issues" doc: "https://mirage.github.io/capnp-rpc/" depends: [ "ocaml" {>= "4.03.0"} - "uint" + "stdint" "astring" "fmt" "logs" diff --git a/capnp-rpc/debug.ml b/capnp-rpc/debug.ml index 968fb574a..fe1a35012 100644 --- a/capnp-rpc/debug.ml +++ b/capnp-rpc/debug.ml @@ -1,7 +1,7 @@ let src = Logs.Src.create "capnp-rpc" ~doc:"Cap'n Proto RPC" module Log = (val Logs.src_log src: Logs.LOG) -let qid_tag = Logs.Tag.def "qid" Uint32.printer +let qid_tag = Logs.Tag.def "qid" Stdint.Uint32.printer exception Invariant_broken of (Format.formatter -> unit) diff --git a/capnp-rpc/debug.mli b/capnp-rpc/debug.mli index a41a787bb..26fcc760e 100644 --- a/capnp-rpc/debug.mli +++ b/capnp-rpc/debug.mli @@ -6,7 +6,7 @@ module Log : Logs.LOG val src : Logs.src (** Control the log level for [Log]. *) -val qid_tag : Uint32.t Logs.Tag.def +val qid_tag : Stdint.Uint32.t Logs.Tag.def (** [qid_tag] is used in log reports to tag the question (or answer) ID in the call. *) exception Invariant_broken of (Format.formatter -> unit) diff --git a/capnp-rpc/dune b/capnp-rpc/dune index 1b5d84277..0c1d6131a 100644 --- a/capnp-rpc/dune +++ b/capnp-rpc/dune @@ -1,4 +1,4 @@ (library (name capnp_rpc) (public_name capnp-rpc) - (libraries astring fmt logs uint asetmap)) + (libraries astring fmt logs stdint asetmap)) diff --git a/capnp-rpc/id.ml b/capnp-rpc/id.ml index 9d445c636..ceef3579b 100644 --- a/capnp-rpc/id.ml +++ b/capnp-rpc/id.ml @@ -1,5 +1,7 @@ (** Unique identifiers. *) +open Stdint + module type S = sig type t = private Uint32.t val zero : t diff --git a/examples/calc.ml b/examples/calc.ml index 84d4aa31e..30730fc46 100644 --- a/examples/calc.ml +++ b/examples/calc.ml @@ -24,7 +24,7 @@ module Expr = struct | Expression.Literal f -> Float f | Expression.PreviousResult None -> failwith "PreviousResult but no cap!" | Expression.PreviousResult (Some v) -> Prev v - | Expression.Parameter p -> Param (Uint32.to_int p) + | Expression.Parameter p -> Param (Stdint.Uint32.to_int p) | Expression.Call c -> let fn_obj = Expression.Call.function_get c |> or_fail "Missing fn" in let params = Expression.Call.params_get_list c |> List.map parse in @@ -48,7 +48,7 @@ let rec write_expr b expr = match expr with | Float f -> Expression.literal_set b f | Prev v -> Expression.previous_result_set b (Some v) - | Param i -> Expression.parameter_set b (Uint32.of_int i) + | Param i -> Expression.parameter_set b (Stdint.Uint32.of_int i) | Call (f, args) -> let c = Expression.call_init b in Expression.Call.function_set c (Some f); diff --git a/test-bin/calc.ml b/test-bin/calc.ml index dcc93a4de..18f200de5 100644 --- a/test-bin/calc.ml +++ b/test-bin/calc.ml @@ -8,7 +8,7 @@ module Calc = Examples.Calc let pp_qid f = function | None -> () | Some x -> - let s = Uint32.to_string x in + let s = Stdint.Uint32.to_string x in Fmt.(styled `Magenta (fun f x -> Fmt.pf f " (qid=%s)" x)) f s let reporter = diff --git a/test/test.ml b/test/test.ml index 3b5a8fabc..7e3a84fa4 100644 --- a/test/test.ml +++ b/test/test.ml @@ -1365,7 +1365,7 @@ module Level0 = struct let send t m = Queue.add m t.to_server - let qid_of_int x = S.EP.In.QuestionId.of_uint32 (Uint32.of_int x) + let qid_of_int x = S.EP.In.QuestionId.of_uint32 (Stdint.Uint32.of_int x) let init ~bootstrap = let from_server = Queue.create () in diff --git a/test/testbed/test_utils.ml b/test/testbed/test_utils.ml index ca01acb2b..c176a4c74 100644 --- a/test/testbed/test_utils.ml +++ b/test/testbed/test_utils.ml @@ -14,7 +14,7 @@ let peer_tag = Logs.Tag.def "peer" pp_actor let pp_qid f = function | None -> () | Some x -> - let s = Uint32.to_string x in + let s = Stdint.Uint32.to_string x in Fmt.(styled `Magenta (fun f x -> Fmt.pf f " (qid=%s)" x)) f s let reporter =