|
| 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 | +module D = Debug.Make (struct let name = "qcow_tool_wrapper" end) |
| 16 | + |
| 17 | +open D |
| 18 | + |
| 19 | +let unimplemented () = |
| 20 | + raise |
| 21 | + (Api_errors.Server_error (Api_errors.unimplemented_in_qcow_tool_wrapper, [])) |
| 22 | + |
| 23 | +let run_qcow_tool (progress_cb : int -> unit) (args : string list) |
| 24 | + (ufd : Unix.file_descr) = |
| 25 | + let qcow_tool = !Xapi_globs.qcow_tool in |
| 26 | + info "Executing %s %s" qcow_tool (String.concat " " args) ; |
| 27 | + let open Forkhelpers in |
| 28 | + let pipe_read, pipe_write = Unix.pipe () in |
| 29 | + Xapi_stdext_pervasives.Pervasiveext.finally |
| 30 | + (fun () -> |
| 31 | + match |
| 32 | + with_logfile_fd "qcow-tool" (fun log_fd -> |
| 33 | + let ufd_str = Uuidx.(to_string (make ())) in |
| 34 | + let pid = |
| 35 | + safe_close_and_exec None (Some pipe_write) (Some log_fd) |
| 36 | + [(ufd_str, ufd)] |
| 37 | + qcow_tool args |
| 38 | + in |
| 39 | + let _, status = waitpid pid in |
| 40 | + if status <> Unix.WEXITED 0 then ( |
| 41 | + error "qcow-tool failed, returning VDI_IO_ERROR" ; |
| 42 | + raise |
| 43 | + (Api_errors.Server_error |
| 44 | + (Api_errors.vdi_io_error, ["Device I/O errors"]) |
| 45 | + ) |
| 46 | + ) |
| 47 | + ) |
| 48 | + with |
| 49 | + | Success (out, _) -> |
| 50 | + debug "%s" out |
| 51 | + | Failure (out, e) -> |
| 52 | + error "qcow-tool output: %s" out ; |
| 53 | + raise e |
| 54 | + ) |
| 55 | + (fun () -> List.iter Unix.close [pipe_read; pipe_write]) |
| 56 | + |
| 57 | +let update_task_progress (__context : Context.t) (x : int) = |
| 58 | + TaskHelper.set_progress ~__context (float_of_int x /. 100.) |
| 59 | + |
| 60 | +let send (progress_cb : int -> unit) (unix_fd : Unix.file_descr) (path : string) |
| 61 | + (size : Int64.t) = |
| 62 | + 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 |
0 commit comments