From: rjones@thinkpad Date: Thu, 17 Apr 2008 10:13:39 +0000 (+0100) Subject: Merge. X-Git-Url: http://git.annexia.org/?p=virt-top.git;a=commitdiff_plain;h=5fb80987ddf0f8af6cd479964f1c5bb8340c7ba8;hp=f9d99e63272520c19bddc9e4b47731d57e5658e2 Merge. --- diff --git a/.hgignore b/.hgignore index 3f4fb29..f78c6f6 100644 --- a/.hgignore +++ b/.hgignore @@ -35,3 +35,12 @@ virt-top/virt-top virt-df/virt-df wininstaller.nsis *.orig +mlvirsh/mlvirsh_gettext.ml +virt-ctrl/virt_ctrl_gettext.ml +virt-df/virt_df_gettext.ml +virt-top/virt_top_gettext.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 \ No newline at end of file diff --git a/MANIFEST b/MANIFEST index 331d75b..ba611aa 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6,63 +6,19 @@ config.sub configure.ac COPYING COPYING.LIB -examples/.depend -examples/list_domains.ml -examples/node_info.ml -examples/Makefile.in .hgignore install-sh -libvirt/.depend -libvirt/generator.pl -libvirt/libvirt_c.c -libvirt/libvirt_c_epilogue.c -libvirt/libvirt_c_oneoffs.c -libvirt/libvirt_c_prologue.c -libvirt/libvirt.ml -libvirt/libvirt.mli -libvirt/libvirt_version.ml.in -libvirt/libvirt_version.mli -libvirt/Makefile.in -libvirt/README Makefile.in Make.rules.in MANIFEST -META.in -mlvirsh/.depend -mlvirsh/Makefile.in -mlvirsh/mlvirsh.ml -virt-ctrl/.depend -virt-ctrl/Makefile.in -virt-ctrl/mingw-gcc-wrapper.ml -virt-ctrl/rebuild-icons.sh -virt-ctrl/vc_connection_dlg.ml -virt-ctrl/vc_connection_dlg.mli -virt-ctrl/vc_connections.ml -virt-ctrl/vc_connections.mli -virt-ctrl/vc_dbus.ml -virt-ctrl/vc_dbus.mli -virt-ctrl/vc_domain_ops.ml -virt-ctrl/vc_domain_ops.mli -virt-ctrl/vc_helpers.ml -virt-ctrl/vc_helpers.mli -virt-ctrl/vc_icons.ml -virt-ctrl/vc_mainwindow.ml -virt-ctrl/vc_mainwindow.mli -virt-ctrl/virt_ctrl.ml +po/ja.po +po/LINGUAS +po/Makefile.in +po/pl.po +po/POTFILES +po/virt-top.pot README -TODO.libvirt TODO.virt-top -virt-df/.depend -virt-df/Makefile.in -virt-df/virt-df.1 -virt-df/virt-df.pod -virt-df/virt-df.txt -virt-df/virt_df.ml -virt-df/README -virt-df/virt_df_ext2.ml -virt-df/virt_df_linux_swap.ml -virt-df/virt_df_lvm2.ml -virt-df/virt_df_main.ml virt-top/.depend virt-top/Makefile.in virt-top/README @@ -79,4 +35,4 @@ virt-top/virt_top_utils.ml virt-top/virt_top_utils.mli virt-top/virt_top_xml.ml wininstaller.nsis.in -winlicense.rtf \ No newline at end of file +winlicense.rtf diff --git a/META.in b/META.in deleted file mode 100755 index 960e07e..0000000 --- a/META.in +++ /dev/null @@ -1,5 +0,0 @@ -name="libvirt" -version="@PACKAGE_VERSION@" -description="libvirt bindings for OCaml" -archive(byte)="mllibvirt.cma" -archive(native)="mllibvirt.cmxa" diff --git a/Make.rules.in b/Make.rules.in index 6a56728..a25d485 100644 --- a/Make.rules.in +++ b/Make.rules.in @@ -40,6 +40,11 @@ else $(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLOPTINCS) -c $< endif +%.ml %.mli: %.mly + ocamlyacc $< +.mll.ml: + ocamllex $< + # Dependencies. depend: .depend @@ -47,11 +52,11 @@ depend: .depend ifneq ($(OCAMLFIND),) .depend: $(wildcard *.mli) $(wildcard *.ml) rm -f .depend - $(OCAMLFIND) ocamldep $(OCAMLCPACKAGES) $^ > $@ + $(OCAMLFIND) ocamldep $(OCAMLCPACKAGES) $(OCAMLDEPFLAGS) $^ > $@ else .depend: $(wildcard *.mli) $(wildcard *.ml) rm -f .depend - $(OCAMLDEP) $(OCAMLCINCS) $^ > $@ + $(OCAMLDEP) $(OCAMLCINCS) $(OCAMLDEPFLAGS) $^ > $@ endif ifeq ($(wildcard .depend),.depend) @@ -60,4 +65,4 @@ endif .PHONY: depend dist check-manifest dpkg doc -.SUFFIXES: .cmo .cmi .cmx .ml .mli .mll +.SUFFIXES: .cmo .cmi .cmx .ml .mli .mll .mly diff --git a/Makefile.in b/Makefile.in index 52776e0..83fc0cb 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1,4 +1,4 @@ -# ocaml-libvirt +# virt-top # Copyright (C) 2007 Red Hat Inc., Richard W.M. Jones # # This library is free software; you can redistribute it and/or @@ -22,10 +22,7 @@ INSTALL = @INSTALL@ MAKENSIS = @MAKENSIS@ -OCAMLDOC = @OCAMLDOC@ -OCAMLDOCFLAGS := -html -sort - -SUBDIRS = @subdirs@ +SUBDIRS = virt-top all opt depend install: for d in $(SUBDIRS); do \ @@ -37,36 +34,13 @@ 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 examples/list_domains - rm -f examples/node_info - rm -f mlvirsh/mlvirsh - rm -f virt-ctrl/virt-ctrl rm -f virt-top/virt-top - rm -f virt-df/virt-df distclean: clean rm -f config.h config.log config.status configure rm -rf autom4te.cache - rm -f META - rm -f libvirt/libvirt_version.ml rm -f Makefile - rm -f libvirt/Makefile - rm -f examples/Makefile - rm -f mlvirsh/Makefile - rm -f virt-ctrl/Makefile rm -f virt-top/Makefile - rm -f virt-df/Makefile - -# Developer documentation (in html/ subdirectory). - -ifneq ($(OCAMLDOC),) -doc: - rm -rf html - mkdir html - -cd libvirt; \ - $(OCAMLDOC) $(OCAMLDOCFLAGS) -d ../html \ - libvirt.{ml,mli} libvirt_version.{ml,mli} -endif # Windows installer (requires NSIS). @@ -82,14 +56,6 @@ $(WININSTALLER): wininstaller.nsis all opt ls -l $@ endif -# Update configure and rerun. - -configure: force - autoreconf - CFLAGS=-g \ - ./configure \ - --enable-debug=yes --with-libvirt=/home/rjones/local - # Distribution. dist: @@ -109,42 +75,5 @@ check-manifest: rm -f .orig-manifest .check-manifest; \ exit $$rv -# Do a release (update the website). - -release: configure - $(MAKE) release_stage_2 - -release_stage_2: clean all opt doc dist - $(MAKE) release_stage_3 - -WEBSITE = ../redhat/websites - -release_stage_3: - rm -f $(WEBSITE)/ocaml-libvirt/html/*.{html,css} - cp html/*.{html,css} $(WEBSITE)/ocaml-libvirt/html/ - cp README $(WEBSITE)/ocaml-libvirt/README.txt - cp ChangeLog $(WEBSITE)/ocaml-libvirt/ChangeLog.txt -# cp virt-top/virt-top.txt $(WEBSITE)/virt-top/ -# cp ChangeLog $(WEBSITE)/virt-top/ChangeLog.txt - -# Upload to main website. - -upload: - cd $(WEBSITE)/ocaml-libvirt && \ - scp ChangeLog.txt index.html README.txt Screenshot*.png \ - libvirt.org:/data/www/libvirt.org/ocaml && \ - scp css/*.css \ - libvirt.org:/data/www/libvirt.org/ocaml/css/ && \ - scp html/*.html html/*.css \ - libvirt.org:/data/www/libvirt.org/ocaml/html/ - scp $(PACKAGE)-$(VERSION).tar.gz libvirt.org:/data/ftp/libvirt/ocaml/ - -# Upload Windows binary installer to main website. - -winupload: - scp $(WININSTALLER) libvirt.org:/data/ftp/libvirt/ocaml/ - -force: - .PHONY: all opt depend install clean distclean configure dist check-manifest \ release release_stage_2 release_stage_3 force \ No newline at end of file diff --git a/README b/README index 8ae896e..fc20808 100644 --- a/README +++ b/README @@ -1,130 +1,17 @@ -ocaml-libvirt +virt-top ---------------------------------------------------------------------- Copyright (C) 2007-2008 Richard W.M. Jones, Red Hat Inc. +http://et.redhat.com/~rjones/virt-top/ http://libvirt.org/ocaml/ http://libvirt.org/ -This is a complete set of OCaml bindings around libvirt, exposing all -known functionality to OCaml programs. +virt-top is a top-like utility for showing stats of virtualized +domains. Many keys and command line options are the same as for +ordinary top. - -Requirements ----------------------------------------------------------------------- - -PLEASE NOTE: The list of requirements looks long but you DO NOT NEED -all of these packages, so pay careful attention to what is required -('R') and what is optional ('O'). - -ALSO NOTE: Binaries are available for many platforms. You only need -the packages below if you want to build from source. - - W h a t y o u w a n t t o b u i l d - - |Bindings, |Docs, |virt-top |virt-ctrl |Windows - |examples, |manpages | | |version - |mlvirsh | | | | - --------------+----------+---------+---------+----------+--------- - GNU make | R | R | R | R | R - | | | | | - gcc | R | | R | R | R - | | | | | - libvirt | R | | R | R | R - | >= 0.2.1 | | | | - | | | | | - ocaml | R | | R | R | R - | >= 3.08 | | | | - | | | | | - findlib | HR | R | HR | HR | n/a - | | | | | - MinGW + MSYS | | | | | R - --------------+----------+---------+---------+----------+--------- - ocamldoc | | R | | | O - | | | | | - perldoc | | O | | | - --------------+----------+---------+---------+----------+--------- - ocaml-curses | | | R | | - | | | | | - Extlib | | | R | | - | | | | | - xml-light | | | O | | - | | | | | - ocaml-calendar| | | O | | - | | | | | - ocaml CSV | | | O | | - --------------+----------+---------+---------+----------+--------- - GTK2 | | | | R | O - | | | | | - lablgtk2 | | | | R | O - | | | | >= 2.10.0| - ocaml-dbus | | | | O | - | | | | >= 0.06 | - gnome-icon-theme | | | O | - --------------+----------+---------+---------+----------+--------- - NSIS | | | | | O - --------------+----------+---------+---------+----------+--------- - - R = required - HR = highly recommended (use if possible) - O = optional (just improves functionality, but not required) - n/a = not available - -Where to get the packages: - - libvirt >= 0.2.1 from http://libvirt.org/ (get the latest version available) - or packaged in Debian, Ubuntu and Fedora - - ocaml >= 3.08 from http://caml.inria.fr/ - or packaged in Debian, Ubuntu and Fedora - - findlib from http://www.ocaml-programming.de/packages/ - or packaged in Debian, Ubuntu and Fedora as 'ocaml-findlib' - - MinGW + MSYS from http://www.mingw.org/ (only needed for Windows) - - ocamldoc part of OCaml itself - or part of the ocaml package in Debian, Ubuntu - or packaged in Fedora as 'ocaml-ocamldoc' - - perldoc part of Perl - or packaged in Debian, Ubuntu and Fedora - - ocaml-curses from http://www.nongnu.org/ocaml-tmk/ - or packaged in Debian, Ubuntu as 'libcurses-ocaml-dev' - or packaged in Fedora as 'ocaml-curses-devel' - - Extlib from http://ocaml-lib.sourceforge.net/ - or packaged in Debian, Unbuntu as 'libextlib-ocaml-dev' - or packaged in Fedora as 'ocaml-extlib-devel' - - xml-light from http://tech.motion-twin.com/doc/xml-light/ - or packaged in Debian, Ubuntu as 'libxml-light-ocaml-dev' - or packaged in Fedora as 'ocaml-xml-light-devel' - - ocaml CSV from http://merjis.com/developers/csv - or packaged in Debian, Ubuntu as 'libcsv-ocaml-dev' - or packaged in Fedora as 'ocaml-csv-devel' - - ocaml-calendar from http://www.lri.fr/~signoles/prog.en.html - or packaged in Debian, Ubuntu as 'libcalendar-ocaml-dev' - or packaged in Fedora as 'ocaml-calendar-devel' - - GTK2 from http://gtk.org/ - or packaged in Debian, Ubuntu and Fedora - - lablgtk2 >= 2.10.0 - from http://wwwfun.kurims.kyoto-u.ac.jp/soft/lsl/lablgtk.html - or packaged in Debian, Ubuntu as 'liblablgtk2-ocaml-dev' - or packaged in Fedora 9 as 'ocaml-lablgtk-devel' - - gnome-icon-theme part of GNOME - - ocaml-dbus >= 0.06 - from http://tab.snarc.org/projects/ocaml_dbus/ - or packaged in Fedora 9 as 'ocaml-dbus-devel' - (not yet available for Debian or Ubuntu AFAIK) - - NSIS from http://nsis.sf.net +It uses libvirt so it capable of showing stats across a variety of +different virtualization systems. Building @@ -132,103 +19,7 @@ Building ./configure # Checks that you have all the required bits. - make all # Builds the bytecode version of libs/programs. - make opt # Builds the native code version of libs/programs. - - make install # Install in OCaml directory, and the binaries - # in $prefix/bin. - - make doc # Build HTML documentation in html/ subdirectory. - -Then have a look at the programs 'mlvirsh.opt', 'virt-top.opt' -and 'virt-ctrl.opt'. - -Note: If you want to run the programs without first installing, you -may need to set your $LD_LIBRARY_PATH environment variable so it -contains the build directory. eg: - - LD_LIBRARY_PATH=libvirt/ mlvirsh/mlvirsh.opt - - -Windows ----------------------------------------------------------------------- - -I have built libvirt (the bindings), examples, mlvirsh and virt-ctrl -on Windows using the MinGW port of OCaml. It's quite likely that it -will also work under VC++, but I have not tested this. - -You should make sure that your $PATH (environment variable) contains -the names of the directories containing all required DLLs, in -particular you will require: - - libvirt-*.dll (from libvirt) - libgnutls-*.dll (from GnuTLS) - libgcrypt-*.dll - libgpg-error-*.dll - libtasn1-*.dll - libxdr.dll (from libxdr) - libxml2-*.dll (from libxml2) - and, a multitude of DLLs from GTK if you want to run virt-ctrl - -You can use a tool such as Dependency Walker to find/check the -locations of dependent libraries. - -To build the Windows installer, you will need NSIS. Then do: - - ./configure --with-nsis=/c/Progra~1/NSIS - make all opt - make wininstaller - -This should build a Windows binary installer called -ocaml-libvirt-$VERSION.exe which includes the bindings, all required -DLLs and all programs that can be built under Windows. - - -mlvirsh ----------------------------------------------------------------------- - -'mlvirsh' is an almost complete reimplementation of virsh, which is -mostly command compatible (there are a very few commands missing, and -some commands have a slightly different syntax, but broadly speaking -they are equivalent programs except that one is written in C and the -other in OCaml). - -At the time of writing: - - wc -c wc -l - - virsh 126,056 4,641 - mlvirsh 19,427 598 - - % size 15% 13% - - -virt-ctrl ----------------------------------------------------------------------- - -'virt-ctrl' (originally called 'mlvirtmanager') is a reimplementation -of virt-manager in OCaml. It is not feature-complete by any means, -but does allow you to show the running domains and start and stop -defined domains. The main functionality _missing_ is the ability to -define new virtual machines, change the resources allocated to -domains, or show the machine console. - - -Programming ----------------------------------------------------------------------- - -For documentation on these bindings, read libvirt.mli and/or 'make -doc' and browse the HTML documentation in the html/ subdirectory. - -For documentation on libvirt itself, see http://libvirt.org/html/ - - -Subdirectories ----------------------------------------------------------------------- + make all # Builds the bytecode version of the program. + make opt # Builds the native code version of the program. -libvirt/ The OCaml bindings. -examples/ Some example programs using the bindings. -mlvirsh/ 'mlvirsh' command line tool. -virt-ctrl/ 'virt-ctrl' graphical tool. -virt-top/ 'virt-top' tool. -virt-df/ 'virt-df' tool. +Then have a look at the program 'virt-top/virt-top.opt'. diff --git a/TODO.libvirt b/TODO.libvirt deleted file mode 100755 index d87b8b8..0000000 --- a/TODO.libvirt +++ /dev/null @@ -1 +0,0 @@ -Turn VIR_ERR_NO_DOMAIN and NO_NETWORK errors into Not_found exceptions. diff --git a/config.h.in b/config.h.in index ab90ff8..989ed53 100644 --- a/config.h.in +++ b/config.h.in @@ -1,196 +1,5 @@ /* config.h.in. Generated from configure.ac by autoheader. */ -/* Define to 1 if you have the header file. */ -#undef HAVE_INTTYPES_H - -/* Define to 1 if you have the `ncurses' library (-lncurses). */ -#undef HAVE_LIBNCURSES - -/* Define to 1 if you have the `virt' library (-lvirt). */ -#undef HAVE_LIBVIRT - -/* Define to 1 if you have the header file. */ -#undef HAVE_MEMORY_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STDINT_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STDLIB_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STRINGS_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STRING_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_SYS_STAT_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_SYS_TYPES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_UNISTD_H - -/* Define to 1 if you have the `virConnectGetHostname' function. */ -#undef HAVE_VIRCONNECTGETHOSTNAME - -/* Define to 1 if you have the `virConnectGetURI' function. */ -#undef HAVE_VIRCONNECTGETURI - -/* Define to 1 if you have the `virConnectListDefinedStoragePools' function. - */ -#undef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS - -/* Define to 1 if you have the `virConnectListStoragePools' function. */ -#undef HAVE_VIRCONNECTLISTSTORAGEPOOLS - -/* Define to 1 if you have the `virConnectNumOfDefinedStoragePools' function. - */ -#undef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS - -/* Define to 1 if you have the `virConnectNumOfStoragePools' function. */ -#undef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS - -/* Define to 1 if you have the `virDomainBlockStats' function. */ -#undef HAVE_VIRDOMAINBLOCKSTATS - -/* Define to 1 if you have the `virDomainGetSchedulerParameters' function. */ -#undef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS - -/* Define to 1 if you have the `virDomainGetSchedulerType' function. */ -#undef HAVE_VIRDOMAINGETSCHEDULERTYPE - -/* Define to 1 if you have the `virDomainInterfaceStats' function. */ -#undef HAVE_VIRDOMAININTERFACESTATS - -/* Define to 1 if you have the `virDomainMigrate' function. */ -#undef HAVE_VIRDOMAINMIGRATE - -/* Define to 1 if you have the `virDomainSetSchedulerParameters' function. */ -#undef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS - -/* Define to 1 if the system has the type `virJobPtr'. */ -#undef HAVE_VIRJOBPTR - -/* Define to 1 if you have the `virNodeGetCellsFreeMemory' function. */ -#undef HAVE_VIRNODEGETCELLSFREEMEMORY - -/* Define to 1 if you have the `virNodeGetFreeMemory' function. */ -#undef HAVE_VIRNODEGETFREEMEMORY - -/* Define to 1 if you have the `virStoragePoolBuild' function. */ -#undef HAVE_VIRSTORAGEPOOLBUILD - -/* Define to 1 if you have the `virStoragePoolCreate' function. */ -#undef HAVE_VIRSTORAGEPOOLCREATE - -/* Define to 1 if you have the `virStoragePoolCreateXML' function. */ -#undef HAVE_VIRSTORAGEPOOLCREATEXML - -/* Define to 1 if you have the `virStoragePoolDefineXML' function. */ -#undef HAVE_VIRSTORAGEPOOLDEFINEXML - -/* Define to 1 if you have the `virStoragePoolDelete' function. */ -#undef HAVE_VIRSTORAGEPOOLDELETE - -/* Define to 1 if you have the `virStoragePoolDestroy' function. */ -#undef HAVE_VIRSTORAGEPOOLDESTROY - -/* Define to 1 if you have the `virStoragePoolFree' function. */ -#undef HAVE_VIRSTORAGEPOOLFREE - -/* Define to 1 if you have the `virStoragePoolGetAutostart' function. */ -#undef HAVE_VIRSTORAGEPOOLGETAUTOSTART - -/* Define to 1 if you have the `virStoragePoolGetConnect' function. */ -#undef HAVE_VIRSTORAGEPOOLGETCONNECT - -/* Define to 1 if you have the `virStoragePoolGetInfo' function. */ -#undef HAVE_VIRSTORAGEPOOLGETINFO - -/* Define to 1 if you have the `virStoragePoolGetName' function. */ -#undef HAVE_VIRSTORAGEPOOLGETNAME - -/* Define to 1 if you have the `virStoragePoolGetUUID' function. */ -#undef HAVE_VIRSTORAGEPOOLGETUUID - -/* Define to 1 if you have the `virStoragePoolGetUUIDString' function. */ -#undef HAVE_VIRSTORAGEPOOLGETUUIDSTRING - -/* Define to 1 if you have the `virStoragePoolGetXMLDesc' function. */ -#undef HAVE_VIRSTORAGEPOOLGETXMLDESC - -/* Define to 1 if you have the `virStoragePoolListVolumes' function. */ -#undef HAVE_VIRSTORAGEPOOLLISTVOLUMES - -/* Define to 1 if you have the `virStoragePoolLookupByName' function. */ -#undef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME - -/* Define to 1 if you have the `virStoragePoolLookupByUUID' function. */ -#undef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID - -/* Define to 1 if you have the `virStoragePoolLookupByUUIDString' function. */ -#undef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING - -/* Define to 1 if you have the `virStoragePoolLookupByVolume' function. */ -#undef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME - -/* Define to 1 if you have the `virStoragePoolNumOfVolumes' function. */ -#undef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES - -/* Define to 1 if the system has the type `virStoragePoolPtr'. */ -#undef HAVE_VIRSTORAGEPOOLPTR - -/* Define to 1 if you have the `virStoragePoolRefresh' function. */ -#undef HAVE_VIRSTORAGEPOOLREFRESH - -/* Define to 1 if you have the `virStoragePoolSetAutostart' function. */ -#undef HAVE_VIRSTORAGEPOOLSETAUTOSTART - -/* Define to 1 if you have the `virStoragePoolUndefine' function. */ -#undef HAVE_VIRSTORAGEPOOLUNDEFINE - -/* Define to 1 if you have the `virStorageVolCreateXML' function. */ -#undef HAVE_VIRSTORAGEVOLCREATEXML - -/* Define to 1 if you have the `virStorageVolDelete' function. */ -#undef HAVE_VIRSTORAGEVOLDELETE - -/* Define to 1 if you have the `virStorageVolFree' function. */ -#undef HAVE_VIRSTORAGEVOLFREE - -/* Define to 1 if you have the `virStorageVolGetInfo' function. */ -#undef HAVE_VIRSTORAGEVOLGETINFO - -/* Define to 1 if you have the `virStorageVolGetKey' function. */ -#undef HAVE_VIRSTORAGEVOLGETKEY - -/* Define to 1 if you have the `virStorageVolGetName' function. */ -#undef HAVE_VIRSTORAGEVOLGETNAME - -/* Define to 1 if you have the `virStorageVolGetPath' function. */ -#undef HAVE_VIRSTORAGEVOLGETPATH - -/* Define to 1 if you have the `virStorageVolGetXMLDesc' function. */ -#undef HAVE_VIRSTORAGEVOLGETXMLDESC - -/* Define to 1 if you have the `virStorageVolLookupByKey' function. */ -#undef HAVE_VIRSTORAGEVOLLOOKUPBYKEY - -/* Define to 1 if you have the `virStorageVolLookupByName' function. */ -#undef HAVE_VIRSTORAGEVOLLOOKUPBYNAME - -/* Define to 1 if you have the `virStorageVolLookupByPath' function. */ -#undef HAVE_VIRSTORAGEVOLLOOKUPBYPATH - -/* Define to 1 if the system has the type `virStorageVolPtr'. */ -#undef HAVE_VIRSTORAGEVOLPTR - -/* Define to 1 if your C compiler doesn't accept -c and -o together. */ -#undef NO_MINUS_C_MINUS_O - /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT @@ -205,12 +14,3 @@ /* Define to the version of this package. */ #undef PACKAGE_VERSION - -/* Define to 1 if the C compiler supports function prototypes. */ -#undef PROTOTYPES - -/* Define to 1 if you have the ANSI C header files. */ -#undef STDC_HEADERS - -/* Define like PROTOTYPES; this can be used by system headers. */ -#undef __PROTOTYPES diff --git a/configure.ac b/configure.ac index ba9be91..fd9e10c 100644 --- a/configure.ac +++ b/configure.ac @@ -1,4 +1,4 @@ -# ocaml-libvirt +# virt-top # Copyright (C) 2007-2008 Red Hat Inc., Richard W.M. Jones # # This library is free software; you can redistribute it and/or @@ -17,240 +17,69 @@ dnl Process this file with autoconf to produce a configure script. -AC_INIT(ocaml-libvirt,0.4.1.0) +AC_INIT(virt-top,1.0.0) -dnl Check for basic C environment. -AC_PROG_CC AC_PROG_INSTALL -AC_PROG_CPP - -AC_C_PROTOTYPES -test "x$U" != "x" && AC_MSG_ERROR(Compiler not ANSI compliant) - -AC_PROG_CC_C_O - -dnl Select some C flags based on the host type. -AC_CANONICAL_HOST - -DEBUG="-g" -WARNINGS="-Wall -Werror" -CFLAGS_FPIC="-fPIC" -WIN32=no -case "$host" in - *-*-mingw*) - WARNINGS="$WARNINGS -Wno-unused" - CFLAGS_FPIC="" - WIN32=yes -esac -AC_SUBST(DEBUG) -AC_SUBST(WARNINGS) -AC_SUBST(CFLAGS_FPIC) -AC_SUBST(WIN32) - -dnl Check for libvirt development environment. -AC_ARG_WITH(libvirt, - AC_HELP_STRING([--with-libvirt=PATH],[Set path to installed libvirt]), - [if test "x$withval" != "x"; then - CFLAGS="$CFLAGS -I$withval/include" - LDFLAGS="$LDFLAGS -L$withval/lib" - fi - ]) -AC_CHECK_LIB(virt,virConnectOpen, - [], - AC_MSG_ERROR([You must install libvirt library])) -AC_CHECK_HEADER([libvirt/libvirt.h], - [], - AC_MSG_ERROR([You must install libvirt development package])) - -dnl We also use -AC_CHECK_HEADER([libvirt/virterror.h], - [], - AC_MSG_ERROR([You must install libvirt development package])) - -dnl Check for libvirt >= 0.2.1 (our minimum supported version). -dnl See: http://libvirt.org/hvsupport.html -AC_CHECK_FUNC(virConnectGetCapabilities, - [], - AC_MSG_ERROR([You must have libvirt >= 0.2.1])) - -dnl Check for optional libvirt functions added since 0.2.1. -dnl See: http://libvirt.org/hvsupport.html -AC_CHECK_FUNCS([virConnectGetHostname \ - virConnectGetURI \ - virDomainBlockStats \ - virDomainGetSchedulerParameters \ - virDomainGetSchedulerType \ - virDomainInterfaceStats \ - virDomainMigrate \ - virDomainSetSchedulerParameters \ - virNodeGetFreeMemory \ - virNodeGetCellsFreeMemory \ - virStoragePoolGetConnect \ - virConnectNumOfStoragePools \ - virConnectListStoragePools \ - virConnectNumOfDefinedStoragePools \ - virConnectListDefinedStoragePools \ - virStoragePoolLookupByName \ - virStoragePoolLookupByUUID \ - virStoragePoolLookupByUUIDString \ - virStoragePoolLookupByVolume \ - virStoragePoolCreateXML \ - virStoragePoolDefineXML \ - virStoragePoolBuild \ - virStoragePoolUndefine \ - virStoragePoolCreate \ - virStoragePoolDestroy \ - virStoragePoolDelete \ - virStoragePoolFree \ - virStoragePoolRefresh \ - virStoragePoolGetName \ - virStoragePoolGetUUID \ - virStoragePoolGetUUIDString \ - virStoragePoolGetInfo \ - virStoragePoolGetXMLDesc \ - virStoragePoolGetAutostart \ - virStoragePoolSetAutostart \ - virStoragePoolNumOfVolumes \ - virStoragePoolListVolumes \ - virStorageVolLookupByName \ - virStorageVolLookupByKey \ - virStorageVolLookupByPath \ - virStorageVolGetName \ - virStorageVolGetKey \ - virStorageVolCreateXML \ - virStorageVolDelete \ - virStorageVolFree \ - virStorageVolGetInfo \ - virStorageVolGetXMLDesc \ - virStorageVolGetPath \ -]) - -# This jobs API was never published and is due to get overhauled -# in the near future: -# virJobGetInfo -# virJobGetDomain -# virJobGetNetwork -# virJobCancel -# virJobFree -# virDomainCreateLinuxJob -# virDomainSaveJob -# virDomainRestoreJob -# virDomainCoreDumpJob -# virDomainCreateJob -# virNetworkCreateXMLJob -# virNetworkCreateJob - -dnl Check for optional types added since 0.2.1. -AC_CHECK_TYPES([virJobPtr, virStoragePoolPtr, virStorageVolPtr],,, - [#include ]) - -dnl Check for optional ncurses. -AC_CHECK_LIB(ncurses,initscr) - -dnl Check for optional GNOME icons (from gnome-icon-theme package). -AC_ARG_WITH(icons, - AC_HELP_STRING([--with-icons=PATH], - [Set path to installed icons @<:@default=/usr/share/icons@:>@]), - [],[with_icons=/usr/share/icons]) -icons="" -if test "x$with_icons" != "xno"; then - for size in 16 24 32 48; do - for f in devices/computer.png; do - fname="${with_icons}/gnome/${size}x${size}/${f}" - AC_MSG_CHECKING([checking for icon $fname]) - if test -f "$fname"; then - AC_MSG_RESULT([yes]) - icons="$size $f $fname $icons" - else - AC_MSG_RESULT([no]) - fi - done - done -fi -AC_SUBST(with_icons) -AC_SUBST(icons) dnl Check for basic OCaml environment & findlib. -dnl Note that findlib is not necessary, but things will work better -dnl if it is present. AC_PROG_OCAML AC_PROG_FINDLIB -if test "x$OCAMLFIND" != "x"; then - dnl Use ocamlfind to find the required packages ... - - dnl Check for required OCaml packages. - AC_CHECK_OCAML_PKG(unix) - if test "x$pkg_unix" != "xyes"; then - AC_MSG_ERROR([Cannot find required OCaml package 'unix']) - fi - - dnl Check for optional OCaml packages. - AC_CHECK_OCAML_PKG(extlib) - AC_CHECK_OCAML_PKG(lablgtk2) - AC_CHECK_OCAML_PKG(curses) - AC_CHECK_OCAML_PKG(gettext) - AC_CHECK_OCAML_PKG(xml-light) - AC_CHECK_OCAML_PKG(csv) - AC_CHECK_OCAML_PKG(dbus) - - dnl Need to check which version of calendar is installed. - AC_CHECK_OCAML_MODULE(calendar,pkg_calendar2,CalendarLib.Date,[+calendar]) - if test "x$pkg_calendar2" = "xno"; then - AC_CHECK_OCAML_PKG(calendar) - fi +if test "x$OCAMLFIND" = "x"; then + AC_MSG_ERROR([OCaml findlib is required]) +fi - AC_SUBST(pkg_unix) - AC_SUBST(pkg_extlib) - AC_SUBST(pkg_lablgtk2) - AC_SUBST(pkg_curses) - AC_SUBST(pkg_gettext) - AC_SUBST(pkg_xml_light) - AC_SUBST(pkg_csv) - AC_SUBST(pkg_dbus) - AC_SUBST(pkg_calendar) - AC_SUBST(pkg_calendar2) -else - dnl Use a basic module test if there is no findlib ... +dnl Use ocamlfind to find the required packages ... - dnl Check for required OCaml modules. - AC_CHECK_OCAML_MODULE(unix,pkg_unix,Unix,[.]) - if test "x$pkg_unix" = "xno"; then - AC_MSG_ERROR([Cannot find required OCaml package 'unix']) - fi +dnl Check for required OCaml packages. +AC_CHECK_OCAML_PKG(unix) +if test "x$pkg_unix" != "xyes"; then + AC_MSG_ERROR([Cannot find required OCaml package 'unix']) +fi - dnl Check for optional OCaml modules. - AC_CHECK_OCAML_MODULE(extlib,pkg_extlib,ExtString,[+extlib]) - AC_CHECK_OCAML_MODULE(lablgtk2,pkg_lablgtk2,GMain,[+lablgtk2]) - AC_CHECK_OCAML_MODULE(curses,pkg_curses,Curses,[+curses]) - AC_CHECK_OCAML_MODULE(gettext,pkg_gettext,Gettext,[+gettext]) dnl XXX - AC_CHECK_OCAML_MODULE(xml-light,pkg_xml_light,Xml,[+xml-light]) - AC_CHECK_OCAML_MODULE(csv,pkg_csv,Csv,[+csv]) - AC_CHECK_OCAML_MODULE(dbus,pkg_dbus,DBus,[+dbus]) - dnl XXX Version check - see above. - AC_CHECK_OCAML_MODULE(calendar,pkg_calendar,Calendar,[+calendar]) +AC_CHECK_OCAML_PKG(extlib) +if test "x$pkg_extlib" != "xyes"; then + AC_MSG_ERROR([Cannot find required OCaml package 'extlib']) fi -dnl Which subpackages (== subdirs) will we build? -subdirs="libvirt examples mlvirsh" -if test "x$pkg_lablgtk2" != "xno"; then - subdirs="$subdirs virt-ctrl" +AC_CHECK_OCAML_PKG(libvirt) +if test "x$pkg_libvirt" != "xyes"; then + AC_MSG_ERROR([Cannot find required OCaml package 'libvirt']) fi -if test "x$pkg_extlib" != "xno" -a "x$pkg_curses" != "xno"; then - subdirs="$subdirs virt-top" + +AC_CHECK_OCAML_PKG(curses) +if test "x$pkg_curses" != "xyes"; then + AC_MSG_ERROR([Cannot find required OCaml package 'curses']) fi -if test "x$pkg_extlib" != "xno" -a "x$pkg_xml_light" != "xno"; then - subdirs="$subdirs virt-df" + +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_MODULE(calendar,pkg_calendar2,CalendarLib.Date,[+calendar]) +if test "x$pkg_calendar2" = "xno"; then + AC_CHECK_OCAML_PKG(calendar) fi -AC_SUBST(subdirs) + +AC_SUBST(pkg_unix) +AC_SUBST(pkg_extlib) +AC_SUBST(pkg_curses) +AC_SUBST(pkg_gettext) +AC_SUBST(pkg_xml_light) +AC_SUBST(pkg_csv) +AC_SUBST(pkg_calendar) +AC_SUBST(pkg_calendar2) dnl Check for optional perldoc (for building manual pages). AC_CHECK_PROG(HAVE_PERLDOC,perldoc,perldoc) -dnl Check for optional gdk-pixbuf-mlsource (for icons). -AC_CHECK_PROG(HAVE_GDK_PIXBUF_MLSOURCE,gdk-pixbuf-mlsource,gdk-pixbuf-mlsource) +dnl Check for recommended ocaml-gettext tool. +AC_CHECK_PROG(OCAML_GETTEXT,ocaml-gettext,ocaml-gettext) dnl Check for optional NSIS (for building a Windows installer). +dnl XXX NSIS support is probably broken at the moment XXX AC_ARG_WITH([nsis], [AS_HELP_STRING([--with-nsis], [use NSIS to build a Windows installer])], @@ -339,24 +168,53 @@ AC_SUBST(GNUTLS_DLL_PATH) AC_SUBST(GTK_DLL_PATH) AC_SUBST(GTK_PATH) +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$pkg_gettext" != "xno"; then + # Gettext module is available, so use it. + cat <>$d/$f +module Gettext = Gettext.Program ( + struct + let textdomain = "$d" + let codeset = None + let dir = None + let dependencies = [[]] + end +) (GettextStub.Native) +EOT + else + # No gettext module is available, so fake the translation functions. + cat <>$d/$f +module Gettext = struct + external s_ : string -> string = "%identity" + external f_ : ('a -> 'b, 'c, 'd) format -> ('a -> 'b, 'c, 'd) format + = "%identity" + let sn_ : string -> string -> int -> string + = fun s p n -> if n = 1 then s else p + let fn_ : ('a -> 'b, 'c, 'd) format -> ('a -> 'b, 'c, 'd) format -> int + -> ('a -> 'b, 'c, 'd) format + = fun s p n -> if n = 1 then s else p +end +EOT + fi +done + dnl Summary. echo "------------------------------------------------------------" echo "Thanks for downloading" $PACKAGE_STRING -echo " subpackages to build : $subdirs" echo "------------------------------------------------------------" dnl Produce output files. AC_CONFIG_HEADERS([config.h]) -AC_CONFIG_FILES([META - libvirt/libvirt_version.ml - Makefile +AC_CONFIG_FILES([Makefile Make.rules - libvirt/Makefile - examples/Makefile - mlvirsh/Makefile - virt-ctrl/Makefile + po/Makefile virt-top/Makefile - virt-df/Makefile ]) if test "x$MAKENSIS" != "x"; then AC_CONFIG_FILES([wininstaller.nsis]) diff --git a/examples/.depend b/examples/.depend deleted file mode 100644 index 334ba5d..0000000 --- a/examples/.depend +++ /dev/null @@ -1,4 +0,0 @@ -list_domains.cmo: ../libvirt/libvirt.cmi -list_domains.cmx: ../libvirt/libvirt.cmx -node_info.cmo: ../libvirt/libvirt.cmi -node_info.cmx: ../libvirt/libvirt.cmx diff --git a/examples/Makefile.in b/examples/Makefile.in deleted file mode 100644 index 75a98eb..0000000 --- a/examples/Makefile.in +++ /dev/null @@ -1,90 +0,0 @@ -# ocaml-libvirt -# Copyright (C) 2007 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 -# License as published by the Free Software Foundation; either -# version 2 of the License, or (at your option) any later version. -# -# This library 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 -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -OCAMLFIND = @OCAMLFIND@ - -ifneq ($(OCAMLFIND),) -OCAMLCPACKAGES := -package unix -I ../libvirt -OCAMLCFLAGS := -g -OCAMLCLIBS := -linkpkg -OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) -OCAMLOPTFLAGS := -OCAMLOPTLIBS := $(OCAMLCLIBS) -else -OCAMLCINCS := -I ../libvirt -OCAMLCFLAGS := -g -OCAMLCLIBS := unix.cma -OCAMLOPTINCS := $(OCAMLCINCS) -OCAMLOPTFLAGS := -OCAMLOPTLIBS := unix.cmxa -endif - -export LIBRARY_PATH=../libvirt -export LD_LIBRARY_PATH=../libvirt - -BYTE_TARGETS := list_domains node_info -OPT_TARGETS := list_domains.opt node_info.opt - -all: $(BYTE_TARGETS) - -opt: $(OPT_TARGETS) - -ifneq ($(OCAMLFIND),) -list_domains: list_domains.cmo - $(OCAMLFIND) ocamlc \ - $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma -o $@ $< - -list_domains.opt: list_domains.cmx - $(OCAMLFIND) ocamlopt \ - $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa -o $@ $< - -node_info: node_info.cmo - $(OCAMLFIND) ocamlc \ - $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma -o $@ $< - -node_info.opt: node_info.cmx - $(OCAMLFIND) ocamlopt \ - $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa -o $@ $< -else -list_domains: list_domains.cmo - $(OCAMLC) \ - $(OCAMLCINCS) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma -o $@ $< - -list_domains.opt: list_domains.cmx - $(OCAMLOPT) \ - $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa -o $@ $< - -node_info: node_info.cmo - $(OCAMLC) \ - $(OCAMLCINCS) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma -o $@ $< - -node_info.opt: node_info.cmx - $(OCAMLOPT) \ - $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa -o $@ $< -endif - -install: - -include ../Make.rules diff --git a/examples/list_domains.ml b/examples/list_domains.ml deleted file mode 100644 index c97432c..0000000 --- a/examples/list_domains.ml +++ /dev/null @@ -1,46 +0,0 @@ -(* Simple demo program showing how to list out domains. - Usage: list_domains [URI] - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - *) - -open Printf - -module C = Libvirt.Connect -module D = Libvirt.Domain -module N = Libvirt.Network - -let () = - try - let name = - if Array.length Sys.argv >= 2 then - Some (Sys.argv.(1)) - else - None in - let conn = C.connect_readonly ?name () in - - (* List running domains. *) - let n = C.num_of_domains conn in - let ids = C.list_domains conn n in - let domains = Array.map (D.lookup_by_id conn) ids in - Array.iter ( - fun dom -> - printf "%8d %s\n%!" (D.get_id dom) (D.get_name dom) - ) domains; - - (* List inactive domains. *) - let n = C.num_of_defined_domains conn in - let names = C.list_defined_domains conn n in - Array.iter ( - fun name -> - printf "inactive %s\n%!" name - ) names; - with - Libvirt.Virterror err -> - eprintf "error: %s\n" (Libvirt.Virterror.to_string err) - -let () = - (* Run the garbage collector which is a good way to check for - * memory corruption errors and reference counting issues in libvirt. - *) - Gc.compact () diff --git a/examples/node_info.ml b/examples/node_info.ml deleted file mode 100644 index c52615e..0000000 --- a/examples/node_info.ml +++ /dev/null @@ -1,48 +0,0 @@ -(* Simple demo program showing node info. - Usage: node_info [URI] - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - *) - -open Printf - -module C = Libvirt.Connect - -let () = - try - let name = - if Array.length Sys.argv >= 2 then - Some (Sys.argv.(1)) - else - None in - let conn = C.connect_readonly ?name () in - - (* Get node_info, hostname, etc. *) - let node_info = C.get_node_info conn in - - printf "model = %s\n" node_info.C.model; - printf "memory = %Ld K\n" node_info.C.memory; - printf "cpus = %d\n" node_info.C.cpus; - printf "mhz = %d\n" node_info.C.mhz; - printf "nodes = %d\n" node_info.C.nodes; - printf "sockets = %d\n" node_info.C.sockets; - printf "cores = %d\n" node_info.C.cores; - printf "threads = %d\n%!" node_info.C.threads; - - let hostname = C.get_hostname conn in - - printf "hostname = %s\n%!" hostname; - - let uri = C.get_uri conn in - - printf "uri = %s\n%!" uri - - with - Libvirt.Virterror err -> - eprintf "error: %s\n" (Libvirt.Virterror.to_string err) - -let () = - (* Run the garbage collector which is a good way to check for - * memory corruption errors and reference counting issues in libvirt. - *) - Gc.compact () diff --git a/libvirt/.depend b/libvirt/.depend deleted file mode 100644 index 5556d96..0000000 --- a/libvirt/.depend +++ /dev/null @@ -1,4 +0,0 @@ -libvirt.cmo: libvirt.cmi -libvirt.cmx: libvirt.cmi -libvirt_version.cmo: libvirt_version.cmi -libvirt_version.cmx: libvirt_version.cmi diff --git a/libvirt/Makefile.in b/libvirt/Makefile.in deleted file mode 100644 index 4b203fd..0000000 --- a/libvirt/Makefile.in +++ /dev/null @@ -1,125 +0,0 @@ -# ocaml-libvirt -# Copyright (C) 2007 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 -# License as published by the Free Software Foundation; either -# version 2 of the License, or (at your option) any later version. -# -# This library 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 -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -WIN32 = @WIN32@ - -CFLAGS = @CFLAGS@ \ - -I.. \ - -I"$(shell ocamlc -where)" \ - @DEBUG@ @WARNINGS@ @CFLAGS_FPIC@ -LDFLAGS = @LDFLAGS@ -# -L"$(shell ocamlc -where)" - -OCAMLC = @OCAMLC@ -OCAMLOPT = @OCAMLOPT@ -OCAMLFIND = @OCAMLFIND@ -OCAMLMKLIB = @OCAMLMKLIB@ - -ifneq ($(OCAMLFIND),) -OCAMLCPACKAGES := -package unix -OCAMLCFLAGS := -g -OCAMLCLIBS := -linkpkg -else -OCAMLCINCS := -OCAMLCFLAGS := -g -OCAMLCLIBS := unix.cma -endif - -OCAMLOPTFLAGS := -ifneq ($(OCAMLFIND),) -OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) -OCAMLOPTLIBS := $(OCAMLCLIBS) -else -OCAMLOPTINCS := $(OCAMLCINCS) -OCAMLOPTLIBS := unix.cmxa -endif - -export LIBRARY_PATH=. -export LD_LIBRARY_PATH=. - -BYTE_TARGETS := mllibvirt.cma -OPT_TARGETS := mllibvirt.cmxa - -all: $(BYTE_TARGETS) - -opt: $(OPT_TARGETS) - -COBJS := libvirt.cmo libvirt_version.cmo -OPTOBJS := libvirt.cmx libvirt_version.cmx - -ifneq ($(OCAMLMKLIB),) -# Good, we can just use ocamlmklib -mllibvirt.cma: libvirt_c.o $(COBJS) - $(OCAMLMKLIB) -o mllibvirt $^ $(LDFLAGS) -lvirt - -mllibvirt.cmxa: libvirt_c.o $(OPTOBJS) - $(OCAMLMKLIB) -o mllibvirt $^ $(LDFLAGS) -lvirt - -else -ifeq ($(WIN32),yes) -# Ugh, MinGW doesn't have ocamlmklib. This technique is copied from the -# example in OCaml distribution, otherlibs/win32unix/Makefile.nt - -mllibvirt.cma: dllmllibvirt.dll libmllibvirt.a $(COBJS) - $(OCAMLC) -a -linkall -o $@ $(COBJS) \ - -dllib -lmllibvirt -cclib -lmllibvirt -cclib "$(LDFLAGS) -lvirt" - -mllibvirt.cmxa: libmllibvirt.a $(OPTOBJS) - $(OCAMLOPT) -a -linkall -o $@ $(OPTOBJS) \ - -cclib -lmllibvirt -cclib "$(LDFLAGS) -lvirt" - -dllmllibvirt.dll: libvirt_c.o - $(CC) -shared -o $@ $^ \ - $(LDFLAGS) "$(shell ocamlc -where)"/ocamlrun.a -lvirt - -libmllibvirt.a: libvirt_c.o - ar rc $@ $^ - ranlib $@ - -else -# Don't know how to build a library on this platform. -$(BYTE_TARGETS) $(OPT_TARGETS): - echo "Error: ocamlmklib missing, and no known way to build libraries on this platform" - exit 1 -endif -endif - -# Automatically generate the C code from a Perl script 'generator.pl'. -libvirt_c.c: generator.pl - perl -w $< - -# Status of automatically generated bindings. -autostatus: libvirt_c.c - @echo -n "Functions which have manual bindings: " - @grep ^ocaml_libvirt_ libvirt_c_oneoffs.c | wc -l - @echo -n "Functions which have automatic bindings: " - @grep ^ocaml_libvirt_ libvirt_c.c | wc -l - @echo -n "LOC in manual bindings: " - @wc -l < libvirt_c_oneoffs.c - @echo -n "LOC in automatic bindings: " - @wc -l < libvirt_c.c - -libvirt.cmo: libvirt.cmi -libvirt.cmi: libvirt.mli - -libvirt_version.cmo: libvirt_version.cmi -libvirt_version.cmi: libvirt_version.mli - -install: - ocamlfind install libvirt ../META *.so *.a *.cmx *.cma *.cmxa *.mli - -include ../Make.rules diff --git a/libvirt/README b/libvirt/README deleted file mode 100644 index be8300d..0000000 --- a/libvirt/README +++ /dev/null @@ -1,49 +0,0 @@ -README -====== - -The public interface is described in 'libvirt.mli'. You may prefer to -do 'make doc' at the top level source directory and then read the HTML -documentation starting at html/index.html. - -'libvirt.ml' describes how OCaml functions map to C functions. - -'libvirt_c*.c' are the C functions which map OCaml objects to C -objects and vice versa (see next section). - -Generated code --------------- - -The C bindings in 'libvirt_c.c' are now generated automatically by a -Perl script called 'generator.pl'. You do not normally need to run -this script, but you may need to if you want to extend libvirt -coverage. - -The majority of the functions are now generated automatically, but -there are a few one-off bindings (eg. one-of-a-type functions, -functions with particularly complex mappings). Our eventual aim to is -autogenerate as much as possible. Use 'make autostatus' in this -directory to find out how we're doing. - -The generated 'libvirt_c.c' #includes some other C files in this -directory: - - #include "libvirt_c_prologue.c" - - A prologue that prototypes some static functions which are defined - in the epilogue (see below), and provides some general macros. - - #include "libvirt_c_oneoffs.c" - - One-off bindings: Bindings which are too specialised or one-of-a-kind - to be worth generating automatically. - - [Followed by generated bindings, then ...] - - #include "libvirt_c_epilogue.c" - - An epilogue which defines some standard static functions (eg.) for - wrapping and unwrapping libvirt objects. - -The key to understanding the generator is to look at the generated -code (libvirt_c.c) first, and go from there back to parts of the -generator script. diff --git a/libvirt/generator.pl b/libvirt/generator.pl deleted file mode 100755 index 578029b..0000000 --- a/libvirt/generator.pl +++ /dev/null @@ -1,1019 +0,0 @@ -#!/usr/bin/perl -w -# -# OCaml bindings for libvirt. -# (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. -# http://libvirt.org/ -# -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; either -# version 2 of the License, or (at your option) any later version. -# -# This library 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 -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -# This generates libvirt_c.c (the core of the bindings). You don't -# need to run this program unless you are extending the bindings -# themselves (eg. because libvirt has been extended). -# -# Please read libvirt/README. - -use strict; - -#---------------------------------------------------------------------- - -# The functions in the libvirt API that we can generate. - -# The 'sig' (signature) doesn't have a meaning or any internal structure. -# It is interpreted by the generation functions below to indicate what -# "class" the function falls into, and to generate the right class of -# binding. -# -# Any function added since libvirt 0.2.1 must be marked weak. - -my @functions = ( - { name => "virConnectClose", sig => "conn : free" }, - { name => "virConnectGetHostname", sig => "conn : string", weak => 1 }, - { name => "virConnectGetURI", sig => "conn : string", weak => 1 }, - { name => "virConnectGetType", sig => "conn : static string" }, - { name => "virConnectNumOfDomains", sig => "conn : int" }, - { name => "virConnectListDomains", sig => "conn, int : int array" }, - { name => "virConnectNumOfDefinedDomains", sig => "conn : int" }, - { name => "virConnectListDefinedDomains", - sig => "conn, int : string array" }, - { name => "virConnectNumOfNetworks", sig => "conn : int" }, - { name => "virConnectListNetworks", sig => "conn, int : string array" }, - { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" }, - { name => "virConnectListDefinedNetworks", - sig => "conn, int : string array" }, - { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 }, - { name => "virConnectListStoragePools", - sig => "conn, int : string array", weak => 1 }, - { name => "virConnectNumOfDefinedStoragePools", - sig => "conn : int", weak => 1 }, - { name => "virConnectListDefinedStoragePools", - sig => "conn, int : string array", weak => 1 }, - { name => "virConnectGetCapabilities", sig => "conn : string" }, - - { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" }, - { name => "virDomainCreateLinuxJob", - sig => "conn, string, 0U : job", weak => 1 }, - { name => "virDomainFree", sig => "dom : free" }, - { name => "virDomainDestroy", sig => "dom : free" }, - { name => "virDomainLookupByName", sig => "conn, string : dom" }, - { name => "virDomainLookupByID", sig => "conn, int : dom" }, - { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" }, - { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" }, - { name => "virDomainGetName", sig => "dom : static string" }, - { name => "virDomainGetOSType", sig => "dom : string" }, - { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" }, - { name => "virDomainGetUUID", sig => "dom : uuid" }, - { name => "virDomainGetUUIDString", sig => "dom : uuid string" }, - { name => "virDomainGetMaxVcpus", sig => "dom : int" }, - { name => "virDomainSave", sig => "dom, string : unit" }, - { name => "virDomainSaveJob", - sig => "dom, string : job from dom", weak => 1 }, - { name => "virDomainRestore", sig => "conn, string : unit" }, - { name => "virDomainRestoreJob", - sig => "conn, string : job", weak => 1 }, - { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" }, - { name => "virDomainCoreDumpJob", - sig => "dom, string, 0 : job from dom", weak => 1 }, - { name => "virDomainSuspend", sig => "dom : unit" }, - { name => "virDomainResume", sig => "dom : unit" }, - { name => "virDomainShutdown", sig => "dom : unit" }, - { name => "virDomainReboot", sig => "dom, 0 : unit" }, - { name => "virDomainDefineXML", sig => "conn, string : dom" }, - { name => "virDomainUndefine", sig => "dom : unit" }, - { name => "virDomainCreate", sig => "dom : unit" }, - { name => "virDomainCreateJob", - sig => "dom, 0U : job from dom", weak => 1 }, - { name => "virDomainAttachDevice", sig => "dom, string : unit" }, - { name => "virDomainDetachDevice", sig => "dom, string : unit" }, - { name => "virDomainGetAutostart", sig => "dom : bool" }, - { name => "virDomainSetAutostart", sig => "dom, bool : unit" }, - - { name => "virNetworkFree", sig => "net : free" }, - { name => "virNetworkDestroy", sig => "net : free" }, - { name => "virNetworkLookupByName", sig => "conn, string : net" }, - { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" }, - { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" }, - { name => "virNetworkGetName", sig => "net : static string" }, - { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" }, - { name => "virNetworkGetBridgeName", sig => "net : string" }, - { name => "virNetworkGetUUID", sig => "net : uuid" }, - { name => "virNetworkGetUUIDString", sig => "net : uuid string" }, - { name => "virNetworkUndefine", sig => "net : unit" }, - { name => "virNetworkCreateXML", sig => "conn, string : net" }, - { name => "virNetworkCreateXMLJob", - sig => "conn, string : job", weak => 1 }, - { name => "virNetworkDefineXML", sig => "conn, string : net" }, - { name => "virNetworkCreate", sig => "net : unit" }, - { name => "virNetworkCreateJob", - sig => "net : job from net", weak => 1 }, - { name => "virNetworkGetAutostart", sig => "net : bool" }, - { name => "virNetworkSetAutostart", sig => "net, bool : unit" }, - - { name => "virStoragePoolFree", sig => "pool : free", weak => 1 }, - { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 }, - { name => "virStoragePoolLookupByName", - sig => "conn, string : pool", weak => 1 }, - { name => "virStoragePoolLookupByUUID", - sig => "conn, uuid : pool", weak => 1 }, - { name => "virStoragePoolLookupByUUIDString", - sig => "conn, string : pool", weak => 1 }, - { name => "virStoragePoolGetName", - sig => "pool : static string", weak => 1 }, - { name => "virStoragePoolGetXMLDesc", - sig => "pool, 0U : string", weak => 1 }, - { name => "virStoragePoolGetUUID", - sig => "pool : uuid", weak => 1 }, - { name => "virStoragePoolGetUUIDString", - sig => "pool : uuid string", weak => 1 }, - { name => "virStoragePoolCreateXML", - sig => "conn, string, 0U : pool", weak => 1 }, - { name => "virStoragePoolDefineXML", - sig => "conn, string, 0U : pool", weak => 1 }, - { name => "virStoragePoolBuild", - sig => "pool, uint : unit", weak => 1 }, - { name => "virStoragePoolUndefine", - sig => "pool : unit", weak => 1 }, - { name => "virStoragePoolCreate", - sig => "pool, 0U : unit", weak => 1 }, - { name => "virStoragePoolDelete", - sig => "pool, uint : unit", weak => 1 }, - { name => "virStoragePoolRefresh", - sig => "pool, 0U : unit", weak => 1 }, - { name => "virStoragePoolGetAutostart", - sig => "pool : bool", weak => 1 }, - { name => "virStoragePoolSetAutostart", - sig => "pool, bool : unit", weak => 1 }, - { name => "virStoragePoolNumOfVolumes", - sig => "pool : int", weak => 1 }, - { name => "virStoragePoolListVolumes", - sig => "pool, int : string array", weak => 1 }, - - { name => "virStorageVolFree", sig => "vol : free", weak => 1 }, - { name => "virStorageVolDelete", - sig => "vol, uint : unit", weak => 1 }, - { name => "virStorageVolLookupByName", - sig => "pool, string : vol from pool", weak => 1 }, - { name => "virStorageVolLookupByKey", - sig => "conn, string : vol", weak => 1 }, - { name => "virStorageVolLookupByPath", - sig => "conn, string : vol", weak => 1 }, - { name => "virStorageVolCreateXML", - sig => "pool, string, 0U : vol from pool", weak => 1 }, - { name => "virStorageVolGetXMLDesc", - sig => "vol, 0U : string", weak => 1 }, - { name => "virStorageVolGetPath", - sig => "vol : string", weak => 1 }, - { name => "virStorageVolGetKey", - sig => "vol : static string", weak => 1 }, - { name => "virStorageVolGetName", - sig => "vol : static string", weak => 1 }, - { name => "virStoragePoolLookupByVolume", - sig => "vol : pool from vol", weak => 1 }, - - { name => "virJobFree", - sig => "job : free", weak => 1 }, - { name => "virJobCancel", - sig => "job : unit", weak => 1 }, - { name => "virJobGetNetwork", - sig => "job : net from job", weak => 1 }, - { name => "virJobGetDomain", - sig => "job : dom from job", weak => 1 }, - - ); - -# Functions we haven't implemented anywhere yet but which are mentioned -# in 'libvirt.ml'. -# -# We create stubs for these, but eventually they need to either be -# moved ^^^ so they are auto-generated, or implementations of them -# written in 'libvirt_c_oneoffs.c'. - -my @unimplemented = ( - ); - -#---------------------------------------------------------------------- - -# Open the output file. - -my $filename = "libvirt_c.c"; -open F, ">$filename" or die "$filename: $!"; - -# Write the prologue. - -print F <<'END'; -/* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!! - * - * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'. - * - * Any changes you make to this file may be overwritten. - */ - -/* OCaml bindings for libvirt. - * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - * http://libvirt.org/ - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2 of the License, or (at your option) any later version. - * - * This library 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 - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - -#include "config.h" - -#include -#include -#include - -#include -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "libvirt_c_prologue.c" - -#include "libvirt_c_oneoffs.c" - -END - -#---------------------------------------------------------------------- - -sub camel_case_to_underscores -{ - my $name = shift; - - $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g; - my @subs = split (/,/, $name); - @subs = map { lc($_) } @subs; - join "_", @subs -} - -# Helper functions dealing with signatures. - -sub short_name_to_c_type -{ - local $_ = shift; - - if ($_ eq "conn") { "virConnectPtr" } - elsif ($_ eq "dom") { "virDomainPtr" } - elsif ($_ eq "net") { "virNetworkPtr" } - elsif ($_ eq "pool") { "virStoragePoolPtr" } - elsif ($_ eq "vol") { "virStorageVolPtr" } - elsif ($_ eq "job") { "virJobPtr" } - else { - die "unknown short name $_" - } -} - -# Generate a C signature for the original function. Used when building -# weak bindings. - -sub gen_c_signature -{ - my $sig = shift; - my $c_name = shift; - - if ($sig =~ /^(\w+) : string$/) { - my $c_type = short_name_to_c_type ($1); - "char *$c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : static string$/) { - my $c_type = short_name_to_c_type ($1); - "const char *$c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : int$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : uuid$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, unsigned char *)" - } elsif ($sig =~ /^(\w+) : uuid string$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, char *)" - } elsif ($sig =~ /^(\w+) : bool$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, int *r)" - } elsif ($sig =~ /^(\w+), bool : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, int b)" - } elsif ($sig eq "conn, int : int array") { - "int $c_name (virConnectPtr conn, int *ids, int maxids)" - } elsif ($sig =~ /^(\w+), int : string array$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, char **const names, int maxnames)" - } elsif ($sig =~ /^(\w+), 0(U?) : string$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "char *$c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "int $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+) : free$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+), string : unit$/) { - my $c_type = short_name_to_c_type ($1); - "int $c_name ($c_type $1, const char *str)" - } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - "int $c_name ($c_type $1, const char *str, ${unsigned}int flags)" - } elsif ($sig =~ /^(\w+), string : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1, const char *str)" - } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, const char *str, ${unsigned}int flags)" - } elsif ($sig =~ /^(\w+), (u?)int : unit$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "u" ? "unsigned " : ""; - "int $c_name ($c_type $1, ${unsigned}int i)" - } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "u" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, ${unsigned}int i)" - } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1, const unsigned char *str)" - } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : (\w+)$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1)" - } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1, const char *str)" - } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)" - } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $unsigned = $2 eq "U" ? "unsigned " : ""; - my $c_ret_type = short_name_to_c_type ($3); - "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" - } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { - my $c_type = short_name_to_c_type ($1); - my $c_ret_type = short_name_to_c_type ($2); - "$c_ret_type $c_name ($c_type $1)" - } else { - die "unknown signature $sig" - } -} - -# OCaml argument names. - -sub gen_arg_names -{ - my $sig = shift; - - if ($sig =~ /^(\w+) : string$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : static string$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : int$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : uuid$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : uuid string$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : bool$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+), bool : unit$/) { - ( "$1v", "bv" ) - } elsif ($sig eq "conn, int : int array") { - ( "connv", "iv" ) - } elsif ($sig =~ /^(\w+), int : string array$/) { - ( "$1v", "iv" ) - } elsif ($sig =~ /^(\w+), 0U? : string$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+), 0U? : unit$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : unit$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : free$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+), string : unit$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), string : (\w+)$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) { - ( "$1v", "iv" ) - } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { - ( "$1v", "uuidv" ) - } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : (\w+)$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) { - ( "$1v", "strv" ) - } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) { - ( "$1v" ) - } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { - ( "$1v" ) - } else { - die "unknown signature $sig" - } -} - -# Unpack the first (object) argument. - -sub gen_unpack_args -{ - local $_ = shift; - - if ($_ eq "conn") { - "virConnectPtr conn = Connect_val (connv);" - } elsif ($_ eq "dom") { - "virDomainPtr dom = Domain_val (domv);\n". - " virConnectPtr conn = Connect_domv (domv);" - } elsif ($_ eq "net") { - "virNetworkPtr net = Network_val (netv);\n". - " virConnectPtr conn = Connect_netv (netv);" - } elsif ($_ eq "pool") { - "virStoragePoolPtr pool = Pool_val (poolv);\n". - " virConnectPtr conn = Connect_polv (poolv);" - } elsif ($_ eq "vol") { - "virStorageVolPtr vol = Volume_val (volv);\n". - " virConnectPtr conn = Connect_volv (volv);" - } elsif ($_ eq "job") { - "virJobPtr job = Job_val (jobv);\n". - " virConnectPtr conn = Connect_jobv (jobv);" - } else { - die "unknown short name $_" - } -} - -# Pack the result if it's an object. - -sub gen_pack_result -{ - local $_ = shift; - - if ($_ eq "dom") { "rv = Val_domain (r, connv);" } - elsif ($_ eq "net") { "rv = Val_network (r, connv);" } - elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" } - elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" } - elsif ($_ eq "job") { "rv = Val_job (r, connv);" } - else { - die "unknown short name $_" - } -} - -sub gen_free_arg -{ - local $_ = shift; - - if ($_ eq "conn") { "Connect_val (connv) = NULL;" } - elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" } - elsif ($_ eq "net") { "Network_val (netv) = NULL;" } - elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" } - elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" } - elsif ($_ eq "job") { "Job_val (jobv) = NULL;" } - else { - die "unknown short name $_" - } -} - -# Generate the C body for each signature (class of function). - -sub gen_c_code -{ - my $sig = shift; - my $c_name = shift; - - if ($sig =~ /^(\w+) : string$/) { - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char *r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : static string$/) { - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - const char *r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : int$/) { - "\ - " . gen_unpack_args ($1) . " - int r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (Val_int (r)); -" - } elsif ($sig =~ /^(\w+) : uuid$/) { - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - unsigned char uuid[VIR_UUID_BUFLEN]; - int r; - - NONBLOCKING (r = $c_name ($1, uuid)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - /* UUIDs are byte arrays with a fixed length. */ - rv = caml_alloc_string (VIR_UUID_BUFLEN); - memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : uuid string$/) { - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char uuid[VIR_UUID_STRING_BUFLEN]; - int r; - - NONBLOCKING (r = $c_name ($1, uuid)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - rv = caml_copy_string (uuid); - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : bool$/) { - "\ - " . gen_unpack_args ($1) . " - int r, b; - - NONBLOCKING (r = $c_name ($1, &b)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (b ? Val_true : Val_false); -" - } elsif ($sig =~ /^(\w+), bool : unit$/) { - "\ - " . gen_unpack_args ($1) . " - int r, b; - - b = bv == Val_true ? 1 : 0; - - NONBLOCKING (r = $c_name ($1, b)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } elsif ($sig eq "conn, int : int array") { - "\ - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - int ids[i], r; - - NONBLOCKING (r = $c_name (conn, ids, i)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) - Store_field (rv, i, Val_int (ids[i])); - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), int : string array$/) { - "\ - CAMLlocal2 (rv, strv); - " . gen_unpack_args ($1) . " - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = $c_name ($1, names, i)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) { - strv = caml_copy_string (names[i]); - Store_field (rv, i, strv); - free (names[i]); - } - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), 0U? : string$/) { - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char *r; - - NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), 0U? : unit$/) { - "\ - " . gen_unpack_args ($1) . " - int r; - - NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+) : unit$/) { - "\ - " . gen_unpack_args ($1) . " - int r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+) : free$/) { - "\ - " . gen_unpack_args ($1) . " - int r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - /* So that we don't double-free in the finalizer: */ - " . gen_free_arg ($1) . " - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+), string : unit$/) { - "\ - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - int r; - - NONBLOCKING (r = $c_name ($1, str)); - CHECK_ERROR (r == -1, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - int r; - - NONBLOCKING (r = $c_name ($1, str, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+), string : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, str)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, str, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), (u?)int : unit$/) { - my $unsigned = $2 eq "u" ? "unsigned " : ""; - "\ - " . gen_unpack_args ($1) . " - ${unsigned}int i = Int_val (iv); - int r; - - NONBLOCKING (r = $c_name ($1, i)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - CAMLreturn (Val_unit); -" - } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($3); - my $unsigned = $2 eq "u" ? "unsigned " : ""; - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - ${unsigned}int i = Int_val (iv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, i)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($3) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - unsigned char *uuid = (unsigned char *) String_val (uuidv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, uuid)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal1 (rv); - " . gen_unpack_args ($1) . " - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal2 (rv, connv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, str)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - connv = Field ($3v, 1); - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal2 (rv, connv); - " . gen_unpack_args ($1) . " - char *str = String_val (strv); - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, str, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - connv = Field ($3v, 1); - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal2 (rv, connv); - " . gen_unpack_args ($1) . " - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1, 0)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - connv = Field ($3v, 1); - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) { - my $c_ret_type = short_name_to_c_type ($2); - "\ - CAMLlocal2 (rv, connv); - " . gen_unpack_args ($1) . " - $c_ret_type r; - - NONBLOCKING (r = $c_name ($1)); - CHECK_ERROR (!r, conn, \"$c_name\"); - - connv = Field ($3v, 1); - " . gen_pack_result ($2) . " - - CAMLreturn (rv); -" - } else { - die "unknown signature $sig" - } -} - -# Generate each function. - -foreach my $function (@functions) { - my $c_name = $function->{name}; - my $is_weak = $function->{weak}; - my $sig = $function->{sig}; - - #print "generating $c_name with sig \"$sig\" ...\n"; - - #my $is_pool_func = $c_name =~ /^virStoragePool/; - #my $is_vol_func = $c_name =~ /^virStorageVol/; - - # Generate an equivalent C-external name for the function, unless - # one is defined already. - my $c_external_name; - if (exists ($function->{c_external_name})) { - $c_external_name = $function->{c_external_name}; - } elsif ($c_name =~ /^vir/) { - $c_external_name = substr $c_name, 3; - $c_external_name = camel_case_to_underscores ($c_external_name); - $c_external_name = "ocaml_libvirt_" . $c_external_name; - } else { - die "cannot convert c_name $c_name to c_external_name" - } - - print F < unit -> int * int = "ocaml_libvirt_get_version" - -let uuid_length = 16 -let uuid_string_length = 36 - -(* http://caml.inria.fr/pub/ml-archives/caml-list/2004/07/80683af867cce6bf8fff273973f70c95.en.html *) -type rw = [`R|`W] -type ro = [`R] - -type ('a, 'b) job_t - -module Connect = -struct - type 'rw t - - type node_info = { - model : string; - memory : int64; - cpus : int; - mhz : int; - nodes : int; - sockets : int; - cores : int; - threads : int; - } - - external connect : ?name:string -> unit -> rw t = "ocaml_libvirt_connect_open" - external connect_readonly : ?name:string -> unit -> ro t = "ocaml_libvirt_connect_open_readonly" - external close : [>`R] t -> unit = "ocaml_libvirt_connect_close" - external get_type : [>`R] t -> string = "ocaml_libvirt_connect_get_type" - external get_version : [>`R] t -> int = "ocaml_libvirt_connect_get_version" - external get_hostname : [>`R] t -> string = "ocaml_libvirt_connect_get_hostname" - external get_uri : [>`R] t -> string = "ocaml_libvirt_connect_get_uri" - external get_max_vcpus : [>`R] t -> ?type_:string -> unit -> int = "ocaml_libvirt_connect_get_max_vcpus" - external list_domains : [>`R] t -> int -> int array = "ocaml_libvirt_connect_list_domains" - external num_of_domains : [>`R] t -> int = "ocaml_libvirt_connect_num_of_domains" - external get_capabilities : [>`R] t -> xml = "ocaml_libvirt_connect_get_capabilities" - external num_of_defined_domains : [>`R] t -> int = "ocaml_libvirt_connect_num_of_defined_domains" - external list_defined_domains : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_defined_domains" - external num_of_networks : [>`R] t -> int = "ocaml_libvirt_connect_num_of_networks" - external list_networks : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_networks" - external num_of_defined_networks : [>`R] t -> int = "ocaml_libvirt_connect_num_of_defined_networks" - external list_defined_networks : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_defined_networks" - external num_of_pools : [>`R] t -> int = "ocaml_libvirt_connect_num_of_storage_pools" - external list_pools : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_storage_pools" - external num_of_defined_pools : [>`R] t -> int = "ocaml_libvirt_connect_num_of_defined_storage_pools" - external list_defined_pools : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_defined_storage_pools" - - external get_node_info : [>`R] t -> node_info = "ocaml_libvirt_connect_get_node_info" - external node_get_free_memory : [> `R] t -> int64 = "ocaml_libvirt_connect_node_get_free_memory" - external node_get_cells_free_memory : [> `R] t -> int -> int -> int64 array = "ocaml_libvirt_connect_node_get_cells_free_memory" - - (* See VIR_NODEINFO_MAXCPUS macro defined in . *) - let maxcpus_of_node_info { nodes = nodes; sockets = sockets; - cores = cores; threads = threads } = - nodes * sockets * cores * threads - - (* See VIR_CPU_MAPLEN macro defined in . *) - let cpumaplen nr_cpus = - (nr_cpus + 7) / 8 - - (* See VIR_USE_CPU, VIR_UNUSE_CPU, VIR_CPU_USABLE macros defined in . *) - let use_cpu cpumap cpu = - cpumap.[cpu/8] <- - Char.chr (Char.code cpumap.[cpu/8] lor (1 lsl (cpu mod 8))) - let unuse_cpu cpumap cpu = - cpumap.[cpu/8] <- - Char.chr (Char.code cpumap.[cpu/8] land (lnot (1 lsl (cpu mod 8)))) - let cpu_usable cpumaps maplen vcpu cpu = - Char.code cpumaps.[vcpu*maplen + cpu/8] land (1 lsl (cpu mod 8)) <> 0 - - external const : [>`R] t -> ro t = "%identity" -end - -module Domain = -struct - type 'rw t - - type state = - | InfoNoState | InfoRunning | InfoBlocked | InfoPaused - | InfoShutdown | InfoShutoff | InfoCrashed - - type info = { - state : state; - max_mem : int64; - memory : int64; - nr_virt_cpu : int; - cpu_time : int64; - } - - type vcpu_state = VcpuOffline | VcpuRunning | VcpuBlocked - - type vcpu_info = { - number : int; - vcpu_state : vcpu_state; - vcpu_time : int64; - cpu : int; - } - - type sched_param = string * sched_param_value - and sched_param_value = - | SchedFieldInt32 of int32 | SchedFieldUInt32 of int32 - | SchedFieldInt64 of int64 | SchedFieldUInt64 of int64 - | SchedFieldFloat of float | SchedFieldBool of bool - - type migrate_flag = Live - - type block_stats = { - rd_req : int64; - rd_bytes : int64; - wr_req : int64; - wr_bytes : int64; - errs : int64; - } - - type interface_stats = { - rx_bytes : int64; - rx_packets : int64; - rx_errs : int64; - rx_drop : int64; - tx_bytes : int64; - tx_packets : int64; - tx_errs : int64; - tx_drop : int64; - } - - external create_linux : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_create_linux" - external create_linux_job : [>`W] Connect.t -> xml -> ([`Domain], rw) job_t = "ocaml_libvirt_domain_create_linux_job" - external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id" - external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid" - external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid_string" - external lookup_by_name : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_name" - external destroy : [>`W] t -> unit = "ocaml_libvirt_domain_destroy" - external free : [>`R] t -> unit = "ocaml_libvirt_domain_free" - external suspend : [>`W] t -> unit = "ocaml_libvirt_domain_suspend" - external resume : [>`W] t -> unit = "ocaml_libvirt_domain_resume" - external save : [>`W] t -> filename -> unit = "ocaml_libvirt_domain_save" - external save_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_save_job" - external restore : [>`W] Connect.t -> filename -> unit = "ocaml_libvirt_domain_restore" - external restore_job : [>`W] Connect.t -> filename -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_restore_job" - external core_dump : [>`W] t -> filename -> unit = "ocaml_libvirt_domain_core_dump" - external core_dump_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_core_dump_job" - external shutdown : [>`W] t -> unit = "ocaml_libvirt_domain_shutdown" - external reboot : [>`W] t -> unit = "ocaml_libvirt_domain_reboot" - external get_name : [>`R] t -> string = "ocaml_libvirt_domain_get_name" - external get_uuid : [>`R] t -> uuid = "ocaml_libvirt_domain_get_uuid" - external get_uuid_string : [>`R] t -> string = "ocaml_libvirt_domain_get_uuid_string" - external get_id : [>`R] t -> int = "ocaml_libvirt_domain_get_id" - external get_os_type : [>`R] t -> string = "ocaml_libvirt_domain_get_os_type" - external get_max_memory : [>`R] t -> int64 = "ocaml_libvirt_domain_get_max_memory" - external set_max_memory : [>`W] t -> int64 -> unit = "ocaml_libvirt_domain_set_max_memory" - external set_memory : [>`W] t -> int64 -> unit = "ocaml_libvirt_domain_set_memory" - external get_info : [>`R] t -> info = "ocaml_libvirt_domain_get_info" - external get_xml_desc : [>`R] t -> xml = "ocaml_libvirt_domain_get_xml_desc" - external get_scheduler_type : [>`R] t -> string * int = "ocaml_libvirt_domain_get_scheduler_type" - external get_scheduler_parameters : [>`R] t -> int -> sched_param array = "ocaml_libvirt_domain_get_scheduler_parameters" - external set_scheduler_parameters : [>`W] t -> sched_param array -> unit = "ocaml_libvirt_domain_set_scheduler_parameters" - external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_define_xml" - external undefine : [>`W] t -> unit = "ocaml_libvirt_domain_undefine" - external create : [>`W] t -> unit = "ocaml_libvirt_domain_create" - external create_job : [>`W] t -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_create_job" - external get_autostart : [>`R] t -> bool = "ocaml_libvirt_domain_get_autostart" - external set_autostart : [>`W] t -> bool -> unit = "ocaml_libvirt_domain_set_autostart" - external set_vcpus : [>`W] t -> int -> unit = "ocaml_libvirt_domain_set_vcpus" - external pin_vcpu : [>`W] t -> int -> string -> unit = "ocaml_libvirt_domain_pin_vcpu" - external get_vcpus : [>`R] t -> int -> int -> int * vcpu_info array * string = "ocaml_libvirt_domain_get_vcpus" - external get_max_vcpus : [>`R] t -> int = "ocaml_libvirt_domain_get_max_vcpus" - external attach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_attach_device" - external detach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_detach_device" - external migrate : [>`W] t -> [>`W] Connect.t -> migrate_flag list -> ?dname:string -> ?uri:string -> ?bandwidth:int -> unit -> rw t = "ocaml_libvirt_domain_migrate_bytecode" "ocaml_libvirt_domain_migrate_native" - external block_stats : [>`R] t -> string -> block_stats = "ocaml_libvirt_domain_block_stats" - external interface_stats : [>`R] t -> string -> interface_stats = "ocaml_libvirt_domain_interface_stats" - - external const : [>`R] t -> ro t = "%identity" -end - -module Network = -struct - type 'rw t - - external lookup_by_name : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_network_lookup_by_name" - external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_network_lookup_by_uuid" - external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_network_lookup_by_uuid_string" - external create_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_network_create_xml" - external create_xml_job : [>`W] Connect.t -> xml -> ([`Network], rw) job_t = "ocaml_libvirt_network_create_xml_job" - external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_network_define_xml" - external undefine : [>`W] t -> unit = "ocaml_libvirt_network_undefine" - external create : [>`W] t -> unit = "ocaml_libvirt_network_create" - external create_job : [>`W] t -> ([`Network_nocreate], rw) job_t = "ocaml_libvirt_network_create_job" - external destroy : [>`W] t -> unit = "ocaml_libvirt_network_destroy" - external free : [>`R] t -> unit = "ocaml_libvirt_network_free" - external get_name : [>`R] t -> string = "ocaml_libvirt_network_get_name" - external get_uuid : [>`R] t -> uuid = "ocaml_libvirt_network_get_uuid" - external get_uuid_string : [>`R] t -> string = "ocaml_libvirt_network_get_uuid_string" - external get_xml_desc : [>`R] t -> xml = "ocaml_libvirt_network_get_xml_desc" - external get_bridge_name : [>`R] t -> string = "ocaml_libvirt_network_get_bridge_name" - external get_autostart : [>`R] t -> bool = "ocaml_libvirt_network_get_autostart" - external set_autostart : [>`W] t -> bool -> unit = "ocaml_libvirt_network_set_autostart" - - external const : [>`R] t -> ro t = "%identity" -end - -module Pool = -struct - type 'rw t - type pool_state = Inactive | Building | Running | Degraded - type pool_build_flags = New | Repair | Resize - type pool_delete_flags = Normal | Zeroed - type pool_info = { - state : pool_state; - capacity : int64; - allocation : int64; - available : int64; - } - - external lookup_by_name : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_pool_lookup_by_name" - external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_storage_pool_lookup_by_uuid" - external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_pool_lookup_by_uuid_string" - external create_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_storage_pool_create_xml" - external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_storage_pool_define_xml" - external build : [>`W] t -> pool_build_flags -> unit = "ocaml_libvirt_storage_pool_build" - external undefine : [>`W] t -> unit = "ocaml_libvirt_storage_pool_undefine" - external create : [>`W] t -> unit = "ocaml_libvirt_storage_pool_create" - external destroy : [>`W] t -> unit = "ocaml_libvirt_storage_pool_destroy" - external delete : [>`W] t -> unit = "ocaml_libvirt_storage_pool_delete" - external free : [>`R] t -> unit = "ocaml_libvirt_storage_pool_free" - external refresh : [`R] t -> unit = "ocaml_libvirt_storage_pool_refresh" - external get_name : [`R] t -> string = "ocaml_libvirt_storage_pool_get_name" - external get_uuid : [`R] t -> uuid = "ocaml_libvirt_storage_pool_get_uuid" - external get_uuid_string : [`R] t -> string = "ocaml_libvirt_storage_pool_get_uuid_string" - external get_info : [`R] t -> pool_info = "ocaml_libvirt_storage_pool_get_info" - external get_xml_desc : [`R] t -> xml = "ocaml_libvirt_storage_pool_get_xml_desc" - external get_autostart : [`R] t -> bool = "ocaml_libvirt_storage_pool_get_autostart" - external set_autostart : [`W] t -> bool -> unit = "ocaml_libvirt_storage_pool_set_autostart" - external num_of_volumes : [`R] t -> int = "ocaml_libvirt_storage_pool_num_of_volumes" - external list_volumes : [`R] t -> int -> string array = "ocaml_libvirt_storage_pool_list_volumes" - external const : [>`R] t -> ro t = "%identity" -end - -module Volume = -struct - type 'rw t - type vol_type = File | Block - type vol_delete_flags = Normal | Zeroed - type vol_info = { - typ : vol_type; - capacity : int64; - allocation : int64; - } - - external lookup_by_name : 'a Pool.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_name" - external lookup_by_key : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_key" - external lookup_by_path : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_path" - external pool_of_volume : 'a t -> 'a Pool.t = "ocaml_libvirt_storage_pool_lookup_by_volume" - external get_name : [`R] t -> string = "ocaml_libvirt_storage_vol_get_name" - external get_key : [`R] t -> string = "ocaml_libvirt_storage_vol_get_key" - external get_path : [`R] t -> string = "ocaml_libvirt_storage_vol_get_path" - external get_info : [`R] t -> vol_info = "ocaml_libvirt_storage_vol_get_info" - external get_xml_desc : [`R] t -> xml = "ocaml_libvirt_storage_vol_get_xml_desc" - external create_xml : [`W] Pool.t -> xml -> unit = "ocaml_libvirt_storage_vol_create_xml" - external delete : [`W] t -> unit = "ocaml_libvirt_storage_vol_delete" - external free : [>`R] t -> unit = "ocaml_libvirt_storage_vol_free" - external const : [>`R] t -> ro t = "%identity" -end - -module Job = -struct - type ('jobclass, 'rw) t = ('jobclass, 'rw) job_t - type job_type = Bounded | Unbounded - type job_state = Running | Complete | Failed | Cancelled - type job_info = { - typ : job_type; - state : job_state; - running_time : int; - remaining_time : int; - percent_complete : int - } - external get_info : ('a,'b) t -> job_info = "ocaml_libvirt_job_get_info" - external get_domain : ([`Domain], 'a) t -> 'a Domain.t = "ocaml_libvirt_job_get_domain" - external get_network : ([`Network], 'a) t -> 'a Network.t = "ocaml_libvirt_job_get_network" - external cancel : ('a,'b) t -> unit = "ocaml_libvirt_job_cancel" - external free : ('a, [>`R]) t -> unit = "ocaml_libvirt_job_free" - external const : ('a, [>`R]) t -> ('a, ro) t = "%identity" -end - -module Virterror = -struct - type code = - | VIR_ERR_OK - | VIR_ERR_INTERNAL_ERROR - | VIR_ERR_NO_MEMORY - | VIR_ERR_NO_SUPPORT - | VIR_ERR_UNKNOWN_HOST - | VIR_ERR_NO_CONNECT - | VIR_ERR_INVALID_CONN - | VIR_ERR_INVALID_DOMAIN - | VIR_ERR_INVALID_ARG - | VIR_ERR_OPERATION_FAILED - | VIR_ERR_GET_FAILED - | VIR_ERR_POST_FAILED - | VIR_ERR_HTTP_ERROR - | VIR_ERR_SEXPR_SERIAL - | VIR_ERR_NO_XEN - | VIR_ERR_XEN_CALL - | VIR_ERR_OS_TYPE - | VIR_ERR_NO_KERNEL - | VIR_ERR_NO_ROOT - | VIR_ERR_NO_SOURCE - | VIR_ERR_NO_TARGET - | VIR_ERR_NO_NAME - | VIR_ERR_NO_OS - | VIR_ERR_NO_DEVICE - | VIR_ERR_NO_XENSTORE - | VIR_ERR_DRIVER_FULL - | VIR_ERR_CALL_FAILED - | VIR_ERR_XML_ERROR - | VIR_ERR_DOM_EXIST - | VIR_ERR_OPERATION_DENIED - | VIR_ERR_OPEN_FAILED - | VIR_ERR_READ_FAILED - | VIR_ERR_PARSE_FAILED - | VIR_ERR_CONF_SYNTAX - | VIR_ERR_WRITE_FAILED - | VIR_ERR_XML_DETAIL - | VIR_ERR_INVALID_NETWORK - | VIR_ERR_NETWORK_EXIST - | VIR_ERR_SYSTEM_ERROR - | VIR_ERR_RPC - | VIR_ERR_GNUTLS_ERROR - | VIR_WAR_NO_NETWORK - | VIR_ERR_NO_DOMAIN - | VIR_ERR_NO_NETWORK - | VIR_ERR_INVALID_MAC - | VIR_ERR_AUTH_FAILED - | VIR_ERR_INVALID_STORAGE_POOL - | VIR_ERR_INVALID_STORAGE_VOL - | VIR_WAR_NO_STORAGE - | VIR_ERR_NO_STORAGE_POOL - | VIR_ERR_NO_STORAGE_VOL - | VIR_ERR_UNKNOWN of int - - let string_of_code = function - | VIR_ERR_OK -> "VIR_ERR_OK" - | VIR_ERR_INTERNAL_ERROR -> "VIR_ERR_INTERNAL_ERROR" - | VIR_ERR_NO_MEMORY -> "VIR_ERR_NO_MEMORY" - | VIR_ERR_NO_SUPPORT -> "VIR_ERR_NO_SUPPORT" - | VIR_ERR_UNKNOWN_HOST -> "VIR_ERR_UNKNOWN_HOST" - | VIR_ERR_NO_CONNECT -> "VIR_ERR_NO_CONNECT" - | VIR_ERR_INVALID_CONN -> "VIR_ERR_INVALID_CONN" - | VIR_ERR_INVALID_DOMAIN -> "VIR_ERR_INVALID_DOMAIN" - | VIR_ERR_INVALID_ARG -> "VIR_ERR_INVALID_ARG" - | VIR_ERR_OPERATION_FAILED -> "VIR_ERR_OPERATION_FAILED" - | VIR_ERR_GET_FAILED -> "VIR_ERR_GET_FAILED" - | VIR_ERR_POST_FAILED -> "VIR_ERR_POST_FAILED" - | VIR_ERR_HTTP_ERROR -> "VIR_ERR_HTTP_ERROR" - | VIR_ERR_SEXPR_SERIAL -> "VIR_ERR_SEXPR_SERIAL" - | VIR_ERR_NO_XEN -> "VIR_ERR_NO_XEN" - | VIR_ERR_XEN_CALL -> "VIR_ERR_XEN_CALL" - | VIR_ERR_OS_TYPE -> "VIR_ERR_OS_TYPE" - | VIR_ERR_NO_KERNEL -> "VIR_ERR_NO_KERNEL" - | VIR_ERR_NO_ROOT -> "VIR_ERR_NO_ROOT" - | VIR_ERR_NO_SOURCE -> "VIR_ERR_NO_SOURCE" - | VIR_ERR_NO_TARGET -> "VIR_ERR_NO_TARGET" - | VIR_ERR_NO_NAME -> "VIR_ERR_NO_NAME" - | VIR_ERR_NO_OS -> "VIR_ERR_NO_OS" - | VIR_ERR_NO_DEVICE -> "VIR_ERR_NO_DEVICE" - | VIR_ERR_NO_XENSTORE -> "VIR_ERR_NO_XENSTORE" - | VIR_ERR_DRIVER_FULL -> "VIR_ERR_DRIVER_FULL" - | VIR_ERR_CALL_FAILED -> "VIR_ERR_CALL_FAILED" - | VIR_ERR_XML_ERROR -> "VIR_ERR_XML_ERROR" - | VIR_ERR_DOM_EXIST -> "VIR_ERR_DOM_EXIST" - | VIR_ERR_OPERATION_DENIED -> "VIR_ERR_OPERATION_DENIED" - | VIR_ERR_OPEN_FAILED -> "VIR_ERR_OPEN_FAILED" - | VIR_ERR_READ_FAILED -> "VIR_ERR_READ_FAILED" - | VIR_ERR_PARSE_FAILED -> "VIR_ERR_PARSE_FAILED" - | VIR_ERR_CONF_SYNTAX -> "VIR_ERR_CONF_SYNTAX" - | VIR_ERR_WRITE_FAILED -> "VIR_ERR_WRITE_FAILED" - | VIR_ERR_XML_DETAIL -> "VIR_ERR_XML_DETAIL" - | VIR_ERR_INVALID_NETWORK -> "VIR_ERR_INVALID_NETWORK" - | VIR_ERR_NETWORK_EXIST -> "VIR_ERR_NETWORK_EXIST" - | VIR_ERR_SYSTEM_ERROR -> "VIR_ERR_SYSTEM_ERROR" - | VIR_ERR_RPC -> "VIR_ERR_RPC" - | VIR_ERR_GNUTLS_ERROR -> "VIR_ERR_GNUTLS_ERROR" - | VIR_WAR_NO_NETWORK -> "VIR_WAR_NO_NETWORK" - | VIR_ERR_NO_DOMAIN -> "VIR_ERR_NO_DOMAIN" - | VIR_ERR_NO_NETWORK -> "VIR_ERR_NO_NETWORK" - | VIR_ERR_INVALID_MAC -> "VIR_ERR_INVALID_MAC" - | VIR_ERR_AUTH_FAILED -> "VIR_ERR_AUTH_FAILED" - | VIR_ERR_INVALID_STORAGE_POOL -> "VIR_ERR_INVALID_STORAGE_POOL" - | VIR_ERR_INVALID_STORAGE_VOL -> "VIR_ERR_INVALID_STORAGE_VOL" - | VIR_WAR_NO_STORAGE -> "VIR_WAR_NO_STORAGE" - | VIR_ERR_NO_STORAGE_POOL -> "VIR_ERR_NO_STORAGE_POOL" - | VIR_ERR_NO_STORAGE_VOL -> "VIR_ERR_NO_STORAGE_VOL" - | VIR_ERR_UNKNOWN i -> "VIR_ERR_" ^ string_of_int i - - type domain = - | VIR_FROM_NONE - | VIR_FROM_XEN - | VIR_FROM_XEND - | VIR_FROM_XENSTORE - | VIR_FROM_SEXPR - | VIR_FROM_XML - | VIR_FROM_DOM - | VIR_FROM_RPC - | VIR_FROM_PROXY - | VIR_FROM_CONF - | VIR_FROM_QEMU - | VIR_FROM_NET - | VIR_FROM_TEST - | VIR_FROM_REMOTE - | VIR_FROM_OPENVZ - | VIR_FROM_XENXM - | VIR_FROM_STATS_LINUX - | VIR_FROM_STORAGE - | VIR_FROM_UNKNOWN of int - - let string_of_domain = function - | VIR_FROM_NONE -> "VIR_FROM_NONE" - | VIR_FROM_XEN -> "VIR_FROM_XEN" - | VIR_FROM_XEND -> "VIR_FROM_XEND" - | VIR_FROM_XENSTORE -> "VIR_FROM_XENSTORE" - | VIR_FROM_SEXPR -> "VIR_FROM_SEXPR" - | VIR_FROM_XML -> "VIR_FROM_XML" - | VIR_FROM_DOM -> "VIR_FROM_DOM" - | VIR_FROM_RPC -> "VIR_FROM_RPC" - | VIR_FROM_PROXY -> "VIR_FROM_PROXY" - | VIR_FROM_CONF -> "VIR_FROM_CONF" - | VIR_FROM_QEMU -> "VIR_FROM_QEMU" - | VIR_FROM_NET -> "VIR_FROM_NET" - | VIR_FROM_TEST -> "VIR_FROM_TEST" - | VIR_FROM_REMOTE -> "VIR_FROM_REMOTE" - | VIR_FROM_OPENVZ -> "VIR_FROM_OPENVZ" - | VIR_FROM_XENXM -> "VIR_FROM_XENXM" - | VIR_FROM_STATS_LINUX -> "VIR_FROM_STATS_LINUX" - | VIR_FROM_STORAGE -> "VIR_FROM_STORAGE" - | VIR_FROM_UNKNOWN i -> "VIR_FROM_" ^ string_of_int i - - type level = - | VIR_ERR_NONE - | VIR_ERR_WARNING - | VIR_ERR_ERROR - | VIR_ERR_UNKNOWN_LEVEL of int - - let string_of_level = function - | VIR_ERR_NONE -> "VIR_ERR_NONE" - | VIR_ERR_WARNING -> "VIR_ERR_WARNING" - | VIR_ERR_ERROR -> "VIR_ERR_ERROR" - | VIR_ERR_UNKNOWN_LEVEL i -> "VIR_ERR_LEVEL_" ^ string_of_int i - - type t = { - code : code; - domain : domain; - message : string option; - level : level; - conn : ro Connect.t option; - dom : ro Domain.t option; - str1 : string option; - str2 : string option; - str3 : string option; - int1 : int32; - int2 : int32; - net : ro Network.t option; - } - - let to_string { code = code; domain = domain; message = message } = - let buf = Buffer.create 128 in - Buffer.add_string buf "libvirt: "; - Buffer.add_string buf (string_of_code code); - Buffer.add_string buf ": "; - Buffer.add_string buf (string_of_domain domain); - Buffer.add_string buf ": "; - (match message with Some msg -> Buffer.add_string buf msg | None -> ()); - Buffer.contents buf - - external get_last_error : unit -> t option = "ocaml_libvirt_virterror_get_last_error" - external get_last_conn_error : [>`R] Connect.t -> t option = "ocaml_libvirt_virterror_get_last_conn_error" - external reset_last_error : unit -> unit = "ocaml_libvirt_virterror_reset_last_error" - external reset_last_conn_error : [>`R] Connect.t -> unit = "ocaml_libvirt_virterror_reset_last_conn_error" - - let no_error () = - { code = VIR_ERR_OK; domain = VIR_FROM_NONE; message = None; - level = VIR_ERR_NONE; conn = None; dom = None; - str1 = None; str2 = None; str3 = None; - int1 = 0_l; int2 = 0_l; net = None } -end - -exception Virterror of Virterror.t -exception Not_supported of string - -(* Initialization. *) -external c_init : unit -> unit = "ocaml_libvirt_init" -let () = - Callback.register_exception - "ocaml_libvirt_virterror" (Virterror (Virterror.no_error ())); - Callback.register_exception - "ocaml_libvirt_not_supported" (Not_supported ""); - c_init () diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli deleted file mode 100644 index af372af..0000000 --- a/libvirt/libvirt.mli +++ /dev/null @@ -1,994 +0,0 @@ -(** OCaml bindings for libvirt. *) -(* (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - This library 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 - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) - -(** - {2 Introduction and examples} - - This is a set of bindings for writing OCaml programs to - manage virtual machines through {{:http://libvirt.org/}libvirt}. - - {3 Using libvirt interactively} - - Using the interactive toplevel: - -{v -$ ocaml -I +libvirt - Objective Caml version 3.10.0 - -# #load "unix.cma";; -# #load "mllibvirt.cma";; -# let name = "test:///default";; -val name : string = "test:///default" -# let conn = Libvirt.Connect.connect_readonly ~name () ;; -val conn : Libvirt.ro Libvirt.Connect.t = -# Libvirt.Connect.get_node_info conn;; - : Libvirt.Connect.node_info = -{Libvirt.Connect.model = "i686"; Libvirt.Connect.memory = 3145728L; - Libvirt.Connect.cpus = 16; Libvirt.Connect.mhz = 1400; - Libvirt.Connect.nodes = 2; Libvirt.Connect.sockets = 2; - Libvirt.Connect.cores = 2; Libvirt.Connect.threads = 2} -v} - - {3 Compiling libvirt programs} - - This command compiles a program to native code: - -{v -ocamlopt -I +libvirt mllibvirt.cmxa list_domains.ml -o list_domains -v} - - {3 Example: Connect to the hypervisor} - - The main modules are {!Libvirt.Connect}, {!Libvirt.Domain} and - {!Libvirt.Network} corresponding respectively to the - {{:http://libvirt.org/html/libvirt-libvirt.html}virConnect*, virDomain* and virNetwork* functions from libvirt}. - For brevity I usually rename these modules like this: - -{v -module C = Libvirt.Connect -module D = Libvirt.Domain -module N = Libvirt.Network -v} - - To get a connection handle, assuming a Xen hypervisor: - -{v -let name = "xen:///" -let conn = C.connect_readonly ~name () -v} - - {3 Example: List running domains} - -{v -open Printf - -let n = C.num_of_domains conn in -let ids = C.list_domains conn n in -let domains = Array.map (D.lookup_by_id conn) ids in -Array.iter ( - fun dom -> - printf "%8d %s\n%!" (D.get_id dom) (D.get_name dom) -) domains; -v} - - {3 Example: List inactive domains} - -{v -let n = C.num_of_defined_domains conn in -let names = C.list_defined_domains conn n in -Array.iter ( - fun name -> - printf "inactive %s\n%!" name -) names; -v} - - {3 Example: Print node info} - -{v -let node_info = C.get_node_info conn in -printf "model = %s\n" node_info.C.model; -printf "memory = %Ld K\n" node_info.C.memory; -printf "cpus = %d\n" node_info.C.cpus; -printf "mhz = %d\n" node_info.C.mhz; -printf "nodes = %d\n" node_info.C.nodes; -printf "sockets = %d\n" node_info.C.sockets; -printf "cores = %d\n" node_info.C.cores; -printf "threads = %d\n%!" node_info.C.threads; - -let hostname = C.get_hostname conn in -printf "hostname = %s\n%!" hostname; - -let uri = C.get_uri conn in -printf "uri = %s\n%!" uri -v} - -*) - - -(** {2 Programming issues} - - {3 General safety issues} - - Memory allocation / automatic garbage collection of all libvirt - objects should be completely safe (except in the specific - virterror case noted below). If you find any safety issues or if your - pure OCaml program ever segfaults, please contact the author. - - You can force a libvirt object to be freed early by calling - the [close] function on the object. This shouldn't affect - the safety of garbage collection and should only be used when - you want to explicitly free memory. Note that explicitly - closing a connection object does nothing if there are still - unclosed domain or network objects referencing it. - - Note that even though you hold open (eg) a domain object, that - doesn't mean that the domain (virtual machine) actually exists. - The domain could have been shut down or deleted by another user. - Thus domain objects can through odd exceptions at any time. - This is just the nature of virtualisation. - - Virterror has a specific design error which means that the - objects embedded in a virterror exception message are only - valid as long as the connection handle is still open. This - is a design flaw in the C code of libvirt and we cannot fix - or work around it in the OCaml bindings. - - {3 Backwards and forwards compatibility} - - OCaml-libvirt is backwards and forwards compatible with - any libvirt >= 0.2.1. One consequence of this is that - your program can dynamically link to a {i newer} version of - libvirt than it was compiled with, and it should still - work. - - When we link to an older version of libvirt.so, there may - be missing functions. If ocaml-libvirt was compiled with - gcc, then these are turned into OCaml {!Libvirt.Not_supported} - exceptions. - - We don't support libvirt < 0.2.1, and never will so don't ask us. - - {3 Threads} - - You can issue multiple concurrent libvirt requests in - different threads. However you must follow this rule: - Each thread must have its own separate libvirt connection, {i or} - you must implement your own mutex scheme to ensure that no - two threads can ever make concurrent calls using the same - libvirt connection. - - (Note that multithreaded code is not well tested. If you find - bugs please report them.) - - {3 Initialisation} - - Libvirt requires all callers to call virInitialize before - using the library. This is done automatically for you by - these bindings when the program starts up, and we believe - that the way this is done is safe. - - {2 Reference} -*) - -type uuid = string - (** This is a "raw" UUID, ie. a packed string of bytes. *) - -type xml = string - (** Type of XML (an uninterpreted string of bytes). Use PXP, expat, - xml-light, etc. if you want to do anything useful with the XML. - *) - -type filename = string - (** A filename. *) - -val get_version : ?driver:string -> unit -> int * int - (** [get_version ()] returns the library version in the first part - of the tuple, and [0] in the second part. - - [get_version ~driver ()] returns the library version in the first - part of the tuple, and the version of the driver called [driver] - in the second part. - - The version numbers are encoded as - 1,000,000 * major + 1,000 * minor + release. - *) - -val uuid_length : int - (** Length of packed UUIDs. *) - -val uuid_string_length : int - (** Length of UUID strings. *) - -type rw = [`R|`W] -type ro = [`R] - (** These - {{:http://caml.inria.fr/pub/ml-archives/caml-list/2004/07/80683af867cce6bf8fff273973f70c95.en.html}phantom types} - are used to ensure the type-safety of read-only - versus read-write connections. - - All connection/domain/etc. objects are marked with - a phantom read-write or read-only type, and trying to - pass a read-only object into a function which could - mutate the object will cause a compile time error. - - Each module provides a function like {!Libvirt.Connect.const} - to demote a read-write object into a read-only object. The - opposite operation is, of course, not allowed. - - If you want to handle both read-write and read-only - connections at runtime, use a variant similar to this: -{v -type conn_t = - | No_connection - | Read_only of Libvirt.ro Libvirt.Connect.t - | Read_write of Libvirt.rw Libvirt.Connect.t -v} - See also the source of [mlvirsh]. - *) - -type ('a, 'b) job_t -(** Forward definition of {!Job.t} to avoid recursive module dependencies. *) - -(** {3 Connections} *) - -module Connect : -sig - type 'rw t - (** Connection. Read-only connections have type [ro Connect.t] and - read-write connections have type [rw Connect.t]. - *) - - type node_info = { - model : string; (** CPU model *) - memory : int64; (** memory size in kilobytes *) - cpus : int; (** number of active CPUs *) - mhz : int; (** expected CPU frequency *) - nodes : int; (** number of NUMA nodes (1 = UMA) *) - sockets : int; (** number of CPU sockets per node *) - cores : int; (** number of cores per socket *) - threads : int; (** number of threads per core *) - } - - val connect : ?name:string -> unit -> rw t - val connect_readonly : ?name:string -> unit -> ro t - (** [connect ~name ()] connects to the hypervisor with URI [name]. - - [connect ()] connects to the default hypervisor. - - [connect_readonly] is the same but connects in read-only mode. - *) - - val close : [>`R] t -> unit - (** [close conn] closes and frees the connection object in memory. - - The connection is automatically closed if it is garbage - collected. This function just forces it to be closed - and freed right away. - *) - - val get_type : [>`R] t -> string - (** Returns the name of the driver (hypervisor). *) - - val get_version : [>`R] t -> int - (** Returns the driver version - [major * 1_000_000 + minor * 1000 + release] - *) - val get_hostname : [>`R] t -> string - (** Returns the hostname of the physical server. *) - val get_uri : [>`R] t -> string - (** Returns the canonical connection URI. *) - val get_max_vcpus : [>`R] t -> ?type_:string -> unit -> int - (** Returns the maximum number of virtual CPUs - supported by a guest VM of a particular type. *) - val list_domains : [>`R] t -> int -> int array - (** [list_domains conn max] returns the running domain IDs, - up to a maximum of [max] entries. - Call {!num_of_domains} first to get a value for [max]. - *) - val num_of_domains : [>`R] t -> int - (** Returns the number of running domains. *) - val get_capabilities : [>`R] t -> xml - (** Returns the hypervisor capabilities (as XML). *) - val num_of_defined_domains : [>`R] t -> int - (** Returns the number of inactive (shutdown) domains. *) - val list_defined_domains : [>`R] t -> int -> string array - (** [list_defined_domains conn max] - returns the names of the inactive domains, up to - a maximum of [max] entries. - Call {!num_of_defined_domains} first to get a value for [max]. - *) - val num_of_networks : [>`R] t -> int - (** Returns the number of networks. *) - val list_networks : [>`R] t -> int -> string array - (** [list_networks conn max] - returns the names of the networks, up to a maximum - of [max] entries. - Call {!num_of_networks} first to get a value for [max]. - *) - val num_of_defined_networks : [>`R] t -> int - (** Returns the number of inactive networks. *) - val list_defined_networks : [>`R] t -> int -> string array - (** [list_defined_networks conn max] - returns the names of the inactive networks, up to a maximum - of [max] entries. - Call {!num_of_defined_networks} first to get a value for [max]. - *) - - val num_of_pools : [>`R] t -> int - (** Returns the number of storage pools. *) - val list_pools : [>`R] t -> int -> string array - (** Return list of storage pools. *) - val num_of_defined_pools : [>`R] t -> int - (** Returns the number of storage pools. *) - val list_defined_pools : [>`R] t -> int -> string array - (** Return list of storage pools. *) - - (* The name of this function is inconsistent, but the inconsistency - * is really in libvirt itself. - *) - val get_node_info : [>`R] t -> node_info - (** Return information about the physical server. *) - - val node_get_free_memory : [> `R] t -> int64 - (** - [node_get_free_memory conn] - returns the amount of free memory (not allocated to any guest) - in the machine. - *) - - val node_get_cells_free_memory : [> `R] t -> int -> int -> int64 array - (** - [node_get_cells_free_memory conn start max] - returns the amount of free memory on each NUMA cell in kilobytes. - [start] is the first cell for which we return free memory. - [max] is the maximum number of cells for which we return free memory. - Returns an array of up to [max] entries in length. - *) - - val maxcpus_of_node_info : node_info -> int - (** Calculate the total number of CPUs supported (but not necessarily - active) in the host. - *) - - val cpumaplen : int -> int - (** Calculate the length (in bytes) required to store the complete - CPU map between a single virtual and all physical CPUs of a domain. - *) - - val use_cpu : string -> int -> unit - (** [use_cpu cpumap cpu] marks [cpu] as usable in [cpumap]. *) - val unuse_cpu : string -> int -> unit - (** [unuse_cpu cpumap cpu] marks [cpu] as not usable in [cpumap]. *) - val cpu_usable : string -> int -> int -> int -> bool - (** [cpu_usable cpumaps maplen vcpu cpu] checks returns true iff the - [cpu] is usable by [vcpu]. *) - - external const : [>`R] t -> ro t = "%identity" - (** [const conn] turns a read/write connection into a read-only - connection. Note that the opposite operation is impossible. - *) -end - (** Module dealing with connections. [Connect.t] is the - connection object. *) - -(** {3 Domains} *) - -module Domain : -sig - type 'rw t - (** Domain handle. Read-only handles have type [ro Domain.t] and - read-write handles have type [rw Domain.t]. - *) - - type state = - | InfoNoState | InfoRunning | InfoBlocked | InfoPaused - | InfoShutdown | InfoShutoff | InfoCrashed - - type info = { - state : state; (** running state *) - max_mem : int64; (** maximum memory in kilobytes *) - memory : int64; (** memory used in kilobytes *) - nr_virt_cpu : int; (** number of virtual CPUs *) - cpu_time : int64; (** CPU time used in nanoseconds *) - } - - type vcpu_state = VcpuOffline | VcpuRunning | VcpuBlocked - - type vcpu_info = { - number : int; (** virtual CPU number *) - vcpu_state : vcpu_state; (** state *) - vcpu_time : int64; (** CPU time used in nanoseconds *) - cpu : int; (** real CPU number, -1 if offline *) - } - - type sched_param = string * sched_param_value - and sched_param_value = - | SchedFieldInt32 of int32 | SchedFieldUInt32 of int32 - | SchedFieldInt64 of int64 | SchedFieldUInt64 of int64 - | SchedFieldFloat of float | SchedFieldBool of bool - - type migrate_flag = Live - - type block_stats = { - rd_req : int64; - rd_bytes : int64; - wr_req : int64; - wr_bytes : int64; - errs : int64; - } - - type interface_stats = { - rx_bytes : int64; - rx_packets : int64; - rx_errs : int64; - rx_drop : int64; - tx_bytes : int64; - tx_packets : int64; - tx_errs : int64; - tx_drop : int64; - } - - val create_linux : [>`W] Connect.t -> xml -> rw t - (** Create a new guest domain (not necessarily a Linux one) - from the given XML. - *) - val create_linux_job : [>`W] Connect.t -> xml -> ([`Domain], rw) job_t - (** Asynchronous domain creation. *) - val lookup_by_id : 'a Connect.t -> int -> 'a t - (** Lookup a domain by ID. *) - val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t - (** Lookup a domain by UUID. This uses the packed byte array UUID. *) - val lookup_by_uuid_string : 'a Connect.t -> string -> 'a t - (** Lookup a domain by (string) UUID. *) - val lookup_by_name : 'a Connect.t -> string -> 'a t - (** Lookup a domain by name. *) - val destroy : [>`W] t -> unit - (** Abruptly destroy a domain. *) - val free : [>`R] t -> unit - (** [free domain] frees the domain object in memory. - - The domain object is automatically freed if it is garbage - collected. This function just forces it to be freed right - away. - *) - - val suspend : [>`W] t -> unit - (** Suspend a domain. *) - val resume : [>`W] t -> unit - (** Resume a domain. *) - val save : [>`W] t -> filename -> unit - (** Suspend a domain, then save it to the file. *) - val save_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t - (** Asynchronous domain suspend. *) - val restore : [>`W] Connect.t -> filename -> unit - (** Restore a domain from a file. *) - val restore_job : [>`W] Connect.t -> filename -> ([`Domain_nocreate], rw) job_t - (** Asynchronous domain restore. *) - val core_dump : [>`W] t -> filename -> unit - (** Force a domain to core dump to the named file. *) - val core_dump_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t - (** Asynchronous core dump. *) - val shutdown : [>`W] t -> unit - (** Shutdown a domain. *) - val reboot : [>`W] t -> unit - (** Reboot a domain. *) - val get_name : [>`R] t -> string - (** Get the domain name. *) - val get_uuid : [>`R] t -> uuid - (** Get the domain UUID (as a packed byte array). *) - val get_uuid_string : [>`R] t -> string - (** Get the domain UUID (as a printable string). *) - val get_id : [>`R] t -> int - (** [getid dom] returns the ID of the domain. - - Do not call this on a defined but not running domain. Those - domains don't have IDs, and you'll get an error here. - *) - - val get_os_type : [>`R] t -> string - (** Get the operating system type. *) - val get_max_memory : [>`R] t -> int64 - (** Get the maximum memory allocation. *) - val set_max_memory : [>`W] t -> int64 -> unit - (** Set the maximum memory allocation. *) - val set_memory : [>`W] t -> int64 -> unit - (** Set the normal memory allocation. *) - val get_info : [>`R] t -> info - (** Get information about a domain. *) - val get_xml_desc : [>`R] t -> xml - (** Get the XML description of a domain. *) - val get_scheduler_type : [>`R] t -> string * int - (** Get the scheduler type. *) - val get_scheduler_parameters : [>`R] t -> int -> sched_param array - (** Get the array of scheduler parameters. *) - val set_scheduler_parameters : [>`W] t -> sched_param array -> unit - (** Set the array of scheduler parameters. *) - val define_xml : [>`W] Connect.t -> xml -> rw t - (** Define a new domain (but don't start it up) from the XML. *) - val undefine : [>`W] t -> unit - (** Undefine a domain - removes its configuration. *) - val create : [>`W] t -> unit - (** Launch a defined (inactive) domain. *) - val create_job : [>`W] t -> ([`Domain_nocreate], rw) job_t - (** Asynchronous launch domain. *) - val get_autostart : [>`R] t -> bool - (** Get the autostart flag for a domain. *) - val set_autostart : [>`W] t -> bool -> unit - (** Set the autostart flag for a domain. *) - val set_vcpus : [>`W] t -> int -> unit - (** Change the number of vCPUs available to a domain. *) - val pin_vcpu : [>`W] t -> int -> string -> unit - (** [pin_vcpu dom vcpu bitmap] pins a domain vCPU to a bitmap of physical - CPUs. See the libvirt documentation for details of the - layout of the bitmap. *) - val get_vcpus : [>`R] t -> int -> int -> int * vcpu_info array * string - (** [get_vcpus dom maxinfo maplen] returns the pinning information - for a domain. See the libvirt documentation for details - of the array and bitmap returned from this function. - *) - val get_max_vcpus : [>`R] t -> int - (** Returns the maximum number of vCPUs supported for this domain. *) - val attach_device : [>`W] t -> xml -> unit - (** Attach a device (described by the device XML) to a domain. *) - val detach_device : [>`W] t -> xml -> unit - (** Detach a device (described by the device XML) from a domain. *) - - val migrate : [>`W] t -> [>`W] Connect.t -> migrate_flag list -> - ?dname:string -> ?uri:string -> ?bandwidth:int -> unit -> rw t - (** [migrate dom dconn flags ()] migrates a domain to a - destination host described by [dconn]. - - The optional flag [?dname] is used to rename the domain. - - The optional flag [?uri] is used to route the migration. - - The optional flag [?bandwidth] is used to limit the bandwidth - used for migration (in Mbps). *) - - val block_stats : [>`R] t -> string -> block_stats - (** Returns block device stats. *) - val interface_stats : [>`R] t -> string -> interface_stats - (** Returns network interface stats. *) - - external const : [>`R] t -> ro t = "%identity" - (** [const dom] turns a read/write domain handle into a read-only - domain handle. Note that the opposite operation is impossible. - *) -end - (** Module dealing with domains. [Domain.t] is the - domain object. *) - -(** {3 Networks} *) - -module Network : -sig - type 'rw t - (** Network handle. Read-only handles have type [ro Network.t] and - read-write handles have type [rw Network.t]. - *) - - val lookup_by_name : 'a Connect.t -> string -> 'a t - (** Lookup a network by name. *) - val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t - (** Lookup a network by (packed) UUID. *) - val lookup_by_uuid_string : 'a Connect.t -> string -> 'a t - (** Lookup a network by UUID string. *) - val create_xml : [>`W] Connect.t -> xml -> rw t - (** Create a network. *) - val create_xml_job : [>`W] Connect.t -> xml -> ([`Network], rw) job_t - (** Asynchronous create network. *) - val define_xml : [>`W] Connect.t -> xml -> rw t - (** Define but don't activate a network. *) - val undefine : [>`W] t -> unit - (** Undefine configuration of a network. *) - val create : [>`W] t -> unit - (** Start up a defined (inactive) network. *) - val create_job : [>`W] t -> ([`Network_nocreate], rw) job_t - (** Asynchronous start network. *) - val destroy : [>`W] t -> unit - (** Destroy a network. *) - val free : [>`R] t -> unit - (** [free network] frees the network object in memory. - - The network object is automatically freed if it is garbage - collected. This function just forces it to be freed right - away. - *) - - val get_name : [>`R] t -> string - (** Get network name. *) - val get_uuid : [>`R] t -> uuid - (** Get network packed UUID. *) - val get_uuid_string : [>`R] t -> string - (** Get network UUID as a printable string. *) - val get_xml_desc : [>`R] t -> xml - (** Get XML description of a network. *) - val get_bridge_name : [>`R] t -> string - (** Get bridge device name of a network. *) - val get_autostart : [>`R] t -> bool - (** Get the autostart flag for a network. *) - val set_autostart : [>`W] t -> bool -> unit - (** Set the autostart flag for a network. *) - - external const : [>`R] t -> ro t = "%identity" - (** [const network] turns a read/write network handle into a read-only - network handle. Note that the opposite operation is impossible. - *) -end - (** Module dealing with networks. [Network.t] is the - network object. *) - -(** {3 Storage pools} *) - -module Pool : -sig - type 'rw t - (** Storage pool handle. *) - - type pool_state = Inactive | Building | Running | Degraded - (** State of the storage pool. *) - - type pool_build_flags = New | Repair | Resize - (** Flags for creating a storage pool. *) - - type pool_delete_flags = Normal | Zeroed - (** Flags for deleting a storage pool. *) - - type pool_info = { - state : pool_state; (** Pool state. *) - capacity : int64; (** Logical size in bytes. *) - allocation : int64; (** Currently allocated in bytes. *) - available : int64; (** Remaining free space bytes. *) - } - - val lookup_by_name : 'a Connect.t -> string -> 'a t - val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t - val lookup_by_uuid_string : 'a Connect.t -> string -> 'a t - (** Look up a storage pool by name, UUID or UUID string. *) - - val create_xml : [>`W] Connect.t -> xml -> rw t - (** Create a storage pool. *) - val define_xml : [>`W] Connect.t -> xml -> rw t - (** Define but don't activate a storage pool. *) - val build : [>`W] t -> pool_build_flags -> unit - (** Build a storage pool. *) - val undefine : [>`W] t -> unit - (** Undefine configuration of a storage pool. *) - val create : [>`W] t -> unit - (** Start up a defined (inactive) storage pool. *) - val destroy : [>`W] t -> unit - (** Destroy a storage pool. *) - val delete : [>`W] t -> unit - (** Delete a storage pool. *) - val free : [>`R] t -> unit - (** Free a storage pool object in memory. - - The storage pool object is automatically freed if it is garbage - collected. This function just forces it to be freed right - away. - *) - val refresh : [`R] t -> unit - (** Refresh the list of volumes in the storage pool. *) - - val get_name : [`R] t -> string - (** Name of the pool. *) - val get_uuid : [`R] t -> uuid - (** Get the UUID (as a packed byte array). *) - val get_uuid_string : [`R] t -> string - (** Get the UUID (as a printable string). *) - val get_info : [`R] t -> pool_info - (** Get information about the pool. *) - val get_xml_desc : [`R] t -> xml - (** Get the XML description. *) - val get_autostart : [`R] t -> bool - (** Get the autostart flag for the storage pool. *) - val set_autostart : [`W] t -> bool -> unit - (** Set the autostart flag for the storage pool. *) - - val num_of_volumes : [`R] t -> int - (** Returns the number of storage volumes within the storage pool. *) - val list_volumes : [`R] t -> int -> string array - (** Return list of storage volumes. *) - - external const : [>`R] t -> ro t = "%identity" - (** [const conn] turns a read/write storage pool into a read-only - pool. Note that the opposite operation is impossible. - *) -end - (** Module dealing with storage pools. *) - -(** {3 Storage volumes} *) - -module Volume : -sig - type 'rw t - (** Storage volume handle. *) - - type vol_type = File | Block - (** Type of a storage volume. *) - - type vol_delete_flags = Normal | Zeroed - (** Flags for deleting a storage volume. *) - - type vol_info = { - typ : vol_type; (** Type of storage volume. *) - capacity : int64; (** Logical size in bytes. *) - allocation : int64; (** Currently allocated in bytes. *) - } - - val lookup_by_name : 'a Pool.t -> string -> 'a t - val lookup_by_key : 'a Connect.t -> string -> 'a t - val lookup_by_path : 'a Connect.t -> string -> 'a t - (** Look up a storage volume by name, key or path volume. *) - - val pool_of_volume : 'a t -> 'a Pool.t - (** Get the storage pool containing this volume. *) - - val get_name : [`R] t -> string - (** Name of the volume. *) - val get_key : [`R] t -> string - (** Key of the volume. *) - val get_path : [`R] t -> string - (** Path of the volume. *) - val get_info : [`R] t -> vol_info - (** Get information about the storage volume. *) - val get_xml_desc : [`R] t -> xml - (** Get the XML description. *) - - val create_xml : [`W] Pool.t -> xml -> unit - (** Create a storage volume. *) - val delete : [`W] t -> unit - (** Delete a storage volume. *) - val free : [>`R] t -> unit - (** Free a storage volume object in memory. - - The storage volume object is automatically freed if it is garbage - collected. This function just forces it to be freed right - away. - *) - - external const : [>`R] t -> ro t = "%identity" - (** [const conn] turns a read/write storage volume into a read-only - volume. Note that the opposite operation is impossible. - *) -end - (** Module dealing with storage volumes. *) - -(** {3 Jobs and asynchronous processing} *) - -module Job : -sig - type ('jobclass, 'rw) t = ('jobclass, 'rw) job_t - (** A background asynchronous job. - - Jobs represent a pending operation such as domain creation. - The possible types for a job are: - -{v -(`Domain, `W) Job.t Job creating a new domain -(`Domain_nocreate, `W) Job.t Job acting on an existing domain -(`Network, `W) Job.t Job creating a new network -(`Network_nocreate, `W) Job.t Job acting on an existing network -v} - *) - - type job_type = Bounded | Unbounded - (** A Bounded job is one where we can estimate time to completion. *) - - type job_state = Running | Complete | Failed | Cancelled - (** State of the job. *) - - type job_info = { - typ : job_type; (** Job type (Bounded, Unbounded) *) - state : job_state; (** Job state (Running, etc.) *) - running_time : int; (** Actual running time (seconds) *) - (** The following fields are only available in Bounded jobs: *) - remaining_time : int; (** Estimated time left (seconds) *) - percent_complete : int (** Estimated percent complete *) - } - - val get_info : ('a,'b) t -> job_info - (** Get information and status about the job. *) - - val get_domain : ([`Domain], 'a) t -> 'a Domain.t - (** Get the completed domain from a job. - - You should only call it on a job in state Complete. *) - - val get_network : ([`Network], 'a) t -> 'a Network.t - (** Get the completed network from a job. - - You should only call it on a job in state Complete. *) - - val cancel : ('a,'b) t -> unit - (** Cancel a job. *) - - val free : ('a, [>`R]) t -> unit - (** Free a job object in memory. - - The job object is automatically freed if it is garbage - collected. This function just forces it to be freed right - away. - *) - - external const : ('a, [>`R]) t -> ('a, ro) t = "%identity" - (** [const conn] turns a read/write job into a read-only - job. Note that the opposite operation is impossible. - *) -end - (** Module dealing with asynchronous jobs. *) - -(** {3 Error handling and exceptions} *) - -module Virterror : -sig - type code = - | VIR_ERR_OK - | VIR_ERR_INTERNAL_ERROR - | VIR_ERR_NO_MEMORY - | VIR_ERR_NO_SUPPORT - | VIR_ERR_UNKNOWN_HOST - | VIR_ERR_NO_CONNECT - | VIR_ERR_INVALID_CONN - | VIR_ERR_INVALID_DOMAIN - | VIR_ERR_INVALID_ARG - | VIR_ERR_OPERATION_FAILED - | VIR_ERR_GET_FAILED - | VIR_ERR_POST_FAILED - | VIR_ERR_HTTP_ERROR - | VIR_ERR_SEXPR_SERIAL - | VIR_ERR_NO_XEN - | VIR_ERR_XEN_CALL - | VIR_ERR_OS_TYPE - | VIR_ERR_NO_KERNEL - | VIR_ERR_NO_ROOT - | VIR_ERR_NO_SOURCE - | VIR_ERR_NO_TARGET - | VIR_ERR_NO_NAME - | VIR_ERR_NO_OS - | VIR_ERR_NO_DEVICE - | VIR_ERR_NO_XENSTORE - | VIR_ERR_DRIVER_FULL - | VIR_ERR_CALL_FAILED - | VIR_ERR_XML_ERROR - | VIR_ERR_DOM_EXIST - | VIR_ERR_OPERATION_DENIED - | VIR_ERR_OPEN_FAILED - | VIR_ERR_READ_FAILED - | VIR_ERR_PARSE_FAILED - | VIR_ERR_CONF_SYNTAX - | VIR_ERR_WRITE_FAILED - | VIR_ERR_XML_DETAIL - | VIR_ERR_INVALID_NETWORK - | VIR_ERR_NETWORK_EXIST - | VIR_ERR_SYSTEM_ERROR - | VIR_ERR_RPC - | VIR_ERR_GNUTLS_ERROR - | VIR_WAR_NO_NETWORK - | VIR_ERR_NO_DOMAIN - | VIR_ERR_NO_NETWORK - | VIR_ERR_INVALID_MAC - | VIR_ERR_AUTH_FAILED - | VIR_ERR_INVALID_STORAGE_POOL - | VIR_ERR_INVALID_STORAGE_VOL - | VIR_WAR_NO_STORAGE - | VIR_ERR_NO_STORAGE_POOL - | VIR_ERR_NO_STORAGE_VOL - (* ^^ NB: If you add a variant you MUST edit - libvirt_c_epilogue.c:MAX_VIR_* *) - | VIR_ERR_UNKNOWN of int - (** See [] for meaning of these codes. *) - - val string_of_code : code -> string - - type domain = - | VIR_FROM_NONE - | VIR_FROM_XEN - | VIR_FROM_XEND - | VIR_FROM_XENSTORE - | VIR_FROM_SEXPR - | VIR_FROM_XML - | VIR_FROM_DOM - | VIR_FROM_RPC - | VIR_FROM_PROXY - | VIR_FROM_CONF - | VIR_FROM_QEMU - | VIR_FROM_NET - | VIR_FROM_TEST - | VIR_FROM_REMOTE - | VIR_FROM_OPENVZ - | VIR_FROM_XENXM - | VIR_FROM_STATS_LINUX - | VIR_FROM_STORAGE - (* ^^ NB: If you add a variant you MUST edit - libvirt_c_epilogue.c: MAX_VIR_* *) - | VIR_FROM_UNKNOWN of int - (** Subsystem / driver which produced the error. *) - - val string_of_domain : domain -> string - - type level = - | VIR_ERR_NONE - | VIR_ERR_WARNING - | VIR_ERR_ERROR - (* ^^ NB: If you add a variant you MUST edit libvirt_c.c: MAX_VIR_* *) - | VIR_ERR_UNKNOWN_LEVEL of int - (** No error, a warning or an error. *) - - val string_of_level : level -> string - - type t = { - code : code; (** Error code. *) - domain : domain; (** Origin of the error. *) - message : string option; (** Human-readable message. *) - level : level; (** Error or warning. *) - conn : ro Connect.t option; (** Associated connection. *) - dom : ro Domain.t option; (** Associated domain. *) - str1 : string option; (** Informational string. *) - str2 : string option; (** Informational string. *) - str3 : string option; (** Informational string. *) - int1 : int32; (** Informational integer. *) - int2 : int32; (** Informational integer. *) - net : ro Network.t option; (** Associated network. *) - } - (** An error object. *) - - val to_string : t -> string - (** Turn the exception into a printable string. *) - - val get_last_error : unit -> t option - val get_last_conn_error : [>`R] Connect.t -> t option - (** Get the last error at a global or connection level. - - Normally you do not need to use these functions because - the library automatically turns errors into exceptions. - *) - - val reset_last_error : unit -> unit - val reset_last_conn_error : [>`R] Connect.t -> unit - (** Reset the error at a global or connection level. - - Normally you do not need to use these functions. - *) - - val no_error : unit -> t - (** Creates an empty error message. - - Normally you do not need to use this function. - *) -end - (** Module dealing with errors. *) - -exception Virterror of Virterror.t -(** This exception can be raised by any library function that detects - an error. To get a printable error message, call - {!Virterror.to_string} on the content of this exception. -*) - -exception Not_supported of string -(** - Functions may raise - [Not_supported "virFoo"] - (where [virFoo] is the libvirt function name) if a function is - not supported at either compile or run time. This applies to - any libvirt function added after version 0.2.1. - - See also {{:http://libvirt.org/hvsupport.html}http://libvirt.org/hvsupport.html} -*) - diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c deleted file mode 100644 index 882f016..0000000 --- a/libvirt/libvirt_c.c +++ /dev/null @@ -1,3065 +0,0 @@ -/* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!! - * - * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'. - * - * Any changes you make to this file may be overwritten. - */ - -/* OCaml bindings for libvirt. - * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - * http://libvirt.org/ - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2 of the License, or (at your option) any later version. - * - * This library 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 - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - -#include "config.h" - -#include -#include -#include - -#include -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "libvirt_c_prologue.c" - -#include "libvirt_c_oneoffs.c" - -/* Automatically generated binding for virConnectClose. - * In generator.pl this function has signature "conn : free". - */ - -CAMLprim value -ocaml_libvirt_connect_close (value connv) -{ - CAMLparam1 (connv); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectClose (conn)); - CHECK_ERROR (r == -1, conn, "virConnectClose"); - - /* So that we don't double-free in the finalizer: */ - Connect_val (connv) = NULL; - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virConnectGetHostname. - * In generator.pl this function has signature "conn : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTGETHOSTNAME -extern char *virConnectGetHostname (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_get_hostname (value connv) -{ - CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTGETHOSTNAME - /* Symbol virConnectGetHostname not found at compile time. */ - not_supported ("virConnectGetHostname"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virConnectGetHostname - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectGetHostname); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *r; - - NONBLOCKING (r = virConnectGetHostname (conn)); - CHECK_ERROR (!r, conn, "virConnectGetHostname"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virConnectGetURI. - * In generator.pl this function has signature "conn : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTGETURI -extern char *virConnectGetURI (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_get_uri (value connv) -{ - CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTGETURI - /* Symbol virConnectGetURI not found at compile time. */ - not_supported ("virConnectGetURI"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virConnectGetURI - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectGetURI); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *r; - - NONBLOCKING (r = virConnectGetURI (conn)); - CHECK_ERROR (!r, conn, "virConnectGetURI"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virConnectGetType. - * In generator.pl this function has signature "conn : static string". - */ - -CAMLprim value -ocaml_libvirt_connect_get_type (value connv) -{ - CAMLparam1 (connv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - const char *r; - - NONBLOCKING (r = virConnectGetType (conn)); - CHECK_ERROR (!r, conn, "virConnectGetType"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virConnectNumOfDomains. - * In generator.pl this function has signature "conn : int". - */ - -CAMLprim value -ocaml_libvirt_connect_num_of_domains (value connv) -{ - CAMLparam1 (connv); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfDomains (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains"); - - CAMLreturn (Val_int (r)); -} - -/* Automatically generated binding for virConnectListDomains. - * In generator.pl this function has signature "conn, int : int array". - */ - -CAMLprim value -ocaml_libvirt_connect_list_domains (value connv, value iv) -{ - CAMLparam2 (connv, iv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - int ids[i], r; - - NONBLOCKING (r = virConnectListDomains (conn, ids, i)); - CHECK_ERROR (r == -1, conn, "virConnectListDomains"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) - Store_field (rv, i, Val_int (ids[i])); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virConnectNumOfDefinedDomains. - * In generator.pl this function has signature "conn : int". - */ - -CAMLprim value -ocaml_libvirt_connect_num_of_defined_domains (value connv) -{ - CAMLparam1 (connv); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfDefinedDomains (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains"); - - CAMLreturn (Val_int (r)); -} - -/* Automatically generated binding for virConnectListDefinedDomains. - * In generator.pl this function has signature "conn, int : string array". - */ - -CAMLprim value -ocaml_libvirt_connect_list_defined_domains (value connv, value iv) -{ - CAMLparam2 (connv, iv); - - CAMLlocal2 (rv, strv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virConnectListDefinedDomains (conn, names, i)); - CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) { - strv = caml_copy_string (names[i]); - Store_field (rv, i, strv); - free (names[i]); - } - - CAMLreturn (rv); -} - -/* Automatically generated binding for virConnectNumOfNetworks. - * In generator.pl this function has signature "conn : int". - */ - -CAMLprim value -ocaml_libvirt_connect_num_of_networks (value connv) -{ - CAMLparam1 (connv); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfNetworks (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks"); - - CAMLreturn (Val_int (r)); -} - -/* Automatically generated binding for virConnectListNetworks. - * In generator.pl this function has signature "conn, int : string array". - */ - -CAMLprim value -ocaml_libvirt_connect_list_networks (value connv, value iv) -{ - CAMLparam2 (connv, iv); - - CAMLlocal2 (rv, strv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virConnectListNetworks (conn, names, i)); - CHECK_ERROR (r == -1, conn, "virConnectListNetworks"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) { - strv = caml_copy_string (names[i]); - Store_field (rv, i, strv); - free (names[i]); - } - - CAMLreturn (rv); -} - -/* Automatically generated binding for virConnectNumOfDefinedNetworks. - * In generator.pl this function has signature "conn : int". - */ - -CAMLprim value -ocaml_libvirt_connect_num_of_defined_networks (value connv) -{ - CAMLparam1 (connv); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfDefinedNetworks (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks"); - - CAMLreturn (Val_int (r)); -} - -/* Automatically generated binding for virConnectListDefinedNetworks. - * In generator.pl this function has signature "conn, int : string array". - */ - -CAMLprim value -ocaml_libvirt_connect_list_defined_networks (value connv, value iv) -{ - CAMLparam2 (connv, iv); - - CAMLlocal2 (rv, strv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virConnectListDefinedNetworks (conn, names, i)); - CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) { - strv = caml_copy_string (names[i]); - Store_field (rv, i, strv); - free (names[i]); - } - - CAMLreturn (rv); -} - -/* Automatically generated binding for virConnectNumOfStoragePools. - * In generator.pl this function has signature "conn : int". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS -extern int virConnectNumOfStoragePools (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_num_of_storage_pools (value connv) -{ - CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS - /* Symbol virConnectNumOfStoragePools not found at compile time. */ - not_supported ("virConnectNumOfStoragePools"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virConnectNumOfStoragePools - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectNumOfStoragePools); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfStoragePools (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfStoragePools"); - - CAMLreturn (Val_int (r)); -#endif -} - -/* Automatically generated binding for virConnectListStoragePools. - * In generator.pl this function has signature "conn, int : string array". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTLISTSTORAGEPOOLS -extern int virConnectListStoragePools (virConnectPtr conn, char **const names, int maxnames) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_list_storage_pools (value connv, value iv) -{ - CAMLparam2 (connv, iv); -#ifndef HAVE_VIRCONNECTLISTSTORAGEPOOLS - /* Symbol virConnectListStoragePools not found at compile time. */ - not_supported ("virConnectListStoragePools"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virConnectListStoragePools - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectListStoragePools); - - CAMLlocal2 (rv, strv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virConnectListStoragePools (conn, names, i)); - CHECK_ERROR (r == -1, conn, "virConnectListStoragePools"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) { - strv = caml_copy_string (names[i]); - Store_field (rv, i, strv); - free (names[i]); - } - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virConnectNumOfDefinedStoragePools. - * In generator.pl this function has signature "conn : int". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS -extern int virConnectNumOfDefinedStoragePools (virConnectPtr conn) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_num_of_defined_storage_pools (value connv) -{ - CAMLparam1 (connv); -#ifndef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS - /* Symbol virConnectNumOfDefinedStoragePools not found at compile time. */ - not_supported ("virConnectNumOfDefinedStoragePools"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virConnectNumOfDefinedStoragePools - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectNumOfDefinedStoragePools); - - virConnectPtr conn = Connect_val (connv); - int r; - - NONBLOCKING (r = virConnectNumOfDefinedStoragePools (conn)); - CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedStoragePools"); - - CAMLreturn (Val_int (r)); -#endif -} - -/* Automatically generated binding for virConnectListDefinedStoragePools. - * In generator.pl this function has signature "conn, int : string array". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS -extern int virConnectListDefinedStoragePools (virConnectPtr conn, char **const names, int maxnames) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_list_defined_storage_pools (value connv, value iv) -{ - CAMLparam2 (connv, iv); -#ifndef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS - /* Symbol virConnectListDefinedStoragePools not found at compile time. */ - not_supported ("virConnectListDefinedStoragePools"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virConnectListDefinedStoragePools - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virConnectListDefinedStoragePools); - - CAMLlocal2 (rv, strv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virConnectListDefinedStoragePools (conn, names, i)); - CHECK_ERROR (r == -1, conn, "virConnectListDefinedStoragePools"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) { - strv = caml_copy_string (names[i]); - Store_field (rv, i, strv); - free (names[i]); - } - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virConnectGetCapabilities. - * In generator.pl this function has signature "conn : string". - */ - -CAMLprim value -ocaml_libvirt_connect_get_capabilities (value connv) -{ - CAMLparam1 (connv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *r; - - NONBLOCKING (r = virConnectGetCapabilities (conn)); - CHECK_ERROR (!r, conn, "virConnectGetCapabilities"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainCreateLinux. - * In generator.pl this function has signature "conn, string, 0U : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_create_linux (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virDomainPtr r; - - NONBLOCKING (r = virDomainCreateLinux (conn, str, 0)); - CHECK_ERROR (!r, conn, "virDomainCreateLinux"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainCreateLinuxJob. - * In generator.pl this function has signature "conn, string, 0U : job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINCREATELINUXJOB -extern virJobPtr virDomainCreateLinuxJob (virConnectPtr conn, const char *str, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_create_linux_job (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRDOMAINCREATELINUXJOB - /* Symbol virDomainCreateLinuxJob not found at compile time. */ - not_supported ("virDomainCreateLinuxJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainCreateLinuxJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainCreateLinuxJob); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virDomainCreateLinuxJob (conn, str, 0)); - CHECK_ERROR (!r, conn, "virDomainCreateLinuxJob"); - - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainFree. - * In generator.pl this function has signature "dom : free". - */ - -CAMLprim value -ocaml_libvirt_domain_free (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainFree (dom)); - CHECK_ERROR (r == -1, conn, "virDomainFree"); - - /* So that we don't double-free in the finalizer: */ - Domain_val (domv) = NULL; - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainDestroy. - * In generator.pl this function has signature "dom : free". - */ - -CAMLprim value -ocaml_libvirt_domain_destroy (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainDestroy (dom)); - CHECK_ERROR (r == -1, conn, "virDomainDestroy"); - - /* So that we don't double-free in the finalizer: */ - Domain_val (domv) = NULL; - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainLookupByName. - * In generator.pl this function has signature "conn, string : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_lookup_by_name (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByName (conn, str)); - CHECK_ERROR (!r, conn, "virDomainLookupByName"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainLookupByID. - * In generator.pl this function has signature "conn, int : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_lookup_by_id (value connv, value iv) -{ - CAMLparam2 (connv, iv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - int i = Int_val (iv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByID (conn, i)); - CHECK_ERROR (!r, conn, "virDomainLookupByID"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainLookupByUUID. - * In generator.pl this function has signature "conn, uuid : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - unsigned char *uuid = (unsigned char *) String_val (uuidv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByUUID (conn, uuid)); - CHECK_ERROR (!r, conn, "virDomainLookupByUUID"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainLookupByUUIDString. - * In generator.pl this function has signature "conn, string : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virDomainPtr r; - - NONBLOCKING (r = virDomainLookupByUUIDString (conn, str)); - CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetName. - * In generator.pl this function has signature "dom : static string". - */ - -CAMLprim value -ocaml_libvirt_domain_get_name (value domv) -{ - CAMLparam1 (domv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - const char *r; - - NONBLOCKING (r = virDomainGetName (dom)); - CHECK_ERROR (!r, conn, "virDomainGetName"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetOSType. - * In generator.pl this function has signature "dom : string". - */ - -CAMLprim value -ocaml_libvirt_domain_get_os_type (value domv) -{ - CAMLparam1 (domv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *r; - - NONBLOCKING (r = virDomainGetOSType (dom)); - CHECK_ERROR (!r, conn, "virDomainGetOSType"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetXMLDesc. - * In generator.pl this function has signature "dom, 0 : string". - */ - -CAMLprim value -ocaml_libvirt_domain_get_xml_desc (value domv) -{ - CAMLparam1 (domv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *r; - - NONBLOCKING (r = virDomainGetXMLDesc (dom, 0)); - CHECK_ERROR (!r, conn, "virDomainGetXMLDesc"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetUUID. - * In generator.pl this function has signature "dom : uuid". - */ - -CAMLprim value -ocaml_libvirt_domain_get_uuid (value domv) -{ - CAMLparam1 (domv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - unsigned char uuid[VIR_UUID_BUFLEN]; - int r; - - NONBLOCKING (r = virDomainGetUUID (dom, uuid)); - CHECK_ERROR (r == -1, conn, "virDomainGetUUID"); - - /* UUIDs are byte arrays with a fixed length. */ - rv = caml_alloc_string (VIR_UUID_BUFLEN); - memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetUUIDString. - * In generator.pl this function has signature "dom : uuid string". - */ - -CAMLprim value -ocaml_libvirt_domain_get_uuid_string (value domv) -{ - CAMLparam1 (domv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char uuid[VIR_UUID_STRING_BUFLEN]; - int r; - - NONBLOCKING (r = virDomainGetUUIDString (dom, uuid)); - CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString"); - - rv = caml_copy_string (uuid); - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainGetMaxVcpus. - * In generator.pl this function has signature "dom : int". - */ - -CAMLprim value -ocaml_libvirt_domain_get_max_vcpus (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainGetMaxVcpus (dom)); - CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus"); - - CAMLreturn (Val_int (r)); -} - -/* Automatically generated binding for virDomainSave. - * In generator.pl this function has signature "dom, string : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_save (value domv, value strv) -{ - CAMLparam2 (domv, strv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainSave (dom, str)); - CHECK_ERROR (r == -1, conn, "virDomainSave"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainSaveJob. - * In generator.pl this function has signature "dom, string : job from dom". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINSAVEJOB -extern virJobPtr virDomainSaveJob (virDomainPtr dom, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_save_job (value domv, value strv) -{ - CAMLparam2 (domv, strv); -#ifndef HAVE_VIRDOMAINSAVEJOB - /* Symbol virDomainSaveJob not found at compile time. */ - not_supported ("virDomainSaveJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainSaveJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainSaveJob); - - CAMLlocal2 (rv, connv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virDomainSaveJob (dom, str)); - CHECK_ERROR (!r, conn, "virDomainSaveJob"); - - connv = Field (domv, 1); - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainRestore. - * In generator.pl this function has signature "conn, string : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_restore (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainRestore (conn, str)); - CHECK_ERROR (r == -1, conn, "virDomainRestore"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainRestoreJob. - * In generator.pl this function has signature "conn, string : job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINRESTOREJOB -extern virJobPtr virDomainRestoreJob (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_restore_job (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRDOMAINRESTOREJOB - /* Symbol virDomainRestoreJob not found at compile time. */ - not_supported ("virDomainRestoreJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainRestoreJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainRestoreJob); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virDomainRestoreJob (conn, str)); - CHECK_ERROR (!r, conn, "virDomainRestoreJob"); - - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainCoreDump. - * In generator.pl this function has signature "dom, string, 0 : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_core_dump (value domv, value strv) -{ - CAMLparam2 (domv, strv); - - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainCoreDump (dom, str, 0)); - CHECK_ERROR (!r, conn, "virDomainCoreDump"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainCoreDumpJob. - * In generator.pl this function has signature "dom, string, 0 : job from dom". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINCOREDUMPJOB -extern virJobPtr virDomainCoreDumpJob (virDomainPtr dom, const char *str, int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_core_dump_job (value domv, value strv) -{ - CAMLparam2 (domv, strv); -#ifndef HAVE_VIRDOMAINCOREDUMPJOB - /* Symbol virDomainCoreDumpJob not found at compile time. */ - not_supported ("virDomainCoreDumpJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainCoreDumpJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainCoreDumpJob); - - CAMLlocal2 (rv, connv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virDomainCoreDumpJob (dom, str, 0)); - CHECK_ERROR (!r, conn, "virDomainCoreDumpJob"); - - connv = Field (domv, 1); - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainSuspend. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_suspend (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainSuspend (dom)); - CHECK_ERROR (r == -1, conn, "virDomainSuspend"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainResume. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_resume (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainResume (dom)); - CHECK_ERROR (r == -1, conn, "virDomainResume"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainShutdown. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_shutdown (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainShutdown (dom)); - CHECK_ERROR (r == -1, conn, "virDomainShutdown"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainReboot. - * In generator.pl this function has signature "dom, 0 : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_reboot (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainReboot (dom, 0)); - CHECK_ERROR (r == -1, conn, "virDomainReboot"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainDefineXML. - * In generator.pl this function has signature "conn, string : dom". - */ - -CAMLprim value -ocaml_libvirt_domain_define_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virDomainPtr r; - - NONBLOCKING (r = virDomainDefineXML (conn, str)); - CHECK_ERROR (!r, conn, "virDomainDefineXML"); - - rv = Val_domain (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virDomainUndefine. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_undefine (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainUndefine (dom)); - CHECK_ERROR (r == -1, conn, "virDomainUndefine"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainCreate. - * In generator.pl this function has signature "dom : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_create (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r; - - NONBLOCKING (r = virDomainCreate (dom)); - CHECK_ERROR (r == -1, conn, "virDomainCreate"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainCreateJob. - * In generator.pl this function has signature "dom, 0U : job from dom". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINCREATEJOB -extern virJobPtr virDomainCreateJob (virDomainPtr dom, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_create_job (value domv) -{ - CAMLparam1 (domv); -#ifndef HAVE_VIRDOMAINCREATEJOB - /* Symbol virDomainCreateJob not found at compile time. */ - not_supported ("virDomainCreateJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virDomainCreateJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virDomainCreateJob); - - CAMLlocal2 (rv, connv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - virJobPtr r; - - NONBLOCKING (r = virDomainCreateJob (dom, 0)); - CHECK_ERROR (!r, conn, "virDomainCreateJob"); - - connv = Field (domv, 1); - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virDomainAttachDevice. - * In generator.pl this function has signature "dom, string : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_attach_device (value domv, value strv) -{ - CAMLparam2 (domv, strv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainAttachDevice (dom, str)); - CHECK_ERROR (r == -1, conn, "virDomainAttachDevice"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainDetachDevice. - * In generator.pl this function has signature "dom, string : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_detach_device (value domv, value strv) -{ - CAMLparam2 (domv, strv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *str = String_val (strv); - int r; - - NONBLOCKING (r = virDomainDetachDevice (dom, str)); - CHECK_ERROR (r == -1, conn, "virDomainDetachDevice"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virDomainGetAutostart. - * In generator.pl this function has signature "dom : bool". - */ - -CAMLprim value -ocaml_libvirt_domain_get_autostart (value domv) -{ - CAMLparam1 (domv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r, b; - - NONBLOCKING (r = virDomainGetAutostart (dom, &b)); - CHECK_ERROR (r == -1, conn, "virDomainGetAutostart"); - - CAMLreturn (b ? Val_true : Val_false); -} - -/* Automatically generated binding for virDomainSetAutostart. - * In generator.pl this function has signature "dom, bool : unit". - */ - -CAMLprim value -ocaml_libvirt_domain_set_autostart (value domv, value bv) -{ - CAMLparam2 (domv, bv); - - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r, b; - - b = bv == Val_true ? 1 : 0; - - NONBLOCKING (r = virDomainSetAutostart (dom, b)); - CHECK_ERROR (r == -1, conn, "virDomainSetAutostart"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virNetworkFree. - * In generator.pl this function has signature "net : free". - */ - -CAMLprim value -ocaml_libvirt_network_free (value netv) -{ - CAMLparam1 (netv); - - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r; - - NONBLOCKING (r = virNetworkFree (net)); - CHECK_ERROR (r == -1, conn, "virNetworkFree"); - - /* So that we don't double-free in the finalizer: */ - Network_val (netv) = NULL; - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virNetworkDestroy. - * In generator.pl this function has signature "net : free". - */ - -CAMLprim value -ocaml_libvirt_network_destroy (value netv) -{ - CAMLparam1 (netv); - - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r; - - NONBLOCKING (r = virNetworkDestroy (net)); - CHECK_ERROR (r == -1, conn, "virNetworkDestroy"); - - /* So that we don't double-free in the finalizer: */ - Network_val (netv) = NULL; - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virNetworkLookupByName. - * In generator.pl this function has signature "conn, string : net". - */ - -CAMLprim value -ocaml_libvirt_network_lookup_by_name (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkLookupByName (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkLookupByName"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkLookupByUUID. - * In generator.pl this function has signature "conn, uuid : net". - */ - -CAMLprim value -ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - unsigned char *uuid = (unsigned char *) String_val (uuidv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkLookupByUUID (conn, uuid)); - CHECK_ERROR (!r, conn, "virNetworkLookupByUUID"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkLookupByUUIDString. - * In generator.pl this function has signature "conn, string : net". - */ - -CAMLprim value -ocaml_libvirt_network_lookup_by_uuid_string (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkLookupByUUIDString (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkGetName. - * In generator.pl this function has signature "net : static string". - */ - -CAMLprim value -ocaml_libvirt_network_get_name (value netv) -{ - CAMLparam1 (netv); - - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - const char *r; - - NONBLOCKING (r = virNetworkGetName (net)); - CHECK_ERROR (!r, conn, "virNetworkGetName"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkGetXMLDesc. - * In generator.pl this function has signature "net, 0 : string". - */ - -CAMLprim value -ocaml_libvirt_network_get_xml_desc (value netv) -{ - CAMLparam1 (netv); - - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - char *r; - - NONBLOCKING (r = virNetworkGetXMLDesc (net, 0)); - CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkGetBridgeName. - * In generator.pl this function has signature "net : string". - */ - -CAMLprim value -ocaml_libvirt_network_get_bridge_name (value netv) -{ - CAMLparam1 (netv); - - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - char *r; - - NONBLOCKING (r = virNetworkGetBridgeName (net)); - CHECK_ERROR (!r, conn, "virNetworkGetBridgeName"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkGetUUID. - * In generator.pl this function has signature "net : uuid". - */ - -CAMLprim value -ocaml_libvirt_network_get_uuid (value netv) -{ - CAMLparam1 (netv); - - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - unsigned char uuid[VIR_UUID_BUFLEN]; - int r; - - NONBLOCKING (r = virNetworkGetUUID (net, uuid)); - CHECK_ERROR (r == -1, conn, "virNetworkGetUUID"); - - /* UUIDs are byte arrays with a fixed length. */ - rv = caml_alloc_string (VIR_UUID_BUFLEN); - memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkGetUUIDString. - * In generator.pl this function has signature "net : uuid string". - */ - -CAMLprim value -ocaml_libvirt_network_get_uuid_string (value netv) -{ - CAMLparam1 (netv); - - CAMLlocal1 (rv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - char uuid[VIR_UUID_STRING_BUFLEN]; - int r; - - NONBLOCKING (r = virNetworkGetUUIDString (net, uuid)); - CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString"); - - rv = caml_copy_string (uuid); - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkUndefine. - * In generator.pl this function has signature "net : unit". - */ - -CAMLprim value -ocaml_libvirt_network_undefine (value netv) -{ - CAMLparam1 (netv); - - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r; - - NONBLOCKING (r = virNetworkUndefine (net)); - CHECK_ERROR (r == -1, conn, "virNetworkUndefine"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virNetworkCreateXML. - * In generator.pl this function has signature "conn, string : net". - */ - -CAMLprim value -ocaml_libvirt_network_create_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkCreateXML (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkCreateXML"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkCreateXMLJob. - * In generator.pl this function has signature "conn, string : job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNETWORKCREATEXMLJOB -extern virJobPtr virNetworkCreateXMLJob (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_network_create_xml_job (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRNETWORKCREATEXMLJOB - /* Symbol virNetworkCreateXMLJob not found at compile time. */ - not_supported ("virNetworkCreateXMLJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virNetworkCreateXMLJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virNetworkCreateXMLJob); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virJobPtr r; - - NONBLOCKING (r = virNetworkCreateXMLJob (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkCreateXMLJob"); - - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virNetworkDefineXML. - * In generator.pl this function has signature "conn, string : net". - */ - -CAMLprim value -ocaml_libvirt_network_define_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virNetworkPtr r; - - NONBLOCKING (r = virNetworkDefineXML (conn, str)); - CHECK_ERROR (!r, conn, "virNetworkDefineXML"); - - rv = Val_network (r, connv); - - CAMLreturn (rv); -} - -/* Automatically generated binding for virNetworkCreate. - * In generator.pl this function has signature "net : unit". - */ - -CAMLprim value -ocaml_libvirt_network_create (value netv) -{ - CAMLparam1 (netv); - - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r; - - NONBLOCKING (r = virNetworkCreate (net)); - CHECK_ERROR (r == -1, conn, "virNetworkCreate"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virNetworkCreateJob. - * In generator.pl this function has signature "net : job from net". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNETWORKCREATEJOB -extern virJobPtr virNetworkCreateJob (virNetworkPtr net) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_network_create_job (value netv) -{ - CAMLparam1 (netv); -#ifndef HAVE_VIRNETWORKCREATEJOB - /* Symbol virNetworkCreateJob not found at compile time. */ - not_supported ("virNetworkCreateJob"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virNetworkCreateJob - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virNetworkCreateJob); - - CAMLlocal2 (rv, connv); - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - virJobPtr r; - - NONBLOCKING (r = virNetworkCreateJob (net)); - CHECK_ERROR (!r, conn, "virNetworkCreateJob"); - - connv = Field (netv, 1); - rv = Val_job (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virNetworkGetAutostart. - * In generator.pl this function has signature "net : bool". - */ - -CAMLprim value -ocaml_libvirt_network_get_autostart (value netv) -{ - CAMLparam1 (netv); - - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r, b; - - NONBLOCKING (r = virNetworkGetAutostart (net, &b)); - CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart"); - - CAMLreturn (b ? Val_true : Val_false); -} - -/* Automatically generated binding for virNetworkSetAutostart. - * In generator.pl this function has signature "net, bool : unit". - */ - -CAMLprim value -ocaml_libvirt_network_set_autostart (value netv, value bv) -{ - CAMLparam2 (netv, bv); - - virNetworkPtr net = Network_val (netv); - virConnectPtr conn = Connect_netv (netv); - int r, b; - - b = bv == Val_true ? 1 : 0; - - NONBLOCKING (r = virNetworkSetAutostart (net, b)); - CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart"); - - CAMLreturn (Val_unit); -} - -/* Automatically generated binding for virStoragePoolFree. - * In generator.pl this function has signature "pool : free". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLFREE -extern int virStoragePoolFree (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_free (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLFREE - /* Symbol virStoragePoolFree not found at compile time. */ - not_supported ("virStoragePoolFree"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolFree - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolFree); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolFree (pool)); - CHECK_ERROR (r == -1, conn, "virStoragePoolFree"); - - /* So that we don't double-free in the finalizer: */ - Pool_val (poolv) = NULL; - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolDestroy. - * In generator.pl this function has signature "pool : free". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLDESTROY -extern int virStoragePoolDestroy (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_destroy (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLDESTROY - /* Symbol virStoragePoolDestroy not found at compile time. */ - not_supported ("virStoragePoolDestroy"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolDestroy - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolDestroy); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolDestroy (pool)); - CHECK_ERROR (r == -1, conn, "virStoragePoolDestroy"); - - /* So that we don't double-free in the finalizer: */ - Pool_val (poolv) = NULL; - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolLookupByName. - * In generator.pl this function has signature "conn, string : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME -extern virStoragePoolPtr virStoragePoolLookupByName (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_lookup_by_name (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME - /* Symbol virStoragePoolLookupByName not found at compile time. */ - not_supported ("virStoragePoolLookupByName"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolLookupByName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByName); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolLookupByName (conn, str)); - CHECK_ERROR (!r, conn, "virStoragePoolLookupByName"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolLookupByUUID. - * In generator.pl this function has signature "conn, uuid : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID -extern virStoragePoolPtr virStoragePoolLookupByUUID (virConnectPtr conn, const unsigned char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_lookup_by_uuid (value connv, value uuidv) -{ - CAMLparam2 (connv, uuidv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID - /* Symbol virStoragePoolLookupByUUID not found at compile time. */ - not_supported ("virStoragePoolLookupByUUID"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolLookupByUUID - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByUUID); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - unsigned char *uuid = (unsigned char *) String_val (uuidv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolLookupByUUID (conn, uuid)); - CHECK_ERROR (!r, conn, "virStoragePoolLookupByUUID"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolLookupByUUIDString. - * In generator.pl this function has signature "conn, string : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING -extern virStoragePoolPtr virStoragePoolLookupByUUIDString (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_lookup_by_uuid_string (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING - /* Symbol virStoragePoolLookupByUUIDString not found at compile time. */ - not_supported ("virStoragePoolLookupByUUIDString"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolLookupByUUIDString - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByUUIDString); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolLookupByUUIDString (conn, str)); - CHECK_ERROR (!r, conn, "virStoragePoolLookupByUUIDString"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolGetName. - * In generator.pl this function has signature "pool : static string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETNAME -extern const char *virStoragePoolGetName (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_name (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETNAME - /* Symbol virStoragePoolGetName not found at compile time. */ - not_supported ("virStoragePoolGetName"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolGetName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetName); - - CAMLlocal1 (rv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - const char *r; - - NONBLOCKING (r = virStoragePoolGetName (pool)); - CHECK_ERROR (!r, conn, "virStoragePoolGetName"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolGetXMLDesc. - * In generator.pl this function has signature "pool, 0U : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETXMLDESC -extern char *virStoragePoolGetXMLDesc (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_xml_desc (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETXMLDESC - /* Symbol virStoragePoolGetXMLDesc not found at compile time. */ - not_supported ("virStoragePoolGetXMLDesc"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolGetXMLDesc - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetXMLDesc); - - CAMLlocal1 (rv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - char *r; - - NONBLOCKING (r = virStoragePoolGetXMLDesc (pool, 0)); - CHECK_ERROR (!r, conn, "virStoragePoolGetXMLDesc"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolGetUUID. - * In generator.pl this function has signature "pool : uuid". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETUUID -extern int virStoragePoolGetUUID (virStoragePoolPtr pool, unsigned char *) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_uuid (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETUUID - /* Symbol virStoragePoolGetUUID not found at compile time. */ - not_supported ("virStoragePoolGetUUID"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolGetUUID - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetUUID); - - CAMLlocal1 (rv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - unsigned char uuid[VIR_UUID_BUFLEN]; - int r; - - NONBLOCKING (r = virStoragePoolGetUUID (pool, uuid)); - CHECK_ERROR (r == -1, conn, "virStoragePoolGetUUID"); - - /* UUIDs are byte arrays with a fixed length. */ - rv = caml_alloc_string (VIR_UUID_BUFLEN); - memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolGetUUIDString. - * In generator.pl this function has signature "pool : uuid string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETUUIDSTRING -extern int virStoragePoolGetUUIDString (virStoragePoolPtr pool, char *) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_uuid_string (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETUUIDSTRING - /* Symbol virStoragePoolGetUUIDString not found at compile time. */ - not_supported ("virStoragePoolGetUUIDString"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolGetUUIDString - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetUUIDString); - - CAMLlocal1 (rv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - char uuid[VIR_UUID_STRING_BUFLEN]; - int r; - - NONBLOCKING (r = virStoragePoolGetUUIDString (pool, uuid)); - CHECK_ERROR (r == -1, conn, "virStoragePoolGetUUIDString"); - - rv = caml_copy_string (uuid); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolCreateXML. - * In generator.pl this function has signature "conn, string, 0U : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLCREATEXML -extern virStoragePoolPtr virStoragePoolCreateXML (virConnectPtr conn, const char *str, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_create_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLCREATEXML - /* Symbol virStoragePoolCreateXML not found at compile time. */ - not_supported ("virStoragePoolCreateXML"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolCreateXML - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolCreateXML); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolCreateXML (conn, str, 0)); - CHECK_ERROR (!r, conn, "virStoragePoolCreateXML"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolDefineXML. - * In generator.pl this function has signature "conn, string, 0U : pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLDEFINEXML -extern virStoragePoolPtr virStoragePoolDefineXML (virConnectPtr conn, const char *str, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_define_xml (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEPOOLDEFINEXML - /* Symbol virStoragePoolDefineXML not found at compile time. */ - not_supported ("virStoragePoolDefineXML"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolDefineXML - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolDefineXML); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolDefineXML (conn, str, 0)); - CHECK_ERROR (!r, conn, "virStoragePoolDefineXML"); - - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolBuild. - * In generator.pl this function has signature "pool, uint : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLBUILD -extern int virStoragePoolBuild (virStoragePoolPtr pool, unsigned int i) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_build (value poolv, value iv) -{ - CAMLparam2 (poolv, iv); -#ifndef HAVE_VIRSTORAGEPOOLBUILD - /* Symbol virStoragePoolBuild not found at compile time. */ - not_supported ("virStoragePoolBuild"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolBuild - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolBuild); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - unsigned int i = Int_val (iv); - int r; - - NONBLOCKING (r = virStoragePoolBuild (pool, i)); - CHECK_ERROR (!r, conn, "virStoragePoolBuild"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolUndefine. - * In generator.pl this function has signature "pool : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLUNDEFINE -extern int virStoragePoolUndefine (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_undefine (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLUNDEFINE - /* Symbol virStoragePoolUndefine not found at compile time. */ - not_supported ("virStoragePoolUndefine"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolUndefine - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolUndefine); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolUndefine (pool)); - CHECK_ERROR (r == -1, conn, "virStoragePoolUndefine"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolCreate. - * In generator.pl this function has signature "pool, 0U : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLCREATE -extern int virStoragePoolCreate (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_create (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLCREATE - /* Symbol virStoragePoolCreate not found at compile time. */ - not_supported ("virStoragePoolCreate"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolCreate - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolCreate); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolCreate (pool, 0)); - CHECK_ERROR (r == -1, conn, "virStoragePoolCreate"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolDelete. - * In generator.pl this function has signature "pool, uint : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLDELETE -extern int virStoragePoolDelete (virStoragePoolPtr pool, unsigned int i) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_delete (value poolv, value iv) -{ - CAMLparam2 (poolv, iv); -#ifndef HAVE_VIRSTORAGEPOOLDELETE - /* Symbol virStoragePoolDelete not found at compile time. */ - not_supported ("virStoragePoolDelete"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolDelete - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolDelete); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - unsigned int i = Int_val (iv); - int r; - - NONBLOCKING (r = virStoragePoolDelete (pool, i)); - CHECK_ERROR (!r, conn, "virStoragePoolDelete"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolRefresh. - * In generator.pl this function has signature "pool, 0U : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLREFRESH -extern int virStoragePoolRefresh (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_refresh (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLREFRESH - /* Symbol virStoragePoolRefresh not found at compile time. */ - not_supported ("virStoragePoolRefresh"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolRefresh - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolRefresh); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolRefresh (pool, 0)); - CHECK_ERROR (r == -1, conn, "virStoragePoolRefresh"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolGetAutostart. - * In generator.pl this function has signature "pool : bool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETAUTOSTART -extern int virStoragePoolGetAutostart (virStoragePoolPtr pool, int *r) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_autostart (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLGETAUTOSTART - /* Symbol virStoragePoolGetAutostart not found at compile time. */ - not_supported ("virStoragePoolGetAutostart"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolGetAutostart - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolGetAutostart); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r, b; - - NONBLOCKING (r = virStoragePoolGetAutostart (pool, &b)); - CHECK_ERROR (r == -1, conn, "virStoragePoolGetAutostart"); - - CAMLreturn (b ? Val_true : Val_false); -#endif -} - -/* Automatically generated binding for virStoragePoolSetAutostart. - * In generator.pl this function has signature "pool, bool : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLSETAUTOSTART -extern int virStoragePoolSetAutostart (virStoragePoolPtr pool, int b) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_set_autostart (value poolv, value bv) -{ - CAMLparam2 (poolv, bv); -#ifndef HAVE_VIRSTORAGEPOOLSETAUTOSTART - /* Symbol virStoragePoolSetAutostart not found at compile time. */ - not_supported ("virStoragePoolSetAutostart"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolSetAutostart - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolSetAutostart); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r, b; - - b = bv == Val_true ? 1 : 0; - - NONBLOCKING (r = virStoragePoolSetAutostart (pool, b)); - CHECK_ERROR (r == -1, conn, "virStoragePoolSetAutostart"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStoragePoolNumOfVolumes. - * In generator.pl this function has signature "pool : int". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES -extern int virStoragePoolNumOfVolumes (virStoragePoolPtr pool) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_num_of_volumes (value poolv) -{ - CAMLparam1 (poolv); -#ifndef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES - /* Symbol virStoragePoolNumOfVolumes not found at compile time. */ - not_supported ("virStoragePoolNumOfVolumes"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolNumOfVolumes - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolNumOfVolumes); - - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int r; - - NONBLOCKING (r = virStoragePoolNumOfVolumes (pool)); - CHECK_ERROR (r == -1, conn, "virStoragePoolNumOfVolumes"); - - CAMLreturn (Val_int (r)); -#endif -} - -/* Automatically generated binding for virStoragePoolListVolumes. - * In generator.pl this function has signature "pool, int : string array". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLISTVOLUMES -extern int virStoragePoolListVolumes (virStoragePoolPtr pool, char **const names, int maxnames) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_list_volumes (value poolv, value iv) -{ - CAMLparam2 (poolv, iv); -#ifndef HAVE_VIRSTORAGEPOOLLISTVOLUMES - /* Symbol virStoragePoolListVolumes not found at compile time. */ - not_supported ("virStoragePoolListVolumes"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolListVolumes - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolListVolumes); - - CAMLlocal2 (rv, strv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - int i = Int_val (iv); - char *names[i]; - int r; - - NONBLOCKING (r = virStoragePoolListVolumes (pool, names, i)); - CHECK_ERROR (r == -1, conn, "virStoragePoolListVolumes"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) { - strv = caml_copy_string (names[i]); - Store_field (rv, i, strv); - free (names[i]); - } - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolFree. - * In generator.pl this function has signature "vol : free". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLFREE -extern int virStorageVolFree (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_free (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLFREE - /* Symbol virStorageVolFree not found at compile time. */ - not_supported ("virStorageVolFree"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolFree - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolFree); - - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - int r; - - NONBLOCKING (r = virStorageVolFree (vol)); - CHECK_ERROR (r == -1, conn, "virStorageVolFree"); - - /* So that we don't double-free in the finalizer: */ - Volume_val (volv) = NULL; - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStorageVolDelete. - * In generator.pl this function has signature "vol, uint : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLDELETE -extern int virStorageVolDelete (virStorageVolPtr vol, unsigned int i) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_delete (value volv, value iv) -{ - CAMLparam2 (volv, iv); -#ifndef HAVE_VIRSTORAGEVOLDELETE - /* Symbol virStorageVolDelete not found at compile time. */ - not_supported ("virStorageVolDelete"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolDelete - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolDelete); - - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - unsigned int i = Int_val (iv); - int r; - - NONBLOCKING (r = virStorageVolDelete (vol, i)); - CHECK_ERROR (!r, conn, "virStorageVolDelete"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virStorageVolLookupByName. - * In generator.pl this function has signature "pool, string : vol from pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYNAME -extern virStorageVolPtr virStorageVolLookupByName (virStoragePoolPtr pool, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_lookup_by_name (value poolv, value strv) -{ - CAMLparam2 (poolv, strv); -#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYNAME - /* Symbol virStorageVolLookupByName not found at compile time. */ - not_supported ("virStorageVolLookupByName"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolLookupByName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolLookupByName); - - CAMLlocal2 (rv, connv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - char *str = String_val (strv); - virStorageVolPtr r; - - NONBLOCKING (r = virStorageVolLookupByName (pool, str)); - CHECK_ERROR (!r, conn, "virStorageVolLookupByName"); - - connv = Field (poolv, 1); - rv = Val_volume (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolLookupByKey. - * In generator.pl this function has signature "conn, string : vol". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYKEY -extern virStorageVolPtr virStorageVolLookupByKey (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_lookup_by_key (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYKEY - /* Symbol virStorageVolLookupByKey not found at compile time. */ - not_supported ("virStorageVolLookupByKey"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolLookupByKey - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolLookupByKey); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStorageVolPtr r; - - NONBLOCKING (r = virStorageVolLookupByKey (conn, str)); - CHECK_ERROR (!r, conn, "virStorageVolLookupByKey"); - - rv = Val_volume (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolLookupByPath. - * In generator.pl this function has signature "conn, string : vol". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYPATH -extern virStorageVolPtr virStorageVolLookupByPath (virConnectPtr conn, const char *str) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_lookup_by_path (value connv, value strv) -{ - CAMLparam2 (connv, strv); -#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYPATH - /* Symbol virStorageVolLookupByPath not found at compile time. */ - not_supported ("virStorageVolLookupByPath"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolLookupByPath - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolLookupByPath); - - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - char *str = String_val (strv); - virStorageVolPtr r; - - NONBLOCKING (r = virStorageVolLookupByPath (conn, str)); - CHECK_ERROR (!r, conn, "virStorageVolLookupByPath"); - - rv = Val_volume (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolCreateXML. - * In generator.pl this function has signature "pool, string, 0U : vol from pool". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLCREATEXML -extern virStorageVolPtr virStorageVolCreateXML (virStoragePoolPtr pool, const char *str, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_create_xml (value poolv, value strv) -{ - CAMLparam2 (poolv, strv); -#ifndef HAVE_VIRSTORAGEVOLCREATEXML - /* Symbol virStorageVolCreateXML not found at compile time. */ - not_supported ("virStorageVolCreateXML"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolCreateXML - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolCreateXML); - - CAMLlocal2 (rv, connv); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - char *str = String_val (strv); - virStorageVolPtr r; - - NONBLOCKING (r = virStorageVolCreateXML (pool, str, 0)); - CHECK_ERROR (!r, conn, "virStorageVolCreateXML"); - - connv = Field (poolv, 1); - rv = Val_volume (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolGetXMLDesc. - * In generator.pl this function has signature "vol, 0U : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETXMLDESC -extern char *virStorageVolGetXMLDesc (virStorageVolPtr vol, unsigned int flags) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_xml_desc (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETXMLDESC - /* Symbol virStorageVolGetXMLDesc not found at compile time. */ - not_supported ("virStorageVolGetXMLDesc"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolGetXMLDesc - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetXMLDesc); - - CAMLlocal1 (rv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - char *r; - - NONBLOCKING (r = virStorageVolGetXMLDesc (vol, 0)); - CHECK_ERROR (!r, conn, "virStorageVolGetXMLDesc"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolGetPath. - * In generator.pl this function has signature "vol : string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETPATH -extern char *virStorageVolGetPath (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_path (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETPATH - /* Symbol virStorageVolGetPath not found at compile time. */ - not_supported ("virStorageVolGetPath"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolGetPath - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetPath); - - CAMLlocal1 (rv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - char *r; - - NONBLOCKING (r = virStorageVolGetPath (vol)); - CHECK_ERROR (!r, conn, "virStorageVolGetPath"); - - rv = caml_copy_string (r); - free (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolGetKey. - * In generator.pl this function has signature "vol : static string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETKEY -extern const char *virStorageVolGetKey (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_key (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETKEY - /* Symbol virStorageVolGetKey not found at compile time. */ - not_supported ("virStorageVolGetKey"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolGetKey - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetKey); - - CAMLlocal1 (rv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - const char *r; - - NONBLOCKING (r = virStorageVolGetKey (vol)); - CHECK_ERROR (!r, conn, "virStorageVolGetKey"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStorageVolGetName. - * In generator.pl this function has signature "vol : static string". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETNAME -extern const char *virStorageVolGetName (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_name (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEVOLGETNAME - /* Symbol virStorageVolGetName not found at compile time. */ - not_supported ("virStorageVolGetName"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStorageVolGetName - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStorageVolGetName); - - CAMLlocal1 (rv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - const char *r; - - NONBLOCKING (r = virStorageVolGetName (vol)); - CHECK_ERROR (!r, conn, "virStorageVolGetName"); - - rv = caml_copy_string (r); - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virStoragePoolLookupByVolume. - * In generator.pl this function has signature "vol : pool from vol". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME -extern virStoragePoolPtr virStoragePoolLookupByVolume (virStorageVolPtr vol) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_lookup_by_volume (value volv) -{ - CAMLparam1 (volv); -#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME - /* Symbol virStoragePoolLookupByVolume not found at compile time. */ - not_supported ("virStoragePoolLookupByVolume"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virStoragePoolLookupByVolume - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virStoragePoolLookupByVolume); - - CAMLlocal2 (rv, connv); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - virStoragePoolPtr r; - - NONBLOCKING (r = virStoragePoolLookupByVolume (vol)); - CHECK_ERROR (!r, conn, "virStoragePoolLookupByVolume"); - - connv = Field (volv, 1); - rv = Val_pool (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virJobFree. - * In generator.pl this function has signature "job : free". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBFREE -extern int virJobFree (virJobPtr job) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_free (value jobv) -{ - CAMLparam1 (jobv); -#ifndef HAVE_VIRJOBFREE - /* Symbol virJobFree not found at compile time. */ - not_supported ("virJobFree"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virJobFree - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virJobFree); - - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - int r; - - NONBLOCKING (r = virJobFree (job)); - CHECK_ERROR (r == -1, conn, "virJobFree"); - - /* So that we don't double-free in the finalizer: */ - Job_val (jobv) = NULL; - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virJobCancel. - * In generator.pl this function has signature "job : unit". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBCANCEL -extern int virJobCancel (virJobPtr job) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_cancel (value jobv) -{ - CAMLparam1 (jobv); -#ifndef HAVE_VIRJOBCANCEL - /* Symbol virJobCancel not found at compile time. */ - not_supported ("virJobCancel"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virJobCancel - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virJobCancel); - - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - int r; - - NONBLOCKING (r = virJobCancel (job)); - CHECK_ERROR (r == -1, conn, "virJobCancel"); - - CAMLreturn (Val_unit); -#endif -} - -/* Automatically generated binding for virJobGetNetwork. - * In generator.pl this function has signature "job : net from job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBGETNETWORK -extern virNetworkPtr virJobGetNetwork (virJobPtr job) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_get_network (value jobv) -{ - CAMLparam1 (jobv); -#ifndef HAVE_VIRJOBGETNETWORK - /* Symbol virJobGetNetwork not found at compile time. */ - not_supported ("virJobGetNetwork"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virJobGetNetwork - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virJobGetNetwork); - - CAMLlocal2 (rv, connv); - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - virNetworkPtr r; - - NONBLOCKING (r = virJobGetNetwork (job)); - CHECK_ERROR (!r, conn, "virJobGetNetwork"); - - connv = Field (jobv, 1); - rv = Val_network (r, connv); - - CAMLreturn (rv); -#endif -} - -/* Automatically generated binding for virJobGetDomain. - * In generator.pl this function has signature "job : dom from job". - */ - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBGETDOMAIN -extern virDomainPtr virJobGetDomain (virJobPtr job) __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_get_domain (value jobv) -{ - CAMLparam1 (jobv); -#ifndef HAVE_VIRJOBGETDOMAIN - /* Symbol virJobGetDomain not found at compile time. */ - not_supported ("virJobGetDomain"); - /* Suppresses a compiler warning. */ - (void) caml__frame; -#else - /* Check that the symbol virJobGetDomain - * is in runtime version of libvirt. - */ - WEAK_SYMBOL_CHECK (virJobGetDomain); - - CAMLlocal2 (rv, connv); - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - virDomainPtr r; - - NONBLOCKING (r = virJobGetDomain (job)); - CHECK_ERROR (!r, conn, "virJobGetDomain"); - - connv = Field (jobv, 1); - rv = Val_domain (r, connv); - - CAMLreturn (rv); -#endif -} - -#include "libvirt_c_epilogue.c" - -/* EOF */ diff --git a/libvirt/libvirt_c_epilogue.c b/libvirt/libvirt_c_epilogue.c deleted file mode 100644 index 78bd23e..0000000 --- a/libvirt/libvirt_c_epilogue.c +++ /dev/null @@ -1,548 +0,0 @@ -/* OCaml bindings for libvirt. - * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - * http://libvirt.org/ - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2 of the License, or (at your option) any later version. - * - * This library 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 - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - -/* Please read libvirt/README file. */ - -static char * -Optstring_val (value strv) -{ - if (strv == Val_int (0)) /* None */ - return NULL; - else /* Some string */ - return String_val (Field (strv, 0)); -} - -static value -Val_opt (void *ptr, Val_ptr_t Val_ptr) -{ - CAMLparam0 (); - CAMLlocal2 (optv, ptrv); - - if (ptr) { /* Some ptr */ - optv = caml_alloc (1, 0); - ptrv = Val_ptr (ptr); - Store_field (optv, 0, ptrv); - } else /* None */ - optv = Val_int (0); - - CAMLreturn (optv); -} - -#if 0 -static value -option_default (value option, value deflt) -{ - if (option == Val_int (0)) /* "None" */ - return deflt; - else /* "Some 'a" */ - return Field (option, 0); -} -#endif - -static void -_raise_virterror (virConnectPtr conn, const char *fn) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - virErrorPtr errp; - struct _virError err; - - errp = conn ? virConnGetLastError (conn) : virGetLastError (); - - if (!errp) { - /* Fake a _virError structure. */ - memset (&err, 0, sizeof err); - err.code = VIR_ERR_INTERNAL_ERROR; - err.domain = VIR_FROM_NONE; - err.level = VIR_ERR_ERROR; - err.message = (char *) fn; - errp = &err; - } - - rv = Val_virterror (errp); - caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv); - - /*NOTREACHED*/ - /* Suppresses a compiler warning. */ - (void) caml__frame; -} - -/* Raise an error if a function is not supported. */ -static void -not_supported (const char *fn) -{ - CAMLparam0 (); - CAMLlocal1 (fnv); - - fnv = caml_copy_string (fn); - caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_not_supported"), fnv); - - /*NOTREACHED*/ - /* Suppresses a compiler warning. */ - (void) caml__frame; -} - -/* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums - * into values (longs because they are variants in OCaml). - * - * The enum values are part of the libvirt ABI so they cannot change, - * which means that we can convert these numbers directly into - * OCaml variants (which use the same ordering) very fast. - * - * The tricky part here is when we are linked to a newer version of - * libvirt than the one we were compiled against. If the newer libvirt - * generates an error code which we don't know about then we need - * to convert it into VIR_*_UNKNOWN (code). - */ - -#define MAX_VIR_CODE 50 /* VIR_ERR_NO_STORAGE_VOL */ -#define MAX_VIR_DOMAIN 17 /* VIR_FROM_STORAGE */ -#define MAX_VIR_LEVEL VIR_ERR_ERROR - -static inline value -Val_err_number (virErrorNumber code) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - - if (0 <= code && code <= MAX_VIR_CODE) - rv = Val_int (code); - else { - rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN (code) */ - Store_field (rv, 0, Val_int (code)); - } - - CAMLreturn (rv); -} - -static inline value -Val_err_domain (virErrorDomain code) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - - if (0 <= code && code <= MAX_VIR_DOMAIN) - rv = Val_int (code); - else { - rv = caml_alloc (1, 0); /* VIR_FROM_UNKNOWN (code) */ - Store_field (rv, 0, Val_int (code)); - } - - CAMLreturn (rv); -} - -static inline value -Val_err_level (virErrorLevel code) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - - if (0 <= code && code <= MAX_VIR_LEVEL) - rv = Val_int (code); - else { - rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN_LEVEL (code) */ - Store_field (rv, 0, Val_int (code)); - } - - CAMLreturn (rv); -} - -/* Convert a virterror to a value. */ -static value -Val_virterror (virErrorPtr err) -{ - CAMLparam0 (); - CAMLlocal3 (rv, connv, optv); - - rv = caml_alloc (12, 0); - Store_field (rv, 0, Val_err_number (err->code)); - Store_field (rv, 1, Val_err_domain (err->domain)); - Store_field (rv, 2, - Val_opt (err->message, (Val_ptr_t) caml_copy_string)); - Store_field (rv, 3, Val_err_level (err->level)); - - /* conn, dom and net fields, all optional */ - if (err->conn) { - connv = Val_connect_no_finalize (err->conn); - optv = caml_alloc (1, 0); - Store_field (optv, 0, connv); - Store_field (rv, 4, optv); /* Some conn */ - - if (err->dom) { - optv = caml_alloc (1, 0); - Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv)); - Store_field (rv, 5, optv); /* Some (dom, conn) */ - } - else - Store_field (rv, 5, Val_int (0)); /* None */ - if (err->net) { - optv = caml_alloc (1, 0); - Store_field (optv, 0, Val_network_no_finalize (err->net, connv)); - Store_field (rv, 11, optv); /* Some (net, conn) */ - } else - Store_field (rv, 11, Val_int (0)); /* None */ - } else { - Store_field (rv, 4, Val_int (0)); /* None */ - Store_field (rv, 5, Val_int (0)); /* None */ - Store_field (rv, 11, Val_int (0)); /* None */ - } - - Store_field (rv, 6, - Val_opt (err->str1, (Val_ptr_t) caml_copy_string)); - Store_field (rv, 7, - Val_opt (err->str2, (Val_ptr_t) caml_copy_string)); - Store_field (rv, 8, - Val_opt (err->str3, (Val_ptr_t) caml_copy_string)); - Store_field (rv, 9, caml_copy_int32 (err->int1)); - Store_field (rv, 10, caml_copy_int32 (err->int2)); - - CAMLreturn (rv); -} - -static void conn_finalize (value); -static void dom_finalize (value); -static void net_finalize (value); -#ifdef HAVE_VIRSTORAGEPOOLPTR -static void pol_finalize (value); -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR -static void vol_finalize (value); -#endif -#ifdef HAVE_VIRJOBPTR -static void jb_finalize (value); -#endif - -static struct custom_operations conn_custom_operations = { - "conn_custom_operations", - conn_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; - -static struct custom_operations dom_custom_operations = { - "dom_custom_operations", - dom_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default - -}; - -static struct custom_operations net_custom_operations = { - "net_custom_operations", - net_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; - -#ifdef HAVE_VIRSTORAGEPOOLPTR -static struct custom_operations pol_custom_operations = { - "pol_custom_operations", - pol_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; -#endif - -#ifdef HAVE_VIRSTORAGEVOLPTR -static struct custom_operations vol_custom_operations = { - "vol_custom_operations", - vol_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; -#endif - -#ifdef HAVE_VIRJOBPTR -static struct custom_operations jb_custom_operations = { - "jb_custom_operations", - jb_finalize, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; -#endif - -static value -Val_connect (virConnectPtr conn) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&conn_custom_operations, - sizeof (virConnectPtr), 0, 1); - Connect_val (rv) = conn; - CAMLreturn (rv); -} - -static value -Val_dom (virDomainPtr dom) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&dom_custom_operations, - sizeof (virDomainPtr), 0, 1); - Dom_val (rv) = dom; - CAMLreturn (rv); -} - -static value -Val_net (virNetworkPtr net) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&net_custom_operations, - sizeof (virNetworkPtr), 0, 1); - Net_val (rv) = net; - CAMLreturn (rv); -} - -#ifdef HAVE_VIRSTORAGEPOOLPTR -static value -Val_pol (virStoragePoolPtr pol) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&pol_custom_operations, - sizeof (virStoragePoolPtr), 0, 1); - Pol_val (rv) = pol; - CAMLreturn (rv); -} -#endif - -#ifdef HAVE_VIRSTORAGEVOLPTR -static value -Val_vol (virStorageVolPtr vol) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&vol_custom_operations, - sizeof (virStorageVolPtr), 0, 1); - Vol_val (rv) = vol; - CAMLreturn (rv); -} -#endif - -#ifdef HAVE_VIRJOBPTR -static value -Val_jb (virJobPtr jb) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc_custom (&jb_custom_operations, - sizeof (virJobPtr), 0, 1); - Jb_val (rv) = jb; - CAMLreturn (rv); -} -#endif - -/* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use - * by virterror wrappers. - */ -static value -Val_connect_no_finalize (virConnectPtr conn) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc (1, Abstract_tag); - Store_field (rv, 0, (value) conn); - CAMLreturn (rv); -} - -static value -Val_dom_no_finalize (virDomainPtr dom) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc (1, Abstract_tag); - Store_field (rv, 0, (value) dom); - CAMLreturn (rv); -} - -static value -Val_net_no_finalize (virNetworkPtr net) -{ - CAMLparam0 (); - CAMLlocal1 (rv); - rv = caml_alloc (1, Abstract_tag); - Store_field (rv, 0, (value) net); - CAMLreturn (rv); -} - -/* This wraps up the (dom, conn) pair (Domain.t). */ -static value -Val_domain (virDomainPtr dom, value connv) -{ - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_dom (dom); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); -} - -/* This wraps up the (net, conn) pair (Network.t). */ -static value -Val_network (virNetworkPtr net, value connv) -{ - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_net (net); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); -} - -#ifdef HAVE_VIRSTORAGEPOOLPTR -/* This wraps up the (pol, conn) pair (Pool.t). */ -static value -Val_pool (virStoragePoolPtr pol, value connv) -{ - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_pol (pol); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); -} -#endif - -#ifdef HAVE_VIRSTORAGEVOLPTR -/* This wraps up the (vol, conn) pair (Volume.t). */ -static value -Val_volume (virStorageVolPtr vol, value connv) -{ - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_vol (vol); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); -} -#endif - -#ifdef HAVE_VIRJOBPTR -/* This wraps up the (jb, conn) pair (Job.t). */ -static value -Val_job (virJobPtr jb, value connv) -{ - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_jb (jb); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); -} -#endif - -/* No-finalize versions of Val_domain, Val_network ONLY for use by - * virterror wrappers. - */ -static value -Val_domain_no_finalize (virDomainPtr dom, value connv) -{ - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_dom_no_finalize (dom); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); -} - -static value -Val_network_no_finalize (virNetworkPtr net, value connv) -{ - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - - rv = caml_alloc_tuple (2); - v = Val_net_no_finalize (net); - Store_field (rv, 0, v); - Store_field (rv, 1, connv); - CAMLreturn (rv); -} - -static void -conn_finalize (value connv) -{ - virConnectPtr conn = Connect_val (connv); - if (conn) (void) virConnectClose (conn); -} - -static void -dom_finalize (value domv) -{ - virDomainPtr dom = Dom_val (domv); - if (dom) (void) virDomainFree (dom); -} - -static void -net_finalize (value netv) -{ - virNetworkPtr net = Net_val (netv); - if (net) (void) virNetworkFree (net); -} - -#ifdef HAVE_VIRSTORAGEPOOLPTR -static void -pol_finalize (value polv) -{ - virStoragePoolPtr pol = Pol_val (polv); - if (pol) (void) virStoragePoolFree (pol); -} -#endif - -#ifdef HAVE_VIRSTORAGEVOLPTR -static void -vol_finalize (value volv) -{ - virStorageVolPtr vol = Vol_val (volv); - if (vol) (void) virStorageVolFree (vol); -} -#endif - -#ifdef HAVE_VIRJOBPTR -static void -jb_finalize (value jbv) -{ - virJobPtr jb = Jb_val (jbv); - if (jb) (void) virJobFree (jb); -} -#endif diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c deleted file mode 100644 index 5df783e..0000000 --- a/libvirt/libvirt_c_oneoffs.c +++ /dev/null @@ -1,822 +0,0 @@ -/* OCaml bindings for libvirt. - * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - * http://libvirt.org/ - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2 of the License, or (at your option) any later version. - * - * This library 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 - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - -/* Please read libvirt/README file. */ - -/*----------------------------------------------------------------------*/ - -CAMLprim value -ocaml_libvirt_get_version (value driverv, value unit) -{ - CAMLparam2 (driverv, unit); - CAMLlocal1 (rv); - const char *driver = Optstring_val (driverv); - unsigned long libVer, typeVer = 0, *typeVer_ptr; - int r; - - typeVer_ptr = driver ? &typeVer : NULL; - NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr)); - CHECK_ERROR (r == -1, NULL, "virGetVersion"); - - rv = caml_alloc_tuple (2); - Store_field (rv, 0, Val_int (libVer)); - Store_field (rv, 1, Val_int (typeVer)); - CAMLreturn (rv); -} - -/*----------------------------------------------------------------------*/ - -/* Connection object. */ - -CAMLprim value -ocaml_libvirt_connect_open (value namev, value unit) -{ - CAMLparam2 (namev, unit); - CAMLlocal1 (rv); - const char *name = Optstring_val (namev); - virConnectPtr conn; - - NONBLOCKING (conn = virConnectOpen (name)); - CHECK_ERROR (!conn, NULL, "virConnectOpen"); - - rv = Val_connect (conn); - - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_connect_open_readonly (value namev, value unit) -{ - CAMLparam2 (namev, unit); - CAMLlocal1 (rv); - const char *name = Optstring_val (namev); - virConnectPtr conn; - - NONBLOCKING (conn = virConnectOpenReadOnly (name)); - CHECK_ERROR (!conn, NULL, "virConnectOpen"); - - rv = Val_connect (conn); - - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_connect_get_version (value connv) -{ - CAMLparam1 (connv); - virConnectPtr conn = Connect_val (connv); - unsigned long hvVer; - int r; - - NONBLOCKING (r = virConnectGetVersion (conn, &hvVer)); - CHECK_ERROR (r == -1, conn, "virConnectGetVersion"); - - CAMLreturn (Val_int (hvVer)); -} - -CAMLprim value -ocaml_libvirt_connect_get_max_vcpus (value connv, value typev) -{ - CAMLparam2 (connv, typev); - virConnectPtr conn = Connect_val (connv); - const char *type = Optstring_val (typev); - int r; - - NONBLOCKING (r = virConnectGetMaxVcpus (conn, type)); - CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus"); - - CAMLreturn (Val_int (r)); -} - -CAMLprim value -ocaml_libvirt_connect_get_node_info (value connv) -{ - CAMLparam1 (connv); - CAMLlocal2 (rv, v); - virConnectPtr conn = Connect_val (connv); - virNodeInfo info; - int r; - - NONBLOCKING (r = virNodeGetInfo (conn, &info)); - CHECK_ERROR (r == -1, conn, "virNodeGetInfo"); - - rv = caml_alloc (8, 0); - v = caml_copy_string (info.model); Store_field (rv, 0, v); - v = caml_copy_int64 (info.memory); Store_field (rv, 1, v); - Store_field (rv, 2, Val_int (info.cpus)); - Store_field (rv, 3, Val_int (info.mhz)); - Store_field (rv, 4, Val_int (info.nodes)); - Store_field (rv, 5, Val_int (info.sockets)); - Store_field (rv, 6, Val_int (info.cores)); - Store_field (rv, 7, Val_int (info.threads)); - - CAMLreturn (rv); -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNODEGETFREEMEMORY -extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_node_get_free_memory (value connv) -{ -#ifdef HAVE_VIRNODEGETFREEMEMORY - CAMLparam1 (connv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - unsigned long long r; - - WEAK_SYMBOL_CHECK (virNodeGetFreeMemory); - NONBLOCKING (r = virNodeGetFreeMemory (conn)); - CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory"); - - rv = caml_copy_int64 ((int64) r); - CAMLreturn (rv); -#else - not_supported ("virNodeGetFreeMemory"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY -extern int virNodeGetCellsFreeMemory (virConnectPtr conn, - unsigned long long *freeMems, - int startCell, int maxCells) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_connect_node_get_cells_free_memory (value connv, - value startv, value maxv) -{ -#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY - CAMLparam3 (connv, startv, maxv); - CAMLlocal2 (rv, iv); - virConnectPtr conn = Connect_val (connv); - int start = Int_val (startv); - int max = Int_val (maxv); - int r, i; - unsigned long long freemems[max]; - - WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory); - NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max)); - CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory"); - - rv = caml_alloc (r, 0); - for (i = 0; i < r; ++i) { - iv = caml_copy_int64 ((int64) freemems[i]); - Store_field (rv, i, iv); - } - - CAMLreturn (rv); -#else - not_supported ("virNodeGetCellsFreeMemory"); -#endif -} - -CAMLprim value -ocaml_libvirt_domain_get_id (value domv) -{ - CAMLparam1 (domv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - unsigned int r; - - NONBLOCKING (r = virDomainGetID (dom)); - /* There's a bug in libvirt which means that if you try to get - * the ID of a defined-but-not-running domain, it returns -1, - * and there's no way to distinguish that from an error. - */ - CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID"); - - CAMLreturn (Val_int ((int) r)); -} - -CAMLprim value -ocaml_libvirt_domain_get_max_memory (value domv) -{ - CAMLparam1 (domv); - CAMLlocal1 (rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - unsigned long r; - - NONBLOCKING (r = virDomainGetMaxMemory (dom)); - CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory"); - - rv = caml_copy_int64 (r); - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_domain_set_max_memory (value domv, value memv) -{ - CAMLparam2 (domv, memv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - unsigned long mem = Int64_val (memv); - int r; - - NONBLOCKING (r = virDomainSetMaxMemory (dom, mem)); - CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_set_memory (value domv, value memv) -{ - CAMLparam2 (domv, memv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - unsigned long mem = Int64_val (memv); - int r; - - NONBLOCKING (r = virDomainSetMemory (dom, mem)); - CHECK_ERROR (r == -1, conn, "virDomainSetMemory"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_get_info (value domv) -{ - CAMLparam1 (domv); - CAMLlocal2 (rv, v); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - virDomainInfo info; - int r; - - NONBLOCKING (r = virDomainGetInfo (dom, &info)); - CHECK_ERROR (r == -1, conn, "virDomainGetInfo"); - - rv = caml_alloc (5, 0); - Store_field (rv, 0, Val_int (info.state)); // These flags are compatible. - v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v); - v = caml_copy_int64 (info.memory); Store_field (rv, 2, v); - Store_field (rv, 3, Val_int (info.nrVirtCpu)); - v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v); - - CAMLreturn (rv); -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE -extern char *virDomainGetSchedulerType(virDomainPtr domain, - int *nparams) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_get_scheduler_type (value domv) -{ -#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE - CAMLparam1 (domv); - CAMLlocal2 (rv, strv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *r; - int nparams; - - WEAK_SYMBOL_CHECK (virDomainGetSchedulerType); - NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams)); - CHECK_ERROR (!r, conn, "virDomainGetSchedulerType"); - - rv = caml_alloc_tuple (2); - strv = caml_copy_string (r); Store_field (rv, 0, strv); - free (r); - Store_field (rv, 1, nparams); - CAMLreturn (rv); -#else - not_supported ("virDomainGetSchedulerType"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS -extern int virDomainGetSchedulerParameters (virDomainPtr domain, - virSchedParameterPtr params, - int *nparams) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv) -{ -#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS - CAMLparam2 (domv, nparamsv); - CAMLlocal4 (rv, v, v2, v3); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int nparams = Int_val (nparamsv); - virSchedParameter params[nparams]; - int r, i; - - WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters); - NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams)); - CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters"); - - rv = caml_alloc (nparams, 0); - for (i = 0; i < nparams; ++i) { - v = caml_alloc_tuple (2); Store_field (rv, i, v); - v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2); - switch (params[i].type) { - case VIR_DOMAIN_SCHED_FIELD_INT: - v2 = caml_alloc (1, 0); - v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_UINT: - v2 = caml_alloc (1, 1); - v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_LLONG: - v2 = caml_alloc (1, 2); - v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_ULLONG: - v2 = caml_alloc (1, 3); - v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_DOUBLE: - v2 = caml_alloc (1, 4); - v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3); - break; - case VIR_DOMAIN_SCHED_FIELD_BOOLEAN: - v2 = caml_alloc (1, 5); - Store_field (v2, 0, Val_int (params[i].value.b)); - break; - default: - caml_failwith ((char *)__FUNCTION__); - } - Store_field (v, 1, v2); - } - CAMLreturn (rv); -#else - not_supported ("virDomainGetSchedulerParameters"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS -extern int virDomainSetSchedulerParameters (virDomainPtr domain, - virSchedParameterPtr params, - int nparams) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv) -{ -#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS - CAMLparam2 (domv, paramsv); - CAMLlocal1 (v); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int nparams = Wosize_val (paramsv); - virSchedParameter params[nparams]; - int r, i; - char *name; - - for (i = 0; i < nparams; ++i) { - v = Field (paramsv, i); /* Points to the two-element tuple. */ - name = String_val (Field (v, 0)); - strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH); - params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0'; - v = Field (v, 1); /* Points to the sched_param_value block. */ - switch (Tag_val (v)) { - case 0: - params[i].type = VIR_DOMAIN_SCHED_FIELD_INT; - params[i].value.i = Int32_val (Field (v, 0)); - break; - case 1: - params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT; - params[i].value.ui = Int32_val (Field (v, 0)); - break; - case 2: - params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG; - params[i].value.l = Int64_val (Field (v, 0)); - break; - case 3: - params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG; - params[i].value.ul = Int64_val (Field (v, 0)); - break; - case 4: - params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE; - params[i].value.d = Double_val (Field (v, 0)); - break; - case 5: - params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN; - params[i].value.b = Int_val (Field (v, 0)); - break; - default: - caml_failwith ((char *)__FUNCTION__); - } - } - - WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters); - NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams)); - CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters"); - - CAMLreturn (Val_unit); -#else - not_supported ("virDomainSetSchedulerParameters"); -#endif -} - -CAMLprim value -ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv) -{ - CAMLparam2 (domv, nvcpusv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int r, nvcpus = Int_val (nvcpusv); - - NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus)); - CHECK_ERROR (r == -1, conn, "virDomainSetVcpus"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv) -{ - CAMLparam3 (domv, vcpuv, cpumapv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int maplen = caml_string_length (cpumapv); - unsigned char *cpumap = (unsigned char *) String_val (cpumapv); - int vcpu = Int_val (vcpuv); - int r; - - NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen)); - CHECK_ERROR (r == -1, conn, "virDomainPinVcpu"); - - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv) -{ - CAMLparam3 (domv, maxinfov, maplenv); - CAMLlocal5 (rv, infov, strv, v, v2); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - int maxinfo = Int_val (maxinfov); - int maplen = Int_val (maplenv); - virVcpuInfo info[maxinfo]; - unsigned char cpumaps[maxinfo * maplen]; - int r, i; - - memset (info, 0, sizeof (virVcpuInfo) * maxinfo); - memset (cpumaps, 0, maxinfo * maplen); - - NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen)); - CHECK_ERROR (r == -1, conn, "virDomainPinVcpu"); - - /* Copy the virVcpuInfo structures. */ - infov = caml_alloc (maxinfo, 0); - for (i = 0; i < maxinfo; ++i) { - v2 = caml_alloc (4, 0); Store_field (infov, i, v2); - Store_field (v2, 0, Val_int (info[i].number)); - Store_field (v2, 1, Val_int (info[i].state)); - v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v); - Store_field (v2, 3, Val_int (info[i].cpu)); - } - - /* Copy the bitmap. */ - strv = caml_alloc_string (maxinfo * maplen); - memcpy (String_val (strv), cpumaps, maxinfo * maplen); - - /* Allocate the tuple and return it. */ - rv = caml_alloc_tuple (3); - Store_field (rv, 0, Val_int (r)); /* number of CPUs. */ - Store_field (rv, 1, infov); - Store_field (rv, 2, strv); - - CAMLreturn (rv); -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINMIGRATE -extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn, - unsigned long flags, const char *dname, - const char *uri, unsigned long bandwidth) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv) -{ -#ifdef HAVE_VIRDOMAINMIGRATE - CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv); - CAMLxparam2 (optbandwidthv, unitv); - CAMLlocal2 (flagv, rv); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - virConnectPtr dconn = Connect_val (dconnv); - int flags = 0; - const char *dname = Optstring_val (optdnamev); - const char *uri = Optstring_val (opturiv); - unsigned long bandwidth; - virDomainPtr r; - - /* Iterate over the list of flags. */ - for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) - { - flagv = Field (flagsv, 0); - if (flagv == Int_val(0)) - flags |= VIR_MIGRATE_LIVE; - } - - if (optbandwidthv == Val_int (0)) /* None */ - bandwidth = 0; - else /* Some bandwidth */ - bandwidth = Int_val (Field (optbandwidthv, 0)); - - WEAK_SYMBOL_CHECK (virDomainMigrate); - NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth)); - CHECK_ERROR (!r, conn, "virDomainMigrate"); - - rv = Val_domain (r, dconnv); - - CAMLreturn (rv); - -#else /* virDomainMigrate not supported */ - not_supported ("virDomainMigrate"); -#endif -} - -CAMLprim value -ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn) -{ - return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5], - argv[6]); -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAINBLOCKSTATS -extern int virDomainBlockStats (virDomainPtr dom, - const char *path, - virDomainBlockStatsPtr stats, - size_t size) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_block_stats (value domv, value pathv) -{ -#if HAVE_VIRDOMAINBLOCKSTATS - CAMLparam2 (domv, pathv); - CAMLlocal2 (rv,v); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *path = String_val (pathv); - struct _virDomainBlockStats stats; - int r; - - WEAK_SYMBOL_CHECK (virDomainBlockStats); - NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats)); - CHECK_ERROR (r == -1, conn, "virDomainBlockStats"); - - rv = caml_alloc (5, 0); - v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v); - v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v); - v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v); - v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v); - v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v); - - CAMLreturn (rv); -#else - not_supported ("virDomainBlockStats"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRDOMAININTERFACESTATS -extern int virDomainInterfaceStats (virDomainPtr dom, - const char *path, - virDomainInterfaceStatsPtr stats, - size_t size) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_domain_interface_stats (value domv, value pathv) -{ -#if HAVE_VIRDOMAININTERFACESTATS - CAMLparam2 (domv, pathv); - CAMLlocal2 (rv,v); - virDomainPtr dom = Domain_val (domv); - virConnectPtr conn = Connect_domv (domv); - char *path = String_val (pathv); - struct _virDomainInterfaceStats stats; - int r; - - WEAK_SYMBOL_CHECK (virDomainInterfaceStats); - NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats)); - CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats"); - - rv = caml_alloc (8, 0); - v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v); - v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v); - v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v); - v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v); - v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v); - v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v); - v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v); - v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v); - - CAMLreturn (rv); -#else - not_supported ("virDomainInterfaceStats"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEPOOLGETINFO -extern int virStoragePoolGetInfo(virStoragePoolPtr pool, virStoragePoolInfoPtr info) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_pool_get_info (value poolv) -{ -#if HAVE_VIRSTORAGEPOOLGETINFO - CAMLparam1 (poolv); - CAMLlocal2 (rv, v); - virStoragePoolPtr pool = Pool_val (poolv); - virConnectPtr conn = Connect_polv (poolv); - virStoragePoolInfo info; - int r; - - WEAK_SYMBOL_CHECK (virStoragePoolGetInfo); - NONBLOCKING (r = virStoragePoolGetInfo (pool, &info)); - CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo"); - - rv = caml_alloc (4, 0); - Store_field (rv, 0, Val_int (info.state)); - v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v); - v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v); - v = caml_copy_int64 (info.available); Store_field (rv, 3, v); - - CAMLreturn (rv); -#else - not_supported ("virStoragePoolGetInfo"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRSTORAGEVOLGETINFO -extern int virStorageVolGetInfo(virStorageVolPtr vol, virStorageVolInfoPtr info) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_storage_vol_get_info (value volv) -{ -#if HAVE_VIRSTORAGEVOLGETINFO - CAMLparam1 (volv); - CAMLlocal2 (rv, v); - virStorageVolPtr vol = Volume_val (volv); - virConnectPtr conn = Connect_volv (volv); - virStorageVolInfo info; - int r; - - WEAK_SYMBOL_CHECK (virStorageVolGetInfo); - NONBLOCKING (r = virStorageVolGetInfo (vol, &info)); - CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo"); - - rv = caml_alloc (3, 0); - Store_field (rv, 0, Val_int (info.type)); - v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v); - v = caml_copy_int64 (info.allocation); Store_field (rv, 1, v); - - CAMLreturn (rv); -#else - not_supported ("virStorageVolGetInfo"); -#endif -} - -#ifdef HAVE_WEAK_SYMBOLS -#ifdef HAVE_VIRJOBGETINFO -extern int virJobGetInfo(virJobPtr job, virJobInfoPtr info) - __attribute__((weak)); -#endif -#endif - -CAMLprim value -ocaml_libvirt_job_get_info (value jobv) -{ -#if HAVE_VIRJOBGETINFO - CAMLparam1 (jobv); - CAMLlocal1 (rv); - virJobPtr job = Job_val (jobv); - virConnectPtr conn = Connect_jobv (jobv); - virJobInfo info; - int r; - - WEAK_SYMBOL_CHECK (virJobGetInfo); - NONBLOCKING (r = virJobGetInfo (job, &info)); - CHECK_ERROR (r == -1, conn, "virJobGetInfo"); - - rv = caml_alloc (5, 0); - Store_field (rv, 0, Val_int (info.type)); - Store_field (rv, 1, Val_int (info.state)); - Store_field (rv, 2, Val_int (info.runningTime)); - Store_field (rv, 3, Val_int (info.remainingTime)); - Store_field (rv, 4, Val_int (info.percentComplete)); - - CAMLreturn (rv); -#else - not_supported ("virJobGetInfo"); -#endif -} - -/*----------------------------------------------------------------------*/ - -CAMLprim value -ocaml_libvirt_virterror_get_last_error (value unitv) -{ - CAMLparam1 (unitv); - CAMLlocal1 (rv); - virErrorPtr err = virGetLastError (); - - rv = Val_opt (err, (Val_ptr_t) Val_virterror); - - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_virterror_get_last_conn_error (value connv) -{ - CAMLparam1 (connv); - CAMLlocal1 (rv); - virConnectPtr conn = Connect_val (connv); - - rv = Val_opt (conn, (Val_ptr_t) Val_connect); - - CAMLreturn (rv); -} - -CAMLprim value -ocaml_libvirt_virterror_reset_last_error (value unitv) -{ - CAMLparam1 (unitv); - virResetLastError (); - CAMLreturn (Val_unit); -} - -CAMLprim value -ocaml_libvirt_virterror_reset_last_conn_error (value connv) -{ - CAMLparam1 (connv); - virConnectPtr conn = Connect_val (connv); - virConnResetLastError (conn); - CAMLreturn (Val_unit); -} - -/*----------------------------------------------------------------------*/ - -/* Initialise the library. */ -CAMLprim value -ocaml_libvirt_init (value unit) -{ - CAMLparam1 (unit); - CAMLlocal1 (rv); - int r; - - r = virInitialize (); - CHECK_ERROR (r == -1, NULL, "virInitialize"); - - CAMLreturn (Val_unit); -} diff --git a/libvirt/libvirt_c_prologue.c b/libvirt/libvirt_c_prologue.c deleted file mode 100644 index 7fe9714..0000000 --- a/libvirt/libvirt_c_prologue.c +++ /dev/null @@ -1,191 +0,0 @@ -/* OCaml bindings for libvirt. - * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - * http://libvirt.org/ - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2 of the License, or (at your option) any later version. - * - * This library 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 - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - -/* Please read libvirt/README file. */ - -static char *Optstring_val (value strv); -typedef value (*Val_ptr_t) (void *); -static value Val_opt (void *ptr, Val_ptr_t Val_ptr); -/*static value option_default (value option, value deflt);*/ -static void _raise_virterror (virConnectPtr conn, const char *fn) Noreturn; -static void not_supported (const char *fn) Noreturn; -static value Val_virterror (virErrorPtr err); - -/* Use this around synchronous libvirt API calls to release the OCaml - * lock, allowing other threads to run simultaneously. 'code' must not - * perform any caml_* calls, run any OCaml code, or raise any exception. - * http://web.archive.org/web/20030521020915/http://caml.inria.fr/archives/200106/msg00199.html - */ -#define NONBLOCKING(code) \ - do { \ - caml_enter_blocking_section (); \ - code; \ - caml_leave_blocking_section (); \ - } while (0) - -/* Check error condition from a libvirt function, and automatically raise - * an exception if one is found. - */ -#define CHECK_ERROR(cond, conn, fn) \ - do { if (cond) _raise_virterror (conn, fn); } while (0) - -/* For more about weak symbols, see: - * http://kolpackov.net/pipermail/notes/2004-March/000006.html - * We are using this to do runtime detection of library functions - * so that if we dynamically link with an older version of - * libvirt than we were compiled against, it won't fail (provided - * libvirt >= 0.2.1 - we don't support anything older). - */ -#ifdef __GNUC__ -#ifdef linux -#if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3) -#define HAVE_WEAK_SYMBOLS 1 -#endif -#endif -#endif - -#ifdef HAVE_WEAK_SYMBOLS -#define WEAK_SYMBOL_CHECK(sym) \ - do { if (!sym) not_supported(#sym); } while (0) -#else -#define WEAK_SYMBOL_CHECK(sym) -#endif /* HAVE_WEAK_SYMBOLS */ - -/*----------------------------------------------------------------------*/ - -/* Some notes about the use of custom blocks to store virConnectPtr, - * virDomainPtr and virNetworkPtr. - *------------------------------------------------------------------ - * - * Libvirt does some tricky reference counting to keep track of - * virConnectPtr's, virDomainPtr's and virNetworkPtr's. - * - * There is only one function which can return a virConnectPtr - * (virConnectOpen*) and that allocates a new one each time. - * - * virDomainPtr/virNetworkPtr's on the other hand can be returned - * repeatedly (for the same underlying domain/network), and we must - * keep track of each one and explicitly free it with virDomainFree - * or virNetworkFree. If we lose track of one then the reference - * counting in libvirt will keep it open. We therefore wrap these - * in a custom block with a finalizer function. - * - * We also have to allow the user to explicitly free them, in - * which case we set the pointer inside the custom block to NULL. - * The finalizer notices this and doesn't free the object. - * - * Domains and networks "belong to" a connection. We have to avoid - * the situation like this: - * - * let conn = Connect.open ... in - * let dom = Domain.lookup_by_id conn 0 in - * (* conn goes out of scope and is garbage collected *) - * printf "dom name = %s\n" (Domain.get_name dom) - * - * The reason is that when conn is garbage collected, virConnectClose - * is called and any subsequent operations on dom will fail (in fact - * will probably segfault). To stop this from happening, the OCaml - * wrappers store domains (and networks) as explicit (dom, conn) - * pairs. - * - * Further complication with virterror / exceptions: Virterror gives - * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we - * follow standard practice and wrap these up in blocks with - * finalizers then we'll end up double-freeing (in particular, calling - * virConnectClose at the wrong time). So for virterror, we have - * "special" wrapper functions (Val_connect_no_finalize, etc.). - * - * Update 2008/01: Storage pools and volumes work the same way as - * domains and networks. And jobs. - */ - -/* Unwrap a custom block. */ -#define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv))) -#define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv))) -#define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv))) -#ifdef HAVE_VIRSTORAGEPOOLPTR -#define Pol_val(rv) (*((virStoragePoolPtr *)Data_custom_val(rv))) -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR -#define Vol_val(rv) (*((virStorageVolPtr *)Data_custom_val(rv))) -#endif -#ifdef HAVE_VIRJOBPTR -#define Jb_val(rv) (*((virJobPtr *)Data_custom_val(rv))) -#endif - -/* Wrap up a pointer to something in a custom block. */ -static value Val_connect (virConnectPtr conn); -static value Val_dom (virDomainPtr dom); -static value Val_net (virNetworkPtr net); -#ifdef HAVE_VIRSTORAGEPOOLPTR -static value Val_pol (virStoragePoolPtr pool); -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR -static value Val_vol (virStorageVolPtr vol); -#endif -#ifdef HAVE_VIRJOBPTR -static value Val_jb (virJobPtr jb); -#endif - -/* ONLY for use by virterror wrappers. */ -static value Val_connect_no_finalize (virConnectPtr conn); -static value Val_dom_no_finalize (virDomainPtr dom); -static value Val_net_no_finalize (virNetworkPtr net); - -/* Domains and networks are stored as pairs (dom/net, conn), so have - * some convenience functions for unwrapping and wrapping them. - */ -#define Domain_val(rv) (Dom_val(Field((rv),0))) -#define Network_val(rv) (Net_val(Field((rv),0))) -#ifdef HAVE_VIRSTORAGEPOOLPTR -#define Pool_val(rv) (Pol_val(Field((rv),0))) -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR -#define Volume_val(rv) (Vol_val(Field((rv),0))) -#endif -#ifdef HAVE_VIRJOBPTR -#define Job_val(rv) (Jb_val(Field((rv),0))) -#endif -#define Connect_domv(rv) (Connect_val(Field((rv),1))) -#define Connect_netv(rv) (Connect_val(Field((rv),1))) -#ifdef HAVE_VIRSTORAGEPOOLPTR -#define Connect_polv(rv) (Connect_val(Field((rv),1))) -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR -#define Connect_volv(rv) (Connect_val(Field((rv),1))) -#endif -#ifdef HAVE_VIRJOBPTR -#define Connect_jobv(rv) (Connect_val(Field((rv),1))) -#endif - -static value Val_domain (virDomainPtr dom, value connv); -static value Val_network (virNetworkPtr net, value connv); -#ifdef HAVE_VIRSTORAGEPOOLPTR -static value Val_pool (virStoragePoolPtr pol, value connv); -#endif -#ifdef HAVE_VIRSTORAGEVOLPTR -static value Val_volume (virStorageVolPtr vol, value connv); -#endif -#ifdef HAVE_VIRJOBPTR -static value Val_job (virJobPtr jb, value connv); -#endif - -/* ONLY for use by virterror wrappers. */ -static value Val_domain_no_finalize (virDomainPtr dom, value connv); -static value Val_network_no_finalize (virNetworkPtr net, value connv); diff --git a/libvirt/libvirt_version.ml.in b/libvirt/libvirt_version.ml.in deleted file mode 100755 index ef7aea5..0000000 --- a/libvirt/libvirt_version.ml.in +++ /dev/null @@ -1,21 +0,0 @@ -(* Helper module containing the version of the OCaml bindings. - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - This library 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 - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - *) - -let package = "@PACKAGE_NAME@" -let version = "@PACKAGE_VERSION@" diff --git a/libvirt/libvirt_version.mli b/libvirt/libvirt_version.mli deleted file mode 100755 index b1755ba..0000000 --- a/libvirt/libvirt_version.mli +++ /dev/null @@ -1,25 +0,0 @@ -(** OCaml bindings for libvirt. - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - This library 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 - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) - -val package : string -val version : string -(** The name and version of the OCaml libvirt bindings. - - (To get the version of libvirt C library itself - use {!Libvirt.get_version}). *) diff --git a/mlvirsh/.depend b/mlvirsh/.depend deleted file mode 100644 index a346edd..0000000 --- a/mlvirsh/.depend +++ /dev/null @@ -1,2 +0,0 @@ -mlvirsh.cmo: ../libvirt/libvirt.cmi -mlvirsh.cmx: ../libvirt/libvirt.cmx diff --git a/mlvirsh/Makefile.in b/mlvirsh/Makefile.in deleted file mode 100644 index 197f732..0000000 --- a/mlvirsh/Makefile.in +++ /dev/null @@ -1,78 +0,0 @@ -# mlvirsh -# Copyright (C) 2007 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 -# 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. - -INSTALL := @INSTALL@ - -prefix = @prefix@ -exec_prefix = @exec_prefix@ -bindir = @bindir@ - -OCAMLFIND = @OCAMLFIND@ - -ifneq ($(OCAMLFIND),) -OCAMLCPACKAGES := -package unix -I ../libvirt -OCAMLCFLAGS := -g -OCAMLCLIBS := -linkpkg -OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) -OCAMLOPTFLAGS := -OCAMLOPTLIBS := $(OCAMLCLIBS) -else -OCAMLCINCS := -I ../libvirt -OCAMLCFLAGS := -g -OCAMLCLIBS := unix.cma -OCAMLOPTINCS := $(OCAMLCINCS) -OCAMLOPTFLAGS := -OCAMLOPTLIBS := unix.cmxa -endif - -export LIBRARY_PATH=../libvirt -export LD_LIBRARY_PATH=../libvirt - -BYTE_TARGETS := mlvirsh -OPT_TARGETS := mlvirsh.opt - -all: $(BYTE_TARGETS) - -opt: $(OPT_TARGETS) - -ifneq ($(OCAMLFIND),) -mlvirsh: mlvirsh.cmo - $(OCAMLFIND) ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma -o $@ $< - -mlvirsh.opt: mlvirsh.cmx - $(OCAMLFIND) ocamlopt \ - $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa -o $@ $< -else -mlvirsh: mlvirsh.cmo - $(OCAMLC) $(OCAMLCINCS) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma -o $@ $< - -mlvirsh.opt: mlvirsh.cmx - $(OCAMLOPT) \ - $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa -o $@ $< -endif - -install: - if [ -x mlvirsh.opt ]; then \ - mkdir -p $(DESTDIR)$(bindir); \ - $(INSTALL) -m 0755 mlvirsh.opt $(DESTDIR)$(bindir)/mlvirsh; \ - fi - -include ../Make.rules diff --git a/mlvirsh/mlvirsh.ml b/mlvirsh/mlvirsh.ml deleted file mode 100644 index 8052506..0000000 --- a/mlvirsh/mlvirsh.ml +++ /dev/null @@ -1,764 +0,0 @@ -(* virsh-like command line tool. - (C) Copyright 2007 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. -*) - -open Printf - -module C = Libvirt.Connect -module D = Libvirt.Domain -module N = Libvirt.Network - -(* Program name. *) -let program_name = Filename.basename Sys.executable_name - -(* Parse arguments. *) -let name = ref "" -let readonly = ref false - -let argspec = Arg.align [ - "-c", Arg.Set_string name, "URI Hypervisor connection URI"; - "-r", Arg.Set readonly, " Read-only connection"; -] - -let usage_msg = "\ -Synopsis: - " ^ program_name ^ " [options] [command] - -List of all commands: - " ^ program_name ^ " help - -Full description of a single command: - " ^ program_name ^ " help command - -Options:" - -let add_extra_arg, get_extra_args = - let extra_args = ref [] in - let add_extra_arg s = extra_args := s :: !extra_args in - let get_extra_args () = List.rev !extra_args in - add_extra_arg, get_extra_args - -let () = Arg.parse argspec add_extra_arg usage_msg - -let name = match !name with "" -> None | name -> Some name -let readonly = !readonly -let extra_args = get_extra_args () - -(* Read a whole file into memory and return it (as a string). *) -let rec input_file filename = - let chan = open_in_bin filename in - let data = input_all chan in - close_in chan; - data -and input_all chan = - let buf = Buffer.create 16384 in - let tmpsize = 16384 in - let tmp = String.create tmpsize in - let n = ref 0 in - while n := input chan tmp 0 tmpsize; !n > 0 do - Buffer.add_substring buf tmp 0 !n; - done; - Buffer.contents buf - -(* Split a string at a separator. - * Functions copied from extlib Copyright (C) 2003 Nicolas Cannasse et al. - * to avoid the explicit dependency on extlib. - *) -let str_find str sub = - let sublen = String.length sub in - if sublen = 0 then - 0 - else - let found = ref 0 in - let len = String.length str in - try - for i = 0 to len - sublen do - let j = ref 0 in - while String.unsafe_get str (i + !j) = String.unsafe_get sub !j do - incr j; - if !j = sublen then begin found := i; raise Exit; end; - done; - done; - raise Not_found - with - Exit -> !found - -let str_split str sep = - let p = str_find str sep in - let len = String.length sep in - let slen = String.length str in - String.sub str 0 p, String.sub str (p + len) (slen - p - len) - -let str_nsplit str sep = - if str = "" then [] - else ( - let rec nsplit str sep = - try - let s1 , s2 = str_split str sep in - s1 :: nsplit s2 sep - with - Not_found -> [str] - in - nsplit str sep - ) - -(* Hypervisor connection. *) -type conn_t = No_connection | RO of Libvirt.ro C.t | RW of Libvirt.rw C.t -let conn = ref No_connection - -let close_connection () = - match !conn with - | No_connection -> () - | RO c -> - C.close c; - conn := No_connection - | RW c -> - C.close c; - conn := No_connection - -let do_command = - (* Command helper functions. - * - * Each cmd is a function that constructs a command. - * string string string ... <--- user types on the command line - * | | | - * arg1 arg2 arg3 ... <--- conversion functions - * | | | - * V V V - * function f <--- work function - * | - * V - * print result <--- printing function - * - * (Note that cmd function constructs and returns the above - * function, it isn't the function itself.) - * - * Example: If the function takes one parameter (an int) and - * returns a string to be printed, you would use: - * - * cmd1 print_endline f int_of_string - *) - let cmd0 print fn = function (* Command with no args. *) - | [] -> print (fn ()) - | _ -> failwith "incorrect number of arguments for function" - in - let cmd1 print fn arg1 = function (* Command with one arg. *) - | [str1] -> print (fn (arg1 str1)) - | _ -> failwith "incorrect number of arguments for function" - in - let cmd2 print fn arg1 arg2 = function (* Command with 2 args. *) - | [str1; str2] -> print (fn (arg1 str1) (arg2 str2)) - | _ -> failwith "incorrect number of arguments for function" - in - let cmd3 print fn arg1 arg2 arg3 = function (* Command with 3 args. *) - | [str1; str2; str3] -> print (fn (arg1 str1) (arg2 str2) (arg3 str3)) - | _ -> failwith "incorrect number of arguments for function" - in - let cmd01 print fn arg1 = function (* Command with 0 or 1 arg. *) - | [] -> print (fn None) - | [str1] -> print (fn (Some (arg1 str1))) - | _ -> failwith "incorrect number of arguments for function" - in - let cmd12 print fn arg1 arg2 = function (* Command with 1 or 2 args. *) - | [str1] -> print (fn (arg1 str1) None) - | [str1; str2] -> print (fn (arg1 str1) (Some (arg2 str2))) - | _ -> failwith "incorrect number of arguments for function" - in - let cmd012 print fn arg1 arg2 = function (* Command with 0, 1 or 2 args. *) - | [] -> print (fn None None) - | [str1] -> print (fn (Some (arg1 str1)) None) - | [str1; str2] -> print (fn (Some (arg1 str1)) (Some (arg2 str2))) - | _ -> failwith "incorrect number of arguments for function" - in - let cmdN print fn = (* Command with any number of args. *) - fun args -> print (fn args) - in - - (* Get the connection or fail if we don't have one. *) - let rec get_full_connection () = - match !conn with - | No_connection -> failwith "not connected to the hypervisor" - | RO _ -> failwith "tried to do read-write operation on read-only hypervisor connection" - | RW conn -> conn - and get_readonly_connection () = - match !conn with - | No_connection -> failwith "not connected to the hypervisor" - | RO conn -> conn - | RW conn -> C.const conn -(* - and with_full_connection fn = - fun () -> fn (get_full_connection ()) -*) - and with_readonly_connection fn = - fun () -> fn (get_readonly_connection ()) - and arg_full_connection fn = - fun str -> fn (get_full_connection ()) str - and arg_readonly_connection fn = - fun str -> fn (get_readonly_connection ()) str - in - - (* Parsing of command arguments. *) - let string_of_readonly = function - | "readonly" | "read-only" | "ro" -> true - | _ -> failwith "flag should be 'readonly'" - in - let string_of_string (str : string) = str in - let boolean_of_string = function - | "enable" | "enabled" | "on" | "1" | "true" -> true - | "disable" | "disabled" | "off" | "0" | "false" -> false - | _ -> failwith "setting should be 'on' or 'off'" - in - let domain_of_string conn str = - try - (try - let id = int_of_string str in - D.lookup_by_id conn id - with - Failure "int_of_string" -> - if String.length str = Libvirt.uuid_string_length then - D.lookup_by_uuid_string conn str - else - D.lookup_by_name conn str - ) - with - Libvirt.Virterror err -> - failwith ("domain " ^ str ^ ": not found. Additional info: " ^ - Libvirt.Virterror.to_string err); - in - let network_of_string conn str = - try - if String.length str = Libvirt.uuid_string_length then - N.lookup_by_uuid_string conn str - else - N.lookup_by_name conn str - with - Libvirt.Virterror err -> - failwith ("network " ^ str ^ ": not found. Additional info: " ^ - Libvirt.Virterror.to_string err); - in - let rec parse_sched_params = function - | [] -> [] - | [_] -> failwith "expected field value pairs, but got an odd number of arguments" - | field :: value :: rest -> - (* XXX We only support the UINT type at the moment. *) - (field, D.SchedFieldUInt32 (Int32.of_string value)) - :: parse_sched_params rest - in - let cpumap_of_string str = - let c = get_readonly_connection () in - let info = C.get_node_info c in - let cpumap = - String.make (C.cpumaplen (C.maxcpus_of_node_info info)) '\000' in - List.iter (C.use_cpu cpumap) - (List.map int_of_string (str_nsplit str ",")); - cpumap - in - - (* Printing of command results. *) - let no_return _ = () in - let print_int i = print_endline (string_of_int i) in - let print_int64 i = print_endline (Int64.to_string i) in - let print_int64_array a = Array.iter print_int64 a in - let print_bool b = print_endline (string_of_bool b) in - let print_version v = - let major = v / 1000000 in - let minor = (v - major * 1000000) / 1000 in - let release = (v - major * 1000000 - minor * 1000) in - printf "%d.%d.%d\n" major minor release - in - let string_of_domain_state = function - | D.InfoNoState -> "unknown" - | D.InfoRunning -> "running" - | D.InfoBlocked -> "blocked" - | D.InfoPaused -> "paused" - | D.InfoShutdown -> "shutdown" - | D.InfoShutoff -> "shutoff" - | D.InfoCrashed -> "crashed" - in - let string_of_vcpu_state = function - | D.VcpuOffline -> "offline" - | D.VcpuRunning -> "running" - | D.VcpuBlocked -> "blocked" - in - let print_domain_array doms = - Array.iter ( - fun dom -> - let id = - try sprintf "%d" (D.get_id dom) - with Libvirt.Virterror _ -> "" in - let name = - try sprintf "%s" (D.get_name dom) - with Libvirt.Virterror _ -> "" in - let state = - try - let { D.state = state } = D.get_info dom in - string_of_domain_state state - with Libvirt.Virterror _ -> "" in - printf "%5s %-30s %s\n" id name state - ) doms - in - let print_network_array nets = - Array.iter ( - fun net -> - printf "%s\n" (N.get_name net) - ) nets - in - let print_node_info info = - printf "model: %s\n" info.C.model; - printf "memory: %Ld K\n" info.C.memory; - printf "cpus: %d\n" info.C.cpus; - printf "mhz: %d\n" info.C.mhz; - printf "nodes: %d\n" info.C.nodes; - printf "sockets: %d\n" info.C.sockets; - printf "cores: %d\n" info.C.cores; - printf "threads: %d\n" info.C.threads; - in - let print_domain_state { D.state = state } = - print_endline (string_of_domain_state state) - in - let print_domain_info info = - printf "state: %s\n" (string_of_domain_state info.D.state); - printf "max_mem: %Ld K\n" info.D.max_mem; - printf "memory: %Ld K\n" info.D.memory; - printf "nr_virt_cpu: %d\n" info.D.nr_virt_cpu; - printf "cpu_time: %Ld ns\n" info.D.cpu_time; - in - let print_sched_param_array params = - Array.iter ( - fun (name, value) -> - printf "%-20s" name; - match value with - | D.SchedFieldInt32 i -> printf " %ld\n" i - | D.SchedFieldUInt32 i -> printf " %lu\n" i - | D.SchedFieldInt64 i -> printf " %Ld\n" i - | D.SchedFieldUInt64 i -> printf " %Lu\n" i - | D.SchedFieldFloat f -> printf " %g\n" f - | D.SchedFieldBool b -> printf " %b\n" b - ) params - in - let print_vcpu_info (ncpus, vcpu_infos, cpumaps, maplen, maxcpus) = - for n = 0 to ncpus-1 do - printf "virtual CPU: %d\n" n; - printf " on physical CPU: %d\n" vcpu_infos.(n).D.cpu; - printf " current state: %s\n" - (string_of_vcpu_state vcpu_infos.(n).D.vcpu_state); - printf " CPU time: %Ld ns\n" vcpu_infos.(n).D.vcpu_time; - printf " CPU affinity: "; - for m = 0 to maxcpus-1 do - print_char (if C.cpu_usable cpumaps maplen n m then 'y' else '-') - done; - print_endline ""; - done - in - let print_block_stats { D.rd_req = rd_req; rd_bytes = rd_bytes; - wr_req = wr_req; wr_bytes = wr_bytes; - errs = errs } = - if rd_req >= 0L then printf "read requests: %Ld\n" rd_req; - if rd_bytes >= 0L then printf "read bytes: %Ld\n" rd_bytes; - if wr_req >= 0L then printf "write requests: %Ld\n" wr_req; - if wr_bytes >= 0L then printf "write bytes: %Ld\n" wr_bytes; - if errs >= 0L then printf "errors: %Ld\n" errs; - and print_interface_stats { D.rx_bytes = rx_bytes; rx_packets = rx_packets; - rx_errs = rx_errs; rx_drop = rx_drop; - tx_bytes = tx_bytes; tx_packets = tx_packets; - tx_errs = tx_errs; tx_drop = tx_drop } = - if rx_bytes >= 0L then printf "rx bytes: %Ld\n" rx_bytes; - if rx_packets >= 0L then printf "rx packets: %Ld\n" rx_packets; - if rx_errs >= 0L then printf "rx errs: %Ld\n" rx_errs; - if rx_drop >= 0L then printf "rx dropped: %Ld\n" rx_drop; - if tx_bytes >= 0L then printf "tx bytes: %Ld\n" tx_bytes; - if tx_packets >= 0L then printf "tx packets: %Ld\n" tx_packets; - if tx_errs >= 0L then printf "tx errs: %Ld\n" tx_errs; - if tx_drop >= 0L then printf "tx dropped: %Ld\n" tx_drop; - in - - (* List of commands. *) - let commands = [ - "attach-device", - cmd2 no_return D.attach_device - (arg_full_connection domain_of_string) input_file, - "Attach device to domain."; - "autostart", - cmd2 no_return D.set_autostart - (arg_full_connection domain_of_string) boolean_of_string, - "Set whether a domain autostarts at boot."; - "capabilities", - cmd0 print_endline (with_readonly_connection C.get_capabilities), - "Returns capabilities of hypervisor/driver."; - "close", - cmd0 no_return close_connection, - "Close an existing hypervisor connection."; - "connect", - cmd12 no_return - (fun name readonly -> - close_connection (); - match readonly with - | None | Some false -> conn := RW (C.connect ~name ()) - | Some true -> conn := RO (C.connect_readonly ~name ()) - ) string_of_string string_of_readonly, - "Open a new hypervisor connection."; - "create", - cmd1 no_return - (fun xml -> D.create_linux (get_full_connection ()) xml) input_file, - "Create a domain from an XML file."; - "define", - cmd1 no_return - (fun xml -> D.define_xml (get_full_connection ()) xml) input_file, - "Define (but don't start) a domain from an XML file."; - "detach-device", - cmd2 no_return D.detach_device - (arg_full_connection domain_of_string) input_file, - "Detach device from domain."; - "destroy", - cmd1 no_return D.destroy (arg_full_connection domain_of_string), - "Destroy a domain."; - "domblkstat", - cmd2 print_block_stats D.block_stats - (arg_readonly_connection domain_of_string) string_of_string, - "Display the block device statistics for a domain."; - "domid", - cmd1 print_int D.get_id (arg_readonly_connection domain_of_string), - "Print the ID of a domain."; - "domifstat", - cmd2 print_interface_stats D.interface_stats - (arg_readonly_connection domain_of_string) string_of_string, - "Display the network interface statistics for a domain."; - "dominfo", - cmd1 print_domain_info D.get_info - (arg_readonly_connection domain_of_string), - "Print the domain info."; - "dommaxmem", - cmd1 print_int64 D.get_max_memory - (arg_readonly_connection domain_of_string), - "Print the max memory (in kilobytes) of a domain."; - "dommaxvcpus", - cmd1 print_int D.get_max_vcpus - (arg_readonly_connection domain_of_string), - "Print the max VCPUs of a domain."; - "domname", - cmd1 print_endline D.get_name - (arg_readonly_connection domain_of_string), - "Print the name of a domain."; - "domostype", - cmd1 print_endline D.get_os_type - (arg_readonly_connection domain_of_string), - "Print the OS type of a domain."; - "domstate", - cmd1 print_domain_state D.get_info - (arg_readonly_connection domain_of_string), - "Print the domain state."; - "domuuid", - cmd1 print_endline D.get_uuid_string - (arg_readonly_connection domain_of_string), - "Print the UUID of a domain."; - "dump", - cmd2 no_return D.core_dump - (arg_full_connection domain_of_string) string_of_string, - "Core dump a domain to a file for analysis."; - "dumpxml", - cmd1 print_endline D.get_xml_desc - (arg_full_connection domain_of_string), - "Print the XML description of a domain."; - "freecell", - cmd012 print_int64_array ( - fun start max -> - let conn = get_readonly_connection () in - match start, max with - | None, _ -> - [| C.node_get_free_memory conn |] - | Some start, None -> - C.node_get_cells_free_memory conn start 1 - | Some start, Some max -> - C.node_get_cells_free_memory conn start max - ) int_of_string int_of_string, - "Display free memory for machine, NUMA cell or range of cells"; - "get-autostart", - cmd1 print_bool D.get_autostart - (arg_readonly_connection domain_of_string), - "Print whether a domain autostarts at boot."; - "hostname", - cmd0 print_endline (with_readonly_connection C.get_hostname), - "Print the hostname."; - "list", - cmd0 print_domain_array - (fun () -> - let c = get_readonly_connection () in - let n = C.num_of_domains c in - let domids = C.list_domains c n in - Array.map (D.lookup_by_id c) domids), - "List the running domains."; - "list-defined", - cmd0 print_domain_array - (fun () -> - let c = get_readonly_connection () in - let n = C.num_of_defined_domains c in - let domnames = C.list_defined_domains c n in - Array.map (D.lookup_by_name c) domnames), - "List the defined but not running domains."; - "quit", - cmd0 no_return (fun () -> exit 0), - "Quit the interactive terminal."; - "maxvcpus", - cmd0 print_int (fun () -> C.get_max_vcpus (get_readonly_connection ()) ()), - "Print the max VCPUs available."; - "net-autostart", - cmd2 no_return N.set_autostart - (arg_full_connection network_of_string) boolean_of_string, - "Set whether a network autostarts at boot."; - "net-bridgename", - cmd1 print_endline N.get_bridge_name - (arg_readonly_connection network_of_string), - "Print the bridge name of a network."; - "net-create", - cmd1 no_return - (fun xml -> N.create_xml (get_full_connection ()) xml) input_file, - "Create a network from an XML file."; - "net-define", - cmd1 no_return - (fun xml -> N.define_xml (get_full_connection ()) xml) input_file, - "Define (but don't start) a network from an XML file."; - "net-destroy", - cmd1 no_return N.destroy (arg_full_connection network_of_string), - "Destroy a network."; - "net-dumpxml", - cmd1 print_endline N.get_xml_desc - (arg_full_connection network_of_string), - "Print the XML description of a network."; - "net-get-autostart", - cmd1 print_bool N.get_autostart - (arg_full_connection network_of_string), - "Print whether a network autostarts at boot."; - "net-list", - cmd0 print_network_array - (fun () -> - let c = get_readonly_connection () in - let n = C.num_of_networks c in - let nets = C.list_networks c n in - Array.map (N.lookup_by_name c) nets), - "List the active networks."; - "net-list-defined", - cmd0 print_network_array - (fun () -> - let c = get_readonly_connection () in - let n = C.num_of_defined_networks c in - let nets = C.list_defined_networks c n in - Array.map (N.lookup_by_name c) nets), - "List the defined but inactive networks."; - "net-name", - cmd1 print_endline N.get_name - (arg_readonly_connection network_of_string), - "Print the name of a network."; - "net-start", - cmd1 no_return N.create - (arg_full_connection network_of_string), - "Start a previously defined inactive network."; - "net-undefine", - cmd1 no_return N.undefine - (arg_full_connection network_of_string), - "Undefine an inactive network."; - "net-uuid", - cmd1 print_endline N.get_uuid_string - (arg_readonly_connection network_of_string), - "Print the UUID of a network."; - "nodeinfo", - cmd0 print_node_info (with_readonly_connection C.get_node_info), - "Print node information."; - "reboot", - cmd1 no_return D.reboot (arg_full_connection domain_of_string), - "Reboot a domain."; - "restore", - cmd1 no_return ( - fun path -> D.restore (get_full_connection ()) path - ) string_of_string, - "Restore a domain from the named file."; - "resume", - cmd1 no_return D.resume (arg_full_connection domain_of_string), - "Resume a domain."; - "save", - cmd2 no_return D.save - (arg_full_connection domain_of_string) string_of_string, - "Save a domain to a file."; - "schedparams", - cmd1 print_sched_param_array ( - fun dom -> - let n = snd (D.get_scheduler_type dom) in - D.get_scheduler_parameters dom n - ) (arg_readonly_connection domain_of_string), - "Get the current scheduler parameters for a domain."; - "schedparamset", - cmdN no_return ( - function - | [] -> failwith "expecting domain followed by field value pairs" - | dom :: pairs -> - let conn = get_full_connection () in - let dom = domain_of_string conn dom in - let params = parse_sched_params pairs in - let params = Array.of_list params in - D.set_scheduler_parameters dom params - ), - "Set the scheduler parameters for a domain."; - "schedtype", - cmd1 print_endline - (fun dom -> fst (D.get_scheduler_type dom)) - (arg_readonly_connection domain_of_string), - "Get the scheduler type."; - "setmem", - cmd2 no_return D.set_memory - (arg_full_connection domain_of_string) Int64.of_string, - "Set the memory used by the domain (in kilobytes)."; - "setmaxmem", - cmd2 no_return D.set_max_memory - (arg_full_connection domain_of_string) Int64.of_string, - "Set the maximum memory used by the domain (in kilobytes)."; - "shutdown", - cmd1 no_return D.shutdown - (arg_full_connection domain_of_string), - "Gracefully shutdown a domain."; - "start", - cmd1 no_return D.create - (arg_full_connection domain_of_string), - "Start a previously defined inactive domain."; - "suspend", - cmd1 no_return D.suspend - (arg_full_connection domain_of_string), - "Suspend a domain."; - "type", - cmd0 print_endline (with_readonly_connection C.get_type), - "Print the driver name"; - "undefine", - cmd1 no_return D.undefine - (arg_full_connection domain_of_string), - "Undefine an inactive domain."; - "uri", - cmd0 print_endline (with_readonly_connection C.get_uri), - "Print the canonical URI."; - "vcpuinfo", - cmd1 print_vcpu_info ( - fun dom -> - let c = get_readonly_connection () in - let info = C.get_node_info c in - let dominfo = D.get_info dom in - let maxcpus = C.maxcpus_of_node_info info in - let maplen = C.cpumaplen maxcpus in - let maxinfo = dominfo.D.nr_virt_cpu in - let ncpus, vcpu_infos, cpumaps = D.get_vcpus dom maxinfo maplen in - ncpus, vcpu_infos, cpumaps, maplen, maxcpus - ) (arg_readonly_connection domain_of_string), - "Pin domain VCPU to a list of physical CPUs."; - "vcpupin", - cmd3 no_return D.pin_vcpu - (arg_full_connection domain_of_string) int_of_string cpumap_of_string, - "Pin domain VCPU to a list of physical CPUs."; - "vcpus", - cmd2 no_return D.set_vcpus - (arg_full_connection domain_of_string) int_of_string, - "Set the number of virtual CPUs assigned to a domain."; - "version", - cmd0 print_version (with_readonly_connection C.get_version), - "Print the driver version"; - ] in - - (* Command help. *) - let help = function - | None -> (* List of commands. *) - String.concat "\n" ( - List.map ( - fun (cmd, _, description) -> - sprintf "%-12s %s" cmd description - ) commands - ) ^ - "\n\nUse '" ^ program_name ^ " help command' for help on a command." - - | Some command -> (* Full description of one command. *) - try - let (command, _, description) = - List.find (fun (c, _, _) -> c = command) commands in - sprintf "%s %s\n\n%s" program_name command description - with - Not_found -> - failwith ("help: " ^ command ^ ": command not found"); - in - - let commands = - ("help", - cmd01 print_endline help string_of_string, - "Print list of commands or full description of one command."; - ) :: commands in - - (* Execute a command. *) - let do_command command args = - try - let (_, cmd, _) = List.find (fun (c, _, _) -> c = command) commands in - cmd args - with - Not_found -> - failwith (command ^ ": command not found"); - in - - do_command - -(* Interactive mode. *) -let rec interactive_mode () = - let prompt = - match !conn with - | No_connection -> "mlvirsh(no connection)$ " - | RO _ -> "mlvirsh(ro)$ " - | RW _ -> "mlvirsh# " in - print_string prompt; - let command = read_line () in - (match str_nsplit command " " with - | [] -> () - | command :: args -> - do_command command args - ); - Gc.full_major (); (* Free up all unreachable domain and network objects. *) - interactive_mode () - -(* Connect to hypervisor. Allow the connection to fail. *) -let () = - conn := - try - if readonly then RO (C.connect_readonly ?name ()) - else RW (C.connect ?name ()) - with - Libvirt.Virterror err -> - eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err); - No_connection - -let () = - try - (* Execute the command on the command line, if there was one. - * Otherwise go into interactive mode. - *) - (match extra_args with - | command :: args -> - do_command command args - | [] -> - try interactive_mode () with End_of_file -> () - ); - - (* If we are connected to a hypervisor, close the connection. *) - close_connection (); - - (* A good way to find heap bugs: *) - Gc.compact () - with - | Libvirt.Virterror err -> - eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err) - | Failure msg -> - eprintf "%s: %s\n" program_name msg diff --git a/po/LINGUAS b/po/LINGUAS new file mode 100644 index 0000000..ffff11a --- /dev/null +++ b/po/LINGUAS @@ -0,0 +1,2 @@ +ja +pl diff --git a/po/Makefile.in b/po/Makefile.in new file mode 100644 index 0000000..9398e2f --- /dev/null +++ b/po/Makefile.in @@ -0,0 +1,79 @@ +# Makefile for po subdirectory. +# @configure_input@ +# +# Copyright (C) 2007-2008 Red Hat Inc. +# Written by 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 +# 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +OCAML_GETTEXT_PACKAGE = virt-top +LINGUAS = $(shell cat LINGUAS) +SOURCES = POTFILES + +OCAML_GETTEXT = @OCAML_GETTEXT@ +OCAML_GETTEXT_EXTRACT_OPTIONS = +OCAML_GETTEXT_COMPILE_OPTIONS = +OCAML_GETTEXT_INSTALL_OPTIONS = +OCAML_GETTEXT_MERGE_OPTIONS = + +PODIR = @prefix@/share/locale + +POFILES = $(addsuffix .po,$(LINGUAS)) +MOFILES = $(addsuffix .mo,$(LINGUAS)) +POTFILE = $(OCAML_GETTEXT_PACKAGE).pot + +all: $(MOFILES) $(POTFILE) + +install: install-po + +uninstall: uninstall-po + +clean:: clean-po + +%.mo: %.po + $(OCAML_GETTEXT) --action compile $(OCAML_GETTEXT_COMPILE_OPTIONS) \ + --compile-output $@ $^ + +%.pot: $(SOURCES) $(shell cat $(SOURCES)) + $(OCAML_GETTEXT) --action extract $(OCAML_GETTEXT_EXTRACT_OPTIONS) \ + --extract-pot $@ $< + +# Also includes a fix for incorrectly escaped multi-byte sequences. +%.po: $(POTFILE) + $(OCAML_GETTEXT) --action merge $(OCAML_GETTEXT_MERGE_OPTIONS) \ + --merge-pot $(POTFILE) $@ + mv $@ $@.orig + perl -wpe 's/\\(\d{3})/pack "C*", $$1/ge' < $@.orig > $@ + +$(BUILDPO): + mkdir -p $(BUILDPO) + +.PRECIOUS: $(POTFILE) + +install-po: $(MOFILES) + $(OCAML_GETTEXT) --action install $(OCAML_GETTEXT_INSTALL_OPTIONS) \ + --install-textdomain $(OCAML_GETTEXT_PACKAGE) \ + --install-destdir $(PODIR) $(MOFILES) + +uninstall-po: + $(OCAML_GETTEXT) --action uninstall $(OCAML_GETTEXT_INSTALL_OPTIONS) \ + --uninstall-textdomain $(OCAML_GETTEXT_PACKAGE) \ + --uninstall-orgdir $(PODIR) $(MOFILES) + +clean-po: + -$(OCAML_GETTEXT) --action uninstall $(OCAML_GETTEXT_INSTALL_OPTIONS) \ + --uninstall-textdomain $(OCAML_GETTEXT_PACKAGE) \ + --uninstall-orgdir $(BUILDPO) $(MOFILES) + -$(RM) $(MOFILES) diff --git a/po/POTFILES b/po/POTFILES new file mode 100644 index 0000000..938a847 --- /dev/null +++ b/po/POTFILES @@ -0,0 +1,22 @@ +../mlvirsh/mlvirsh.ml +../virt-ctrl/mingw-gcc-wrapper.ml +../virt-ctrl/vc_connection_dlg.ml +../virt-ctrl/vc_connections.ml +../virt-ctrl/vc_dbus.ml +../virt-ctrl/vc_domain_ops.ml +../virt-ctrl/vc_helpers.ml +../virt-ctrl/vc_icons.ml +../virt-ctrl/vc_mainwindow.ml +../virt-ctrl/virt_ctrl.ml +../virt-df/virt_df_ext2.ml +../virt-df/virt_df_linux_swap.ml +../virt-df/virt_df_lvm2.ml +../virt-df/virt_df_main.ml +../virt-df/virt_df.ml +../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 diff --git a/po/ja.po b/po/ja.po new file mode 100644 index 0000000..ebef7a4 --- /dev/null +++ b/po/ja.po @@ -0,0 +1,1017 @@ +msgid "" +msgstr "" +"Project-Id-Version: virt-p2v--devel\n" +"Report-Msgid-Bugs-To: rjones@redhat.com\n" +"POT-Creation-Date: 2008-03-22 15:53+0000\n" +"PO-Revision-Date: 2008-03-28 17:00+0000\n" +"Last-Translator: Naoko - \n" +"Language-Team: Japanese\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=1; plural=0;\n" + +#: ../virt-top/virt_top.ml:1490 +msgid "# .virt-toprc virt-top configuration file\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:1508 +msgid "# Enable CSV output to the named file\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:1511 +msgid "# To protect this file from being overwritten, uncomment next line\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:1505 +msgid "# To send debug and error messages to a file, uncomment next line\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:1491 +msgid "# generated on %s by %s\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:63 +msgid "%CPU" +msgstr "" + +#: ../virt-top/virt_top.ml:64 +msgid "%MEM" +msgstr "" + +#: ../virt-top/virt_top.ml:1144 +msgid "%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:716 +msgid "%s: command not found" +msgstr "" + +#: ../virt-top/virt_top.ml:105 +msgid "%s: display should be %s" +msgstr "" + +#: ../virt-top/virt_top.ml:82 +msgid "%s: sort order should be: %s" +msgstr "" + +#: ../virt-top/virt_top.ml:202 ../virt-df/virt_df.ml:362 +msgid "%s: unknown parameter" +msgstr "" + +#: ../virt-top/virt_top.ml:233 +msgid "%s:%d: configuration item ``%s'' ignored\\n%!" +msgstr "" + +#: ../virt-df/virt_df.ml:514 +msgid "(device omitted)" +msgstr "" + +#: ../virt-top/virt_top.ml:145 +msgid "-d: cannot set a negative delay" +msgstr "" + +#: ../virt-df/virt_df.ml:498 +msgid "1K-blocks" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:97 +msgid "About ..." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:399 +msgid "Attach device to domain." +msgstr "" + +#: ../virt-df/virt_df.ml:498 ../virt-df/virt_df.ml:499 +msgid "Available" +msgstr "" + +#: ../virt-top/virt_top.ml:167 +msgid "Batch mode" +msgstr "" + +#: ../virt-top/virt_top.ml:70 +msgid "Block read reqs" +msgstr "" + +#: ../virt-top/virt_top.ml:71 +msgid "Block write reqs" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:408 +msgid "CPU" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:365 +msgid "CPU affinity" +msgstr "" + +#: ../virt-top/virt_top.ml:1151 +msgid "CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:182 +msgid "Cancel" +msgstr "" + +#: ../virt-top/virt_top.ml:1319 +msgid "Change delay from %.1f to: " +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:409 +msgid "Close an existing hypervisor connection." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:118 +msgid "Connect ..." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:160 +msgid "Connect to ..." +msgstr "" + +#: ../virt-top/virt_top.ml:169 ../virt-top/virt_top.ml:171 ../virt-df/virt_df.ml:346 ../virt-df/virt_df.ml:348 +msgid "Connect to URI (default: Xen)" +msgstr "" + +#: ../virt-top/virt_top.ml:1558 +msgid "Connect: %s; Hostname: %s" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:476 +msgid "Core dump a domain to a file for analysis." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:422 +msgid "Create a domain from an XML file." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:534 +msgid "Create a network from an XML file." +msgstr "" + +#: ../virt-top/virt_top.ml:1596 +msgid "DISPLAY MODES" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:426 +msgid "Define (but don't start) a domain from an XML file." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:538 +msgid "Define (but don't start) a network from an XML file." +msgstr "" + +#: ../virt-top/virt_top.ml:1326 +msgid "Delay must be > 0" +msgstr "" + +#: ../virt-top/virt_top.ml:181 +msgid "Delay time interval (seconds)" +msgstr "" + +#: ../virt-top/virt_top.ml:1552 +msgid "Delay: %.1f secs; Batch: %s; Secure: %s; Sort: %s" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:433 +msgid "Destroy a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:541 +msgid "Destroy a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:430 +msgid "Detach device from domain." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:123 +msgid "Details" +msgstr "" + +#: ../virt-top/virt_top.ml:175 +msgid "Disable CPU stats in CSV" +msgstr "" + +#: ../virt-top/virt_top.ml:177 +msgid "Disable block device stats in CSV" +msgstr "" + +#: ../virt-top/virt_top.ml:179 +msgid "Disable net stats in CSV" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:493 +msgid "Display free memory for machine, NUMA cell or range of cells" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:437 +msgid "Display the block device statistics for a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:444 +msgid "Display the network interface statistics for a domain." +msgstr "" + +#: ../virt-df/virt_df.ml:358 +msgid "Display version and exit" +msgstr "" + +#: ../virt-top/virt_top.ml:191 +msgid "Do not read init file" +msgstr "" + +#: ../virt-top/virt_top.ml:66 +msgid "Domain ID" +msgstr "" + +#: ../virt-top/virt_top.ml:67 +msgid "Domain name" +msgstr "" + +#: ../virt-top/virt_top.ml:1610 +msgid "Domains display" +msgstr "" + +#: ../virt-top/virt_top.ml:1528 ../virt-top/virt_top_main.ml:47 ../virt-ctrl/vc_mainwindow.ml:61 +msgid "Error" +msgstr "エラー" + +#: ../virt-top/virt_top.ml:185 +msgid "Exit at given time" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:79 +msgid "File" +msgstr "ファイル" + +#: ../virt-df/virt_df.ml:502 +msgid "Filesystem" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:606 +msgid "Get the current scheduler parameters for a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:623 +msgid "Get the scheduler type." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:635 +msgid "Gracefully shutdown a domain." +msgstr "" + +#: ../virt-top/virt_top.ml:1580 ../virt-ctrl/vc_mainwindow.ml:80 ../virt-ctrl/vc_mainwindow.ml:96 +msgid "Help" +msgstr "" + +#: ../virt-top/virt_top.ml:187 +msgid "Historical CPU delay" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:35 +msgid "Hypervisor connection URI" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:405 +msgid "ID" +msgstr "" + +#: ../virt-df/virt_df.ml:500 +msgid "IFree" +msgstr "" + +#: ../virt-df/virt_df.ml:500 +msgid "IUse" +msgstr "" + +#: ../virt-df/virt_df.ml:500 +msgid "Inodes" +msgstr "" + +#: ../virt-df/virt_df_lvm2.ml:33 +msgid "LVM2 not supported yet" +msgstr "" + +#: ../virt-df/virt_df_ext2.ml:82 +msgid "Linux ext2/3" +msgstr "" + +#: ../virt-df/virt_df_linux_swap.ml:33 +msgid "Linux swap" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:557 +msgid "List the active networks." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:565 +msgid "List the defined but inactive networks." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:516 +msgid "List the defined but not running domains." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:508 +msgid "List the running domains." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:158 +msgid "Local QEMU/KVM" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:157 +msgid "Local Xen" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:93 +msgid "Local network" +msgstr "" + +#: ../virt-top/virt_top.ml:173 +msgid "Log statistics to CSV file" +msgstr "" + +#: ../virt-top/virt_top.ml:1563 +msgid "MAIN KEYS" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:409 +msgid "Memory" +msgstr "" + +#: ../virt-top/virt_top.ml:1617 +msgid "More help in virt-top(1) man page. Press any key to return." +msgstr "" + +#: ../virt-top/virt_top.ml:258 ../virt-df/virt_df.ml:382 +msgid "NB: If you want to monitor a local Xen hypervisor, you usually need to be root" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:406 +msgid "Name" +msgstr "" + +#: ../virt-top/virt_top.ml:68 +msgid "Net RX bytes" +msgstr "" + +#: ../virt-top/virt_top.ml:69 +msgid "Net TX bytes" +msgstr "" + +#: ../virt-top/virt_top.ml:1332 +msgid "Not a valid number" +msgstr "" + +#: ../virt-top/virt_top.ml:193 +msgid "Number of iterations to run" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:137 ../virt-ctrl/vc_connection_dlg.ml:170 +msgid "Open" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:418 +msgid "Open a new hypervisor connection." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:86 +msgid "Open connection ..." +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:40 +msgid "Open connection to hypervisor" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:130 +msgid "Pause" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:666 ../mlvirsh/mlvirsh.ml:670 +msgid "Pin domain VCPU to a list of physical CPUs." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:706 +msgid "Print list of commands or full description of one command." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:584 +msgid "Print node information." +msgstr "" + +#: ../virt-df/virt_df.ml:350 ../virt-df/virt_df.ml:352 +msgid "Print sizes in human-readable format" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:440 +msgid "Print the ID of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:464 +msgid "Print the OS type of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:472 +msgid "Print the UUID of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:581 +msgid "Print the UUID of a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:480 +msgid "Print the XML description of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:545 +msgid "Print the XML description of a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:530 +msgid "Print the bridge name of a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:653 +msgid "Print the canonical URI." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:448 +msgid "Print the domain info." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:468 +msgid "Print the domain state." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:646 +msgid "Print the driver name" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:677 +msgid "Print the driver version" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:500 +msgid "Print the hostname." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:522 +msgid "Print the max VCPUs available." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:456 +msgid "Print the max VCPUs of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:452 +msgid "Print the max memory (in kilobytes) of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:460 +msgid "Print the name of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:569 +msgid "Print the name of a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:497 +msgid "Print whether a domain autostarts at boot." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:549 +msgid "Print whether a network autostarts at boot." +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:83 +msgid "QEMU or KVM" +msgstr "" + +#: ../virt-top/virt_top.ml:1578 ../virt-ctrl/vc_mainwindow.ml:89 +msgid "Quit" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:519 +msgid "Quit the interactive terminal." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:36 +msgid "Read-only connection" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:587 +msgid "Reboot a domain." +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:134 +msgid "Refresh" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:592 +msgid "Restore a domain from the named file." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:133 +msgid "Resume" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:595 +msgid "Resume a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:406 +msgid "Returns capabilities of hypervisor/driver." +msgstr "" + +#: ../virt-top/virt_top.ml:199 +msgid "Run from a script (no user interface)" +msgstr "" + +#: ../virt-top/virt_top.ml:1584 +msgid "SORTING" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:599 +msgid "Save a domain to a file." +msgstr "" + +#: ../virt-top/virt_top.ml:197 +msgid "Secure (\\\"kiosk\\\") mode" +msgstr "" + +#: ../virt-top/virt_top.ml:1593 +msgid "Select sort field" +msgstr "" + +#: ../virt-top/virt_top.ml:183 +msgid "Send debug messages to file" +msgstr "" + +#: ../virt-top/virt_top.ml:189 +msgid "Set name of init file" +msgstr "" + +#: ../virt-top/virt_top.ml:195 +msgid "Set sort order (%s)" +msgstr "" + +#: ../virt-top/virt_top.ml:1340 +msgid "Set sort order for main display" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:631 +msgid "Set the maximum memory used by the domain (in kilobytes)." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:627 +msgid "Set the memory used by the domain (in kilobytes)." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:674 +msgid "Set the number of virtual CPUs assigned to a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:618 +msgid "Set the scheduler parameters for a domain." +msgstr "" + +#: ../virt-top/virt_top.ml:1579 +msgid "Set update interval" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:403 +msgid "Set whether a domain autostarts at boot." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:526 +msgid "Set whether a network autostarts at boot." +msgstr "" + +#: ../virt-df/virt_df.ml:342 ../virt-df/virt_df.ml:344 +msgid "Show all domains (default: only active domains)" +msgstr "" + +#: ../virt-df/virt_df.ml:354 ../virt-df/virt_df.ml:356 +msgid "Show inodes instead of blocks" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:137 +msgid "Shutdown" +msgstr "" + +#: ../virt-df/virt_df.ml:499 +msgid "Size" +msgstr "" + +#: ../virt-top/virt_top.ml:1589 +msgid "Sort by %CPU" +msgstr "" + +#: ../virt-top/virt_top.ml:1590 +msgid "Sort by %MEM" +msgstr "" + +#: ../virt-top/virt_top.ml:1592 +msgid "Sort by ID" +msgstr "" + +#: ../virt-top/virt_top.ml:1591 +msgid "Sort by TIME" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:127 +msgid "Start" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:639 +msgid "Start a previously defined inactive domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:573 +msgid "Start a previously defined inactive network." +msgstr "" + +#: ../virt-top/virt_top.ml:165 +msgid "Start by displaying block devices" +msgstr "" + +#: ../virt-top/virt_top.ml:163 +msgid "Start by displaying network interfaces" +msgstr "" + +#: ../virt-top/virt_top.ml:161 +msgid "Start by displaying pCPUs (default: tasks)" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:407 +msgid "Status" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:643 +msgid "Suspend a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:40 +msgid "Synopsis:\n %s [options] [command]\n\nList of all commands:\n %s help\n\nFull description of a single command:\n %s help command\n\nOptions:" +msgstr "" + +#: ../virt-top/virt_top.ml:65 +msgid "TIME (CPU time)" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:62 +msgid "This machine" +msgstr "" + +#: ../virt-top/virt_top.ml:1613 +msgid "Toggle block devices" +msgstr "" + +#: ../virt-top/virt_top.ml:1612 +msgid "Toggle network interfaces" +msgstr "" + +#: ../virt-top/virt_top.ml:1611 +msgid "Toggle physical CPUs" +msgstr "" + +#: ../virt-df/virt_df.ml:502 +msgid "Type" +msgstr "" + +#: ../virt-top/virt_top.ml:1341 +msgid "Type key or use up and down cursor keys." +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:160 +msgid "URI connection" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:650 +msgid "Undefine an inactive domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:577 +msgid "Undefine an inactive network." +msgstr "" + +#: ../virt-top/virt_top.ml:1622 +msgid "Unknown command - try 'h' for help" +msgstr "" + +#: ../virt-top/virt_top.ml:1577 +msgid "Update display" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:690 +msgid "Use '%s help command' for help on a command." +msgstr "" + +#: ../virt-df/virt_df.ml:498 ../virt-df/virt_df.ml:499 +msgid "Used" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:23 +msgid "Virtual Control" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:53 +msgid "Virtualisation error" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:39 +msgid "Virtualization control tool (virt-ctrl) by\nRichard W.M. Jones (rjones@redhat.com).\n\nCopyright %s 2007-2008 Red Hat Inc.\n\nLibvirt version: %s\n\nGtk toolkit version: %s" +msgstr "" + +#: ../virt-top/virt_top.ml:1523 +msgid "Wrote settings to %s" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:76 +msgid "Xen hypervisor" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:364 +msgid "\\tCPU time: %Ld ns\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:362 +msgid "\\tcurrent state: %s\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:361 +msgid "\\ton physical CPU: %d\\n" +msgstr "" + +#: ../virt-ctrl/vc_helpers.ml:54 ../mlvirsh/mlvirsh.ml:289 ../mlvirsh/mlvirsh.ml:298 +msgid "blocked" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:330 +msgid "cores: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:342 +msgid "cpu_time: %Ld ns\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:326 +msgid "cpus: %d\\n" +msgstr "" + +#: ../virt-ctrl/vc_helpers.ml:58 ../mlvirsh/mlvirsh.ml:293 +msgid "crashed" +msgstr "" + +#: ../virt-df/virt_df.ml:236 +msgid "detection of unpartitioned devices not yet supported" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:242 +msgid "domain %s: not found. Additional info: %s" +msgstr "" + +#: ../virt-df/virt_df_ext2.ml:39 +msgid "error reading ext2/ext3 magic" +msgstr "" + +#: ../virt-df/virt_df.ml:182 +msgid "error reading extended partition" +msgstr "" + +#: ../virt-df/virt_df.ml:149 +msgid "error reading partition table" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:239 +msgid "error set after getting System bus" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:379 +msgid "errors: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:258 +msgid "expected field value pairs, but got an odd number of arguments" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:610 +msgid "expecting domain followed by field value pairs" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:220 +msgid "flag should be '%s'" +msgstr "" + +#: ../virt-top/virt_top_xml.ml:46 ../virt-df/virt_df.ml:419 +msgid "get_xml_desc didn't return " +msgstr "" + +#: ../virt-df/virt_df.ml:427 +msgid "get_xml_desc returned no node in XML" +msgstr "" + +#: ../virt-df/virt_df.ml:430 +msgid "get_xml_desc returned strange node" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:700 +msgid "help: %s: command not found" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:160 ../mlvirsh/mlvirsh.ml:164 ../mlvirsh/mlvirsh.ml:168 ../mlvirsh/mlvirsh.ml:172 ../mlvirsh/mlvirsh.ml:177 ../mlvirsh/mlvirsh.ml:182 ../mlvirsh/mlvirsh.ml:188 +msgid "incorrect number of arguments for function" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:339 +msgid "max_mem: %Ld K\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:325 ../mlvirsh/mlvirsh.ml:340 +msgid "memory: %Ld K\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:327 +msgid "mhz: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:727 +msgid "mlvirsh" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:725 +msgid "mlvirsh(no connection)" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:726 +msgid "mlvirsh(ro)" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:324 +msgid "model: %s\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:253 +msgid "network %s: not found. Additional info: %s" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:328 +msgid "nodes: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:197 ../mlvirsh/mlvirsh.ml:202 +msgid "not connected to the hypervisor" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:341 +msgid "nr_virt_cpu: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:296 +msgid "offline" +msgstr "" + +#: ../virt-df/virt_df_ext2.ml:42 +msgid "partition marked EXT2/3 but no valid filesystem" +msgstr "" + +#: ../virt-ctrl/vc_helpers.ml:55 ../mlvirsh/mlvirsh.ml:290 +msgid "paused" +msgstr "" + +#: ../virt-df/virt_df.ml:188 +msgid "probe_extended_partition: internal error" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:376 +msgid "read bytes: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:375 +msgid "read requests: %Ld\\n" +msgstr "" + +#: ../virt-ctrl/vc_helpers.ml:53 ../mlvirsh/mlvirsh.ml:288 ../mlvirsh/mlvirsh.ml:297 +msgid "running" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:384 +msgid "rx bytes: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:387 +msgid "rx dropped: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:386 +msgid "rx errs: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:385 +msgid "rx packets: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:226 +msgid "setting should be '%s' or '%s'" +msgstr "" + +#: ../virt-ctrl/vc_helpers.ml:56 ../mlvirsh/mlvirsh.ml:291 +msgid "shutdown" +msgstr "" + +#: ../virt-ctrl/vc_helpers.ml:57 ../mlvirsh/mlvirsh.ml:292 +msgid "shutoff" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:329 +msgid "sockets: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:338 +msgid "state: %s\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:331 +msgid "threads: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:198 +msgid "tried to do read-write operation on read-only hypervisor connection" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:388 +msgid "tx bytes: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:391 +msgid "tx dropped: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:390 +msgid "tx errs: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:389 +msgid "tx packets: %Ld\\n" +msgstr "" + +#: ../virt-ctrl/vc_helpers.ml:52 ../mlvirsh/mlvirsh.ml:287 +msgid "unknown" +msgstr "" + +#: ../virt-df/virt_df.ml:246 +msgid "unsupported partition type %02x" +msgstr "" + +#: ../virt-df/virt_df.ml:363 +msgid "virt-df : like 'df', shows disk space used in guests\n\nSUMMARY\n virt-df [-options]\n\nOPTIONS" +msgstr "" + +#: ../virt-top/virt_top.ml:1543 +msgid "virt-top %s (libvirt %d.%d.%d) by Red Hat" +msgstr "" + +#: ../virt-top/virt_top.ml:203 +msgid "virt-top : a 'top'-like utility for virtualization\n\nSUMMARY\n virt-top [-options]\n\nOPTIONS" +msgstr "" + +#: ../virt-top/virt_top.ml:40 +msgid "virt-top was compiled without support for CSV files" +msgstr "" + +#: ../virt-top/virt_top.ml:51 +msgid "virt-top was compiled without support for dates and times" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:360 +msgid "virtual CPU: %d\\n" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:219 +msgid "warning: ignored unknown message %s from %s\\n%!" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:124 +msgid "warning: unexpected message contents of Found signal" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:188 +msgid "warning: unexpected message contents of ItemNew signal" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:140 +msgid "warning: unexpected message contents of ItemRemove signal" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:378 +msgid "write bytes: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:377 +msgid "write requests: %Ld\\n" +msgstr "" + diff --git a/po/pl.po b/po/pl.po new file mode 100644 index 0000000..a1474af --- /dev/null +++ b/po/pl.po @@ -0,0 +1,1018 @@ +# translation of pl.po to Polish +# Piotr Drąg , 2008. +# +msgid "" +msgstr "" +"Project-Id-Version: pl\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2008-03-28 17:30+0000\n" +"PO-Revision-Date: 2008-04-12 21:09+0200\n" +"Last-Translator: Piotr Drąg \n" +"Language-Team: Polish \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#: ../virt-top/virt_top.ml:1490 +msgid "# .virt-toprc virt-top configuration file\\n" +msgstr "# plik konfiguracji virt-top .virt-toprc\\n" + +#: ../virt-top/virt_top.ml:1508 +msgid "# Enable CSV output to the named file\\n" +msgstr "# Włącz wyjście CSV do pliku named\\n" + +#: ../virt-top/virt_top.ml:1511 +msgid "# To protect this file from being overwritten, uncomment next line\\n" +msgstr "# Aby ochronić ten plik przed zastąpieniem, usuń komentarz z następnego wiersza\\n" + +#: ../virt-top/virt_top.ml:1505 +msgid "# To send debug and error messages to a file, uncomment next line\\n" +msgstr "# Aby wysłać komunikaty debugowania i błędów do pliku, usuń komentarz z następnego wiersza\\n" + +#: ../virt-top/virt_top.ml:1491 +msgid "# generated on %s by %s\\n" +msgstr "# utworzone %s przez %s\\n" + +#: ../virt-top/virt_top.ml:63 +msgid "%CPU" +msgstr "%CPU" + +#: ../virt-top/virt_top.ml:64 +msgid "%MEM" +msgstr "%MEM" + +#: ../virt-top/virt_top.ml:1144 +msgid "%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d" +msgstr "%d domeny, %d aktywne, %d uruchomionych, %d uśpionych, %d wstrzymanych, %d nieaktywnych D:%d O:%d X:%d" + +#: ../mlvirsh/mlvirsh.ml:716 +msgid "%s: command not found" +msgstr "%s: nie znaleziono polecenia" + +#: ../virt-top/virt_top.ml:105 +msgid "%s: display should be %s" +msgstr "%s: ekran powinien być %s" + +#: ../virt-top/virt_top.ml:82 +msgid "%s: sort order should be: %s" +msgstr "%s: porządek sortowania powinien być: %s" + +#: ../virt-df/virt_df.ml:362 ../virt-top/virt_top.ml:202 +msgid "%s: unknown parameter" +msgstr "%s: nieznany parametr" + +#: ../virt-top/virt_top.ml:233 +msgid "%s:%d: configuration item ``%s'' ignored\\n%!" +msgstr "%s:%d: zignorowano element konfiguracji ``%s''\\n%!" + +#: ../virt-df/virt_df.ml:514 +msgid "(device omitted)" +msgstr "(pominięto urządzenie)" + +#: ../virt-top/virt_top.ml:145 +msgid "-d: cannot set a negative delay" +msgstr "-d: nie można ustawić negatywnego opóźnienia" + +#: ../virt-df/virt_df.ml:498 +msgid "1K-blocks" +msgstr "Bloki 1K" + +#: ../virt-ctrl/vc_mainwindow.ml:97 +msgid "About ..." +msgstr "Informacje o..." + +#: ../mlvirsh/mlvirsh.ml:399 +msgid "Attach device to domain." +msgstr "Podłącz urządzenie do domeny." + +#: ../virt-df/virt_df.ml:499 ../virt-df/virt_df.ml:498 +msgid "Available" +msgstr "Dostępne" + +#: ../virt-top/virt_top.ml:167 +msgid "Batch mode" +msgstr "Tryb wsadowy" + +#: ../virt-top/virt_top.ml:70 +msgid "Block read reqs" +msgstr "Wymagania odczytania blokowego" + +#: ../virt-top/virt_top.ml:71 +msgid "Block write reqs" +msgstr "Wymagania zapisania blokowego" + +#: ../virt-ctrl/vc_connections.ml:408 +msgid "CPU" +msgstr "Procesor" + +#: ../mlvirsh/mlvirsh.ml:365 +msgid "CPU affinity" +msgstr "Dopasowanie procesora" + +#: ../virt-top/virt_top.ml:1151 +msgid "CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)" +msgstr "Procesor: %2.1f%% Pamięć: %Ld MB (%Ld MB przez gości)" + +#: ../virt-ctrl/vc_connection_dlg.ml:182 +msgid "Cancel" +msgstr "Anuluj" + +#: ../virt-top/virt_top.ml:1319 +msgid "Change delay from %.1f to: " +msgstr "Zmień opóźnienie z %.1f na: " + +#: ../mlvirsh/mlvirsh.ml:409 +msgid "Close an existing hypervisor connection." +msgstr "Zamknij istniejące połączenie nadzorcy." + +#: ../virt-ctrl/vc_mainwindow.ml:118 +msgid "Connect ..." +msgstr "Połącz się..." + +#: ../virt-ctrl/vc_mainwindow.ml:160 +msgid "Connect to ..." +msgstr "Połącz się z..." + +#: ../virt-df/virt_df.ml:348 ../virt-df/virt_df.ml:346 ../virt-top/virt_top.ml:171 ../virt-top/virt_top.ml:169 +msgid "Connect to URI (default: Xen)" +msgstr "Połącz się z URI (domyślnie: Xen)" + +#: ../virt-top/virt_top.ml:1558 +msgid "Connect: %s; Hostname: %s" +msgstr "Połącz się: %s; nazwa hosta: %s" + +#: ../mlvirsh/mlvirsh.ml:476 +msgid "Core dump a domain to a file for analysis." +msgstr "Zrzut core domeny do pliku do analizy." + +#: ../mlvirsh/mlvirsh.ml:422 +msgid "Create a domain from an XML file." +msgstr "Utwórz domenę z pliku XML." + +#: ../mlvirsh/mlvirsh.ml:534 +msgid "Create a network from an XML file." +msgstr "Utwórz sieć z pliku XML." + +#: ../virt-top/virt_top.ml:1596 +msgid "DISPLAY MODES" +msgstr "TRYBY WYŚWIETLANIA" + +#: ../mlvirsh/mlvirsh.ml:426 +msgid "Define (but don't start) a domain from an XML file." +msgstr "Określ (ale nie uruchamiaj) domenę z pliku XML." + +#: ../mlvirsh/mlvirsh.ml:538 +msgid "Define (but don't start) a network from an XML file." +msgstr "Określ (ale nie uruchamiaj) sieć z pliku XML." + +#: ../virt-top/virt_top.ml:1326 +msgid "Delay must be > 0" +msgstr "Opóźnienie musi być > 0" + +#: ../virt-top/virt_top.ml:181 +msgid "Delay time interval (seconds)" +msgstr "Czas między opóźnieniami (sekundy)" + +#: ../virt-top/virt_top.ml:1552 +msgid "Delay: %.1f secs; Batch: %s; Secure: %s; Sort: %s" +msgstr "Opóźnienie: %.1f sekundy; wsadowo: %s; bezpieczeństwo: %s; sortowanie: %s" + +#: ../mlvirsh/mlvirsh.ml:433 +msgid "Destroy a domain." +msgstr "Zniszcz domenę." + +#: ../mlvirsh/mlvirsh.ml:541 +msgid "Destroy a network." +msgstr "Zniszcz sieć." + +#: ../mlvirsh/mlvirsh.ml:430 +msgid "Detach device from domain." +msgstr "Odłącz urządzenie z domeny." + +#: ../virt-ctrl/vc_mainwindow.ml:123 +msgid "Details" +msgstr "Szczegóły" + +#: ../virt-top/virt_top.ml:175 +msgid "Disable CPU stats in CSV" +msgstr "Wyłącz statystyki procesora w CSV" + +#: ../virt-top/virt_top.ml:177 +msgid "Disable block device stats in CSV" +msgstr "Wyłącz statystyki urządzenia blokowego w CSV" + +#: ../virt-top/virt_top.ml:179 +msgid "Disable net stats in CSV" +msgstr "Wyłącz statystyki sieci w CSV" + +#: ../mlvirsh/mlvirsh.ml:493 +msgid "Display free memory for machine, NUMA cell or range of cells" +msgstr "Wyświetl wolną pamięć dla komputera, komórkę NUMA lub zakres komórek" + +#: ../mlvirsh/mlvirsh.ml:437 +msgid "Display the block device statistics for a domain." +msgstr "Wyświetl statystyki urządzenia blokowego dla domeny." + +#: ../mlvirsh/mlvirsh.ml:444 +msgid "Display the network interface statistics for a domain." +msgstr "Wyświetl statystyki interfejsu sieciowego dla domeny." + +#: ../virt-df/virt_df.ml:358 +msgid "Display version and exit" +msgstr "Wyświetl wersję i zakończ" + +#: ../virt-top/virt_top.ml:191 +msgid "Do not read init file" +msgstr "Nie odczytuj pliku init" + +#: ../virt-top/virt_top.ml:66 +msgid "Domain ID" +msgstr "Identyfikator domeny" + +#: ../virt-top/virt_top.ml:67 +msgid "Domain name" +msgstr "Nazwa domeny" + +#: ../virt-top/virt_top.ml:1610 +msgid "Domains display" +msgstr "Ekran domen" + +#: ../virt-ctrl/vc_mainwindow.ml:61 ../virt-top/virt_top_main.ml:47 ../virt-top/virt_top.ml:1528 +msgid "Error" +msgstr "Błąd" + +#: ../virt-top/virt_top.ml:185 +msgid "Exit at given time" +msgstr "Zakończ o podanym czasie" + +#: ../virt-ctrl/vc_mainwindow.ml:79 +msgid "File" +msgstr "Plik" + +#: ../virt-df/virt_df.ml:502 +msgid "Filesystem" +msgstr "System plików" + +#: ../mlvirsh/mlvirsh.ml:606 +msgid "Get the current scheduler parameters for a domain." +msgstr "Uzyskaj obecne parametry planisty dla domeny." + +#: ../mlvirsh/mlvirsh.ml:623 +msgid "Get the scheduler type." +msgstr "Uzyskaj typ planisty." + +#: ../mlvirsh/mlvirsh.ml:635 +msgid "Gracefully shutdown a domain." +msgstr "Wyłącz domenę." + +#: ../virt-ctrl/vc_mainwindow.ml:96 ../virt-ctrl/vc_mainwindow.ml:80 ../virt-top/virt_top.ml:1580 +msgid "Help" +msgstr "Pomoc" + +#: ../virt-top/virt_top.ml:187 +msgid "Historical CPU delay" +msgstr "Historyczne opóźnienie procsora" + +#: ../mlvirsh/mlvirsh.ml:35 +msgid "Hypervisor connection URI" +msgstr "URI połączenia nadzorcy" + +#: ../virt-ctrl/vc_connections.ml:405 +msgid "ID" +msgstr "Identyfikator" + +#: ../virt-df/virt_df.ml:500 +msgid "IFree" +msgstr "IWolne" + +#: ../virt-df/virt_df.ml:500 +msgid "IUse" +msgstr "IUżyte" + +#: ../virt-df/virt_df.ml:500 +msgid "Inodes" +msgstr "Iwęzły" + +#: ../virt-df/virt_df_lvm2.ml:33 +msgid "LVM2 not supported yet" +msgstr "LVM2 nie jest jeszcze obsługiwane" + +#: ../virt-df/virt_df_ext2.ml:82 +msgid "Linux ext2/3" +msgstr "Linuksowe ext2/3" + +#: ../virt-df/virt_df_linux_swap.ml:33 +msgid "Linux swap" +msgstr "Linuksowa przestrzeń wymiany" + +#: ../mlvirsh/mlvirsh.ml:557 +msgid "List the active networks." +msgstr "Wyświetl listę aktywnych sieci." + +#: ../mlvirsh/mlvirsh.ml:565 +msgid "List the defined but inactive networks." +msgstr "Wyświetl listę określonych, ale nieaktywnych sieci." + +#: ../mlvirsh/mlvirsh.ml:516 +msgid "List the defined but not running domains." +msgstr "Wyświetl listę określonych, ale nie uruchomionych domen." + +#: ../mlvirsh/mlvirsh.ml:508 +msgid "List the running domains." +msgstr "Wyświetl listę uruchomionych domen." + +#: ../virt-ctrl/vc_mainwindow.ml:158 +msgid "Local QEMU/KVM" +msgstr "Lokalny QEMU/KVM" + +#: ../virt-ctrl/vc_mainwindow.ml:157 +msgid "Local Xen" +msgstr "Lokalny Xen" + +#: ../virt-ctrl/vc_connection_dlg.ml:93 +msgid "Local network" +msgstr "Lokalna sieć" + +#: ../virt-top/virt_top.ml:173 +msgid "Log statistics to CSV file" +msgstr "Zapisz statystyki do pliku CSV" + +#: ../virt-top/virt_top.ml:1563 +msgid "MAIN KEYS" +msgstr "GŁÓWNE KLUCZE" + +#: ../virt-ctrl/vc_connections.ml:409 +msgid "Memory" +msgstr "Pamięć" + +#: ../virt-top/virt_top.ml:1617 +msgid "More help in virt-top(1) man page. Press any key to return." +msgstr "Więcej pomocy na stronie podręcznika virt-top(1). Naciśnij dowolny klawisz, aby kontynuować." + +#: ../virt-df/virt_df.ml:382 ../virt-top/virt_top.ml:258 +msgid "NB: If you want to monitor a local Xen hypervisor, you usually need to be root" +msgstr "NB: jeśli chcesz monitorować lokalnego nadzorcę Xena, zwykle musisz być rootem" + +#: ../virt-ctrl/vc_connections.ml:406 +msgid "Name" +msgstr "Nazwa" + +#: ../virt-top/virt_top.ml:68 +msgid "Net RX bytes" +msgstr "Sieciowe bajty RX" + +#: ../virt-top/virt_top.ml:69 +msgid "Net TX bytes" +msgstr "Sieciowe bajty TX" + +#: ../virt-top/virt_top.ml:1332 +msgid "Not a valid number" +msgstr "Nie jest prawidłowym numerem" + +#: ../virt-top/virt_top.ml:193 +msgid "Number of iterations to run" +msgstr "Liczba iteracji do uruchomienia" + +#: ../virt-ctrl/vc_connection_dlg.ml:170 ../virt-ctrl/vc_connection_dlg.ml:137 +msgid "Open" +msgstr "Otwórz" + +#: ../mlvirsh/mlvirsh.ml:418 +msgid "Open a new hypervisor connection." +msgstr "Otwórz nowe połączenie nadzorcy." + +#: ../virt-ctrl/vc_mainwindow.ml:86 +msgid "Open connection ..." +msgstr "Otwórz połączenie..." + +#: ../virt-ctrl/vc_connection_dlg.ml:40 +msgid "Open connection to hypervisor" +msgstr "Otwórz połączenie do nadzorcy" + +#: ../virt-ctrl/vc_mainwindow.ml:130 +msgid "Pause" +msgstr "Wstrzymaj" + +#: ../mlvirsh/mlvirsh.ml:670 ../mlvirsh/mlvirsh.ml:666 +msgid "Pin domain VCPU to a list of physical CPUs." +msgstr "Przypnij wirtualny procesor do listy fizycznych procesorów." + +#: ../mlvirsh/mlvirsh.ml:706 +msgid "Print list of commands or full description of one command." +msgstr "Wyświetl listę poleceń lub pełny opis jednego polecenia." + +#: ../mlvirsh/mlvirsh.ml:584 +msgid "Print node information." +msgstr "Wyświetl informacje o węźle." + +#: ../virt-df/virt_df.ml:352 ../virt-df/virt_df.ml:350 +msgid "Print sizes in human-readable format" +msgstr "Wyświetl rozmiary w formacie czytelnym dla człowieka" + +#: ../mlvirsh/mlvirsh.ml:440 +msgid "Print the ID of a domain." +msgstr "Wyświetl identyfikator domeny." + +#: ../mlvirsh/mlvirsh.ml:464 +msgid "Print the OS type of a domain." +msgstr "Wyświetl typ systemu operacyjnego domeny." + +#: ../mlvirsh/mlvirsh.ml:472 +msgid "Print the UUID of a domain." +msgstr "Wyświetl UUID domeny." + +#: ../mlvirsh/mlvirsh.ml:581 +msgid "Print the UUID of a network." +msgstr "Wyświetl UUID sieci." + +#: ../mlvirsh/mlvirsh.ml:480 +msgid "Print the XML description of a domain." +msgstr "Wyświetl opis XML domeny." + +#: ../mlvirsh/mlvirsh.ml:545 +msgid "Print the XML description of a network." +msgstr "Wyświetl opis XML sieci." + +#: ../mlvirsh/mlvirsh.ml:530 +msgid "Print the bridge name of a network." +msgstr "Wyświetl nazwę mostka sieci." + +#: ../mlvirsh/mlvirsh.ml:653 +msgid "Print the canonical URI." +msgstr "Wyświetl kanoniczne URI." + +#: ../mlvirsh/mlvirsh.ml:448 +msgid "Print the domain info." +msgstr "Wyświetl informacje o domenie." + +#: ../mlvirsh/mlvirsh.ml:468 +msgid "Print the domain state." +msgstr "Wyświetl stan domeny." + +#: ../mlvirsh/mlvirsh.ml:646 +msgid "Print the driver name" +msgstr "Wyświetl nazwę sterownika" + +#: ../mlvirsh/mlvirsh.ml:677 +msgid "Print the driver version" +msgstr "Wyświetl wersję sterownika" + +#: ../mlvirsh/mlvirsh.ml:500 +msgid "Print the hostname." +msgstr "Wyświetl nazwę hosta." + +#: ../mlvirsh/mlvirsh.ml:522 +msgid "Print the max VCPUs available." +msgstr "Wyświetl maksymalną ilość dostępnych wirtualnych procesorów." + +#: ../mlvirsh/mlvirsh.ml:456 +msgid "Print the max VCPUs of a domain." +msgstr "Wyświetl maksymalną ilość wirtualnych procesorów domeny." + +#: ../mlvirsh/mlvirsh.ml:452 +msgid "Print the max memory (in kilobytes) of a domain." +msgstr "Wyświetl maksymalną pamięć (w kilobitach) domeny." + +#: ../mlvirsh/mlvirsh.ml:460 +msgid "Print the name of a domain." +msgstr "Wyświetl nazwę domeny." + +#: ../mlvirsh/mlvirsh.ml:569 +msgid "Print the name of a network." +msgstr "Wyświetl nazwę sieci." + +#: ../mlvirsh/mlvirsh.ml:497 +msgid "Print whether a domain autostarts at boot." +msgstr "Wyświetl, czy domena powinna być automatycznie uruchamiania po starcie." + +#: ../mlvirsh/mlvirsh.ml:549 +msgid "Print whether a network autostarts at boot." +msgstr "Wyświetl, czy sieć powinna być automatycznie uruchamiania po starcie." + +#: ../virt-ctrl/vc_connection_dlg.ml:83 +msgid "QEMU or KVM" +msgstr "QEMU lub KVM" + +#: ../virt-ctrl/vc_mainwindow.ml:89 ../virt-top/virt_top.ml:1578 +msgid "Quit" +msgstr "Zakończ" + +#: ../mlvirsh/mlvirsh.ml:519 +msgid "Quit the interactive terminal." +msgstr "Zakończ interaktywny terminal." + +#: ../mlvirsh/mlvirsh.ml:36 +msgid "Read-only connection" +msgstr "Połączenie tylko do odczytu" + +#: ../mlvirsh/mlvirsh.ml:587 +msgid "Reboot a domain." +msgstr "Ponownie uruchom domenę." + +#: ../virt-ctrl/vc_connection_dlg.ml:134 +msgid "Refresh" +msgstr "Odśwież" + +#: ../mlvirsh/mlvirsh.ml:592 +msgid "Restore a domain from the named file." +msgstr "Przywróć domenę z pliku named." + +#: ../virt-ctrl/vc_mainwindow.ml:133 +msgid "Resume" +msgstr "Wznów" + +#: ../mlvirsh/mlvirsh.ml:595 +msgid "Resume a domain." +msgstr "Wznów domenę." + +#: ../mlvirsh/mlvirsh.ml:406 +msgid "Returns capabilities of hypervisor/driver." +msgstr "Zwraca możliwości nadzorcy/sterownika." + +#: ../virt-top/virt_top.ml:199 +msgid "Run from a script (no user interface)" +msgstr "Uruchom ze skryptu (brak interfejsu użytkownika)" + +#: ../virt-top/virt_top.ml:1584 +msgid "SORTING" +msgstr "SORTOWANIE" + +#: ../mlvirsh/mlvirsh.ml:599 +msgid "Save a domain to a file." +msgstr "Zapisz domenę do pliku." + +#: ../virt-top/virt_top.ml:197 +msgid "Secure (\\\"kiosk\\\") mode" +msgstr "Tryb bezpieczny (\\\"kiosk\\\")" + +#: ../virt-top/virt_top.ml:1593 +msgid "Select sort field" +msgstr "Wybierz pole sortowania" + +#: ../virt-top/virt_top.ml:183 +msgid "Send debug messages to file" +msgstr "Wyślij komunikaty debugowania do pliku" + +#: ../virt-top/virt_top.ml:189 +msgid "Set name of init file" +msgstr "Ustaw nazwę pliku init" + +#: ../virt-top/virt_top.ml:195 +msgid "Set sort order (%s)" +msgstr "Ustaw porządek sortowania (%s)" + +#: ../virt-top/virt_top.ml:1340 +msgid "Set sort order for main display" +msgstr "Ustaw porządek sortowania dla głównego ekranu" + +#: ../mlvirsh/mlvirsh.ml:631 +msgid "Set the maximum memory used by the domain (in kilobytes)." +msgstr "Ustaw maksymalną pamięć używaną przez domenę (w kilobajtach)." + +#: ../mlvirsh/mlvirsh.ml:627 +msgid "Set the memory used by the domain (in kilobytes)." +msgstr "Ustaw pamięć używaną przez domenę (w kilobajtach)." + +#: ../mlvirsh/mlvirsh.ml:674 +msgid "Set the number of virtual CPUs assigned to a domain." +msgstr "Ustaw liczbę wirtualnych procesorów powiązanych z domeną." + +#: ../mlvirsh/mlvirsh.ml:618 +msgid "Set the scheduler parameters for a domain." +msgstr "Ustaw parametry planisty domeny." + +#: ../virt-top/virt_top.ml:1579 +msgid "Set update interval" +msgstr "Ustaw czas między aktualizacjami" + +#: ../mlvirsh/mlvirsh.ml:403 +msgid "Set whether a domain autostarts at boot." +msgstr "Ustaw, czy automatycznie uruchamiać domenę po starcie." + +#: ../mlvirsh/mlvirsh.ml:526 +msgid "Set whether a network autostarts at boot." +msgstr "Ustaw, czy automatycznie uruchamiać sieć po starcie." + +#: ../virt-df/virt_df.ml:344 ../virt-df/virt_df.ml:342 +msgid "Show all domains (default: only active domains)" +msgstr "Wyświetl wszystkie domeny (domyślnie: tylko aktywne domeny)" + +#: ../virt-df/virt_df.ml:356 ../virt-df/virt_df.ml:354 +msgid "Show inodes instead of blocks" +msgstr "Wyświetl i-węzły zamiast bloków" + +#: ../virt-ctrl/vc_mainwindow.ml:137 +msgid "Shutdown" +msgstr "Wyłącz" + +#: ../virt-df/virt_df.ml:499 +msgid "Size" +msgstr "Rozmiar" + +#: ../virt-top/virt_top.ml:1589 +msgid "Sort by %CPU" +msgstr "Uporządkuj według %CPU" + +#: ../virt-top/virt_top.ml:1590 +msgid "Sort by %MEM" +msgstr "Uporządkuj według %MEM" + +#: ../virt-top/virt_top.ml:1592 +msgid "Sort by ID" +msgstr "Uporządkuj według identyfikatorów" + +#: ../virt-top/virt_top.ml:1591 +msgid "Sort by TIME" +msgstr "Uporządkuj według TIME" + +#: ../virt-ctrl/vc_mainwindow.ml:127 +msgid "Start" +msgstr "Uruchom" + +#: ../mlvirsh/mlvirsh.ml:639 +msgid "Start a previously defined inactive domain." +msgstr "Uruchom poprzednio określoną nieaktywną domenę." + +#: ../mlvirsh/mlvirsh.ml:573 +msgid "Start a previously defined inactive network." +msgstr "Uruchom poprzednio określoną nieaktywną sieć." + +#: ../virt-top/virt_top.ml:165 +msgid "Start by displaying block devices" +msgstr "Uruchom przez wyświetlenie urządzeń blokowych" + +#: ../virt-top/virt_top.ml:163 +msgid "Start by displaying network interfaces" +msgstr "Uruchom przez wyświetlenie interfejsów sieciowych" + +#: ../virt-top/virt_top.ml:161 +msgid "Start by displaying pCPUs (default: tasks)" +msgstr "Uruchom przez wyświetlanie fizycznych procesorów (domyślnie: zadania)" + +#: ../virt-ctrl/vc_connections.ml:407 +msgid "Status" +msgstr "Stan" + +#: ../mlvirsh/mlvirsh.ml:643 +msgid "Suspend a domain." +msgstr "Uśpij domenę." + +#: ../mlvirsh/mlvirsh.ml:40 +msgid "Synopsis:\n %s [options] [command]\n\nList of all commands:\n %s help\n\nFull description of a single command:\n %s help command\n\nOptions:" +msgstr "Podsumowanie:\n %s [opcje] [polecenie]\n\nWyświetl listę wszystkich poleceń:\n %s help\n\nPełny opis jednego polecenia:\n %s help polecenie\n\nOpcje:" + +#: ../virt-top/virt_top.ml:65 +msgid "TIME (CPU time)" +msgstr "TIME (czas procesora)" + +#: ../virt-ctrl/vc_connection_dlg.ml:62 +msgid "This machine" +msgstr "Ten komputer" + +#: ../virt-top/virt_top.ml:1613 +msgid "Toggle block devices" +msgstr "Przełącz urządzenia blokowe" + +#: ../virt-top/virt_top.ml:1612 +msgid "Toggle network interfaces" +msgstr "Przełącz interfejsy sieciowe" + +#: ../virt-top/virt_top.ml:1611 +msgid "Toggle physical CPUs" +msgstr "Przełącz fizyczne procesory" + +#: ../virt-df/virt_df.ml:502 +msgid "Type" +msgstr "Podaj" + +#: ../virt-top/virt_top.ml:1341 +msgid "Type key or use up and down cursor keys." +msgstr "Podaj klucz lub użyj klawiszy kursora w górę i w dół." + +#: ../virt-ctrl/vc_connection_dlg.ml:160 +msgid "URI connection" +msgstr "Połączenie URI" + +#: ../mlvirsh/mlvirsh.ml:650 +msgid "Undefine an inactive domain." +msgstr "Usuń określenie nieaktywnej domeny." + +#: ../mlvirsh/mlvirsh.ml:577 +msgid "Undefine an inactive network." +msgstr "Usuń określenie nieaktywnej sieci." + +#: ../virt-top/virt_top.ml:1622 +msgid "Unknown command - try 'h' for help" +msgstr "Nieznane polecenie - wypróbuj \"h\", aby uzyskać pomoc" + +#: ../virt-top/virt_top.ml:1577 +msgid "Update display" +msgstr "Zaktualizuj ekran" + +#: ../mlvirsh/mlvirsh.ml:690 +msgid "Use '%s help command' for help on a command." +msgstr "Użyj \"%s help polecenie\", aby uzyskać pomoc o poleceniu." + +#: ../virt-df/virt_df.ml:499 ../virt-df/virt_df.ml:498 +msgid "Used" +msgstr "Użyte" + +#: ../virt-ctrl/vc_mainwindow.ml:23 +msgid "Virtual Control" +msgstr "Kontrola wirtualna" + +#: ../virt-ctrl/vc_mainwindow.ml:53 +msgid "Virtualisation error" +msgstr "Błąd wirtualizacji" + +#: ../virt-ctrl/vc_mainwindow.ml:39 +msgid "Virtualization control tool (virt-ctrl) by\nRichard W.M. Jones (rjones@redhat.com).\n\nCopyright %s 2007-2008 Red Hat Inc.\n\nLibvirt version: %s\n\nGtk toolkit version: %s" +msgstr "Narzędzie kontroli wirtualizacji (virt-ctrl) by\nRichard W.M. Jones (rjones@redhat.com).\n\nCopyright %s 2007-2008 Red Hat Inc.\n\nWersja libvirt: %s\n\nWersja zestawu narzędzi GTK: %s" + +#: ../virt-top/virt_top.ml:1523 +msgid "Wrote settings to %s" +msgstr "Zapisano ustawienia do %s" + +#: ../virt-ctrl/vc_connection_dlg.ml:76 +msgid "Xen hypervisor" +msgstr "Nadzorca Xen" + +#: ../mlvirsh/mlvirsh.ml:364 +msgid "\\tCPU time: %Ld ns\\n" +msgstr "\\tCzas procesora: %Ld ns\\n" + +#: ../mlvirsh/mlvirsh.ml:362 +msgid "\\tcurrent state: %s\\n" +msgstr "\\tobecny stan: %s\\n" + +#: ../mlvirsh/mlvirsh.ml:361 +msgid "\\ton physical CPU: %d\\n" +msgstr "\\tna fizycznym procesorze: %d\\n" + +#: ../mlvirsh/mlvirsh.ml:298 ../mlvirsh/mlvirsh.ml:289 ../virt-ctrl/vc_helpers.ml:54 +msgid "blocked" +msgstr "zablokowano" + +#: ../mlvirsh/mlvirsh.ml:330 +msgid "cores: %d\\n" +msgstr "rdzenie: %d\\n" + +#: ../mlvirsh/mlvirsh.ml:342 +msgid "cpu_time: %Ld ns\\n" +msgstr "cpu_time: %Ld ns\\n" + +#: ../mlvirsh/mlvirsh.ml:326 +msgid "cpus: %d\\n" +msgstr "procesory: %d\\n" + +#: ../mlvirsh/mlvirsh.ml:293 ../virt-ctrl/vc_helpers.ml:58 +msgid "crashed" +msgstr "zawiesił się" + +#: ../virt-df/virt_df.ml:236 +msgid "detection of unpartitioned devices not yet supported" +msgstr "wykrywanie niespartycjonowanych urządzeń nie jest jeszcze obsługiwane" + +#: ../mlvirsh/mlvirsh.ml:242 +msgid "domain %s: not found. Additional info: %s" +msgstr "domena %s: nie znaleziono. Dodatkowe informacje: %s" + +#: ../virt-df/virt_df_ext2.ml:39 +msgid "error reading ext2/ext3 magic" +msgstr "błąd podczas odczytywanie magii ext2/ext3" + +#: ../virt-df/virt_df.ml:182 +msgid "error reading extended partition" +msgstr "błąd podczas odczytywania partycji rozszerzonej" + +#: ../virt-df/virt_df.ml:149 +msgid "error reading partition table" +msgstr "błąd podczas odczytywania tablicy partycji" + +#: ../virt-ctrl/vc_dbus.ml:239 +msgid "error set after getting System bus" +msgstr "błąd podczas ustawiania po otrzymaniu magistrali systemowej" + +#: ../mlvirsh/mlvirsh.ml:379 +msgid "errors: %Ld\\n" +msgstr "błędy: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:258 +msgid "expected field value pairs, but got an odd number of arguments" +msgstr "oczekiwano pary wartości pól, ale otrzymano nieparzystą liczbę argumentów" + +#: ../mlvirsh/mlvirsh.ml:610 +msgid "expecting domain followed by field value pairs" +msgstr "oczekiwano domenę poprzedzoną parami wartości pól" + +#: ../mlvirsh/mlvirsh.ml:220 +msgid "flag should be '%s'" +msgstr "flaga powinna być \"%s\"" + +#: ../virt-df/virt_df.ml:419 ../virt-top/virt_top_xml.ml:46 +msgid "get_xml_desc didn't return " +msgstr "get_xml_desc nie zwróciło " + +#: ../virt-df/virt_df.ml:427 +msgid "get_xml_desc returned no node in XML" +msgstr "get_xml_desc nie zwróciło węzła w XML-u" + +#: ../virt-df/virt_df.ml:430 +msgid "get_xml_desc returned strange node" +msgstr "get_xml_desc zwróciło dziwny węzeł " + +#: ../mlvirsh/mlvirsh.ml:700 +msgid "help: %s: command not found" +msgstr "help: %s: nie znaleziono polecenia" + +#: ../mlvirsh/mlvirsh.ml:188 ../mlvirsh/mlvirsh.ml:182 ../mlvirsh/mlvirsh.ml:177 ../mlvirsh/mlvirsh.ml:172 ../mlvirsh/mlvirsh.ml:168 ../mlvirsh/mlvirsh.ml:164 ../mlvirsh/mlvirsh.ml:160 +msgid "incorrect number of arguments for function" +msgstr "niepoprawna liczba argumentów dla funkcji" + +#: ../mlvirsh/mlvirsh.ml:339 +msgid "max_mem: %Ld K\\n" +msgstr "max_mem: %Ld K\\n" + +#: ../mlvirsh/mlvirsh.ml:340 ../mlvirsh/mlvirsh.ml:325 +msgid "memory: %Ld K\\n" +msgstr "pamięć: %Ld K\\n" + +#: ../mlvirsh/mlvirsh.ml:327 +msgid "mhz: %d\\n" +msgstr "MHz: %d\\n" + +#: ../mlvirsh/mlvirsh.ml:727 +msgid "mlvirsh" +msgstr "mlvirsh" + +#: ../mlvirsh/mlvirsh.ml:725 +msgid "mlvirsh(no connection)" +msgstr "mlvirsh (brak połączenia)" + +#: ../mlvirsh/mlvirsh.ml:726 +msgid "mlvirsh(ro)" +msgstr "mlvirsh (tylko do odczytu)" + +#: ../mlvirsh/mlvirsh.ml:324 +msgid "model: %s\\n" +msgstr "model: %s\\n" + +#: ../mlvirsh/mlvirsh.ml:253 +msgid "network %s: not found. Additional info: %s" +msgstr "sieć %s: nie znaleziono. Dodatkowe informacje: %s" + +#: ../mlvirsh/mlvirsh.ml:328 +msgid "nodes: %d\\n" +msgstr "węzły: %d\\n" + +#: ../mlvirsh/mlvirsh.ml:202 ../mlvirsh/mlvirsh.ml:197 +msgid "not connected to the hypervisor" +msgstr "nie połączono z nadzorcą" + +#: ../mlvirsh/mlvirsh.ml:341 +msgid "nr_virt_cpu: %d\\n" +msgstr "nr_virt_cpu: %d\\n" + +#: ../mlvirsh/mlvirsh.ml:296 +msgid "offline" +msgstr "offline" + +#: ../virt-df/virt_df_ext2.ml:42 +msgid "partition marked EXT2/3 but no valid filesystem" +msgstr "partycja jest oznaczona jako ext2/3, ale nie jest prawidłowym system plików" + +#: ../mlvirsh/mlvirsh.ml:290 ../virt-ctrl/vc_helpers.ml:55 +msgid "paused" +msgstr "wstrzymano" + +#: ../virt-df/virt_df.ml:188 +msgid "probe_extended_partition: internal error" +msgstr "probe_extended_partition: wewnętrzny błąd" + +#: ../mlvirsh/mlvirsh.ml:376 +msgid "read bytes: %Ld\\n" +msgstr "odczytaj bajty: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:375 +msgid "read requests: %Ld\\n" +msgstr "odczytaj żądania: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:297 ../mlvirsh/mlvirsh.ml:288 ../virt-ctrl/vc_helpers.ml:53 +msgid "running" +msgstr "uruchomione" + +#: ../mlvirsh/mlvirsh.ml:384 +msgid "rx bytes: %Ld\\n" +msgstr "bajty RX: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:387 +msgid "rx dropped: %Ld\\n" +msgstr "opuszczono RX: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:386 +msgid "rx errs: %Ld\\n" +msgstr "błędy RX: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:385 +msgid "rx packets: %Ld\\n" +msgstr "pakiety RX: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:226 +msgid "setting should be '%s' or '%s'" +msgstr "ustawienie powinno być \"%s\" lub \"%s\"" + +#: ../mlvirsh/mlvirsh.ml:291 ../virt-ctrl/vc_helpers.ml:56 +msgid "shutdown" +msgstr "wyłącz" + +#: ../mlvirsh/mlvirsh.ml:292 ../virt-ctrl/vc_helpers.ml:57 +msgid "shutoff" +msgstr "wyłącz" + +#: ../mlvirsh/mlvirsh.ml:329 +msgid "sockets: %d\\n" +msgstr "gniazda: %d\\n" + +#: ../mlvirsh/mlvirsh.ml:338 +msgid "state: %s\\n" +msgstr "stan: %s\\n" + +#: ../mlvirsh/mlvirsh.ml:331 +msgid "threads: %d\\n" +msgstr "wątki: %d\\n" + +#: ../mlvirsh/mlvirsh.ml:198 +msgid "tried to do read-write operation on read-only hypervisor connection" +msgstr "spróbowano wykonać operację odczytu/zapisu na połączeniu nadzorcy tylko do odczytu" + +#: ../mlvirsh/mlvirsh.ml:388 +msgid "tx bytes: %Ld\\n" +msgstr "bajty TX: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:391 +msgid "tx dropped: %Ld\\n" +msgstr "opuszczono TX: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:390 +msgid "tx errs: %Ld\\n" +msgstr "błędy TX: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:389 +msgid "tx packets: %Ld\\n" +msgstr "pakiety TX: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:287 ../virt-ctrl/vc_helpers.ml:52 +msgid "unknown" +msgstr "nieznane" + +#: ../virt-df/virt_df.ml:246 +msgid "unsupported partition type %02x" +msgstr "nieobsługiwany typ partycji %02x" + +#: ../virt-df/virt_df.ml:363 +msgid "virt-df : like 'df', shows disk space used in guests\n\nSUMMARY\n virt-df [-options]\n\nOPTIONS" +msgstr "virt-df: podobne do \"df\", pokazuje użytą przestrzeń na dysku w gościach\n\nPODSUMOWANIE\n virt-df [-opcje]\n\nOPCJE" + +#: ../virt-top/virt_top.ml:1543 +msgid "virt-top %s (libvirt %d.%d.%d) by Red Hat" +msgstr "virt-top %s (libvirt %d.%d.%d) od Red Hata" + +#: ../virt-top/virt_top.ml:203 +msgid "virt-top : a 'top'-like utility for virtualization\n\nSUMMARY\n virt-top [-options]\n\nOPTIONS" +msgstr "virt-top: narzędzie podobne do \"top\" dla wirtualizacji\n\nPODSUMOWANIE\n virt-top [-opcje]\n\nOPCJE" + +#: ../virt-top/virt_top.ml:40 +msgid "virt-top was compiled without support for CSV files" +msgstr "virt-top został skompilowany bez obsługi plików CSV" + +#: ../virt-top/virt_top.ml:51 +msgid "virt-top was compiled without support for dates and times" +msgstr "virt-top został skompilowany bez obsługi dat i czasu" + +#: ../mlvirsh/mlvirsh.ml:360 +msgid "virtual CPU: %d\\n" +msgstr "wirtualny procesor: %d\\n" + +#: ../virt-ctrl/vc_dbus.ml:219 +msgid "warning: ignored unknown message %s from %s\\n%!" +msgstr "ostrzeżenie: zignorowano nieznany komunikat %s z %s\\n%!" + +#: ../virt-ctrl/vc_dbus.ml:124 +msgid "warning: unexpected message contents of Found signal" +msgstr "ostrzeżenie: nieoczekiwana zawartość komunikatu sygnału \"Found\"" + +#: ../virt-ctrl/vc_dbus.ml:188 +msgid "warning: unexpected message contents of ItemNew signal" +msgstr "ostrzeżenie: nieoczekiwana zawartość komunikatu sygnału \"ItemNew\"" + +#: ../virt-ctrl/vc_dbus.ml:140 +msgid "warning: unexpected message contents of ItemRemove signal" +msgstr "ostrzeżenie: nieoczekiwana zawartość komunikatu sygnału \"ItemRemove\"" + +#: ../mlvirsh/mlvirsh.ml:378 +msgid "write bytes: %Ld\\n" +msgstr "bajty zapisu: %Ld\\n" + +#: ../mlvirsh/mlvirsh.ml:377 +msgid "write requests: %Ld\\n" +msgstr "żądania zapisu: %Ld\\n" diff --git a/po/virt-top.pot b/po/virt-top.pot new file mode 100644 index 0000000..68806b4 --- /dev/null +++ b/po/virt-top.pot @@ -0,0 +1,1023 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +#, fuzzy +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2008-03-28 17:30+0000\n" +"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" +"Last-Translator: FULL NAME \n" +"Language-Team: LANGUAGE \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=CHARSET\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=INTEGER; plural=EXPRESSION;\n" + +#: ../virt-top/virt_top.ml:1490 +msgid "# .virt-toprc virt-top configuration file\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:1508 +msgid "# Enable CSV output to the named file\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:1511 +msgid "# To protect this file from being overwritten, uncomment next line\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:1505 +msgid "# To send debug and error messages to a file, uncomment next line\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:1491 +msgid "# generated on %s by %s\\n" +msgstr "" + +#: ../virt-top/virt_top.ml:63 +msgid "%CPU" +msgstr "" + +#: ../virt-top/virt_top.ml:64 +msgid "%MEM" +msgstr "" + +#: ../virt-top/virt_top.ml:1144 +msgid "%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:716 +msgid "%s: command not found" +msgstr "" + +#: ../virt-top/virt_top.ml:105 +msgid "%s: display should be %s" +msgstr "" + +#: ../virt-top/virt_top.ml:82 +msgid "%s: sort order should be: %s" +msgstr "" + +#: ../virt-df/virt_df.ml:362 ../virt-top/virt_top.ml:202 +msgid "%s: unknown parameter" +msgstr "" + +#: ../virt-top/virt_top.ml:233 +msgid "%s:%d: configuration item ``%s'' ignored\\n%!" +msgstr "" + +#: ../virt-df/virt_df.ml:514 +msgid "(device omitted)" +msgstr "" + +#: ../virt-top/virt_top.ml:145 +msgid "-d: cannot set a negative delay" +msgstr "" + +#: ../virt-df/virt_df.ml:498 +msgid "1K-blocks" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:97 +msgid "About ..." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:399 +msgid "Attach device to domain." +msgstr "" + +#: ../virt-df/virt_df.ml:499 ../virt-df/virt_df.ml:498 +msgid "Available" +msgstr "" + +#: ../virt-top/virt_top.ml:167 +msgid "Batch mode" +msgstr "" + +#: ../virt-top/virt_top.ml:70 +msgid "Block read reqs" +msgstr "" + +#: ../virt-top/virt_top.ml:71 +msgid "Block write reqs" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:408 +msgid "CPU" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:365 +msgid "CPU affinity" +msgstr "" + +#: ../virt-top/virt_top.ml:1151 +msgid "CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:182 +msgid "Cancel" +msgstr "" + +#: ../virt-top/virt_top.ml:1319 +msgid "Change delay from %.1f to: " +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:409 +msgid "Close an existing hypervisor connection." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:118 +msgid "Connect ..." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:160 +msgid "Connect to ..." +msgstr "" + +#: ../virt-df/virt_df.ml:348 ../virt-df/virt_df.ml:346 ../virt-top/virt_top.ml:171 ../virt-top/virt_top.ml:169 +msgid "Connect to URI (default: Xen)" +msgstr "" + +#: ../virt-top/virt_top.ml:1558 +msgid "Connect: %s; Hostname: %s" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:476 +msgid "Core dump a domain to a file for analysis." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:422 +msgid "Create a domain from an XML file." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:534 +msgid "Create a network from an XML file." +msgstr "" + +#: ../virt-top/virt_top.ml:1596 +msgid "DISPLAY MODES" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:426 +msgid "Define (but don't start) a domain from an XML file." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:538 +msgid "Define (but don't start) a network from an XML file." +msgstr "" + +#: ../virt-top/virt_top.ml:1326 +msgid "Delay must be > 0" +msgstr "" + +#: ../virt-top/virt_top.ml:181 +msgid "Delay time interval (seconds)" +msgstr "" + +#: ../virt-top/virt_top.ml:1552 +msgid "Delay: %.1f secs; Batch: %s; Secure: %s; Sort: %s" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:433 +msgid "Destroy a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:541 +msgid "Destroy a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:430 +msgid "Detach device from domain." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:123 +msgid "Details" +msgstr "" + +#: ../virt-top/virt_top.ml:175 +msgid "Disable CPU stats in CSV" +msgstr "" + +#: ../virt-top/virt_top.ml:177 +msgid "Disable block device stats in CSV" +msgstr "" + +#: ../virt-top/virt_top.ml:179 +msgid "Disable net stats in CSV" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:493 +msgid "Display free memory for machine, NUMA cell or range of cells" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:437 +msgid "Display the block device statistics for a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:444 +msgid "Display the network interface statistics for a domain." +msgstr "" + +#: ../virt-df/virt_df.ml:358 +msgid "Display version and exit" +msgstr "" + +#: ../virt-top/virt_top.ml:191 +msgid "Do not read init file" +msgstr "" + +#: ../virt-top/virt_top.ml:66 +msgid "Domain ID" +msgstr "" + +#: ../virt-top/virt_top.ml:67 +msgid "Domain name" +msgstr "" + +#: ../virt-top/virt_top.ml:1610 +msgid "Domains display" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:61 ../virt-top/virt_top_main.ml:47 ../virt-top/virt_top.ml:1528 +msgid "Error" +msgstr "" + +#: ../virt-top/virt_top.ml:185 +msgid "Exit at given time" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:79 +msgid "File" +msgstr "" + +#: ../virt-df/virt_df.ml:502 +msgid "Filesystem" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:606 +msgid "Get the current scheduler parameters for a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:623 +msgid "Get the scheduler type." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:635 +msgid "Gracefully shutdown a domain." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:96 ../virt-ctrl/vc_mainwindow.ml:80 ../virt-top/virt_top.ml:1580 +msgid "Help" +msgstr "" + +#: ../virt-top/virt_top.ml:187 +msgid "Historical CPU delay" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:35 +msgid "Hypervisor connection URI" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:405 +msgid "ID" +msgstr "" + +#: ../virt-df/virt_df.ml:500 +msgid "IFree" +msgstr "" + +#: ../virt-df/virt_df.ml:500 +msgid "IUse" +msgstr "" + +#: ../virt-df/virt_df.ml:500 +msgid "Inodes" +msgstr "" + +#: ../virt-df/virt_df_lvm2.ml:33 +msgid "LVM2 not supported yet" +msgstr "" + +#: ../virt-df/virt_df_ext2.ml:82 +msgid "Linux ext2/3" +msgstr "" + +#: ../virt-df/virt_df_linux_swap.ml:33 +msgid "Linux swap" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:557 +msgid "List the active networks." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:565 +msgid "List the defined but inactive networks." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:516 +msgid "List the defined but not running domains." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:508 +msgid "List the running domains." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:158 +msgid "Local QEMU/KVM" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:157 +msgid "Local Xen" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:93 +msgid "Local network" +msgstr "" + +#: ../virt-top/virt_top.ml:173 +msgid "Log statistics to CSV file" +msgstr "" + +#: ../virt-top/virt_top.ml:1563 +msgid "MAIN KEYS" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:409 +msgid "Memory" +msgstr "" + +#: ../virt-top/virt_top.ml:1617 +msgid "More help in virt-top(1) man page. Press any key to return." +msgstr "" + +#: ../virt-df/virt_df.ml:382 ../virt-top/virt_top.ml:258 +msgid "NB: If you want to monitor a local Xen hypervisor, you usually need to be root" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:406 +msgid "Name" +msgstr "" + +#: ../virt-top/virt_top.ml:68 +msgid "Net RX bytes" +msgstr "" + +#: ../virt-top/virt_top.ml:69 +msgid "Net TX bytes" +msgstr "" + +#: ../virt-top/virt_top.ml:1332 +msgid "Not a valid number" +msgstr "" + +#: ../virt-top/virt_top.ml:193 +msgid "Number of iterations to run" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:170 ../virt-ctrl/vc_connection_dlg.ml:137 +msgid "Open" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:418 +msgid "Open a new hypervisor connection." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:86 +msgid "Open connection ..." +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:40 +msgid "Open connection to hypervisor" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:130 +msgid "Pause" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:670 ../mlvirsh/mlvirsh.ml:666 +msgid "Pin domain VCPU to a list of physical CPUs." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:706 +msgid "Print list of commands or full description of one command." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:584 +msgid "Print node information." +msgstr "" + +#: ../virt-df/virt_df.ml:352 ../virt-df/virt_df.ml:350 +msgid "Print sizes in human-readable format" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:440 +msgid "Print the ID of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:464 +msgid "Print the OS type of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:472 +msgid "Print the UUID of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:581 +msgid "Print the UUID of a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:480 +msgid "Print the XML description of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:545 +msgid "Print the XML description of a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:530 +msgid "Print the bridge name of a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:653 +msgid "Print the canonical URI." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:448 +msgid "Print the domain info." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:468 +msgid "Print the domain state." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:646 +msgid "Print the driver name" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:677 +msgid "Print the driver version" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:500 +msgid "Print the hostname." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:522 +msgid "Print the max VCPUs available." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:456 +msgid "Print the max VCPUs of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:452 +msgid "Print the max memory (in kilobytes) of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:460 +msgid "Print the name of a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:569 +msgid "Print the name of a network." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:497 +msgid "Print whether a domain autostarts at boot." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:549 +msgid "Print whether a network autostarts at boot." +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:83 +msgid "QEMU or KVM" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:89 ../virt-top/virt_top.ml:1578 +msgid "Quit" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:519 +msgid "Quit the interactive terminal." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:36 +msgid "Read-only connection" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:587 +msgid "Reboot a domain." +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:134 +msgid "Refresh" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:592 +msgid "Restore a domain from the named file." +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:133 +msgid "Resume" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:595 +msgid "Resume a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:406 +msgid "Returns capabilities of hypervisor/driver." +msgstr "" + +#: ../virt-top/virt_top.ml:199 +msgid "Run from a script (no user interface)" +msgstr "" + +#: ../virt-top/virt_top.ml:1584 +msgid "SORTING" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:599 +msgid "Save a domain to a file." +msgstr "" + +#: ../virt-top/virt_top.ml:197 +msgid "Secure (\\\"kiosk\\\") mode" +msgstr "" + +#: ../virt-top/virt_top.ml:1593 +msgid "Select sort field" +msgstr "" + +#: ../virt-top/virt_top.ml:183 +msgid "Send debug messages to file" +msgstr "" + +#: ../virt-top/virt_top.ml:189 +msgid "Set name of init file" +msgstr "" + +#: ../virt-top/virt_top.ml:195 +msgid "Set sort order (%s)" +msgstr "" + +#: ../virt-top/virt_top.ml:1340 +msgid "Set sort order for main display" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:631 +msgid "Set the maximum memory used by the domain (in kilobytes)." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:627 +msgid "Set the memory used by the domain (in kilobytes)." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:674 +msgid "Set the number of virtual CPUs assigned to a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:618 +msgid "Set the scheduler parameters for a domain." +msgstr "" + +#: ../virt-top/virt_top.ml:1579 +msgid "Set update interval" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:403 +msgid "Set whether a domain autostarts at boot." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:526 +msgid "Set whether a network autostarts at boot." +msgstr "" + +#: ../virt-df/virt_df.ml:344 ../virt-df/virt_df.ml:342 +msgid "Show all domains (default: only active domains)" +msgstr "" + +#: ../virt-df/virt_df.ml:356 ../virt-df/virt_df.ml:354 +msgid "Show inodes instead of blocks" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:137 +msgid "Shutdown" +msgstr "" + +#: ../virt-df/virt_df.ml:499 +msgid "Size" +msgstr "" + +#: ../virt-top/virt_top.ml:1589 +msgid "Sort by %CPU" +msgstr "" + +#: ../virt-top/virt_top.ml:1590 +msgid "Sort by %MEM" +msgstr "" + +#: ../virt-top/virt_top.ml:1592 +msgid "Sort by ID" +msgstr "" + +#: ../virt-top/virt_top.ml:1591 +msgid "Sort by TIME" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:127 +msgid "Start" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:639 +msgid "Start a previously defined inactive domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:573 +msgid "Start a previously defined inactive network." +msgstr "" + +#: ../virt-top/virt_top.ml:165 +msgid "Start by displaying block devices" +msgstr "" + +#: ../virt-top/virt_top.ml:163 +msgid "Start by displaying network interfaces" +msgstr "" + +#: ../virt-top/virt_top.ml:161 +msgid "Start by displaying pCPUs (default: tasks)" +msgstr "" + +#: ../virt-ctrl/vc_connections.ml:407 +msgid "Status" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:643 +msgid "Suspend a domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:40 +msgid "Synopsis:\n %s [options] [command]\n\nList of all commands:\n %s help\n\nFull description of a single command:\n %s help command\n\nOptions:" +msgstr "" + +#: ../virt-top/virt_top.ml:65 +msgid "TIME (CPU time)" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:62 +msgid "This machine" +msgstr "" + +#: ../virt-top/virt_top.ml:1613 +msgid "Toggle block devices" +msgstr "" + +#: ../virt-top/virt_top.ml:1612 +msgid "Toggle network interfaces" +msgstr "" + +#: ../virt-top/virt_top.ml:1611 +msgid "Toggle physical CPUs" +msgstr "" + +#: ../virt-df/virt_df.ml:502 +msgid "Type" +msgstr "" + +#: ../virt-top/virt_top.ml:1341 +msgid "Type key or use up and down cursor keys." +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:160 +msgid "URI connection" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:650 +msgid "Undefine an inactive domain." +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:577 +msgid "Undefine an inactive network." +msgstr "" + +#: ../virt-top/virt_top.ml:1622 +msgid "Unknown command - try 'h' for help" +msgstr "" + +#: ../virt-top/virt_top.ml:1577 +msgid "Update display" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:690 +msgid "Use '%s help command' for help on a command." +msgstr "" + +#: ../virt-df/virt_df.ml:499 ../virt-df/virt_df.ml:498 +msgid "Used" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:23 +msgid "Virtual Control" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:53 +msgid "Virtualisation error" +msgstr "" + +#: ../virt-ctrl/vc_mainwindow.ml:39 +msgid "Virtualization control tool (virt-ctrl) by\nRichard W.M. Jones (rjones@redhat.com).\n\nCopyright %s 2007-2008 Red Hat Inc.\n\nLibvirt version: %s\n\nGtk toolkit version: %s" +msgstr "" + +#: ../virt-top/virt_top.ml:1523 +msgid "Wrote settings to %s" +msgstr "" + +#: ../virt-ctrl/vc_connection_dlg.ml:76 +msgid "Xen hypervisor" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:364 +msgid "\\tCPU time: %Ld ns\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:362 +msgid "\\tcurrent state: %s\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:361 +msgid "\\ton physical CPU: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:298 ../mlvirsh/mlvirsh.ml:289 ../virt-ctrl/vc_helpers.ml:54 +msgid "blocked" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:330 +msgid "cores: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:342 +msgid "cpu_time: %Ld ns\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:326 +msgid "cpus: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:293 ../virt-ctrl/vc_helpers.ml:58 +msgid "crashed" +msgstr "" + +#: ../virt-df/virt_df.ml:236 +msgid "detection of unpartitioned devices not yet supported" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:242 +msgid "domain %s: not found. Additional info: %s" +msgstr "" + +#: ../virt-df/virt_df_ext2.ml:39 +msgid "error reading ext2/ext3 magic" +msgstr "" + +#: ../virt-df/virt_df.ml:182 +msgid "error reading extended partition" +msgstr "" + +#: ../virt-df/virt_df.ml:149 +msgid "error reading partition table" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:239 +msgid "error set after getting System bus" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:379 +msgid "errors: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:258 +msgid "expected field value pairs, but got an odd number of arguments" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:610 +msgid "expecting domain followed by field value pairs" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:220 +msgid "flag should be '%s'" +msgstr "" + +#: ../virt-df/virt_df.ml:419 ../virt-top/virt_top_xml.ml:46 +msgid "get_xml_desc didn't return " +msgstr "" + +#: ../virt-df/virt_df.ml:427 +msgid "get_xml_desc returned no node in XML" +msgstr "" + +#: ../virt-df/virt_df.ml:430 +msgid "get_xml_desc returned strange node" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:700 +msgid "help: %s: command not found" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:188 ../mlvirsh/mlvirsh.ml:182 ../mlvirsh/mlvirsh.ml:177 ../mlvirsh/mlvirsh.ml:172 ../mlvirsh/mlvirsh.ml:168 ../mlvirsh/mlvirsh.ml:164 ../mlvirsh/mlvirsh.ml:160 +msgid "incorrect number of arguments for function" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:339 +msgid "max_mem: %Ld K\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:340 ../mlvirsh/mlvirsh.ml:325 +msgid "memory: %Ld K\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:327 +msgid "mhz: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:727 +msgid "mlvirsh" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:725 +msgid "mlvirsh(no connection)" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:726 +msgid "mlvirsh(ro)" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:324 +msgid "model: %s\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:253 +msgid "network %s: not found. Additional info: %s" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:328 +msgid "nodes: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:202 ../mlvirsh/mlvirsh.ml:197 +msgid "not connected to the hypervisor" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:341 +msgid "nr_virt_cpu: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:296 +msgid "offline" +msgstr "" + +#: ../virt-df/virt_df_ext2.ml:42 +msgid "partition marked EXT2/3 but no valid filesystem" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:290 ../virt-ctrl/vc_helpers.ml:55 +msgid "paused" +msgstr "" + +#: ../virt-df/virt_df.ml:188 +msgid "probe_extended_partition: internal error" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:376 +msgid "read bytes: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:375 +msgid "read requests: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:297 ../mlvirsh/mlvirsh.ml:288 ../virt-ctrl/vc_helpers.ml:53 +msgid "running" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:384 +msgid "rx bytes: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:387 +msgid "rx dropped: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:386 +msgid "rx errs: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:385 +msgid "rx packets: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:226 +msgid "setting should be '%s' or '%s'" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:291 ../virt-ctrl/vc_helpers.ml:56 +msgid "shutdown" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:292 ../virt-ctrl/vc_helpers.ml:57 +msgid "shutoff" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:329 +msgid "sockets: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:338 +msgid "state: %s\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:331 +msgid "threads: %d\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:198 +msgid "tried to do read-write operation on read-only hypervisor connection" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:388 +msgid "tx bytes: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:391 +msgid "tx dropped: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:390 +msgid "tx errs: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:389 +msgid "tx packets: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:287 ../virt-ctrl/vc_helpers.ml:52 +msgid "unknown" +msgstr "" + +#: ../virt-df/virt_df.ml:246 +msgid "unsupported partition type %02x" +msgstr "" + +#: ../virt-df/virt_df.ml:363 +msgid "virt-df : like 'df', shows disk space used in guests\n\nSUMMARY\n virt-df [-options]\n\nOPTIONS" +msgstr "" + +#: ../virt-top/virt_top.ml:1543 +msgid "virt-top %s (libvirt %d.%d.%d) by Red Hat" +msgstr "" + +#: ../virt-top/virt_top.ml:203 +msgid "virt-top : a 'top'-like utility for virtualization\n\nSUMMARY\n virt-top [-options]\n\nOPTIONS" +msgstr "" + +#: ../virt-top/virt_top.ml:40 +msgid "virt-top was compiled without support for CSV files" +msgstr "" + +#: ../virt-top/virt_top.ml:51 +msgid "virt-top was compiled without support for dates and times" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:360 +msgid "virtual CPU: %d\\n" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:219 +msgid "warning: ignored unknown message %s from %s\\n%!" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:124 +msgid "warning: unexpected message contents of Found signal" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:188 +msgid "warning: unexpected message contents of ItemNew signal" +msgstr "" + +#: ../virt-ctrl/vc_dbus.ml:140 +msgid "warning: unexpected message contents of ItemRemove signal" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:378 +msgid "write bytes: %Ld\\n" +msgstr "" + +#: ../mlvirsh/mlvirsh.ml:377 +msgid "write requests: %Ld\\n" +msgstr "" + diff --git a/virt-ctrl/.depend b/virt-ctrl/.depend deleted file mode 100644 index 5b01507..0000000 --- a/virt-ctrl/.depend +++ /dev/null @@ -1,24 +0,0 @@ -vc_connections.cmi: ../libvirt/libvirt.cmi -vc_domain_ops.cmi: vc_connections.cmi -vc_helpers.cmi: ../libvirt/libvirt.cmi -vc_mainwindow.cmi: vc_domain_ops.cmi -vc_connection_dlg.cmo: vc_connections.cmi vc_connection_dlg.cmi -vc_connection_dlg.cmx: vc_connections.cmx vc_connection_dlg.cmi -vc_connections.cmo: vc_helpers.cmi ../libvirt/libvirt.cmi vc_connections.cmi -vc_connections.cmx: vc_helpers.cmx ../libvirt/libvirt.cmx vc_connections.cmi -vc_dbus.cmo: vc_connection_dlg.cmi vc_dbus.cmi -vc_dbus.cmx: vc_connection_dlg.cmx vc_dbus.cmi -vc_domain_ops.cmo: vc_connections.cmi ../libvirt/libvirt.cmi \ - vc_domain_ops.cmi -vc_domain_ops.cmx: vc_connections.cmx ../libvirt/libvirt.cmx \ - vc_domain_ops.cmi -vc_helpers.cmo: ../libvirt/libvirt.cmi vc_helpers.cmi -vc_helpers.cmx: ../libvirt/libvirt.cmx vc_helpers.cmi -vc_icons.cmo: vc_connection_dlg.cmi -vc_icons.cmx: vc_connection_dlg.cmx -vc_mainwindow.cmo: vc_connections.cmi vc_connection_dlg.cmi \ - ../libvirt/libvirt.cmi vc_mainwindow.cmi -vc_mainwindow.cmx: vc_connections.cmx vc_connection_dlg.cmx \ - ../libvirt/libvirt.cmx vc_mainwindow.cmi -virt_ctrl.cmo: vc_mainwindow.cmi vc_domain_ops.cmi -virt_ctrl.cmx: vc_mainwindow.cmx vc_domain_ops.cmx diff --git a/virt-ctrl/Makefile.in b/virt-ctrl/Makefile.in deleted file mode 100644 index 1b4e529..0000000 --- a/virt-ctrl/Makefile.in +++ /dev/null @@ -1,131 +0,0 @@ -# virt-ctrl (originally called mlvirtmanager) -# Copyright (C) 2007 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 -# 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. - -INSTALL := @INSTALL@ - -prefix = @prefix@ -exec_prefix = @exec_prefix@ -bindir = @bindir@ - -with_icons = @with_icons@ -icons = @icons@ - -HAVE_GDK_PIXBUF_MLSOURCE = @HAVE_GDK_PIXBUF_MLSOURCE@ - -pkg_dbus = @pkg_dbus@ - -OCAMLFIND = @OCAMLFIND@ - -OBJS += \ - vc_helpers.cmo \ - vc_connections.cmo \ - vc_domain_ops.cmo \ - vc_connection_dlg.cmo \ - vc_mainwindow.cmo - -ifneq ($(OCAMLFIND),) -# Good, we have ocamlfind. -OCAMLCPACKAGES := -I ../libvirt -package unix,lablgtk2 -ifeq ($(pkg_dbus),yes) -OCAMLCPACKAGES := $(OCAMLCPACKAGES),dbus -OBJS += vc_dbus.cmo -endif -OCAMLCFLAGS := -g -OCAMLCLIBS := -linkpkg -OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) -OCAMLOPTFLAGS := -OCAMLOPTLIBS := $(OCAMLCLIBS) -else -# Bad boy, please install ocamlfind. -OCAMLCINCS := -I ../libvirt -I @pkg_lablgtk2@ -OCAMLCFLAGS := -g -OCAMLCLIBS := unix.cma lablgtk.cma -OCAMLOPTINCS := $(OCAMLCINCS) -OCAMLOPTFLAGS := -OCAMLOPTLIBS := unix.cmxa lablgtk.cmxa -endif - -ifneq ($(with_icons),no) -OBJS += vc_icons.cmo -endif - -export LIBRARY_PATH=../libvirt -export LD_LIBRARY_PATH=../libvirt - -BYTE_TARGETS := virt-ctrl -OPT_TARGETS := virt-ctrl.opt - -OBJS += virt_ctrl.cmo - -XOBJS := $(OBJS:.cmo=.cmx) - -all: $(BYTE_TARGETS) - -opt: $(OPT_TARGETS) - -ifneq ($(OCAMLFIND),) -virt-ctrl: $(OBJS) - $(OCAMLFIND) ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma gtkInit.cmo -o $@ $^ - -virt-ctrl.opt: $(XOBJS) - $(OCAMLFIND) ocamlopt \ - $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa gtkInit.cmx -o $@ $^ -else -virt-ctrl: $(OBJS) - $(OCAMLC) $(OCAMLCINCS) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma gtkInit.cmo -o $@ $^ - -host_os = @host_os@ - -ifneq ($(host_os),mingw32) -virt-ctrl.opt: $(XOBJS) - $(OCAMLOPT) $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - $(patsubst %,-cclib %,$(LDFLAGS)) \ - ../libvirt/mllibvirt.cmxa gtkInit.cmx -o $@ $^ -else -# On MinGW, use a hacked 'gcc' wrapper which understands the @... -# syntax for extending the command line. -gcc.exe: mingw-gcc-wrapper.ml - $(OCAMLC) unix.cma $< -o $@ - -virt-ctrl.opt: $(XOBJS) gcc.exe - PATH=.:$$PATH \ - $(OCAMLOPT) $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - $(patsubst %,-cclib %,$(LDFLAGS)) \ - ../libvirt/mllibvirt.cmxa gtkInit.cmx -o $@ $(XOBJS) -endif -endif - -# Rebuild the icons if newer ones available. -ifneq ($(with_icons),no) -ifneq ($(icons),) -ifeq ($(HAVE_GDK_PIXBUF_MLSOURCE),gdk-pixbuf-mlsource) -vc_icons.ml: rebuild-icons.sh - ./rebuild-icons.sh $(icons) > $@ -endif -endif -endif - -install: - if [ -x virt-ctrl.opt ]; then \ - mkdir -p $(DESTDIR)$(bindir); \ - $(INSTALL) -m 0755 virt-ctrl.opt $(DESTDIR)$(bindir)/virt-ctrl; \ - fi - -include ../Make.rules diff --git a/virt-ctrl/mingw-gcc-wrapper.ml b/virt-ctrl/mingw-gcc-wrapper.ml deleted file mode 100755 index 21cdb8f..0000000 --- a/virt-ctrl/mingw-gcc-wrapper.ml +++ /dev/null @@ -1,70 +0,0 @@ -(* Wrapper around 'gcc'. On MinGW, this wrapper understands the '@...' - * syntax for extending the command line. - *) - -open Printf -open Unix - -let (//) = Filename.concat - -(* Substitute any @... arguments with the file content. *) -let rec input_all_lines chan = - try - let line = input_line chan in - line :: input_all_lines chan - with - End_of_file -> [] - -let argv = Array.map ( - fun arg -> - if arg.[0] = '@' then ( - let chan = open_in (String.sub arg 1 (String.length arg - 1)) in - let lines = input_all_lines chan in - close_in chan; - lines - ) else - [arg] -) Sys.argv - -let argv = Array.to_list argv -let argv = List.flatten argv - -(* Find the real gcc.exe on $PATH, but ignore any '.' elements in the path. - * Note that on Windows, $PATH is split with ';' characters. - *) -let rec split_find str sep f = - try - let i = String.index str sep in - let n = String.length str in - let str, str' = String.sub str 0 i, String.sub str (i+1) (n-i-1) in - match f str with - | None -> split_find str' sep f (* not found, keep searching *) - | Some found -> found - with - Not_found -> - match f str with - | None -> raise Not_found (* not found at all *) - | Some found -> found - -let exists filename = - try access filename [F_OK]; true with Unix_error _ -> false - -let gcc = - split_find (Sys.getenv "PATH") ';' - (function - | "." -> None (* ignore current directory in path *) - | path -> - let gcc = path // "gcc.exe" in - if exists gcc then Some gcc else None) - -(* Finally execute the real gcc with the full argument list. - * Can't use execv here because then the parent process (ocamlopt) thinks - * that this process has finished and deletes all the temp files. Stupid - * Windoze! - *) -let _ = - let argv = List.map Filename.quote (List.tl argv) in - let cmd = String.concat " " (gcc :: argv) in - eprintf "mingw-gcc-wrapper: %s\n%!" cmd; - let r = Sys.command cmd in - exit r diff --git a/virt-ctrl/rebuild-icons.sh b/virt-ctrl/rebuild-icons.sh deleted file mode 100755 index 399e182..0000000 --- a/virt-ctrl/rebuild-icons.sh +++ /dev/null @@ -1,44 +0,0 @@ -#!/bin/sh - -# Copyright (C) 2008 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 -# 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. - -# Generate vc_icons.ml - -echo <<'EOF' -(* The file vc_icons.ml is automatically generated from rebuild-icons.sh - * Any changes you make will be lost. - *) - -EOF -echo - -# Open any modules which may use icons. -echo "open Vc_connection_dlg" -echo - -while [ $# -gt 0 ]; do - size="$1" - name="$2" - filename="$3" - shift 3 - - gdk-pixbuf-mlsource "$filename" - echo ";;" - - name=`echo -n $name | tr -cs '[0-9a-zA-Z]' '_'` - - echo "icon_${size}x${size}_$name := Some (pixbuf ()) ;;" -done \ No newline at end of file diff --git a/virt-ctrl/vc_connection_dlg.ml b/virt-ctrl/vc_connection_dlg.ml deleted file mode 100644 index 9575efc..0000000 --- a/virt-ctrl/vc_connection_dlg.ml +++ /dev/null @@ -1,200 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. -*) - -type name = string -type uri = string -type service = name * uri - -let local_xen_uri = "xen:///" -let local_qemu_uri = "qemu:///system" - -(* Code in Vc_dbus overrides this, if that capability was compiled in. *) -let find_libvirtd_with_zeroconf = ref (fun () -> []) - -(* Code in Vc_icons may override these with icons. *) -let icon_16x16_devices_computer_png = ref None -let icon_24x24_devices_computer_png = ref None -let icon_32x32_devices_computer_png = ref None -let icon_48x48_devices_computer_png = ref None - -(* Open connection dialog. *) -let open_connection parent () = - let title = "Open connection to hypervisor" in - let position = `CENTER_ON_PARENT in - - let dlg = GWindow.dialog ~title ~position ~parent - ~modal:true ~width:450 () in - - (* We will enter the Gtk main loop recursively. Wire up close and - * other buttons to quit the recursive main loop. - *) - ignore (dlg#connect#destroy ~callback:GMain.quit); - ignore (dlg#event#connect#delete - ~callback:(fun _ -> GMain.quit (); false)); - - let uri = ref None in - - (* Pack the buttons into the dialog. *) - let vbox = dlg#vbox in - vbox#set_spacing 5; - - (* Local connections. *) - let () = - let frame = - GBin.frame ~label:"This machine" ~packing:vbox#pack () in - let hbox = GPack.hbox ~packing:frame#add () in - hbox#set_spacing 20; - ignore ( - let packing = hbox#pack in - match !icon_24x24_devices_computer_png with - | None -> GMisc.image ~stock:`DIRECTORY ~packing () - | Some pixbuf -> GMisc.image ~pixbuf ~packing () - ); - - let vbox = GPack.vbox ~packing:hbox#pack () in - vbox#set_spacing 5; - - let xen_button = - GButton.button ~label:"Xen hypervisor" - ~packing:vbox#pack () in - ignore (xen_button#connect#clicked - ~callback:(fun () -> - uri := Some local_xen_uri; - dlg#destroy ())); - let qemu_button = - GButton.button ~label:"QEMU or KVM" - ~packing:vbox#pack () in - ignore (qemu_button#connect#clicked - ~callback:(fun () -> - uri := Some local_qemu_uri; - dlg#destroy ())) in - - (* Network connections. *) - let () = - let frame = - GBin.frame ~label:"Local network" - ~packing:(vbox#pack ~expand:true) () in - let hbox = GPack.hbox ~packing:frame#add () in - hbox#set_spacing 20; - ignore (GMisc.image ~stock:`NETWORK ~packing:hbox#pack ()); - - let vbox = GPack.vbox ~packing:(hbox#pack ~expand:true) () in - vbox#set_spacing 5; - - let cols = new GTree.column_list in - (*let col_icon = cols#add Gobject.Data.string in*) - let col_name = cols#add Gobject.Data.string in - let model = GTree.list_store cols in - - let icons = GTree.icon_view - ~selection_mode:`SINGLE ~model - ~height:200 - ~packing:(vbox#pack ~expand:true ~fill:true) () in - icons#set_border_width 4; - - (*icons#set_pixbuf_column col_icon;*) - icons#set_text_column col_name; - - let refresh () = - model#clear (); - let services = !find_libvirtd_with_zeroconf () in - - (*let pixbuf = !icon_16x16_devices_computer_png in*) - List.iter ( - fun (name, _) -> - let row = model#append () in - model#set ~row ~column:col_name name; - (*match pixbuf with - | None -> () - | Some pixbuf -> model#set ~row ~column:col_icon pixbuf*) - ) services - in - refresh (); - - let hbox = GPack.hbox ~packing:vbox#pack () in - let refresh_button = - GButton.button ~label:"Refresh" ~stock:`REFRESH ~packing:hbox#pack () in - let open_button = - GButton.button ~label:"Open" ~packing:hbox#pack () in - - ignore (refresh_button#connect#clicked ~callback:refresh); - - (* Function callback when someone selects and hits Open. *) - let callback () = - match icons#get_selected_items with - | [] -> () (* nothing selected *) - | path :: _ -> - let row = model#get_iter path in - let name = model#get ~row ~column:col_name in - let services = !find_libvirtd_with_zeroconf () in - try - uri := Some (List.assoc name services); - dlg#destroy () - with - Not_found -> () in - - ignore (open_button#connect#clicked ~callback) in - - (* Custom connections. *) - let () = - let frame = - GBin.frame ~label:"URI connection" ~packing:vbox#pack () in - let hbox = GPack.hbox ~packing:frame#add () in - hbox#set_spacing 20; - ignore (GMisc.image ~stock:`CONNECT ~packing:hbox#pack ()); - - let hbox = GPack.hbox ~packing:(hbox#pack ~expand:true) () in - let entry = - GEdit.entry ~text:"xen://localhost/" - ~packing:(hbox#pack ~expand:true ~fill:true) () in - let button = - GButton.button ~label:"Open" ~packing:hbox#pack () in - - ignore (button#connect#clicked - ~callback:(fun () -> - uri := Some entry#text; - dlg#destroy ())); - - () in - - - (* Just a cancel button in the action area. *) - let cancel_button = - GButton.button ~label:"Cancel" - ~packing:dlg#action_area#pack () in - ignore (cancel_button#connect#clicked - ~callback:(fun () -> - uri := None; - dlg#destroy ())); - - dlg#show (); - - (* Enter Gtk main loop recursively. *) - GMain.main (); - - match !uri with - | None -> () - | Some uri -> Vc_connections.open_connection uri - -(* Callback from the Connect button drop-down menu. *) -let open_local_xen () = - Vc_connections.open_connection local_xen_uri - -let open_local_qemu () = - Vc_connections.open_connection local_qemu_uri diff --git a/virt-ctrl/vc_connection_dlg.mli b/virt-ctrl/vc_connection_dlg.mli deleted file mode 100644 index 0102713..0000000 --- a/virt-ctrl/vc_connection_dlg.mli +++ /dev/null @@ -1,43 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. - - Make the main window. -*) - -(** The connection dialog. *) -val open_connection : GWindow.window -> unit -> unit - -(** Quick connect to local Xen. *) -val open_local_xen : unit -> unit - -(** Quick connect to local QEMU or KVM. *) -val open_local_qemu : unit -> unit - -type name = string -type uri = string -type service = name * uri - -(** Hook to find libvirtd network services with zeroconf using some - external method, eg. D-Bus or Avahi. *) -val find_libvirtd_with_zeroconf : (unit -> service list) ref - -(** Hooks for icons. *) -val icon_16x16_devices_computer_png : GdkPixbuf.pixbuf option ref -val icon_24x24_devices_computer_png : GdkPixbuf.pixbuf option ref -val icon_32x32_devices_computer_png : GdkPixbuf.pixbuf option ref -val icon_48x48_devices_computer_png : GdkPixbuf.pixbuf option ref diff --git a/virt-ctrl/vc_connections.ml b/virt-ctrl/vc_connections.ml deleted file mode 100644 index 05024c5..0000000 --- a/virt-ctrl/vc_connections.ml +++ /dev/null @@ -1,476 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. -*) - -open Printf - -module C = Libvirt.Connect -module D = Libvirt.Domain -module N = Libvirt.Network - -open Vc_helpers - -(* List of currently open connections. Actually it's a list of - * (id, Libvirt.Connect.t) so that we can easily identify - * connections by their unique ID. - *) -let get_conns, add_conn, del_conn = - let conns = ref [] in - let id = ref 0 in - let get_conns () = !conns in - let add_conn conn = - incr id; let id = !id in - conns := (id, conn) :: !conns; - id - in - let del_conn id = - conns := List.filter (fun (id', _) -> id <> id') !conns - in - get_conns, add_conn, del_conn - -(* Store the node_info and hostname for each connection, fetched - * once just after we connect since these don't normally change. - * Hash of connid -> (C.node_info, hostname option, uri) - *) -let static_conn_info = Hashtbl.create 13 - -let open_connection uri = - (* If this fails, let the exception escape and be printed - * in the global exception handler. - *) - let conn = C.connect ~name:uri () in - - let node_info = C.get_node_info conn in - let hostname = - try Some (C.get_hostname conn) - with - | Libvirt.Not_supported "virConnectGetHostname" - | Libvirt.Virterror _ -> None in - - (* Add it to our list of connections. *) - let conn_id = add_conn conn in - Hashtbl.add static_conn_info conn_id (node_info, hostname, uri) - -(* Stores the state and history for each domain. - * Hash of (connid, domid) -> mutable domhistory structure. - * We never delete entries in this hash table, which may be a problem - * for very very long-lived instances of virt-ctrl. - *) -type domhistory = { - (* for %CPU calculation: *) - mutable last_cpu_time : int64; (* last virDomainInfo->cpuTime *) - mutable last_time : float; (* exact time we measured the above *) - - (* historical data for graphs etc: *) - mutable hist : dhentry array; (* historical data *) - mutable hist_posn : int; (* position within array *) -} -and dhentry = { - hist_cpu : int; (* historical %CPU entry *) - hist_mem : int64; (* historical memory entry (KB) *) -} - -let domhistory = Hashtbl.create 13 - -let empty_dhentry = { - hist_cpu = 0; hist_mem = 0L; -} -let new_domhistory () = { - last_cpu_time = 0L; last_time = 0.; - hist = Array.make 0 empty_dhentry; hist_posn = 0; -} - -(* These set limits on the amount of history we collect. *) -let hist_max = 86400 (* max history stored, seconds *) -let hist_rot = 3600 (* rotation of array when we hit max *) - -(* The current state. This is used so that we can see changes that - * have happened and add or remove parts of the model. (Previously - * we used to recreate the whole model each time, but the problem - * with that is we "forget" things like the selection). - *) -type state = connection list -and connection = int (* connection ID *) * (active list * inactive list) -and active = int (* domain's ID *) -and inactive = string (* domain's name *) - -(* The types of the display columns in the main window. The interesting - * one of the final (int) field which stores the ID of the row, either - * connid or domid. - *) -type columns = string GTree.column * string GTree.column * string GTree.column * string GTree.column * string GTree.column * int GTree.column - -let debug_repopulate = false - -(* Populate the tree with the current list of connections, domains. - * This function is called once per second. - *) -let repopulate (tree : GTree.view) (model : GTree.tree_store) - (col_name_id, col_domname, col_status, col_cpu, col_mem, col_id) - state = - (* Which connections have been added or removed? *) - let conns = get_conns () in - let added, _, removed = - let old_conn_ids = List.map fst state - and new_conn_ids = List.map fst conns in - differences old_conn_ids new_conn_ids in - - (* Remove the subtrees for any connections which have gone. *) - if debug_repopulate then List.iter (eprintf "-connection %d\n%!") removed; - - List.iter ( - fun conn_id -> - filter_top_level_rows model - (fun row -> conn_id <> model#get ~row ~column:col_id) - ) removed; - - (* Add placeholder subtree for any new connections. *) - if debug_repopulate then List.iter (eprintf "+connection %d\n%!") added; - - List.iter ( - fun conn_id -> - let row = model#append () in - (* Get the connection name, usually the hostname. *) - let name = - match Hashtbl.find static_conn_info conn_id with - | (_, Some hostname, _) -> hostname - | (_, None, _) -> sprintf "Conn #%d" conn_id in - model#set ~row ~column:col_name_id name; - model#set ~row ~column:col_id conn_id; - (* Expand the new row. *) - (* XXX This doesn't work, why? - Because we haven't create subrows yet.*) - tree#expand_row (model#get_path row) - ) added; - - let new_state = - List.map ( - fun (conn_id, conn) -> - (* Get the old list of active and inactive domains. If this - * connection is newly created, start with empty lists. - *) - let old_active, old_inactive = - try List.assoc conn_id state - with Not_found -> [], [] in - - (* Get the top level row in the model corresponding to this - * connection. - *) - let parent = - try find_top_level_row model - (fun row -> conn_id = model#get ~row ~column:col_id) - with Not_found -> assert false (* Should never happen. *) in - - try - (* Number of CPUs available. *) - let node_info, _, _ = Hashtbl.find static_conn_info conn_id in - let nr_cpus = C.maxcpus_of_node_info node_info in - - (* For this connection, get a current list of active domains (IDs) *) - let active = - let n = C.num_of_domains conn in - let doms = C.list_domains conn n in - Array.to_list doms in - - (* Which active domains have been added or removed? *) - let added, _, removed = differences old_active active in - - (* Remove any active domains which have disappeared. *) - if debug_repopulate then - List.iter (eprintf "-active %d\n%!") removed; - - List.iter ( - fun domid -> - filter_rows model - (fun row -> domid <> model#get ~row ~column:col_id) - (model#iter_children (Some parent)) - ) removed; - - (* Add any active domains which have appeared. *) - if debug_repopulate then - List.iter (eprintf "+active %d\n%!") added; - - List.iter ( - fun domid -> - let domname = - try - let dom = D.lookup_by_id conn domid in - D.get_name dom - with _ -> "" in (* Ignore any transient error. *) - - let row = model#append ~parent () in - model#set ~row ~column:col_name_id (string_of_int domid); - model#set ~row ~column:col_domname domname; - model#set ~row ~column:col_id domid - ) added; - - (* Get a current list of inactive domains (names). *) - let inactive = - let n = C.num_of_defined_domains conn in - let doms = C.list_defined_domains conn n in - Array.to_list doms in - - (* Which inactive domains have been added or removed? *) - let added, _, removed = differences old_inactive inactive in - - (* Remove any inactive domains which have disappeared. *) - if debug_repopulate then - List.iter (eprintf "-inactive %s\n%!") removed; - - List.iter ( - fun domname -> - filter_rows model - (fun row -> - model#get ~row ~column:col_id <> -1 || - model#get ~row ~column:col_domname <> domname) - (model#iter_children (Some parent)) - ) removed; - - (* Add any inactive domains which have appeared. *) - if debug_repopulate then - List.iter (eprintf "+inactive %s\n%!") added; - - List.iter ( - fun domname -> - let row = model#append ~parent () in - model#set ~row ~column:col_name_id ""; - model#set ~row ~column:col_domname domname; - model#set ~row ~column:col_status "inactive"; - model#set ~row ~column:col_id (-1) - ) added; - - (* Now iterate over all active domains and update their state, - * CPU and memory. - *) - iter_rows model ( - fun row -> - let domid = model#get ~row ~column:col_id in - if domid >= 0 then ( (* active *) - try - let dom = D.lookup_by_id conn domid in - let info = D.get_info dom in - let status = string_of_domain_state info.D.state in - model#set ~row ~column:col_status status; - let memory = sprintf "%Ld K" info.D.memory in - model#set ~row ~column:col_mem memory; - - (* Get domhistory. For a new domain it won't exist, so - * create an empty one. - *) - let dh = - let key = conn_id, domid in - try Hashtbl.find domhistory key - with Not_found -> - let dh = new_domhistory () in - Hashtbl.add domhistory key dh; - dh in - - (* Measure current time and domain cpuTime as close - * together as possible. - *) - let time_now = Unix.gettimeofday () in - let cpu_now = info.D.cpu_time in - - let time_prev = dh.last_time in - let cpu_prev = - if dh.last_cpu_time > cpu_now then 0L (* Rebooted? *) - else dh.last_cpu_time in - - dh.last_time <- time_now; - dh.last_cpu_time <- cpu_now; - - let cpu_percent = - if time_prev > 0. then ( - let cpu_now = Int64.to_float cpu_now in - let cpu_prev = Int64.to_float cpu_prev in - let cpu_used = cpu_now -. cpu_prev in - let cpu_available = 1_000_000_000. *. float nr_cpus in - let time_passed = time_now -. time_prev in - - let cpu_percent = - 100. *. (cpu_used /. cpu_available) /. time_passed in - - let cpu_percent = - if cpu_percent < 0. then 0. - else if cpu_percent > 100. then 100. - else cpu_percent in - - let cpu_percent_str = sprintf "%.1f %%" cpu_percent in - model#set ~row ~column:col_cpu cpu_percent_str; - int_of_float cpu_percent - ) else -1 in - - (* Store history. *) - let datum = { hist_cpu = cpu_percent; - hist_mem = info.D.memory } in - - if dh.hist_posn >= hist_max then ( - (* rotate the array *) - Array.blit dh.hist hist_rot dh.hist 0 (hist_max-hist_rot); - dh.hist_posn <- dh.hist_posn - hist_rot; - dh.hist.(dh.hist_posn) <- datum; - ) else ( - let len = Array.length dh.hist in - if dh.hist_posn < len then - (* normal update *) - dh.hist.(dh.hist_posn) <- datum - else ( - (* extend the array *) - let len' = min (max (2*len) 1) hist_max in - let arr' = Array.make len' datum in - Array.blit dh.hist 0 arr' 0 len; - dh.hist <- arr'; - ) - ); - dh.hist_posn <- dh.hist_posn+1 - - with - Libvirt.Virterror _ -> () (* Ignore any transient error *) - ) - ) (model#iter_children (Some parent)); - - (* Return new state. *) - conn_id, (active, inactive) - with - (* Libvirt errors here are not really fatal. They can happen - * if the state changes at the moment we read it. If it does - * happen, just return the old state, and next time we come - * around to this connection it'll be fixed. - *) - | Libvirt.Virterror err -> - prerr_endline (Libvirt.Virterror.to_string err); - conn_id, (old_active, old_inactive) - | Failure msg -> - prerr_endline msg; - conn_id, (old_active, old_inactive) - ) conns in - - (* Return the updated state. *) - new_state - -(* Make the treeview which displays the connections and domains. *) -let make_treeview ?packing () = - let cols = new GTree.column_list in - let col_name_id = cols#add Gobject.Data.string in - let col_domname = cols#add Gobject.Data.string in - let col_status = cols#add Gobject.Data.string in - let col_cpu = cols#add Gobject.Data.string in - let col_mem = cols#add Gobject.Data.string in - (* Hidden column containing the connection ID or domain ID. For - * inactive domains, this contains -1 and col_domname is the name. *) - let col_id = cols#add Gobject.Data.int in - let model = GTree.tree_store cols in - - (* Column sorting functions. *) - let make_sort_func_on column = - fun (model : GTree.model) row1 row2 -> - let col1 = model#get ~row:row1 ~column in - let col2 = model#get ~row:row2 ~column in - compare col1 col2 - in - (*model#set_default_sort_func (make_sort_func_on col_domname);*) - model#set_sort_func 0 (make_sort_func_on col_name_id); - model#set_sort_func 1 (make_sort_func_on col_domname); - model#set_sort_column_id 1 `ASCENDING; - - (* Make the GtkTreeView and attach column renderers to it. *) - let tree = GTree.view ~model ~reorderable:false ?packing () in - - let append_visible_column title column sort = - let renderer = GTree.cell_renderer_text [], ["text", column] in - let view_col = GTree.view_column ~title ~renderer () in - ignore (tree#append_column view_col); - match sort with - | None -> () - | Some (sort_indicator, sort_order, sort_column_id) -> - view_col#set_sort_indicator sort_indicator; - view_col#set_sort_order sort_order; - view_col#set_sort_column_id sort_column_id - in - append_visible_column "ID" col_name_id (Some (false, `ASCENDING, 0)); - append_visible_column "Name" col_domname (Some (true, `ASCENDING, 1)); - append_visible_column "Status" col_status None; - append_visible_column "CPU" col_cpu None; - append_visible_column "Memory" col_mem None; - - let columns = - col_name_id, col_domname, col_status, col_cpu, col_mem, col_id in - let state = repopulate tree model columns [] in - - (tree, model, columns, state) - -(* Get historical data size. *) -let get_hist_size connid domid = - try - let dh = Hashtbl.find domhistory (connid, domid) in - dh.hist_posn - with - Not_found -> 0 - -(* Get historical data entries. *) -let _get_hist ?(latest=0) ?earliest ?(granularity=1) - extract fold zero connid domid = - try - let dh = Hashtbl.find domhistory (connid, domid) in - let earliest = - match earliest with - | None -> dh.hist_posn - | Some e -> min e dh.hist_posn in - - let src = dh.hist in - let src_start = dh.hist_posn - earliest in assert (src_start >= 0); - let src_end = dh.hist_posn - latest in assert (src_end <= dh.hist_posn); - - (* Create a sufficiently large array to store the result. *) - let len = (earliest-latest) / granularity in - let r = Array.make len zero in - - if granularity = 1 then ( - for j = 0 to len-1 do - r.(j) <- extract src.(src_start+j) - done - ) else ( - let i = ref src_start in - for j = 0 to len-1 do - let sub = Array.sub src !i (min (!i+granularity) src_end - !i) in - let sub = Array.map extract sub in - r.(j) <- fold sub; - i := !i + granularity - done - ); - r - with - Not_found -> [| |] - -let get_hist_cpu ?latest ?earliest ?granularity connid domid = - let zero = 0 in - let extract { hist_cpu = c } = c in - let fold a = - let len = Array.length a in - if len > 0 then Array.fold_left (+) zero a / len else -1 in - _get_hist ?latest ?earliest ?granularity extract fold zero connid domid - -let get_hist_mem ?latest ?earliest ?granularity connid domid = - let zero = 0L in - let extract { hist_mem = m } = m in - let fold a = - let len = Array.length a in - if len > 0 then - Int64.div (Array.fold_left (Int64.add) zero a) (Int64.of_int len) - else - -1L in - _get_hist ?latest ?earliest ?granularity extract fold zero connid domid diff --git a/virt-ctrl/vc_connections.mli b/virt-ctrl/vc_connections.mli deleted file mode 100644 index 261f853..0000000 --- a/virt-ctrl/vc_connections.mli +++ /dev/null @@ -1,102 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. - - Handle connections and the complicated GtkTreeView which - displays the connections / domains. -*) - -(** Get the list of current connections. *) -val get_conns : unit -> (int * Libvirt.rw Libvirt.Connect.t) list - -(** The current/previous state last time repopulate was called. The - repopulate function uses this state to determine what has changed - (eg. domains added, removed) since last time. -*) -type state - -type columns = string GTree.column * string GTree.column * string GTree.column * string GTree.column * string GTree.column * int GTree.column - -(** This function should be called once per second in order to - redraw the GtkTreeView. - - Takes the previous state as a parameter and returns the new state. -*) -val repopulate : GTree.view -> GTree.tree_store -> columns -> state -> state - -(** Create the GtkTreeView. Returns the widget itself, the model, - the list of columns, and the initial state. -*) -val make_treeview : - ?packing:(GObj.widget -> unit) -> unit -> - GTree.view * GTree.tree_store * columns * state - -(** Open a new connection to the hypervisor URI given. *) -val open_connection : string -> unit - -(** Return the amount of historical data that we hold about a - domain (in seconds). - - The parameters are connection ID (see {!get_conns}) and domain ID. - - This can return from [0] to [86400] (or 1 day of data). -*) -val get_hist_size : int -> int -> int - -(** Return a slice of historical %CPU data about a domain. - - The required parameters are connection ID (see {!get_conns}) - and domain ID. - - The optional [latest] parameter is the latest data we should - return. It defaults to [0] meaning to return everything up to now. - - The optional [earliest] parameter is the earliest data we should - return. This is a positive number representing number of seconds - back in time. It defaults to returning all data. - - The optional [granularity] parameter is the granularity of data - that we should return, in seconds. This defaults to [1], meaning - to return all data (once per second), but you might for example - set this to [60] to return data for each minute. - - This returns an array of data. The first element of the array is - the oldest data. The last element of the array is the most recent - data. The array returned might be shorter than you expect (if - data is missing or for some other reason) so always check the - length. - - Entries in the array are clamped to [0..100], except that if an - entry is [-1] it means "no data". - - This returns a zero-length array if we don't know about the domain. -*) -val get_hist_cpu : ?latest:int -> ?earliest:int -> ?granularity:int -> - int -> int -> - int array - -(** Return a slice of historical memory data about a domain. - - Parameters as above. - - Entries in the array are 64 bit integers corresponding to the - amount of memory in KB allocated to the domain (not necessarily - the amount being used, which we don't know about). -*) -val get_hist_mem : ?latest:int -> ?earliest:int -> ?granularity:int -> - int -> int -> - int64 array diff --git a/virt-ctrl/vc_dbus.ml b/virt-ctrl/vc_dbus.ml deleted file mode 100644 index 278b1fc..0000000 --- a/virt-ctrl/vc_dbus.ml +++ /dev/null @@ -1,311 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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 any code which needs optional package OCaml-DBUS. -*) - -(* There is *zero* documentation for this. I examined a lot of code - * to do this, and the following page was also very helpful: - * http://www.amk.ca/diary/2007/04/rough_notes_python_and_dbus.html - * See also the DBus API reference: - * http://dbus.freedesktop.org/doc/dbus/api/html/index.html - * See also Dan Berrange's Perl bindings: - * http://search.cpan.org/src/DANBERR/Net-DBus-0.33.5/lib/Net/ - * - * This code is a complicated state machine because that's what - * D-Bus requires. Enable debugging below to trace messages. - * - * It's also very unelegant and leaks memory. - * - * The code connects to D-Bus only the first time that the - * connection dialog is opened, and thereafter it attaches itself - * to the Gtk main loop, waiting for events. It's probably not - * safe if the avahi or dbus daemon restarts. - *) - -open Printf -open DBus - -let debug = true - -let service = "_libvirt._tcp" - -let rec print_msg msg = - (match Message.get_type msg with - | Message.Invalid -> - eprintf "Invalid"; - | Message.Method_call -> - eprintf "Method_call"; - | Message.Method_return -> - eprintf "Method_return"; - | Message.Error -> - eprintf "Error"; - | Message.Signal -> - eprintf "Signal"); - - let print_opt f name = - match f msg with - | None -> () - | Some value -> eprintf "\n\t%s=%S" name value - in - print_opt Message.get_member "member"; - print_opt Message.get_path "path"; - print_opt Message.get_interface "interface"; - print_opt Message.get_sender "sender"; - - let fields = Message.get msg in - eprintf "\n\t["; - print_fields fields; - eprintf "]\n%!"; - -and print_fields fields = - eprintf "%s" (String.concat ", " (List.map string_of_ty fields)) - -(* Perform a synchronous call to an object method. *) -let call_method ~bus ~err ~name ~path ~interface ~methd args = - (* Create the method_call message. *) - let msg = Message.new_method_call name path interface methd in - Message.append msg args; - (* Send the message, get reply. *) - let r = Connection.send_with_reply_and_block bus msg (-1) err in - Message.get r - -(* Services we've found. - * This is a map from name -> URI. - * XXX We just assume Xen at the moment. - * XXX The same machine can appear on multiple interfaces, so this - * isn't right. - *) -let services : (string, string) Hashtbl.t = Hashtbl.create 13 - -(* Process a Found message, indicating that we've found and fully - * resolved a new service. - *) -let add_service bus err msg = - (* match fields in the Found message from ServiceResolver. *) - match Message.get msg with - | Int32 _ :: (* interface *) - Int32 (*protocol*)_ :: (* 0 = IPv4, 1=IPv6 *) - String name :: (* "Virtualization Host foo" *) - String _ :: (* "_libvirt._tcp" *) - String _ :: (* domain name *) - String hostname :: (* this is the hostname as a string *) - Int32 _ :: (* ? aprotocol *) - String address :: (* IP address as a string *) - UInt16 (*port*)_ :: _ -> (* port is set to 0 by libvirtd *) - - let hostname = if hostname <> "" then hostname else address in - (*let protocol = if protocol = 1_l then IPv6 else IPv4 in*) - - (* XXX *) - let uri = "xen://" ^ hostname ^ "/" in - - if debug then eprintf "adding %s %s\n%!" name uri; - - Hashtbl.replace services name uri - - | _ -> - prerr_endline "warning: unexpected message contents of Found signal" - -(* Process an ItemRemove message, indicating that a service has - * gone away. - *) -let remove_service bus err msg = - (* match fields in the ItemRemove message from ServiceBrowser. *) - match Message.get msg with - | Int32 _ :: (* interface *) - Int32 _ :: (* protocol *) - String name :: _ -> (* name *) - if debug then eprintf "removing %s\n%!" name; - Hashtbl.remove services name - - | _ -> - prerr_endline "warning: unexpected message contents of ItemRemove signal" - -(* A service has appeared on the network. Resolve its IP address, etc. *) -let start_resolve_service bus err sb_path msg = - (* match fields in the ItemNew message from ServiceBrowser. *) - match Message.get msg with - | ((Int32 _) as interface) :: - ((Int32 _) as protocol) :: - ((String _) as name) :: - ((String _) as service) :: - ((String _) as domain) :: _ -> - (* Create a new ServiceResolver object which is used to resolve - * the actual locations of network services found by the ServiceBrowser. - *) - let sr = - call_method ~bus ~err - ~name:"org.freedesktop.Avahi" - ~path:"/" - ~interface:"org.freedesktop.Avahi.Server" - ~methd:"ServiceResolverNew" - [ - interface; - protocol; - name; - service; - domain; - Int32 (-1_l); (* AVAHI_PROTO_UNSPEC *) - UInt32 0_l; (* flags *) - ] in - let sr_path = - match sr with - | [ ObjectPath path ] -> path - | _ -> assert false in - - if debug then eprintf "ServiceResolver path = %S\n%!" sr_path; - - (* Add a match rule so we see these all signals of interest. *) - Bus.add_match bus - (String.concat "," [ - "type='signal'"; - "sender='org.freedesktop.Avahi.ServiceResolver'"; - "path='" ^ sr_path ^ "'"; - ]) err; - - () - - | _ -> - prerr_endline "warning: unexpected message contents of ItemNew signal" - -(* This is called when we get a message/signal. Could be from the - * (global) ServiceBrowser or any of the ServiceResolver objects. - *) -let got_message bus err sb_path msg = - if debug then print_msg msg; - - let typ = Message.get_type msg in - let member = match Message.get_member msg with None -> "" | Some m -> m in - let interface = - match Message.get_interface msg with None -> "" | Some m -> m in - - if typ = Message.Signal then ( - match interface, member with - | "org.freedesktop.Avahi.ServiceBrowser", "CacheExhausted" -> () - | "org.freedesktop.Avahi.ServiceBrowser", "AllForNow" -> () - | "org.freedesktop.Avahi.ServiceBrowser", "ItemNew" -> - (* New service has appeared, start to resolve it. *) - start_resolve_service bus err sb_path msg - | "org.freedesktop.Avahi.ServiceResolver", "Found" -> - (* Resolver has finished resolving the name of a previously - * appearing service. - *) - add_service bus err msg - | "org.freedesktop.Avahi.ServiceBrowser", "ItemRemove" -> - (* Service has disappeared. *) - remove_service bus err msg - | "org.freedesktop.DBus", _ -> () - | interface, member -> - eprintf "warning: ignored unknown message %s from %s\n%!" - member interface - ); - true - -(* Store the connection ((bus, err, io_id) tuple). However don't bother - * connecting to D-Bus at all until the user opens the connection - * dialog for the first time. - *) -let connection = ref None - -(* Create global error and system bus object, and create the service browser. *) -let connect () = - match !connection with - | Some (bus, err, _) -> (bus, err, false) - | None -> - let err = Error.init () in - let bus = Bus.get Bus.System err in - if Error.is_set err then failwith "error set after getting System bus"; - - (* Create a new ServiceBrowser object which emits a signal whenever - * a new network service of the type specified is found on the network. - *) - let sb = - call_method ~bus ~err - ~name:"org.freedesktop.Avahi" - ~path:"/" - ~interface:"org.freedesktop.Avahi.Server" - ~methd:"ServiceBrowserNew" - [ - Int32 (-1_l); (* interface, -1=AVAHI_IF_UNSPEC *) - Int32 (-1_l); (* AVAHI_PROTO_UNSPEC *) - String service; (* service type *) - String ""; (* XXX call GetDomainName() *) - UInt32 0_l; (* flags *) - ] in - let sb_path = - match sb with - | [ ObjectPath path ] -> path - | _ -> assert false in - - if debug then eprintf "ServiceBrowser path = %S\n%!" sb_path; - - (* Register a callback to accept the signals. *) - (* XXX This leaks memory because it is never freed. *) - Connection.add_filter bus ( - fun bus msg -> got_message bus err sb_path msg - ); - - (* Add a match rule so we see these all signals of interest. *) - Bus.add_match bus - (String.concat "," [ - "type='signal'"; - "sender='org.freedesktop.Avahi.ServiceBrowser'"; - "path='" ^ sb_path ^ "'"; - ]) err; - - (* This is called from the Gtk main loop whenever there is new - * data to read on the D-Bus socket. - *) - let callback _ = - if debug then eprintf "dbus callback\n%!"; - if Connection.read_write_dispatch bus 0 then true - else ( (* Disconnected. *) - connection := None; - false - ) - in - - (* Get the file descriptor and attach to the Gtk main loop. *) - let fd = Connection.get_fd bus in - let channel = GMain.Io.channel_of_descr fd in - let io_id = GMain.Io.add_watch ~cond:[`IN] ~callback channel in - - connection := Some (bus, err, io_id); - (bus, err, true) - -(* This function is called by the connection dialog and is expected - * to return a list of services we know about now. - *) -let find_services () = - let bus, err, just_connected = connect () in - - (* If we've just connected, wait briefly for the list to stablise. *) - if just_connected then ( - let start_time = Unix.gettimeofday () in - while Unix.gettimeofday () -. start_time < 0.5 do - ignore (Connection.read_write_dispatch bus 500) - done - ); - - (* Return the services we know about. *) - Hashtbl.fold (fun k v vs -> (k, v) :: vs) services [] - -;; - -Vc_connection_dlg.find_libvirtd_with_zeroconf := find_services diff --git a/virt-ctrl/vc_dbus.mli b/virt-ctrl/vc_dbus.mli deleted file mode 100644 index 884093e..0000000 --- a/virt-ctrl/vc_dbus.mli +++ /dev/null @@ -1,22 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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 any code which needs optional package OCaml-DBUS. -*) - -(* No public API. If loaded this module hooks into Vc_connection_dlg. *) diff --git a/virt-ctrl/vc_domain_ops.ml b/virt-ctrl/vc_domain_ops.ml deleted file mode 100644 index 787e71e..0000000 --- a/virt-ctrl/vc_domain_ops.ml +++ /dev/null @@ -1,108 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. - - Domain operations buttons. -*) - -open Printf - -module C = Libvirt.Connect -module D = Libvirt.Domain -module N = Libvirt.Network - -(* Get the selected domain (if there is one) or return None. *) -let get_domain (tree : GTree.view) (model : GTree.tree_store) - (columns : Vc_connections.columns) = - let path, _ = tree#get_cursor () in - match path with - | None -> None (* No row at all selected. *) - | Some path -> - let row = model#get_iter path in - (* Visit parent to get the connid. - * If this returns None, then it's a top-level row which is - * selected (ie. a connection), so just ignore. - *) - match model#iter_parent row with - | None -> None - | Some parent -> - try - let (_, col_domname, _, _, _, col_id) = columns in - let connid = model#get ~row:parent ~column:col_id in - let conn = - List.assoc connid (Vc_connections.get_conns ()) in - let domid = model#get ~row ~column:col_id in - if domid = -1 then ( (* Inactive domain. *) - let domname = model#get ~row ~column:col_domname in - let dom = D.lookup_by_name conn domname in - let info = D.get_info dom in - Some (dom, info, connid, -1) - ) else ( (* Active domU. *) - let dom = D.lookup_by_id conn domid in - let info = D.get_info dom in - Some (dom, info, connid, domid) - ) - with - (* Domain or connection disappeared under us. *) - | Not_found -> None - | Failure msg -> - prerr_endline msg; - None - | Libvirt.Virterror err -> - prerr_endline (Libvirt.Virterror.to_string err); - None - -type dops_callback_fn = - GTree.view -> GTree.tree_store -> Vc_connections.columns -> unit -> unit - -let start_domain tree model columns () = - match get_domain tree model columns with - | None -> () - | Some (dom, _, _, domid) -> - if domid = -1 then - D.create dom - -let pause_domain tree model columns () = - match get_domain tree model columns with - | None -> () - | Some (dom, info, _, domid) -> - if domid >= 0 && info.D.state <> D.InfoPaused then - D.suspend dom - -let resume_domain tree model columns () = - match get_domain tree model columns with - | None -> () - | Some (dom, info, _, domid) -> - if domid >= 0 && info.D.state = D.InfoPaused then - D.resume dom - -let shutdown_domain tree model columns () = - match get_domain tree model columns with - | None -> () - | Some (dom, info, _, domid) -> - if domid >= 0 && info.D.state <> D.InfoShutdown then - D.shutdown dom - -let open_domain_details tree model columns () = - match get_domain tree model columns with - | None -> () - | Some (dom, info, connid, domid) -> - if domid >= 0 then ( - - - - ) diff --git a/virt-ctrl/vc_domain_ops.mli b/virt-ctrl/vc_domain_ops.mli deleted file mode 100644 index 38a2015..0000000 --- a/virt-ctrl/vc_domain_ops.mli +++ /dev/null @@ -1,35 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. - - Domain operations buttons. -*) - -type dops_callback_fn = - GTree.view -> GTree.tree_store -> Vc_connections.columns -> unit -> unit - (** Domain ops callback function type. - - The parameters are: tree (view), model, columns. - The extra unit parameter is there to make it easier to - turn into a callback. - *) - -val start_domain : dops_callback_fn -val pause_domain : dops_callback_fn -val resume_domain : dops_callback_fn -val shutdown_domain : dops_callback_fn -val open_domain_details : dops_callback_fn diff --git a/virt-ctrl/vc_helpers.ml b/virt-ctrl/vc_helpers.ml deleted file mode 100644 index 10fe6b1..0000000 --- a/virt-ctrl/vc_helpers.ml +++ /dev/null @@ -1,95 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. -*) - -module C = Libvirt.Connect -module D = Libvirt.Domain -module N = Libvirt.Network - -(* Given two lists, xs and ys, return a list of items which have been - * added to ys, items which are the same, and items which have been - * removed from ys. - * Returns a triplet (list of added, list of same, list of removed). - *) -let differences xs ys = - let rec d = function - | [], [] -> (* Base case. *) - ([], [], []) - | [], ys -> (* All ys have been added. *) - (ys, [], []) - | xs, [] -> (* All xs have been removed. *) - ([], [], xs) - | (x :: xs), (y :: ys) when x = y -> (* Not added or removed. *) - let added, unchanged, removed = d (xs, ys) in - added, x :: unchanged, removed - | (x :: xs), ((y :: _) as ys) when x < y -> (* x removed. *) - let added, unchanged, removed = d (xs, ys) in - added, unchanged, x :: removed - | ((x :: _) as xs), (y :: ys) (* when x > y *) -> (* y added. *) - let added, unchanged, removed = d (xs, ys) in - y :: added, unchanged, removed - in - d (List.sort compare xs, List.sort compare ys) - -let string_of_domain_state = function - | D.InfoNoState -> "unknown" - | D.InfoRunning -> "running" - | D.InfoBlocked -> "blocked" - | D.InfoPaused -> "paused" - | D.InfoShutdown -> "shutdown" - | D.InfoShutoff -> "shutoff" - | D.InfoCrashed -> "crashed" - -(* Filter top level rows (only) in a tree_store. If function f returns - * true then the row remains, but if it returns false then the row is - * removed. - *) -let rec filter_top_level_rows (model : GTree.tree_store) f = - match model#get_iter_first with - | None -> () - | Some iter -> filter_rows model f iter - -(* Filter rows in a tree_store at a particular level. *) -and filter_rows model f row = - let keep = f row in - let iter_still_valid = - if not keep then model#remove row else model#iter_next row in - if iter_still_valid then filter_rows model f row - -(* Find the first top level row matching predicate f and return it. *) -let rec find_top_level_row (model : GTree.tree_store) f = - match model#get_iter_first with - | None -> raise Not_found (* no rows *) - | Some row -> find_row model f row - -(* Find the first row matching predicate f at a particular level. *) -and find_row model f row = - if f row then row - else if model#iter_next row then find_row model f row - else raise Not_found - -(* Iterate over top level rows (only) in a tree_store. *) -let rec iter_top_level_rows (model : GTree.tree_store) f = - match model#get_iter_first with - | None -> () - | Some iter -> iter_rows model f iter - -(* Iterate over rows in a tree_store at a particular level. *) -and iter_rows model f row = - f row; - if model#iter_next row then iter_rows model f row diff --git a/virt-ctrl/vc_helpers.mli b/virt-ctrl/vc_helpers.mli deleted file mode 100644 index b533024..0000000 --- a/virt-ctrl/vc_helpers.mli +++ /dev/null @@ -1,51 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. - - Helper functions. -*) - -(** Given two lists, xs and ys, return a list of items which have been - added to ys, items which are the same, and items which have been - removed from ys. - Returns a triplet (list of added, list of same, list of removed). -*) -val differences : 'a list -> 'a list -> 'a list * 'a list * 'a list - -(** Convert libvirt domain state to a string. *) -val string_of_domain_state : Libvirt.Domain.state -> string - -(** Filter top level rows (only) in a GtkTreeStore. If function f returns - true then the row remains, but if it returns false then the row is - removed. -*) -val filter_top_level_rows : GTree.tree_store -> (Gtk.tree_iter -> bool) -> unit - -(** Filter rows in a tree_store at a particular level. *) -val filter_rows : GTree.tree_store -> (Gtk.tree_iter -> bool) -> Gtk.tree_iter -> unit - -(** Find the first top level row matching predicate and return it. *) -val find_top_level_row : GTree.tree_store -> (Gtk.tree_iter -> bool) -> Gtk.tree_iter - -(** Find the first row matching predicate f at a particular level. *) -val find_row : GTree.tree_store -> (Gtk.tree_iter -> bool) -> Gtk.tree_iter -> Gtk.tree_iter - -(** Iterate over top level rows (only) in a GtkTreeStore. *) -val iter_top_level_rows : GTree.tree_store -> (Gtk.tree_iter -> unit) -> unit - -(** Iterate over rows in a tree_store at a particular level. *) -val iter_rows : GTree.tree_store -> (Gtk.tree_iter -> unit) -> Gtk.tree_iter -> unit diff --git a/virt-ctrl/vc_icons.ml b/virt-ctrl/vc_icons.ml deleted file mode 100644 index 911e487..0000000 --- a/virt-ctrl/vc_icons.ml +++ /dev/null @@ -1,270 +0,0 @@ - - -open Vc_connection_dlg - - -let pixbuf_data = "\ -\132\149\166\190\000\000\010\192\000\000\000\001\000\000\000\003\000\000\000\003\ -\018\071\100\107\080\105\120\098\117\102\047\050\046\048\047\000\000\000\010\172\ -\071\100\107\080\000\000\010\172\002\001\000\002\000\000\000\128\000\000\000\032\ -\000\000\000\032\161\255\255\255\000\003\136\138\133\023\140\142\137\150\138\140\ -\135\247\152\136\138\133\255\003\138\140\135\246\140\142\137\156\136\138\133\030\ -\130\255\255\255\000\003\141\143\138\165\190\191\188\251\249\249\249\255\152\255\ -\255\255\255\009\248\248\247\255\194\196\192\253\141\143\138\165\255\255\255\000\ -\136\138\133\010\139\141\136\246\250\250\249\255\128\152\186\255\033\075\135\255\ -\150\032\074\135\255\010\033\075\135\255\113\140\178\255\244\245\246\255\139\141\ -\136\246\136\138\133\009\136\138\133\024\141\143\138\246\255\255\255\255\033\075\ -\135\255\160\182\205\255\130\173\191\212\255\134\173\192\212\255\131\174\193\213\ -\255\134\175\193\213\255\134\176\194\213\255\003\041\081\139\255\255\255\255\255\ -\141\143\138\246\130\136\138\133\024\004\141\143\138\246\255\255\255\255\032\074\ -\135\255\154\177\202\255\151\164\185\208\255\003\040\080\139\255\255\255\255\255\ -\141\143\138\246\130\136\138\133\024\004\141\143\138\246\255\255\255\255\032\074\ -\135\255\144\169\197\255\151\153\176\202\255\003\040\080\139\255\255\255\255\255\ -\141\143\138\246\130\136\138\133\024\004\141\143\138\246\255\255\255\255\032\074\ -\135\255\134\162\192\255\151\142\168\196\255\003\040\080\139\255\255\255\255\255\ -\141\143\138\246\130\136\138\133\024\004\141\143\138\246\255\255\255\255\032\074\ -\135\255\123\154\186\255\134\131\159\190\255\002\132\160\190\255\133\161\191\255\ -\130\133\161\192\255\003\134\162\192\255\134\162\193\255\134\162\192\255\131\133\ -\161\192\255\001\132\160\190\255\132\131\159\190\255\005\121\152\185\255\103\138\ -\176\255\040\080\139\255\255\255\255\255\141\143\138\246\130\136\138\133\024\004\ -\141\143\138\246\255\255\255\255\032\074\135\255\113\145\181\255\131\119\150\184\ -\255\007\121\152\185\255\122\153\187\255\123\154\188\255\125\155\189\255\125\156\ -\189\255\126\157\190\255\127\157\191\255\132\127\158\191\255\007\126\157\190\255\ -\125\156\189\255\123\155\188\255\105\140\178\255\088\127\169\255\072\114\160\255\ -\055\101\150\255\130\050\097\148\255\003\040\080\139\255\255\255\255\255\141\143\ -\138\246\130\136\138\133\024\030\141\143\138\246\255\255\255\255\032\074\135\255\ -\103\138\176\255\108\142\178\255\110\144\180\255\112\145\182\255\114\147\183\255\ -\115\149\185\255\117\150\186\255\118\151\187\255\119\152\188\255\120\153\189\255\ -\120\154\190\255\121\154\190\255\121\155\190\255\121\154\190\255\120\154\190\255\ -\115\149\186\255\091\131\174\255\068\113\163\255\062\109\159\255\060\107\157\255\ -\058\105\155\255\056\102\153\255\053\100\151\255\050\097\148\255\040\080\139\255\ -\255\255\255\255\141\143\138\246\130\136\138\133\024\030\141\143\138\246\255\255\ -\255\255\032\074\135\255\094\131\171\255\100\136\175\255\102\138\178\255\105\141\ -\179\255\107\142\181\255\108\145\183\255\111\146\185\255\112\148\186\255\113\149\ -\188\255\115\150\188\255\115\151\189\255\115\152\189\255\116\152\190\255\106\145\ -\185\255\088\130\176\255\073\119\169\255\071\118\168\255\070\116\166\255\068\114\ -\164\255\066\112\162\255\063\110\160\255\060\107\158\255\058\104\155\255\055\102\ -\152\255\040\080\139\255\255\255\255\255\141\143\138\246\130\136\138\133\024\030\ -\141\143\138\246\255\255\255\255\032\074\135\255\087\126\169\255\092\131\173\255\ -\096\133\175\255\098\136\178\255\101\138\180\255\102\141\182\255\105\143\184\255\ -\106\144\185\255\108\146\187\255\110\147\189\255\109\147\189\255\099\140\184\255\ -\086\131\179\255\081\127\177\255\080\126\176\255\079\125\175\255\077\124\173\255\ -\076\122\171\255\073\120\169\255\071\117\167\255\068\114\165\255\065\112\162\255\ -\062\109\159\255\059\106\156\255\040\081\139\255\255\255\255\255\141\143\138\246\ -\130\136\138\133\024\030\141\143\138\246\255\255\255\255\032\074\135\255\080\121\ -\166\255\085\126\170\255\088\129\173\255\091\132\175\255\094\134\178\255\096\137\ -\181\255\099\139\183\255\102\142\185\255\099\141\185\255\093\137\183\255\086\132\ -\182\255\087\133\182\255\088\134\183\255\087\133\183\255\087\132\182\255\085\131\ -\180\255\083\129\179\255\081\127\176\255\078\124\174\255\075\122\171\255\072\119\ -\169\255\069\116\166\255\066\112\163\255\062\109\159\255\040\081\139\255\255\255\ -\255\255\141\143\138\246\130\136\138\133\024\030\141\143\138\246\255\255\255\255\ -\032\074\135\255\073\117\164\255\077\121\168\255\081\124\171\255\084\128\174\255\ -\086\129\176\255\087\131\178\255\087\131\180\255\088\132\182\255\088\134\183\255\ -\091\136\185\255\093\138\187\255\094\139\188\255\094\140\189\255\094\140\188\255\ -\093\138\187\255\091\137\186\255\089\134\183\255\086\132\181\255\083\129\178\255\ -\080\126\175\255\076\122\172\255\073\119\169\255\069\115\166\255\065\112\162\255\ -\040\081\140\255\255\255\255\255\141\143\138\246\130\136\138\133\024\030\141\143\ -\138\246\255\255\255\255\032\074\135\255\063\110\160\255\067\114\164\255\071\117\ -\167\255\075\121\171\255\079\125\174\255\082\128\178\255\086\132\181\255\090\135\ -\184\255\093\139\187\255\096\141\190\255\098\144\193\255\100\146\194\255\101\146\ -\195\255\100\146\194\255\099\144\193\255\096\142\191\255\093\139\188\255\090\136\ -\185\255\086\132\182\255\083\129\178\255\079\125\175\255\075\121\171\255\071\118\ -\168\255\068\114\164\255\040\081\140\255\255\255\255\255\141\143\138\246\130\136\ -\138\133\024\030\141\143\138\246\255\255\255\255\032\074\135\255\065\111\161\255\ -\069\115\165\255\073\119\169\255\077\123\172\255\080\127\176\255\084\130\180\255\ -\088\134\183\255\092\138\187\255\096\142\190\255\100\145\194\255\103\149\197\255\ -\106\151\200\255\107\153\201\255\106\152\200\255\104\149\197\255\100\146\194\255\ -\096\142\191\255\093\138\187\255\089\135\184\255\085\131\180\255\081\127\176\255\ -\077\123\173\255\073\119\169\255\069\115\165\255\041\081\140\255\255\255\255\255\ -\141\143\138\246\130\136\138\133\024\030\141\143\138\246\255\255\255\255\032\074\ -\135\255\065\111\162\255\069\115\165\255\073\119\169\255\077\123\173\255\081\127\ -\177\255\085\131\180\255\089\135\184\255\093\139\188\255\097\143\191\255\101\147\ -\195\255\105\151\199\255\109\154\203\255\113\158\206\255\110\155\203\255\106\151\ -\199\255\102\147\196\255\098\143\192\255\094\139\188\255\090\135\184\255\086\131\ -\181\255\081\127\177\255\077\124\173\255\073\120\170\255\069\116\166\255\041\081\ -\140\255\255\255\255\255\141\143\138\246\130\136\138\133\024\006\141\143\138\246\ -\255\255\255\255\032\074\135\255\047\087\143\255\048\088\144\255\048\088\145\255\ -\130\049\089\145\255\130\050\090\146\255\130\051\091\147\255\001\052\091\148\255\ -\130\052\092\148\255\001\053\092\148\255\130\052\092\148\255\001\052\091\148\255\ -\130\051\091\147\255\130\050\090\146\255\130\049\089\145\255\005\048\088\145\255\ -\048\088\144\255\032\075\135\255\255\255\255\255\141\143\138\246\130\136\138\133\ -\024\005\141\143\138\246\255\255\255\255\198\206\214\255\197\205\214\255\196\204\ -\214\255\132\196\204\213\255\131\196\204\212\255\131\195\203\211\255\130\194\202\ -\211\255\132\194\202\210\255\134\193\201\210\255\007\192\200\209\255\254\254\254\ -\255\141\143\138\246\136\138\133\024\136\138\133\009\138\140\135\247\244\244\244\ -\255\151\254\254\254\255\131\255\255\255\255\006\247\247\246\255\138\140\135\248\ -\136\138\133\008\255\255\255\000\141\143\138\132\138\140\135\245\154\136\138\133\ -\255\002\138\140\135\245\141\143\138\149\135\255\255\255\000\025\000\000\000\001\ -\000\000\000\005\110\110\110\037\127\129\125\120\121\123\119\247\193\193\191\255\ -\203\203\201\255\205\205\204\255\207\207\206\255\210\210\208\255\213\213\211\255\ -\216\216\214\255\218\218\217\255\221\221\219\255\197\198\196\255\134\139\137\248\ -\121\146\173\203\110\153\198\187\112\156\204\189\113\156\204\192\113\158\205\195\ -\115\158\207\198\115\159\207\236\114\158\207\206\111\162\204\030\132\255\255\255\ -\000\008\000\000\000\002\000\000\000\007\000\000\000\011\000\000\000\015\124\126\ -\122\117\139\142\137\248\166\167\165\248\197\197\195\255\136\212\212\211\255\130\ -\211\211\211\255\011\185\185\185\255\156\157\154\246\138\140\134\244\082\082\078\ -\068\093\131\171\109\103\143\187\146\101\142\183\124\093\128\168\082\106\147\192\ -\147\112\156\204\205\000\000\000\002\130\255\255\255\000\008\000\000\000\003\000\ -\000\000\008\000\000\000\013\000\000\000\018\000\000\000\023\138\141\136\217\200\ -\200\197\255\251\251\251\255\140\254\254\254\255\010\241\241\241\255\174\176\172\ -\252\122\129\130\164\112\156\205\244\092\129\169\152\100\139\181\170\107\151\195\ -\206\112\157\203\235\106\147\192\187\000\000\000\011\130\255\255\255\000\006\000\ -\000\000\001\000\000\000\007\000\000\000\012\000\000\000\017\000\000\000\022\135\ -\137\132\208\132\137\139\134\248\138\137\139\134\249\130\137\139\134\248\008\123\ -\126\122\156\112\156\203\245\052\075\094\054\000\000\000\020\000\000\000\019\000\ -\000\000\020\000\000\000\015\000\000\000\002\130\255\255\255\000\003\136\138\133\ -\056\154\156\152\242\185\187\182\255\136\186\189\182\255\010\187\190\183\255\186\ -\189\182\255\187\190\184\255\186\189\182\255\188\191\184\255\186\188\182\255\184\ -\186\181\255\186\189\182\255\187\190\183\255\186\189\182\255\130\186\188\183\255\ -\006\186\189\182\255\187\190\183\255\185\188\181\255\182\183\179\255\140\142\137\ -\238\136\138\133\053\130\255\255\255\000\030\136\138\133\010\148\150\145\234\225\ -\226\224\255\199\201\196\255\211\215\207\255\217\220\213\255\211\215\207\255\219\ -\222\215\255\211\215\207\255\220\223\217\255\211\215\207\255\221\224\218\255\211\ -\215\207\255\222\225\219\255\211\215\207\255\223\226\221\255\211\215\207\255\208\ -\211\206\255\207\209\202\255\203\205\200\255\186\189\182\255\204\206\201\255\190\ -\194\187\255\206\208\202\255\214\216\211\255\211\215\207\255\220\222\217\255\188\ -\191\184\255\227\227\224\255\141\143\138\216\130\255\255\255\000\067\138\140\135\ -\151\212\212\210\251\190\193\186\255\207\210\202\255\224\226\221\255\211\215\207\ -\255\226\228\223\255\211\215\207\255\228\231\226\255\211\215\207\255\230\232\228\ -\255\211\215\207\255\232\234\230\255\211\215\207\255\234\236\232\255\211\215\207\ -\255\235\237\233\255\189\193\186\255\218\219\214\255\191\195\188\255\220\222\218\ -\255\187\190\183\255\228\230\226\255\211\213\207\255\194\197\190\255\232\234\230\ -\255\211\215\207\255\227\228\225\255\218\220\216\255\165\167\163\246\136\138\133\ -\076\136\138\133\050\151\153\148\247\238\238\237\255\187\190\183\255\210\212\207\ -\255\186\189\182\255\214\216\212\255\186\189\182\255\219\220\216\255\186\189\182\ -\255\223\224\221\255\186\189\182\255\227\229\226\255\186\189\182\255\232\233\230\ -\255\186\189\182\255\236\237\235\255\186\189\182\255\241\241\240\255\215\216\212\ -\255\227\229\226\255\186\189\182\255\232\233\230\255\185\188\181\255\221\222\218\ -\255\228\229\226\255\186\189\182\255\232\233\230\255\186\189\182\255\204\206\201\ -\255\236\237\235\255\141\143\138\216\136\138\133\092\170\172\167\245\252\252\251\ -\255\254\254\254\255\142\253\253\253\255\002\254\254\254\255\255\255\255\255\132\ -\253\253\253\255\002\255\255\255\255\254\254\254\255\131\253\253\253\255\006\255\ -\255\255\255\236\236\234\255\139\141\136\243\136\138\133\015\141\143\138\202\136\ -\138\133\253\131\136\138\133\255\131\136\138\133\254\132\136\138\133\253\133\137\ -\139\134\252\131\137\139\134\251\134\138\140\135\250\001\138\140\135\249\130\139\ -\141\136\249\002\141\143\138\230\137\139\134\083" - -let pixbuf () : GdkPixbuf.pixbuf = Marshal.from_string pixbuf_data 0 -;; -icon_32x32_devices_computer_png := Some (pixbuf ()) ;; - -let pixbuf_data = "\ -\132\149\166\190\000\000\005\123\000\000\000\001\000\000\000\003\000\000\000\003\ -\018\071\100\107\080\105\120\098\117\102\047\050\046\048\047\000\000\000\005\103\ -\071\100\107\080\000\000\005\103\002\001\000\002\000\000\000\096\000\000\000\024\ -\000\000\000\024\154\000\000\000\000\002\131\131\134\116\128\128\131\253\144\128\ -\128\131\255\002\128\128\131\253\131\131\134\116\132\000\000\000\000\002\128\128\ -\131\253\250\250\250\255\144\255\255\255\255\002\250\250\250\255\128\128\131\253\ -\132\000\000\000\000\003\128\128\131\255\252\252\253\255\048\087\143\255\142\032\ -\074\135\255\003\050\088\144\255\255\255\255\255\128\128\131\255\132\000\000\000\ -\000\009\128\128\131\255\248\249\251\255\034\075\135\255\090\129\181\255\093\132\ -\182\255\097\135\184\255\101\138\186\255\105\141\187\255\109\144\189\255\136\113\ -\147\191\255\003\032\074\135\255\255\255\255\255\128\128\131\255\132\000\000\000\ -\000\020\128\128\131\255\248\249\251\255\034\075\135\255\086\126\179\255\089\129\ -\180\255\094\133\183\255\100\137\185\255\105\142\188\255\108\145\190\255\113\148\ -\192\255\117\151\194\255\118\151\194\255\117\151\194\255\116\150\193\255\116\149\ -\192\255\114\148\192\255\113\147\191\255\032\074\135\255\255\255\255\255\128\128\ -\131\255\132\000\000\000\000\011\128\128\131\255\248\249\251\255\034\075\135\255\ -\084\125\178\255\090\131\182\255\096\135\185\255\102\140\188\255\106\144\191\255\ -\111\147\193\255\115\151\194\255\119\153\196\255\130\123\156\198\255\007\122\155\ -\197\255\120\154\196\255\119\153\195\255\117\151\194\255\032\074\135\255\255\255\ -\255\255\128\128\131\255\132\000\000\000\000\020\128\128\131\255\248\249\251\255\ -\034\076\135\255\086\128\181\255\092\133\184\255\098\138\188\255\104\143\190\255\ -\108\147\193\255\113\150\195\255\118\153\197\255\121\156\199\255\125\159\200\255\ -\117\153\197\255\102\142\190\255\091\134\185\255\081\125\180\255\069\116\174\255\ -\032\074\135\255\255\255\255\255\128\128\131\255\132\000\000\000\000\020\128\128\ -\131\255\248\249\251\255\034\076\136\255\086\129\183\255\094\136\186\255\100\141\ -\190\255\105\145\192\255\110\150\195\255\115\153\198\255\119\156\200\255\114\153\ -\197\255\094\138\190\255\081\128\184\255\079\127\183\255\077\124\181\255\074\122\ -\179\255\071\119\177\255\032\074\135\255\255\255\255\255\128\128\131\255\132\000\ -\000\000\000\020\128\128\131\255\248\249\251\255\034\076\136\255\087\131\184\255\ -\094\137\188\255\101\142\191\255\107\147\195\255\113\152\198\255\111\151\197\255\ -\098\143\193\255\091\137\191\255\090\137\190\255\089\135\189\255\086\133\188\255\ -\083\130\186\255\080\127\183\255\076\124\181\255\032\074\135\255\255\255\255\255\ -\128\128\131\255\132\000\000\000\000\020\128\128\131\255\248\249\251\255\034\076\ -\136\255\086\130\184\255\091\136\188\255\095\139\191\255\098\142\192\255\097\142\ -\193\255\096\142\194\255\098\144\195\255\098\144\196\255\098\144\195\255\095\142\ -\194\255\092\139\192\255\089\135\189\255\085\131\186\255\080\127\183\255\032\074\ -\135\255\255\255\255\255\128\128\131\255\132\000\000\000\000\020\128\128\131\255\ -\248\249\251\255\034\076\136\255\078\126\182\255\083\130\185\255\088\135\189\255\ -\093\139\192\255\097\143\195\255\101\147\198\255\105\150\200\255\106\152\201\255\ -\105\150\200\255\101\147\198\255\097\143\195\255\092\139\192\255\088\134\189\255\ -\083\130\185\255\032\074\135\255\255\255\255\255\128\128\131\255\132\000\000\000\ -\000\003\128\128\131\255\252\252\253\255\048\088\143\255\142\032\074\135\255\003\ -\050\089\145\255\255\255\255\255\128\128\131\255\132\000\000\000\000\002\128\128\ -\131\255\255\255\255\255\144\228\228\225\255\002\255\255\255\255\128\128\131\255\ -\132\000\000\000\000\002\128\128\131\253\250\250\250\255\144\255\255\255\255\002\ -\250\250\250\255\128\128\131\253\132\000\000\000\000\002\131\131\134\116\128\128\ -\131\253\144\128\128\131\255\002\128\128\131\253\131\131\134\116\138\000\000\000\ -\000\008\134\136\131\255\141\144\138\255\147\150\144\255\153\156\150\255\159\162\ -\156\255\165\168\162\255\171\174\167\255\134\136\131\255\137\000\000\000\000\022\ -\131\132\132\003\137\138\137\223\139\140\139\241\179\181\175\254\181\184\177\255\ -\184\187\180\255\181\184\177\255\184\187\180\255\181\184\177\255\184\187\180\255\ -\181\184\177\255\184\187\180\255\181\184\177\255\184\187\180\255\181\184\177\255\ -\184\187\180\255\181\184\177\255\184\187\180\255\179\181\175\254\139\140\139\241\ -\136\137\137\224\131\132\132\004\130\000\000\000\000\022\126\127\127\054\152\153\ -\153\236\221\222\219\255\186\189\181\255\187\190\183\255\191\197\186\255\198\201\ -\194\255\191\197\186\255\211\213\208\255\191\197\186\255\221\223\218\255\191\197\ -\186\255\220\223\218\255\191\197\186\255\211\213\208\255\191\197\186\255\198\200\ -\194\255\191\197\186\255\186\189\181\255\221\222\219\255\153\154\153\237\126\127\ -\127\058\130\000\000\000\000\003\124\125\126\122\183\183\183\251\219\220\217\255\ -\130\181\184\177\255\003\188\191\185\255\181\184\177\255\202\204\198\255\135\181\ -\184\177\255\007\202\204\198\255\181\184\177\255\188\191\184\255\181\184\177\255\ -\219\220\217\255\184\185\184\252\124\125\126\129\130\000\000\000\000\002\126\126\ -\127\200\248\248\248\255\146\255\255\255\255\002\248\248\248\255\125\125\127\208\ -\130\000\000\000\000\004\119\119\121\203\117\117\120\240\118\118\120\240\117\117\ -\120\240\130\117\117\120\241\001\117\117\119\242\130\116\116\119\242\132\116\116\ -\119\243\131\116\116\118\243\006\116\116\118\244\116\116\118\243\115\115\118\244\ -\116\116\118\244\115\115\118\244\118\118\120\210\131\000\000\000\000\020\000\000\ -\000\002\000\000\000\009\000\000\000\017\000\000\000\022\000\000\000\028\000\000\ -\000\034\000\000\000\040\000\000\000\047\000\000\000\053\000\000\000\059\000\000\ -\000\060\000\000\000\056\000\000\000\051\000\000\000\045\000\000\000\038\000\000\ -\000\032\000\000\000\026\000\000\000\021\000\000\000\012\000\000\000\003\154\000\ -\000\000\000" - -let pixbuf () : GdkPixbuf.pixbuf = Marshal.from_string pixbuf_data 0 -;; -icon_24x24_devices_computer_png := Some (pixbuf ()) ;; - -let pixbuf_data = "\ -\132\149\166\190\000\000\002\203\000\000\000\001\000\000\000\003\000\000\000\003\ -\018\071\100\107\080\105\120\098\117\102\047\050\046\048\047\000\000\000\002\183\ -\071\100\107\080\000\000\002\183\002\001\000\002\000\000\000\064\000\000\000\016\ -\000\000\000\016\003\000\000\000\000\129\129\132\172\128\128\131\253\138\128\128\ -\131\255\002\128\128\131\253\129\129\132\172\130\000\000\000\000\002\128\128\131\ -\253\242\242\242\255\138\255\255\255\255\002\242\242\242\255\128\128\131\253\130\ -\000\000\000\000\002\128\128\131\255\255\255\255\255\138\032\074\135\255\002\255\ -\255\255\255\128\128\131\255\130\000\000\000\000\004\128\128\131\255\255\255\255\ -\255\032\074\135\255\112\146\191\255\130\113\147\191\255\003\113\148\191\255\113\ -\148\192\255\113\148\191\255\130\113\147\191\255\003\032\074\135\255\255\255\255\ -\255\128\128\131\255\130\000\000\000\000\014\128\128\131\255\255\255\255\255\032\ -\074\135\255\106\143\189\255\111\147\191\255\115\151\194\255\119\154\196\255\122\ -\155\197\255\121\155\197\255\117\152\195\255\106\143\189\255\032\074\135\255\255\ -\255\255\255\128\128\131\255\130\000\000\000\000\014\128\128\131\255\255\255\255\ -\255\032\074\135\255\105\142\189\255\111\148\193\255\116\153\197\255\120\155\198\ -\255\106\145\193\255\084\129\183\255\073\121\179\255\069\117\176\255\032\074\135\ -\255\255\255\255\255\128\128\131\255\130\000\000\000\000\014\128\128\131\255\255\ -\255\255\255\032\074\135\255\101\141\190\255\103\144\192\255\103\145\193\255\091\ -\137\189\255\089\135\189\255\087\134\188\255\084\131\186\255\078\126\182\255\032\ -\074\135\255\255\255\255\255\128\128\131\255\130\000\000\000\000\014\128\128\131\ -\255\255\255\255\255\032\074\135\255\078\125\182\255\086\132\187\255\092\139\192\ -\255\098\144\196\255\100\146\197\255\098\144\196\255\092\139\192\255\086\132\187\ -\255\032\074\135\255\255\255\255\255\128\128\131\255\130\000\000\000\000\002\128\ -\128\131\255\255\255\255\255\138\032\074\135\255\002\255\255\255\255\128\128\131\ -\255\130\000\000\000\000\002\128\128\131\253\241\241\241\255\138\255\255\255\255\ -\002\241\241\241\255\128\128\131\253\130\000\000\000\000\002\129\129\132\172\128\ -\128\131\253\138\128\128\131\255\002\128\128\131\253\129\129\132\172\134\000\000\ -\000\000\002\134\136\131\255\201\206\196\255\130\165\174\157\255\002\201\206\196\ -\255\134\136\131\255\133\000\000\000\000\034\136\138\133\004\136\138\133\116\169\ -\172\166\255\205\208\201\255\186\189\182\255\205\208\201\255\186\189\182\255\205\ -\208\201\255\186\189\182\255\205\208\201\255\186\189\182\255\205\208\201\255\186\ -\189\182\255\155\158\152\255\136\138\133\119\136\138\133\009\136\138\133\105\136\ -\138\133\255\196\198\192\255\186\189\182\255\204\207\200\255\186\189\182\255\192\ -\195\189\255\186\189\182\255\190\193\186\255\186\189\182\255\193\196\189\255\186\ -\189\182\255\206\209\202\255\196\198\192\255\136\138\133\255\136\138\133\115\136\ -\138\133\255\213\213\211\255\140\255\255\255\255\003\213\213\211\255\136\138\133\ -\255\142\143\139\214\142\136\138\133\255\001\142\143\139\214" - -let pixbuf () : GdkPixbuf.pixbuf = Marshal.from_string pixbuf_data 0 -;; -icon_16x16_devices_computer_png := Some (pixbuf ()) ;; diff --git a/virt-ctrl/vc_mainwindow.ml b/virt-ctrl/vc_mainwindow.ml deleted file mode 100644 index 7aa8145..0000000 --- a/virt-ctrl/vc_mainwindow.ml +++ /dev/null @@ -1,198 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. -*) - -open Printf - -let title = "Virtual Control" - -let utf8_copyright = "\194\169" - -let help_about () = - let gtk_version = - let gtk_major, gtk_minor, gtk_micro = GMain.Main.version in - sprintf "%d.%d.%d" gtk_major gtk_minor gtk_micro in - let virt_version = string_of_int (fst (Libvirt.get_version ())) in - let title = "About " ^ title in - let icon = GMisc.image () in - icon#set_stock `DIALOG_INFO; - icon#set_icon_size `DIALOG; - GToolbox.message_box - ~title - ~icon - ("Virtualization control tool (virt-ctrl) by\n" ^ - "Richard W.M. Jones (rjones@redhat.com).\n\n" ^ - "Copyright " ^ utf8_copyright ^ " 2007-2008 Red Hat Inc.\n\n" ^ - "Libvirt version: " ^ virt_version ^ "\n" ^ - "Gtk toolkit version: " ^ gtk_version) - -(* Catch any exception and throw up a dialog. *) -let () = - (* A nicer exception printing function. *) - let string_of_exn = function - | Libvirt.Virterror err -> - "Virtualisation error: " ^ (Libvirt.Virterror.to_string err) - | Failure msg -> msg - | exn -> Printexc.to_string exn - in - GtkSignal.user_handler := - fun exn -> - let label = string_of_exn exn in - prerr_endline label; - let title = "Error" in - let icon = GMisc.image () in - icon#set_stock `DIALOG_ERROR; - icon#set_icon_size `DIALOG; - GToolbox.message_box ~title ~icon label - -let make - ~start_domain ~pause_domain ~resume_domain ~shutdown_domain - ~open_domain_details = - (* Create the main window. *) - let window = GWindow.window ~width:800 ~height:600 ~title () in - let vbox = GPack.vbox ~packing:window#add () in - - (* Menu bar. *) - let quit_item = - let menubar = GMenu.menu_bar ~packing:vbox#pack () in - let factory = new GMenu.factory menubar in - let accel_group = factory#accel_group in - let file_menu = factory#add_submenu "File" in - let help_menu = factory#add_submenu "Help" in - - window#add_accel_group accel_group; - - (* File menu. *) - let factory = new GMenu.factory file_menu ~accel_group in - let open_item = factory#add_item "Open connection ..." - ~key:GdkKeysyms._O in - ignore (factory#add_separator ()); - let quit_item = factory#add_item "Quit" ~key:GdkKeysyms._Q in - - ignore (open_item#connect#activate - ~callback:(Vc_connection_dlg.open_connection window)); - - (* Help menu. *) - let factory = new GMenu.factory help_menu ~accel_group in - let help_item = factory#add_item "Help" in - let help_about_item = factory#add_item "About ..." in - - ignore (help_about_item#connect#activate ~callback:help_about); - - quit_item in - - (* The toolbar. *) - let toolbar = GButton.toolbar ~packing:vbox#pack () in - - (* The treeview. *) - let (tree, model, columns, initial_state) = - Vc_connections.make_treeview - ~packing:(vbox#pack ~expand:true ~fill:true) () in - - (* Add buttons to the toolbar (requires the treeview to - * have been made above). - *) - let () = - let connect_button_menu = GMenu.menu () in - let connect_button = - GButton.menu_tool_button - ~label:"Connect ..." ~stock:`CONNECT - ~menu:connect_button_menu - ~packing:toolbar#insert () in - ignore (GButton.separator_tool_item ~packing:toolbar#insert ()); - let open_button = - GButton.tool_button ~label:"Details" ~stock:`OPEN - ~packing:toolbar#insert () in - ignore (GButton.separator_tool_item ~packing:toolbar#insert ()); - let start_button = - GButton.tool_button ~label:"Start" ~stock:`ADD - ~packing:toolbar#insert () in - let pause_button = - GButton.tool_button ~label:"Pause" ~stock:`MEDIA_PAUSE - ~packing:toolbar#insert () in - let resume_button = - GButton.tool_button ~label:"Resume" ~stock:`MEDIA_PLAY - ~packing:toolbar#insert () in - ignore (GButton.separator_tool_item ~packing:toolbar#insert ()); - let shutdown_button = - GButton.tool_button ~label:"Shutdown" ~stock:`STOP - ~packing:toolbar#insert () in - - (* Set callbacks for the toolbar buttons. *) - ignore (connect_button#connect#clicked - ~callback:(Vc_connection_dlg.open_connection window)); - ignore (open_button#connect#clicked - ~callback:(open_domain_details tree model columns)); - ignore (start_button#connect#clicked - ~callback:(start_domain tree model columns)); - ignore (pause_button#connect#clicked - ~callback:(pause_domain tree model columns)); - ignore (resume_button#connect#clicked - ~callback:(resume_domain tree model columns)); - ignore (shutdown_button#connect#clicked - ~callback:(shutdown_domain tree model columns)); - - (* Set a menu on the connect menu-button. *) - let () = - let factory = new GMenu.factory connect_button_menu (*~accel_group*) in - let local_xen = factory#add_item "Local Xen" in - let local_qemu = factory#add_item "Local QEMU/KVM" in - ignore (factory#add_separator ()); - let open_dialog = factory#add_item "Connect to ..." in - ignore (local_xen#connect#activate - ~callback:Vc_connection_dlg.open_local_xen); - ignore (local_qemu#connect#activate - ~callback:Vc_connection_dlg.open_local_qemu); - ignore (open_dialog#connect#activate - ~callback:(Vc_connection_dlg.open_connection window)) in - () in - - (* Make a timeout function which is called once per second. *) - let state = ref initial_state in - let callback () = - (* Gc.compact is generally not safe in lablgtk programs, but - * is explicitly allowed in timeouts (see lablgtk README). - * This ensures memory is compacted regularly, but is also an - * excellent way to catch memory bugs in the ocaml libvirt bindings. - *) - Gc.compact (); - - (* Ugh: Bug in lablgtk causes a segfault if a timeout raises an - * exception. Catch and print exceptions instead. - *) - (try state := Vc_connections.repopulate tree model columns !state - with exn -> prerr_endline (Printexc.to_string exn)); - - true - in - let timeout_id = GMain.Timeout.add ~ms:1000 ~callback in - - (* Quit. *) - let quit _ = - GMain.Timeout.remove timeout_id; - GMain.quit (); - false - in - - ignore (window#connect#destroy ~callback:GMain.quit); - ignore (window#event#connect#delete ~callback:quit); - ignore (quit_item#connect#activate - ~callback:(fun () -> ignore (quit ()); ())); - - (* Display the window. *) - window#show () diff --git a/virt-ctrl/vc_mainwindow.mli b/virt-ctrl/vc_mainwindow.mli deleted file mode 100644 index 39439e9..0000000 --- a/virt-ctrl/vc_mainwindow.mli +++ /dev/null @@ -1,31 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. - - Make the main window. -*) - -(** This function creates the main window. You have to pass in - callback functions to wire everything up. -*) -val make : - start_domain:Vc_domain_ops.dops_callback_fn -> - pause_domain:Vc_domain_ops.dops_callback_fn -> - resume_domain:Vc_domain_ops.dops_callback_fn -> - shutdown_domain:Vc_domain_ops.dops_callback_fn -> - open_domain_details:Vc_domain_ops.dops_callback_fn -> - unit diff --git a/virt-ctrl/virt_ctrl.ml b/virt-ctrl/virt_ctrl.ml deleted file mode 100644 index c7c4620..0000000 --- a/virt-ctrl/virt_ctrl.ml +++ /dev/null @@ -1,35 +0,0 @@ -(* virt-ctrl: A graphical management tool. - (C) Copyright 2007 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. -*) - -open Printf - -let () = - (* Build the main window and wire up the buttons to the callback functions *) - Vc_mainwindow.make - ~start_domain:Vc_domain_ops.start_domain - ~pause_domain:Vc_domain_ops.pause_domain - ~resume_domain:Vc_domain_ops.resume_domain - ~shutdown_domain:Vc_domain_ops.shutdown_domain - ~open_domain_details:Vc_domain_ops.open_domain_details; - - (* Enter the Gtk main loop. *) - GMain.main (); - - (* Useful to catch memory bugs in the ocaml libvirt bindings. *) - Gc.compact () diff --git a/virt-df/.depend b/virt-df/.depend deleted file mode 100644 index 1a7750e..0000000 --- a/virt-df/.depend +++ /dev/null @@ -1,10 +0,0 @@ -virt_df_ext2.cmo: virt_df.cmo -virt_df_ext2.cmx: virt_df.cmx -virt_df_linux_swap.cmo: virt_df.cmo -virt_df_linux_swap.cmx: virt_df.cmx -virt_df_lvm2.cmo: virt_df.cmo -virt_df_lvm2.cmx: virt_df.cmx -virt_df_main.cmo: virt_df.cmo -virt_df_main.cmx: virt_df.cmx -virt_df.cmo: ../libvirt/libvirt_version.cmi ../libvirt/libvirt.cmi -virt_df.cmx: ../libvirt/libvirt_version.cmx ../libvirt/libvirt.cmx diff --git a/virt-df/Makefile.in b/virt-df/Makefile.in deleted file mode 100644 index 1f3af53..0000000 --- a/virt-df/Makefile.in +++ /dev/null @@ -1,86 +0,0 @@ -# virt-df -# Copyright (C) 2007 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 -# 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. - -PACKAGE := @PACKAGE_NAME@ -VERSION := @PACKAGE_VERSION@ - -INSTALL := @INSTALL@ -HAVE_PERLDOC := @HAVE_PERLDOC@ - -prefix = @prefix@ -exec_prefix = @exec_prefix@ -bindir = @bindir@ - -pkg_xml_light = @pkg_xml_light@ - -OCAMLCPACKAGES := -package unix,extlib,xml-light - -OBJS := virt_df.cmo \ - virt_df_ext2.cmo \ - virt_df_linux_swap.cmo \ - virt_df_lvm2.cmo \ - virt_df_main.cmo -XOBJS := $(OBJS:.cmo=.cmx) - -OCAMLCPACKAGES += -I ../libvirt -OCAMLCFLAGS := -g -w s -OCAMLCLIBS := -linkpkg - -OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) -OCAMLOPTFLAGS := -w s -OCAMLOPTLIBS := $(OCAMLCLIBS) - -export LIBRARY_PATH=../libvirt -export LD_LIBRARY_PATH=../libvirt - -BYTE_TARGETS := virt-df -OPT_TARGETS := virt-df.opt - -ifeq ($(HAVE_PERLDOC),perldoc) -BYTE_TARGETS += virt-df.1 virt-df.txt -endif - -all: $(BYTE_TARGETS) - -opt: $(OPT_TARGETS) - -virt-df: $(OBJS) - ocamlfind ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma -o $@ $^ - -virt-df.opt: $(XOBJS) - ocamlfind ocamlopt \ - $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa -o $@ $^ - -# Manual page. -ifeq ($(HAVE_PERLDOC),perldoc) -virt-df.1: virt-df.pod - pod2man -c "Virtualization Support" --release "$(PACKAGE)-$(VERSION)" \ - $< > $@ - -virt-df.txt: virt-df.pod - pod2text $< > $@ -endif - -install: - if [ -x virt-df.opt ]; then \ - mkdir -p $(DESTDIR)$(bindir); \ - $(INSTALL) -m 0755 virt-df.opt $(DESTDIR)$(bindir)/virt-df; \ - fi - -include ../Make.rules diff --git a/virt-df/README b/virt-df/README deleted file mode 100644 index 0623030..0000000 --- a/virt-df/README +++ /dev/null @@ -1,2 +0,0 @@ -Please see the manual page (virt-df.pod or virt-df.txt in this -directory). \ No newline at end of file diff --git a/virt-df/virt-df.1 b/virt-df/virt-df.1 deleted file mode 100644 index ff7e92d..0000000 --- a/virt-df/virt-df.1 +++ /dev/null @@ -1,280 +0,0 @@ -.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 -.\" -.\" Standard preamble: -.\" ======================================================================== -.de Sh \" Subsection heading -.br -.if t .Sp -.ne 5 -.PP -\fB\\$1\fR -.PP -.. -.de Sp \" Vertical space (when we can't use .PP) -.if t .sp .5v -.if n .sp -.. -.de Vb \" Begin verbatim text -.ft CW -.nf -.ne \\$1 -.. -.de Ve \" End verbatim text -.ft R -.fi -.. -.\" Set up some character translations and predefined strings. \*(-- will -.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left -.\" double quote, and \*(R" will give a right double quote. | will give a -.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to -.\" do unbreakable dashes and therefore won't be available. \*(C` and \*(C' -.\" expand to `' in nroff, nothing in troff, for use with C<>. -.tr \(*W-|\(bv\*(Tr -.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' -.ie n \{\ -. ds -- \(*W- -. ds PI pi -. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch -. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch -. ds L" "" -. ds R" "" -. ds C` "" -. ds C' "" -'br\} -.el\{\ -. ds -- \|\(em\| -. ds PI \(*p -. ds L" `` -. ds R" '' -'br\} -.\" -.\" If the F register is turned on, we'll generate index entries on stderr for -.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index -.\" entries marked with X<> in POD. Of course, you'll have to process the -.\" output yourself in some meaningful fashion. -.if \nF \{\ -. de IX -. tm Index:\\$1\t\\n%\t"\\$2" -.. -. nr % 0 -. rr F -.\} -.\" -.\" For nroff, turn off justification. Always turn off hyphenation; it makes -.\" way too many mistakes in technical documents. -.hy 0 -.if n .na -.\" -.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). -.\" Fear. Run. Save yourself. No user-serviceable parts. -. \" fudge factors for nroff and troff -.if n \{\ -. ds #H 0 -. ds #V .8m -. ds #F .3m -. ds #[ \f1 -. ds #] \fP -.\} -.if t \{\ -. ds #H ((1u-(\\\\n(.fu%2u))*.13m) -. ds #V .6m -. ds #F 0 -. ds #[ \& -. ds #] \& -.\} -. \" simple accents for nroff and troff -.if n \{\ -. ds ' \& -. ds ` \& -. ds ^ \& -. ds , \& -. ds ~ ~ -. ds / -.\} -.if t \{\ -. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" -. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' -. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' -. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' -. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' -. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' -.\} -. \" troff and (daisy-wheel) nroff accents -.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' -.ds 8 \h'\*(#H'\(*b\h'-\*(#H' -.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] -.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' -.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' -.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] -.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] -.ds ae a\h'-(\w'a'u*4/10)'e -.ds Ae A\h'-(\w'A'u*4/10)'E -. \" corrections for vroff -.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' -.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' -. \" for low resolution devices (crt and lpr) -.if \n(.H>23 .if \n(.V>19 \ -\{\ -. ds : e -. ds 8 ss -. ds o a -. ds d- d\h'-1'\(ga -. ds D- D\h'-1'\(hy -. ds th \o'bp' -. ds Th \o'LP' -. ds ae ae -. ds Ae AE -.\} -.rm #[ #] #H #V #F C -.\" ======================================================================== -.\" -.IX Title "VIRT-DF 1" -.TH VIRT-DF 1 "2008-03-04" "ocaml-libvirt-0.4.0.3" "Virtualization Support" -.SH "NAME" -virt\-df \- 'df'\-like utility for virtualization stats -.SH "SUMMARY" -.IX Header "SUMMARY" -virt-df [\-options] -.SH "DESCRIPTION" -.IX Header "DESCRIPTION" -virt-df is a \fIdf\fR\|(1)\-like utility for showing the actual disk usage -of guests. Many command line options are the same as for ordinary -\&\fIdf\fR. -.PP -It uses libvirt so it is capable of showing stats across a variety of -different virtualization systems. -.PP -There are some shortcomings to the whole approach of reading disk -state from outside the guest. Please read \s-1SHORTCOMINGS\s0 section below -for more details. -.SH "OPTIONS" -.IX Header "OPTIONS" -.IP "\fB\-a\fR, \fB\-\-all\fR" 4 -.IX Item "-a, --all" -Show all domains. The default is show only running (active) domains. -.IP "\fB\-c uri\fR, \fB\-\-connect uri\fR" 4 -.IX Item "-c uri, --connect uri" -Connect to libvirt \s-1URI\s0. The default is to connect to the default -libvirt \s-1URI\s0, normally Xen. -.IP "\fB\-h\fR, \fB\-\-human\-readable\fR" 4 -.IX Item "-h, --human-readable" -Display human-readable sizes (eg. 10GiB). -.IP "\fB\-i\fR, \fB\-\-inodes\fR" 4 -.IX Item "-i, --inodes" -Display inode information. -.IP "\fB\-\-help\fR" 4 -.IX Item "--help" -Display usage summary. -.IP "\fB\-\-version\fR" 4 -.IX Item "--version" -Display version and exit. -.SH "SHORTCOMINGS" -.IX Header "SHORTCOMINGS" -virt-df spies on the guest's disk image to try to work out how much -disk space it is actually using. There are some shortcomings to this, -described here. -.PP -(1) It does not work over remote connections. The storage \s-1API\s0 does -not support peeking into remote disks, and libvirt has rejected a -request to add this support. -.PP -(2) It only understands a limited set of partition types. Assuming -that the files and partitions that we get back from libvirt / Xen -correspond to block devices in the guests, we can go some way towards -manually parsing those partitions to find out what they contain. We -can read the \s-1MBR\s0, \s-1LVM\s0, superblocks and so on. However that's a lot of -parsing work, and currently there is no library which understands a -wide range of partition schemes and filesystem types (not even -libparted which doesn't support \s-1LVM\s0 yet). The Linux kernel does -support that, but there's not really any good way to access that work. -.PP -The current implementation uses a hand-coded parser which understands -some simple formats (\s-1MBR\s0, \s-1LVM2\s0, ext2/3). In future we should use -something like libparted. -.PP -(3) The statistics you get are delayed. The real state of, for -example, an ext2 filesystem is only stored in the memory of the -guest's kernel. The ext2 superblock contains some meta-information -about blocks used and free, but this superblock is not up to date. In -fact the guest kernel may not update it even on a 'sync', not until -the filesystem is unmounted. Some operations do appear to write the -superblock, for example \fIfsync\fR\|(2) [that is my reading of the ext2/3 -source code at least]. -.SH "SECURITY" -.IX Header "SECURITY" -The current code is probably not secure against malicious guests. In -particular a malicious guest can set up a disk in such a way that disk -structures with loops can cause virt-df to spin forever. We are -preparing a parsing library which can fix these sorts of problems. -.PP -In the meantime, do not run virt-df on untrusted guests. -.SH "SEE ALSO" -.IX Header "SEE ALSO" -\&\fIdf\fR\|(1), -\&\fIvirsh\fR\|(1), -\&\fIxm\fR\|(1), -, -, -, - -.SH "AUTHORS" -.IX Header "AUTHORS" -Richard W.M. Jones -.SH "COPYRIGHT" -.IX Header "COPYRIGHT" -(C) Copyright 2007\-2008 Red Hat Inc., Richard W.M. Jones -http://libvirt.org/ -.PP -This program is free software; you can redistribute it and/or modify -it under the terms of the \s-1GNU\s0 General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. -.PP -This program is distributed in the hope that it will be useful, -but \s-1WITHOUT\s0 \s-1ANY\s0 \s-1WARRANTY\s0; without even the implied warranty of -\&\s-1MERCHANTABILITY\s0 or \s-1FITNESS\s0 \s-1FOR\s0 A \s-1PARTICULAR\s0 \s-1PURPOSE\s0. See the -\&\s-1GNU\s0 General Public License for more details. -.PP -You should have received a copy of the \s-1GNU\s0 General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, \s-1MA\s0 02139, \s-1USA\s0. -.SH "REPORTING BUGS" -.IX Header "REPORTING BUGS" -Bugs can be viewed on the Red Hat Bugzilla page: -. -.PP -If you find a bug in virt\-df, please follow these steps to report it: -.IP "1. Check for existing bug reports" 4 -.IX Item "1. Check for existing bug reports" -Go to and search for similar bugs. -Someone may already have reported the same bug, and they may even -have fixed it. -.IP "2. Capture debug and error messages" 4 -.IX Item "2. Capture debug and error messages" -Run -.Sp -.Vb 1 -\& virt-df > virt-df.log 2>&1 -.Ve -.Sp -and keep \fIvirt\-df.log\fR. It contains error messages which you should -submit with your bug report. -.IP "3. Get version of virt-df and version of libvirt." 4 -.IX Item "3. Get version of virt-df and version of libvirt." -Run -.Sp -.Vb 1 -\& virt-df --version -.Ve -.IP "4. Submit a bug report." 4 -.IX Item "4. Submit a bug report." -Go to and enter a new bug. -Please describe the problem in as much detail as possible. -.Sp -Remember to include the version numbers (step 3) and the debug -messages file (step 2). -.IP "5. Assign the bug to rjones @ redhat.com" 4 -.IX Item "5. Assign the bug to rjones @ redhat.com" -Assign or reassign the bug to \fBrjones @ redhat.com\fR (without the -spaces). You can also send me an email with the bug number if you -want a faster response. diff --git a/virt-df/virt-df.pod b/virt-df/virt-df.pod deleted file mode 100644 index 84b1d97..0000000 --- a/virt-df/virt-df.pod +++ /dev/null @@ -1,174 +0,0 @@ -=head1 NAME - -virt-df - 'df'-like utility for virtualization stats - -=head1 SUMMARY - -virt-df [-options] - -=head1 DESCRIPTION - -virt-df is a L-like utility for showing the actual disk usage -of guests. Many command line options are the same as for ordinary -I. - -It uses libvirt so it is capable of showing stats across a variety of -different virtualization systems. - -There are some shortcomings to the whole approach of reading disk -state from outside the guest. Please read SHORTCOMINGS section below -for more details. - -=head1 OPTIONS - -=over 4 - -=item B<-a>, B<--all> - -Show all domains. The default is show only running (active) domains. - -=item B<-c uri>, B<--connect uri> - -Connect to libvirt URI. The default is to connect to the default -libvirt URI, normally Xen. - -=item B<-h>, B<--human-readable> - -Display human-readable sizes (eg. 10GiB). - -=item B<-i>, B<--inodes> - -Display inode information. - -=item B<--help> - -Display usage summary. - -=item B<--version> - -Display version and exit. - -=back - -=head1 SHORTCOMINGS - -virt-df spies on the guest's disk image to try to work out how much -disk space it is actually using. There are some shortcomings to this, -described here. - -(1) It does not work over remote connections. The storage API does -not support peeking into remote disks, and libvirt has rejected a -request to add this support. - -(2) It only understands a limited set of partition types. Assuming -that the files and partitions that we get back from libvirt / Xen -correspond to block devices in the guests, we can go some way towards -manually parsing those partitions to find out what they contain. We -can read the MBR, LVM, superblocks and so on. However that's a lot of -parsing work, and currently there is no library which understands a -wide range of partition schemes and filesystem types (not even -libparted which doesn't support LVM yet). The Linux kernel does -support that, but there's not really any good way to access that work. - -The current implementation uses a hand-coded parser which understands -some simple formats (MBR, LVM2, ext2/3). In future we should use -something like libparted. - -(3) The statistics you get are delayed. The real state of, for -example, an ext2 filesystem is only stored in the memory of the -guest's kernel. The ext2 superblock contains some meta-information -about blocks used and free, but this superblock is not up to date. In -fact the guest kernel may not update it even on a 'sync', not until -the filesystem is unmounted. Some operations do appear to write the -superblock, for example L [that is my reading of the ext2/3 -source code at least]. - -=head1 SECURITY - -The current code is probably not secure against malicious guests. In -particular a malicious guest can set up a disk in such a way that disk -structures with loops can cause virt-df to spin forever. We are -preparing a parsing library which can fix these sorts of problems. - -In the meantime, do not run virt-df on untrusted guests. - -=head1 SEE ALSO - -L, -L, -L, -L, -L, -L, -L - -=head1 AUTHORS - -Richard W.M. Jones - -=head1 COPYRIGHT - -(C) Copyright 2007-2008 Red Hat Inc., Richard W.M. Jones -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. - -=head1 REPORTING BUGS - -Bugs can be viewed on the Red Hat Bugzilla page: -L. - -If you find a bug in virt-df, please follow these steps to report it: - -=over 4 - -=item 1. Check for existing bug reports - -Go to L and search for similar bugs. -Someone may already have reported the same bug, and they may even -have fixed it. - -=item 2. Capture debug and error messages - -Run - - virt-df > virt-df.log 2>&1 - -and keep I. It contains error messages which you should -submit with your bug report. - -=item 3. Get version of virt-df and version of libvirt. - -Run - - virt-df --version - -=item 4. Submit a bug report. - -Go to L and enter a new bug. -Please describe the problem in as much detail as possible. - -Remember to include the version numbers (step 3) and the debug -messages file (step 2). - -=item 5. Assign the bug to rjones @ redhat.com - -Assign or reassign the bug to B (without the -spaces). You can also send me an email with the bug number if you -want a faster response. - -=back - -=end diff --git a/virt-df/virt-df.txt b/virt-df/virt-df.txt deleted file mode 100644 index fcddafb..0000000 --- a/virt-df/virt-df.txt +++ /dev/null @@ -1,139 +0,0 @@ -NAME - virt-df - 'df'-like utility for virtualization stats - -SUMMARY - virt-df [-options] - -DESCRIPTION - virt-df is a df(1)-like utility for showing the actual disk usage of - guests. Many command line options are the same as for ordinary *df*. - - It uses libvirt so it is capable of showing stats across a variety of - different virtualization systems. - - There are some shortcomings to the whole approach of reading disk state - from outside the guest. Please read SHORTCOMINGS section below for more - details. - -OPTIONS - -a, --all - Show all domains. The default is show only running (active) domains. - - -c uri, --connect uri - Connect to libvirt URI. The default is to connect to the default - libvirt URI, normally Xen. - - -h, --human-readable - Display human-readable sizes (eg. 10GiB). - - -i, --inodes - Display inode information. - - --help - Display usage summary. - - --version - Display version and exit. - -SHORTCOMINGS - virt-df spies on the guest's disk image to try to work out how much disk - space it is actually using. There are some shortcomings to this, - described here. - - (1) It does not work over remote connections. The storage API does not - support peeking into remote disks, and libvirt has rejected a request to - add this support. - - (2) It only understands a limited set of partition types. Assuming that - the files and partitions that we get back from libvirt / Xen correspond - to block devices in the guests, we can go some way towards manually - parsing those partitions to find out what they contain. We can read the - MBR, LVM, superblocks and so on. However that's a lot of parsing work, - and currently there is no library which understands a wide range of - partition schemes and filesystem types (not even libparted which doesn't - support LVM yet). The Linux kernel does support that, but there's not - really any good way to access that work. - - The current implementation uses a hand-coded parser which understands - some simple formats (MBR, LVM2, ext2/3). In future we should use - something like libparted. - - (3) The statistics you get are delayed. The real state of, for example, - an ext2 filesystem is only stored in the memory of the guest's kernel. - The ext2 superblock contains some meta-information about blocks used and - free, but this superblock is not up to date. In fact the guest kernel - may not update it even on a 'sync', not until the filesystem is - unmounted. Some operations do appear to write the superblock, for - example fsync(2) [that is my reading of the ext2/3 source code at - least]. - -SECURITY - The current code is probably not secure against malicious guests. In - particular a malicious guest can set up a disk in such a way that disk - structures with loops can cause virt-df to spin forever. We are - preparing a parsing library which can fix these sorts of problems. - - In the meantime, do not run virt-df on untrusted guests. - -SEE ALSO - df(1), virsh(1), xm(1), , - , , - - -AUTHORS - Richard W.M. Jones - -COPYRIGHT - (C) Copyright 2007-2008 Red Hat Inc., Richard W.M. Jones - 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. - -REPORTING BUGS - Bugs can be viewed on the Red Hat Bugzilla page: - . - - If you find a bug in virt-df, please follow these steps to report it: - - 1. Check for existing bug reports - Go to and search for similar bugs. - Someone may already have reported the same bug, and they may even - have fixed it. - - 2. Capture debug and error messages - Run - - virt-df > virt-df.log 2>&1 - - and keep *virt-df.log*. It contains error messages which you should - submit with your bug report. - - 3. Get version of virt-df and version of libvirt. - Run - - virt-df --version - - 4. Submit a bug report. - Go to and enter a new bug. Please - describe the problem in as much detail as possible. - - Remember to include the version numbers (step 3) and the debug - messages file (step 2). - - 5. Assign the bug to rjones @ redhat.com - Assign or reassign the bug to rjones @ redhat.com (without the - spaces). You can also send me an email with the bug number if you - want a faster response. - diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml deleted file mode 100644 index 350d535..0000000 --- a/virt-df/virt_df.ml +++ /dev/null @@ -1,505 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007-2008 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. - *) - -open Printf -open ExtList - -open Unix - -module C = Libvirt.Connect -module D = Libvirt.Domain -module N = Libvirt.Network - -(* Int64 operators for convenience. - * For sanity we do all int operations as int64's. - *) -let (+^) = Int64.add -let (-^) = Int64.sub -let ( *^ ) = Int64.mul -let (/^) = Int64.div - -let uri = ref None -let inodes = ref false -let human = ref false -let all = ref false - -(* Maximum number of extended partitions possible. *) -let max_extended_partitions = 100 - -let sector_size = 512L - -(* Parse out the device XML to get the names of disks. *) -type domain = { - dom_name : string; (* Domain name. *) - dom_id : int option; (* Domain ID (if running). *) - dom_disks : disk list; (* Domain disks. *) -} -and disk = { - d_type : string option; (* The *) - d_device : string option; (* The *) - d_source : string option; (* The *) - d_target : string option; (* The *) -} - -type partition = { - part_status : partition_status; (* Bootable, etc. *) - part_type : int; (* Partition type. *) - part_lba_start : int64; (* LBA start sector. *) - part_len : int64; (* Length in sectors. *) -} -and partition_status = Bootable | Nonbootable | Malformed | NullEntry - -type filesystem_stats = { - fs_name : string; - fs_block_size : int64; (* Block size (bytes). *) - fs_blocks_total : int64; (* Total blocks. *) - fs_blocks_reserved : int64; (* Blocks reserved for super-user. *) - fs_blocks_avail : int64; (* Blocks free (available). *) - fs_blocks_used : int64; (* Blocks in use. *) - fs_inodes_total : int64; (* Total inodes. *) - fs_inodes_reserved : int64; (* Inodes reserved for super-user. *) - fs_inodes_avail : int64; (* Inodes free (available). *) - fs_inodes_used : int64; (* Inodes in use. *) -} -and swap_stats = { - swap_name : string; - swap_block_size : int64; (* Block size (bytes). *) - swap_blocks_total : int64; (* Total blocks. *) -} -and fs_probe_t = (* Return type of the probe_partition.*) - | Filesystem of filesystem_stats - | Swap of swap_stats - | ProbeFailed of string (* Probe failed for some reason. *) - | ProbeIgnore (* This filesystem should be ignored. *) - -(* Register a filesystem type. *) -let filesystems = Hashtbl.create 13 -let fs_register part_types probe_fn = - List.iter - (fun part_type -> Hashtbl.replace filesystems part_type probe_fn) - part_types - -(* Probe the devices and display. - * - dom_name is the domain name - * - target will be something like "hda" - * - source will be the name of a file or disk partition on the local machine - *) -let rec probe_device dom_name target source = - let fd = openfile source [ O_RDONLY ] 0 in - let size = (LargeFile.fstat fd).LargeFile.st_size in - let size = size /^ sector_size in (* Size in sectors. *) - - (*print_device dom_name target source size;*) - - let partitions = probe_mbr fd in - - if partitions <> [] then ( - let stats = - List.mapi ( - fun i part -> - if part.part_status = Bootable || - part.part_status = Nonbootable then ( - let pnum = i+1 in - let target = target ^ string_of_int pnum in - Some (target, - probe_partition target (Some part.part_type) - fd part.part_lba_start part.part_len) - ) - else - None - ) partitions in - let stats = List.filter_map (fun x -> x) stats in - print_stats dom_name stats - ) else (* Not an MBR, assume it's a single partition. *) - print_stats dom_name [target, probe_partition target None fd 0L size]; - - close fd - -(* Probe the master boot record (if it is one) and read the partitions. - * Returns [] if this is not an MBR. - * http://en.wikipedia.org/wiki/Master_boot_record - *) -and probe_mbr fd = - lseek fd 510 SEEK_SET; - let str = String.create 2 in - if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then - [] (* Not MBR *) - else ( - (* Read the partition table. *) - lseek fd 446 SEEK_SET; - let str = String.create 64 in - if read fd str 0 64 <> 64 then - failwith "error reading partition table" - else ( - (* Extract partitions from the data. *) - let primaries = List.map (get_partition str) [ 0; 16; 32; 48 ] in - (* XXX validate partition extents compared to disk. *) - (* Read extended partition data. *) - let extendeds = List.map ( - function - | { part_type = 0x05 } as part -> - probe_extended_partition - max_extended_partitions fd part part.part_lba_start - | part -> [] - ) primaries in - let extendeds = List.concat extendeds in - primaries @ extendeds - ) - ) - -(* Probe an extended partition. *) -and probe_extended_partition max fd epart sect = - if max > 0 then ( - (* Offset of the first EBR. *) - let ebr_offs = sect *^ sector_size in - (* EBR Signature? *) - LargeFile.lseek fd (ebr_offs +^ 510L) SEEK_SET; - let str = String.create 2 in - if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then - [] (* Not EBR *) - else ( - (* Read the extended partition table entries (just 2 of them). *) - LargeFile.lseek fd (ebr_offs +^ 446L) SEEK_SET; - let str = String.create 32 in - if read fd str 0 32 <> 32 then - failwith "error reading extended partition" - else ( - (* Extract partitions from the data. *) - let part1, part2 = - match List.map (get_partition str) [ 0; 16 ] with - | [p1;p2] -> p1,p2 - | _ -> failwith "probe_extended_partition: internal error" in - (* First partition entry has offset to the start of this partition. *) - let part1 = { part1 with - part_lba_start = sect +^ part1.part_lba_start } in - (* Second partition entry is zeroes if end of list, otherwise points - * to the next partition. - *) - if part2.part_status = NullEntry then - [part1] - else - part1 :: probe_extended_partition - (max-1) fd epart (sect +^ part2.part_lba_start) - ) - ) - ) - else [] - -(* Get the partition data from str.[offs] - str.[offs+15] *) -and get_partition str offs = - let part_type = Char.code str.[offs+4] in - let part_lba_start = read_int32_le str (offs+8) in - let part_len = read_int32_le str (offs+12) in - - let part_status = - if part_type = 0 && part_lba_start = 0L && part_len = 0L then - NullEntry - else ( - let part_status = Char.code str.[offs] in - match part_status with - | 0x80 -> Bootable | 0 -> Nonbootable | _ -> Malformed - ) in - - { part_status = part_status; - part_type = part_type; - part_lba_start = part_lba_start; - part_len = part_len } - -(* Probe a single partition, which we assume contains either a - * filesystem or is a PV. - * - target will be something like "hda" or "hda1" - * - part_type will be the partition type if known, or None - * - fd is a file descriptor opened on the device - * - start & size are where we think the start and size of the - * partition is within the file descriptor (in SECTORS) - *) -and probe_partition target part_type fd start size = - match part_type with - | None -> - ProbeFailed "detection of unpartitioned devices not yet supported" - | Some 0x05 -> - ProbeIgnore (* Extended partition - ignore it. *) - | Some part_type -> - try - let probe_fn = Hashtbl.find filesystems part_type in - probe_fn target part_type fd start size - with - Not_found -> - ProbeFailed - (sprintf "unsupported partition type %02x" part_type) - -and print_stats dom_name statss = - List.iter ( - fun (target, fs_probe_t) -> - let dom_target = dom_name ^ ":" ^ target in - printf "%-20s " dom_target; - - match fs_probe_t with - (* Swap partition. *) - | Swap { swap_name = swap_name; - swap_block_size = block_size; - swap_blocks_total = blocks_total } -> - if not !human then - printf "%10Ld %s\n" - (block_size *^ blocks_total /^ 1024L) swap_name - else - printf "%10s %s\n" - (printable_size (block_size *^ blocks_total)) swap_name - - (* Ordinary filesystem. *) - | Filesystem stats -> - if not !inodes then ( (* Block display. *) - (* 'df' doesn't count the restricted blocks. *) - let blocks_total = - stats.fs_blocks_total -^ stats.fs_blocks_reserved in - let blocks_avail = - stats.fs_blocks_avail -^ stats.fs_blocks_reserved in - let blocks_avail = - if blocks_avail < 0L then 0L else blocks_avail in - - if not !human then ( (* Display 1K blocks. *) - printf "%10Ld %10Ld %10Ld %s\n" - (blocks_total *^ stats.fs_block_size /^ 1024L) - (stats.fs_blocks_used *^ stats.fs_block_size /^ 1024L) - (blocks_avail *^ stats.fs_block_size /^ 1024L) - stats.fs_name - ) else ( (* Human-readable blocks. *) - printf "%10s %10s %10s %s\n" - (printable_size (blocks_total *^ stats.fs_block_size)) - (printable_size (stats.fs_blocks_used *^ stats.fs_block_size)) - (printable_size (blocks_avail *^ stats.fs_block_size)) - stats.fs_name - ) - ) else ( (* Inodes display. *) - printf "%10Ld %10Ld %10Ld %s\n" - stats.fs_inodes_total stats.fs_inodes_used stats.fs_inodes_avail - stats.fs_name - ) - - (* Unsupported filesystem or other failure. *) - | ProbeFailed reason -> - printf " %s\n" reason - - | ProbeIgnore -> () - ) statss - -(* Target is something like "hda" and size is the size in sectors. *) -and print_device dom_name target source size = - printf "%s /dev/%s (%s) %s\n" - dom_name target (printable_size (size *^ sector_size)) source - -and printable_size bytes = - if bytes < 1024L *^ 1024L then - sprintf "%Ld bytes" bytes - else if bytes < 1024L *^ 1024L *^ 1024L then - sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.) - else - sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.) - -and read_int32_le str offs = - Int64.of_int (Char.code str.[offs]) +^ - 256L *^ Int64.of_int (Char.code str.[offs+1]) +^ - 65536L *^ Int64.of_int (Char.code str.[offs+2]) +^ - 16777216L *^ Int64.of_int (Char.code str.[offs+3]) - -and read_int16_le str offs = - Int64.of_int (Char.code str.[offs]) +^ - 256L *^ Int64.of_int (Char.code str.[offs+1]) - -let main () = - (* Command line argument parsing. *) - let set_uri = function "" -> uri := None | u -> uri := Some u in - - let version () = - printf "virt-df %s\n" (Libvirt_version.version); - - let major, minor, release = - let v, _ = Libvirt.get_version () in - v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in - printf "libvirt %d.%d.%d\n" major minor release; - exit 0 - in - - let argspec = Arg.align [ - "-a", Arg.Set all, " Show all domains (default: only active domains)"; - "--all", Arg.Set all, " Show all domains (default: only active domains)"; - "-c", Arg.String set_uri, "uri Connect to URI (default: Xen)"; - "--connect", Arg.String set_uri, "uri Connect to URI (default: Xen)"; - "-h", Arg.Set human, " Print sizes in human-readable format"; - "--human-readable", Arg.Set human, " Print sizes in human-readable format"; - "-i", Arg.Set inodes, " Show inodes instead of blocks"; - "--inodes", Arg.Set inodes, " Show inodes instead of blocks"; - "--version", Arg.Unit version, " Display version and exit"; - ] in - - let anon_fun str = raise (Arg.Bad (str ^ ": unknown parameter")) in - let usage_msg = "virt-df : like 'df', shows disk space used in guests - -SUMMARY - virt-df [-options] - -OPTIONS" in - - Arg.parse argspec anon_fun usage_msg; - - let xmls = - (* Connect to the hypervisor. *) - let conn = - let name = !uri in - try C.connect_readonly ?name () - with - Libvirt.Virterror err -> - prerr_endline (Libvirt.Virterror.to_string err); - (* If non-root and no explicit connection URI, print a warning. *) - if geteuid () <> 0 && name = None then ( - print_endline "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"; - ); - exit 1 in - - (* Get the list of active & inactive domains. *) - let doms = - let nr_active_doms = C.num_of_domains conn in - let active_doms = Array.to_list (C.list_domains conn nr_active_doms) in - let active_doms = List.map (D.lookup_by_id conn) active_doms in - if not !all then - active_doms - else ( - let nr_inactive_doms = C.num_of_defined_domains conn in - let inactive_doms = - Array.to_list (C.list_defined_domains conn nr_inactive_doms) in - let inactive_doms = List.map (D.lookup_by_name conn) inactive_doms in - active_doms @ inactive_doms - ) in - - (* Get their XML. *) - let xmls = List.map D.get_xml_desc doms in - - (* Parse the XML. *) - let xmls = List.map Xml.parse_string xmls in - - (* Return just the XML documents - everything else will be closed - * and freed including the connection to the hypervisor. - *) - xmls in - - let doms : domain list = - (* Grr.. Need to use a library which has XPATH support (or cduce). *) - List.map ( - fun xml -> - let nodes, domain_attrs = - match xml with - | Xml.Element ("domain", attrs, children) -> children, attrs - | _ -> failwith "get_xml_desc didn't return " in - - let domid = - try Some (int_of_string (List.assoc "id" domain_attrs)) - with Not_found -> None in - - let rec loop = function - | [] -> - failwith "get_xml_desc returned no node in XML" - | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name - | Xml.Element ("name", _, _) :: _ -> - failwith "get_xml_desc returned strange node" - | _ :: rest -> loop rest - in - let name = loop nodes in - - let devices = - let devices = - List.filter_map ( - function - | Xml.Element ("devices", _, devices) -> Some devices - | _ -> None - ) nodes in - List.concat devices 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 rec source_file_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "file" attrs) - with Not_found -> source_file_of rest) - | _ :: rest -> source_file_of rest - in - - let rec source_dev_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "dev" attrs) - with Not_found -> source_dev_of rest) - | _ :: rest -> source_dev_of rest - in - - let disks = - List.filter_map ( - function - | Xml.Element ("disk", attrs, children) -> - let typ = - try Some (List.assoc "type" attrs) - with Not_found -> None in - let device = - try Some (List.assoc "device" attrs) - with Not_found -> None in - let source = - match source_file_of children with - | (Some _) as source -> source - | None -> source_dev_of children in - let target = target_dev_of children in - - Some { - d_type = typ; d_device = device; - d_source = source; d_target = target - } - | _ -> None - ) devices in - - { dom_name = name; dom_id = domid; dom_disks = disks } - ) xmls in - - (* Print the title. *) - let () = - let total, used, avail = - match !inodes, !human with - | false, false -> "1K-blocks", "Used", "Available" - | false, true -> "Size", "Used", "Available" - | true, _ -> "Inodes", "IUse", "IFree" in - printf "%-20s %10s %10s %10s %s\n%!" - "Filesystem" total used avail "Type" in - - (* Probe the devices. *) - List.iter ( - fun { dom_name = dom_name; dom_disks = dom_disks } -> - List.iter ( - function - | { d_source = Some source; d_target = Some target } -> - probe_device dom_name target source - | { d_device = Some "cdrom" } -> - () (* Ignore physical CD-ROM devices. *) - | _ -> - printf "(device omitted)\n"; - ) dom_disks - ) doms diff --git a/virt-df/virt_df_ext2.ml b/virt-df/virt_df_ext2.ml deleted file mode 100755 index d2b51f3..0000000 --- a/virt-df/virt_df_ext2.ml +++ /dev/null @@ -1,99 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007 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. - - Support for EXT2/EXT3 filesystems. -*) - -open Unix -open Printf - -(* Int64 operators for convenience. *) -let (+^) = Int64.add -let (-^) = Int64.sub -let ( *^ ) = Int64.mul -let (/^) = Int64.div - -let sector_size = Virt_df.sector_size -let read_int32_le = Virt_df.read_int32_le - -let probe_ext2 target part_type fd start size = - LargeFile.lseek fd ((start+^2L) *^ sector_size) SEEK_SET; - let str = String.create 128 in - if read fd str 0 128 <> 128 then - failwith "error reading ext2/ext3 magic" - else ( - if str.[56] != '\x53' || str.[57] != '\xEF' then ( - Virt_df.ProbeFailed "partition marked EXT2/3 but no valid filesystem" - ) else ( - (* Refer to *) - let s_inodes_count = read_int32_le str 0 in - let s_blocks_count = read_int32_le str 4 in - let s_r_blocks_count = read_int32_le str 8 in - let s_free_blocks_count = read_int32_le str 12 in - let s_free_inodes_count = read_int32_le str 16 in - let s_first_data_block = read_int32_le str 20 in - let s_log_block_size = read_int32_le str 24 in - (*let s_log_frag_size = read_int32_le str 28 in*) - let s_blocks_per_group = read_int32_le str 32 in - - (* Work out the block size in bytes. *) - let s_log_block_size = Int64.to_int s_log_block_size in - let block_size = 1024L in - let block_size = Int64.shift_left block_size s_log_block_size in - - (* Number of groups. *) - let s_groups_count = - (s_blocks_count -^ s_first_data_block -^ 1L) - /^ s_blocks_per_group +^ 1L in - -(* - (* Number of group descriptors per block. *) - let s_inodes_per_block = s_blocksize / - let s_desc_per_block = block_size / s_inodes_per_block in - let db_count = - (s_groups_count +^ s_desc_per_block -^ 1L) - /^ s_desc_per_block -*) - - (* Calculate the block overhead (used by superblocks, inodes, etc.) - * See fs/ext2/super.c. - *) - let overhead = s_first_data_block in - let overhead = (* XXX *) overhead in - - - Virt_df.Filesystem { - Virt_df.fs_name = "Linux ext2/3"; - fs_block_size = block_size; - fs_blocks_total = s_blocks_count -^ overhead; - fs_blocks_reserved = s_r_blocks_count; - fs_blocks_avail = s_free_blocks_count; - fs_blocks_used = s_blocks_count -^ overhead -^ s_free_blocks_count; - fs_inodes_total = s_inodes_count; - fs_inodes_reserved = 0L; (* XXX? *) - fs_inodes_avail = s_free_inodes_count; - fs_inodes_used = s_inodes_count (*-^ 0L*) -^ s_free_inodes_count; - } - ) - ) - -(* Register with main code. *) -let () = - Virt_df.fs_register - [ 0x83 ] (* Partition type. *) - probe_ext2 diff --git a/virt-df/virt_df_linux_swap.ml b/virt-df/virt_df_linux_swap.ml deleted file mode 100755 index 4638828..0000000 --- a/virt-df/virt_df_linux_swap.ml +++ /dev/null @@ -1,40 +0,0 @@ -(* 'df' command for virtual domains. - - (C) Copyright 2007 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. - - Support for Linux swap partitions. -*) - -(* Int64 operators for convenience. *) -let (+^) = Int64.add -let (-^) = Int64.sub -let ( *^ ) = Int64.mul -let (/^) = Int64.div - -let probe_swap target part_type fd start size = - Virt_df.Swap { - Virt_df.swap_name = "Linux swap"; - swap_block_size = 4096L; (* XXX *) - swap_blocks_total = size *^ 512L /^ 4096L; - } - -(* Register with main code. *) -let () = - Virt_df.fs_register - [ 0x82 ] (* Partition type. *) - probe_swap diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml deleted file mode 100755 index 8dc0c05..0000000 --- a/virt-df/virt_df_lvm2.ml +++ /dev/null @@ -1,38 +0,0 @@ -(* 'df' command for virtual domains. - - (C) Copyright 2007 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. - - Support for LVM2 PVs. -*) - -open Printf - -(* Int64 operators for convenience. *) -let (+^) = Int64.add -let (-^) = Int64.sub -let ( *^ ) = Int64.mul -let (/^) = Int64.div - -let probe_lvm2 target part_type fd start size = - Virt_df.ProbeFailed "LVM2 not supported yet" - -(* Register with main code. *) -let () = - Virt_df.fs_register - [ 0x8e ] (* Partition type. *) - probe_lvm2 diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml deleted file mode 100755 index bc4096b..0000000 --- a/virt-df/virt_df_main.ml +++ /dev/null @@ -1,20 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007 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. - *) - -let () = Virt_df.main () diff --git a/virt-top/.depend b/virt-top/.depend index 8a8d99e..15e5c48 100644 --- a/virt-top/.depend +++ b/virt-top/.depend @@ -1,18 +1,14 @@ -virt_top.cmi: ../libvirt/libvirt.cmi -virt_top_utils.cmi: ../libvirt/libvirt.cmi -virt_top_calendar1.cmo: virt_top.cmi -virt_top_calendar1.cmx: virt_top.cmx -virt_top_calendar2.cmo: virt_top.cmi -virt_top_calendar2.cmx: virt_top.cmx -virt_top_csv.cmo: virt_top.cmi -virt_top_csv.cmx: virt_top.cmx -virt_top_main.cmo: virt_top.cmi ../libvirt/libvirt.cmi -virt_top_main.cmx: virt_top.cmx ../libvirt/libvirt.cmx -virt_top.cmo: virt_top_utils.cmi ../libvirt/libvirt_version.cmi \ - ../libvirt/libvirt.cmi virt_top.cmi -virt_top.cmx: virt_top_utils.cmx ../libvirt/libvirt_version.cmx \ - ../libvirt/libvirt.cmx virt_top.cmi -virt_top_utils.cmo: ../libvirt/libvirt.cmi virt_top_utils.cmi -virt_top_utils.cmx: ../libvirt/libvirt.cmx virt_top_utils.cmi -virt_top_xml.cmo: virt_top.cmi ../libvirt/libvirt.cmi -virt_top_xml.cmx: virt_top.cmx ../libvirt/libvirt.cmx +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_csv.cmo: virt_top_gettext.cmo virt_top.cmi +virt_top_csv.cmx: virt_top_gettext.cmx virt_top.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.cmo: virt_top_utils.cmi virt_top_gettext.cmo virt_top.cmi +virt_top.cmx: virt_top_utils.cmx virt_top_gettext.cmx virt_top.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_xml.cmo: virt_top_gettext.cmo virt_top.cmi +virt_top_xml.cmx: virt_top_gettext.cmx virt_top.cmx diff --git a/virt-top/Makefile.in b/virt-top/Makefile.in index 31cd828..e471f93 100755 --- a/virt-top/Makefile.in +++ b/virt-top/Makefile.in @@ -30,31 +30,35 @@ pkg_xml_light = @pkg_xml_light@ pkg_csv = @pkg_csv@ pkg_calendar = @pkg_calendar@ pkg_calendar2 = @pkg_calendar2@ +pkg_gettext = @pkg_gettext@ -OCAMLCPACKAGES := -package unix,extlib,curses,str +OCAMLCPACKAGES := -package unix,extlib,curses,str,libvirt -OBJS := virt_top_utils.cmo virt_top.cmo +ifeq ($(pkg_gettext),yes) +OCAMLCPACKAGES += -package gettext-stub +endif + +OBJS := virt_top_gettext.cmo virt_top_utils.cmo virt_top.cmo ifeq ($(pkg_xml_light),yes) OBJS += virt_top_xml.cmo -OCAMLCPACKAGES := $(OCAMLCPACKAGES),xml-light +OCAMLCPACKAGES += -package xml-light endif ifeq ($(pkg_csv),yes) OBJS += virt_top_csv.cmo -OCAMLCPACKAGES := $(OCAMLCPACKAGES),csv +OCAMLCPACKAGES += -package csv endif ifeq ($(pkg_calendar),yes) OBJS += virt_top_calendar1.cmo -OCAMLCPACKAGES := $(OCAMLCPACKAGES),calendar +OCAMLCPACKAGES += -package calendar endif ifneq ($(pkg_calendar2),no) OBJS += virt_top_calendar2.cmo -OCAMLCPACKAGES := $(OCAMLCPACKAGES),calendar +OCAMLCPACKAGES += -package calendar endif OBJS += virt_top_main.cmo XOBJS := $(OBJS:.cmo=.cmx) -OCAMLCPACKAGES += -I ../libvirt OCAMLCFLAGS := -g -w s OCAMLCLIBS := -linkpkg @@ -62,9 +66,6 @@ OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) OCAMLOPTFLAGS := -w s OCAMLOPTLIBS := $(OCAMLCLIBS) -export LIBRARY_PATH=../libvirt -export LD_LIBRARY_PATH=../libvirt - BYTE_TARGETS := virt-top OPT_TARGETS := virt-top.opt @@ -77,13 +78,12 @@ all: $(BYTE_TARGETS) opt: $(OPT_TARGETS) virt-top: $(OBJS) - ocamlfind ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma -o $@ $^ + ocamlfind ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) -o $@ $^ virt-top.opt: $(XOBJS) ocamlfind ocamlopt \ $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa -cclib -lncurses -o $@ $^ + -cclib -lncurses -o $@ $^ # Manual page. ifeq ($(HAVE_PERLDOC),perldoc) diff --git a/virt-top/virt_top.ml b/virt-top/virt_top.ml old mode 100755 new mode 100644 index b3e2628..a8c4839 --- a/virt-top/virt_top.ml +++ b/virt-top/virt_top.ml @@ -21,6 +21,7 @@ open Printf open ExtList open Curses +open Virt_top_gettext.Gettext open Virt_top_utils module C = Libvirt.Connect @@ -36,7 +37,7 @@ let parse_device_xml : (int -> [>`R] D.t -> string list * string list) ref = (* Hooks for CSV support (see virt_top_csv.ml). *) let csv_start : (string -> unit) ref = ref ( - fun _ -> failwith "virt-top was compiled without support for CSV files" + fun _ -> failwith (s_ "virt-top was compiled without support for CSV files") ) let csv_write : (string list -> unit) ref = ref ( @@ -47,7 +48,7 @@ let csv_write : (string list -> unit) ref = let parse_date_time : (string -> float) ref = ref ( fun _ -> - failwith "virt-top was compiled without support for dates and times" + failwith (s_ "virt-top was compiled without support for dates and times") ) (* Sort order. *) @@ -59,15 +60,15 @@ let all_sort_fields = [ NetRX; NetTX; BlockRdRq; BlockWrRq ] let printable_sort_order = function - | Processor -> "%CPU" - | Memory -> "%MEM" - | Time -> "TIME (CPU time)" - | DomainID -> "Domain ID" - | DomainName -> "Domain name" - | NetRX -> "Net RX bytes" - | NetTX -> "Net TX bytes" - | BlockRdRq -> "Block read reqs" - | BlockWrRq -> "Block write reqs" + | Processor -> s_ "%CPU" + | Memory -> s_ "%MEM" + | Time -> s_ "TIME (CPU time)" + | DomainID -> s_ "Domain ID" + | DomainName -> s_ "Domain name" + | NetRX -> s_ "Net RX bytes" + | NetTX -> s_ "Net TX bytes" + | BlockRdRq -> s_ "Block read reqs" + | BlockWrRq -> s_ "Block write reqs" let sort_order_of_cli = function | "cpu" | "processor" -> Processor | "mem" | "memory" -> Memory @@ -76,7 +77,10 @@ let sort_order_of_cli = function | "name" -> DomainName | "netrx" -> NetRX | "nettx" -> NetTX | "blockrdrq" -> BlockRdRq | "blockwrrq" -> BlockWrRq - | str -> failwith (str ^ ": sort order should be: cpu|mem|time|id|name|netrx|nettx|blockrdrq|blockwrrq") + | str -> + failwith + (sprintf (f_ "%s: sort order should be: %s") + str "cpu|mem|time|id|name|netrx|nettx|blockrdrq|blockwrrq") let cli_of_sort_order = function | Processor -> "cpu" | Memory -> "mem" @@ -96,7 +100,10 @@ let display_of_cli = function | "pcpu" -> PCPUDisplay | "block" -> BlockDisplay | "net" -> NetDisplay - | str -> failwith (str ^ ": display should be task|pcpu|block|net") + | str -> + failwith + (sprintf (f_ "%s: display should be %s") + str "task|pcpu|block|net") let cli_of_display = function | TaskDisplay -> "task" | PCPUDisplay -> "pcpu" @@ -135,7 +142,7 @@ let start_up () = (* Read command line arguments. *) let rec set_delay newdelay = if newdelay <= 0. then - failwith "-d: cannot set a negative delay"; + failwith (s_ "-d: cannot set a negative delay"); delay := int_of_float (newdelay *. 1000.) and set_uri = function "" -> uri := None | u -> uri := Some u and set_sort order = sort_order := sort_order_of_cli order @@ -150,29 +157,50 @@ let start_up () = and set_end_time time = end_time := Some ((!parse_date_time) time) in let argspec = Arg.align [ - "-1", Arg.Unit set_pcpu_mode, " Start by displaying pCPUs (default: tasks)"; - "-2", Arg.Unit set_net_mode, " Start by displaying network interfaces"; - "-3", Arg.Unit set_block_mode, " Start by displaying block devices"; - "-b", Arg.Set batch_mode, " Batch mode"; - "-c", Arg.String set_uri, "uri Connect to URI (default: Xen)"; - "--connect", Arg.String set_uri, "uri Connect to URI (default: Xen)"; - "--csv", Arg.String set_csv, "file Log statistics to CSV file"; - "--no-csv-cpu", Arg.Clear csv_cpu, " Disable CPU stats in CSV"; - "--no-csv-block", Arg.Clear csv_block, " Disable block device stats in CSV"; - "--no-csv-net", Arg.Clear csv_net, " Disable net stats in CSV"; - "-d", Arg.Float set_delay, "delay Delay time interval (seconds)"; - "--debug", Arg.Set_string debug_file, "file Send debug messages to file"; - "--end-time", Arg.String set_end_time, "time Exit at given time"; - "--hist-cpu", Arg.Set_int historical_cpu_delay, "secs Historical CPU delay"; - "--init-file", Arg.String set_init_file, "file Set name of init file"; - "--no-init-file", Arg.Unit no_init_file, " Do not read init file"; - "-n", Arg.Set_int iterations, "iterations Number of iterations to run"; - "-o", Arg.String set_sort, "sort Set sort order (cpu|mem|time|id|name)"; - "-s", Arg.Set secure_mode, " Secure (\"kiosk\") mode"; - "--script", Arg.Set script_mode, " Run from a script (no user interface)"; + "-1", Arg.Unit set_pcpu_mode, + " " ^ s_ "Start by displaying pCPUs (default: tasks)"; + "-2", Arg.Unit set_net_mode, + " " ^ s_ "Start by displaying network interfaces"; + "-3", Arg.Unit set_block_mode, + " " ^ s_ "Start by displaying block devices"; + "-b", Arg.Set batch_mode, + " " ^ s_ "Batch mode"; + "-c", Arg.String set_uri, + "uri " ^ s_ "Connect to URI (default: Xen)"; + "--connect", Arg.String set_uri, + "uri " ^ s_ "Connect to URI (default: Xen)"; + "--csv", Arg.String set_csv, + "file " ^ s_ "Log statistics to CSV file"; + "--no-csv-cpu", Arg.Clear csv_cpu, + " " ^ s_ "Disable CPU stats in CSV"; + "--no-csv-block", Arg.Clear csv_block, + " " ^ s_ "Disable block device stats in CSV"; + "--no-csv-net", Arg.Clear csv_net, + " " ^ s_ "Disable net stats in CSV"; + "-d", Arg.Float set_delay, + "delay " ^ s_ "Delay time interval (seconds)"; + "--debug", Arg.Set_string debug_file, + "file " ^ s_ "Send debug messages to file"; + "--end-time", Arg.String set_end_time, + "time " ^ s_ "Exit at given time"; + "--hist-cpu", Arg.Set_int historical_cpu_delay, + "secs " ^ s_ "Historical CPU delay"; + "--init-file", Arg.String set_init_file, + "file " ^ s_ "Set name of init file"; + "--no-init-file", Arg.Unit no_init_file, + " " ^ s_ "Do not read init file"; + "-n", Arg.Set_int iterations, + "iterations " ^ s_ "Number of iterations to run"; + "-o", Arg.String set_sort, + "sort " ^ sprintf (f_ "Set sort order (%s)") "cpu|mem|time|id|name"; + "-s", Arg.Set secure_mode, + " " ^ s_ "Secure (\"kiosk\") mode"; + "--script", Arg.Set script_mode, + " " ^ s_ "Run from a script (no user interface)"; ] in - let anon_fun str = raise (Arg.Bad (str ^ ": unknown parameter")) in - let usage_msg = "virt-top : a 'top'-like utility for virtualization + let anon_fun str = + raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in + let usage_msg = s_ "virt-top : a 'top'-like utility for virtualization SUMMARY virt-top [-options] @@ -202,7 +230,7 @@ OPTIONS" in | _, "end-time", t -> set_end_time t | _, "overwrite-init-file", "false" -> no_init_file () | lineno, key, _ -> - eprintf "%s:%d: configuration item ``%s'' ignored\n%!" + eprintf (f_ "%s:%d: configuration item ``%s'' ignored\n%!") filename lineno key ) config in @@ -227,7 +255,7 @@ OPTIONS" in prerr_endline (Libvirt.Virterror.to_string err); (* If non-root and no explicit connection URI, print a warning. *) if Unix.geteuid () <> 0 && name = None then ( - print_endline "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"; + print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"); ); exit 1 in @@ -1113,14 +1141,14 @@ let redraw = total_cpu_time, total_memory, total_domU_memory) = totals in mvaddstr summary_lineno 0 - (sprintf "%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d" + (sprintf (f_ "%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d") count active running blocked paused inactive shutdown shutoff crashed); (* Total %CPU used, and memory summary. *) let percent_cpu = 100. *. total_cpu_time /. total_cpu in mvaddstr (summary_lineno+1) 0 - (sprintf "CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)" + (sprintf (f_ "CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)") percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L)); (* Time to grab another historical %CPU for the list? *) @@ -1287,20 +1315,21 @@ and get_key_press setup = ) and change_delay () = - print_msg (sprintf "Change delay from %.1f to: " (float !delay /. 1000.)); + print_msg + (sprintf (f_ "Change delay from %.1f to: ") (float !delay /. 1000.)); let str = get_string 16 in (* Try to parse the number. *) let error = try let newdelay = float_of_string str in if newdelay <= 0. then ( - print_msg "Delay must be > 0"; true + print_msg (s_ "Delay must be > 0"); true ) else ( delay := int_of_float (newdelay *. 1000.); false ) with Failure "float_of_string" -> - print_msg "Not a valid number"; true in + print_msg (s_ "Not a valid number"); true in refresh (); sleep (if error then 2 else 1) @@ -1308,8 +1337,8 @@ and change_sort_order () = clear (); let lines, cols = get_size () in - mvaddstr top_lineno 0 "Set sort order for main display"; - mvaddstr summary_lineno 0 "Type key or use up and down cursor keys."; + mvaddstr top_lineno 0 (s_ "Set sort order for main display"); + mvaddstr summary_lineno 0 (s_ "Type key or use up and down cursor keys."); attron A.reverse; mvaddstr header_lineno 0 (pad cols "KEY Sort field"); @@ -1458,8 +1487,8 @@ and _write_init_file filename = let fp = fprintf in let nl () = fp chan "\n" in - fp chan "# .virt-toprc virt-top configuration file\n"; - fp chan "# generated on %s by %s\n" printable_date_time username; + let () = fp chan (f_ "# .virt-toprc virt-top configuration file\n") in + let () = fp chan (f_ "# generated on %s by %s\n") printable_date_time username in nl (); fp chan "display %s\n" (cli_of_display !display_mode); fp chan "delay %g\n" (float !delay /. 1000.); @@ -1473,13 +1502,13 @@ and _write_init_file filename = if !batch_mode = true then fp chan "batch true\n"; if !secure_mode = true then fp chan "secure true\n"; nl (); - fp chan "# To send debug and error messages to a file, uncomment next line\n"; + let () = fp chan (f_ "# To send debug and error messages to a file, uncomment next line\n") in fp chan "#debug virt-top.out\n"; nl (); - fp chan "# Enable CSV output to the named file\n"; + let () = fp chan (f_ "# Enable CSV output to the named file\n") in fp chan "#csv virt-top.csv\n"; nl (); - fp chan "# To protect this file from being overwritten, uncomment next line\n"; + let () = fp chan (f_ "# To protect this file from being overwritten, uncomment next line\n") in fp chan "#overwrite-init-file false\n"; close_out chan; @@ -1491,13 +1520,14 @@ and _write_init_file filename = (* Rename filename.new to filename. *) Unix.rename (filename ^ ".new") filename; - print_msg (sprintf "Wrote settings to %s" filename); + print_msg (sprintf (f_ "Wrote settings to %s") filename); refresh (); sleep 2 with - | Sys_error err -> print_msg "Error: %s"; refresh (); sleep 2 + | Sys_error err -> + print_msg (s_ "Error" ^ ": " ^ err); refresh (); sleep 2 | Unix.Unix_error (err, fn, str) -> - print_msg (sprintf "Error: %s %s %s" (Unix.error_message err) fn str); + print_msg (s_ ("Error" ^ ": " ^ Unix.error_message err ^ fn ^ str)); refresh (); sleep 2 @@ -1510,7 +1540,7 @@ and show_help (_, _, _, _, _, hostname, (* Banner at the top of the screen. *) let banner = - sprintf "virt-top %s (libvirt %d.%d.%d) by Red Hat" + sprintf (f_ "virt-top %s (libvirt %d.%d.%d) by Red Hat") Libvirt_version.version libvirt_major libvirt_minor libvirt_release in let banner = pad cols banner in attron A.reverse; @@ -1519,18 +1549,18 @@ and show_help (_, _, _, _, _, hostname, (* Status. *) mvaddstr 1 0 - (sprintf "Delay: %.1f secs; Batch: %s; Secure: %s; Sort: %s" + (sprintf (f_ "Delay: %.1f secs; Batch: %s; Secure: %s; Sort: %s") (float !delay /. 1000.) (if !batch_mode then "On" else "Off") (if !secure_mode then "On" else "Off") (printable_sort_order !sort_order)); mvaddstr 2 0 - (sprintf "Connect: %s; Hostname: %s" + (sprintf (f_ "Connect: %s; Hostname: %s") (match !uri with None -> "default" | Some s -> s) hostname); (* Misc keys on left. *) - let banner = pad 38 "MAIN KEYS" in + let banner = pad 38 (s_ "MAIN KEYS") in attron A.reverse; mvaddstr header_lineno 1 banner; attroff A.reverse; @@ -1544,26 +1574,26 @@ and show_help (_, _, _, _, _, hostname, move lineno 1; attron A.bold; addstr keys; attroff A.bold; move lineno 10; addstr description; () in - key "space ^L" "Update display"; - key "q" "Quit"; - key "d s" "Set update interval"; - key "h" "Help"; + key "space ^L" (s_ "Update display"); + key "q" (s_ "Quit"); + key "d s" (s_ "Set update interval"); + key "h" (s_ "Help"); (* Sort order. *) ignore (get_lineno ()); - let banner = pad 38 "SORTING" in + let banner = pad 38 (s_ "SORTING") in attron A.reverse; mvaddstr (get_lineno ()) 1 banner; attroff A.reverse; - key "P" "Sort by %CPU"; - key "M" "Sort by %MEM"; - key "T" "Sort by TIME"; - key "N" "Sort by ID"; - key "F" "Select sort field"; + key "P" (s_ "Sort by %CPU"); + key "M" (s_ "Sort by %MEM"); + key "T" (s_ "Sort by TIME"); + key "N" (s_ "Sort by ID"); + key "F" (s_ "Select sort field"); (* Display modes on right. *) - let banner = pad 39 "DISPLAY MODES" in + let banner = pad 39 (s_ "DISPLAY MODES") in attron A.reverse; mvaddstr header_lineno 40 banner; attroff A.reverse; @@ -1577,18 +1607,18 @@ and show_help (_, _, _, _, _, hostname, move lineno 40; attron A.bold; addstr keys; attroff A.bold; move lineno 49; addstr description; () in - key "0" "Domains display"; - key "1" "Toggle physical CPUs"; - key "2" "Toggle network interfaces"; - key "3" "Toggle block devices"; + key "0" (s_ "Domains display"); + key "1" (s_ "Toggle physical CPUs"); + key "2" (s_ "Toggle network interfaces"); + key "3" (s_ "Toggle block devices"); (* Update screen and wait for key press. *) mvaddstr (lines-1) 0 - "More help in virt-top(1) man page. Press any key to return."; + (s_ "More help in virt-top(1) man page. Press any key to return."); refresh (); ignore (getch ()) and unknown_command k = - print_msg "Unknown command - try 'h' for help"; + print_msg (s_ "Unknown command - try 'h' for help"); refresh (); sleep 1 diff --git a/virt-top/virt_top_calendar1.ml b/virt-top/virt_top_calendar1.ml index 438a791..779e62b 100755 --- a/virt-top/virt_top_calendar1.ml +++ b/virt-top/virt_top_calendar1.ml @@ -20,7 +20,9 @@ *) open Printf -open ExtString ;; +open ExtString + +open Virt_top_gettext.Gettext ;; Virt_top.parse_date_time := fun time -> diff --git a/virt-top/virt_top_calendar2.ml b/virt-top/virt_top_calendar2.ml index dd00c79..3d042e3 100755 --- a/virt-top/virt_top_calendar2.ml +++ b/virt-top/virt_top_calendar2.ml @@ -22,7 +22,9 @@ open CalendarLib open Printf -open ExtString ;; +open ExtString + +open Virt_top_gettext.Gettext ;; Virt_top.parse_date_time := fun time -> diff --git a/virt-top/virt_top_csv.ml b/virt-top/virt_top_csv.ml old mode 100755 new mode 100644 index 8f8c45d..3393e3a --- a/virt-top/virt_top_csv.ml +++ b/virt-top/virt_top_csv.ml @@ -19,6 +19,8 @@ This file contains all code which requires CSV support. *) +open Virt_top_gettext.Gettext + (* Output channel, or None if CSV output not enabled. *) let chan = ref None ;; diff --git a/virt-top/virt_top_main.ml b/virt-top/virt_top_main.ml old mode 100755 new mode 100644 index ba98e7e..4ab60ad --- a/virt-top/virt_top_main.ml +++ b/virt-top/virt_top_main.ml @@ -21,6 +21,7 @@ open Curses +open Virt_top_gettext.Gettext open Virt_top (* Note: make sure we catch any exceptions and clean up the display. @@ -43,7 +44,7 @@ let error = true | exn -> if not script_mode then endwin (); - prerr_endline ("Error: " ^ Printexc.to_string exn); + prerr_endline (s_ "Error" ^ ": " ^ Printexc.to_string exn); true let () = diff --git a/virt-top/virt_top_utils.ml b/virt-top/virt_top_utils.ml old mode 100755 new mode 100644 index 53c9bf1..c668fb9 --- a/virt-top/virt_top_utils.ml +++ b/virt-top/virt_top_utils.ml @@ -21,6 +21,8 @@ open Printf +open Virt_top_gettext.Gettext + module C = Libvirt.Connect module D = Libvirt.Domain module N = Libvirt.Network diff --git a/virt-top/virt_top_xml.ml b/virt-top/virt_top_xml.ml old mode 100755 new mode 100644 index 8bf3d8a..73a4906 --- a/virt-top/virt_top_xml.ml +++ b/virt-top/virt_top_xml.ml @@ -21,6 +21,8 @@ open ExtList +open Virt_top_gettext.Gettext + module C = Libvirt.Connect module D = Libvirt.Domain module N = Libvirt.Network ;; @@ -41,7 +43,7 @@ fun id dom -> ) children in List.concat devices | _ -> - failwith "get_xml_desc didn't return " in + failwith (s_ "get_xml_desc didn't return ") in let rec target_dev_of = function | [] -> None | Xml.Element ("target", attrs, _) :: rest ->