Merge pull request #9 from avsm/master

port to V1.BLOCK.CLIENT

.gitignore

@@ -1,9 +1,9 @@
-*.annot
-*.cmo
-*.cma
-*.cmi
-*.a
-*.o
-*.cmx
-*.cmxs
-*.cmxa
+_build/
+setup.bin
+setup.data
+setup.log
+configure
+config.mk
+configure.cmi
+configure.cmx
+configure.o

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.3
 Name:        ocaml-xen-block-driver
-Version:     0.2.4
+Version:     0.9.9
 Synopsis:    Xen block frontend and backend driver implementation
 Authors:     Jonathan Ludlam, Anil Madhavapeddy, David Scott
 License:     ISC
@@ -28,8 +28,8 @@ Library blkfront
   Path:               lib
   Findlibparent:      xenblock
   Findlibname:        front
-  Modules:            Blkfront, Blkfront_init
-  BuildDepends:       lwt, lwt.syntax, cstruct, cstruct.syntax, mirage, mirage-types, shared-memory-ring, shared-memory-ring.lwt, xenblock
+  Modules:            Blkfront
+  BuildDepends:       lwt, lwt.syntax, cstruct, cstruct.syntax, mirage-xen, mirage-types, shared-memory-ring, shared-memory-ring.lwt, xenblock
 
 Library blkback
   Build$:             flag(blkback)
@@ -38,4 +38,4 @@ Library blkback
   Findlibparent:      xenblock
   Findlibname:        back
   Modules:            Blkback
-  BuildDepends:       lwt, lwt.syntax, cstruct, cstruct.syntax, mirage, shared-memory-ring, shared-memory-ring.lwt, xenblock, xenctrl
+  BuildDepends:       lwt, lwt.syntax, cstruct, cstruct.syntax, mirage-xen, shared-memory-ring, shared-memory-ring.lwt, xenblock, xenctrl

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: fa8d6474a1a5bb6911b0fb034ee12cc9)
+# DO NOT EDIT (digest: 331d59dcafd1cda8cb8d9461461b5927)
 # Ignore VCS directories, you can use the same kind of rule outside 
 # OASIS_START/STOP if you want to exclude directories that contains 
 # useless stuff for the build process
@@ -25,7 +25,7 @@
 <lib/*.ml{,i}>: pkg_lwt.syntax
 <lib/*.ml{,i}>: pkg_cstruct
 <lib/*.ml{,i}>: pkg_cstruct.syntax
-<lib/*.ml{,i}>: pkg_mirage
+<lib/*.ml{,i}>: pkg_mirage-xen
 <lib/*.ml{,i}>: pkg_shared-memory-ring
 <lib/*.ml{,i}>: pkg_shared-memory-ring.lwt
 <lib/*.ml{,i}>: pkg_xenctrl

lib/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: 29112410a7cdc0a8cf0173c510bb7667)
-version = "0.2.4"
+# DO NOT EDIT (digest: 23dd5356ed801dd35f2cee4a1959c72c)
+version = "0.9.9"
 description = "Xen block frontend and backend driver implementation"
 requires = "cstruct cstruct.syntax"
 archive(byte) = "xenblock.cma"
@@ -9,10 +9,10 @@ archive(native) = "xenblock.cmxa"
 archive(native, plugin) = "xenblock.cmxs"
 exists_if = "xenblock.cma"
 package "front" (
- version = "0.2.4"
+ version = "0.9.9"
  description = "Xen block frontend and backend driver implementation"
  requires =
- "lwt lwt.syntax cstruct cstruct.syntax mirage mirage-types shared-memory-ring shared-memory-ring.lwt xenblock"
+ "lwt lwt.syntax cstruct cstruct.syntax mirage-xen mirage-types shared-memory-ring shared-memory-ring.lwt xenblock"
  archive(byte) = "blkfront.cma"
  archive(byte, plugin) = "blkfront.cma"
  archive(native) = "blkfront.cmxa"
@@ -21,10 +21,10 @@ package "front" (
 )
 
 package "back" (
- version = "0.2.4"
+ version = "0.9.9"
  description = "Xen block frontend and backend driver implementation"
  requires =
- "lwt lwt.syntax cstruct cstruct.syntax mirage shared-memory-ring shared-memory-ring.lwt xenblock xenctrl"
+ "lwt lwt.syntax cstruct cstruct.syntax mirage-xen shared-memory-ring shared-memory-ring.lwt xenblock xenctrl"
  archive(byte) = "blkback.cma"
  archive(byte, plugin) = "blkback.cma"
  archive(native) = "blkback.cmxa"

lib/blkfront.ml

@@ -23,7 +23,7 @@ open Gnt
 
 type 'a io = 'a Lwt.t
 
-type page_aligned_buffer = Io_page.t
+type page_aligned_buffer = Cstruct.t
 
 type info = {
   read_write: bool;
@@ -153,8 +153,7 @@ let plug (id:id) =
 (* Unplug shouldn't block, although the Xen one might need to due
    to Xenstore? XXX *)
 let unplug id =
-  Console.log (sprintf "Blkif.unplug %s: not implemented yet" id);
-  ()
+  printf "Blkif.unplug %s: not implemented yet\n" id
 
 (** Return a list of valid VBDs *)
 let enumerate () =
@@ -165,7 +164,7 @@ let enumerate () =
     | Xs_protocol.Enoent _ ->
       return []
     | e ->
-      Console.log (sprintf "Blkif.enumerate caught exception: %s" (Printexc.to_string e));
+      printf "Blkif.enumerate caught exception: %s\n" (Printexc.to_string e);
       return []
 
 (** [single_request_into op t start_sector start_offset end_offset pages]
@@ -315,61 +314,15 @@ let resume () =
   let devs = Hashtbl.fold (fun k v acc -> (k,v)::acc) devices [] in
   Lwt_list.iter_p (fun (k,v) -> resume v) devs
 
-let create ~id : Devices.blkif Lwt.t =
-  printf "Xen.Blkif: create %s\n%!" id;
-  lwt trans = plug id in
-  let dev = { vdev = int_of_string id;
- 	      t = trans } in
-  Hashtbl.add devices id dev;
-  if Hashtbl.mem devices_waiters id then begin
-    Lwt_sequence.iter_l (fun u -> Lwt.wakeup_later u dev) (Hashtbl.find devices_waiters id);
-    Hashtbl.remove devices_waiters id
-  end;
-  printf "Xen.Blkif: success\n%!";
-  return (object
-    method id = id
-    method read_512 = read_512 dev
-    method write_page = write_page dev
-    method sector_size = 4096
-    method size = Int64.(mul dev.t.info.size_sectors (of_int dev.t.info.sector_size))
-    method readwrite = dev.t.info.read_write
-    method ppname = sprintf "Xen.blkif:%s" id
-    method destroy = unplug id
-  end)
-
-(* Register Xen.Blkif provider with the device manager *)
-let register () =
-  printf "Xen.Blkfront.register\n%!";
-  let plug_mvar = Lwt_mvar.create_empty () in
-  let unplug_mvar = Lwt_mvar.create_empty () in
-  let provider = object(self)
-     method id = "Xen.Blkif"
-     method plug = plug_mvar 
-     method unplug = unplug_mvar
-     method create ~deps ~cfg id =
-	  (* no cfg required: we will check xenstore instead *)
-      lwt blkif = create ~id in
-      let entry = Devices.({
-        provider=self; 
-        id=self#id; 
-        depends=[];
-        node=Blkif blkif }) in
-      return entry
-  end in
-  Devices.new_provider provider;
-  (* Iterate over the plugged in VBDs and plug them in *)
-  lwt ids = enumerate () in
-  Console.log (sprintf "Blkif.enumerate found ids [ %s ]" (String.concat "; " ids));
-    let vbds = List.map (fun id ->
-      printf "found VBD with id: %s\n%!" id;
-      { Devices.p_dep_ids = []; p_cfg = []; p_id = id }
-    ) ids in
-  Lwt_list.iter_s (Lwt_mvar.put plug_mvar) vbds
+let disconnect _id =
+  printf "Blkfront: disconnect not implement yet\n";
+  return ()
 
 type error =
-| Unknown of string
-| Unimplemented
-| Is_read_only
+  [ `Disconnected
+  | `Is_read_only
+  | `Unimplemented
+  | `Unknown of string ]
 
 (* [take xs n] returns [(taken, remaining)] where [taken] is as many
    elements of [xs] as possible, up to [n], and [remaining] is any
@@ -442,14 +395,14 @@ let read t start_sector pages =
   try_lwt
     lwt () = multiple_requests_into Req.Read t (sector t start_sector) pages in
     return (`Ok ())
-  with e -> return (`Error (Unknown (Printexc.to_string e)))
+  with e -> return (`Error (`Unknown (Printexc.to_string e)))
 
 let write t start_sector pages =
   lwt pages = to_iopages pages in
   try_lwt
     lwt () = multiple_requests_into Req.Write t (sector t start_sector) pages in
     return (`Ok ())
-  with e -> return (`Error (Unknown (Printexc.to_string e)))
+  with e -> return (`Error (`Unknown (Printexc.to_string e)))
 
 let _ =
   printf "Blkif: add resume hook\n%!";

lib/blkfront.mli

@@ -15,16 +15,7 @@
  *)
 open OS
 
-include Block.S
-
-(** {2} Legacy interface *)
-
-type id = string
-exception IO_error of string
-val create : id:id -> Devices.blkif Lwt.t
-val enumerate : unit -> id list Lwt.t
-val write_page : t -> int64 -> Io_page.t -> unit Lwt.t
-val read_512 : t -> int64 -> int64 -> Cstruct.t Lwt_stream.t
-val resume : unit -> unit Lwt.t
-
-val register: unit -> unit Lwt.t
+include V1.BLOCK.CLIENT
+with type 'a io = 'a Lwt.t
+and type     page_aligned_buffer = Cstruct.t
+and type     id = string

lib/blkfront.mllib

@@ -1,5 +1,4 @@
 # OASIS_START
-# DO NOT EDIT (digest: f7fed72d781df4577f6248f09fbc53cc)
+# DO NOT EDIT (digest: 2d16726a1926756d424db957c9d78408)
 Blkfront
-Blkfront_init
 # OASIS_STOP

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.3.1 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 648c6d14cec373e3874d25bae73710e1) *)
+(* DO NOT EDIT (digest: 72c7973360c0910a155a34af35909926) *)
 (*
    Regenerated by OASIS v0.3.0
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -5578,7 +5578,7 @@ let setup_t =
           ocaml_version = None;
           findlib_version = None;
           name = "ocaml-xen-block-driver";
-          version = "0.2.4";
+          version = "0.9.9";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -5706,7 +5706,7 @@ let setup_t =
                            FindlibPackage ("lwt.syntax", None);
                            FindlibPackage ("cstruct", None);
                            FindlibPackage ("cstruct.syntax", None);
-                           FindlibPackage ("mirage", None);
+                           FindlibPackage ("mirage-xen", None);
                            FindlibPackage ("mirage-types", None);
                            FindlibPackage ("shared-memory-ring", None);
                            FindlibPackage ("shared-memory-ring.lwt", None);
@@ -5723,7 +5723,7 @@ let setup_t =
                       bs_nativeopt = [(OASISExpr.EBool true, [])];
                       },
                    {
-                      lib_modules = ["Blkfront"; "Blkfront_init"];
+                      lib_modules = ["Blkfront"];
                       lib_pack = false;
                       lib_internal_modules = [];
                       lib_findlib_parent = Some "xenblock";
@@ -5751,7 +5751,7 @@ let setup_t =
                            FindlibPackage ("lwt.syntax", None);
                            FindlibPackage ("cstruct", None);
                            FindlibPackage ("cstruct.syntax", None);
-                           FindlibPackage ("mirage", None);
+                           FindlibPackage ("mirage-xen", None);
                            FindlibPackage ("shared-memory-ring", None);
                            FindlibPackage ("shared-memory-ring.lwt", None);
                            InternalLibrary "xenblock";
@@ -5782,7 +5782,7 @@ let setup_t =
           };
      oasis_fn = Some "_oasis";
      oasis_version = "0.3.0";
-     oasis_digest = Some "zC\011\183\163\002\230\200\132vGuz8 \n";
+     oasis_digest = Some "\133\024\255\167*\139L\135\149ep\021L\146bC";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false;