From 42de3812f0bd97c3fa5114b39d9bb23c483d364b Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 3 Nov 2021 11:28:58 +0000 Subject: [PATCH] Remove external dependency on ocaml-csv We only used a tiny number of features from this library, and it is distributed under a compatible license so we might as well inline the function we need. --- README | 1 - configure.ac | 2 -- src/.depend | 8 ----- src/Makefile.am | 5 --- src/README | 7 +--- src/csv_output.ml | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++---- src/csv_output.mli | 5 ++- src/opt_csv.ml | 40 ----------------------- src/top.ml | 8 +---- src/top.mli | 3 -- src/virt-top.pod | 4 --- 11 files changed, 93 insertions(+), 86 deletions(-) delete mode 100644 src/opt_csv.ml diff --git a/README b/README index 1ad45a2..70d0683 100644 --- a/README +++ b/README @@ -24,7 +24,6 @@ OCaml curses Optional: OCaml gettext OCaml xml-light -OCaml CSV OCaml Calendar, version 2 is preferred perldoc msgfmt diff --git a/configure.ac b/configure.ac index 7eca0f6..316be00 100644 --- a/configure.ac +++ b/configure.ac @@ -69,12 +69,10 @@ fi dnl Check for optional OCaml packages. AC_CHECK_OCAML_PKG(calendar) -AC_CHECK_OCAML_PKG(csv) AC_CHECK_OCAML_PKG(gettext) AC_CHECK_OCAML_PKG(xml-light) AM_CONDITIONAL([HAVE_PKG_CALENDAR], [test "x$OCAML_PKG_calendar" != "xno"]) -AM_CONDITIONAL([HAVE_PKG_CSV], [test "x$OCAML_PKG_csv" != "xno"]) AM_CONDITIONAL([HAVE_PKG_GETTEXT], [test "x$OCAML_PKG_gettext" != "xno"]) AM_CONDITIONAL([HAVE_PKG_XML_LIGHT],[test "x$OCAML_PKG_xml_light" != "xno"]) diff --git a/src/.depend b/src/.depend index 997a051..ffca8e3 100644 --- a/src/.depend +++ b/src/.depend @@ -33,14 +33,6 @@ opt_calendar.cmo : \ opt_calendar.cmx : \ top.cmx \ opt_gettext.cmx -opt_csv.cmo : \ - top.cmi \ - opt_gettext.cmo \ - csv_output.cmi -opt_csv.cmx : \ - top.cmx \ - opt_gettext.cmx \ - csv_output.cmx opt_gettext.cmo : opt_gettext.cmx : opt_xml.cmo : \ diff --git a/src/Makefile.am b/src/Makefile.am index aa55078..03e4b1c 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -27,7 +27,6 @@ EXTRA_DIST = \ dummy.c \ main.ml \ opt_calendar.ml \ - opt_csv.ml \ opt_gettext.ml \ opt_xml.ml \ redraw.ml \ @@ -66,10 +65,6 @@ if HAVE_PKG_XML_LIGHT BOBJS += opt_xml.cmo OCAMLPACKAGES += -package xml-light endif -if HAVE_PKG_CSV -BOBJS += opt_csv.cmo -OCAMLPACKAGES += -package csv -endif if HAVE_PKG_CALENDAR BOBJS += opt_calendar.cmo OCAMLPACKAGES += -package calendar diff --git a/src/README b/src/README index 1fd4be3..61d2c77 100644 --- a/src/README +++ b/src/README @@ -53,11 +53,6 @@ The code is structured into these files: The reason for having it in a separate file is so that we don't depend on xml-light. - opt_csv.ml - - Any code which needs the optional ocaml-csv library goes - in here. - opt_calendar.ml Any code which needs the optional ocaml-calendar library @@ -67,7 +62,7 @@ The code is structured into these files: main.ml This is just a small bit of code to glue the modules together - Top + Opt_xml? + Opt_csv? + Opt_calendar? + Top + Opt_xml? + Opt_calendar? The man-page is generated from the single file: diff --git a/src/csv_output.ml b/src/csv_output.ml index cb373d5..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 @@ -26,15 +26,97 @@ 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"; @@ -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) diff --git a/src/csv_output.mli b/src/csv_output.mli index 4064be5..71838eb 100644 --- a/src/csv_output.mli +++ b/src/csv_output.mli @@ -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 @@ -19,8 +19,7 @@ (** CSV output functions. *) -(* Hook for [Opt_csv] to override (if present). *) -val csv_write : (string list -> unit) ref +val csv_set_filename : string -> unit val write_csv_header : bool * bool * bool * bool -> bool -> unit diff --git a/src/opt_csv.ml b/src/opt_csv.ml deleted file mode 100644 index 6625c61..0000000 --- a/src/opt_csv.ml +++ /dev/null @@ -1,40 +0,0 @@ -(* 'top'-like tool for libvirt domains. - (C) Copyright 2007-2009 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - This file contains all code which requires CSV support. -*) - -open Opt_gettext.Gettext - -(* Output channel, or None if CSV output not enabled. *) -let chan = ref None ;; - -Top.csv_start := - fun filename -> - chan := Some (open_out filename) ;; - -Csv_output.csv_write := - fun row -> - match !chan with - | None -> () (* CSV output not enabled. *) - | Some chan -> - Csv.save_out chan [row]; - (* Flush the output to the file immediately because we don't - * explicitly close this file. - *) - flush chan diff --git a/src/top.ml b/src/top.ml index 5fb6e03..75fbcb9 100644 --- a/src/top.ml +++ b/src/top.ml @@ -32,12 +32,6 @@ module N = Libvirt.Network let rcfile = ".virt-toprc" -(* Hooks for CSV support (see [opt_csv.ml]). *) -let csv_start : (string -> unit) ref = - ref ( - fun _ -> failwith (s_"virt-top was compiled without support for CSV files") - ) - (* Hook for calendar support (see [opt_calendar.ml]). *) let parse_date_time : (string -> float) ref = ref ( @@ -83,7 +77,7 @@ let start_up () = and set_net_mode () = display_mode := NetDisplay and set_block_mode () = display_mode := BlockDisplay and set_csv filename = - (!csv_start) filename; + Csv_output.csv_set_filename filename; csv_enabled := true and no_init_file () = init_file := NoInitFile and set_init_file filename = init_file := InitFile filename diff --git a/src/top.mli b/src/top.mli index b625910..f609325 100644 --- a/src/top.mli +++ b/src/top.mli @@ -17,9 +17,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) -(* Hook for [Opt_csv] to override (if present). *) -val csv_start : (string -> unit) ref - (* Hook for [Opt_calendar] to override (if present). *) val parse_date_time : (string -> float) ref diff --git a/src/virt-top.pod b/src/virt-top.pod index 76ad3f9..315b9b6 100644 --- a/src/virt-top.pod +++ b/src/virt-top.pod @@ -114,10 +114,6 @@ Currently the statistics which this records vary between releases of virt-top (but the column headers will stay the same, so you can use those to process the CSV file). -Not every version of virt-top supports CSV output - it depends how the -program was compiled (see I file in the source distribution -for details). - To save space you can compress your CSV files (if your shell supports this feature, eg. I): -- 1.8.3.1