diff --git a/.gitignore b/.gitignore index fea4c45..fdecd21 100644 --- a/.gitignore +++ b/.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 diff --git a/_oasis b/_oasis index 8ee9b3d..964a866 100644 --- a/_oasis +++ b/_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 diff --git a/_tags b/_tags index 5a33cd1..a8439e5 100644 --- a/_tags +++ b/_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 @@ : pkg_lwt.syntax : pkg_cstruct : pkg_cstruct.syntax -: pkg_mirage +: pkg_mirage-xen : pkg_shared-memory-ring : pkg_shared-memory-ring.lwt : pkg_xenctrl diff --git a/lib/META b/lib/META index a02910a..ecee5e8 100644 --- a/lib/META +++ b/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" diff --git a/lib/blkfront.ml b/lib/blkfront.ml index 6222698..3a236de 100644 --- a/lib/blkfront.ml +++ b/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%!"; diff --git a/lib/blkfront.mli b/lib/blkfront.mli index 189b286..fd114e2 100644 --- a/lib/blkfront.mli +++ b/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 diff --git a/lib/blkfront.mllib b/lib/blkfront.mllib index a248237..5e98dd6 100644 --- a/lib/blkfront.mllib +++ b/lib/blkfront.mllib @@ -1,5 +1,4 @@ # OASIS_START -# DO NOT EDIT (digest: f7fed72d781df4577f6248f09fbc53cc) +# DO NOT EDIT (digest: 2d16726a1926756d424db957c9d78408) Blkfront -Blkfront_init # OASIS_STOP diff --git a/lib/blkfront_init.ml b/lib/blkfront_init.ml deleted file mode 100644 index 4dbaa13..0000000 --- a/lib/blkfront_init.ml +++ /dev/null @@ -1,20 +0,0 @@ -(* - * Copyright (c) 2011 Anil Madhavapeddy - * Copyright (c) 2012 Citrix Systems Inc - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - *) - -let register () = - OS.Block.register "local" (module Blkfront: OS.Block.S); - Blkfront.register () diff --git a/setup.ml b/setup.ml index 3a0b225..7443e6b 100644 --- a/setup.ml +++ b/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;