New upstream version 1.1.1

21 files changed, 525 insertions, 385 deletions

diff --git a/src/.depend b/src/.depend
index ce785dd..aad72ab 100644
--- a/src/.depend
+++ b/src/.depend
@@ -1,19 +1,23 @@
 # OCaml dependencies generated by ../ocaml-dep.sh
 
 collect.cmo : \
+    xml.cmo \
     utils.cmi \
     types.cmi \
     collect.cmi
 collect.cmx : \
+    xml.cmx \
     utils.cmx \
     types.cmx \
     collect.cmi
 collect.cmi : \
     types.cmi
 csv_output.cmo : \
+    utils.cmi \
     collect.cmi \
     csv_output.cmi
 csv_output.cmx : \
+    utils.cmx \
     collect.cmx \
     csv_output.cmi
 csv_output.cmi : \
@@ -31,22 +35,8 @@ 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 : \
-    opt_gettext.cmo \
-    collect.cmi
-opt_xml.cmx : \
-    opt_gettext.cmx \
-    collect.cmx
 redraw.cmo : \
     utils.cmi \
     types.cmi \
@@ -122,3 +112,5 @@ utils.cmx : \
 utils.cmi :
 version.cmo :
 version.cmx :
+xml.cmo :
+xml.cmx :
diff --git a/src/Makefile.am b/src/Makefile.am
index 32a51ac..baf8ce4 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -24,12 +24,9 @@ EXTRA_DIST = \
 	collect.mli \
 	csv_output.ml \
 	csv_output.mli \
-	dummy.c \
 	main.ml \
 	opt_calendar.ml \
-	opt_csv.ml \
 	opt_gettext.ml \
-	opt_xml.ml \
 	redraw.ml \
 	redraw.mli \
 	screen.ml \
@@ -43,9 +40,11 @@ EXTRA_DIST = \
 	utils.ml \
 	utils.mli \
 	version.ml \
-	virt-top.pod
+	virt-top.pod \
+	xml-c.c \
+	xml.ml
 
-OCAMLPACKAGES = -package unix,extlib,curses,str,libvirt
+OCAMLPACKAGES = -package unix,curses,str,libvirt
 
 if HAVE_PKG_GETTEXT
 OCAMLPACKAGES  += -package gettext-stub
@@ -56,20 +55,13 @@ BOBJS = \
 	opt_gettext.cmo \
 	utils.cmo \
 	types.cmo \
+	xml.cmo \
 	collect.cmo \
 	screen.cmo \
 	redraw.cmo \
 	csv_output.cmo \
 	stream_output.cmo \
 	top.cmo
-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
@@ -78,12 +70,18 @@ BOBJS += main.cmo
 
 XOBJS = $(BOBJS:.cmo=.cmx)
 
-OCAMLFLAGS = -g -warn-error CDEFLMPSUVYZX-3 -ccopt '@CFLAGS@'
-OCAMLLIBS =
+OCAMLFLAGS = \
+	-g \
+	-warn-error +C+D+E+F+L+M+P+S+U+V+Y+Z+X-3 \
+	-ccopt '$(CFLAGS)'
+OCAMLLIBS = $(LIBXML2_LIBS)
 
 bin_PROGRAMS = virt-top
 
-virt_top_SOURCES = dummy.c
+virt_top_SOURCES = xml-c.c
+virt_top_CFLAGS = \
+	$(LIBXML2_CFLAGS) \
+	-I$(libdir)/ocaml
 
 if !HAVE_OCAMLOPT
 OBJECTS = $(BOBJS)
diff --git a/src/Makefile.in b/src/Makefile.in
index d5480dc..c85cc32 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -106,14 +106,10 @@ POST_UNINSTALL = :
 build_triplet = @build@
 host_triplet = @host@
 @HAVE_PKG_GETTEXT_TRUE@am__append_1 = -package gettext-stub
-@HAVE_PKG_XML_LIGHT_TRUE@am__append_2 = opt_xml.cmo
-@HAVE_PKG_XML_LIGHT_TRUE@am__append_3 = -package xml-light
-@HAVE_PKG_CSV_TRUE@am__append_4 = opt_csv.cmo
-@HAVE_PKG_CSV_TRUE@am__append_5 = -package csv
-@HAVE_PKG_CALENDAR_TRUE@am__append_6 = opt_calendar.cmo
-@HAVE_PKG_CALENDAR_TRUE@am__append_7 = -package calendar
+@HAVE_PKG_CALENDAR_TRUE@am__append_2 = opt_calendar.cmo
+@HAVE_PKG_CALENDAR_TRUE@am__append_3 = -package calendar
 bin_PROGRAMS = virt-top$(EXEEXT)
-@HAVE_PERLDOC_TRUE@am__append_8 = virt-top.1 virt-top.txt
+@HAVE_PERLDOC_TRUE@am__append_4 = virt-top.1 virt-top.txt
 subdir = src
 ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
 am__aclocal_m4_deps = $(top_srcdir)/m4/ocaml.m4 \
@@ -127,7 +123,7 @@ CONFIG_CLEAN_FILES = version.ml
 CONFIG_CLEAN_VPATH_FILES =
 am__installdirs = "$(DESTDIR)$(bindir)"
 PROGRAMS = $(bin_PROGRAMS)
-am_virt_top_OBJECTS = dummy.$(OBJEXT)
+am_virt_top_OBJECTS = virt_top-xml-c.$(OBJEXT)
 virt_top_OBJECTS = $(am_virt_top_OBJECTS)
 virt_top_LDADD = $(LDADD)
 AM_V_P = $(am__v_P_@AM_V@)
@@ -145,8 +141,12 @@ am__v_at_1 =
 DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
 depcomp = $(SHELL) $(top_srcdir)/depcomp
 am__maybe_remake_depfiles = depfiles
-am__depfiles_remade = ./$(DEPDIR)/dummy.Po
+am__depfiles_remade = ./$(DEPDIR)/virt_top-xml-c.Po
 am__mv = mv -f
+AM_V_lt = $(am__v_lt_@AM_V@)
+am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
+am__v_lt_0 = --silent
+am__v_lt_1 = 
 COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
 	$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
 AM_V_CC = $(am__v_CC_@AM_V@)
@@ -225,6 +225,8 @@ LIBICONV = @LIBICONV@
 LIBINTL = @LIBINTL@
 LIBOBJS = @LIBOBJS@
 LIBS = @LIBS@
+LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
+LIBXML2_LIBS = @LIBXML2_LIBS@
 LTLIBICONV = @LTLIBICONV@
 LTLIBINTL = @LTLIBINTL@
 LTLIBOBJS = @LTLIBOBJS@
@@ -251,13 +253,10 @@ OCAMLOPTDOTOPT = @OCAMLOPTDOTOPT@
 OCAMLVERSION = @OCAMLVERSION@
 OCAML_GETTEXT = @OCAML_GETTEXT@
 OCAML_PKG_calendar = @OCAML_PKG_calendar@
-OCAML_PKG_csv = @OCAML_PKG_csv@
 OCAML_PKG_curses = @OCAML_PKG_curses@
-OCAML_PKG_extlib = @OCAML_PKG_extlib@
 OCAML_PKG_gettext = @OCAML_PKG_gettext@
 OCAML_PKG_libvirt = @OCAML_PKG_libvirt@
 OCAML_PKG_unix = @OCAML_PKG_unix@
-OCAML_PKG_xml_light = @OCAML_PKG_xml_light@
 OCAML_RUNTIME_VARIANT_PIC_OPTION = @OCAML_RUNTIME_VARIANT_PIC_OPTION@
 PACKAGE = @PACKAGE@
 PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
@@ -267,6 +266,9 @@ PACKAGE_TARNAME = @PACKAGE_TARNAME@
 PACKAGE_URL = @PACKAGE_URL@
 PACKAGE_VERSION = @PACKAGE_VERSION@
 PATH_SEPARATOR = @PATH_SEPARATOR@
+PKG_CONFIG = @PKG_CONFIG@
+PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@
+PKG_CONFIG_PATH = @PKG_CONFIG_PATH@
 POSUB = @POSUB@
 SED = @SED@
 SET_MAKE = @SET_MAKE@
@@ -329,19 +331,16 @@ top_build_prefix = @top_build_prefix@
 top_builddir = @top_builddir@
 top_srcdir = @top_srcdir@
 CLEANFILES = *~ *.bak *.orig *.rej *.cmi *.cmo *.cma *.cmx *.cmxa \
-	dll*.so *.a *.annot $(am__append_8)
+	dll*.so *.a *.annot $(am__append_4)
 EXTRA_DIST = \
 	.depend \
 	collect.ml \
 	collect.mli \
 	csv_output.ml \
 	csv_output.mli \
-	dummy.c \
 	main.ml \
 	opt_calendar.ml \
-	opt_csv.ml \
 	opt_gettext.ml \
-	opt_xml.ml \
 	redraw.ml \
 	redraw.mli \
 	screen.ml \
@@ -355,18 +354,27 @@ EXTRA_DIST = \
 	utils.ml \
 	utils.mli \
 	version.ml \
-	virt-top.pod
-
-OCAMLPACKAGES = -package unix,extlib,curses,str,libvirt \
-	$(am__append_1) $(am__append_3) $(am__append_5) \
-	$(am__append_7)
-BOBJS = version.cmo opt_gettext.cmo utils.cmo types.cmo collect.cmo \
-	screen.cmo redraw.cmo csv_output.cmo stream_output.cmo top.cmo \
-	$(am__append_2) $(am__append_4) $(am__append_6) main.cmo
+	virt-top.pod \
+	xml-c.c \
+	xml.ml
+
+OCAMLPACKAGES = -package unix,curses,str,libvirt $(am__append_1) \
+	$(am__append_3)
+BOBJS = version.cmo opt_gettext.cmo utils.cmo types.cmo xml.cmo \
+	collect.cmo screen.cmo redraw.cmo csv_output.cmo \
+	stream_output.cmo top.cmo $(am__append_2) main.cmo
 XOBJS = $(BOBJS:.cmo=.cmx)
-OCAMLFLAGS = -g -warn-error CDEFLMPSUVYZX-3 -ccopt '@CFLAGS@'
-OCAMLLIBS = 
-virt_top_SOURCES = dummy.c
+OCAMLFLAGS = \
+	-g \
+	-warn-error +C+D+E+F+L+M+P+S+U+V+Y+Z+X-3 \
+	-ccopt '$(CFLAGS)'
+
+OCAMLLIBS = $(LIBXML2_LIBS)
+virt_top_SOURCES = xml-c.c
+virt_top_CFLAGS = \
+	$(LIBXML2_CFLAGS) \
+	-I$(libdir)/ocaml
+
 @HAVE_OCAMLOPT_FALSE@OBJECTS = $(BOBJS)
 @HAVE_OCAMLOPT_TRUE@OBJECTS = $(XOBJS)
 virt_top_DEPENDENCIES = $(OBJECTS)
@@ -463,7 +471,7 @@ mostlyclean-compile:
 distclean-compile:
 	-rm -f *.tab.c
 
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dummy.Po@am__quote@ # am--include-marker
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/virt_top-xml-c.Po@am__quote@ # am--include-marker
 
 $(am__depfiles_remade):
 	@$(MKDIR_P) $(@D)
@@ -485,6 +493,20 @@ am--depfiles: $(am__depfiles_remade)
 @AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
 
+virt_top-xml-c.o: xml-c.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(virt_top_CFLAGS) $(CFLAGS) -MT virt_top-xml-c.o -MD -MP -MF $(DEPDIR)/virt_top-xml-c.Tpo -c -o virt_top-xml-c.o `test -f 'xml-c.c' || echo '$(srcdir)/'`xml-c.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/virt_top-xml-c.Tpo $(DEPDIR)/virt_top-xml-c.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='xml-c.c' object='virt_top-xml-c.o' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(virt_top_CFLAGS) $(CFLAGS) -c -o virt_top-xml-c.o `test -f 'xml-c.c' || echo '$(srcdir)/'`xml-c.c
+
+virt_top-xml-c.obj: xml-c.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(virt_top_CFLAGS) $(CFLAGS) -MT virt_top-xml-c.obj -MD -MP -MF $(DEPDIR)/virt_top-xml-c.Tpo -c -o virt_top-xml-c.obj `if test -f 'xml-c.c'; then $(CYGPATH_W) 'xml-c.c'; else $(CYGPATH_W) '$(srcdir)/xml-c.c'; fi`
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/virt_top-xml-c.Tpo $(DEPDIR)/virt_top-xml-c.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='xml-c.c' object='virt_top-xml-c.obj' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(virt_top_CFLAGS) $(CFLAGS) -c -o virt_top-xml-c.obj `if test -f 'xml-c.c'; then $(CYGPATH_W) 'xml-c.c'; else $(CYGPATH_W) '$(srcdir)/xml-c.c'; fi`
+
 ID: $(am__tagged_files)
 	$(am__define_uniq_tagged_files); mkid -fID $$unique
 tags: tags-am
@@ -613,7 +635,7 @@ clean: clean-am
 clean-am: clean-binPROGRAMS clean-generic mostlyclean-am
 
 distclean: distclean-am
-		-rm -f ./$(DEPDIR)/dummy.Po
+		-rm -f ./$(DEPDIR)/virt_top-xml-c.Po
 	-rm -f Makefile
 distclean-am: clean-am distclean-compile distclean-generic \
 	distclean-tags
@@ -659,7 +681,7 @@ install-ps-am:
 installcheck-am:
 
 maintainer-clean: maintainer-clean-am
-		-rm -f ./$(DEPDIR)/dummy.Po
+		-rm -f ./$(DEPDIR)/virt_top-xml-c.Po
 	-rm -f Makefile
 maintainer-clean-am: distclean-am maintainer-clean-generic
 
diff --git a/src/README b/src/README
index 1fd4be3..e49fd48 100644
--- a/src/README
+++ b/src/README
@@ -41,23 +41,10 @@ The code is structured into these files:
     to deal with keypresses, help screens and so on.
 
   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
-    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.
-
-  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 +54,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_calendar?
 
 The man-page is generated from the single file:
 
diff --git a/src/collect.ml b/src/collect.ml
index a1e50a1..7d1aadc 100644
--- a/src/collect.ml
+++ b/src/collect.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
@@ -21,17 +21,10 @@ module C = Libvirt.Connect
 module D = Libvirt.Domain
 
 open Printf
-open ExtList
 
 open Utils
 open Types
 
-(* Hook for XML support (see [opt_xml.ml]). *)
-let parse_device_xml : (int -> [>`R] D.t -> string list * string list) ref =
-  ref (
-    fun _ _ -> [], []
-  )
-
 (* Intermediate "domain + stats" structure that we use to collect
  * everything we know about a domain within the collect function.
  *)
@@ -95,7 +88,7 @@ let devices = Hashtbl.create 13
 let get_devices id dom =
   try Hashtbl.find devices id
   with Not_found ->
-    let blkdevs, netifs = (!parse_device_xml) id dom in
+    let blkdevs, netifs = Xml.parse_device_xml dom in
     Hashtbl.replace devices id (blkdevs, netifs);
     blkdevs, netifs
 
@@ -144,174 +137,185 @@ let collect (conn, _, _, _, _, node_info, _, _) =
     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)
+        try
+          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
-          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;
-	   })
-        )
+          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 =
+                      (let n = sprintf "block.%d.rd.reqs" i in
+                       match get_param_int64 n None
+                       with None -> 0_L | Some v -> v);
+                    rd_bytes =
+                      (let n = sprintf "block.%d.rd.bytes" i in
+                       match get_param_int64 n None
+                       with None -> 0_L | Some v -> v);
+                    wr_req =
+                      (let n = sprintf "block.%d.wr.reqs" i in
+                       match get_param_int64 n None
+                       with None -> 0_L | Some v -> v);
+                    wr_bytes =
+                      (let n = sprintf "block.%d.wr.bytes" i in
+                       match get_param_int64 n 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;
+	    })
+          )
+        with
+          Libvirt.Virterror _ ->
+            (* this can happen if a domain goes away while we
+             * are reading it, just report an inactive domain
+             *)
+            ("", Inactive)
     ) doms in
 
   (* Calculate the CPU time (ns) and %CPU used by each domain. *)
diff --git a/src/collect.mli b/src/collect.mli
index 3c5492f..72f0800 100644
--- a/src/collect.mli
+++ b/src/collect.mli
@@ -17,10 +17,6 @@
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 *)
 
-(* Hook for [Opt_xml] to override (if present). *)
-val parse_device_xml :
-  (int -> [ `R ] Libvirt.Domain.t -> string list * string list) ref
-
 (* Intermediate "domain + stats" structure that we use to collect
  * everything we know about a domain within the collect function.
  *)
diff --git a/src/csv_output.ml b/src/csv_output.ml
index f23d673..42fed9d 100644
--- a/src/csv_output.ml
+++ b/src/csv_output.ml
@@ -1,5 +1,5 @@
 (* 'top'-like tool for libvirt domains.
-   (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
+   (C) Copyright 2007-2021 Richard W.M. Jones, Red Hat Inc.
    http://libvirt.org/
 
    This program is free software; you can redistribute it and/or modify
@@ -20,21 +20,103 @@
 (* CSV output functions. *)
 
 open Printf
-open ExtList
 
+open Utils
 open Collect
 
 module C = Libvirt.Connect
 
-(* Hook for CSV support (see [opt_csv.ml]). *)
-let csv_write : (string list -> unit) ref =
-  ref (
-    fun _ -> ()
+let chan = ref None
+
+let csv_set_filename filename = chan := Some (open_out filename)
+
+(* This code is adapted from OCaml CSV, published under the LGPLv2+
+ * which is compatible with the license of virt-top.
+ *)
+
+let nl = Bytes.make 1 '\n'
+let comma = Bytes.make 1 ','
+let quote = Bytes.make 1 '"'
+let output_newline chan = output chan nl 0 1
+let output_comma chan = output chan comma 0 1
+let output_quote chan = output chan quote 0 1
+
+let is_space_or_tab c = c = ' ' || c = '\t'
+
+let must_escape = Array.make 256 false
+let () =
+  List.iter (fun c -> must_escape.(Char.code c) <- true)
+            ['\"'; '\\';  '\000'; '\b'; '\n'; '\r'; '\t'; '\026']
+
+let must_quote chan s len =
+  let quote = ref (is_space_or_tab (String.unsafe_get s 0)
+                   || is_space_or_tab (String.unsafe_get s (len - 1))) in
+  let n = ref 0 in
+  for i = 0 to len-1 do
+    let c = String.unsafe_get s i in
+    if c = ',' || c = '\n' || c = '\r' then quote := true
+    else if c = '"' then (
+      quote := true;
+      incr n
+    )
+  done;
+  if !quote then !n else -1
+
+let write_escaped chan field =
+  let len = String.length field in
+  if len > 0 then (
+    let n = must_quote chan field len in
+    if n < 0 then
+      output chan (Bytes.unsafe_of_string field) 0 len
+    else (
+      let field =
+        if n <= 0 then Bytes.unsafe_of_string field
+        else (* There are some quotes to escape *)
+          let s = Bytes.create (len + n) in
+          let j = ref 0 in
+          for i = 0 to len - 1 do
+            let c = String.unsafe_get field i in
+            if c = '"' then (
+              Bytes.unsafe_set s !j '"'; incr j;
+              Bytes.unsafe_set s !j '"'; incr j
+            )
+            else (Bytes.unsafe_set s !j c; incr j)
+          done;
+          s
+      in
+      output_quote chan;
+      output chan field 0 (Bytes.length field);
+      output_quote chan
+    )
   )
 
+let save_out chan = function
+  | [] -> output_newline chan
+  | [f] ->
+     write_escaped chan f;
+     output_newline chan
+  | f :: tl ->
+     write_escaped chan f;
+     List.iter (
+       fun f ->
+         output_comma chan;
+         write_escaped chan f
+     ) tl;
+     output_newline chan
+
+let csv_write row =
+  match !chan with
+  | None -> ()                  (* CSV output not enabled *)
+  | Some chan ->
+     save_out chan row;
+     (* Flush the output to the file immediately because we don't
+      * explicitly close the channel.
+      *)
+     flush chan
+
 (* Write CSV header row. *)
 let write_csv_header (csv_cpu, csv_mem, csv_block, csv_net) block_in_bytes =
-  (!csv_write) (
+  csv_write (
     [ "Hostname"; "Time"; "Arch"; "Physical CPUs";
       "Count"; "Running"; "Blocked"; "Paused"; "Shutdown";
       "Shutoff"; "Crashed"; "Active"; "Inactive";
@@ -92,9 +174,9 @@ let append_csv (_, _, _, _, _, node_info, hostname, _) (* setup *)
   let cmp (_, { rd_domid = rd_domid1 }) (_, { rd_domid = rd_domid2 }) =
     compare rd_domid1 rd_domid2
   in
-  let doms = List.sort ~cmp doms in
+  let doms = List.sort cmp doms in
 
-  let string_of_int64_option = Option.map_default Int64.to_string "" in
+  let string_of_int64_option = map_default Int64.to_string "" in
 
   let domain_fields = List.map (
     fun (domname, rd) ->
@@ -121,4 +203,4 @@ let append_csv (_, _, _, _, _, node_info, hostname, _) (* setup *)
   ) doms in
   let domain_fields = List.flatten domain_fields in
 
-  (!csv_write) (summary_fields @ domain_fields)
+  csv_write (summary_fields @ domain_fields)
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/dummy.c b/src/dummy.c
deleted file mode 100644
index ebab619..0000000
--- a/src/dummy.c
+++ /dev/null
@@ -1,2 +0,0 @@
-/* Dummy source, to be used for OCaml-based tools with no C sources. */
-enum { foo = 1 };
diff --git a/src/opt_calendar.ml b/src/opt_calendar.ml
index fd93704..89c5598 100644
--- a/src/opt_calendar.ml
+++ b/src/opt_calendar.ml
@@ -22,14 +22,18 @@
 open CalendarLib
 
 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 *)
+    (* time is "+something" *)
+    let is_plus =
+      let n = String.length time in
+      n >= 1 && time.[0] = '+'
+    in
+    if is_plus then (
       let period = String.sub time 1 (String.length time - 1) in
       let period =
 	if String.contains period ':' then ( (* +HH:MM:SS *)
diff --git a/src/opt_xml.ml b/src/opt_xml.ml
deleted file mode 100644
index 1037b85..0000000
--- a/src/opt_xml.ml
+++ /dev/null
@@ -1,69 +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 xml-light.
-*)
-
-open ExtList
-
-open Opt_gettext.Gettext
-
-module C = Libvirt.Connect
-module D = Libvirt.Domain
-module N = Libvirt.Network ;;
-
-Collect.parse_device_xml :=
-fun id dom ->
-  try
-    let xml = D.get_xml_desc dom in
-    let xml = Xml.parse_string xml in
-    let devices =
-      match xml with
-      | Xml.Element ("domain", _, children) ->
-	  let devices =
-	    List.filter_map (
-	      function
-	      | Xml.Element ("devices", _, devices) -> Some devices
-	      | _ -> None
-	    ) children in
-	  List.concat devices
-      | _ ->
-	  failwith (s_ "get_xml_desc didn't return <domain/>") in
-    let rec target_dev_of = function
-      | [] -> None
-      | Xml.Element ("target", attrs, _) :: rest ->
-	  (try Some (List.assoc "dev" attrs)
-	   with Not_found -> target_dev_of rest)
-      | _ :: rest -> target_dev_of rest
-    in
-    let blkdevs =
-      List.filter_map (
-	function
-	| Xml.Element ("disk", _, children) -> target_dev_of children
-	| _ -> None
-      ) devices in
-    let netifs =
-      List.filter_map (
-	function
-	| Xml.Element ("interface", _, children) -> target_dev_of children
-	| _ -> None
-      ) devices in
-    blkdevs, netifs
-  with
-  | Xml.Error _
-  | Libvirt.Virterror _ -> [], [] (* ignore transient errs *)
diff --git a/src/redraw.ml b/src/redraw.ml
index 0403158..7031e66 100644
--- a/src/redraw.ml
+++ b/src/redraw.ml
@@ -17,7 +17,6 @@
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 *)
 
-open ExtList
 open Curses
 open Printf
 
@@ -137,7 +136,7 @@ let redraw display_mode sort_order
 	  if r <> 0 then r
 	  else compare name1 name2
 	in
-	List.sort ~cmp doms in
+	List.sort cmp doms in
 
       (* Print domains. *)
       attron A.reverse;
@@ -316,7 +315,7 @@ let redraw display_mode sort_order
 	  if r <> 0 then r
 	  else compare (dev1, name1) (dev2, name2)
 	in
-	List.sort ~cmp devs in
+	List.sort cmp devs in
 
       (* Print the header for network devices. *)
       attron A.reverse;
@@ -428,7 +427,7 @@ let redraw display_mode sort_order
 	  if r <> 0 then r
 	  else compare (dev1, name1) (dev2, name2)
 	in
-	List.sort ~cmp devs in
+	List.sort cmp devs in
 
       (* Print the header for block devices. *)
       attron A.reverse;
@@ -491,7 +490,7 @@ let redraw display_mode sort_order
   (* Time to grab another historical %CPU for the list? *)
   if time >= !historical_cpu_last_time +. float historical_cpu_delay
   then (
-    historical_cpu := percent_cpu :: List.take 10 !historical_cpu;
+    historical_cpu := percent_cpu :: list_take 10 !historical_cpu;
     historical_cpu_last_time := time
   );
 
diff --git a/src/stream_output.ml b/src/stream_output.ml
index c3af99b..2b9e087 100644
--- a/src/stream_output.ml
+++ b/src/stream_output.ml
@@ -20,7 +20,6 @@
 (* [--stream] mode output functions. *)
 
 open Printf
-open ExtList
 
 open Utils
 open Collect
@@ -54,7 +53,7 @@ let append_stream (_, _, _, _, _, node_info, hostname, _) (* setup *)
        | Inactive, Inactive -> 0)
     in
     let cmp  (name1, dom1) (name2, dom2) = compare(dom1, dom2) in
-    List.sort ~cmp doms in
+    List.sort cmp doms in
   (*Print domains *)
   let dump_domain = fun name rd
   -> begin
diff --git a/src/top.ml b/src/top.ml
index c38239c..75fbcb9 100644
--- a/src/top.ml
+++ b/src/top.ml
@@ -18,7 +18,6 @@
 *)
 
 open Printf
-open ExtList
 open Curses
 
 open Opt_gettext.Gettext
@@ -33,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 (
@@ -84,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/utils.ml b/src/utils.ml
index 4332ff7..1f00803 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -75,6 +75,14 @@ let trimr ?(test = isspace) str =
 let trim ?(test = isspace) str =
   trimr (triml str)
 
+(* Split string on the first instance of 'sep' character. *)
+let split str sep =
+  try
+    let i = String.index str sep in
+    String.sub str 0 i, String.sub str (i+1) (String.length str - 1)
+  with
+    Not_found -> str, ""
+
 (* Read a configuration file as a list of (key, value) pairs.
  * If the config file is missing this returns an empty list.
  *)
@@ -103,7 +111,7 @@ let read_config_file filename =
   (* Convert to key, value pairs. *)
   List.map (
     fun (lineno, line) ->
-      let key, value = ExtString.String.split line " " in
+      let key, value = split line ' ' in
       lineno, trim key, trim value
   ) lines
 
@@ -117,6 +125,19 @@ let pad width str =
     else (* if n < width then *) str ^ String.make (width-n) ' '
   )
 
+(* Take up to n elements of xs, if available. *)
+let rec list_take n xs =
+  if n <= 0 then []
+  else (
+    match xs with
+    | [] -> []
+    | x :: xs -> x :: list_take (n-1) xs
+  )
+
+let map_default f def = function
+  | None -> def
+  | Some v -> f v
+
 module Show = struct
   (* Show a percentage in 4 chars. *)
   let percent percent =
diff --git a/src/utils.mli b/src/utils.mli
index 3c966f8..2679dc9 100644
--- a/src/utils.mli
+++ b/src/utils.mli
@@ -36,6 +36,12 @@ val read_config_file : string -> (int * string * string) list
 (* Pad or truncate a string to a fixed width. *)
 val pad : int -> string -> string
 
+(* Take up to n elements of xs, if available. *)
+val list_take : int -> 'a list -> 'a list
+
+(* Apply function f to [Some v], return default for [None] *)
+val map_default : ('a -> 'b) -> 'b -> 'a option -> 'b
+
 (* Int64 operators for convenience. *)
 val (+^) : int64 -> int64 -> int64
 val (-^) : int64 -> int64 -> int64
diff --git a/src/version.ml b/src/version.ml
index 484cdb1..0c56d4b 100644
--- a/src/version.ml
+++ b/src/version.ml
@@ -19,4 +19,4 @@
    This file contains all code which requires CSV support.
 *)
 
-let version = "1.1.0"
+let version = "1.1.1"
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<README> file in the source distribution
-for details).
-
 To save space you can compress your CSV files (if your shell supports
 this feature, eg. I<bash>):
 
diff --git a/src/xml-c.c b/src/xml-c.c
new file mode 100644
index 0000000..72042bf
--- /dev/null
+++ b/src/xml-c.c
@@ -0,0 +1,124 @@
+/* 'top'-like tool for libvirt domains.
+   (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
+   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.
+*/
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#include <libxml/xpath.h>
+#include <libxml/xpathInternals.h>
+
+/* xpathobj contains a list of dev attributes, return the list
+ * as an OCaml array of strings.
+ */
+static value
+get_devs (xmlDocPtr doc, xmlXPathObjectPtr xpathobj)
+{
+  CAMLparam0 ();
+  CAMLlocal2 (rv, nodev);
+  const xmlNodeSetPtr nodes = xpathobj->nodesetval;
+  size_t i, nr_nodes;
+  xmlNodePtr node;
+  char *str;
+  xmlAttrPtr attr;
+
+  if (nodes == NULL || nodes->nodeNr == 0)
+    rv = caml_alloc (0, 0);
+  else {
+    /* Count the nodes that contain data. */
+    nr_nodes = 0;
+    for (i = 0; i < nodes->nodeNr; ++i) {
+      node = nodes->nodeTab[i];
+      if (node->type != XML_ATTRIBUTE_NODE)
+        continue;
+      nr_nodes++;
+    }
+
+    rv = caml_alloc (nr_nodes, 0);
+    nr_nodes = 0;
+    for (i = 0; i < nodes->nodeNr; ++i) {
+      node = nodes->nodeTab[i];
+      if (node->type != XML_ATTRIBUTE_NODE)
+        continue;
+      attr = (xmlAttrPtr) node;
+      str = (char *) xmlNodeListGetString (doc, attr->children, 1);
+      nodev = caml_copy_string (str);
+      free (str);
+      Store_field (rv, nr_nodes, nodev);
+      nr_nodes++;
+    }
+  }
+
+  CAMLreturn (rv);
+}
+
+/* external get_blk_net_devs : string -> string array * string array */
+value
+get_blk_net_devs (value xmlv)
+{
+  CAMLparam1 (xmlv);
+  CAMLlocal3 (rv, blkdevs, netifs);
+  xmlDocPtr doc;
+  xmlXPathContextPtr xpathctx;
+  xmlXPathObjectPtr xpathobj;
+  const char *expr;
+
+  /* For security reasons, call xmlReadMemory (not xmlParseMemory) and
+   * pass XML_PARSE_NONET.
+   */
+  doc = xmlReadMemory (String_val (xmlv), caml_string_length (xmlv),
+                       NULL, NULL, XML_PARSE_NONET);
+  if (doc == NULL)
+    caml_invalid_argument ("xmlReadMemory: unable to parse XML");
+
+  xpathctx = xmlXPathNewContext (doc);
+  if (xpathctx == NULL)
+    caml_invalid_argument ("xmlXPathNewContext: unable to create new context");
+
+  expr = "//devices/disk/target/@dev";
+  xpathobj = xmlXPathEvalExpression (BAD_CAST expr, xpathctx);
+  if (xpathobj == NULL)
+    caml_invalid_argument (expr);
+
+  blkdevs = get_devs (doc, xpathobj);
+  xmlXPathFreeObject (xpathobj);
+
+  expr = "//devices/interface/target/@dev";
+  xpathobj = xmlXPathEvalExpression (BAD_CAST expr, xpathctx);
+  if (xpathobj == NULL)
+    caml_invalid_argument (expr);
+
+  netifs = get_devs (doc, xpathobj);
+  xmlXPathFreeObject (xpathobj);
+
+  xmlXPathFreeContext (xpathctx);
+  xmlFreeDoc (doc);
+
+  rv = caml_alloc (2, 0);
+  Store_field (rv, 0, blkdevs);
+  Store_field (rv, 1, netifs);
+  CAMLreturn (rv);
+}
diff --git a/src/opt_csv.ml b/src/xml.ml
index 6625c61..d11ce45 100644
--- a/src/opt_csv.ml
+++ b/src/xml.ml
@@ -1,5 +1,5 @@
 (* 'top'-like tool for libvirt domains.
-   (C) Copyright 2007-2009 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
@@ -15,26 +15,18 @@
    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 ;;
+module D = Libvirt.Domain
 
-Top.csv_start :=
-  fun filename ->
-    chan := Some (open_out filename) ;;
+external get_blk_net_devs : string -> string array * string array
+  = "get_blk_net_devs"
 
-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
+let parse_device_xml dom =
+  try
+    let xml = D.get_xml_desc dom in
+    let blkdevs, netifs = get_blk_net_devs xml in
+    Array.to_list blkdevs, Array.to_list netifs
+  with
+  | Invalid_argument _
+  | Libvirt.Virterror _ -> [], [] (* ignore transient errors *)