maintenance: add interface files for vhd-tool (#6052)

This detects some unused bindings and a mutable field. Chunked got also
documented and changed the interface to make it more understandable to
use.

ocaml/vhd-tool/cli/dune

@@ -3,7 +3,7 @@
   (names main sparse_dd get_vhd_vsize)
   (libraries
     astring
-    
+
     local_lib
     cmdliner
     cstruct
@@ -19,6 +19,7 @@
     xapi-idl
     xapi-log
     xenstore_transport.unix
+    ezxenstore
   )
 )
 

ocaml/vhd-tool/cli/sparse_dd.ml

@@ -175,15 +175,15 @@ module Progress = struct
       let s = Printf.sprintf "Progress: %.0f" (fraction *. 100.) in
       let data = Cstruct.create (String.length s) in
       Cstruct.blit_from_string s 0 data 0 (String.length s) ;
-      Chunked.marshal header {Chunked.offset= 0L; data} ;
+      Chunked.(marshal header (make ~sector:0L data)) ;
       Printf.printf "%s%s%!" (Cstruct.to_string header) s
     )
 
   (** Emit the end-of-stream message *)
   let close () =
     if !machine_readable_progress then (
       let header = Cstruct.create Chunked.sizeof in
-      Chunked.marshal header {Chunked.offset= 0L; data= Cstruct.create 0} ;
+      Chunked.(marshal header end_of_stream) ;
       Printf.printf "%s%!" (Cstruct.to_string header)
     )
 end
@@ -198,7 +198,7 @@ let after f g =
     the driver domain corresponding to the frontend device [path] in this domain. *)
 let find_backend_device path =
   try
-    let open Xenstore in
+    let open Ezxenstore_core.Xenstore in
     (* If we're looking at a xen frontend device, see if the backend
        is in the same domain. If so check if it looks like a .vhd *)
     let rdev = (Unix.LargeFile.stat path).Unix.LargeFile.st_rdev in

ocaml/vhd-tool/src/channels.mli

@@ -0,0 +1,35 @@
+(* Copyright (C) Cloud Software Group Inc.
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; version 2.1 only. with the special
+   exception on linking described in file LICENSE.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+*)
+
+type t = {
+    really_read: Cstruct.t -> unit Lwt.t
+  ; really_write: Cstruct.t -> unit Lwt.t
+  ; offset: int64 ref
+  ; skip: int64 -> unit Lwt.t
+  ; copy_from: Lwt_unix.file_descr -> int64 -> int64 Lwt.t
+  ; close: unit -> unit Lwt.t
+}
+
+exception Impossible_to_seek
+
+val of_raw_fd : Lwt_unix.file_descr -> t Lwt.t
+
+val of_seekable_fd : Lwt_unix.file_descr -> t Lwt.t
+
+type verification_config = {
+    sni: string option
+  ; verify: Ssl.verify_mode
+  ; cert_bundle_path: string
+}
+
+val of_ssl_fd :
+  Lwt_unix.file_descr -> string option -> verification_config option -> t Lwt.t

ocaml/vhd-tool/src/chunked.ml

@@ -18,15 +18,17 @@ let sizeof = sizeof_t
 
 type t = {
     offset: int64  (** offset on the physical disk *)
-  ; data: Cstruct.t  (** data to write *)
+  ; len: int32  (** how much data to write *)
 }
 
-let marshal (buf : Cstruct.t) t =
-  set_t_offset buf t.offset ;
-  set_t_len buf (Int32.of_int (Cstruct.length t.data))
+let end_of_stream = {offset= 0L; len= 0l}
 
-let is_last_chunk (buf : Cstruct.t) =
-  get_t_offset buf = 0L && get_t_len buf = 0l
+let make ~sector ?(size = 512L) data =
+  {offset= Int64.mul sector size; len= Int32.of_int (Cstruct.length data)}
+
+let marshal buf t = set_t_offset buf t.offset ; set_t_len buf t.len
+
+let is_last_chunk buf = get_t_offset buf = 0L && get_t_len buf = 0l
 
 let get_offset = get_t_offset
 

ocaml/vhd-tool/src/chunked.mli

@@ -0,0 +1,40 @@
+(* Copyright (C) Cloud Software Group Inc.
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; version 2.1 only. with the special
+   exception on linking described in file LICENSE.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+*)
+
+val sizeof : int
+
+(** [t] is the metadata of a chunk of disk that's meant to be streamed. These
+    are used in a protocol that interleaves the metadata and the data until an
+    empty metadata block is sent, which signals the end of the stream. *)
+type t
+
+val end_of_stream : t
+(** [end_of_stream] is the value that signals the end of the stream of chunks
+    being transferred. *)
+
+val make : sector:int64 -> ?size:int64 -> Cstruct.t -> t
+(** [make ~sector ?size data] creates a chunk of disk that needs to be
+    transferred, starting at the sector [sector]. [size] is the sector size, in
+    bytes. The default is 512. *)
+
+val marshal : Cstruct.t -> t -> unit
+(** [marshall buffer chunk] writes the metadata of [chunk] to [buffer]. When
+    transferring a whole disk, this is called a header and is written before
+    the data. *)
+
+val is_last_chunk : Cstruct.t -> bool
+(** [is_last_chunk buffer] returns whether the current [buffer] is
+    {end_of_stream} *)
+
+val get_offset : Cstruct.t -> int64
+
+val get_len : Cstruct.t -> int32

ocaml/vhd-tool/src/dune

@@ -12,7 +12,6 @@
     cohttp
     cohttp-lwt
     cstruct
-    (re_export ezxenstore)
     io-page
     lwt
     lwt.unix
@@ -27,17 +26,13 @@
     ssl
     tar
     uri
+    uuidm
     vhd-format
     vhd-format-lwt
     tapctl
     xapi-stdext-std
     xapi-stdext-unix
     xen-api-client-lwt
-    xenstore
-    xenstore.client
-    xenstore.unix
-    xenstore_transport
-    xenstore_transport.unix
   )
   (preprocess
     (per_module

ocaml/vhd-tool/src/impl.ml

@@ -42,12 +42,6 @@ end)
 
 open F
 
-(*
-open Vhd
-open Vhd_format_lwt
-*)
-let vhd_search_path = "/dev/mapper"
-
 let require name arg =
   match arg with
   | None ->
@@ -304,7 +298,7 @@ let stream_chunked _common c s prezeroed _ ?(progress = no_progress_bar) () =
     (fun (sector, work_done) x ->
       ( match x with
       | `Sectors data ->
-          let t = {Chunked.offset= Int64.(mul sector 512L); data} in
+          let t = Chunked.make ~sector ~size:512L data in
           Chunked.marshal header t ;
           c.Channels.really_write header >>= fun () ->
           c.Channels.really_write data >>= fun () ->
@@ -332,7 +326,7 @@ let stream_chunked _common c s prezeroed _ ?(progress = no_progress_bar) () =
   p total_work ;
 
   (* Send the end-of-stream marker *)
-  Chunked.marshal header {Chunked.offset= 0L; data= Cstruct.create 0} ;
+  Chunked.(marshal header end_of_stream) ;
   c.Channels.really_write header >>= fun () -> return (Some total_work)
 
 let stream_raw _common c s prezeroed _ ?(progress = no_progress_bar) () =
@@ -398,16 +392,9 @@ module TarStream = struct
     ; nr_bytes_remaining: int
     ; (* start at 0 *)
       next_counter: int
-    ; mutable header: Tar.Header.t option
+    ; header: Tar.Header.t option
   }
 
-  let to_string t =
-    Printf.sprintf
-      "work_done = %Ld; nr_bytes_remaining = %d; next_counter = %d; filename = \
-       %s"
-      t.work_done t.nr_bytes_remaining t.next_counter
-      (match t.header with None -> "None" | Some h -> h.Tar.Header.file_name)
-
   let initial total_size =
     {
       work_done= 0L

ocaml/vhd-tool/src/impl.mli

@@ -0,0 +1,75 @@
+(* Copyright (C) Cloud Software Group Inc.
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; version 2.1 only. with the special
+   exception on linking described in file LICENSE.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+*)
+
+module F : module type of Vhd_format.F.From_file (Vhd_format_lwt.IO)
+
+val get :
+     'a
+  -> string option
+  -> string option
+  -> [> `Error of bool * string | `Ok of unit]
+
+val info : 'a -> string option -> [> `Error of bool * string | `Ok of unit]
+
+val contents : 'a -> string option -> [> `Error of bool * string | `Ok of unit]
+
+val create :
+     Common.t
+  -> string option
+  -> string option
+  -> string option
+  -> [> `Error of bool * string | `Ok of unit]
+
+val check :
+  Common.t -> string option -> [> `Error of bool * string | `Ok of unit]
+
+val stream :
+  Common.t -> StreamCommon.t -> [> `Error of bool * string | `Ok of unit]
+
+val serve :
+     Common.t
+  -> string
+  -> int option
+  -> string
+  -> string option
+  -> string
+  -> int option
+  -> string
+  -> int64 option
+  -> bool
+  -> bool
+  -> bool
+  -> string option
+  -> bool
+  -> [> `Error of bool * string | `Ok of unit]
+
+(** Functions used by sparse_dd *)
+
+val make_stream :
+     Common.t
+  -> string
+  -> string option
+  -> string
+  -> string
+  -> Vhd_format_lwt.IO.fd Nbd_input.F.stream Lwt.t
+
+val write_stream :
+     Common.t
+  -> Vhd_format_lwt.IO.fd F.stream
+  -> string
+  -> StreamCommon.protocol option
+  -> bool
+  -> (int64 -> int64 -> unit)
+  -> string option
+  -> string option
+  -> Channels.verification_config option
+  -> unit Lwt.t

ocaml/vhd-tool/src/input.mli

@@ -0,0 +1,19 @@
+(* Copyright (C) Cloud Software Group Inc.
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; version 2.1 only. with the special
+   exception on linking described in file LICENSE.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+*)
+
+type 'a t = 'a Lwt.t
+
+type fd = {fd: Lwt_unix.file_descr; mutable offset: int64}
+
+include Vhd_format.S.INPUT with type 'a t := 'a t with type fd := fd
+
+val of_fd : Lwt_unix.file_descr -> fd

ocaml/vhd-tool/src/nbd_input.mli

@@ -0,0 +1,24 @@
+(* Copyright (C) Cloud Software Group Inc.
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; version 2.1 only. with the special
+   exception on linking described in file LICENSE.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+*)
+
+module F : module type of Vhd_format.F.From_file (Vhd_format_lwt.IO)
+
+val raw :
+  ?extent_reader:string -> 'a -> string -> string -> int64 -> 'a F.stream Lwt.t
+
+val vhd :
+     ?extent_reader:string
+  -> Vhd_format_lwt.IO.fd Vhd_format.F.Raw.t
+  -> string
+  -> string
+  -> int64
+  -> Vhd_format_lwt.IO.fd F.stream Lwt.t

quality-gate.sh

@@ -25,7 +25,7 @@ verify-cert () {
 }
 
 mli-files () {
-  N=505
+  N=499
   # do not count ml files from the tests in ocaml/{tests/perftest/quicktest}
   MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
   MLS=$(git  ls-files -- '**/*.ml'  | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)