From f8f2f2dc287548d135fe2c8067b0e84c626d1a19 Mon Sep 17 00:00:00 2001 From: Mindy Date: Tue, 26 Mar 2019 13:32:47 -0500 Subject: [PATCH 1/3] remove unused local 'empty' definition --- lib/blkback.ml | 2 -- 1 file changed, 2 deletions(-) diff --git a/lib/blkback.ml b/lib/blkback.ml index 734c9a7..58bda42 100644 --- a/lib/blkback.ml +++ b/lib/blkback.ml @@ -82,8 +82,6 @@ module Opt = struct | Some x -> x end -let empty = Cstruct.create 0 - module Request = struct type kind = Read | Write From 9d38f16acf61e55c39d32723213c45008357f030 Mon Sep 17 00:00:00 2001 From: Mindy Date: Tue, 26 Mar 2019 15:22:29 -0500 Subject: [PATCH 2/3] add an mli for blkproto with only the items needed to build the project --- lib/blkproto.ml | 27 +++++++---- lib/blkproto.mli | 122 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 139 insertions(+), 10 deletions(-) create mode 100644 lib/blkproto.mli diff --git a/lib/blkproto.ml b/lib/blkproto.ml index bbee0af..fb7a752 100644 --- a/lib/blkproto.ml +++ b/lib/blkproto.ml @@ -33,7 +33,7 @@ module Mode = struct let to_string = function | ReadOnly -> "r" | ReadWrite -> "w" - let of_string = function + let _of_string = function | "r" -> Some ReadOnly | "w" -> Some ReadWrite | _ -> None @@ -48,7 +48,7 @@ module Media = struct let to_string = function | CDROM -> "cdrom" | Disk -> "disk" - let of_string = function + let _of_string = function | "cdrom" -> Some CDROM | "disk" -> Some Disk | _ -> None @@ -78,8 +78,8 @@ module State = struct else Error (`Msg (Printf.sprintf "unknown device state: %d" x)) let _state = "state" - let keys = [ _state ] - let of_assoc_list l = + let _keys = [ _state ] + let _of_assoc_list l = list l _state >>= fun x -> int x >>= fun x -> of_int x @@ -153,7 +153,7 @@ module FeatureIndirect = struct then [] (* don't advertise the feature *) else [ _max_indirect_segments, string_of_int t.max_indirect_segments ] - let of_assoc_list l = + let _of_assoc_list l = if not(List.mem_assoc _max_indirect_segments l) then Ok { max_indirect_segments = 0 } else @@ -180,7 +180,7 @@ module DiskInfo = struct _info, string_of_int (Media.to_int t.media lor (Mode.to_int t.mode)); ] - let of_assoc_list l = + let _of_assoc_list l = list l _sector_size >>= fun x -> int x >>= fun sector_size -> list l _sectors >>= fun x -> int64 x @@ -213,7 +213,7 @@ module RingInfo = struct _protocol; ] - let to_assoc_list t = [ + let _to_assoc_list t = [ _ring_ref, Int32.to_string t.ref; _event_channel, string_of_int t.event_channel; _protocol, Protocol.to_string t.protocol @@ -256,6 +256,7 @@ module Req = struct | Flush -> "Flush" | Op_reserved_1 -> "Op_reserved_1" | Trim -> "Trim" | Indirect_op -> "Indirect_op" + [@@@warning "-38"] exception Unknown_request_type of int (* Defined in include/xen/io/blkif.h BLKIF_MAX_SEGMENTS_PER_REQUEST *) @@ -288,7 +289,7 @@ module Req = struct segs: segs; } - let string_of t = + let _string_of t = Printf.sprintf "{ op=%s handle=%d id=%Ld sector=%Ld segs=%s (total %d) }" (match t.op with Some x -> string_of_op x | None -> "None") t.handle t.id t.sector (string_of_segs t.segs) t.nr_segs @@ -335,8 +336,14 @@ module Req = struct val get_hdr_indirect_op: Cstruct.t -> int val set_hdr_indirect_op: Cstruct.t -> int -> unit end - - module Marshalling(D: DIRECT)(I: INDIRECT) = struct + module type PROTOCOL_IMPLEMENTATION = sig + val total_size : int + val segments_per_indirect_page : int + val write_segments : seg array -> Cstruct.t -> unit + val write_request : t -> Cstruct.t -> int64 + val read_request : Cstruct.t -> t + end + module Marshalling(D: DIRECT)(I: INDIRECT) : PROTOCOL_IMPLEMENTATION = struct (* total size of a request structure, in bytes *) let total_size = D.sizeof_hdr + (sizeof_segment * segments_per_request) diff --git a/lib/blkproto.mli b/lib/blkproto.mli new file mode 100644 index 0000000..05f2b65 --- /dev/null +++ b/lib/blkproto.mli @@ -0,0 +1,122 @@ +val max_segments_per_request : int + +module FeatureIndirect : sig + type t = { max_indirect_segments : int } + + val _max_indirect_segments : string + + val to_assoc_list : t -> (string * string) list +end + +module State : sig + type t = | Initialising | InitWait | Initialised | Connected | Closing | Closed + val _state : string + val of_string : string -> t option + val to_assoc_list : t -> (string * string) list + val to_string : t -> string +end + +module Mode : sig + type t = ReadOnly | ReadWrite +end + +module Media : sig + type t = CDROM | Disk +end + +module DiskInfo : sig + type t = { + sector_size : int; + sectors : int64; + media : Media.t; + mode : Mode.t; + } + + val to_assoc_list : t -> (string * string) list +end + +module Hotplug : sig + val _hotplug_status : string + val _online : string +end + +module Connection : sig + type t = { + virtual_device: string; + backend_path: string; + backend_domid: int; + frontend_path: string; + frontend_domid: int; + mode: Mode.t; + media: Media.t; + removable: bool; + } + + val to_assoc_list : t -> (int * (string * string)) list +end + +module Req : sig + type seg = { + gref : int32; + first_sector : int; + last_sector : int; + } + + type segs = | Direct of seg array | Indirect of int32 array + + type op = | Read | Write | Write_barrier | Flush | Op_reserved_1 | Trim | Indirect_op + + val string_of_op : op -> string + + type t = { + op : op option; + handle : int; + id : int64; + sector : int64; + nr_segs : int; + segs : segs; + } + + val get_segments : Cstruct.t -> int -> seg array + + module type PROTOCOL_IMPLEMENTATION = sig + val total_size : int + val segments_per_indirect_page : int + val write_segments : seg array -> Cstruct.t -> unit + val write_request : t -> Cstruct.t -> int64 + val read_request : Cstruct.t -> t + end + + module Proto_32 : PROTOCOL_IMPLEMENTATION + module Proto_64 : PROTOCOL_IMPLEMENTATION + +end + +module Res : sig + type rsp = | OK | Error | Not_supported + + type t = { + op : Req.op option; + st : rsp option; + } + + val write_response : int64 * t -> Cstruct.t -> unit + + val read_response : Cstruct.t -> int64 * t +end + +module Protocol : sig + type t = X86_64 | X86_32 | Native +end + +module RingInfo : sig + type t = { + ref : int32; + event_channel : int; + protocol : Protocol.t; + } + + val keys : string list + val to_string : t -> string + val of_assoc_list : (string * string) list -> (t, [`Msg of string]) result +end From ea991a87b6f54bfdda09507af94e3483d445307b Mon Sep 17 00:00:00 2001 From: Mindy Date: Sat, 30 Mar 2019 12:03:22 -0500 Subject: [PATCH 3/3] remove several unused things --- lib/blkproto.ml | 59 ------------------------------------------------- 1 file changed, 59 deletions(-) diff --git a/lib/blkproto.ml b/lib/blkproto.ml index fb7a752..ac6285d 100644 --- a/lib/blkproto.ml +++ b/lib/blkproto.ml @@ -24,7 +24,6 @@ let list l k = else Ok (List.assoc k l) let int x = try Ok (int_of_string x) with _ -> Error (`Msg ("not an int: " ^ x)) let int32 x = try Ok (Int32.of_string x) with _ -> Error (`Msg ("not an int32: " ^ x)) -let int64 x = try Ok (Int64.of_string x) with _ -> Error (`Msg ("not an int64: " ^ x)) (* Control messages via xenstore *) @@ -33,14 +32,9 @@ module Mode = struct let to_string = function | ReadOnly -> "r" | ReadWrite -> "w" - let _of_string = function - | "r" -> Some ReadOnly - | "w" -> Some ReadWrite - | _ -> None let to_int = function | ReadOnly -> 4 (* VDISK_READONLY *) | ReadWrite -> 0 - let of_int x = if (x land 4) = 4 then ReadOnly else ReadWrite end module Media = struct @@ -48,14 +42,9 @@ module Media = struct let to_string = function | CDROM -> "cdrom" | Disk -> "disk" - let _of_string = function - | "cdrom" -> Some CDROM - | "disk" -> Some Disk - | _ -> None let to_int = function | CDROM -> 1 (* VDISK_CDROM *) | Disk -> 0 - let of_int x = if (x land 1) = 1 then CDROM else Disk end module State = struct @@ -72,17 +61,7 @@ module State = struct let to_string t = string_of_int (List.assoc t table' ) let of_string t = try Some (List.assoc (int_of_string t) table) with _ -> None - let of_int x = - if List.mem_assoc x table - then Ok (List.assoc x table) - else Error (`Msg (Printf.sprintf "unknown device state: %d" x)) - let _state = "state" - let _keys = [ _state ] - let _of_assoc_list l = - list l _state >>= fun x -> - int x >>= fun x -> - of_int x let to_assoc_list t = [ _state, string_of_int (List.assoc t table') ] @@ -153,13 +132,6 @@ module FeatureIndirect = struct then [] (* don't advertise the feature *) else [ _max_indirect_segments, string_of_int t.max_indirect_segments ] - let _of_assoc_list l = - if not(List.mem_assoc _max_indirect_segments l) - then Ok { max_indirect_segments = 0 } - else - let x = List.assoc _max_indirect_segments l in - int x >>= fun max_indirect_segments -> - Ok { max_indirect_segments } end module DiskInfo = struct @@ -180,16 +152,6 @@ module DiskInfo = struct _info, string_of_int (Media.to_int t.media lor (Mode.to_int t.mode)); ] - let _of_assoc_list l = - list l _sector_size >>= fun x -> int x - >>= fun sector_size -> - list l _sectors >>= fun x -> int64 x - >>= fun sectors -> - list l _info >>= fun x -> int x - >>= fun info -> - let media = Media.of_int info - and mode = Mode.of_int info in - Ok { sectors; sector_size; media; mode } end module RingInfo = struct @@ -213,12 +175,6 @@ module RingInfo = struct _protocol; ] - let _to_assoc_list t = [ - _ring_ref, Int32.to_string t.ref; - _event_channel, string_of_int t.event_channel; - _protocol, Protocol.to_string t.protocol - ] - let of_assoc_list l = list l _ring_ref >>= fun x -> int32 x >>= fun ref -> @@ -256,9 +212,6 @@ module Req = struct | Flush -> "Flush" | Op_reserved_1 -> "Op_reserved_1" | Trim -> "Trim" | Indirect_op -> "Indirect_op" - [@@@warning "-38"] - exception Unknown_request_type of int - (* Defined in include/xen/io/blkif.h BLKIF_MAX_SEGMENTS_PER_REQUEST *) let segments_per_request = 11 @@ -268,17 +221,10 @@ module Req = struct last_sector: int; } - let string_of_seg seg = - Printf.sprintf "{gref=%ld first=%d last=%d}" seg.gref seg.first_sector seg.last_sector - type segs = | Direct of seg array | Indirect of int32 array - let string_of_segs = function - | Direct segs -> Printf.sprintf "direct [ %s ]" (String.concat "; " (List.map string_of_seg (Array.to_list segs))) - | Indirect refs -> Printf.sprintf "indirect [ %s ]" (String.concat "; " (List.map Int32.to_string (Array.to_list refs))) - (* Defined in include/xen/io/blkif.h : blkif_request_t *) type t = { op: op option; @@ -289,11 +235,6 @@ module Req = struct segs: segs; } - let _string_of t = - Printf.sprintf "{ op=%s handle=%d id=%Ld sector=%Ld segs=%s (total %d) }" - (match t.op with Some x -> string_of_op x | None -> "None") - t.handle t.id t.sector (string_of_segs t.segs) t.nr_segs - (* The segment looks the same in both 32-bit and 64-bit versions *) [%%cstruct type segment = {