Libguestfs - Feb 2022 - [libguestfs-common PATCH 1/3] Demote "Std_utils.wrap" to an internal function in Tools_utils

https://bugzilla.redhat.com/show_bug.cgi?id=1820221

The first patch turns "Std_utils.wrap" into an internal (not public)
function in "Tools_utils". This is doable after guestfs-tools commit
626f0441d251 ("virt-resize: replace "wrap" calls with calls to
"info"",
2022-02-10).

The second patch causes "Tools_utils.wrap" not to wrap if the output
is
going to a file descriptor that does not refer to a TTY.

The third patch introduces the "-w" / "--wrap" option, for
forcing the
previous behavior (making a difference only on non-TTYs). This follows
the "--colours" option's example, and if accepted, will require
documentation updates in guestfs-tools and virt-v2v.

Thanks,
Laszlo

Laszlo Ersek (3):
  Demote "Std_utils.wrap" to an internal function in Tools_utils
  Tools_utils.wrap: only wrap text for TTYs
  add common ("standard") option -w / --wrap

 mlstdutils/std_utils.ml  | 44 +++++++---------------------------------
 mlstdutils/std_utils.mli |  9 ++++----
 mltools/test-getopt.sh   |  2 ++
 mltools/tools_utils.ml   | 41 +++++++++++++++++++++++++++++++++++++
 4 files changed, 54 insertions(+), 42 deletions(-)


base-commit: 5b5fac3e0b10ff4c5fd28eaa5f17ba0c163dc49b
-- 
2.19.1.3.g30247aa5d201

At this point, no client project of the libguestfs-common submodule should
be using "Std_utils.wrap", so we can remove its public declaration,
and
make it an internal function in the module (Tools_utils) where its callers
are ("error", "warning", and "info").

Note: the "output_spaces" function is not moved; in addition to being
called by "wrap", it is also called by virt-v2v, from commit
b4afcf1dac35
("v2v: Implement -i vmx to read VMware vmx files directly
(RHBZ#1441197).", 2017-04-11). "output_spaces" is generally
useful for
formatting indented (not wrapped) debug output.

Bugzilla: https://bugzilla.redhat.com/show_bug.cgi?id=1820221
Suggested-by: Richard W.M. Jones <rjones at redhat.com>
Signed-off-by: Laszlo Ersek <lersek at redhat.com>
---
 mlstdutils/std_utils.mli |  3 ---
 mlstdutils/std_utils.ml  | 36 +-----------------------------------
 mltools/tools_utils.ml   | 35 +++++++++++++++++++++++++++++++++++
 3 files changed, 36 insertions(+), 38 deletions(-)

diff --git a/mlstdutils/std_utils.mli b/mlstdutils/std_utils.mli
index 8b6bcd1dd7ae..534caa80d6a7 100644
--- a/mlstdutils/std_utils.mli
+++ b/mlstdutils/std_utils.mli
@@ -315,9 +315,6 @@ val be64_of_int : int64 -> string
     On the OCaml side, 64 bit integers are always used so that you
     can use the [.^] operators on them for bit manipulation. *)
 
-val wrap : ?chan:out_channel -> ?indent:int -> string -> unit
-(** Wrap text. *)
-
 val output_spaces : out_channel -> int -> unit
 (** Write [n] spaces to [out_channel]. *)
 
diff --git a/mlstdutils/std_utils.ml b/mlstdutils/std_utils.ml
index 29add4a027bc..58ac058c1b3a 100644
--- a/mlstdutils/std_utils.ml
+++ b/mlstdutils/std_utils.ml
@@ -536,41 +536,7 @@ let be64_of_int i    Bytes.unsafe_set b 7 (Char.unsafe_chr
(Int64.to_int c0));
   Bytes.to_string b
 
-type wrap_break_t = WrapEOS | WrapSpace | WrapNL
-
-let rec wrap ?(chan = stdout) ?(indent = 0) str -  let len = String.length str
in
-  _wrap chan indent 0 0 len str
-
-and _wrap chan indent column i len str -  if i < len then (
-    let (j, break) = _wrap_find_next_break i len str in
-    let next_column -      if column + (j-i) >= 76 then (
-        output_char chan '\n';
-        output_spaces chan indent;
-        indent + (j-i) + 1
-      )
-      else column + (j-i) + 1 in
-    output chan (Bytes.of_string str) i (j-i);
-    match break with
-    | WrapEOS -> ()
-    | WrapSpace ->
-      output_char chan ' ';
-      _wrap chan indent next_column (j+1) len str
-    | WrapNL ->
-      output_char chan '\n';
-      output_spaces chan indent;
-      _wrap chan indent indent (j+1) len str
-  )
-
-and _wrap_find_next_break i len str -  if i >= len then (len, WrapEOS)
-  else if String.unsafe_get str i = ' ' then (i, WrapSpace)
-  else if String.unsafe_get str i = '\n' then (i, WrapNL)
-  else _wrap_find_next_break (i+1) len str
-
-and output_spaces chan n = for i = 0 to n-1 do output_char chan ' '
done
+let output_spaces chan n = for i = 0 to n-1 do output_char chan ' '
done
 
 let unique = let i = ref 0 in fun () -> incr i; !i
 
diff --git a/mltools/tools_utils.ml b/mltools/tools_utils.ml
index 177876e421e6..06ba2f7ab295 100644
--- a/mltools/tools_utils.ml
+++ b/mltools/tools_utils.ml
@@ -122,6 +122,41 @@ let message fs    in
   ksprintf display fs
 
+(* Wrap text. *)
+type wrap_break_t = WrapEOS | WrapSpace | WrapNL
+
+let rec wrap ?(chan = stdout) ?(indent = 0) str +  let len = String.length str
in
+  _wrap chan indent 0 0 len str
+
+and _wrap chan indent column i len str +  if i < len then (
+    let (j, break) = _wrap_find_next_break i len str in
+    let next_column +      if column + (j-i) >= 76 then (
+        output_char chan '\n';
+        output_spaces chan indent;
+        indent + (j-i) + 1
+      )
+      else column + (j-i) + 1 in
+    output chan (Bytes.of_string str) i (j-i);
+    match break with
+    | WrapEOS -> ()
+    | WrapSpace ->
+      output_char chan ' ';
+      _wrap chan indent next_column (j+1) len str
+    | WrapNL ->
+      output_char chan '\n';
+      output_spaces chan indent;
+      _wrap chan indent indent (j+1) len str
+  )
+
+and _wrap_find_next_break i len str +  if i >= len then (len, WrapEOS)
+  else if String.unsafe_get str i = ' ' then (i, WrapSpace)
+  else if String.unsafe_get str i = '\n' then (i, WrapNL)
+  else _wrap_find_next_break (i+1) len str
+
 (* Error messages etc. *)
 let error ?(exit_code = 1) fs    let display str -- 
2.19.1.3.g30247aa5d201

Whenever stdout and/or stderr is redirected (usually to a regular file),
users mostly do that to capture logs, for later searching. Wrapping
interferes with grep though, so make "wrap" just print the string when
the
output channel is not a TTY. The requested indentation is honored though.

Bugzilla: https://bugzilla.redhat.com/show_bug.cgi?id=1820221
Signed-off-by: Laszlo Ersek <lersek at redhat.com>
---

Notes:
    Easily testable e.g. with virt-resize:
    
    $ guestfish -N fs:ext4 exit
    $ truncate -s 2G test1.resized.img
    $ virt-resize --expand /dev/sda1 test1.img test1.resized.img
    $ virt-resize --expand /dev/sda1 test1.img test1.resized.img > log
    $ cat log

 mltools/tools_utils.ml | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/mltools/tools_utils.ml b/mltools/tools_utils.ml
index 06ba2f7ab295..4c5188988e03 100644
--- a/mltools/tools_utils.ml
+++ b/mltools/tools_utils.ml
@@ -126,8 +126,13 @@ let message fs  type wrap_break_t = WrapEOS | WrapSpace |
WrapNL
 
 let rec wrap ?(chan = stdout) ?(indent = 0) str -  let len = String.length str
in
-  _wrap chan indent 0 0 len str
+  if istty chan then
+    let len = String.length str in
+    _wrap chan indent 0 0 len str
+  else (
+    output_spaces chan indent;
+    output_string chan str
+  )
 
 and _wrap chan indent column i len str    if i < len then (
-- 
2.19.1.3.g30247aa5d201

Similarly to how users can can force ANSI colorization with "--colors"
even when stdout / stderr are redirected to a non-tty, allow them to force
wrapping with "--wrap".

Bugzilla: https://bugzilla.redhat.com/show_bug.cgi?id=1820221
Signed-off-by: Laszlo Ersek <lersek at redhat.com>
---

Notes:
    - This patch will require documentation updates for the following
      guestfs-tools utilities (those that already document
"--colours"):
    
        builder/virt-builder-repository.pod
        builder/virt-builder.pod
        customize/virt-customize.pod
        dib/virt-dib.pod
        get-kernel/virt-get-kernel.pod
        resize/virt-resize.pod
        sparsify/virt-sparsify.pod
        sysprep/virt-sysprep.pod
    
      Virt-v2v as well:
    
        docs/virt-v2v.pod
    
      This is evident e.g. from "test-virt-customize-docs.sh" failing
in
      guestfs-tools, and "test-v2v-docs.sh" failing in virt-v2v.
    
      If this patch is accepted, I intend to post such guestfs-tools and
      virt-v2v patches that atomically bump the submodule reference and
      update the documentation.
    
    - Some utilities in libguestfs already use the short "-w" option
      (guestfish, guestmount, virt-rescue); however, those utilities do not
      document "--colours", so they already don't make a TTY-based
      distinction, and will not see the new short "-w" option.
    
    - Easily testable e.g. with virt-resize:
    
      $ guestfish -N fs:ext4 exit
      $ truncate -s 2G test1.resized.img
      $ virt-resize    --expand /dev/sda1 test1.img test1.resized.img
      $ virt-resize -w --expand /dev/sda1 test1.img test1.resized.img
      $ virt-resize    --expand /dev/sda1 test1.img test1.resized.img > log1
      $ virt-resize -w --expand /dev/sda1 test1.img test1.resized.img > log2
      $ cat log1
      $ cat log2

 mlstdutils/std_utils.mli | 6 ++++--
 mlstdutils/std_utils.ml  | 8 ++++++--
 mltools/tools_utils.ml   | 3 ++-
 mltools/test-getopt.sh   | 2 ++
 4 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/mlstdutils/std_utils.mli b/mlstdutils/std_utils.mli
index 534caa80d6a7..87e923e24d29 100644
--- a/mlstdutils/std_utils.mli
+++ b/mlstdutils/std_utils.mli
@@ -376,8 +376,10 @@ val set_trace : unit -> unit
 val trace : unit -> bool
 val set_verbose : unit -> unit
 val verbose : unit -> bool
-(** Stores the colours ([--colours]), quiet ([--quiet]), trace ([-x]) and
-    verbose ([-v]) flags in global variables. *)
+val set_wrap : unit -> unit
+val wrap : unit -> bool
+(** Stores the colours ([--colours]), quiet ([--quiet]), trace ([-x]), verbose
+    ([-v]) and wrap ([-w]) flags in global variables. *)
 
 val with_open_in : string -> (in_channel -> 'a) -> 'a
 (** [with_open_in filename f] calls function [f] with [filename]
diff --git a/mlstdutils/std_utils.ml b/mlstdutils/std_utils.ml
index 58ac058c1b3a..52f44760c490 100644
--- a/mlstdutils/std_utils.ml
+++ b/mlstdutils/std_utils.ml
@@ -580,8 +580,8 @@ let which executable  (* Program name. *)
 let prog = Filename.basename Sys.executable_name
 
-(* Stores the colours (--colours), quiet (--quiet), trace (-x) and
- * verbose (-v) flags in a global variable.
+(* Stores the colours (--colours), quiet (--quiet), trace (-x), verbose (-v)
+ * and wrap (-w) flags in a global variable.
  *)
 let colours = ref false
 let set_colours () = colours := true
@@ -599,6 +599,10 @@ let verbose = ref false
 let set_verbose () = verbose := true
 let verbose () = !verbose
 
+let wrap = ref false
+let set_wrap () = wrap := true
+let wrap () = !wrap
+
 let with_open_in filename f    let chan = open_in filename in
   protect ~f:(fun () -> f chan) ~finally:(fun () -> close_in chan)
diff --git a/mltools/tools_utils.ml b/mltools/tools_utils.ml
index 4c5188988e03..eb8da290eec6 100644
--- a/mltools/tools_utils.ml
+++ b/mltools/tools_utils.ml
@@ -126,7 +126,7 @@ let message fs  type wrap_break_t = WrapEOS | WrapSpace |
WrapNL
 
 let rec wrap ?(chan = stdout) ?(indent = 0) str -  if istty chan then
+  if Std_utils.wrap () || istty chan then
     let len = String.length str in
     _wrap chan indent 0 0 len str
   else (
@@ -388,6 +388,7 @@ let create_standard_options argspec ?anon_fun ?(key_opts =
false)
   add_argspec ([ S 'q'; L"quiet" ],   Getopt.Unit set_quiet, 
s_"Don?t print progress messages");
   add_argspec ([ L"color"; L"colors";
                  L"colour"; L"colours" ], Getopt.Unit
set_colours, s_"Use ANSI colour sequences even if not tty");
+  add_argspec ([ S 'w'; L"wrap" ],    Getopt.Unit set_wrap,  
s_"Wrap log messages even if not tty");
 
   if key_opts then (
     let parse_key_selector arg diff --git a/mltools/test-getopt.sh
b/mltools/test-getopt.sh
index d9919a9a915a..1d7bb7b1dc4f 100755
--- a/mltools/test-getopt.sh
+++ b/mltools/test-getopt.sh
@@ -68,6 +68,7 @@ $t --short-options | grep '^-is'
 $t --short-options | grep '^-t'
 $t --short-options | grep '^-V'
 $t --short-options | grep '^-v'
+$t --short-options | grep '^-w'
 $t --short-options | grep '^-x'
 
 # --long-options
@@ -89,6 +90,7 @@ $t --long-options | grep '^--ii'
 $t --long-options | grep '^--is'
 $t --long-options | grep '^--version'
 $t --long-options | grep '^--verbose'
+$t --long-options | grep '^--wrap'
 
 # -a/--add parameter.
 $t | grep '^adds = \[\]'
-- 
2.19.1.3.g30247aa5d201