New upstream version 1.0.9.

Remove patches which are upstream and aarch64 build fix.
This commit is contained in:
Richard W.M. Jones 2019-08-20 14:30:43 +01:00
parent 79cf871bae
commit 2cb15432da
22 changed files with 7 additions and 25604 deletions

View File

@ -1,50 +0,0 @@
From 0e47961395eec78b1ee9f6ae48520f1d95d84fdf Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Sat, 2 Aug 2014 17:37:21 +0100
Subject: [PATCH 01/19] Disable warning about immutable strings (for OCaml
4.02).
---
Makefile.in | 2 +-
virt-top/Makefile.in | 6 +++---
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/Makefile.in b/Makefile.in
index 32e0b66..b310e58 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -1,5 +1,5 @@
# virt-top
-# Copyright (C) 2007-2009 Red Hat Inc., Richard W.M. Jones
+# Copyright (C) 2007-2014 Red Hat Inc., Richard W.M. Jones
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
diff --git a/virt-top/Makefile.in b/virt-top/Makefile.in
index 5aa0c35..98e6647 100755
--- a/virt-top/Makefile.in
+++ b/virt-top/Makefile.in
@@ -1,5 +1,5 @@
# virt-top
-# Copyright (C) 2007-2009 Red Hat Inc., Richard W.M. Jones
+# Copyright (C) 2007-2014 Red Hat Inc., Richard W.M. Jones
#
# 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
@@ -64,11 +64,11 @@ OBJS += virt_top_main.cmo
XOBJS := $(OBJS:.cmo=.cmx)
-OCAMLCFLAGS := -g -warn-error A
+OCAMLCFLAGS := -g -warn-error A-3
OCAMLCLIBS := -linkpkg
OCAMLOPTPACKAGES := $(OCAMLCPACKAGES)
-OCAMLOPTFLAGS := -warn-error A
+OCAMLOPTFLAGS := -warn-error A-3
OCAMLOPTLIBS := $(OCAMLCLIBS)
BYTE_TARGETS := virt-top
--
2.13.1

View File

@ -1,167 +0,0 @@
From 6ea4275b0d9f6d40b8d4a35f78928e71d830d721 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Sat, 21 Feb 2015 17:27:59 +0000
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:
https://www.redhat.com/archives/libguestfs/2015-February/msg00168.html
---
po/zanata-pull.sh | 30 ++++++++++++++++
po/zanata.xml | 106 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 136 insertions(+)
create mode 100755 po/zanata-pull.sh
create mode 100644 po/zanata.xml
diff --git a/po/zanata-pull.sh b/po/zanata-pull.sh
new file mode 100755
index 0000000..d051b7a
--- /dev/null
+++ b/po/zanata-pull.sh
@@ -0,0 +1,30 @@
+#!/bin/bash -
+# Pull translations from Zanata.
+# Copyright (C) 2011-2015 Red Hat Inc.
+#
+# 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+set -e
+
+echo zanata po pull
+zanata po pull
+
+# Remove PO files that have no translations in them.
+for f in *.po; do
+ if ! grep -q '^msgstr "[^"]' $f; then
+ echo rm $f
+ rm $f
+ fi
+done
diff --git a/po/zanata.xml b/po/zanata.xml
new file mode 100644
index 0000000..64810f9
--- /dev/null
+++ b/po/zanata.xml
@@ -0,0 +1,106 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<config xmlns="http://zanata.org/namespace/config/">
+ <url>https://fedora.zanata.org</url>
+ <project>virt-top</project>
+ <project-version>master</project-version>
+ <project-type>gettext</project-type>
+
+ <locales>
+ <locale>sq</locale>
+ <locale>ar</locale>
+ <locale>as</locale>
+ <locale>ast</locale>
+ <locale>bal</locale>
+ <locale>eu</locale>
+ <locale>bn</locale>
+ <locale>bn-IN</locale>
+ <locale>brx</locale>
+ <locale>bs</locale>
+ <locale>br</locale>
+ <locale>bg</locale>
+ <locale>ca</locale>
+ <locale>zh-CN</locale>
+ <locale>zh-HK</locale>
+ <locale>zh-TW</locale>
+ <locale>kw</locale>
+ <locale>kw-GB</locale>
+ <locale>cs</locale>
+ <locale>da</locale>
+ <locale>nl</locale>
+ <locale>en-GB</locale>
+ <locale>eo</locale>
+ <locale>et</locale>
+ <locale>fi</locale>
+ <locale>fr</locale>
+ <locale>gl</locale>
+ <locale>ka</locale>
+ <locale>de</locale>
+ <locale>el</locale>
+ <locale>gu</locale>
+ <locale>he</locale>
+ <locale>hi</locale>
+ <locale>hu</locale>
+ <locale>is</locale>
+ <locale>id</locale>
+ <locale>ia</locale>
+ <locale>it</locale>
+ <locale>ja</locale>
+ <locale>kn</locale>
+ <locale>kk</locale>
+ <locale>km</locale>
+ <locale>ky</locale>
+ <locale>ko</locale>
+ <locale>lt</locale>
+ <locale>nds</locale>
+ <locale>mk</locale>
+ <locale>mai</locale>
+ <locale>ms</locale>
+ <locale>ml</locale>
+ <locale>mr</locale>
+ <locale>mn</locale>
+ <locale>ne</locale>
+ <locale>nb</locale>
+ <locale>nn</locale>
+ <locale>or</locale>
+ <locale>pa</locale>
+ <locale>fa</locale>
+ <locale>pl</locale>
+ <locale>pt</locale>
+ <locale>pt-BR</locale>
+ <locale>ro</locale>
+ <locale>ru</locale>
+ <locale>sr</locale>
+ <locale>sr@latin</locale>
+ <locale>si</locale>
+ <locale>sk</locale>
+ <locale>sl</locale>
+ <locale>es</locale>
+ <locale>sv</locale>
+ <locale>tg</locale>
+ <locale>ta</locale>
+ <locale>te</locale>
+ <locale>bo</locale>
+ <locale>tr</locale>
+ <locale>uk</locale>
+ <locale>ur</locale>
+ <locale>wba</locale>
+ <locale>cy</locale>
+ <locale>lv</locale>
+ <locale>kw@uccor</locale>
+ <locale>kw@kkcor</locale>
+ <locale>af</locale>
+ <locale>am</locale>
+ <locale>be</locale>
+ <locale>hr</locale>
+ <locale>de-CH</locale>
+ <locale>th</locale>
+ <locale>vi</locale>
+ <locale>zu</locale>
+ <locale>ilo</locale>
+ <locale>nso</locale>
+ <locale>tw</locale>
+ <locale>yo</locale>
+ <locale>anp</locale>
+ </locales>
+
+</config>
--
2.13.1

File diff suppressed because it is too large Load Diff

View File

@ -1,26 +0,0 @@
From 4a2d0ccd91f07d0a2009e8553a29fcf4cf752ba3 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 4 Jan 2016 11:48:40 -0500
Subject: [PATCH 04/19] build: Add -g flag to ocamlopt.
Modern ocamlopt supports the -g flag fine (very old versions did not).
---
virt-top/Makefile.in | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/virt-top/Makefile.in b/virt-top/Makefile.in
index 98e6647..e149b26 100755
--- a/virt-top/Makefile.in
+++ b/virt-top/Makefile.in
@@ -68,7 +68,7 @@ OCAMLCFLAGS := -g -warn-error A-3
OCAMLCLIBS := -linkpkg
OCAMLOPTPACKAGES := $(OCAMLCPACKAGES)
-OCAMLOPTFLAGS := -warn-error A-3
+OCAMLOPTFLAGS := $(OCAMLCFLAGS)
OCAMLOPTLIBS := $(OCAMLCLIBS)
BYTE_TARGETS := virt-top
--
2.13.1

View File

@ -1,719 +0,0 @@
From b7c3ef13cbd9c9cd49005a32ffb70faf6f5bbe8c Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 31 Oct 2016 12:01:40 +0000
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.
This is entirely refactoring and makes no functional change.
Also this fixes the MANIFEST file and removes old Transifex
configuration, fixing commit defe5bdd4a32e0206a786d279e0f9cfc238e5e17.
---
.gitignore | 72 +++++++++-------------
.tx/config | 8 ---
ChangeLog | 30 +++++++++
MANIFEST | 41 +++++++-----
Makefile.in | 15 ++---
README | 2 +-
configure.ac | 29 ++++-----
src/.depend | 20 ++++++
{virt-top => src}/Makefile.in | 18 +++---
{virt-top => src}/README | 22 ++++---
virt-top/virt_top_main.ml => src/main.ml | 4 +-
.../virt_top_calendar1.ml => src/opt_calendar1.ml | 4 +-
.../virt_top_calendar2.ml => src/opt_calendar2.ml | 4 +-
virt-top/virt_top_csv.ml => src/opt_csv.ml | 6 +-
virt-top/virt_top_xml.ml => src/opt_xml.ml | 4 +-
virt-top/virt_top.ml => src/top.ml | 8 +--
virt-top/virt_top.mli => src/top.mli | 0
virt-top/virt_top_utils.ml => src/utils.ml | 2 +-
virt-top/virt_top_utils.mli => src/utils.mli | 0
.../virt_top_version.ml.in => src/version.ml.in | 0
{virt-top => src}/virt-top.pod | 0
virt-top/.depend | 20 ------
22 files changed, 163 insertions(+), 146 deletions(-)
delete mode 100644 .tx/config
create mode 100644 src/.depend
rename {virt-top => src}/Makefile.in (91%)
rename {virt-top => src}/README (77%)
rename virt-top/virt_top_main.ml => src/main.ml (98%)
rename virt-top/virt_top_calendar1.ml => src/opt_calendar1.ml (97%)
rename virt-top/virt_top_calendar2.ml => src/opt_calendar2.ml (97%)
rename virt-top/virt_top_csv.ml => src/opt_csv.ml (94%)
rename virt-top/virt_top_xml.ml => src/opt_xml.ml (97%)
rename virt-top/virt_top.ml => src/top.ml (99%)
rename virt-top/virt_top.mli => src/top.mli (100%)
rename virt-top/virt_top_utils.ml => src/utils.ml (99%)
rename virt-top/virt_top_utils.mli => src/utils.mli (100%)
rename virt-top/virt_top_version.ml.in => src/version.ml.in (100%)
rename {virt-top => src}/virt-top.pod (100%)
delete mode 100644 virt-top/.depend
diff --git a/.gitignore b/.gitignore
index d08e9e2..e3f77e7 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,50 +1,36 @@
-aclocal.m4
-META
-ocaml-libvirt-*.tar.gz
-ocaml-libvirt-*.exe
-html
-configure
-config.log
-config.status
-config.h
-config.cache
-Makefile
-Make.rules
-*/Makefile
-autom4te.cache
-core
-core.*
+*.a
+*.cma
*.cmi
*.cmo
*.cmx
-*.cma
*.cmxa
-*.o
-*.so
-*.a
-*.opt
*.dll
*.exe
-*~
-libvirt/libvirt_version.ml
-examples/list_domains
-examples/node_info
-mlvirsh/mlvirsh
-virt-ctrl/virt-ctrl
-virt-top/virt-top
-virt-df/virt-df
-wininstaller.nsis
+*.o
+*.opt
*.orig
-mlvirsh/mlvirsh_gettext.ml
-virt-ctrl/virt_ctrl_gettext.ml
-virt-df/virt_df_gettext.ml
-virt-top/virt_top_gettext.ml
-virt-top/virt_top_version.ml
-po/*.mo
-po/*.po.bak
-virt-df/virt_df_lvm2_lexer.ml
-virt-df/virt_df_lvm2_parser.ml
-virt-df/virt_df_lvm2_parser.mli
-virt-top-*.tar.gz
-virt-top/virt-top.1
-virt-top/virt-top.txt
\ No newline at end of file
+*.so
+*~
+
+META
+Makefile
+aclocal.m4
+config.cache
+config.h
+config.log
+config.status
+configure
+core
+core.*
+html
+
+/Make.rules
+/autom4te.cache
+/po/*.mo
+/po/*.po.bak
+/src/opt_gettext.ml
+/src/version.ml
+/src/virt-top
+/src/virt-top.1
+/src/virt-top.txt
+/virt-top-*.tar.gz
diff --git a/.tx/config b/.tx/config
deleted file mode 100644
index 3e17770..0000000
--- a/.tx/config
+++ /dev/null
@@ -1,8 +0,0 @@
-[main]
-host = https://www.transifex.net
-
-[virttop.virttoppot]
-file_filter = po/<lang>.po
-source_file = po/virt-top.pot
-source_lang = en
-
diff --git a/ChangeLog b/ChangeLog
index 8daca45..1b3999a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,33 @@
+2016-10-31 Richard W.M. Jones <rjones@redhat.com>
+
+ 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.
+
+ This is entirely refactoring and makes no functional change.
+
+ Also this fixes the MANIFEST file and removes old Transifex
+ configuration, fixing commit defe5bdd4a32e0206a786d279e0f9cfc238e5e17.
+
+2016-01-04 Richard W.M. Jones <rjones@redhat.com>
+
+ build: Add -g flag to ocamlopt.
+ Modern ocamlopt supports the -g flag fine (very old versions did not).
+
+2015-02-21 Richard W.M. Jones <rjones@redhat.com>
+
+ Update translations from Zanata.
+
+ Move upstream translations from Tranifex to Zanata.
+ This is at the request of the Fedora localization team.
+ For further information see:
+
+ https://www.redhat.com/archives/libguestfs/2015-February/msg00168.html
+
+2014-08-02 Richard W.M. Jones <rjones@redhat.com>
+
+ Disable warning about immutable strings (for OCaml 4.02).
+
2012-10-12 Richard W.M. Jones <rjones@redhat.com>
Version 1.0.8.
diff --git a/MANIFEST b/MANIFEST
index c5958d7..2cf377f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -14,12 +14,17 @@ Make.rules.in
MANIFEST
m4/ocaml.m4
po/as.po
+po/ca.po
po/de.po
po/es.po
+po/eu.po
po/fr.po
po/gu.po
+po/hu.po
+po/id.po
po/it.po
po/ja.po
+po/ka.po
po/kn.po
po/LINGUAS
po/Makefile.in
@@ -27,30 +32,36 @@ po/ml.po
po/mr.po
po/nl.po
po/or.po
+po/pa.po
po/pl.po
po/pt_BR.po
po/pt.po
po/POTFILES
po/ru.po
+po/sr.po
+po/sv.po
po/te.po
+po/tg.po
+po/tr.po
po/uk.po
po/virt-top.pot
+po/zanata-pull.sh
+po/zanata.xml
po/zh_CN.po
po/zh_TW.po
README
TODO
-.tx/config
-virt-top/.depend
-virt-top/Makefile.in
-virt-top/README
-virt-top/virt-top.pod
-virt-top/virt_top.ml
-virt-top/virt_top.mli
-virt-top/virt_top_calendar1.ml
-virt-top/virt_top_calendar2.ml
-virt-top/virt_top_csv.ml
-virt-top/virt_top_main.ml
-virt-top/virt_top_utils.ml
-virt-top/virt_top_utils.mli
-virt-top/virt_top_version.ml.in
-virt-top/virt_top_xml.ml
+src/.depend
+src/Makefile.in
+src/README
+src/main.ml
+src/opt_calendar1.ml
+src/opt_calendar2.ml
+src/opt_csv.ml
+src/opt_xml.ml
+src/top.ml
+src/top.mli
+src/utils.ml
+src/utils.mli
+src/version.ml.in
+src/virt-top.pod
diff --git a/Makefile.in b/Makefile.in
index b310e58..d0aec17 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -22,25 +22,22 @@ INSTALL = @INSTALL@
MAKENSIS = @MAKENSIS@
-SUBDIRS = virt-top
+SUBDIRS = src
all opt depend install:
- for d in $(SUBDIRS); do \
- $(MAKE) -C $$d $@; \
- if [ $$? -ne 0 ]; then exit 1; fi; \
- done
+ $(MAKE) -C src $@
clean:
for d in . $(SUBDIRS); do \
(cd $$d; rm -f *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a *.so *.opt *~ *.dll *.exe core); \
done
- rm -f virt-top/virt-top
+ rm -f src/virt-top
distclean: clean
rm -f config.h config.log config.status configure
rm -rf autom4te.cache
rm -f Makefile
- rm -f virt-top/Makefile
+ rm -f src/Makefile
# Distribution.
@@ -51,8 +48,8 @@ dist: ChangeLog
tar -cf - -T MANIFEST | tar -C $(PACKAGE)-$(VERSION) -xf -
$(INSTALL) -m 0755 configure $(PACKAGE)-$(VERSION)/
$(INSTALL) -m 0644 aclocal.m4 $(PACKAGE)-$(VERSION)/
- $(INSTALL) -m 0644 virt-top/virt-top.1 $(PACKAGE)-$(VERSION)/virt-top/
- $(INSTALL) -m 0644 virt-top/virt-top.txt $(PACKAGE)-$(VERSION)/virt-top/
+ $(INSTALL) -m 0644 src/virt-top.1 $(PACKAGE)-$(VERSION)/src/
+ $(INSTALL) -m 0644 src/virt-top.txt $(PACKAGE)-$(VERSION)/src/
tar zcf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION)
rm -rf $(PACKAGE)-$(VERSION)
ls -l $(PACKAGE)-$(VERSION).tar.gz
diff --git a/README b/README
index 5a8bc87..d97fa62 100644
--- a/README
+++ b/README
@@ -1,7 +1,7 @@
virt-top
----------------------------------------------------------------------
-Copyright (C) 2007-2012 Richard W.M. Jones, Red Hat Inc.
+Copyright (C) 2007-2016 Richard W.M. Jones, Red Hat Inc.
http://et.redhat.com/~rjones/virt-top/
http://libvirt.org/ocaml/
http://libvirt.org/
diff --git a/configure.ac b/configure.ac
index 0d41cda..ad65465 100644
--- a/configure.ac
+++ b/configure.ac
@@ -84,26 +84,24 @@ AC_CHECK_PROG(MSGFMT,msgfmt,msgfmt)
dnl Write gettext modules for the programs.
dnl http://www.le-gall.net/sylvain+violaine/documentation/ocaml-gettext/html/reference-manual/ch03s04.html
-for d in virt-top; do
- f=`echo $d | tr - _`_gettext.ml
- AC_MSG_NOTICE([creating $d/$f])
- rm -f $d/$f
- echo "(* This file is generated automatically by ./configure. *)" > $d/$f
- if test "x$OCAML_PKG_gettext" != "xno"; then
- # Gettext module is available, so use it.
- cat <<EOT >>$d/$f
+AC_MSG_NOTICE([creating src/opt_gettext.ml])
+rm -f src/opt_gettext.ml
+echo "(* This file is generated automatically by ./configure. *)" > src/opt_gettext.ml
+if test "x$OCAML_PKG_gettext" != "xno"; then
+ # Gettext module is available, so use it.
+ cat <<EOT >>src/opt_gettext.ml
module Gettext = Gettext.Program (
struct
- let textdomain = "$d"
+ let textdomain = "virt-top"
let codeset = None
let dir = None
let dependencies = [[]]
end
) (GettextStub.Native)
EOT
- else
- # No gettext module is available, so fake the translation functions.
- cat <<EOT >>$d/$f
+else
+ # No gettext module is available, so fake the translation functions.
+ cat <<EOT >>src/opt_gettext.ml
module Gettext = struct
external s_ : string -> string = "%identity"
external f_ : ('a -> 'b, 'c, 'd) format -> ('a -> 'b, 'c, 'd) format
@@ -115,8 +113,7 @@ module Gettext = struct
= fun s p n -> if n = 1 then s else p
end
EOT
- fi
-done
+fi
dnl Summary.
echo "------------------------------------------------------------"
@@ -128,7 +125,7 @@ AC_CONFIG_HEADERS([config.h])
AC_CONFIG_FILES([Makefile
Make.rules
po/Makefile
- virt-top/Makefile
- virt-top/virt_top_version.ml
+ src/Makefile
+ src/version.ml
])
AC_OUTPUT
diff --git a/src/.depend b/src/.depend
new file mode 100644
index 0000000..5325c54
--- /dev/null
+++ b/src/.depend
@@ -0,0 +1,20 @@
+main.cmo: top.cmi opt_gettext.cmo
+main.cmx: top.cmx opt_gettext.cmx
+opt_calendar1.cmo: top.cmi opt_gettext.cmo
+opt_calendar1.cmx: top.cmx opt_gettext.cmx
+opt_calendar2.cmo: top.cmi opt_gettext.cmo
+opt_calendar2.cmx: top.cmx opt_gettext.cmx
+opt_csv.cmo: top.cmi opt_gettext.cmo
+opt_csv.cmx: top.cmx opt_gettext.cmx
+opt_gettext.cmo:
+opt_gettext.cmx:
+opt_xml.cmo: top.cmi opt_gettext.cmo
+opt_xml.cmx: top.cmx opt_gettext.cmx
+top.cmi:
+top.cmo: version.cmo utils.cmi opt_gettext.cmo top.cmi
+top.cmx: version.cmx utils.cmx opt_gettext.cmx top.cmi
+utils.cmi:
+utils.cmo: opt_gettext.cmo utils.cmi
+utils.cmx: opt_gettext.cmx utils.cmi
+version.cmo:
+version.cmx:
diff --git a/virt-top/Makefile.in b/src/Makefile.in
similarity index 91%
rename from virt-top/Makefile.in
rename to src/Makefile.in
index e149b26..d29f2e8 100755
--- a/virt-top/Makefile.in
+++ b/src/Makefile.in
@@ -39,28 +39,28 @@ OCAMLCPACKAGES += -package gettext-stub
endif
OBJS := \
- virt_top_version.cmo \
- virt_top_gettext.cmo \
- virt_top_utils.cmo \
- virt_top.cmo
+ version.cmo \
+ opt_gettext.cmo \
+ utils.cmo \
+ top.cmo
ifneq ($(OCAML_PKG_xml_light),no)
-OBJS += virt_top_xml.cmo
+OBJS += opt_xml.cmo
OCAMLCPACKAGES += -package xml-light
endif
ifneq ($(OCAML_PKG_csv),no)
-OBJS += virt_top_csv.cmo
+OBJS += opt_csv.cmo
OCAMLCPACKAGES += -package csv
endif
ifneq ($(OCAML_PKG_calendar),no)
ifeq ($(is_calendar2),no)
-OBJS += virt_top_calendar1.cmo
+OBJS += opt_calendar1.cmo
OCAMLCPACKAGES += -package calendar
else
-OBJS += virt_top_calendar2.cmo
+OBJS += opt_calendar2.cmo
OCAMLCPACKAGES += -package calendar
endif
endif
-OBJS += virt_top_main.cmo
+OBJS += main.cmo
XOBJS := $(OBJS:.cmo=.cmx)
diff --git a/virt-top/README b/src/README
similarity index 77%
rename from virt-top/README
rename to src/README
index b594f95..47382a5 100755
--- a/virt-top/README
+++ b/src/README
@@ -1,11 +1,11 @@
The code is structured into these files:
- virt_top_utils.mli / virt_top_utils.ml
+ utils.mli, utils.ml
String functions and other small utility functions. This is
included directly into virt_top.ml.
- virt_top.mli / virt_top.ml
+ top.mli, top.ml
This is the virt-top program.
@@ -22,7 +22,11 @@ The code is structured into these files:
The function 'main_loop' runs the main loop and has sub-functions
to deal with keypresses, help screens and so on.
- virt_top_xml.ml
+ opt_gettext.ml
+ A generated file which adds gettext support if ocaml-gettext
+ was found at configure time, or else stubs it out.
+
+ opt_xml.ml
Any code which needs the optional xml-light library goes
in here. Mainly for parsing domain XML descriptions to get
@@ -31,21 +35,21 @@ 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.
- virt_top_csv.ml
+ opt_csv.ml
Any code which needs the optional ocaml-csv library goes
in here. This implements the --csv command line option.
- virt_top_calendar.ml
+ opt_calendar1.ml, opt_calendar2.ml
Any code which needs the optional ocaml-calendar library
- goes in here. This implements the --end-time command line
- option.
+ (v1 or v2) goes in here. This implements the --end-time
+ command line option.
- virt_top_main.ml
+ main.ml
This is just a small bit of code to glue the modules together
- Virt_top + Virt_top_xml? + Virt_top_csv? + Virt_top_calendar?
+ Top + Opt_xml? + Opt_csv? + Opt_calendar{1,2}?
The man-page is generated from the single file:
diff --git a/virt-top/virt_top_main.ml b/src/main.ml
similarity index 98%
rename from virt-top/virt_top_main.ml
rename to src/main.ml
index e8c4425..34d13c8 100644
--- a/virt-top/virt_top_main.ml
+++ b/src/main.ml
@@ -21,8 +21,8 @@
open Curses
-open Virt_top_gettext.Gettext
-open Virt_top
+open Opt_gettext.Gettext
+open Top
(* Note: make sure we catch any exceptions and clean up the display.
*
diff --git a/virt-top/virt_top_calendar1.ml b/src/opt_calendar1.ml
similarity index 97%
rename from virt-top/virt_top_calendar1.ml
rename to src/opt_calendar1.ml
index 534465c..2c459fe 100755
--- a/virt-top/virt_top_calendar1.ml
+++ b/src/opt_calendar1.ml
@@ -22,9 +22,9 @@
open Printf
open ExtString
-open Virt_top_gettext.Gettext ;;
+open Opt_gettext.Gettext ;;
-Virt_top.parse_date_time :=
+Top.parse_date_time :=
fun time ->
let cal : Calendar.t =
if String.starts_with time "+" then ( (* +something *)
diff --git a/virt-top/virt_top_calendar2.ml b/src/opt_calendar2.ml
similarity index 97%
rename from virt-top/virt_top_calendar2.ml
rename to src/opt_calendar2.ml
index cc82eec..fd93704 100755
--- a/virt-top/virt_top_calendar2.ml
+++ b/src/opt_calendar2.ml
@@ -24,9 +24,9 @@ open CalendarLib
open Printf
open ExtString
-open Virt_top_gettext.Gettext ;;
+open Opt_gettext.Gettext ;;
-Virt_top.parse_date_time :=
+Top.parse_date_time :=
fun time ->
let cal : Calendar.t =
if String.starts_with time "+" then ( (* +something *)
diff --git a/virt-top/virt_top_csv.ml b/src/opt_csv.ml
similarity index 94%
rename from virt-top/virt_top_csv.ml
rename to src/opt_csv.ml
index e048856..6c3b2be 100644
--- a/virt-top/virt_top_csv.ml
+++ b/src/opt_csv.ml
@@ -19,16 +19,16 @@
This file contains all code which requires CSV support.
*)
-open Virt_top_gettext.Gettext
+open Opt_gettext.Gettext
(* Output channel, or None if CSV output not enabled. *)
let chan = ref None ;;
-Virt_top.csv_start :=
+Top.csv_start :=
fun filename ->
chan := Some (open_out filename) ;;
-Virt_top.csv_write :=
+Top.csv_write :=
fun row ->
match !chan with
| None -> () (* CSV output not enabled. *)
diff --git a/virt-top/virt_top_xml.ml b/src/opt_xml.ml
similarity index 97%
rename from virt-top/virt_top_xml.ml
rename to src/opt_xml.ml
index ab291d3..bb83780 100644
--- a/virt-top/virt_top_xml.ml
+++ b/src/opt_xml.ml
@@ -21,13 +21,13 @@
open ExtList
-open Virt_top_gettext.Gettext
+open Opt_gettext.Gettext
module C = Libvirt.Connect
module D = Libvirt.Domain
module N = Libvirt.Network ;;
-Virt_top.parse_device_xml :=
+Top.parse_device_xml :=
fun id dom ->
try
let xml = D.get_xml_desc dom in
diff --git a/virt-top/virt_top.ml b/src/top.ml
similarity index 99%
rename from virt-top/virt_top.ml
rename to src/top.ml
index 0aae24e..38658c6 100644
--- a/virt-top/virt_top.ml
+++ b/src/top.ml
@@ -21,8 +21,8 @@ open Printf
open ExtList
open Curses
-open Virt_top_gettext.Gettext
-open Virt_top_utils
+open Opt_gettext.Gettext
+open Utils
module C = Libvirt.Connect
module D = Libvirt.Domain
@@ -159,7 +159,7 @@ let start_up () =
and set_end_time time = end_time := Some ((!parse_date_time) time)
and display_version () =
printf "virt-top %s ocaml-libvirt %s\n"
- Virt_top_version.version Libvirt_version.version;
+ Version.version Libvirt_version.version;
exit 0
in
let argspec = Arg.align [
@@ -1723,7 +1723,7 @@ and show_help (_, _, _, _, _, _, hostname,
(* Banner at the top of the screen. *)
let banner =
sprintf (f_"virt-top %s ocaml-libvirt %s libvirt %d.%d.%d by Red Hat")
- Virt_top_version.version
+ Version.version
Libvirt_version.version
libvirt_major libvirt_minor libvirt_release in
let banner = pad cols banner in
diff --git a/virt-top/virt_top.mli b/src/top.mli
similarity index 100%
rename from virt-top/virt_top.mli
rename to src/top.mli
diff --git a/virt-top/virt_top_utils.ml b/src/utils.ml
similarity index 99%
rename from virt-top/virt_top_utils.ml
rename to src/utils.ml
index c5dc97d..3dc637d 100644
--- a/virt-top/virt_top_utils.ml
+++ b/src/utils.ml
@@ -21,7 +21,7 @@
open Printf
-open Virt_top_gettext.Gettext
+open Opt_gettext.Gettext
module C = Libvirt.Connect
module D = Libvirt.Domain
diff --git a/virt-top/virt_top_utils.mli b/src/utils.mli
similarity index 100%
rename from virt-top/virt_top_utils.mli
rename to src/utils.mli
diff --git a/virt-top/virt_top_version.ml.in b/src/version.ml.in
similarity index 100%
rename from virt-top/virt_top_version.ml.in
rename to src/version.ml.in
diff --git a/virt-top/virt-top.pod b/src/virt-top.pod
similarity index 100%
rename from virt-top/virt-top.pod
rename to src/virt-top.pod
diff --git a/virt-top/.depend b/virt-top/.depend
deleted file mode 100644
index 46099b7..0000000
--- a/virt-top/.depend
+++ /dev/null
@@ -1,20 +0,0 @@
-virt_top_calendar1.cmo: virt_top_gettext.cmo virt_top.cmi
-virt_top_calendar1.cmx: virt_top_gettext.cmx virt_top.cmx
-virt_top_calendar2.cmo: virt_top_gettext.cmo virt_top.cmi
-virt_top_calendar2.cmx: virt_top_gettext.cmx virt_top.cmx
-virt_top.cmi:
-virt_top.cmo: virt_top_version.cmo virt_top_utils.cmi virt_top_gettext.cmo virt_top.cmi
-virt_top.cmx: virt_top_version.cmx virt_top_utils.cmx virt_top_gettext.cmx virt_top.cmi
-virt_top_csv.cmo: virt_top_gettext.cmo virt_top.cmi
-virt_top_csv.cmx: virt_top_gettext.cmx virt_top.cmx
-virt_top_gettext.cmo:
-virt_top_gettext.cmx:
-virt_top_main.cmo: virt_top_gettext.cmo virt_top.cmi
-virt_top_main.cmx: virt_top_gettext.cmx virt_top.cmx
-virt_top_utils.cmi:
-virt_top_utils.cmo: virt_top_gettext.cmo virt_top_utils.cmi
-virt_top_utils.cmx: virt_top_gettext.cmx virt_top_utils.cmi
-virt_top_version.cmo:
-virt_top_version.cmx:
-virt_top_xml.cmo: virt_top_gettext.cmo virt_top.cmi
-virt_top_xml.cmx: virt_top_gettext.cmx virt_top.cmx
--
2.13.1

View File

@ -1,34 +0,0 @@
From 5500a027ad231eb5bb16e36efee72b48cfac9528 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 27 Mar 2017 12:21:48 +0100
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:
File "top.ml", line 377, characters 12-25:
Warning 3: deprecated: String.create
Use Bytes.create instead.
Since we want to continue using old OCaml for now, don't enable
this warning.
---
src/Makefile.in | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/src/Makefile.in b/src/Makefile.in
index d29f2e8..d744fd7 100755
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -64,7 +64,7 @@ OBJS += main.cmo
XOBJS := $(OBJS:.cmo=.cmx)
-OCAMLCFLAGS := -g -warn-error A-3
+OCAMLCFLAGS := -g -warn-error CDEFLMPSUVYZX-3
OCAMLCLIBS := -linkpkg
OCAMLOPTPACKAGES := $(OCAMLCPACKAGES)
--
2.13.1

View File

@ -1,48 +0,0 @@
From 8cd690d0b8a5343d8731145b95931ec7aaa2db35 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 27 Mar 2017 12:25:19 +0100
Subject: [PATCH 07/19] Remove +x (executable) permission on several source
files.
Not sure why it was there, but it was incorrect.
---
src/Makefile.in | 0
src/README | 0
src/opt_calendar1.ml | 0
src/opt_calendar2.ml | 0
src/top.mli | 0
src/utils.mli | 0
src/virt-top.pod | 0
7 files changed, 0 insertions(+), 0 deletions(-)
mode change 100755 => 100644 src/Makefile.in
mode change 100755 => 100644 src/README
mode change 100755 => 100644 src/opt_calendar1.ml
mode change 100755 => 100644 src/opt_calendar2.ml
mode change 100755 => 100644 src/top.mli
mode change 100755 => 100644 src/utils.mli
mode change 100755 => 100644 src/virt-top.pod
diff --git a/src/Makefile.in b/src/Makefile.in
old mode 100755
new mode 100644
diff --git a/src/README b/src/README
old mode 100755
new mode 100644
diff --git a/src/opt_calendar1.ml b/src/opt_calendar1.ml
old mode 100755
new mode 100644
diff --git a/src/opt_calendar2.ml b/src/opt_calendar2.ml
old mode 100755
new mode 100644
diff --git a/src/top.mli b/src/top.mli
old mode 100755
new mode 100644
diff --git a/src/utils.mli b/src/utils.mli
old mode 100755
new mode 100644
diff --git a/src/virt-top.pod b/src/virt-top.pod
old mode 100755
new mode 100644
--
2.13.1

View File

@ -1,95 +0,0 @@
From cc9f1f9d8f17e8ac5a6a73af830c132d916fd6e0 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 27 Mar 2017 12:30:01 +0100
Subject: [PATCH 08/19] Refresh HACKING file.
Fixes commit b7c3ef13cbd9c9cd49005a32ffb70faf6f5bbe8c.
---
HACKING | 72 ++---------------------------------------------------------------
1 file changed, 2 insertions(+), 70 deletions(-)
diff --git a/HACKING b/HACKING
index bce40a9..3cd266b 100644
--- a/HACKING
+++ b/HACKING
@@ -7,75 +7,7 @@ General OCaml advice:
(2) Emacs users: use tuareg-mode for editing OCaml.
-(3) http://www.ocaml-tutorial.org/
+(3) https://realworldocaml.org/ is the definitive book which is also
+ available online in full.
(4) http://camltastic.blogspot.com/2008/08/3-things-that-will-confuse-you-when.html
-
-The code is structured into these files:
-
- virt_top_utils.mli / virt_top_utils.ml
-
- String functions and other small utility functions. This is
- included directly into virt_top.ml.
-
- virt_top_version.ml
-
- The version number (automatically generated by configure).
-
- virt_top.mli / virt_top.ml
-
- 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.
-
- The function 'main_loop' runs the main loop and has sub-functions
- to deal with keypresses, help screens and so on.
-
- virt_top_xml.ml
-
- Any code which needs the optional xml-light library goes
- in here. Mainly for parsing domain XML descriptions to get
- the list of block devices and network interfaces.
-
- The reason for having it in a separate file is so that we
- don't depend on xml-light.
-
- virt_top_csv.ml
-
- Any code which needs the optional ocaml-csv library goes
- in here. This implements the --csv command line option.
-
- virt_top_calendar1.ml
- virt_top_calendar2.ml
-
- Any code which needs the optional ocaml-calendar library
- goes in here. This implements the --end-time command line
- option. Note there are two incompatible versions of the
- ocaml-calendar library, which is why we have two
- implementations. The Makefile works out which one to use.
-
- virt_top_gettext.ml
-
- Gettext interaction (this is generated by ./configure).
-
- virt_top_main.ml
-
- This is just a small bit of code to glue the modules above
- together.
-
-The man-page is generated from the single file:
-
- virt-top.pod
-
-which generates (using perldoc) the following:
-
- virt-top.1
- virt-top.txt
--
2.13.1

View File

@ -1,34 +0,0 @@
From 1b4980da40000a34ec987f83824dd69454c4e8e4 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 27 Mar 2017 12:33:22 +0100
Subject: [PATCH 09/19] Fix po/POTFILES for new location of source files.
Fixes commit b7c3ef13cbd9c9cd49005a32ffb70faf6f5bbe8c.
---
po/POTFILES | 16 +++++++++-------
1 file changed, 9 insertions(+), 7 deletions(-)
diff --git a/po/POTFILES b/po/POTFILES
index 55bb82d..70d62d5 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -1,7 +1,9 @@
-../virt-top/virt_top_calendar1.ml
-../virt-top/virt_top_calendar2.ml
-../virt-top/virt_top_csv.ml
-../virt-top/virt_top_main.ml
-../virt-top/virt_top.ml
-../virt-top/virt_top_utils.ml
-../virt-top/virt_top_xml.ml
+../src/main.ml
+../src/opt_calendar1.ml
+../src/opt_calendar2.ml
+../src/opt_csv.ml
+../src/opt_gettext.ml
+../src/opt_xml.ml
+../src/top.ml
+../src/utils.ml
+../src/version.ml
--
2.13.1

File diff suppressed because it is too large Load Diff

View File

@ -1,203 +0,0 @@
From effd1ec5897a2cac6e897ae7bce72f6b1e617b90 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 27 Mar 2017 12:41:21 +0100
Subject: [PATCH 11/19] Remove support for OCaml Calendar v1.
Calendar v2 was released in 2008 (9 years ago!), thus remove support
for v1.
This was already broken by commit dc0e217390132f7e76a4d9c0a8a81a9556d19081
so it likely didn't work anyway.
---
MANIFEST | 3 +-
configure.ac | 6 ----
po/POTFILES | 3 +-
src/.depend | 6 ++--
src/Makefile.in | 7 +---
src/README | 8 ++---
src/{opt_calendar2.ml => opt_calendar.ml} | 0
src/opt_calendar1.ml | 56 -------------------------------
8 files changed, 9 insertions(+), 80 deletions(-)
rename src/{opt_calendar2.ml => opt_calendar.ml} (100%)
delete mode 100644 src/opt_calendar1.ml
diff --git a/MANIFEST b/MANIFEST
index 2cf377f..26e87b2 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -55,8 +55,7 @@ src/.depend
src/Makefile.in
src/README
src/main.ml
-src/opt_calendar1.ml
-src/opt_calendar2.ml
+src/opt_calendar.ml
src/opt_csv.ml
src/opt_xml.ml
src/top.ml
diff --git a/configure.ac b/configure.ac
index ad65465..c9c7e34 100644
--- a/configure.ac
+++ b/configure.ac
@@ -57,12 +57,7 @@ dnl Check for optional OCaml packages.
AC_CHECK_OCAML_PKG(gettext)
AC_CHECK_OCAML_PKG(xml-light)
AC_CHECK_OCAML_PKG(csv)
-
-dnl Need to check which version of calendar is installed.
AC_CHECK_OCAML_PKG(calendar)
-if test "x$OCAML_PKG_calendar" != "xno"; then
- AC_CHECK_OCAML_MODULE(is_calendar2,calendar,[CalendarLib.Date],[+$OCAML_PKG_calendar])
-fi
AC_SUBST(OCAML_PKG_unix)
AC_SUBST(OCAML_PKG_extlib)
@@ -71,7 +66,6 @@ AC_SUBST(OCAML_PKG_gettext)
AC_SUBST(OCAML_PKG_xml_light)
AC_SUBST(OCAML_PKG_csv)
AC_SUBST(OCAML_PKG_calendar)
-AC_SUBST(is_calendar2)
dnl Check for optional perldoc (for building manual pages).
AC_CHECK_PROG(HAVE_PERLDOC,perldoc,perldoc)
diff --git a/po/POTFILES b/po/POTFILES
index 70d62d5..b826a2a 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -1,6 +1,5 @@
../src/main.ml
-../src/opt_calendar1.ml
-../src/opt_calendar2.ml
+../src/opt_calendar.ml
../src/opt_csv.ml
../src/opt_gettext.ml
../src/opt_xml.ml
diff --git a/src/.depend b/src/.depend
index 5325c54..f487c18 100644
--- a/src/.depend
+++ b/src/.depend
@@ -1,9 +1,7 @@
main.cmo: top.cmi opt_gettext.cmo
main.cmx: top.cmx opt_gettext.cmx
-opt_calendar1.cmo: top.cmi opt_gettext.cmo
-opt_calendar1.cmx: top.cmx opt_gettext.cmx
-opt_calendar2.cmo: top.cmi opt_gettext.cmo
-opt_calendar2.cmx: top.cmx opt_gettext.cmx
+opt_calendar.cmo: top.cmi opt_gettext.cmo
+opt_calendar.cmx: top.cmx opt_gettext.cmx
opt_csv.cmo: top.cmi opt_gettext.cmo
opt_csv.cmx: top.cmx opt_gettext.cmx
opt_gettext.cmo:
diff --git a/src/Makefile.in b/src/Makefile.in
index d744fd7..ae896cb 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -52,13 +52,8 @@ OBJS += opt_csv.cmo
OCAMLCPACKAGES += -package csv
endif
ifneq ($(OCAML_PKG_calendar),no)
-ifeq ($(is_calendar2),no)
-OBJS += opt_calendar1.cmo
+OBJS += opt_calendar.cmo
OCAMLCPACKAGES += -package calendar
-else
-OBJS += opt_calendar2.cmo
-OCAMLCPACKAGES += -package calendar
-endif
endif
OBJS += main.cmo
diff --git a/src/README b/src/README
index 47382a5..8aa2348 100644
--- a/src/README
+++ b/src/README
@@ -40,16 +40,16 @@ The code is structured into these files:
Any code which needs the optional ocaml-csv library goes
in here. This implements the --csv command line option.
- opt_calendar1.ml, opt_calendar2.ml
+ opt_calendar.ml
Any code which needs the optional ocaml-calendar library
- (v1 or v2) goes in here. This implements the --end-time
- command line option.
+ (v2) goes in here. This implements the --end-time command
+ line option.
main.ml
This is just a small bit of code to glue the modules together
- Top + Opt_xml? + Opt_csv? + Opt_calendar{1,2}?
+ Top + Opt_xml? + Opt_csv? + Opt_calendar?
The man-page is generated from the single file:
diff --git a/src/opt_calendar2.ml b/src/opt_calendar.ml
similarity index 100%
rename from src/opt_calendar2.ml
rename to src/opt_calendar.ml
diff --git a/src/opt_calendar1.ml b/src/opt_calendar1.ml
deleted file mode 100644
index 2c459fe..0000000
--- a/src/opt_calendar1.ml
+++ /dev/null
@@ -1,56 +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 ocaml-calendar < 2.0
-*)
-
-open Printf
-open ExtString
-
-open Opt_gettext.Gettext ;;
-
-Top.parse_date_time :=
-fun time ->
- let cal : Calendar.t =
- if String.starts_with time "+" then ( (* +something *)
- let period = String.sub time 1 (String.length time - 1) in
- let period =
- if String.contains period ':' then ( (* +HH:MM:SS *)
- let t = Printer.TimePrinter.from_string period in
- let hh = Time.hour t and mm = Time.minute t and ss = Time.second t in
- Calendar.Period.make 0 0 0 hh mm ss
- ) else (* +seconds *)
- Calendar.Period.second (int_of_string period) in
- (* Add it as an offset from the current time. *)
- Calendar.add (Calendar.now ()) period
- ) else (
- if String.contains time '-' then (* YYYY-MM-DD HH:MM:SS *)
- Printer.CalendarPrinter.from_string time
- else ( (* HH:MM:SS *)
- let time = Printer.TimePrinter.from_string time in
- Calendar.create (Date.today ()) time
- )
- ) in
-
- eprintf "end time: %s\n" (Printer.CalendarPrinter.to_string cal);
-
- (* Convert to a time_t. Note that we compare this against
- * Unix.gettimeofday in the main module, so this must be returned as
- * plain seconds from 1970 with no timezone adjustment. (RHBZ#637964)
- *)
- Calendar.to_unixfloat cal
--
2.13.1

View File

@ -1,76 +0,0 @@
From 3e9ed9c0fe49c3d4e4a8e467d521f676769c485a Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 27 Mar 2017 13:06:18 +0100
Subject: [PATCH 12/19] src: Fix some comments which referred to the old
filenames.
Fixes commit b7c3ef13cbd9c9cd49005a32ffb70faf6f5bbe8c.
---
src/top.ml | 8 ++++----
src/top.mli | 6 +++---
2 files changed, 7 insertions(+), 7 deletions(-)
diff --git a/src/top.ml b/src/top.ml
index 38658c6..f50e6a8 100644
--- a/src/top.ml
+++ b/src/top.ml
@@ -30,13 +30,13 @@ module N = Libvirt.Network
let rcfile = ".virt-toprc"
-(* Hook for XML support (see virt_top_xml.ml). *)
+(* Hook for XML support (see [opt_xml.ml]). *)
let parse_device_xml : (int -> [>`R] D.t -> string list * string list) ref =
ref (
fun _ _ -> [], []
)
-(* Hooks for CSV support (see virt_top_csv.ml). *)
+(* 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")
@@ -46,7 +46,7 @@ let csv_write : (string list -> unit) ref =
fun _ -> ()
)
-(* Hook for calendar support (see virt_top_calendar.ml). *)
+(* Hook for calendar support (see [opt_calendar.ml]). *)
let parse_date_time : (string -> float) ref =
ref (
fun _ ->
@@ -345,7 +345,7 @@ OPTIONS" in
(* This tuple of static information is called 'setup' in other parts
* of this program, and is passed to other functions such as redraw and
- * main_loop. See virt_top_main.ml.
+ * main_loop. See [main.ml].
*)
(conn,
!batch_mode, !script_mode, !csv_enabled, !stream_mode, (* immutable modes *)
diff --git a/src/top.mli b/src/top.mli
index 3ad0718..b0953dd 100644
--- a/src/top.mli
+++ b/src/top.mli
@@ -17,15 +17,15 @@
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)
-(* Hook for virt_top_xml to override (if present). *)
+(* Hook for [Opt_xml] to override (if present). *)
val parse_device_xml :
(int -> [ `R ] Libvirt.Domain.t -> string list * string list) ref
-(* Hooks for virt_top_csv to override (if present). *)
+(* Hooks for [Opt_csv] to override (if present). *)
val csv_start : (string -> unit) ref
val csv_write : (string list -> unit) ref
-(* Hook for virt_top_calendar to override (if present). *)
+(* Hook for [Opt_calendar] to override (if present). *)
val parse_date_time : (string -> float) ref
type setup =
--
2.13.1

File diff suppressed because it is too large Load Diff

View File

@ -1,211 +0,0 @@
From 431dbd98bad6e3635b4d0885bf33dd3e759ca35d Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 27 Mar 2017 21:22:52 +0100
Subject: [PATCH 14/19] Move block_in_bytes entirely to the presentation layer.
Simplifies and updates commit dbef8dd3bf00417e75a12c851b053e49c9e1a79e.
---
src/collect.ml | 19 +++----------------
src/collect.mli | 6 +-----
src/csv_output.ml | 14 ++++++++++----
src/csv_output.mli | 2 +-
src/redraw.ml | 10 +++++++---
src/stream_output.ml | 14 ++++++++++----
src/top.ml | 4 ++--
7 files changed, 34 insertions(+), 35 deletions(-)
diff --git a/src/collect.ml b/src/collect.ml
index f856067..448ce8c 100644
--- a/src/collect.ml
+++ b/src/collect.ml
@@ -57,12 +57,8 @@ and rd_active = {
(* The following are since the last slice, or None if cannot be calc'd: *)
rd_block_rd_reqs : int64 option; (* Number of block device read rqs. *)
rd_block_wr_reqs : int64 option; (* Number of block device write rqs. *)
- rd_block_rd_bytes : int64 option; (* Number of bytes block device read *)
- rd_block_wr_bytes : int64 option; (* Number of bytes block device write *)
- (* _info fields includes the number considering --block_in_bytes option *)
- rd_block_rd_info : int64 option; (* Block device read info for user *)
- rd_block_wr_info : int64 option; (* Block device read info for user *)
-
+ rd_block_rd_bytes : int64 option; (* Number of bytes block device read *)
+ rd_block_wr_bytes : int64 option; (* Number of bytes block device write *)
rd_net_rx_bytes : int64 option; (* Number of bytes received. *)
rd_net_tx_bytes : int64 option; (* Number of bytes transmitted. *)
}
@@ -114,7 +110,7 @@ let last_pcpu_usages = Hashtbl.create 13
let clear_pcpu_display_data () =
Hashtbl.clear last_pcpu_usages
-let collect (conn, _, _, _, _, node_info, _, _) block_in_bytes =
+let collect (conn, _, _, _, _, node_info, _, _) =
(* Number of physical CPUs (some may be disabled). *)
let nr_pcpus = C.maxcpus_of_node_info node_info in
@@ -178,7 +174,6 @@ let collect (conn, _, _, _, _, node_info, _, _) block_in_bytes =
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_block_rd_info = None; rd_block_wr_info = None;
rd_net_rx_bytes = None; rd_net_tx_bytes = None;
})
with
@@ -256,14 +251,6 @@ let collect (conn, _, _, _, _, node_info, _, _) block_in_bytes =
rd_block_rd_bytes = Some read_bytes;
rd_block_wr_bytes = Some write_bytes;
} in
- let rd = { rd with
- rd_block_rd_info =
- if block_in_bytes then
- rd.rd_block_rd_bytes else rd.rd_block_rd_reqs;
- rd_block_wr_info =
- if block_in_bytes then
- rd.rd_block_wr_bytes else rd.rd_block_wr_reqs;
- } in
name, Active rd
(* For all other domains we can't calculate it, so leave as None. *)
| rd -> rd
diff --git a/src/collect.mli b/src/collect.mli
index 440859b..9ad3dcb 100644
--- a/src/collect.mli
+++ b/src/collect.mli
@@ -48,10 +48,6 @@ and rd_active = {
rd_block_wr_reqs : int64 option; (* Number of block device write rqs. *)
rd_block_rd_bytes : int64 option; (* Number of bytes block device read *)
rd_block_wr_bytes : int64 option; (* Number of bytes block device write *)
- (* _info fields includes the number considering --block_in_bytes option *)
- rd_block_rd_info : int64 option; (* Block device read info for user *)
- rd_block_wr_info : int64 option; (* Block device read info for user *)
-
rd_net_rx_bytes : int64 option; (* Number of bytes received. *)
rd_net_tx_bytes : int64 option; (* Number of bytes transmitted. *)
}
@@ -75,7 +71,7 @@ type pcpu_stats = {
rd_pcpu_pcpus_cpu_time : float array
}
-val collect : Types.setup -> bool -> stats
+val collect : Types.setup -> stats
(** Collect statistics. *)
val collect_pcpu : stats -> pcpu_stats
diff --git a/src/csv_output.ml b/src/csv_output.ml
index 9496ca8..f23d673 100644
--- a/src/csv_output.ml
+++ b/src/csv_output.ml
@@ -56,6 +56,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;
@@ -104,10 +105,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;
diff --git a/src/csv_output.mli b/src/csv_output.mli
index d5eab0f..4064be5 100644
--- a/src/csv_output.mli
+++ b/src/csv_output.mli
@@ -24,4 +24,4 @@ val csv_write : (string list -> unit) ref
val write_csv_header : bool * bool * bool * bool -> bool -> unit
-val append_csv : Types.setup -> bool * bool * bool * bool -> Collect.stats -> unit
+val append_csv : Types.setup -> bool * bool * bool * bool -> bool -> Collect.stats -> unit
diff --git a/src/redraw.ml b/src/redraw.ml
index 9ce889b..0403158 100644
--- a/src/redraw.ml
+++ b/src/redraw.ml
@@ -155,8 +155,12 @@ let redraw display_mode sort_order
| (name, Active rd) :: doms ->
if lineno < lines then (
let state = show_state rd.rd_info.D.state in
- let rd_req = Show.int64_option rd.rd_block_rd_info in
- let wr_req = Show.int64_option rd.rd_block_wr_info in
+ let rd_info =
+ if block_in_bytes then Show.int64_option rd.rd_block_rd_bytes
+ else Show.int64_option rd.rd_block_rd_reqs in
+ let wr_info =
+ if block_in_bytes then Show.int64_option rd.rd_block_wr_bytes
+ else Show.int64_option rd.rd_block_wr_reqs in
let rx_bytes = Show.int64_option rd.rd_net_rx_bytes in
let tx_bytes = Show.int64_option rd.rd_net_tx_bytes in
let percent_cpu = Show.percent rd.rd_percent_cpu in
@@ -166,7 +170,7 @@ let redraw display_mode sort_order
let line =
sprintf "%5d %c %s %s %s %s %s %s %s %s"
- rd.rd_domid state rd_req wr_req rx_bytes tx_bytes
+ rd.rd_domid state rd_info wr_info rx_bytes tx_bytes
percent_cpu percent_mem time name in
let line = pad cols line in
mvaddstr lineno 0 line;
diff --git a/src/stream_output.ml b/src/stream_output.ml
index bf7b114..c3af99b 100644
--- a/src/stream_output.ml
+++ b/src/stream_output.ml
@@ -59,10 +59,16 @@ let append_stream (_, _, _, _, _, node_info, hostname, _) (* setup *)
let dump_domain = fun name rd
-> begin
let state = Screen.show_state rd.rd_info.D.state in
- let rd_req = if rd.rd_block_rd_info = None then " 0"
- else Show.int64_option rd.rd_block_rd_info in
- let wr_req = if rd.rd_block_wr_info = None then " 0"
- else Show.int64_option rd.rd_block_wr_info in
+ let rd_req =
+ if rd.rd_block_rd_reqs = None then " 0"
+ else
+ if block_in_bytes then Show.int64_option rd.rd_block_rd_bytes
+ else Show.int64_option rd.rd_block_rd_reqs in
+ let wr_req =
+ if rd.rd_block_wr_reqs = None then " 0"
+ else
+ if block_in_bytes then Show.int64_option rd.rd_block_wr_bytes
+ else Show.int64_option rd.rd_block_wr_reqs in
let rx_bytes = if rd.rd_net_rx_bytes = None then " 0"
else Show.int64_option rd.rd_net_rx_bytes in
let tx_bytes = if rd.rd_net_tx_bytes = None then " 0"
diff --git a/src/top.ml b/src/top.ml
index 204f3b6..e2a93d6 100644
--- a/src/top.ml
+++ b/src/top.ml
@@ -319,7 +319,7 @@ let rec main_loop ((_, batch_mode, script_mode, csv_enabled, stream_mode, _, _,
while not !quit do
(* Collect stats. *)
- let state = collect setup !block_in_bytes in
+ let state = collect setup in
let pcpu_display =
if !display_mode = PCPUDisplay then Some (collect_pcpu state)
else None in
@@ -331,7 +331,7 @@ let rec main_loop ((_, batch_mode, script_mode, csv_enabled, stream_mode, _, _,
(* Update CSV file. *)
if csv_enabled then
- Csv_output.append_csv setup csv_flags state;
+ Csv_output.append_csv setup csv_flags !block_in_bytes state;
(* Append to stream output file. *)
if stream_mode then
--
2.13.1

View File

@ -1,25 +0,0 @@
From 4f3794d5718249238a74b614a6b486465bc4315d Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 28 Mar 2017 13:09:54 +0100
Subject: [PATCH 15/19] Remove unused variable is_calendar2.
Fixes commit effd1ec5897a2cac6e897ae7bce72f6b1e617b90.
---
src/Makefile.in | 1 -
1 file changed, 1 deletion(-)
diff --git a/src/Makefile.in b/src/Makefile.in
index 64f431e..6a13bef 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -29,7 +29,6 @@ OCAML_PKG_curses = @OCAML_PKG_curses@
OCAML_PKG_xml_light = @OCAML_PKG_xml_light@
OCAML_PKG_csv = @OCAML_PKG_csv@
OCAML_PKG_calendar = @OCAML_PKG_calendar@
-is_calendar2 = @is_calendar2@
OCAML_PKG_gettext = @OCAML_PKG_gettext@
OCAMLCPACKAGES := -package unix,extlib,curses,str,libvirt
--
2.13.1

View File

@ -1,348 +0,0 @@
From c513d05fd4e85953701b1023bef71af62613cf79 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 28 Mar 2017 13:30:07 +0100
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
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 | 252 +++++++++++++++++++++++++++++++++++++++++---------------
src/collect.mli | 1 +
src/utils.ml | 6 ++
src/utils.mli | 3 +
4 files changed, 195 insertions(+), 67 deletions(-)
diff --git a/src/collect.ml b/src/collect.ml
index 448ce8c..a1e50a1 100644
--- a/src/collect.ml
+++ b/src/collect.ml
@@ -38,6 +38,7 @@ let parse_device_xml : (int -> [>`R] D.t -> string list * string list) ref =
type rd_domain = Inactive | Active of rd_active
and rd_active = {
rd_domid : int; (* Domain ID. *)
+ rd_domuuid : Libvirt.uuid; (* Domain UUID. *)
rd_dom : [`R] D.t; (* Domain object. *)
rd_info : D.info; (* Domain CPU info now. *)
rd_block_stats : (string * D.block_stats) list;
@@ -110,6 +111,16 @@ let last_pcpu_usages = Hashtbl.create 13
let clear_pcpu_display_data () =
Hashtbl.clear last_pcpu_usages
+(* What to get from virConnectGetAllDomainStats. *)
+let what = [
+ D.StatsState; D.StatsCpuTotal; D.StatsBalloon; D.StatsVcpu;
+ D.StatsInterface; D.StatsBlock
+]
+(* Which domains to get. Empty list means return all domains:
+ * active, inactive, persistent, transient etc.
+ *)
+let who = []
+
let collect (conn, _, _, _, _, node_info, _, _) =
(* Number of physical CPUs (some may be disabled). *)
let nr_pcpus = C.maxcpus_of_node_info node_info in
@@ -129,72 +140,179 @@ let collect (conn, _, _, _, _, node_info, _, _) =
(* Get the domains. Match up with their last_info (if any). *)
let doms =
- (* Active domains. *)
- let n = C.num_of_domains conn in
- let ids =
- if n > 0 then Array.to_list (C.list_domains conn n)
- else [] in
- let doms =
- List.filter_map (
- fun id ->
- try
- 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 (
+ fun { D.dom_uuid = uuid; D.params = params } ->
+ let nr_params = Array.length params in
+ let get_param name =
+ let rec loop i =
+ if i = nr_params then None
+ else if fst params.(i) = name then Some (snd params.(i))
+ else loop (i+1)
+ in
+ loop 0
+ in
+ let get_param_int name default =
+ match get_param name with
+ | None -> None
+ | Some (D.TypedFieldInt32 i)
+ | Some (D.TypedFieldUInt32 i) -> Some (Int32.to_int i)
+ | Some (D.TypedFieldInt64 i)
+ | Some (D.TypedFieldUInt64 i) -> Some (Int64.to_int i)
+ | _ -> default
+ in
+ let get_param_int64 name default =
+ match get_param name with
+ | None -> None
+ | Some (D.TypedFieldInt32 i)
+ | Some (D.TypedFieldUInt32 i) -> Some (Int64.of_int32 i)
+ | Some (D.TypedFieldInt64 i)
+ | Some (D.TypedFieldUInt64 i) -> Some i
+ | _ -> default
+ 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
+
+ if state = Some 5 (* VIR_DOMAIN_SHUTOFF *) then
+ (name, Inactive)
+ else (
+ (* Active domain. *)
+
+ (* 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
+ * stats, we could simplify here, and also return the
+ * RSS memory. XXX
+ *)
+ let state =
+ match state with
+ | None | Some 0 -> D.InfoNoState
+ | Some 1 -> D.InfoRunning
+ | Some 2 -> D.InfoBlocked
+ | Some 3 -> D.InfoPaused
+ | Some 4 -> D.InfoShutdown
+ | Some 5 -> D.InfoShutoff
+ | Some 6 -> D.InfoCrashed
+ | Some 7 -> D.InfoPaused (* XXX really VIR_DOMAIN_PMSUSPENDED *)
+ | _ -> D.InfoNoState in
+ let memory =
+ match get_param_int64 "balloon.current" None with
+ | None -> 0_L
+ | Some m -> m in
+ let nr_virt_cpu =
+ match get_param_int "vcpu.current" None with
+ | None -> 1
+ | Some v -> v in
+ let cpu_time =
+ (* NB: libvirt does not return cpu.time for non-root domains. *)
+ match get_param_int64 "cpu.time" None with
+ | None -> 0_L
+ | Some ns -> ns in
+ let info = {
+ D.state = state;
+ max_mem = -1_L; (* not used anywhere in virt-top *)
+ memory = memory;
+ nr_virt_cpu = nr_virt_cpu;
+ cpu_time = cpu_time
+ } in
+
+ let nr_block_devs =
+ match get_param_int "block.count" None with
+ | None -> 0
+ | Some i -> i in
+ let block_stats =
+ List.map (
+ fun i ->
+ let dev =
+ match get_param (sprintf "block.%d.name" i) with
+ | None -> sprintf "blk%d" i
+ | Some (D.TypedFieldString s) -> s
+ | _ -> assert false in
+ dev, {
+ D.rd_req =
+ (match get_param_int64 (sprintf "block.%d.rd.reqs" i) None
+ with None -> 0_L | Some v -> v);
+ rd_bytes =
+ (match get_param_int64 (sprintf "block.%d.rd.bytes" i) None
+ with None -> 0_L | Some v -> v);
+ wr_req =
+ (match get_param_int64 (sprintf "block.%d.wr.reqs" i) None
+ with None -> 0_L | Some v -> v);
+ wr_bytes =
+ (match get_param_int64 (sprintf "block.%d.wr.bytes" i) None
+ with None -> 0_L | Some v -> v);
+ errs = 0_L
+ }
+ ) (range 0 (nr_block_devs-1)) in
+
+ let nr_interface_devs =
+ match get_param_int "net.count" None with
+ | None -> 0
+ | Some i -> i in
+ let interface_stats =
+ List.map (
+ fun i ->
+ let dev =
+ match get_param (sprintf "net.%d.name" i) with
+ | None -> sprintf "net%d" i
+ | Some (D.TypedFieldString s) -> s
+ | _ -> assert false in
+ dev, {
+ D.rx_bytes =
+ (match get_param_int64 (sprintf "net.%d.rx.bytes" i) None
+ with None -> 0_L | Some v -> v);
+ rx_packets =
+ (match get_param_int64 (sprintf "net.%d.rx.pkts" i) None
+ with None -> 0_L | Some v -> v);
+ rx_errs =
+ (match get_param_int64 (sprintf "net.%d.rx.errs" i) None
+ with None -> 0_L | Some v -> v);
+ rx_drop =
+ (match get_param_int64 (sprintf "net.%d.rx.drop" i) None
+ with None -> 0_L | Some v -> v);
+ tx_bytes =
+ (match get_param_int64 (sprintf "net.%d.tx.bytes" i) None
+ with None -> 0_L | Some v -> v);
+ tx_packets =
+ (match get_param_int64 (sprintf "net.%d.tx.pkts" i) None
+ with None -> 0_L | Some v -> v);
+ tx_errs =
+ (match get_param_int64 (sprintf "net.%d.tx.errs" i) None
+ with None -> 0_L | Some v -> v);
+ tx_drop =
+ (match get_param_int64 (sprintf "net.%d.tx.drop" i) None
+ with None -> 0_L | Some v -> v);
+ }
+ ) (range 0 (nr_interface_devs-1)) in
+
+ let prev_info, prev_block_stats, prev_interface_stats =
+ try
+ let prev_info, prev_block_stats, prev_interface_stats =
+ Hashtbl.find last_info uuid in
+ Some prev_info, prev_block_stats, prev_interface_stats
+ with Not_found -> None, [], [] in
+
+ (name,
+ Active {
+ rd_domid = id; rd_domuuid = uuid; 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;
+ })
+ )
+ ) doms in
(* Calculate the CPU time (ns) and %CPU used by each domain. *)
let doms =
@@ -329,7 +447,7 @@ let collect (conn, _, _, _, _, node_info, _, _) =
function
| (_, Active rd) ->
let info = rd.rd_info, rd.rd_block_stats, rd.rd_interface_stats in
- Hashtbl.add last_info rd.rd_domid info
+ Hashtbl.add last_info rd.rd_domuuid info
| _ -> ()
) doms;
diff --git a/src/collect.mli b/src/collect.mli
index 9ad3dcb..3c5492f 100644
--- a/src/collect.mli
+++ b/src/collect.mli
@@ -27,6 +27,7 @@ val parse_device_xml :
type rd_domain = Inactive | Active of rd_active
and rd_active = {
rd_domid : int; (* Domain ID. *)
+ rd_domuuid : Libvirt.uuid; (* Domain UUID. *)
rd_dom : [`R] Libvirt.Domain.t; (* Domain object. *)
rd_info : Libvirt.Domain.info; (* Domain CPU info now. *)
rd_block_stats : (string * Libvirt.Domain.block_stats) list;
diff --git a/src/utils.ml b/src/utils.ml
index 5fcc905..4332ff7 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -32,6 +32,12 @@ let (/^) = Int64.div
(* failwithf is a printf-like version of failwith. *)
let failwithf fs = ksprintf failwith fs
+let rec range a b =
+ if a <= b then
+ a :: range (a+1) b
+ else
+ []
+
(* Input a whole file as a list of lines. *)
let input_all_lines chan =
let lines = ref [] in
diff --git a/src/utils.mli b/src/utils.mli
index 6e81215..3c966f8 100644
--- a/src/utils.mli
+++ b/src/utils.mli
@@ -25,6 +25,9 @@ val (//) : string -> string -> string
(* failwithf is a printf-like version of failwith. *)
val failwithf : ('a, unit, string, 'b) format4 -> 'a
+(* Return the list of integers [a..b] (inclusive). *)
+val range : int -> int -> int list
+
(* Read a configuration file as a list of (lineno, key, value) pairs.
* If the config file is missing this returns an empty list.
*)
--
2.13.1

View File

@ -1,21 +0,0 @@
From 20c078bead38fd9e413660d4d8fdc3fd4f76edf7 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 28 Mar 2017 14:36:07 +0100
Subject: [PATCH 17/19] chmod -x COPYING* files.
---
COPYING | 0
COPYING.LIB | 0
2 files changed, 0 insertions(+), 0 deletions(-)
mode change 100755 => 100644 COPYING
mode change 100755 => 100644 COPYING.LIB
diff --git a/COPYING b/COPYING
old mode 100755
new mode 100644
diff --git a/COPYING.LIB b/COPYING.LIB
old mode 100755
new mode 100644
--
2.13.1

View File

@ -1,42 +0,0 @@
From a58c90e04e5b54f8c6a67b09a93cfc33402cf398 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
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

View File

@ -1,32 +0,0 @@
From 18a751d8c26548bb090ff05e30ccda3092e3373b Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
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

View File

@ -1 +1 @@
cdb61d35e64c78720082d58f8edfb9da virt-top-1.0.8.tar.gz
SHA512 (virt-top-1.0.9.tar.gz) = 3e0e52bece411f8b73c57beea554937d779bbfb18d16cf5b7f13f8c843e747c2d89ce8253b9cf4db2bd6495c4e4826cb68467cc48bb53bfd65c4aceed043d086

File diff suppressed because it is too large Load Diff

View File

@ -2,8 +2,8 @@
%global debug_package %{nil}
Name: virt-top
Version: 1.0.8
Release: 37%{?dist}
Version: 1.0.9
Release: 1%{?dist}
Summary: Utility like top(1) for displaying virtualization stats
License: GPLv2+
@ -16,33 +16,6 @@ Source2: processcsv.py.pod
Patch0: virt-top-1.0.4-processcsv-documentation.patch
# All upstream patches since 1.0.8.
Patch0001: 0001-Disable-warning-about-immutable-strings-for-OCaml-4..patch
Patch0002: 0002-Move-upstream-translations-from-Tranifex-to-Zanata.patch
Patch0003: 0003-Update-translations-from-Zanata.patch
Patch0004: 0004-build-Add-g-flag-to-ocamlopt.patch
Patch0005: 0005-Rename-source-directory-and-files.patch
Patch0006: 0006-Enable-same-warnings-as-libguestfs.patch
Patch0007: 0007-Remove-x-executable-permission-on-several-source-fil.patch
Patch0008: 0008-Refresh-HACKING-file.patch
Patch0009: 0009-Fix-po-POTFILES-for-new-location-of-source-files.patch
Patch0010: 0010-Update-PO-files.patch
Patch0011: 0011-Remove-support-for-OCaml-Calendar-v1.patch
Patch0012: 0012-src-Fix-some-comments-which-referred-to-the-old-file.patch
Patch0013: 0013-Split-up-huge-Top-module-into-smaller-modules.patch
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
# The patches touch configure.ac:
BuildRequires: autoconf
BuildRequires: ocaml >= 3.10.2
BuildRequires: ocaml-ocamldoc
BuildRequires: ocaml-findlib-devel
@ -85,30 +58,6 @@ different virtualization systems.
%patch0 -p1
%endif
%patch0001 -p1
%patch0002 -p1
%patch0003 -p1
%patch0004 -p1
%patch0005 -p1
%patch0006 -p1
%patch0007 -p1
%patch0008 -p1
%patch0009 -p1
%patch0010 -p1
%patch0011 -p1
%patch0012 -p1
%patch0013 -p1
%patch0014 -p1
%patch0015 -p1
%patch0016 -p1
%patch0017 -p1
%patch0018 -p1
%patch0019 -p1
# Update configure for aarch64 (bz #926701)
%patch9999 -p1
autoconf
%build
%configure
@ -164,6 +113,10 @@ install -m 0644 processcsv.py.1 $RPM_BUILD_ROOT%{_mandir}/man1/
%changelog
* Tue Aug 20 2019 Richard W.M. Jones <rjones@redhat.com> - 1.0.9-1
- New upstream version 1.0.9.
- Remove patches which are upstream and aarch64 build fix.
* Fri Aug 16 2019 Richard W.M. Jones <rjones@redhat.com> - 1.0.8-37
- OCaml 4.08.1 (final) rebuild.