X-Git-Url: http://git.annexia.org/?p=virt-top.git;a=blobdiff_plain;f=src%2Fcsv_output.ml;h=f23d673cf14dc19e0f8fc4388400cae3ddfe8a8c;hp=9496ca81a67bd6d330afa9cfbfbec24dc33b598d;hb=HEAD;hpb=90d14bc151e488972d33eefaac2242d9a6e07578

diff --git a/src/csv_output.ml b/src/csv_output.ml
index 9496ca8..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";
@@ -56,6 +138,7 @@ let write_csv_header (csv_cpu, csv_mem, csv_block, csv_net) block_in_bytes =
 (* Write summary data to CSV file. *)
 let append_csv (_, _, _, _, _, node_info, hostname, _) (* setup *)
                (csv_cpu, csv_mem, csv_block, csv_net)
+               block_in_bytes
                { rd_doms = doms;
                  rd_printable_time = printable_time;
                  rd_nr_pcpus = nr_pcpus; rd_total_cpu = total_cpu;
@@ -91,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) ->
@@ -104,10 +187,15 @@ let append_csv (_, _, _, _, _, node_info, hostname, _) (* setup *)
         (if csv_mem then [
             Int64.to_string rd.rd_mem_bytes; Int64.to_string rd.rd_mem_percent
          ] else []) @
-	(if csv_block then [
-	   string_of_int64_option rd.rd_block_rd_info;
-	   string_of_int64_option rd.rd_block_wr_info;
-	 ] else []) @
+	(if csv_block then
+           if block_in_bytes then [
+	     string_of_int64_option rd.rd_block_rd_bytes;
+	     string_of_int64_option rd.rd_block_wr_bytes;
+	   ] else [
+	     string_of_int64_option rd.rd_block_rd_reqs;
+	     string_of_int64_option rd.rd_block_wr_reqs;
+           ]
+         else []) @
 	(if csv_net then [
 	   string_of_int64_option rd.rd_net_rx_bytes;
 	   string_of_int64_option rd.rd_net_tx_bytes;
@@ -115,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)