diff --git a/0001-Disable-warning-about-immutable-strings-for-OCaml-4..patch b/0001-Disable-warning-about-immutable-strings-for-OCaml-4..patch index d3371ef..146af89 100644 --- a/0001-Disable-warning-about-immutable-strings-for-OCaml-4..patch +++ b/0001-Disable-warning-about-immutable-strings-for-OCaml-4..patch @@ -1,7 +1,7 @@ From 0e47961395eec78b1ee9f6ae48520f1d95d84fdf Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Sat, 2 Aug 2014 17:37:21 +0100 -Subject: [PATCH 01/17] Disable warning about immutable strings (for OCaml +Subject: [PATCH 01/19] Disable warning about immutable strings (for OCaml 4.02). --- @@ -46,5 +46,5 @@ index 5aa0c35..98e6647 100755 BYTE_TARGETS := virt-top -- -2.9.3 +2.13.1 diff --git a/0002-Move-upstream-translations-from-Tranifex-to-Zanata.patch b/0002-Move-upstream-translations-from-Tranifex-to-Zanata.patch index 3b8f82d..8483a52 100644 --- a/0002-Move-upstream-translations-from-Tranifex-to-Zanata.patch +++ b/0002-Move-upstream-translations-from-Tranifex-to-Zanata.patch @@ -1,7 +1,7 @@ From 6ea4275b0d9f6d40b8d4a35f78928e71d830d721 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Sat, 21 Feb 2015 17:27:59 +0000 -Subject: [PATCH 02/17] Move upstream translations from Tranifex to Zanata. +Subject: [PATCH 02/19] Move upstream translations from Tranifex to Zanata. This is at the request of the Fedora localization team. For further information see: @@ -163,5 +163,5 @@ index 0000000..64810f9 + + -- -2.9.3 +2.13.1 diff --git a/0003-Update-translations-from-Zanata.patch b/0003-Update-translations-from-Zanata.patch index f59d7d2..fe0d373 100644 --- a/0003-Update-translations-from-Zanata.patch +++ b/0003-Update-translations-from-Zanata.patch @@ -1,7 +1,7 @@ From defe5bdd4a32e0206a786d279e0f9cfc238e5e17 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Sat, 21 Feb 2015 17:29:16 +0000 -Subject: [PATCH 03/17] Update translations from Zanata. +Subject: [PATCH 03/19] Update translations from Zanata. --- po/LINGUAS | 12 +- @@ -4184,5 +4184,5 @@ index 9729fc3..dcf0de0 100644 #: ../virt-top/virt_top.ml:1506 msgid "# %s virt-top configuration file\\n" -- -2.9.3 +2.13.1 diff --git a/0004-build-Add-g-flag-to-ocamlopt.patch b/0004-build-Add-g-flag-to-ocamlopt.patch index f94a9f8..f3a557d 100644 --- a/0004-build-Add-g-flag-to-ocamlopt.patch +++ b/0004-build-Add-g-flag-to-ocamlopt.patch @@ -1,7 +1,7 @@ From 4a2d0ccd91f07d0a2009e8553a29fcf4cf752ba3 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 4 Jan 2016 11:48:40 -0500 -Subject: [PATCH 04/17] build: Add -g flag to ocamlopt. +Subject: [PATCH 04/19] build: Add -g flag to ocamlopt. Modern ocamlopt supports the -g flag fine (very old versions did not). --- @@ -22,5 +22,5 @@ index 98e6647..e149b26 100755 BYTE_TARGETS := virt-top -- -2.9.3 +2.13.1 diff --git a/0005-Rename-source-directory-and-files.patch b/0005-Rename-source-directory-and-files.patch index 16c9160..ccfac65 100644 --- a/0005-Rename-source-directory-and-files.patch +++ b/0005-Rename-source-directory-and-files.patch @@ -1,7 +1,7 @@ From b7c3ef13cbd9c9cd49005a32ffb70faf6f5bbe8c Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 31 Oct 2016 12:01:40 +0000 -Subject: [PATCH 05/17] Rename source directory and files. +Subject: [PATCH 05/19] Rename source directory and files. This renames the source directory from virt-top to src/ and removes the unnecessary virt_top_* prefix from many source files. @@ -715,5 +715,5 @@ index 46099b7..0000000 -virt_top_xml.cmo: virt_top_gettext.cmo virt_top.cmi -virt_top_xml.cmx: virt_top_gettext.cmx virt_top.cmx -- -2.9.3 +2.13.1 diff --git a/0006-Enable-same-warnings-as-libguestfs.patch b/0006-Enable-same-warnings-as-libguestfs.patch index b460ad3..c3cf507 100644 --- a/0006-Enable-same-warnings-as-libguestfs.patch +++ b/0006-Enable-same-warnings-as-libguestfs.patch @@ -1,7 +1,7 @@ From 5500a027ad231eb5bb16e36efee72b48cfac9528 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 27 Mar 2017 12:21:48 +0100 -Subject: [PATCH 06/17] Enable same warnings as libguestfs. +Subject: [PATCH 06/19] Enable same warnings as libguestfs. In particular 'warning 3' was still enabled before, meaning that the code would fail with newer OCaml compilers: @@ -30,5 +30,5 @@ index d29f2e8..d744fd7 100755 OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) -- -2.9.3 +2.13.1 diff --git a/0007-Remove-x-executable-permission-on-several-source-fil.patch b/0007-Remove-x-executable-permission-on-several-source-fil.patch index 091fb29..a607e65 100644 --- a/0007-Remove-x-executable-permission-on-several-source-fil.patch +++ b/0007-Remove-x-executable-permission-on-several-source-fil.patch @@ -1,7 +1,7 @@ From 8cd690d0b8a5343d8731145b95931ec7aaa2db35 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 27 Mar 2017 12:25:19 +0100 -Subject: [PATCH 07/17] Remove +x (executable) permission on several source +Subject: [PATCH 07/19] Remove +x (executable) permission on several source files. Not sure why it was there, but it was incorrect. @@ -44,5 +44,5 @@ diff --git a/src/virt-top.pod b/src/virt-top.pod old mode 100755 new mode 100644 -- -2.9.3 +2.13.1 diff --git a/0008-Refresh-HACKING-file.patch b/0008-Refresh-HACKING-file.patch index 65ea472..aaf60c3 100644 --- a/0008-Refresh-HACKING-file.patch +++ b/0008-Refresh-HACKING-file.patch @@ -1,7 +1,7 @@ From cc9f1f9d8f17e8ac5a6a73af830c132d916fd6e0 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 27 Mar 2017 12:30:01 +0100 -Subject: [PATCH 08/17] Refresh HACKING file. +Subject: [PATCH 08/19] Refresh HACKING file. Fixes commit b7c3ef13cbd9c9cd49005a32ffb70faf6f5bbe8c. --- @@ -91,5 +91,5 @@ index bce40a9..3cd266b 100644 - virt-top.1 - virt-top.txt -- -2.9.3 +2.13.1 diff --git a/0009-Fix-po-POTFILES-for-new-location-of-source-files.patch b/0009-Fix-po-POTFILES-for-new-location-of-source-files.patch index 4bb0a24..be3c922 100644 --- a/0009-Fix-po-POTFILES-for-new-location-of-source-files.patch +++ b/0009-Fix-po-POTFILES-for-new-location-of-source-files.patch @@ -1,7 +1,7 @@ From 1b4980da40000a34ec987f83824dd69454c4e8e4 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 27 Mar 2017 12:33:22 +0100 -Subject: [PATCH 09/17] Fix po/POTFILES for new location of source files. +Subject: [PATCH 09/19] Fix po/POTFILES for new location of source files. Fixes commit b7c3ef13cbd9c9cd49005a32ffb70faf6f5bbe8c. --- @@ -30,5 +30,5 @@ index 55bb82d..70d62d5 100644 +../src/utils.ml +../src/version.ml -- -2.9.3 +2.13.1 diff --git a/0010-Update-PO-files.patch b/0010-Update-PO-files.patch index 3abedc5..895f8b1 100644 --- a/0010-Update-PO-files.patch +++ b/0010-Update-PO-files.patch @@ -1,7 +1,7 @@ From 0b6f6d45d50174e27f9a425f67bb1a6045a8e58c Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 27 Mar 2017 12:34:20 +0100 -Subject: [PATCH 10/17] Update PO files. +Subject: [PATCH 10/19] Update PO files. --- po/as.po | 227 +++++++++++++++++++++++++++++-------------------------- @@ -14275,5 +14275,5 @@ index dcf0de0..4df1241 100644 msgstr "" + -- -2.9.3 +2.13.1 diff --git a/0011-Remove-support-for-OCaml-Calendar-v1.patch b/0011-Remove-support-for-OCaml-Calendar-v1.patch index fd69a6e..c7076f7 100644 --- a/0011-Remove-support-for-OCaml-Calendar-v1.patch +++ b/0011-Remove-support-for-OCaml-Calendar-v1.patch @@ -1,7 +1,7 @@ From effd1ec5897a2cac6e897ae7bce72f6b1e617b90 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 27 Mar 2017 12:41:21 +0100 -Subject: [PATCH 11/17] Remove support for OCaml Calendar v1. +Subject: [PATCH 11/19] Remove support for OCaml Calendar v1. Calendar v2 was released in 2008 (9 years ago!), thus remove support for v1. @@ -199,5 +199,5 @@ index 2c459fe..0000000 - *) - Calendar.to_unixfloat cal -- -2.9.3 +2.13.1 diff --git a/0012-src-Fix-some-comments-which-referred-to-the-old-file.patch b/0012-src-Fix-some-comments-which-referred-to-the-old-file.patch index a97231d..a22140c 100644 --- a/0012-src-Fix-some-comments-which-referred-to-the-old-file.patch +++ b/0012-src-Fix-some-comments-which-referred-to-the-old-file.patch @@ -1,7 +1,7 @@ From 3e9ed9c0fe49c3d4e4a8e467d521f676769c485a Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 27 Mar 2017 13:06:18 +0100 -Subject: [PATCH 12/17] src: Fix some comments which referred to the old +Subject: [PATCH 12/19] src: Fix some comments which referred to the old filenames. Fixes commit b7c3ef13cbd9c9cd49005a32ffb70faf6f5bbe8c. @@ -72,5 +72,5 @@ index 3ad0718..b0953dd 100644 type setup = -- -2.9.3 +2.13.1 diff --git a/0013-Split-up-huge-Top-module-into-smaller-modules.patch b/0013-Split-up-huge-Top-module-into-smaller-modules.patch index dc49746..9289c1b 100644 --- a/0013-Split-up-huge-Top-module-into-smaller-modules.patch +++ b/0013-Split-up-huge-Top-module-into-smaller-modules.patch @@ -1,7 +1,7 @@ From 90d14bc151e488972d33eefaac2242d9a6e07578 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 27 Mar 2017 15:29:23 +0100 -Subject: [PATCH 13/17] Split up huge Top module into smaller modules. +Subject: [PATCH 13/19] Split up huge Top module into smaller modules. This change is hopefully pure refactoring, splitting up the very large and highly interlinked module into more manageable modules with @@ -11,7 +11,7 @@ well-defined (or at least *better*-defined) interfaces between them. po/POTFILES | 6 + src/.depend | 36 +- src/Makefile.in | 6 + - src/README | 38 +- + src/README | 36 +- src/collect.ml | 455 ++++++++++++++++++++ src/collect.mli | 86 ++++ src/csv_output.ml | 118 +++++ @@ -30,7 +30,7 @@ well-defined (or at least *better*-defined) interfaces between them. src/types.mli | 49 +++ src/utils.ml | 65 --- src/utils.mli | 9 - - 23 files changed, 1719 insertions(+), 1223 deletions(-) + 23 files changed, 1718 insertions(+), 1222 deletions(-) create mode 100644 src/collect.ml create mode 100644 src/collect.mli create mode 100644 src/csv_output.ml @@ -167,8 +167,10 @@ index 8aa2348..1fd4be3 100644 String functions and other small utility functions. This is included directly into virt_top.ml. +- top.mli, top.ml + types.mli, types.ml -+ + +- This is the virt-top program. + Various internally used types and functions operating on those + types. + @@ -181,27 +183,24 @@ index 8aa2348..1fd4be3 100644 + Various useful functions for drawing to the curses screen. + + redraw.mli, redraw.ml -+ + +- The two interesting functions are called 'collect' and 'redraw'. + Redraw the main display. -+ + +- 'collect' collects all the information about domains, etc. + csv_output.mli, csv_output.ml -+ + +- 'redraw' updates the display on each frame. + Functions which implement --csv mode. + + stream_output.mli, stream_output.ml + + Functions which implement --stream mode. + - top.mli, top.ml ++ top.mli, top.ml ++ ++ This is the virt-top program. - This is the virt-top program. - -- The two interesting functions are called 'collect' and 'redraw'. -- -- 'collect' collects all the information about domains, etc. -- -- 'redraw' updates the display on each frame. -- - Another interesting function is 'start_up' which handles all - start-up stuff, eg. command line arguments, connecting to the - hypervisor, enabling curses. @@ -3270,5 +3269,5 @@ index 5b71b31..6e81215 100644 -val sum_interface_stats : interface_stats list -> interface_stats -val diff_interface_stats : interface_stats -> interface_stats -> interface_stats -- -2.9.3 +2.13.1 diff --git a/0014-Move-block_in_bytes-entirely-to-the-presentation-lay.patch b/0014-Move-block_in_bytes-entirely-to-the-presentation-lay.patch index b7d7800..08ee8b4 100644 --- a/0014-Move-block_in_bytes-entirely-to-the-presentation-lay.patch +++ b/0014-Move-block_in_bytes-entirely-to-the-presentation-lay.patch @@ -1,7 +1,7 @@ From 431dbd98bad6e3635b4d0885bf33dd3e759ca35d Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 27 Mar 2017 21:22:52 +0100 -Subject: [PATCH 14/17] Move block_in_bytes entirely to the presentation layer. +Subject: [PATCH 14/19] Move block_in_bytes entirely to the presentation layer. Simplifies and updates commit dbef8dd3bf00417e75a12c851b053e49c9e1a79e. --- @@ -207,5 +207,5 @@ index 204f3b6..e2a93d6 100644 (* Append to stream output file. *) if stream_mode then -- -2.9.3 +2.13.1 diff --git a/0015-Remove-unused-variable-is_calendar2.patch b/0015-Remove-unused-variable-is_calendar2.patch index 30a9128..694728b 100644 --- a/0015-Remove-unused-variable-is_calendar2.patch +++ b/0015-Remove-unused-variable-is_calendar2.patch @@ -1,7 +1,7 @@ From 4f3794d5718249238a74b614a6b486465bc4315d Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 28 Mar 2017 13:09:54 +0100 -Subject: [PATCH 15/17] Remove unused variable is_calendar2. +Subject: [PATCH 15/19] Remove unused variable is_calendar2. Fixes commit effd1ec5897a2cac6e897ae7bce72f6b1e617b90. --- @@ -21,5 +21,5 @@ index 64f431e..6a13bef 100644 OCAMLCPACKAGES := -package unix,extlib,curses,str,libvirt -- -2.9.3 +2.13.1 diff --git a/0016-Use-virConnectGetAllDomainStats-API-to-collect-domai.patch b/0016-Use-virConnectGetAllDomainStats-API-to-collect-domai.patch index afd8f85..e4cdc94 100644 --- a/0016-Use-virConnectGetAllDomainStats-API-to-collect-domai.patch +++ b/0016-Use-virConnectGetAllDomainStats-API-to-collect-domai.patch @@ -1,7 +1,7 @@ From c513d05fd4e85953701b1023bef71af62613cf79 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 28 Mar 2017 13:30:07 +0100 -Subject: [PATCH 16/17] Use virConnectGetAllDomainStats API to collect domain +Subject: [PATCH 16/19] Use virConnectGetAllDomainStats API to collect domain stats (RHBZ#1422795). This is much faster than using the basic libvirt APIs to collect @@ -10,11 +10,11 @@ stats for each domain individually. Note this will not work unless you have the latest ocaml-libvirt package which includes this new API binding. --- - src/collect.ml | 242 +++++++++++++++++++++++++++++++++++++++++--------------- + src/collect.ml | 252 +++++++++++++++++++++++++++++++++++++++++--------------- src/collect.mli | 1 + src/utils.ml | 6 ++ src/utils.mli | 3 + - 4 files changed, 190 insertions(+), 62 deletions(-) + 4 files changed, 195 insertions(+), 67 deletions(-) diff --git a/src/collect.ml b/src/collect.ml index 448ce8c..a1e50a1 100644 @@ -61,6 +61,60 @@ index 448ce8c..a1e50a1 100644 - let dom = D.lookup_by_id conn id in - let name = D.get_name dom in - let blkdevs, netifs = get_devices id dom in +- +- (* Get current CPU, block and network stats. *) +- let info = D.get_info dom in +- let block_stats = +- try List.map (fun dev -> dev, D.block_stats dom dev) blkdevs +- with +- | Libvirt.Not_supported "virDomainBlockStats" +- | Libvirt.Virterror _ -> [] in +- let interface_stats = +- try List.map (fun dev -> dev, D.interface_stats dom dev) netifs +- with +- | Libvirt.Not_supported "virDomainInterfaceStats" +- | Libvirt.Virterror _ -> [] in +- +- let prev_info, prev_block_stats, prev_interface_stats = +- try +- let prev_info, prev_block_stats, prev_interface_stats = +- Hashtbl.find last_info id in +- Some prev_info, prev_block_stats, prev_interface_stats +- with Not_found -> None, [], [] in +- +- Some (name, +- Active { +- rd_domid = id; rd_dom = dom; rd_info = info; +- rd_block_stats = block_stats; +- rd_interface_stats = interface_stats; +- rd_prev_info = prev_info; +- rd_prev_block_stats = prev_block_stats; +- rd_prev_interface_stats = prev_interface_stats; +- rd_cpu_time = 0.; rd_percent_cpu = 0.; +- rd_mem_bytes = 0L; rd_mem_percent = 0L; +- rd_block_rd_reqs = None; rd_block_wr_reqs = None; +- rd_block_rd_bytes = None; rd_block_wr_bytes = None; +- rd_net_rx_bytes = None; rd_net_tx_bytes = None; +- }) +- with +- Libvirt.Virterror _ -> None (* ignore transient error *) +- ) ids in +- +- (* Inactive domains. *) +- let doms_inactive = +- try +- let n = C.num_of_defined_domains conn in +- let names = +- if n > 0 then Array.to_list (C.list_defined_domains conn n) +- else [] in +- List.map (fun name -> name, Inactive) names +- with +- (* Ignore transient errors, in particular errors from +- * num_of_defined_domains if it cannot contact xend. +- *) +- | Libvirt.Virterror _ -> [] in +- +- doms @ doms_inactive in + let doms = D.get_all_domain_stats conn what who in + let doms = Array.to_list doms in + List.map ( @@ -92,52 +146,17 @@ index 448ce8c..a1e50a1 100644 + | Some (D.TypedFieldUInt64 i) -> Some i + | _ -> default + in - -- (* Get current CPU, block and network stats. *) -- let info = D.get_info dom in -- let block_stats = -- try List.map (fun dev -> dev, D.block_stats dom dev) blkdevs -- with -- | Libvirt.Not_supported "virDomainBlockStats" -- | Libvirt.Virterror _ -> [] in -- let interface_stats = -- try List.map (fun dev -> dev, D.interface_stats dom dev) netifs -- with -- | Libvirt.Not_supported "virDomainInterfaceStats" -- | Libvirt.Virterror _ -> [] in ++ + let dom = D.lookup_by_uuid conn uuid in + let id = D.get_id dom in + let name = D.get_name dom in + let state = get_param_int "state.state" None in - -- let prev_info, prev_block_stats, prev_interface_stats = -- try -- let prev_info, prev_block_stats, prev_interface_stats = -- Hashtbl.find last_info id in -- Some prev_info, prev_block_stats, prev_interface_stats -- with Not_found -> None, [], [] in ++ + if state = Some 5 (* VIR_DOMAIN_SHUTOFF *) then + (name, Inactive) + else ( + (* Active domain. *) - -- Some (name, -- Active { -- rd_domid = id; rd_dom = dom; rd_info = info; -- rd_block_stats = block_stats; -- rd_interface_stats = interface_stats; -- rd_prev_info = prev_info; -- rd_prev_block_stats = prev_block_stats; -- rd_prev_interface_stats = prev_interface_stats; -- rd_cpu_time = 0.; rd_percent_cpu = 0.; -- rd_mem_bytes = 0L; rd_mem_percent = 0L; -- rd_block_rd_reqs = None; rd_block_wr_reqs = None; -- rd_block_rd_bytes = None; rd_block_wr_bytes = None; -- rd_net_rx_bytes = None; rd_net_tx_bytes = None; -- }) -- with -- Libvirt.Virterror _ -> None (* ignore transient error *) -- ) ids in ++ + (* Synthesize a D.info struct out of the data we have + * from virConnectGetAllDomainStats. Doing this is an + * artifact from the old APIs we used to use to fetch @@ -175,20 +194,7 @@ index 448ce8c..a1e50a1 100644 + nr_virt_cpu = nr_virt_cpu; + cpu_time = cpu_time + } in - -- (* Inactive domains. *) -- let doms_inactive = -- try -- let n = C.num_of_defined_domains conn in -- let names = -- if n > 0 then Array.to_list (C.list_defined_domains conn n) -- else [] in -- List.map (fun name -> name, Inactive) names -- with -- (* Ignore transient errors, in particular errors from -- * num_of_defined_domains if it cannot contact xend. -- *) -- | Libvirt.Virterror _ -> [] in ++ + let nr_block_devs = + match get_param_int "block.count" None with + | None -> 0 @@ -217,8 +223,7 @@ index 448ce8c..a1e50a1 100644 + errs = 0_L + } + ) (range 0 (nr_block_devs-1)) in - -- doms @ doms_inactive in ++ + let nr_interface_devs = + match get_param_int "net.count" None with + | None -> 0 @@ -339,5 +344,5 @@ index 6e81215..3c966f8 100644 * If the config file is missing this returns an empty list. *) -- -2.9.3 +2.13.1 diff --git a/0017-chmod-x-COPYING-files.patch b/0017-chmod-x-COPYING-files.patch index ee5e72d..f5f3598 100644 --- a/0017-chmod-x-COPYING-files.patch +++ b/0017-chmod-x-COPYING-files.patch @@ -1,7 +1,7 @@ From 20c078bead38fd9e413660d4d8fdc3fd4f76edf7 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 28 Mar 2017 14:36:07 +0100 -Subject: [PATCH 17/17] chmod -x COPYING* files. +Subject: [PATCH 17/19] chmod -x COPYING* files. --- COPYING | 0 @@ -17,5 +17,5 @@ diff --git a/COPYING.LIB b/COPYING.LIB old mode 100755 new mode 100644 -- -2.9.3 +2.13.1 diff --git a/0018-Fixes-for-safe-string-in-OCaml-4.06.patch b/0018-Fixes-for-safe-string-in-OCaml-4.06.patch new file mode 100644 index 0000000..b9e7d2d --- /dev/null +++ b/0018-Fixes-for-safe-string-in-OCaml-4.06.patch @@ -0,0 +1,42 @@ +From a58c90e04e5b54f8c6a67b09a93cfc33402cf398 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Sat, 18 Nov 2017 12:01:34 +0000 +Subject: [PATCH 18/19] Fixes for -safe-string in OCaml 4.06. + +--- + src/top.ml | 13 ++++++++----- + 1 file changed, 8 insertions(+), 5 deletions(-) + +diff --git a/src/top.ml b/src/top.ml +index e2a93d6..d4f7697 100644 +--- a/src/top.ml ++++ b/src/top.ml +@@ -296,17 +296,20 @@ let millisleep n = + *) + let get_string maxlen = + ignore (echo ()); +- let str = String.create maxlen in +- let ok = getstr str in (* Safe because binding calls getnstr. *) ++ let str = Bytes.create maxlen in ++ (* Safe because binding calls getnstr. However the unsafe cast ++ * to string is required because ocaml-curses needs to be fixed. ++ *) ++ let ok = getstr (Obj.magic str) in + ignore (noecho ()); + if not ok then "" + else ( + (* Chop at first '\0'. *) + try +- let i = String.index str '\000' in +- String.sub str 0 i ++ let i = Bytes.index str '\000' in ++ Bytes.sub_string str 0 i + with +- Not_found -> str (* it is full maxlen bytes *) ++ Not_found -> Bytes.to_string str (* it is full maxlen bytes *) + ) + + (* Main loop. *) +-- +2.13.1 + diff --git a/0019-Link-with-fPIC-runtime.patch b/0019-Link-with-fPIC-runtime.patch new file mode 100644 index 0000000..faec5d0 --- /dev/null +++ b/0019-Link-with-fPIC-runtime.patch @@ -0,0 +1,32 @@ +From 18a751d8c26548bb090ff05e30ccda3092e3373b Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Sat, 18 Nov 2017 12:01:49 +0000 +Subject: [PATCH 19/19] Link with -fPIC runtime. + +--- + src/Makefile.in | 5 ++++- + 1 file changed, 4 insertions(+), 1 deletion(-) + +diff --git a/src/Makefile.in b/src/Makefile.in +index 6a13bef..03c6362 100644 +--- a/src/Makefile.in ++++ b/src/Makefile.in +@@ -84,11 +84,14 @@ all: $(BYTE_TARGETS) + opt: $(OPT_TARGETS) + + virt-top: $(OBJS) +- ocamlfind ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) -o $@ $^ ++ ocamlfind ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ ++ -runtime-variant _pic \ ++ -o $@ $^ + + virt-top.opt: $(XOBJS) + ocamlfind ocamlopt \ + $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ ++ -runtime-variant _pic \ + -o $@ $^ + + # Manual page. +-- +2.13.1 + diff --git a/virt-top.spec b/virt-top.spec index 0dad08b..3847c03 100644 --- a/virt-top.spec +++ b/virt-top.spec @@ -36,6 +36,8 @@ Patch0014: 0014-Move-block_in_bytes-entirely-to-the-presentation-lay.patch Patch0015: 0015-Remove-unused-variable-is_calendar2.patch Patch0016: 0016-Use-virConnectGetAllDomainStats-API-to-collect-domai.patch Patch0017: 0017-chmod-x-COPYING-files.patch +Patch0018: 0018-Fixes-for-safe-string-in-OCaml-4.06.patch +Patch0019: 0019-Link-with-fPIC-runtime.patch # Update configure for aarch64 (bz #926701) Patch9999: virt-top-aarch64.patch @@ -102,6 +104,8 @@ different virtualization systems. %patch0015 -p1 %patch0016 -p1 %patch0017 -p1 +%patch0018 -p1 +%patch0019 -p1 # Update configure for aarch64 (bz #926701) %patch9999 -p1