New upstream version 1.1.1

1 files changed, 92 insertions, 10 deletions

diff --git a/src/csv_output.ml b/src/csv_output.ml
index f23d673..42fed9d 100644
--- a/src/csv_output.ml
+++ b/src/csv_output.ml
@@ -1,5 +1,5 @@
 (* 'top'-like tool for libvirt domains.
-   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   (C) Copyright 2007-2021 Richard W.M. Jones, Red Hat Inc.
    http://libvirt.org/
 
    This program is free software; you can redistribute it and/or modify
@@ -20,21 +20,103 @@
 (* CSV output functions. *)
 
 open Printf
-open ExtList
 
+open Utils
 open Collect
 
 module C = Libvirt.Connect
 
-(* Hook for CSV support (see [opt_csv.ml]). *)
-let csv_write : (string list -> unit) ref =
-  ref (
-    fun _ -> ()
+let chan = ref None
+
+let csv_set_filename filename = chan := Some (open_out filename)
+
+(* This code is adapted from OCaml CSV, published under the LGPLv2+
+ * which is compatible with the license of virt-top.
+ *)
+
+let nl = Bytes.make 1 '\n'
+let comma = Bytes.make 1 ','
+let quote = Bytes.make 1 '"'
+let output_newline chan = output chan nl 0 1
+let output_comma chan = output chan comma 0 1
+let output_quote chan = output chan quote 0 1
+
+let is_space_or_tab c = c = ' ' || c = '\t'
+
+let must_escape = Array.make 256 false
+let () =
+  List.iter (fun c -> must_escape.(Char.code c) <- true)
+            ['\"'; '\\';  '\000'; '\b'; '\n'; '\r'; '\t'; '\026']
+
+let must_quote chan s len =
+  let quote = ref (is_space_or_tab (String.unsafe_get s 0)
+                   || is_space_or_tab (String.unsafe_get s (len - 1))) in
+  let n = ref 0 in
+  for i = 0 to len-1 do
+    let c = String.unsafe_get s i in
+    if c = ',' || c = '\n' || c = '\r' then quote := true
+    else if c = '"' then (
+      quote := true;
+      incr n
+    )
+  done;
+  if !quote then !n else -1
+
+let write_escaped chan field =
+  let len = String.length field in
+  if len > 0 then (
+    let n = must_quote chan field len in
+    if n < 0 then
+      output chan (Bytes.unsafe_of_string field) 0 len
+    else (
+      let field =
+        if n <= 0 then Bytes.unsafe_of_string field
+        else (* There are some quotes to escape *)
+          let s = Bytes.create (len + n) in
+          let j = ref 0 in
+          for i = 0 to len - 1 do
+            let c = String.unsafe_get field i in
+            if c = '"' then (
+              Bytes.unsafe_set s !j '"'; incr j;
+              Bytes.unsafe_set s !j '"'; incr j
+            )
+            else (Bytes.unsafe_set s !j c; incr j)
+          done;
+          s
+      in
+      output_quote chan;
+      output chan field 0 (Bytes.length field);
+      output_quote chan
+    )
   )
 
+let save_out chan = function
+  | [] -> output_newline chan
+  | [f] ->
+     write_escaped chan f;
+     output_newline chan
+  | f :: tl ->
+     write_escaped chan f;
+     List.iter (
+       fun f ->
+         output_comma chan;
+         write_escaped chan f
+     ) tl;
+     output_newline chan
+
+let csv_write row =
+  match !chan with
+  | None -> ()                  (* CSV output not enabled *)
+  | Some chan ->
+     save_out chan row;
+     (* Flush the output to the file immediately because we don't
+      * explicitly close the channel.
+      *)
+     flush chan
+
 (* Write CSV header row. *)
 let write_csv_header (csv_cpu, csv_mem, csv_block, csv_net) block_in_bytes =
-  (!csv_write) (
+  csv_write (
     [ "Hostname"; "Time"; "Arch"; "Physical CPUs";
       "Count"; "Running"; "Blocked"; "Paused"; "Shutdown";
       "Shutoff"; "Crashed"; "Active"; "Inactive";
@@ -92,9 +174,9 @@ let append_csv (_, _, _, _, _, node_info, hostname, _) (* setup *)
   let cmp (_, { rd_domid = rd_domid1 }) (_, { rd_domid = rd_domid2 }) =
     compare rd_domid1 rd_domid2
   in
-  let doms = List.sort ~cmp doms in
+  let doms = List.sort cmp doms in
 
-  let string_of_int64_option = Option.map_default Int64.to_string "" in
+  let string_of_int64_option = map_default Int64.to_string "" in
 
   let domain_fields = List.map (
     fun (domname, rd) ->
@@ -121,4 +203,4 @@ let append_csv (_, _, _, _, _, node_info, hostname, _) (* setup *)
   ) doms in
   let domain_fields = List.flatten domain_fields in
 
-  (!csv_write) (summary_fields @ domain_fields)
+  csv_write (summary_fields @ domain_fields)