[Libguestfs] [PATCH 2/2] builder: Choose better weights in the planner.
Richard W.M. Jones
rjones at redhat.com
Mon Oct 2 21:43:55 UTC 2017
---
builder/builder.ml | 89 ++++++++++++++++++++++++++++++++++---------
common/mlutils/unix_utils.ml | 4 ++
common/mlutils/unix_utils.mli | 6 +++
3 files changed, 80 insertions(+), 19 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index d8e625f68..5499a4b10 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -414,12 +414,64 @@ let main () =
let is_not t = not (is t) in
let remove = List.remove_assoc in
let ret = ref [] in
- let tr task weight otags = push_front (task, weight, otags) ret in
- (* XXX Weights are not very smartly chosen. At the moment I'm
- * using a range [0..100] where 0 = free and 100 = expensive. We
- * could estimate weights better by looking at file sizes.
+ (* The scheme for weights ranges from 0 = free to 100 = most expensive:
+ * 0 = free operations like renaming a file in the same directory
+ * 10 = in-place conversions (like [qemu-img resize])
+ * 20 = copy or move a file between two local filesystems
+ * 30 = copy and convert a file between two local filesystems
+ * 40 = copy a file within the same local filesystem
+ * 50 = copy and convert a file within the same local filesystem
+ * 80 = copy, move, convert if source or target is on remote filesystem
+ * 100 = complex operations like virt-resize
+ * We could estimate weights better by looking at file sizes.
*)
+ let weight task otags =
+ let infile = List.assoc `Filename itags
+ and outfile = List.assoc `Filename otags in
+
+ (* Get the lstat and statvfs of a file. If the file doesn't
+ * exist, get them from the containing directory.
+ *)
+ let stats path =
+ let path =
+ if Sys.file_exists path then path else Filename.dirname path in
+ lstat path, StatVFS.statvfs path
+ (* When calculating weight, is the filesystem remote? *)
+ and is_remote (_, { StatVFS.f_type = ft }) =
+ ft = StatVFS.cifs_magic_number || ft = StatVFS.nfs_super_magic
+ || ft = StatVFS.smb_super_magic
+ (* When calculating weight, are two files on the same filesystem? *)
+ and same_filesystem ({st_dev = d1}, _) ({st_dev = d2}, _) = d1 = d2
+ in
+
+ match task with
+ | `Virt_resize -> 100 (* virt-resize is a special case*)
+ | (`Copy|`Move|`Pxzcat|`Disk_resize|`Convert) as task ->
+ let inst = stats infile in
+ let outst = stats outfile in
+ if is_remote inst || is_remote outst then 80 (* NFS etc. *)
+ else (
+ (* Copies and moves across different local filesystems. The
+ * theory is this is less expensive than moving within
+ * filesystems because less bandwith is available (except in
+ * the special case of moving within a filesystem which is
+ * free).
+ *)
+ let across = not (same_filesystem inst outst) in
+ match task, across with
+ | `Move, false -> 0 (* rename in same filesystem *)
+ | `Disk_resize, _ -> 10 (* in-place conversion *)
+ | `Move, true -> 20 (* move between two filesystems *)
+ | `Copy, true -> 20 (* copy between two filesystems *)
+ | (`Pxzcat|`Convert), true -> 30 (* convert between two local fses*)
+ | `Copy, false -> 40 (* copy within same filesystem *)
+ | (`Pxzcat|`Convert), false -> 50 (* convert with same local fs*)
+ )
+ in
+
+ (* Add a transition to the returned list. *)
+ let tr task otags = push_front (task, weight task otags, otags) ret in
(* Since the final plan won't run in parallel, we don't only need
* to choose unique tempfiles per transition, so this is OK:
@@ -431,17 +483,16 @@ let main () =
* thing a copy does is to remove the template tag (since it's always
* copied out of the cache directory).
*)
- tr `Copy 50 ((`Filename, output_filename) :: remove `Template itags);
- tr `Copy 50 ((`Filename, tempfile) :: remove `Template itags);
+ tr `Copy ((`Filename, output_filename) :: remove `Template itags);
+ tr `Copy ((`Filename, tempfile) :: remove `Template itags);
(* We can rename a file instead of copying, but don't rename the
- * cache copy! (XXX Also this is not free if copying across
- * filesystems)
+ * cache copy!
*)
if is_not `Template then (
if not output_is_block_dev then
- tr `Rename 0 ((`Filename, output_filename) :: itags);
- tr `Rename 0 ((`Filename, tempfile) :: itags);
+ tr `Move ((`Filename, output_filename) :: itags);
+ tr `Move ((`Filename, tempfile) :: itags)
);
if is `XZ then (
@@ -449,9 +500,9 @@ let main () =
* to the output file or to a temp file.
*)
if not output_is_block_dev then
- tr `Pxzcat 80
+ tr `Pxzcat
((`Filename, output_filename) :: remove `XZ (remove `Template itags));
- tr `Pxzcat 80
+ tr `Pxzcat
((`Filename, tempfile) :: remove `XZ (remove `Template itags));
)
else (
@@ -462,11 +513,11 @@ let main () =
let old_size = Int64.of_string (List.assoc `Size itags) in
let headroom = 256L *^ 1024L *^ 1024L in
if output_size >= old_size +^ headroom then (
- tr `Virt_resize 100
+ tr `Virt_resize
((`Size, Int64.to_string output_size) ::
(`Filename, output_filename) ::
(`Format, output_format) :: (remove `Template itags));
- tr `Virt_resize 100
+ tr `Virt_resize
((`Size, Int64.to_string output_size) ::
(`Filename, tempfile) ::
(`Format, output_format) :: (remove `Template itags))
@@ -485,15 +536,15 @@ let main () =
*)
else if output_size > old_size && is_not `Template
&& List.mem_assoc `Format itags then
- tr `Disk_resize 60 ((`Size, Int64.to_string output_size) :: itags);
+ tr `Disk_resize ((`Size, Int64.to_string output_size) :: itags);
(* qemu-img convert is always possible, and quicker. It doesn't
* resize, but it does change the format.
*)
- tr `Convert 60
+ tr `Convert
((`Filename, output_filename) :: (`Format, output_format) ::
(remove `Template itags));
- tr `Convert 60
+ tr `Convert
((`Filename, tempfile) :: (`Format, output_format) ::
(remove `Template itags));
);
@@ -528,7 +579,7 @@ let main () =
in
let print_task = function
| `Copy -> printf "cp"
- | `Rename -> printf "mv"
+ | `Move -> printf "mv"
| `Pxzcat -> printf "pxzcat"
| `Virt_resize -> printf "virt-resize"
| `Disk_resize -> printf "qemu-img resize"
@@ -570,7 +621,7 @@ let main () =
let cmd = [ "cp"; ifile; ofile ] in
if run_command cmd <> 0 then exit 1
- | itags, `Rename, otags ->
+ | itags, `Move, otags ->
let ifile = List.assoc `Filename itags in
let ofile = List.assoc `Filename otags in
let cmd = [ "mv"; ifile; ofile ] in
diff --git a/common/mlutils/unix_utils.ml b/common/mlutils/unix_utils.ml
index 3eb3ac890..ef51a7aa2 100644
--- a/common/mlutils/unix_utils.ml
+++ b/common/mlutils/unix_utils.ml
@@ -80,5 +80,9 @@ module StatVFS = struct
external statvfs : string -> statvfs =
"guestfs_int_mllib_statvfs_statvfs"
+ let cifs_magic_number = 0xff534d42_L
+ let nfs_super_magic = 0x6969_L
+ let smb_super_magic = 0x517b_L
+
let free_space { f_bsize = bsize; f_bavail = bavail } = bsize *^ bavail
end
diff --git a/common/mlutils/unix_utils.mli b/common/mlutils/unix_utils.mli
index 385791cac..50affb4ae 100644
--- a/common/mlutils/unix_utils.mli
+++ b/common/mlutils/unix_utils.mli
@@ -116,6 +116,12 @@ module StatVFS : sig
In case of non-Linux or non-POSIX, this call is emulated as best
we can with missing fields returned as [-1]. *)
+ val cifs_magic_number : int64
+ val nfs_super_magic : int64
+ val smb_super_magic : int64
+ (** Magic numbers from some filesystems that might be found in the
+ [f_type] field. See also [statfs(2)]. *)
+
val free_space : statvfs -> int64
(** [free_space (statvfs path)] returns the free space available on the
filesystem that contains [path], in bytes. *)
--
2.13.2
More information about the Libguestfs
mailing list