[Libguestfs] [PATCH 2/2] builder: Choose better weights in the planner.

--- 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