Skip to content

Commit d77adf5

Browse files
gthvn1gthvn1
committed
[qcow-tool] [WIP] implement streaming
Signed-off-by: Guillaume <[email protected]>
1 parent 15f0f6e commit d77adf5

File tree

6 files changed

+123
-43
lines changed

6 files changed

+123
-43
lines changed

‎ocaml/qcow-tool/cli/impl.ml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -844,3 +844,7 @@ let rehydrate _common input_filename output_filename =
844844
>>= fun () -> Lwt.return (`Ok ())
845845
in
846846
Lwt_main.run t
847+
848+
let stream _common source output =
849+
failwith
850+
(Printf.sprintf "streaming from %s to %s is not implemented" source output)

‎ocaml/qcow-tool/cli/main.ml

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -457,6 +457,25 @@ let rehydrate_cmd =
457457
, Cmd.info "rehydrate" ~sdocs:_common_options ~doc ~man
458458
)
459459

460+
let stream_cmd =
461+
let doc = "stream the contents of a virtual disk" in
462+
let man =
463+
[
464+
`S "DESCRIPTION"
465+
; `P
466+
"Read the contents of a virtual disk from a source and write it to\n\
467+
\ a destination that is a qcow2 file."
468+
]
469+
@ help
470+
in
471+
let source =
472+
let doc = Printf.sprintf "The disk to be streamed" in
473+
Arg.(value & opt string "stdin:" & info ["source"] ~doc)
474+
in
475+
( Term.(ret (const Impl.stream $ common_options_t $ source $ output))
476+
, Cmd.info "stream" ~sdocs:_common_options ~doc ~man
477+
)
478+
460479
let cmds =
461480
[
462481
info_cmd
@@ -475,6 +494,7 @@ let cmds =
475494
; sha_cmd
476495
; dehydrate_cmd
477496
; rehydrate_cmd
497+
; stream_cmd
478498
]
479499
|> List.map (fun (t, i) -> Cmd.v i t)
480500

‎ocaml/xapi/common_tool_wrapper.ml

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
(*
2+
* Copyright (C) 2025 Vates.
3+
*
4+
* This program is free software; you can redistribute it and/or modify
5+
* it under the terms of the GNU Lesser General Public License as published
6+
* by the Free Software Foundation; version 2.1 only. with the special
7+
* exception on linking described in file LICENSE.
8+
*
9+
* This program is distributed in the hope that it will be useful,
10+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
11+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+
* GNU Lesser General Public License for more details.
13+
*)
14+
15+
open Xapi_stdext_std.Xstringext
16+
17+
(** [find_backend_device path] returns [Some path'] where [path'] is the backend path in
18+
the driver domain corresponding to the frontend device [path] in this domain. *)
19+
let find_backend_device path =
20+
try
21+
let open Ezxenstore_core.Xenstore in
22+
(* If we're looking at a xen frontend device, see if the backend
23+
is in the same domain. If so check if it looks like a .vhd *)
24+
let rdev = (Unix.stat path).Unix.st_rdev in
25+
let major = rdev / 256 and minor = rdev mod 256 in
26+
let link =
27+
Unix.readlink (Printf.sprintf "/sys/dev/block/%d:%d/device" major minor)
28+
in
29+
match List.rev (String.split '/' link) with
30+
| id :: "xen" :: "devices" :: _
31+
when Astring.String.is_prefix ~affix:"vbd-" id ->
32+
let id = int_of_string (String.sub id 4 (String.length id - 4)) in
33+
with_xs (fun xs ->
34+
let self = xs.Xs.read "domid" in
35+
let backend =
36+
xs.Xs.read (Printf.sprintf "device/vbd/%d/backend" id)
37+
in
38+
let params = xs.Xs.read (Printf.sprintf "%s/params" backend) in
39+
match String.split '/' backend with
40+
| "local" :: "domain" :: bedomid :: _ ->
41+
if not (self = bedomid) then
42+
raise
43+
Api_errors.(
44+
Server_error
45+
( internal_error
46+
, [
47+
Printf.sprintf
48+
"find_backend_device: Got domid %s but expected \
49+
%s"
50+
bedomid self
51+
]
52+
)
53+
) ;
54+
Some params
55+
| _ ->
56+
raise Not_found
57+
)
58+
| _ ->
59+
raise Not_found
60+
with _ -> None

‎ocaml/xapi/import_raw_vdi.ml

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -163,7 +163,6 @@ let localhost_handler rpc session_id vdi_opt (req : Request.t)
163163
not
164164
(Sm_fs_ops.must_write_zeroes_into_new_vdi ~__context vdi)
165165
in
166-
debug "GTNDEBUG: we are receiving Raw, Vhd or Qcow file" ;
167166
Sm_fs_ops.with_block_attached_device __context rpc
168167
session_id vdi `RW (fun path ->
169168
if chunked then

‎ocaml/xapi/qcow_tool_wrapper.ml

Lines changed: 31 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -57,9 +57,37 @@ let run_qcow_tool (progress_cb : int -> unit) (args : string list)
5757
let update_task_progress (__context : Context.t) (x : int) =
5858
TaskHelper.set_progress ~__context (float_of_int x /. 100.)
5959

60+
let qcow_of_device path =
61+
let tapdisk_of_path path =
62+
try
63+
match Tapctl.of_device (Tapctl.create ()) path with
64+
| _, str, Some (_, qcow) ->
65+
debug "Found str %s and file %s" str qcow ;
66+
Some qcow
67+
| _ ->
68+
None
69+
with Not_found ->
70+
debug "Device %s has an unknown driver" path ;
71+
None
72+
in
73+
Common_tool_wrapper.find_backend_device path
74+
|> Option.value ~default:path
75+
|> tapdisk_of_path
76+
6077
let send (progress_cb : int -> unit) (unix_fd : Unix.file_descr) (path : string)
6178
(size : Int64.t) =
6279
debug "Qcow send called with a size of %Ld and path equal to %s" size path ;
63-
let _ = progress_cb in
64-
let _ = unix_fd in
65-
run_qcow_tool progress_cb ["stream"] unix_fd
80+
let _, source =
81+
match (Stream_vdi.get_nbd_device path, qcow_of_device path) with
82+
| Some (nbd_path, exportname), Some p ->
83+
debug "get_nbd_device (path=%s, exportname=%s), p = %s" nbd_path
84+
exportname p ;
85+
(nbd_path, exportname)
86+
| None, Some p ->
87+
debug "nbd device not found but p = %s" p ;
88+
("gtn_no_nbd", p)
89+
| _ ->
90+
("gtn_unknown", "gtn_unknown")
91+
in
92+
let args = ["stream"; "--source"; source; path] in
93+
run_qcow_tool progress_cb args unix_fd

‎ocaml/xapi/vhd_tool_wrapper.ml

Lines changed: 8 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -113,42 +113,6 @@ let receive progress_cb format protocol (s : Unix.file_descr)
113113
in
114114
run_vhd_tool progress_cb args s s' path
115115

116-
(** [find_backend_device path] returns [Some path'] where [path'] is the backend path in
117-
the driver domain corresponding to the frontend device [path] in this domain. *)
118-
let find_backend_device path =
119-
try
120-
let open Ezxenstore_core.Xenstore in
121-
(* If we're looking at a xen frontend device, see if the backend
122-
is in the same domain. If so check if it looks like a .vhd *)
123-
let rdev = (Unix.stat path).Unix.st_rdev in
124-
let major = rdev / 256 and minor = rdev mod 256 in
125-
let link =
126-
Unix.readlink (Printf.sprintf "/sys/dev/block/%d:%d/device" major minor)
127-
in
128-
match List.rev (String.split '/' link) with
129-
| id :: "xen" :: "devices" :: _
130-
when Astring.String.is_prefix ~affix:"vbd-" id ->
131-
let id = int_of_string (String.sub id 4 (String.length id - 4)) in
132-
with_xs (fun xs ->
133-
let self = xs.Xs.read "domid" in
134-
let backend =
135-
xs.Xs.read (Printf.sprintf "device/vbd/%d/backend" id)
136-
in
137-
let params = xs.Xs.read (Printf.sprintf "%s/params" backend) in
138-
match String.split '/' backend with
139-
| "local" :: "domain" :: bedomid :: _ ->
140-
if not (self = bedomid) then
141-
Helpers.internal_error
142-
"find_backend_device: Got domid %s but expected %s" bedomid
143-
self ;
144-
Some params
145-
| _ ->
146-
raise Not_found
147-
)
148-
| _ ->
149-
raise Not_found
150-
with _ -> None
151-
152116
(** [vhd_of_device path] returns (Some vhd) where 'vhd' is the vhd leaf backing a particular device [path] or None.
153117
[path] may either be a blktap2 device *or* a blkfront device backed by a blktap2 device. If the latter then
154118
the script must be run in the same domain as blkback. *)
@@ -178,22 +142,27 @@ let vhd_of_device path =
178142
debug "Device %s has an unknown driver" path ;
179143
None
180144
in
181-
find_backend_device path |> Option.value ~default:path |> tapdisk_of_path
145+
Common_tool_wrapper.find_backend_device path
146+
|> Option.value ~default:path
147+
|> tapdisk_of_path
182148

183149
let send progress_cb ?relative_to (protocol : string) (dest_format : string)
184150
(s : Unix.file_descr) (path : string) (size : Int64.t) (prefix : string) =
185151
let s' = Uuidx.(to_string (make ())) in
152+
debug "GTNDEBUG: path is %s" path ;
153+
debug "GTNDEBUG: prefix is %s" prefix ;
186154
let source_format, source =
187-
debug "GTNDEBUG: get_nbd_device %s" path ;
188-
debug "GTNDEBUG: s' is %s" s' ;
189155
match (Stream_vdi.get_nbd_device path, vhd_of_device path, relative_to) with
190156
| Some (nbd_server, exportname), _, None ->
157+
debug "GTNDEBUG: nbdhybrid %s:%s:%s:%Ld" path nbd_server exportname size ;
191158
( "nbdhybrid"
192159
, Printf.sprintf "%s:%s:%s:%Ld" path nbd_server exportname size
193160
)
194161
| Some _, Some vhd, Some _ | None, Some vhd, _ ->
162+
debug "GTNDEBUG: hybrid %s" (path ^ ":" ^ vhd) ;
195163
("hybrid", path ^ ":" ^ vhd)
196164
| None, None, None ->
165+
debug "GTNDEBUG: raw %s" path ;
197166
("raw", path)
198167
| _, None, Some _ ->
199168
let msg = "Cannot compute differences on non-VHD images" in

0 commit comments

Comments
 (0)