Merge pull request #75 from yomimono/new-gnt-iface

Use new grant interface in mirage-xen

mirage-console-xen-backend.opam

@@ -11,11 +11,11 @@ depends: [
   "dune" {build & >= "1.0"}
   "mirage-console-lwt" {>= "2.2.0"}
   "mirage-console-xen-proto"
+  "mirage-xen" {>= "3.3.0"}
   "lwt"
   "io-page-xen" {>= "2.0.0"}
   "xenstore"
   "xen-evtchn"
-  "xen-gnt"
   "shared-memory-ring-lwt"
 ]
 build: [

mirage-console-xen.opam

@@ -12,9 +12,8 @@ depends: [
   "mirage-console-lwt" {>= "2.2.0"}
   "mirage-console-xen-proto"
   "xen-evtchn"
-  "xen-gnt"
   "io-page-xen"
-  "mirage-xen" {>= "3.0.2"}
+  "mirage-xen" {>= "3.3.0"}
 ]
 build: [
   ["dune" "subst"] {pinned}

xen/backend/conback.ml

@@ -17,7 +17,6 @@
 
 open Lwt.Infix
 open Conproto
-open Gnt
 
 module type ACTIVATIONS = sig
 
@@ -47,7 +46,6 @@ type stats = {
 
 type t = {
   domid:  int;
-  xg:     Gnttab.interface;
   xe:     Eventchn.handle;
   evtchn: Eventchn.t;
   ring:   Cstruct.t;
@@ -113,23 +111,22 @@ module Make(A: ACTIVATIONS)(X: Xs_client_lwt.S)(C: CONSOLE) = struct
     let (b: unit Lwt.t) = read_the_console A.program_start in
     Lwt.join [a; b]
 
-  let init xg xe domid ring_info c =
+  let init xe domid ring_info c =
     let evtchn =
       Eventchn.bind_interdomain xe domid ring_info.RingInfo.event_channel
     in
     let grant =
-      { Gnttab.domid = domid; ref = Int32.to_int ring_info.RingInfo.ref }
+      { OS.Xen.Import.domid = domid; ref = OS.Xen.Gntref.of_int32 ring_info.RingInfo.ref }
     in
-    match Gnttab.mapv xg [ grant ] true with
-    | None ->
-      failwith "Gnttab.mapv failed"
-    | Some mapping ->
-      let ring = Io_page.to_cstruct (Gnttab.Local_mapping.to_buf mapping) in
-      let t = { domid; xg; xe; evtchn; ring } in
+    match OS.Xen.Import.mapv [ grant ] ~writable:true with
+    | Error (`Msg s) -> failwith s
+    | Ok mapping ->
+      let ring = Io_page.to_cstruct (OS.Xen.Import.Local_mapping.to_buf mapping) in
+      let t = { domid; xe; evtchn; ring } in
       let stats = { total_read = 0; total_write = 0 } in
       let th = service_thread t c stats in
       Lwt.on_cancel th (fun () ->
-          let () = Gnttab.unmap_exn xg mapping in ()
+          let () = OS.Xen.Import.Local_mapping.unmap_exn mapping in ()
         );
       th, stats
 
@@ -200,7 +197,6 @@ module Make(A: ACTIVATIONS)(X: Xs_client_lwt.S)(C: CONSOLE) = struct
 
   let run (id: string) backend_name (domid,devid) =
     make () >>= fun client ->
-    let xg = Gnttab.interface_open () in
     let xe = Eventchn.init () in
 
     C.connect id >>= fun t ->
@@ -230,7 +226,7 @@ module Make(A: ACTIVATIONS)(X: Xs_client_lwt.S)(C: CONSOLE) = struct
          | Error x -> Lwt.fail (Failure x)) >>= fun ring_info ->
         Printf.printf "%s\n%!" (Conproto.RingInfo.to_string ring_info);
 
-        let be_thread, stats = init xg xe domid ring_info t in
+        let be_thread, stats = init xe domid ring_info t in
         writev client
           (List.map (fun (k, v) -> backend_path ^ "/" ^ k, v)
              (Conproto.State.to_assoc_list Conproto.State.Connected))

xen/backend/dune

@@ -1,6 +1,6 @@
 (library
  (name mirage_console_xen_backend)
  (public_name mirage-console-xen-backend)
- (libraries lwt xenstore xenstore.client xen-gnt xen-evtchn
+ (libraries lwt mirage-xen xenstore xenstore.client xen-evtchn
    shared-memory-ring mirage-console-lwt mirage-console-xen-proto io-page-xen)
  (flags :standard -safe-string))

xen/console_xen.ml

@@ -16,12 +16,11 @@
 
 open Lwt.Infix
 open OS
-open Gnt
 
 type t = {
   id: int;
   backend_id: int;
-  gnt: Gnt.gntref;
+  gnt: Xen.Gntref.t;
   ring: Cstruct.t;
   mutable evtchn: Eventchn.t;
   mutable closed: bool;
@@ -47,11 +46,11 @@ let h = Eventchn.init ()
 
 (* Allocate a ring, given the vdev and backend domid *)
 let alloc (_, domid) =
-  let buf = Io_page.get 1 in
-  let ring = Io_page.to_cstruct buf in
+  let page = Io_page.get 1 in
+  let ring = Io_page.to_cstruct page in
   Console_ring.Ring.init ring; (* explicitly zero the ring *)
-  Gntshr.get () >|= fun gnt ->
-  Gntshr.grant_access ~domid ~writable:true gnt buf;
+  Xen.Export.get () >|= fun gnt ->
+  Xen.Export.grant_access ~domid ~writable:true gnt page ;
   gnt, ring
 
 (* Plug a console where id > 0 *)
@@ -78,7 +77,7 @@ let plug id =
   let evtchn = Eventchn.bind_unbound_port h backend_id in
   let port = Eventchn.to_int evtchn in
   let ring_info =
-    Conproto.RingInfo.({event_channel = port; ref = Int32.of_int gnt })
+    Conproto.RingInfo.({event_channel = port; ref = Xen.Gntref.to_int32 gnt })
   in
   let info = [
     "state", Device_state.(to_string Connected)
@@ -133,8 +132,6 @@ let names_to_ids ids =
 let get_initial_console () =
   (* The domain is created with a reserved grant entry already set up.
      We don't need to know who the backend domain is. *)
-  let backend_id = 0 in (* unused *)
-  let gnt = Gnt.console in (* unused *)
   let page = Start_info.console_start_page () in
   let ring = page in
   (* We don't need to zero the initial console ring, and doing so may lose boot
@@ -146,7 +143,7 @@ let get_initial_console () =
     e in
   let evtchn = get_evtchn () in
   let closed = false in
-  let cons = { id = 0; backend_id; gnt; ring; evtchn; closed  } in
+  let cons = { id = 0; backend_id = 0; gnt = Xen.console; ring; evtchn; closed  } in
   Sched.add_resume_hook (fun () -> cons.evtchn <- get_evtchn (); Lwt.return ());
 
   Eventchn.unmask h evtchn;
@@ -190,8 +187,12 @@ let connect id =
     end
   end
 
-let disconnect _id =
-  Lwt.return_unit
+let disconnect t =
+  (* attempting to unmap the preset page for the constant default console
+     is a bad idea, according to Xen Experts, so don't do that *)
+  match t.id with
+  | 0 -> Lwt.return_unit
+  | _ -> OS.Xen.Export.end_access ~release_ref:true t.gnt
 
 type buffer = Cstruct.t
 

xen/dune

@@ -1,7 +1,7 @@
 (library
  (name mirage_console_xen)
  (public_name mirage-console-xen)
- (libraries lwt xenstore xen-gnt xen-evtchn shared-memory-ring
+ (libraries lwt xenstore xen-evtchn shared-memory-ring
    mirage-console-xen-proto mirage-console-lwt mirage-flow mirage-xen
    io-page-xen)
  (wrapped false)