From b43c08e73143ed9e74222c376538902a466f3f62 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 31 Jan 2024 10:58:38 +0000 Subject: [PATCH] Revert "Merge stdext and reverse deps into XAPI" Signed-off-by: Pau Ruiz Safont --- .github/workflows/format.yml | 1 - Makefile | 8 +- dune-project | 104 -- ocaml/forkexecd/.ocamlformat | 9 + ocaml/libs/xapi-inventory/.gitignore | 7 - ocaml/libs/xapi-inventory/ChangeLog | 36 - ocaml/libs/xapi-inventory/LICENSE | 521 --------- ocaml/libs/xapi-inventory/README.md | 4 - ocaml/libs/xapi-inventory/lib/dune | 12 - ocaml/libs/xapi-inventory/lib/inventory.ml | 147 --- ocaml/libs/xapi-rrd/.gitignore | 3 - ocaml/libs/xapi-rrd/ChangeLog | 115 -- ocaml/libs/xapi-rrd/LICENSE | 521 --------- ocaml/libs/xapi-rrd/README.md | 1 - ocaml/libs/xapi-rrd/lib/dune | 14 - ocaml/libs/xapi-rrd/lib/rrd.ml | 1002 ----------------- ocaml/libs/xapi-rrd/lib/rrd_fring.ml | 98 -- ocaml/libs/xapi-rrd/lib/rrd_fring.mli | 54 - ocaml/libs/xapi-rrd/lib/rrd_timescales.ml | 37 - ocaml/libs/xapi-rrd/lib/rrd_timescales.mli | 35 - ocaml/libs/xapi-rrd/lib/rrd_updates.ml | 311 ----- ocaml/libs/xapi-rrd/lib/rrd_utils.ml | 139 --- ocaml/libs/xapi-rrd/lib_test/crowbar_tests.ml | 102 -- ocaml/libs/xapi-rrd/lib_test/dune | 23 - .../xapi-rrd/lib_test/test_data/flip_flop.xml | 2 - ocaml/libs/xapi-rrd/lib_test/unit_tests.ml | 381 ------- ocaml/libs/xapi-rrd/unix/dune | 12 - ocaml/libs/xapi-rrd/unix/rrd_unix.ml | 41 - ocaml/libs/xapi-rrd/unix/rrd_unix.mli | 19 - ocaml/libs/xapi-stdext/.gitignore | 3 - ocaml/libs/xapi-stdext/CHANGES.md | 149 --- ocaml/libs/xapi-stdext/LICENSE | 521 --------- ocaml/libs/xapi-stdext/README.md | 11 - .../xapi-stdext/lib/xapi-stdext-date/date.ml | 189 ---- .../xapi-stdext/lib/xapi-stdext-date/date.mli | 105 -- .../xapi-stdext/lib/xapi-stdext-date/dune | 16 - .../xapi-stdext/lib/xapi-stdext-date/test.ml | 135 --- .../bench/bechamel_simple_cli.ml | 56 - .../bench/bench_encodings.ml | 15 - .../lib/xapi-stdext-encodings/bench/dune | 6 - .../lib/xapi-stdext-encodings/dune | 12 - .../lib/xapi-stdext-encodings/encodings.ml | 167 --- .../lib/xapi-stdext-encodings/encodings.mli | 84 -- .../lib/xapi-stdext-encodings/test.ml | 607 ---------- .../lib/xapi-stdext-pervasives/dune | 7 - .../xapi-stdext-pervasives/pervasiveext.ml | 69 -- .../xapi-stdext-pervasives/pervasiveext.mli | 31 - .../libs/xapi-stdext/lib/xapi-stdext-std/dune | 11 - .../lib/xapi-stdext-std/listext.ml | 203 ---- .../lib/xapi-stdext-std/listext.mli | 173 --- .../lib/xapi-stdext-std/listext_test.ml | 240 ---- .../lib/xapi-stdext-std/xstringext.ml | 223 ---- .../lib/xapi-stdext-std/xstringext.mli | 88 -- .../lib/xapi-stdext-std/xstringext_test.ml | 197 ---- .../xapi-stdext/lib/xapi-stdext-threads/dune | 8 - .../lib/xapi-stdext-threads/semaphore.ml | 57 - .../lib/xapi-stdext-threads/semaphore.mli | 40 - .../lib/xapi-stdext-threads/threadext.ml | 113 -- .../lib/xapi-stdext-threads/threadext.mli | 35 - .../lib/xapi-stdext-unix/blkgetsize.h | 6 - .../lib/xapi-stdext-unix/blkgetsize_stubs.c | 78 -- .../xapi-stdext/lib/xapi-stdext-unix/dune | 16 - .../lib/xapi-stdext-unix/unixext.ml | 819 -------------- .../lib/xapi-stdext-unix/unixext.mli | 276 ----- .../lib/xapi-stdext-unix/unixext_open_stubs.c | 75 -- .../lib/xapi-stdext-unix/unixext_stubs.c | 172 --- .../xapi-stdext-unix/unixext_write_stubs.c | 65 -- .../lib/xapi-stdext-zerocheck/dune | 5 - .../lib/xapi-stdext-zerocheck/zerocheck.ml | 14 - .../lib/xapi-stdext-zerocheck/zerocheck.mli | 16 - .../xapi-stdext-zerocheck/zerocheck_stub.c | 41 - ocaml/message-switch/.ocamlformat | 8 + ocaml/xapi-idl/.gitarchive-info | 2 + ocaml/xapi-idl/.gitattributes | 1 + ocaml/xapi-idl/.github/workflows/ocaml-ci.yml | 40 + ocaml/xapi-idl/.ocamlformat | 8 + quality-gate.sh | 6 +- xapi-inventory.opam | 30 - xapi-inventory.opam.template | 28 - xapi-rrd.opam | 37 - xapi-rrd.opam.template | 35 - xapi-stdext-date.opam | 32 - xapi-stdext-encodings.opam | 33 - xapi-stdext-encodings.opam.template | 1 - xapi-stdext-pervasives.opam | 30 - xapi-stdext-std.opam | 29 - xapi-stdext-threads.opam | 31 - xapi-stdext-unix.opam | 34 - xapi-stdext-unix.opam.template | 2 - xapi-stdext-zerocheck.opam | 28 - xapi-stdext.opam | 34 - 91 files changed, 73 insertions(+), 9289 deletions(-) create mode 100644 ocaml/forkexecd/.ocamlformat delete mode 100644 ocaml/libs/xapi-inventory/.gitignore delete mode 100644 ocaml/libs/xapi-inventory/ChangeLog delete mode 100644 ocaml/libs/xapi-inventory/LICENSE delete mode 100644 ocaml/libs/xapi-inventory/README.md delete mode 100644 ocaml/libs/xapi-inventory/lib/dune delete mode 100644 ocaml/libs/xapi-inventory/lib/inventory.ml delete mode 100644 ocaml/libs/xapi-rrd/.gitignore delete mode 100644 ocaml/libs/xapi-rrd/ChangeLog delete mode 100644 ocaml/libs/xapi-rrd/LICENSE delete mode 100644 ocaml/libs/xapi-rrd/README.md delete mode 100644 ocaml/libs/xapi-rrd/lib/dune delete mode 100644 ocaml/libs/xapi-rrd/lib/rrd.ml delete mode 100644 ocaml/libs/xapi-rrd/lib/rrd_fring.ml delete mode 100644 ocaml/libs/xapi-rrd/lib/rrd_fring.mli delete mode 100644 ocaml/libs/xapi-rrd/lib/rrd_timescales.ml delete mode 100644 ocaml/libs/xapi-rrd/lib/rrd_timescales.mli delete mode 100644 ocaml/libs/xapi-rrd/lib/rrd_updates.ml delete mode 100644 ocaml/libs/xapi-rrd/lib/rrd_utils.ml delete mode 100644 ocaml/libs/xapi-rrd/lib_test/crowbar_tests.ml delete mode 100644 ocaml/libs/xapi-rrd/lib_test/dune delete mode 100644 ocaml/libs/xapi-rrd/lib_test/test_data/flip_flop.xml delete mode 100644 ocaml/libs/xapi-rrd/lib_test/unit_tests.ml delete mode 100644 ocaml/libs/xapi-rrd/unix/dune delete mode 100644 ocaml/libs/xapi-rrd/unix/rrd_unix.ml delete mode 100644 ocaml/libs/xapi-rrd/unix/rrd_unix.mli delete mode 100644 ocaml/libs/xapi-stdext/.gitignore delete mode 100644 ocaml/libs/xapi-stdext/CHANGES.md delete mode 100644 ocaml/libs/xapi-stdext/LICENSE delete mode 100644 ocaml/libs/xapi-stdext/README.md delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.mli delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-date/dune delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-date/test.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/bechamel_simple_cli.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/bench_encodings.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/dune delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/dune delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.mli delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/test.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/dune delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.mli delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-std/dune delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.mli delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext_test.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext_test.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/dune delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/semaphore.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/semaphore.mli delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/threadext.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/threadext.mli delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/blkgetsize.h delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/blkgetsize_stubs.c delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/dune delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_open_stubs.c delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_stubs.c delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_write_stubs.c delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/dune delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.ml delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.mli delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck_stub.c create mode 100644 ocaml/message-switch/.ocamlformat create mode 100644 ocaml/xapi-idl/.gitarchive-info create mode 100644 ocaml/xapi-idl/.gitattributes create mode 100644 ocaml/xapi-idl/.github/workflows/ocaml-ci.yml create mode 100644 ocaml/xapi-idl/.ocamlformat delete mode 100644 xapi-inventory.opam delete mode 100644 xapi-inventory.opam.template delete mode 100644 xapi-rrd.opam delete mode 100644 xapi-rrd.opam.template delete mode 100644 xapi-stdext-date.opam delete mode 100644 xapi-stdext-encodings.opam delete mode 100644 xapi-stdext-encodings.opam.template delete mode 100644 xapi-stdext-pervasives.opam delete mode 100644 xapi-stdext-std.opam delete mode 100644 xapi-stdext-threads.opam delete mode 100644 xapi-stdext-unix.opam delete mode 100644 xapi-stdext-unix.opam.template delete mode 100644 xapi-stdext-zerocheck.opam delete mode 100644 xapi-stdext.opam diff --git a/.github/workflows/format.yml b/.github/workflows/format.yml index b15173805cf..94bda1e5a0b 100644 --- a/.github/workflows/format.yml +++ b/.github/workflows/format.yml @@ -35,7 +35,6 @@ jobs: xs-opam: ${{ steps.dotenv.outputs.repository }} dune-cache: true opam-pin: false - opam-depext: false - name: Install ocamlformat run: opam install ocamlformat diff --git a/Makefile b/Makefile index f30a39513df..7c65b089dff 100644 --- a/Makefile +++ b/Makefile @@ -241,9 +241,7 @@ install: build doc sdk doc-json gzip http-lib pciutil sexpr stunnel uuid xml-light2 zstd xapi-compression safe-resources \ message-switch message-switch-async message-switch-cli message-switch-core message-switch-lwt \ message-switch-unix xapi-idl forkexec xapi-forkexecd xapi-storage xapi-storage-script xapi-storage-cli \ - xapi-nbd varstored-guard xapi-log xapi-open-uri xapi-tracing xapi-expiry-alerts cohttp-posix \ - xapi-rrd xapi-inventory \ - xapi-stdext-date xapi-stdext-encodings xapi-stdext-pervasives xapi-stdext-std xapi-stdext-threads xapi-stdext-unix xapi-stdext-zerocheck xapi-stdext + xapi-nbd varstored-guard xapi-log xapi-open-uri xapi-tracing xapi-expiry-alerts cohttp-posix # docs mkdir -p $(DESTDIR)$(DOCDIR) cp -r $(XAPIDOC)/jekyll $(DESTDIR)$(DOCDIR) @@ -263,9 +261,7 @@ uninstall: gzip http-lib pciutil sexpr stunnel uuid xml-light2 zstd xapi-compression safe-resources \ message-switch message-switch-async message-switch-cli message-switch-core message-switch-lwt \ message-switch-unix xapi-idl forkexec xapi-forkexecd xapi-storage xapi-storage-script xapi-log \ - xapi-open-uri xapi-tracing xapi-expiry-alerts cohttp-posix \ - xapi-rrd xapi-inventory \ - xapi-stdext-date xapi-stdext-encodings xapi-stdext-pervasives xapi-stdext-std xapi-stdext-threads xapi-stdext-unix xapi-stdext-zerocheck xapi-stdext + xapi-open-uri xapi-tracing xapi-expiry-alerts cohttp-posix compile_flags.txt: Makefile (ocamlc -config-var ocamlc_cflags;\ diff --git a/dune-project b/dune-project index 747fc62b133..1d7c53c0480 100644 --- a/dune-project +++ b/dune-project @@ -253,107 +253,3 @@ (package (name cohttp-posix) ) - -(package - (name xapi-rrd) -) - -(package - (name xapi-inventory) -) - -(package - (name xapi-stdext) - (synopsis "Xapi's standard library extension") - (description "Dummy package that enables the usage of dune-release") - (depends - (xapi-stdext-date (= :version)) - (xapi-stdext-encodings (= :version)) - (xapi-stdext-pervasives (= :version)) - (xapi-stdext-std (= :version)) - (xapi-stdext-threads (= :version)) - (xapi-stdext-unix (= :version)) - (xapi-stdext-zerocheck (= :version)) - ) -) - -(package - (name xapi-stdext-date) - (synopsis "Xapi's standard library extension, Dates") - (depends - (ocaml (>= 4.12)) - (alcotest :with-test) - astring - base-unix - ptime - (odoc :with-doc) - ) -) - -(package - (name xapi-stdext-encodings) - (synopsis "Xapi's standard library extension, Encodings") - (depends - (ocaml (>= 4.13.0)) - (alcotest (and (>= 0.6.0) :with-test)) - (odoc :with-doc) - (bechamel :with-test) - (bechamel-notty :with-test) - (notty :with-test) - ) -) - -(package - (name xapi-stdext-pervasives) - (synopsis "Xapi's standard library extension, Pervasives") - (depends - (ocaml (>= 4.08)) - logs - (odoc :with-doc) - xapi-backtrace - ) -) - -(package - (name xapi-stdext-std) - (synopsis "Xapi's standard library extension, Stdlib") - (depends - (ocaml (>= 4.08.0)) - (alcotest :with-test) - (odoc :with-doc) - ) -) - -(package - (name xapi-stdext-threads) - (synopsis "Xapi's standard library extension, Threads") - (depends - ocaml - base-threads - base-unix - (odoc :with-doc) - (xapi-stdext-pervasives (= :version)) - ) -) - -(package - (name xapi-stdext-unix) - (synopsis "Xapi's standard library extension, Unix") - (depends - (ocaml (>= 4.12.0)) - base-unix - (fd-send-recv (>= 2.0.0)) - (odoc :with-doc) - xapi-backtrace - (xapi-stdext-pervasives (= :version)) - ) -) - -(package - (name xapi-stdext-zerocheck) - (synopsis "Xapi's standard library extension, Zerocheck") - (depends - ocaml - (odoc :with-doc) - ) -) diff --git a/ocaml/forkexecd/.ocamlformat b/ocaml/forkexecd/.ocamlformat new file mode 100644 index 00000000000..f86522707f6 --- /dev/null +++ b/ocaml/forkexecd/.ocamlformat @@ -0,0 +1,9 @@ +profile=ocamlformat +indicate-multiline-delimiters=closing-on-separate-line +if-then-else=fit-or-vertical +dock-collection-brackets=true +break-struct=natural +break-separators=before +break-infix=fit-or-vertical +break-infix-before-func=false +sequence-blank-line=preserve-one diff --git a/ocaml/libs/xapi-inventory/.gitignore b/ocaml/libs/xapi-inventory/.gitignore deleted file mode 100644 index a2da242d6a4..00000000000 --- a/ocaml/libs/xapi-inventory/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ -_build/ -*.install -.merlin - -*.orig -*.rej -xcp_inventory_config.ml diff --git a/ocaml/libs/xapi-inventory/ChangeLog b/ocaml/libs/xapi-inventory/ChangeLog deleted file mode 100644 index 1a57fb351d8..00000000000 --- a/ocaml/libs/xapi-inventory/ChangeLog +++ /dev/null @@ -1,36 +0,0 @@ -## v1.2.3 (17 Jun 2022): -* maintenance: Decrease direct usages of Threadext -* Add license to opam metadata - -## v1.2.2 (28 Jul 2021): -* maintenance: clean up opam metadata -* maintenance: change default filename to /etc/xensource-inventory -* maintenance: use dune instead of jbuilder -* maintenance: fix travis - -## v1.2.1 (3 Dec 2018): -- Removed conflict between xcp-inventory and xapi-inventory. -- Ported build to dune and deprecated the old package xcp-inventory. - -## v1.2.0 (9 Jan 2018): -* inventory: preserve old ~limit:2 semantic - -## v1.1.0 (14 Dec 2017): -* Reindentation and file mode change. -* Replace xapi-stdext with xapi-stdext-subpackages and astring. -* CA-276606: Ported build from _oasis to jbuilder. -* Sync opam file with xs-opam - -## v1.0.2 (03 Febr 2017): -* fix Makfile to make installation via Opam work -* add Git meta data files .gitarchive-info and .gitattributes - -## v1.0.1 (22 Jun 2016): -* Update to Stdext 2.0.0 - -## v0.9.1 (3 Jun 2014): -* second public release -* Update to cohttp-0.11.2 interface - -## v0.9.0 (5 Jun 2013): -* first public release diff --git a/ocaml/libs/xapi-inventory/LICENSE b/ocaml/libs/xapi-inventory/LICENSE deleted file mode 100644 index 1b1ce97cb5c..00000000000 --- a/ocaml/libs/xapi-inventory/LICENSE +++ /dev/null @@ -1,521 +0,0 @@ -This repository is distributed under the terms of the GNU Lesser General -Public License version 2.1 (included below). - -As a special exception to the GNU Lesser General Public License, you -may link, statically or dynamically, a "work that uses the Library" -with a publicly distributed version of the Library to produce an -executable file containing portions of the Library, and distribute -that executable file under terms of your choice, without any of the -additional requirements listed in clause 6 of the GNU Lesser General -Public License. By "a publicly distributed version of the Library", -we mean either the unmodified Library as distributed, or a -modified version of the Library that is distributed under the -conditions defined in clause 3 of the GNU Library General Public -License. This exception does not however invalidate any other reasons -why the executable file might be covered by the GNU Lesser General -Public License. - ------------- - - GNU LESSER GENERAL PUBLIC LICENSE - Version 2.1, February 1999 - - Copyright (C) 1991, 1999 Free Software Foundation, Inc. - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -[This is the first released version of the Lesser GPL. It also counts - as the successor of the GNU Library Public License, version 2, hence - the version number 2.1.] - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -Licenses are intended to guarantee your freedom to share and change -free software--to make sure the software is free for all its users. - - This license, the Lesser General Public License, applies to some -specially designated software packages--typically libraries--of the -Free Software Foundation and other authors who decide to use it. You -can use it too, but we suggest you first think carefully about whether -this license or the ordinary General Public License is the better -strategy to use in any particular case, based on the explanations below. - - When we speak of free software, we are referring to freedom of use, -not price. Our General Public Licenses are designed to make sure that -you have the freedom to distribute copies of free software (and charge -for this service if you wish); that you receive source code or can get -it if you want it; that you can change the software and use pieces of -it in new free programs; and that you are informed that you can do -these things. - - To protect your rights, we need to make restrictions that forbid -distributors to deny you these rights or to ask you to surrender these -rights. These restrictions translate to certain responsibilities for -you if you distribute copies of the library or if you modify it. - - For example, if you distribute copies of the library, whether gratis -or for a fee, you must give the recipients all the rights that we gave -you. You must make sure that they, too, receive or can get the source -code. If you link other code with the library, you must provide -complete object files to the recipients, so that they can relink them -with the library after making changes to the library and recompiling -it. And you must show them these terms so they know their rights. - - We protect your rights with a two-step method: (1) we copyright the -library, and (2) we offer you this license, which gives you legal -permission to copy, distribute and/or modify the library. - - To protect each distributor, we want to make it very clear that -there is no warranty for the free library. Also, if the library is -modified by someone else and passed on, the recipients should know -that what they have is not the original version, so that the original -author's reputation will not be affected by problems that might be -introduced by others. - - Finally, software patents pose a constant threat to the existence of -any free program. We wish to make sure that a company cannot -effectively restrict the users of a free program by obtaining a -restrictive license from a patent holder. Therefore, we insist that -any patent license obtained for a version of the library must be -consistent with the full freedom of use specified in this license. - - Most GNU software, including some libraries, is covered by the -ordinary GNU General Public License. This license, the GNU Lesser -General Public License, applies to certain designated libraries, and -is quite different from the ordinary General Public License. We use -this license for certain libraries in order to permit linking those -libraries into non-free programs. - - When a program is linked with a library, whether statically or using -a shared library, the combination of the two is legally speaking a -combined work, a derivative of the original library. The ordinary -General Public License therefore permits such linking only if the -entire combination fits its criteria of freedom. The Lesser General -Public License permits more lax criteria for linking other code with -the library. - - We call this license the "Lesser" General Public License because it -does Less to protect the user's freedom than the ordinary General -Public License. It also provides other free software developers Less -of an advantage over competing non-free programs. These disadvantages -are the reason we use the ordinary General Public License for many -libraries. However, the Lesser license provides advantages in certain -special circumstances. - - For example, on rare occasions, there may be a special need to -encourage the widest possible use of a certain library, so that it becomes -a de-facto standard. To achieve this, non-free programs must be -allowed to use the library. A more frequent case is that a free -library does the same job as widely used non-free libraries. In this -case, there is little to gain by limiting the free library to free -software only, so we use the Lesser General Public License. - - In other cases, permission to use a particular library in non-free -programs enables a greater number of people to use a large body of -free software. For example, permission to use the GNU C Library in -non-free programs enables many more people to use the whole GNU -operating system, as well as its variant, the GNU/Linux operating -system. - - Although the Lesser General Public License is Less protective of the -users' freedom, it does ensure that the user of a program that is -linked with the Library has the freedom and the wherewithal to run -that program using a modified version of the Library. - - The precise terms and conditions for copying, distribution and -modification follow. Pay close attention to the difference between a -"work based on the library" and a "work that uses the library". The -former contains code derived from the library, whereas the latter must -be combined with the library in order to run. - - GNU LESSER GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License Agreement applies to any software library or other -program which contains a notice placed by the copyright holder or -other authorized party saying it may be distributed under the terms of -this Lesser General Public License (also called "this License"). -Each licensee is addressed as "you". - - A "library" means a collection of software functions and/or data -prepared so as to be conveniently linked with application programs -(which use some of those functions and data) to form executables. - - The "Library", below, refers to any such software library or work -which has been distributed under these terms. A "work based on the -Library" means either the Library or any derivative work under -copyright law: that is to say, a work containing the Library or a -portion of it, either verbatim or with modifications and/or translated -straightforwardly into another language. (Hereinafter, translation is -included without limitation in the term "modification".) - - "Source code" for a work means the preferred form of the work for -making modifications to it. For a library, complete source code means -all the source code for all modules it contains, plus any associated -interface definition files, plus the scripts used to control compilation -and installation of the library. - - Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running a program using the Library is not restricted, and output from -such a program is covered only if its contents constitute a work based -on the Library (independent of the use of the Library in a tool for -writing it). Whether that is true depends on what the Library does -and what the program that uses the Library does. - - 1. You may copy and distribute verbatim copies of the Library's -complete source code as you receive it, in any medium, provided that -you conspicuously and appropriately publish on each copy an -appropriate copyright notice and disclaimer of warranty; keep intact -all the notices that refer to this License and to the absence of any -warranty; and distribute a copy of this License along with the -Library. - - You may charge a fee for the physical act of transferring a copy, -and you may at your option offer warranty protection in exchange for a -fee. - - 2. You may modify your copy or copies of the Library or any portion -of it, thus forming a work based on the Library, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) The modified work must itself be a software library. - - b) You must cause the files modified to carry prominent notices - stating that you changed the files and the date of any change. - - c) You must cause the whole of the work to be licensed at no - charge to all third parties under the terms of this License. - - d) If a facility in the modified Library refers to a function or a - table of data to be supplied by an application program that uses - the facility, other than as an argument passed when the facility - is invoked, then you must make a good faith effort to ensure that, - in the event an application does not supply such function or - table, the facility still operates, and performs whatever part of - its purpose remains meaningful. - - (For example, a function in a library to compute square roots has - a purpose that is entirely well-defined independent of the - application. Therefore, Subsection 2d requires that any - application-supplied function or table used by this function must - be optional: if the application does not supply it, the square - root function must still compute square roots.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Library, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Library, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote -it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Library. - -In addition, mere aggregation of another work not based on the Library -with the Library (or with a work based on the Library) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may opt to apply the terms of the ordinary GNU General Public -License instead of this License to a given copy of the Library. To do -this, you must alter all the notices that refer to this License, so -that they refer to the ordinary GNU General Public License, version 2, -instead of to this License. (If a newer version than version 2 of the -ordinary GNU General Public License has appeared, then you can specify -that version instead if you wish.) Do not make any other change in -these notices. - - Once this change is made in a given copy, it is irreversible for -that copy, so the ordinary GNU General Public License applies to all -subsequent copies and derivative works made from that copy. - - This option is useful when you wish to copy part of the code of -the Library into a program that is not a library. - - 4. You may copy and distribute the Library (or a portion or -derivative of it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you accompany -it with the complete corresponding machine-readable source code, which -must be distributed under the terms of Sections 1 and 2 above on a -medium customarily used for software interchange. - - If distribution of object code is made by offering access to copy -from a designated place, then offering equivalent access to copy the -source code from the same place satisfies the requirement to -distribute the source code, even though third parties are not -compelled to copy the source along with the object code. - - 5. A program that contains no derivative of any portion of the -Library, but is designed to work with the Library by being compiled or -linked with it, is called a "work that uses the Library". Such a -work, in isolation, is not a derivative work of the Library, and -therefore falls outside the scope of this License. - - However, linking a "work that uses the Library" with the Library -creates an executable that is a derivative of the Library (because it -contains portions of the Library), rather than a "work that uses the -library". The executable is therefore covered by this License. -Section 6 states terms for distribution of such executables. - - When a "work that uses the Library" uses material from a header file -that is part of the Library, the object code for the work may be a -derivative work of the Library even though the source code is not. -Whether this is true is especially significant if the work can be -linked without the Library, or if the work is itself a library. The -threshold for this to be true is not precisely defined by law. - - If such an object file uses only numerical parameters, data -structure layouts and accessors, and small macros and small inline -functions (ten lines or less in length), then the use of the object -file is unrestricted, regardless of whether it is legally a derivative -work. (Executables containing this object code plus portions of the -Library will still fall under Section 6.) - - Otherwise, if the work is a derivative of the Library, you may -distribute the object code for the work under the terms of Section 6. -Any executables containing that work also fall under Section 6, -whether or not they are linked directly with the Library itself. - - 6. As an exception to the Sections above, you may also combine or -link a "work that uses the Library" with the Library to produce a -work containing portions of the Library, and distribute that work -under terms of your choice, provided that the terms permit -modification of the work for the customer's own use and reverse -engineering for debugging such modifications. - - You must give prominent notice with each copy of the work that the -Library is used in it and that the Library and its use are covered by -this License. You must supply a copy of this License. If the work -during execution displays copyright notices, you must include the -copyright notice for the Library among them, as well as a reference -directing the user to the copy of this License. Also, you must do one -of these things: - - a) Accompany the work with the complete corresponding - machine-readable source code for the Library including whatever - changes were used in the work (which must be distributed under - Sections 1 and 2 above); and, if the work is an executable linked - with the Library, with the complete machine-readable "work that - uses the Library", as object code and/or source code, so that the - user can modify the Library and then relink to produce a modified - executable containing the modified Library. (It is understood - that the user who changes the contents of definitions files in the - Library will not necessarily be able to recompile the application - to use the modified definitions.) - - b) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (1) uses at run time a - copy of the library already present on the user's computer system, - rather than copying library functions into the executable, and (2) - will operate properly with a modified version of the library, if - the user installs one, as long as the modified version is - interface-compatible with the version that the work was made with. - - c) Accompany the work with a written offer, valid for at - least three years, to give the same user the materials - specified in Subsection 6a, above, for a charge no more - than the cost of performing this distribution. - - d) If distribution of the work is made by offering access to copy - from a designated place, offer equivalent access to copy the above - specified materials from the same place. - - e) Verify that the user has already received a copy of these - materials or that you have already sent this user a copy. - - For an executable, the required form of the "work that uses the -Library" must include any data and utility programs needed for -reproducing the executable from it. However, as a special exception, -the materials to be distributed need not include anything that is -normally distributed (in either source or binary form) with the major -components (compiler, kernel, and so on) of the operating system on -which the executable runs, unless that component itself accompanies -the executable. - - It may happen that this requirement contradicts the license -restrictions of other proprietary libraries that do not normally -accompany the operating system. Such a contradiction means you cannot -use both them and the Library together in an executable that you -distribute. - - 7. You may place library facilities that are a work based on the -Library side-by-side in a single library together with other library -facilities not covered by this License, and distribute such a combined -library, provided that the separate distribution of the work based on -the Library and of the other library facilities is otherwise -permitted, and provided that you do these two things: - - a) Accompany the combined library with a copy of the same work - based on the Library, uncombined with any other library - facilities. This must be distributed under the terms of the - Sections above. - - b) Give prominent notice with the combined library of the fact - that part of it is a work based on the Library, and explaining - where to find the accompanying uncombined form of the same work. - - 8. You may not copy, modify, sublicense, link with, or distribute -the Library except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense, link with, or -distribute the Library is void, and will automatically terminate your -rights under this License. However, parties who have received copies, -or rights, from you under this License will not have their licenses -terminated so long as such parties remain in full compliance. - - 9. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Library or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Library (or any work based on the -Library), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Library or works based on it. - - 10. Each time you redistribute the Library (or any work based on the -Library), the recipient automatically receives a license from the -original licensor to copy, distribute, link with or modify the Library -subject to these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties with -this License. - - 11. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Library at all. For example, if a patent -license would not permit royalty-free redistribution of the Library by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Library. - -If any portion of this section is held invalid or unenforceable under any -particular circumstance, the balance of the section is intended to apply, -and the section as a whole is intended to apply in other circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 12. If the distribution and/or use of the Library is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Library under this License may add -an explicit geographical distribution limitation excluding those countries, -so that distribution is permitted only in or among countries not thus -excluded. In such case, this License incorporates the limitation as if -written in the body of this License. - - 13. The Free Software Foundation may publish revised and/or new -versions of the Lesser General Public License from time to time. -Such new versions will be similar in spirit to the present version, -but may differ in detail to address new problems or concerns. - -Each version is given a distinguishing version number. If the Library -specifies a version number of this License which applies to it and -"any later version", you have the option of following the terms and -conditions either of that version or of any later version published by -the Free Software Foundation. If the Library does not specify a -license version number, you may choose any version ever published by -the Free Software Foundation. - - 14. If you wish to incorporate parts of the Library into other free -programs whose distribution conditions are incompatible with these, -write to the author to ask for permission. For software which is -copyrighted by the Free Software Foundation, write to the Free -Software Foundation; we sometimes make exceptions for this. Our -decision will be guided by the two goals of preserving the free status -of all derivatives of our free software and of promoting the sharing -and reuse of software generally. - - NO WARRANTY - - 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO -WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. -EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR -OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY -KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE -LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME -THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN -WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY -AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU -FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR -CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE -LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING -RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A -FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Libraries - - If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms of the -ordinary General Public License). - - To apply these terms, attach the following notices to the library. It is -safest to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - 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.1 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 - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the library, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James Random Hacker. - - , 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! diff --git a/ocaml/libs/xapi-inventory/README.md b/ocaml/libs/xapi-inventory/README.md deleted file mode 100644 index 18b4f596890..00000000000 --- a/ocaml/libs/xapi-inventory/README.md +++ /dev/null @@ -1,4 +0,0 @@ -# The XCP inventory library - -Maintains a database of key-value pairs at a specific location in the -filesystem. diff --git a/ocaml/libs/xapi-inventory/lib/dune b/ocaml/libs/xapi-inventory/lib/dune deleted file mode 100644 index 7fb4aa7e40b..00000000000 --- a/ocaml/libs/xapi-inventory/lib/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name inventory) - (public_name xapi-inventory) - (wrapped false) - (libraries - uuidm - astring - xapi-stdext-unix - xapi-stdext-threads - threads - ) -) diff --git a/ocaml/libs/xapi-inventory/lib/inventory.ml b/ocaml/libs/xapi-inventory/lib/inventory.ml deleted file mode 100644 index 374780a09f8..00000000000 --- a/ocaml/libs/xapi-inventory/lib/inventory.ml +++ /dev/null @@ -1,147 +0,0 @@ -(* - * Copyright (C) 2006-2010 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -(* Code to parse the XenSource inventory file *) - -open Xapi_stdext_unix -module M = Xapi_stdext_threads.Threadext.Mutex - -let inventory_filename = ref "/etc/xensource-inventory" - -(* Keys which must exist: *) -let _installation_uuid = "INSTALLATION_UUID" - -let _control_domain_uuid = "CONTROL_DOMAIN_UUID" - -let _management_interface = "MANAGEMENT_INTERFACE" - -let _management_address_type = "MANAGEMENT_ADDRESS_TYPE" - -let _build_number = "BUILD_NUMBER" - -(* Optional keys: *) -let _current_interfaces = "CURRENT_INTERFACES" - -let _oem_manufacturer = "OEM_MANUFACTURER" - -let _oem_model = "OEM_MODEL" - -let _oem_build_number = "OEM_BUILD_NUMBER" - -let _machine_serial_number = "MACHINE_SERIAL_NUMBER" - -let _machine_serial_name = "MACHINE_SERIAL_NAME" - -let _stunnel_idle_timeout = "STUNNEL_IDLE_TIMEOUT" - -let _stunnel_legacy = "STUNNEL_LEGACY" - -let loaded_inventory = ref false - -let inventory = Hashtbl.create 10 - -let inventory_m = Mutex.create () - -(* Compute the minimum necessary inventory file contents *) -let minimum_default_entries () = - let host_uuid = Uuidm.to_string (Uuidm.v `V4) in - let dom0_uuid = Uuidm.to_string (Uuidm.v `V4) in - [ - (_installation_uuid, host_uuid) - ; (_control_domain_uuid, dom0_uuid) - ; (_management_interface, "") - ; (_management_address_type, "IPv4") - ; (_build_number, "0") - ] - -(* trim any quotes off the ends *) -let strip_quotes v = - if String.length v >= 2 && v.[0] = '\'' && v.[String.length v - 1] = '\'' then - String.sub v 1 (String.length v - 2) - else - v - -let parse_inventory_entry line = - match Astring.String.cut ~sep:"=" line with - | Some (k, v) -> - (* trim whitespace *) - Some (k, v |> strip_quotes |> String.trim) - | None -> - None - -let string_of_table h = - let lines = - List.fold_left - (fun acc (k, v) -> Printf.sprintf "%s='%s'\n" k v :: acc) - [] h - in - String.concat "" lines - -let read_inventory_contents () = - if not (Sys.file_exists !inventory_filename) then - Unixext.write_string_to_file !inventory_filename - (string_of_table (minimum_default_entries ())) ; - (* Perhaps we should blank the old inventory before we read the new one? - What is the desired behaviour? *) - Unixext.file_lines_iter - (fun line -> - match parse_inventory_entry line with - | Some (k, v) -> - Hashtbl.add inventory k v - | None -> - () - ) - !inventory_filename ; - loaded_inventory := true - -let read_inventory () = M.execute inventory_m read_inventory_contents - -let reread_inventory () = - M.execute inventory_m (fun () -> - Hashtbl.clear inventory ; read_inventory_contents () - ) - -exception Missing_inventory_key of string - -let lookup ?default key = - M.execute inventory_m (fun () -> - if not !loaded_inventory then read_inventory_contents () ; - if Hashtbl.mem inventory key then - Hashtbl.find inventory key - else - match default with - | None -> - raise (Missing_inventory_key key) - | Some v -> - v - ) - -let flush_to_disk_locked () = - let h = Hashtbl.fold (fun k v acc -> (k, v) :: acc) inventory [] in - Unixext.write_string_to_file !inventory_filename (string_of_table h) - -let update key value = - M.execute inventory_m (fun () -> - Hashtbl.clear inventory ; - read_inventory_contents () ; - Hashtbl.replace inventory key value ; - flush_to_disk_locked () - ) - -let remove key = - M.execute inventory_m (fun () -> - Hashtbl.clear inventory ; - read_inventory_contents () ; - Hashtbl.remove inventory key ; - flush_to_disk_locked () - ) diff --git a/ocaml/libs/xapi-rrd/.gitignore b/ocaml/libs/xapi-rrd/.gitignore deleted file mode 100644 index 3fce47935b6..00000000000 --- a/ocaml/libs/xapi-rrd/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -_build -.merlin -*.install diff --git a/ocaml/libs/xapi-rrd/ChangeLog b/ocaml/libs/xapi-rrd/ChangeLog deleted file mode 100644 index 0606ae6dd3a..00000000000 --- a/ocaml/libs/xapi-rrd/ChangeLog +++ /dev/null @@ -1,115 +0,0 @@ -## v1.12.0 (11-Dec-2023) -* lib: fix typo in ds field minimal_heartbeat - -## v1.11.0 (16-Nov-2023) -* lib: remove Failure "hd" exceptions - -## v1.10.0 (02-Aug-2023) -* rrd_updates: use yojson instead of ad-hoc json serialization - -## v1.9.2 (13-Jun-2023) -* CA-378301: Avoid memory leaks when writing XML - -## v1.9.1 (28-Oct-2022) -* CA-371780: Remove quadratic cost in ds_update_name - -## v1.9.0 (02-Aug-2022) -* ocamlformat: apply new formatting -* unix: remove code from module -* CA-367236: replace ezjsonm with yojson -* Add license to opam metadata and delete deprecated package -* ci: drop travis -* ci: use github -* maintenance: format code with ocamlformat -* chore: prepare for ocamlformat, use dune 2.0 - -## v1.8.2 (09-Sep-2020) -* maintenance(lib_test): refactor crowbar tests -* fix (lib_test): remove duplicated test suite - -## v1.8.1 (24-Mar-2020) -* CP-33354 fix inconsistent number of columns -* rrd: update documentation -* rrd: delete unused functions -* maintenance: whitespace -* rrd_updates: Do not expose Failure "hd" when exporting rrds -* rrd: share to_string methods among serializers -* rrd: cleanup around ds_values processing - -## v1.8.0 (31-Oct-2019) -CA-329813: fix including a datasource to an rrd -CA-329813: add regression tests -opam: refresh metadata - -## v1.7.0 (29-Oct-2019) -* CA-325844: Test RRAs are validated when deserializing -* CA-329043: Add sanity checks to rrds -* CA-329043: Use type system to avoid storing out-of-range values -* CA-329043: add case generated by crowbar -* unit_tests: compare min and max values once per ds -* dune: simplify test definition -* CA-329043: Add crowbar tests -* CA-329043: Do not produce default values that are out-of-bounds -* CA-329043: Add regression test -* tests: add json marshalling -* travis: load vars from xs-opam repo - -## v1.6.0 (29-Jul-2019) -* CA-322008: Report out-of-bounds PDP values as NaN -* maintenance: whitespace and commented code deletion -* maintenance: use infix operators for Int64 in rrd -* CA-322008: Reorganize code for incoming values by type -* CA-322008: do not treat DERIVE sources as COUNTER -* tests: add regression test for CA-322008 -* ci: update and simplify travis configuration -* tests: use random names for files -* tests: check that all values in RRas are within bounds -* tests: convert int and string asserts to alcotest -* tests: Consolidate floating-point comparisons -* tests: port to alcotest - -## v1.5.0 (17-May-2019) -* CA-315952 add missing data in Json output -* CA-315952 fix JSON output - -## v1.4.1 (08-Jan-2019) -* Deprecated package rrd in favour of xapi-rrd. -* Move from jbuilder to dune. - -## v1.4.0 (03-Sep-2018) -* Simplify PPX processing -* Use rpclib if it's available - -## v1.3.0 (15-Mar-2018): -* Make safe-string safe - -## v1.2.0 (28-Feb-2018): -* Added missing bigarray dependency in the jbuild file - -## v1.1.0 (06-Dec-2017): -* Updated dependencies -* Code cleanup -* Port to jbuilder - -## v1.0.1 (16-Jun-2017): -* Use new ppx deriver in place of old camlp4 one -* Fix deprecation warnings - -## v1.0.0 (27-Apr-2016): -* Declare this package stable - -## v0.12.0 (25-Jun-2015): -* rrd_updates: interpret a -ve start as relative to now -* add a concept of rrd_timescales - -## v0.10.1 (2-Apr-2015): -* remove dependency on xapi libraries -* remove Unix dependency - -## v0.9.1 (26-Sep-2014): -* CA-102285: Use the stream API to read the XML RRD file -* Fix 'make install' and 'make uninstall' (by making them PHONY targets) - -## v0.9.0 (6-Jun-2013): -* first public release - diff --git a/ocaml/libs/xapi-rrd/LICENSE b/ocaml/libs/xapi-rrd/LICENSE deleted file mode 100644 index 1b1ce97cb5c..00000000000 --- a/ocaml/libs/xapi-rrd/LICENSE +++ /dev/null @@ -1,521 +0,0 @@ -This repository is distributed under the terms of the GNU Lesser General -Public License version 2.1 (included below). - -As a special exception to the GNU Lesser General Public License, you -may link, statically or dynamically, a "work that uses the Library" -with a publicly distributed version of the Library to produce an -executable file containing portions of the Library, and distribute -that executable file under terms of your choice, without any of the -additional requirements listed in clause 6 of the GNU Lesser General -Public License. By "a publicly distributed version of the Library", -we mean either the unmodified Library as distributed, or a -modified version of the Library that is distributed under the -conditions defined in clause 3 of the GNU Library General Public -License. This exception does not however invalidate any other reasons -why the executable file might be covered by the GNU Lesser General -Public License. - ------------- - - GNU LESSER GENERAL PUBLIC LICENSE - Version 2.1, February 1999 - - Copyright (C) 1991, 1999 Free Software Foundation, Inc. - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -[This is the first released version of the Lesser GPL. It also counts - as the successor of the GNU Library Public License, version 2, hence - the version number 2.1.] - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -Licenses are intended to guarantee your freedom to share and change -free software--to make sure the software is free for all its users. - - This license, the Lesser General Public License, applies to some -specially designated software packages--typically libraries--of the -Free Software Foundation and other authors who decide to use it. You -can use it too, but we suggest you first think carefully about whether -this license or the ordinary General Public License is the better -strategy to use in any particular case, based on the explanations below. - - When we speak of free software, we are referring to freedom of use, -not price. Our General Public Licenses are designed to make sure that -you have the freedom to distribute copies of free software (and charge -for this service if you wish); that you receive source code or can get -it if you want it; that you can change the software and use pieces of -it in new free programs; and that you are informed that you can do -these things. - - To protect your rights, we need to make restrictions that forbid -distributors to deny you these rights or to ask you to surrender these -rights. These restrictions translate to certain responsibilities for -you if you distribute copies of the library or if you modify it. - - For example, if you distribute copies of the library, whether gratis -or for a fee, you must give the recipients all the rights that we gave -you. You must make sure that they, too, receive or can get the source -code. If you link other code with the library, you must provide -complete object files to the recipients, so that they can relink them -with the library after making changes to the library and recompiling -it. And you must show them these terms so they know their rights. - - We protect your rights with a two-step method: (1) we copyright the -library, and (2) we offer you this license, which gives you legal -permission to copy, distribute and/or modify the library. - - To protect each distributor, we want to make it very clear that -there is no warranty for the free library. Also, if the library is -modified by someone else and passed on, the recipients should know -that what they have is not the original version, so that the original -author's reputation will not be affected by problems that might be -introduced by others. - - Finally, software patents pose a constant threat to the existence of -any free program. We wish to make sure that a company cannot -effectively restrict the users of a free program by obtaining a -restrictive license from a patent holder. Therefore, we insist that -any patent license obtained for a version of the library must be -consistent with the full freedom of use specified in this license. - - Most GNU software, including some libraries, is covered by the -ordinary GNU General Public License. This license, the GNU Lesser -General Public License, applies to certain designated libraries, and -is quite different from the ordinary General Public License. We use -this license for certain libraries in order to permit linking those -libraries into non-free programs. - - When a program is linked with a library, whether statically or using -a shared library, the combination of the two is legally speaking a -combined work, a derivative of the original library. The ordinary -General Public License therefore permits such linking only if the -entire combination fits its criteria of freedom. The Lesser General -Public License permits more lax criteria for linking other code with -the library. - - We call this license the "Lesser" General Public License because it -does Less to protect the user's freedom than the ordinary General -Public License. It also provides other free software developers Less -of an advantage over competing non-free programs. These disadvantages -are the reason we use the ordinary General Public License for many -libraries. However, the Lesser license provides advantages in certain -special circumstances. - - For example, on rare occasions, there may be a special need to -encourage the widest possible use of a certain library, so that it becomes -a de-facto standard. To achieve this, non-free programs must be -allowed to use the library. A more frequent case is that a free -library does the same job as widely used non-free libraries. In this -case, there is little to gain by limiting the free library to free -software only, so we use the Lesser General Public License. - - In other cases, permission to use a particular library in non-free -programs enables a greater number of people to use a large body of -free software. For example, permission to use the GNU C Library in -non-free programs enables many more people to use the whole GNU -operating system, as well as its variant, the GNU/Linux operating -system. - - Although the Lesser General Public License is Less protective of the -users' freedom, it does ensure that the user of a program that is -linked with the Library has the freedom and the wherewithal to run -that program using a modified version of the Library. - - The precise terms and conditions for copying, distribution and -modification follow. Pay close attention to the difference between a -"work based on the library" and a "work that uses the library". The -former contains code derived from the library, whereas the latter must -be combined with the library in order to run. - - GNU LESSER GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License Agreement applies to any software library or other -program which contains a notice placed by the copyright holder or -other authorized party saying it may be distributed under the terms of -this Lesser General Public License (also called "this License"). -Each licensee is addressed as "you". - - A "library" means a collection of software functions and/or data -prepared so as to be conveniently linked with application programs -(which use some of those functions and data) to form executables. - - The "Library", below, refers to any such software library or work -which has been distributed under these terms. A "work based on the -Library" means either the Library or any derivative work under -copyright law: that is to say, a work containing the Library or a -portion of it, either verbatim or with modifications and/or translated -straightforwardly into another language. (Hereinafter, translation is -included without limitation in the term "modification".) - - "Source code" for a work means the preferred form of the work for -making modifications to it. For a library, complete source code means -all the source code for all modules it contains, plus any associated -interface definition files, plus the scripts used to control compilation -and installation of the library. - - Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running a program using the Library is not restricted, and output from -such a program is covered only if its contents constitute a work based -on the Library (independent of the use of the Library in a tool for -writing it). Whether that is true depends on what the Library does -and what the program that uses the Library does. - - 1. You may copy and distribute verbatim copies of the Library's -complete source code as you receive it, in any medium, provided that -you conspicuously and appropriately publish on each copy an -appropriate copyright notice and disclaimer of warranty; keep intact -all the notices that refer to this License and to the absence of any -warranty; and distribute a copy of this License along with the -Library. - - You may charge a fee for the physical act of transferring a copy, -and you may at your option offer warranty protection in exchange for a -fee. - - 2. You may modify your copy or copies of the Library or any portion -of it, thus forming a work based on the Library, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) The modified work must itself be a software library. - - b) You must cause the files modified to carry prominent notices - stating that you changed the files and the date of any change. - - c) You must cause the whole of the work to be licensed at no - charge to all third parties under the terms of this License. - - d) If a facility in the modified Library refers to a function or a - table of data to be supplied by an application program that uses - the facility, other than as an argument passed when the facility - is invoked, then you must make a good faith effort to ensure that, - in the event an application does not supply such function or - table, the facility still operates, and performs whatever part of - its purpose remains meaningful. - - (For example, a function in a library to compute square roots has - a purpose that is entirely well-defined independent of the - application. Therefore, Subsection 2d requires that any - application-supplied function or table used by this function must - be optional: if the application does not supply it, the square - root function must still compute square roots.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Library, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Library, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote -it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Library. - -In addition, mere aggregation of another work not based on the Library -with the Library (or with a work based on the Library) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may opt to apply the terms of the ordinary GNU General Public -License instead of this License to a given copy of the Library. To do -this, you must alter all the notices that refer to this License, so -that they refer to the ordinary GNU General Public License, version 2, -instead of to this License. (If a newer version than version 2 of the -ordinary GNU General Public License has appeared, then you can specify -that version instead if you wish.) Do not make any other change in -these notices. - - Once this change is made in a given copy, it is irreversible for -that copy, so the ordinary GNU General Public License applies to all -subsequent copies and derivative works made from that copy. - - This option is useful when you wish to copy part of the code of -the Library into a program that is not a library. - - 4. You may copy and distribute the Library (or a portion or -derivative of it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you accompany -it with the complete corresponding machine-readable source code, which -must be distributed under the terms of Sections 1 and 2 above on a -medium customarily used for software interchange. - - If distribution of object code is made by offering access to copy -from a designated place, then offering equivalent access to copy the -source code from the same place satisfies the requirement to -distribute the source code, even though third parties are not -compelled to copy the source along with the object code. - - 5. A program that contains no derivative of any portion of the -Library, but is designed to work with the Library by being compiled or -linked with it, is called a "work that uses the Library". Such a -work, in isolation, is not a derivative work of the Library, and -therefore falls outside the scope of this License. - - However, linking a "work that uses the Library" with the Library -creates an executable that is a derivative of the Library (because it -contains portions of the Library), rather than a "work that uses the -library". The executable is therefore covered by this License. -Section 6 states terms for distribution of such executables. - - When a "work that uses the Library" uses material from a header file -that is part of the Library, the object code for the work may be a -derivative work of the Library even though the source code is not. -Whether this is true is especially significant if the work can be -linked without the Library, or if the work is itself a library. The -threshold for this to be true is not precisely defined by law. - - If such an object file uses only numerical parameters, data -structure layouts and accessors, and small macros and small inline -functions (ten lines or less in length), then the use of the object -file is unrestricted, regardless of whether it is legally a derivative -work. (Executables containing this object code plus portions of the -Library will still fall under Section 6.) - - Otherwise, if the work is a derivative of the Library, you may -distribute the object code for the work under the terms of Section 6. -Any executables containing that work also fall under Section 6, -whether or not they are linked directly with the Library itself. - - 6. As an exception to the Sections above, you may also combine or -link a "work that uses the Library" with the Library to produce a -work containing portions of the Library, and distribute that work -under terms of your choice, provided that the terms permit -modification of the work for the customer's own use and reverse -engineering for debugging such modifications. - - You must give prominent notice with each copy of the work that the -Library is used in it and that the Library and its use are covered by -this License. You must supply a copy of this License. If the work -during execution displays copyright notices, you must include the -copyright notice for the Library among them, as well as a reference -directing the user to the copy of this License. Also, you must do one -of these things: - - a) Accompany the work with the complete corresponding - machine-readable source code for the Library including whatever - changes were used in the work (which must be distributed under - Sections 1 and 2 above); and, if the work is an executable linked - with the Library, with the complete machine-readable "work that - uses the Library", as object code and/or source code, so that the - user can modify the Library and then relink to produce a modified - executable containing the modified Library. (It is understood - that the user who changes the contents of definitions files in the - Library will not necessarily be able to recompile the application - to use the modified definitions.) - - b) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (1) uses at run time a - copy of the library already present on the user's computer system, - rather than copying library functions into the executable, and (2) - will operate properly with a modified version of the library, if - the user installs one, as long as the modified version is - interface-compatible with the version that the work was made with. - - c) Accompany the work with a written offer, valid for at - least three years, to give the same user the materials - specified in Subsection 6a, above, for a charge no more - than the cost of performing this distribution. - - d) If distribution of the work is made by offering access to copy - from a designated place, offer equivalent access to copy the above - specified materials from the same place. - - e) Verify that the user has already received a copy of these - materials or that you have already sent this user a copy. - - For an executable, the required form of the "work that uses the -Library" must include any data and utility programs needed for -reproducing the executable from it. However, as a special exception, -the materials to be distributed need not include anything that is -normally distributed (in either source or binary form) with the major -components (compiler, kernel, and so on) of the operating system on -which the executable runs, unless that component itself accompanies -the executable. - - It may happen that this requirement contradicts the license -restrictions of other proprietary libraries that do not normally -accompany the operating system. Such a contradiction means you cannot -use both them and the Library together in an executable that you -distribute. - - 7. You may place library facilities that are a work based on the -Library side-by-side in a single library together with other library -facilities not covered by this License, and distribute such a combined -library, provided that the separate distribution of the work based on -the Library and of the other library facilities is otherwise -permitted, and provided that you do these two things: - - a) Accompany the combined library with a copy of the same work - based on the Library, uncombined with any other library - facilities. This must be distributed under the terms of the - Sections above. - - b) Give prominent notice with the combined library of the fact - that part of it is a work based on the Library, and explaining - where to find the accompanying uncombined form of the same work. - - 8. You may not copy, modify, sublicense, link with, or distribute -the Library except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense, link with, or -distribute the Library is void, and will automatically terminate your -rights under this License. However, parties who have received copies, -or rights, from you under this License will not have their licenses -terminated so long as such parties remain in full compliance. - - 9. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Library or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Library (or any work based on the -Library), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Library or works based on it. - - 10. Each time you redistribute the Library (or any work based on the -Library), the recipient automatically receives a license from the -original licensor to copy, distribute, link with or modify the Library -subject to these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties with -this License. - - 11. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Library at all. For example, if a patent -license would not permit royalty-free redistribution of the Library by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Library. - -If any portion of this section is held invalid or unenforceable under any -particular circumstance, the balance of the section is intended to apply, -and the section as a whole is intended to apply in other circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 12. If the distribution and/or use of the Library is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Library under this License may add -an explicit geographical distribution limitation excluding those countries, -so that distribution is permitted only in or among countries not thus -excluded. In such case, this License incorporates the limitation as if -written in the body of this License. - - 13. The Free Software Foundation may publish revised and/or new -versions of the Lesser General Public License from time to time. -Such new versions will be similar in spirit to the present version, -but may differ in detail to address new problems or concerns. - -Each version is given a distinguishing version number. If the Library -specifies a version number of this License which applies to it and -"any later version", you have the option of following the terms and -conditions either of that version or of any later version published by -the Free Software Foundation. If the Library does not specify a -license version number, you may choose any version ever published by -the Free Software Foundation. - - 14. If you wish to incorporate parts of the Library into other free -programs whose distribution conditions are incompatible with these, -write to the author to ask for permission. For software which is -copyrighted by the Free Software Foundation, write to the Free -Software Foundation; we sometimes make exceptions for this. Our -decision will be guided by the two goals of preserving the free status -of all derivatives of our free software and of promoting the sharing -and reuse of software generally. - - NO WARRANTY - - 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO -WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. -EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR -OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY -KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE -LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME -THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN -WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY -AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU -FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR -CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE -LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING -RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A -FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Libraries - - If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms of the -ordinary General Public License). - - To apply these terms, attach the following notices to the library. It is -safest to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - 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.1 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 - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the library, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James Random Hacker. - - , 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! diff --git a/ocaml/libs/xapi-rrd/README.md b/ocaml/libs/xapi-rrd/README.md deleted file mode 100644 index 66444557269..00000000000 --- a/ocaml/libs/xapi-rrd/README.md +++ /dev/null @@ -1 +0,0 @@ -Round-Robin Datasources (RRDs) for OCaml. diff --git a/ocaml/libs/xapi-rrd/lib/dune b/ocaml/libs/xapi-rrd/lib/dune deleted file mode 100644 index 00b4bedfc3d..00000000000 --- a/ocaml/libs/xapi-rrd/lib/dune +++ /dev/null @@ -1,14 +0,0 @@ -(library - (name rrd) - (public_name xapi-rrd) - (flags (:standard -w -39)) - (wrapped false) - (libraries - bigarray - rpclib.json - xmlm - yojson - ) - (preprocess (pps ppx_deriving_rpc)) -) - diff --git a/ocaml/libs/xapi-rrd/lib/rrd.ml b/ocaml/libs/xapi-rrd/lib/rrd.ml deleted file mode 100644 index 3c2f8d707a8..00000000000 --- a/ocaml/libs/xapi-rrd/lib/rrd.ml +++ /dev/null @@ -1,1002 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -(** This module provides a util that records data in a way that's compatible - with {{: http://oss.oetiker.ch/rrdtool/index.en.html} rrdtool}. *) - -module Fring = Rrd_fring -module Utils = Rrd_utils -module StringMap = Map.Make (String) - -exception No_RRA_Available - -exception Invalid_data_source of string - -type ds_owner = VM of string | Host | SR of string - -(** Data source types - see ds datatype *) -type ds_type = Absolute | Gauge | Derive [@@deriving rpc] - -(** Consolidation function - see RRA datatype *) -type cf_type = CF_Average | CF_Min | CF_Max | CF_Last - -(** Container so that we can handle different typed inputs *) -type ds_value_type = VT_Float of float | VT_Int64 of int64 | VT_Unknown -[@@deriving rpc] - -type sampling_frequency = Five_Seconds [@@deriving rpc] - -(* utility *) - -let ( +++ ) = Int64.add - -let ( --- ) = Int64.sub - -let ( *** ) = Int64.mul - -let ( /// ) = Int64.div - -let ds_type_to_string = function - | Gauge -> - "GAUGE" - | Absolute -> - "ABSOLUTE" - | Derive -> - "DERIVE" - -let cf_type_of_string = function - | "AVERAGE" -> - CF_Average - | "MIN" -> - CF_Min - | "MAX" -> - CF_Max - | "LAST" -> - CF_Last - | x -> - failwith (Printf.sprintf "Unknown cf_type: %s" x) - -let cf_type_to_string = function - | CF_Average -> - "AVERAGE" - | CF_Max -> - "MAX" - | CF_Min -> - "MIN" - | CF_Last -> - "LAST" - -let ds_value_to_string = function - | VT_Float x -> - Utils.f_to_s x - | VT_Int64 x -> - Printf.sprintf "%Ld" x - | _ -> - "0.0" - -(** The CDP preparation scratch area. - The 'value' field should be accumulated in such a way that it always - contains the value that will eventually be the CDP. This means that - for averages, we accumulate 1/n * the PDP, and renormalise when we - have unknown PDPs. For the other types it's much easier *) - -type cdp_prep = { - mutable cdp_value: float - ; mutable cdp_unknown_pdps: int (** How may PDPs have been unknown so far *) -} - -(** DS - a data source - This defines how we deal with incoming data. Type is one of: - - - Absolute: meaning that the incoming data is an absolute rate - - Derive: meaning that the rate must come from the difference between the - incoming data and the previous value - - Gauge: meaning that the value isn't a rate at all (e.g. temperature, load avg) - - Optionally, there is a maximum time greater than which we mark the PDPs - as unknown. *) - -type ds = { - ds_name: string (** Name *) - ; ds_ty: ds_type - (** Type of rate the input must be processed as, see above *) - ; ds_min: float - ; ds_max: float - ; ds_mrhb: float (** Maximum time between updates *) - ; mutable ds_last: ds_value_type (** Last raw value that was processed *) - ; mutable ds_value: float (** Current calculated rate of the PDP *) - ; mutable ds_unknown_sec: float - (** Number of seconds that are unknown in the current PDP *) -} -[@@deriving rpc] - -(** RRA - RRD archive - This is an archive that holds consolidated data points (CDPs) belonging to - a single consolidation function. They are stored in rings buffers, each - one related to a single different data-source. It defines the type of - consolidation that happens (average, max, min or last), the number of - primary data points (PDPs) that go to make a CDP, and the number of CDPs - to store. - - To better visualize how the datapoints are stored: - - │ Datasources ┃ ┃ ┃ - └─────────────────┨ Memory ┃ cputime ┃ - Consolidators ┃ ┃ ┃ - ━━━━━━━━━━━━━━━━━━╋━━━━━━━━━━━━━━━━━╋━━━━━━━━━━━━━━━━━┫ - Average ┃ Fring of CDPs ┃ Fring of CDPs ┃ ← RRA - ━━━━━━━━━━━━━━━━━━╋━━━━━━━━━━━━━━━━━╋━━━━━━━━━━━━━━━━━┫ - Max ┃ Fring of CDPs ┃ Fring of CDPs ┃ ← RRA - ━━━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━┛ - *) - -type rra = { - rra_cf: cf_type (** consolidation function *) - ; rra_row_cnt: int (** number of entries to store *) - ; rra_pdp_cnt: int (** number of pdps per cdp *) - ; rra_xff: float - (** proportion of missing pdps at which we mark the cdp as unknown *) - ; rra_data: Fring.t array (** Stored data, one ring per datasource *) - ; rra_cdps: cdp_prep array - (** scratch area for consolidated datapoint preparation *) - ; mutable rra_updatehook: (rrd -> int -> unit) option - (** Hook that gets called when an update happens *) -} - -(** The container for the DSs and RRAs. Also specifies the period between pdps *) - -and rrd = { - mutable last_updated: float (** Last updated time in seconds *) - ; timestep: int64 (** Period between PDPs *) - ; rrd_dss: ds array - ; rrd_rras: rra array -} - -let copy_cdp_prep x = - {cdp_value= x.cdp_value; cdp_unknown_pdps= x.cdp_unknown_pdps} - -let copy_rra x = - { - rra_cf= x.rra_cf - ; rra_row_cnt= x.rra_row_cnt - ; rra_pdp_cnt= x.rra_pdp_cnt - ; rra_xff= x.rra_xff - ; rra_data= Array.map Fring.copy x.rra_data - ; rra_cdps= Array.map copy_cdp_prep x.rra_cdps - ; rra_updatehook= x.rra_updatehook - } - -let copy_ds x = - { - ds_name= x.ds_name (* not mutable *) - ; ds_ty= x.ds_ty - ; ds_min= x.ds_min - ; ds_max= x.ds_max - ; ds_mrhb= x.ds_mrhb - ; ds_last= x.ds_last - ; ds_value= x.ds_value - ; ds_unknown_sec= x.ds_unknown_sec - } - -let copy_rrd x = - { - last_updated= x.last_updated - ; timestep= x.timestep - ; rrd_dss= Array.map copy_ds x.rrd_dss - ; rrd_rras= Array.map copy_rra x.rrd_rras - } - -(* CA-329043: avoid producing out-of-range rates *) -let cf_init_value cf ds = - let default = - match cf with - | CF_Average -> - 0.0 - | CF_Min -> - infinity - | CF_Max -> - neg_infinity - | CF_Last -> - nan - in - min ds.ds_max (max ds.ds_min default) - -(** Helper function to get the start time and age of the current/last PDP *) -let get_times time timestep = - let starttime = timestep *** (Int64.of_float time /// timestep) in - let age = time -. Int64.to_float starttime in - (starttime, age) - -(** Update the CDP value with a number (start_pdp_offset) of PDPs. *) -let do_cfs rra start_pdp_offset pdps = - for i = 0 to Array.length pdps - 1 do - let cdp = rra.rra_cdps.(i) in - if Utils.isnan pdps.(i) then ( - (* CDP is an accumulator for the average. If we've got some unknowns, we need to - renormalize. ie, CDP contains \sum_{i=0}^j{ (1/n) x_i} where n is the number of - values we expect to have. If we have unknowns, we need to multiply the whole - thing by \frac{n_{old}}{n_{new}} *) - let olddiv = rra.rra_pdp_cnt - cdp.cdp_unknown_pdps in - let newdiv = olddiv - start_pdp_offset in - if newdiv > 0 then ( - cdp.cdp_value <- - cdp.cdp_value *. float_of_int olddiv /. float_of_int newdiv ; - cdp.cdp_unknown_pdps <- cdp.cdp_unknown_pdps + start_pdp_offset - ) - ) else - let cdpv = cdp.cdp_value in - cdp.cdp_value <- - ( match rra.rra_cf with - | CF_Average -> - cdpv - +. pdps.(i) - *. float_of_int start_pdp_offset - /. float_of_int rra.rra_pdp_cnt - | CF_Min -> - min cdpv pdps.(i) - | CF_Max -> - max cdpv pdps.(i) - | CF_Last -> - pdps.(i) - ) - done - -(** Update the RRAs with a number of PDPs. *) -let rra_update rrd proc_pdp_st elapsed_pdp_st pdps = - (* debug "rra_update";*) - let updatefn rra = - let start_pdp_offset = - rra.rra_pdp_cnt - - Int64.( - to_int (rem (proc_pdp_st /// rrd.timestep) (of_int rra.rra_pdp_cnt)) - ) - in - let rra_step_cnt = - if elapsed_pdp_st < start_pdp_offset then - 0 - else - ((elapsed_pdp_st - start_pdp_offset) / rra.rra_pdp_cnt) + 1 - in - do_cfs rra (min start_pdp_offset elapsed_pdp_st) pdps ; - if rra_step_cnt > 0 then ( - (* When writing multiple CDP values into the archive, the - first one (primary) is calculated using the values we - already had accumulated from the last update, whereas any - subsequent values (secondary) are calculated just using the - current PDP. It turns out that the secondary values are - simply the PDPs as whichever CF is used, a CDP of many - repeated values is simply the value itself. *) - let primaries = - Array.map - (fun cdp -> - if - cdp.cdp_unknown_pdps - <= int_of_float (rra.rra_xff *. float_of_int rra.rra_pdp_cnt) - then - cdp.cdp_value - else - nan - ) - rra.rra_cdps - in - let secondaries = pdps in - - let push i value = Fring.push rra.rra_data.(i) value in - Array.iteri push primaries ; - for _ = 1 to min (rra_step_cnt - 1) rra.rra_row_cnt do - Array.iteri push secondaries - done ; - - (* Reinitialise the CDP preparation area *) - let new_start_pdp_offset = - (elapsed_pdp_st - start_pdp_offset) mod rra.rra_pdp_cnt - in - Array.iteri - (fun i cdp -> - let ds = rrd.rrd_dss.(i) in - let cdp_init = cf_init_value rra.rra_cf ds in - cdp.cdp_unknown_pdps <- 0 ; - cdp.cdp_value <- cdp_init - ) - rra.rra_cdps ; - do_cfs rra new_start_pdp_offset pdps ; - match rra.rra_updatehook with None -> () | Some f -> f rrd rra_step_cnt - ) - in - Array.iter updatefn rrd.rrd_rras - -(* We assume that the data being given is of the form of a rate; that is, - it's dependent on the time interval between updates. To be able to - deal with gauge DSs, we multiply by the interval so that it cancels - the subsequent divide by interval later on *) -let process_ds_value ds value interval new_domid = - if interval > ds.ds_mrhb then - nan - else - let value_raw = - match value with - | VT_Int64 y -> - Int64.to_float y - | VT_Float y -> - y - | VT_Unknown -> - nan - in - - let rate = - match (ds.ds_ty, new_domid) with - | Absolute, _ | Derive, true -> - value_raw - | Gauge, _ -> - value_raw *. interval - | Derive, false -> ( - match (ds.ds_last, value) with - | VT_Int64 x, VT_Int64 y -> - Int64.to_float (y --- x) - | VT_Float x, VT_Float y -> - y -. x - | VT_Unknown, _ | _, VT_Unknown -> - nan - | _ -> - failwith ("Bad type updating ds: " ^ ds.ds_name) - ) - in - ds.ds_last <- value ; - rate - -let ds_update rrd timestamp values transforms new_domid = - (* Interval is the time between this and the last update *) - let interval = timestamp -. rrd.last_updated in - (* Work around the clock going backwards *) - let interval = if interval < 0. then 5. else interval in - - (* start time (st) and age of the last processed pdp and the currently occupied one *) - let proc_pdp_st, _proc_pdp_age = get_times rrd.last_updated rrd.timestep in - let occu_pdp_st, occu_pdp_age = get_times timestamp rrd.timestep in - - (* The number of pdps that should result from this update *) - let elapsed_pdp_st = - Int64.to_int ((occu_pdp_st --- proc_pdp_st) /// rrd.timestep) - in - - (* if we're due one or more PDPs, pre_int is the amount of the - current update interval that will be used in calculating them, and - post_int is the amount left over - this step. If a PDP isn't post is what's left over *) - let pre_int, post_int = - if elapsed_pdp_st > 0 then - let pre = interval -. occu_pdp_age in - (pre, occu_pdp_age) - else - (interval, 0.0) - in - - (* We're now done with the last_updated value, so update it *) - rrd.last_updated <- timestamp ; - - (* Calculate the values we're going to store based on the input data and the type of the DS *) - let v2s = - Array.mapi - (fun i value -> process_ds_value rrd.rrd_dss.(i) value interval new_domid) - values - in - (* Update the PDP accumulators up until the most recent PDP *) - Array.iteri - (fun i value -> - let ds = rrd.rrd_dss.(i) in - if Utils.isnan value then - ds.ds_unknown_sec <- pre_int - else - ds.ds_value <- ds.ds_value +. (pre_int *. value /. interval) - ) - v2s ; - - (* If we've passed a PDP point, we need to update the RRAs *) - if elapsed_pdp_st > 0 then ( - (* Calculate the PDPs for each DS *) - let pdps = - Array.mapi - (fun i ds -> - if interval > ds.ds_mrhb then - nan - else - let raw = - ds.ds_value - /. (Int64.to_float (occu_pdp_st --- proc_pdp_st) - -. ds.ds_unknown_sec - ) - in - (* Apply the transform after the raw value has been calculated *) - let raw = transforms.(i) raw in - (* Make sure the values are not out of bounds after all the processing *) - if raw < ds.ds_min || raw > ds.ds_max then - nan - else - raw - ) - rrd.rrd_dss - in - - rra_update rrd proc_pdp_st elapsed_pdp_st pdps ; - - (* Reset the PDP accumulators *) - Array.iteri - (fun i value -> - let ds = rrd.rrd_dss.(i) in - if Utils.isnan value then ( - ds.ds_value <- 0.0 ; - ds.ds_unknown_sec <- post_int - ) else ( - ds.ds_value <- post_int *. value /. interval ; - ds.ds_unknown_sec <- 0.0 - ) - ) - v2s - ) - -(** Update the rrd with named values rather than just an ordered array *) -let ds_update_named rrd timestamp ~new_domid valuesandtransforms = - let valuesandtransforms = - valuesandtransforms |> List.to_seq |> StringMap.of_seq - in - let get_value_and_transform {ds_name; _} = - Option.value ~default:(VT_Unknown, Fun.id) - (StringMap.find_opt ds_name valuesandtransforms) - in - let ds_values, ds_transforms = - Array.split (Array.map get_value_and_transform rrd.rrd_dss) - in - ds_update rrd timestamp ds_values ds_transforms new_domid - -(** Get registered DS names *) -let ds_names rrd = Array.to_list (Array.map (fun ds -> ds.ds_name) rrd.rrd_dss) - -(** create an rra structure *) -let rra_create cf row_cnt pdp_cnt xff = - { - rra_cf= cf - ; rra_row_cnt= row_cnt - ; rra_pdp_cnt= pdp_cnt - ; rra_xff= xff - ; rra_data= - [||] - (* defer creation of the data until we know how many dss we're storing *) - ; rra_cdps= - [||] - (* defer creation of the data until we know how many dss we're storing *) - ; rra_updatehook= None (* DEPRECATED *) - } - -let ds_create name ty ?(min = neg_infinity) ?(max = infinity) ?(mrhb = infinity) - init = - { - ds_name= name - ; ds_ty= ty - ; ds_min= min - ; ds_max= max - ; ds_mrhb= mrhb - ; ds_last= init - ; ds_value= 0.0 - ; ds_unknown_sec= 0.0 - } - -let rrd_create dss rras timestep inittime = - (* Use the standard update routines to initialise everything to correct values *) - let rrd = - { - last_updated= 0.0 - ; timestep - ; rrd_dss= dss - ; rrd_rras= - Array.map - (fun rra -> - { - rra with - rra_data= - Array.init (Array.length dss) (fun i -> - let ds = dss.(i) in - Fring.make rra.rra_row_cnt nan ds.ds_min ds.ds_max - ) - ; rra_cdps= - Array.init (Array.length dss) (fun i -> - let ds = dss.(i) in - let cdp_init = cf_init_value rra.rra_cf ds in - {cdp_value= cdp_init; cdp_unknown_pdps= 0} - ) - } - ) - rras - } - in - let values = Array.map (fun ds -> ds.ds_last) dss in - let transforms = Array.make (Array.length values) (fun x -> x) in - ds_update rrd inittime values transforms true ; - rrd - -(** Add in a new DS into a pre-existing RRD. Preserves data of all the other archives - and fills the new one full of NaNs. Note that this doesn't fill in the CDP values - correctly at the moment! - - @param now = Unix.gettimeofday () -*) - -let rrd_add_ds rrd now newds = - if List.mem newds.ds_name (ds_names rrd) then - rrd - else - let npdps = Int64.of_float now /// rrd.timestep in - { - rrd with - rrd_dss= Array.append rrd.rrd_dss [|newds|] - ; rrd_rras= - Array.map - (fun rra -> - let cdp_init = cf_init_value rra.rra_cf newds in - let fring = - Fring.make rra.rra_row_cnt nan newds.ds_min newds.ds_max - in - let nunknowns = - Int64.to_int (Int64.rem npdps (Int64.of_int rra.rra_pdp_cnt)) - in - { - rra with - rra_data= Array.append rra.rra_data [|fring|] - ; rra_cdps= - Array.append rra.rra_cdps - [|{cdp_value= cdp_init; cdp_unknown_pdps= nunknowns}|] - } - ) - rrd.rrd_rras - } - -(** Remove the named DS from an RRD. Removes all of the data associated with it, too *) -let rrd_remove_ds rrd ds_name = - let n = - Utils.array_index ds_name (Array.map (fun ds -> ds.ds_name) rrd.rrd_dss) - in - if n = -1 then - raise (Invalid_data_source ds_name) - else - { - rrd with - rrd_dss= Utils.array_remove n rrd.rrd_dss - ; rrd_rras= - Array.map - (fun rra -> - { - rra with - rra_data= Utils.array_remove n rra.rra_data - ; rra_cdps= Utils.array_remove n rra.rra_cdps - } - ) - rrd.rrd_rras - } - -(** Find the RRA with a particular CF that contains a particular start - time, and also has a minimum pdp_cnt. If it can't find an - appropriate one, either return the RRA with the correct CF that - has the most ancient data, or raise No_RRA_Available if there's - not archive with the correct CF. Assumes the RRAs are stored in - increasing time-length *) -let find_best_rras rrd pdp_interval cf start = - let rras = - match cf with - | Some realcf -> - List.filter (fun rra -> rra.rra_cf = realcf) (Array.to_list rrd.rrd_rras) - | None -> - Array.to_list rrd.rrd_rras - in - if rras = [] then raise No_RRA_Available ; - let last_pdp_time, _age = get_times rrd.last_updated rrd.timestep in - let contains_time t rra = - let lasttime = - last_pdp_time - --- (rrd.timestep *** Int64.of_int (rra.rra_row_cnt * rra.rra_pdp_cnt)) - in - rra.rra_pdp_cnt >= pdp_interval && t > lasttime - in - try - let first_ok_rra = List.find (contains_time start) rras in - let pdp_cnt = first_ok_rra.rra_pdp_cnt in - let row_cnt = first_ok_rra.rra_row_cnt in - let ok_rras = - List.filter - (fun rra -> rra.rra_row_cnt = row_cnt && rra.rra_pdp_cnt = pdp_cnt) - rras - in - ok_rras - with _ -> - let rra = List.hd (List.rev rras) in - let newstarttime = - 1L - +++ last_pdp_time - --- (rrd.timestep *** Int64.of_int (rra.rra_row_cnt * rra.rra_pdp_cnt)) - in - List.filter (contains_time newstarttime) rras - -(* now = Unix.gettimeofday () *) -let query_named_ds rrd now ds_name cf = - let n = - Utils.array_index ds_name (Array.map (fun ds -> ds.ds_name) rrd.rrd_dss) - in - if n = -1 then - raise (Invalid_data_source ds_name) - else - let rras = find_best_rras rrd 0 (Some cf) (Int64.of_float now) in - match rras with - | [] -> - raise No_RRA_Available - | rra :: _ -> - Fring.peek rra.rra_data.(n) 0 - -(******************************************************************************) -(* Marshalling/Unmarshalling functions *) -(******************************************************************************) - -let from_xml input = - let open Utils.Xmlm_utils in - let read_header i = - ignore (get_el "version" i) ; - let step = get_el "step" i in - let last_update = get_el "lastupdate" i in - (step, last_update) - in - - let read_dss i = - let read_ds i = - read_block "ds" - (fun i -> - let name = get_el "name" i in - let type_ = get_el "type" i in - let min_hb = get_el "minimal_heartbeat" i in - let min = get_el "min" i in - let max = get_el "max" i in - ignore (get_el "last_ds" i) ; - let value = get_el "value" i in - let unknown_sec = get_el "unknown_sec" i in - { - ds_name= name - ; ds_ty= - ( match type_ with - | "GAUGE" -> - Gauge - | "ABSOLUTE" -> - Absolute - | "DERIVE" -> - Derive - | _ -> - failwith "Bad format" - ) - ; ds_mrhb= float_of_string min_hb - ; ds_min= float_of_string min - ; ds_max= float_of_string max - ; ds_last= VT_Unknown - ; (* float_of_string "last_ds"; *) - ds_value= float_of_string value - ; ds_unknown_sec= float_of_string unknown_sec - } - ) - i - in - let dss = read_all "ds" read_ds i [] in - dss - in - - let read_rras dss i = - let read_rra i = - let read_cdp_prep i = - let read_ds i = - read_block "ds" - (fun i -> - ignore (get_el "primary_value" i) ; - ignore (get_el "secondary_value" i) ; - let value = get_el "value" i in - let unknown_datapoints = get_el "unknown_datapoints" i in - { - cdp_value= float_of_string value - ; cdp_unknown_pdps= int_of_string unknown_datapoints - } - ) - i - in - let cdps = - read_block "cdp_prep" (fun i -> read_all "ds" read_ds i []) i - in - cdps - in - let read_database i = - let read_row i = - (* should directly write in fring *) - let row = - read_block "row" - (fun i -> Array.of_list (iter_seq (get_el "v") [] i)) - i - in - row - in - let data = - read_block "database" - (fun i -> Array.of_list (read_all "row" read_row i [])) - i - in - let rows = Array.length data in - let cols = try Array.length data.(0) with _ -> -1 in - let db = - Array.init cols (fun i -> - let ds = List.nth dss i in - Fring.make rows nan ds.ds_min ds.ds_max - ) - in - for i = 0 to cols - 1 do - for j = 0 to rows - 1 do - let value = float_of_string data.(j).(i) in - Fring.push db.(i) value - done - done ; - db - in - let rra = - read_block "rra" - (fun i -> - let cf = get_el "cf" i in - let pdp_cnt = get_el "pdp_per_row" i in - let xff = read_block "params" (fun i -> get_el "xff" i) i in - let cdps = read_cdp_prep i in - let database = read_database i in - { - rra_cf= - ( match cf with - | "AVERAGE" -> - CF_Average - | "MIN" -> - CF_Min - | "MAX" -> - CF_Max - | "LAST" -> - CF_Last - | _ -> - raise Utils.Parse_error - ) - ; rra_row_cnt= Fring.length database.(0) - ; rra_pdp_cnt= int_of_string pdp_cnt - ; rra_xff= float_of_string xff - ; rra_data= database - ; rra_cdps= Array.of_list cdps - ; rra_updatehook= None - } - ) - i - in - rra - in - let rras = read_all "rra" read_rra i [] in - rras - in - - accept (`Dtd None) input ; - read_block "rrd" - (fun i -> - let step, last_update = read_header i in - let dss = read_dss i in - let rras = read_rras dss i in - let rrd = - { - last_updated= float_of_string last_update - ; timestep= Int64.of_string step - ; rrd_dss= Array.of_list dss - ; rrd_rras= Array.of_list rras - } - in - - (* Purge any repeated data sources from the RRD *) - let ds_names = ds_names rrd in - let ds_names_set = Utils.setify ds_names in - let ds_name_counts = - List.map - (fun name -> - let x, _ = List.partition (( = ) name) ds_names in - (name, List.length x) - ) - ds_names_set - in - let removals_required = - List.filter (fun (_, x) -> x > 1) ds_name_counts - in - List.fold_left - (fun rrd (name, n) -> - (* Remove n-1 lots of this data source *) - let rec inner rrd n = - if n = 1 then - rrd - else - inner (rrd_remove_ds rrd name) (n - 1) - in - inner rrd n - ) - rrd removals_required - ) - input - -let xml_to_output rrd output = - (* We use an output channel for Xmlm-compat buffered output. Provided we flush - at the end we should be safe. *) - let tag n fn output = - Xmlm.output output (`El_start (("", n), [])) ; - fn output ; - Xmlm.output output `El_end - in - let data dat output = Xmlm.output output (`Data dat) in - - let do_ds ds output = - tag "ds" - (fun output -> - tag "name" (data ds.ds_name) output ; - tag "type" (data (ds_type_to_string ds.ds_ty)) output ; - tag "minimal_heartbeat" (data (Utils.f_to_s ds.ds_mrhb)) output ; - tag "min" (data (Utils.f_to_s ds.ds_min)) output ; - tag "max" (data (Utils.f_to_s ds.ds_max)) output ; - tag "last_ds" (data (ds_value_to_string ds.ds_last)) output ; - tag "value" (data (Utils.f_to_s ds.ds_value)) output ; - tag "unknown_sec" - (data (Printf.sprintf "%d" (int_of_float ds.ds_unknown_sec))) - output - ) - output - in - - let do_dss dss output = Array.iter (fun ds -> do_ds ds output) dss in - - let do_rra_cdp cdp output = - tag "ds" - (fun output -> - tag "primary_value" (data "0.0") output ; - tag "secondary_value" (data "0.0") output ; - tag "value" (data (Utils.f_to_s cdp.cdp_value)) output ; - tag "unknown_datapoints" - (data (Printf.sprintf "%d" cdp.cdp_unknown_pdps)) - output - ) - output - in - - let do_rra_cdps cdps output = - Array.iter (fun cdp -> do_rra_cdp cdp output) cdps - in - - let do_database rings output = - if Array.length rings = 0 then - () - else - let rows = Fring.length rings.(0) in - let cols = Array.length rings in - for row = 0 to rows - 1 do - tag "row" - (fun output -> - for col = 0 to cols - 1 do - tag "v" - (data (Utils.f_to_s (Fring.peek rings.(col) (rows - row - 1)))) - output - done - ) - output - done - in - - let do_rra rra output = - tag "rra" - (fun output -> - tag "cf" (data (cf_type_to_string rra.rra_cf)) output ; - tag "pdp_per_row" (data (string_of_int rra.rra_pdp_cnt)) output ; - tag "params" (tag "xff" (data (Utils.f_to_s rra.rra_xff))) output ; - tag "cdp_prep" (fun output -> do_rra_cdps rra.rra_cdps output) output ; - tag "database" (fun output -> do_database rra.rra_data output) output - ) - output - in - - let do_rras rras output = Array.iter (fun rra -> do_rra rra output) rras in - - Xmlm.output output (`Dtd None) ; - tag "rrd" - (fun output -> - tag "version" (data "0003") output ; - tag "step" (data (Int64.to_string rrd.timestep)) output ; - tag "lastupdate" - (data (Printf.sprintf "%Ld" (Int64.of_float rrd.last_updated))) - output ; - do_dss rrd.rrd_dss output ; - do_rras rrd.rrd_rras output - ) - output - -module Json = struct - let fmt fmt x = Printf.ksprintf (fun msg -> `String msg) fmt x - - let string x = fmt "%s" x - - let float x = string (Utils.f_to_s x) - - let int x = fmt "%d" x - - let int64 x = fmt "%Ld" x - - let record xs = `Assoc xs - - let array xs = `List xs - - let datasource ds = - record - [ - ("name", string ds.ds_name) - ; ("type", string (ds_type_to_string ds.ds_ty)) - ; ("minimal_heartbeat", float ds.ds_mrhb) - ; ("min", float ds.ds_min) - ; ("max", float ds.ds_max) - ; ("last_ds", string (ds_value_to_string ds.ds_last)) - ; ("value", float ds.ds_value) - ; ("unknown_sec", float ds.ds_unknown_sec) - ] - - let cdp x = - record - [ - ("primary_value", float 0.0) - ; ("secondary_value", float 0.0) - ; ("value", float x.cdp_value) - ; ("unknown_datapoints", int x.cdp_unknown_pdps) - ] - - let get rings rows row col = Fring.peek rings.(col) (rows - row - 1) |> float - - let database = function - | [||] -> - array [] - | rings -> - let rows = Fring.length rings.(0) in - let cols = Array.length rings in - array - @@ Array.to_list - @@ Array.init rows (fun row -> - array - @@ Array.to_list - @@ Array.init cols (fun col -> get rings rows row col) - ) - - let rra x = - record - [ - ("cf", string (cf_type_to_string x.rra_cf)) - ; ("pdp_per_row", int x.rra_pdp_cnt) - ; ("params", record [("xff", float x.rra_xff)]) - ; ( "cdp_prep" - , record [("ds", array @@ List.map cdp @@ Array.to_list x.rra_cdps)] - ) - ; ("database", database x.rra_data) - ] - - let rrd x = - record - [ - ("version", string "0003") - ; ("step", int64 x.timestep) - ; ("lastupdate", float x.last_updated) - ; ("ds", array @@ List.map datasource @@ Array.to_list x.rrd_dss) - ; ("rra", array @@ List.map rra @@ Array.to_list x.rrd_rras) - ] -end - -let json_to_string rrd = Yojson.to_string (Json.rrd rrd) - -module Statefile_latency = struct - type t = {id: string; latency: float option} [@@deriving rpc] -end diff --git a/ocaml/libs/xapi-rrd/lib/rrd_fring.ml b/ocaml/libs/xapi-rrd/lib/rrd_fring.ml deleted file mode 100644 index 456e2a8d0b0..00000000000 --- a/ocaml/libs/xapi-rrd/lib/rrd_fring.ml +++ /dev/null @@ -1,98 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -module BoundedFloat = Rrd_utils.BoundedFloat - -type t = { - size: int - ; mutable current: int - ; min: float - ; max: float - ; data: (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t -} - -let make size (init : float) minimum maximum = - let ring = - { - size - ; current= size - 1 - ; min= minimum - ; max= maximum - ; data= Bigarray.Array1.create Bigarray.float32 Bigarray.c_layout size - } - in - let bound = - BoundedFloat.of_float ~minimum ~maximum ~f:BoundedFloat.To_Nan init - in - Bigarray.Array1.fill ring.data @@ BoundedFloat.to_float bound ; - ring - -let copy x = - let y = make x.size nan x.min x.max in - Bigarray.Array1.blit x.data y.data ; - y.current <- x.current ; - y - -let length ring = ring.size - -let push ring (e : float) = - ring.current <- ring.current + 1 ; - if ring.current = ring.size then - ring.current <- 0 ; - let bound = - BoundedFloat.of_float ~minimum:ring.min ~maximum:ring.max - ~f:BoundedFloat.To_Nan e - in - Bigarray.Array1.set ring.data ring.current @@ BoundedFloat.to_float bound - -let peek ring i = - if i >= ring.size then - raise (Invalid_argument "peek: index") ; - let index = - let offset = ring.current - i in - if offset >= 0 then offset else ring.size + offset - in - ring.data.{index} - -let top ring = ring.data.{ring.current} - -let iter_nb ring f nb = - if nb > ring.size then - raise (Invalid_argument "iter_nb: nb") ; - (* FIXME: OPTIMIZE ME with 2 Array.iter ? *) - for i = 0 to nb - 1 do - f (peek ring i) - done - -(* iter directly on all element without using the index *) -let iter f a = - for i = 0 to Bigarray.Array1.dim a - 1 do - f a.{i} - done - -let raw_iter ring f = iter f ring.data - -let iter ring f = iter_nb ring f ring.size - -let get_nb ring nb = - if nb > ring.size then - raise (Invalid_argument "get_nb: nb") ; - let a = Array.make nb (top ring) in - for i = 1 to nb - 1 do - (* FIXME: OPTIMIZE ME with 2 Array.blit *) - a.(i) <- peek ring i - done ; - a - -let get ring = get_nb ring ring.size diff --git a/ocaml/libs/xapi-rrd/lib/rrd_fring.mli b/ocaml/libs/xapi-rrd/lib/rrd_fring.mli deleted file mode 100644 index 7da606a3663..00000000000 --- a/ocaml/libs/xapi-rrd/lib/rrd_fring.mli +++ /dev/null @@ -1,54 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -(** Ring structures for RRAs - The values in the structures are bound to a range *) - -module BoundedFloat = Rrd_utils.BoundedFloat - -type t - -val make : int -> float -> float -> float -> t -(** create a ring structure with [size] record; records initialised to [init] - @param size number of elements the ring holds (constant) - @param init value all the elements are initialized to - *) - -val copy : t -> t -(** create a duplicate ring structure *) - -val length : t -> int -(** length (size) of the ring, it is constant *) - -val push : t -> float -> unit -(** push into the ring one element *) - -val peek : t -> int -> float -(** get the i{^th} old element from the ring *) - -val top : t -> float -(** get the top element of the ring *) - -val iter_nb : t -> (float -> unit) -> int -> unit -(** iterate over nb element of the ring, starting from the top *) - -val raw_iter : t -> (float -> unit) -> unit - -val iter : t -> (float -> unit) -> unit -(** iterate over all elements of the ring, starting from the top *) - -val get_nb : t -> int -> float array -(** get array of latest [nb] value *) - -val get : t -> float array -(** get an array with all the values in the ring *) diff --git a/ocaml/libs/xapi-rrd/lib/rrd_timescales.ml b/ocaml/libs/xapi-rrd/lib/rrd_timescales.ml deleted file mode 100644 index 2432cd1857d..00000000000 --- a/ocaml/libs/xapi-rrd/lib/rrd_timescales.ml +++ /dev/null @@ -1,37 +0,0 @@ -(* - * Copyright (C) 2015 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -(* - * Timescales: this allows an RRD server to advertise which Timescales - * are available, to avoid clients having to already know or guess. - *) - -type t = {name: string; num_intervals: int; interval_in_steps: int} -[@@deriving rpc] - -type ts = t list [@@deriving rpc] - -let make ~name ~num_intervals ~interval_in_steps () = - {name; num_intervals; interval_in_steps} - -let name_of t = t.name - -let to_span t = t.num_intervals * t.interval_in_steps * 5 - -(* ??? *) - -let interval_to_span t = t.interval_in_steps * 5 - -let to_json ts = Jsonrpc.to_string (rpc_of_ts ts) - -let of_json txt = ts_of_rpc (Jsonrpc.of_string txt) diff --git a/ocaml/libs/xapi-rrd/lib/rrd_timescales.mli b/ocaml/libs/xapi-rrd/lib/rrd_timescales.mli deleted file mode 100644 index aa2ba1646f6..00000000000 --- a/ocaml/libs/xapi-rrd/lib/rrd_timescales.mli +++ /dev/null @@ -1,35 +0,0 @@ -(* - * Copyright (C) 2015 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -(* - * Timescales: this allows an RRD server to advertise which Timescales - * are available, to avoid clients having to already know or guess. - *) - -type t = {name: string; num_intervals: int; interval_in_steps: int} - -val make : - name:string -> num_intervals:int -> interval_in_steps:int -> unit -> t - -val name_of : t -> string - -val to_span : t -> int -(** Total length of time covered by the archive *) - -val interval_to_span : t -> int -(** Length of time in one interval (clients requesting updates should poll at - most every interval) *) - -val to_json : t list -> string - -val of_json : string -> t list diff --git a/ocaml/libs/xapi-rrd/lib/rrd_updates.ml b/ocaml/libs/xapi-rrd/lib/rrd_updates.ml deleted file mode 100644 index e1e3a98f88d..00000000000 --- a/ocaml/libs/xapi-rrd/lib/rrd_updates.ml +++ /dev/null @@ -1,311 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -(* - * Updates module: this module deals with the updates type, which - * represents a delta between an RRD's past and current state. - *) -(** - * @group Performance Monitoring -*) - -open Rrd - -type row = {time: int64; row_data: float array} - -type t = { - start_time: int64 - ; step: int64 - ; end_time: int64 - ; legend: string array - ; data: row array -} - -(** Debugging only *) -let string_of t = - let leg_string = - Printf.sprintf "[%s]" - (String.concat ";" - (List.map (fun l -> Printf.sprintf "\"%s\"" l) (Array.to_list t.legend)) - ) - in - - let data_string = - Printf.sprintf "[|%s|]" - (String.concat ";\n" - (List.map - (fun row -> - Printf.sprintf "{time=%Ld; row_data=[|%s|]}" row.time - (String.concat "; " - (List.map - (fun f -> Printf.sprintf "%0.4f" f) - (Array.to_list row.row_data) - ) - ) - ) - (Array.to_list t.data) - ) - ) - in - - Printf.sprintf - "start_time:\t%Ld\nstep:\t\t%Ld\nend_time:\t%Ld\nlegend:\t\t%s\ndata:\n%s\n" - t.start_time t.step t.end_time leg_string data_string - -(* Helper utility - use create_multi instead *) -let create rra_timestep rras first_rra last_cdp_time first_cdp_time start - legends = - let rec do_data i accum = - let time = Int64.(sub last_cdp_time (mul (of_int i) rra_timestep)) in - if time < start || i >= first_rra.rra_row_cnt then - List.rev accum - else - let extract_row rra = - List.map (fun ring -> Fring.peek ring i) (Array.to_list rra.rra_data) - in - let values = List.concat (List.map extract_row rras) in - do_data (i + 1) ({time; row_data= Array.of_list values} :: accum) - in - - let data = Array.of_list (do_data 0 []) in - - { - start_time= first_cdp_time - ; step= rra_timestep - ; end_time= last_cdp_time - ; legend= legends - ; data - } - -let xml_of t output = - let tag tag next () = - Xmlm.output output (`El_start (("", tag), [])) ; - List.iter (fun x -> x ()) next ; - Xmlm.output output `El_end - in - let data dat () = Xmlm.output output (`Data dat) in - - let xml_of_row row = - let values = - List.map - (fun v -> tag "v" [data (Utils.f_to_s v)]) - (Array.to_list row.row_data) - in - tag "row" (tag "t" [data (Printf.sprintf "%Ld" row.time)] :: values) - in - - let rows = List.map xml_of_row (Array.to_list t.data) in - let mydata = tag "data" rows in - - let meta = - tag "meta" - [ - tag "start" [data (Printf.sprintf "%Ld" t.start_time)] - ; tag "step" [data (Printf.sprintf "%Ld" t.step)] - ; tag "end" [data (Printf.sprintf "%Ld" t.end_time)] - ; tag "rows" [data (Printf.sprintf "%d" (List.length rows))] - ; tag "columns" [data (Printf.sprintf "%d" (Array.length t.legend))] - ; tag "legend" - (List.map (fun x -> tag "entry" [data x]) (Array.to_list t.legend)) - ] - in - - Xmlm.output output (`Dtd None) ; - tag "xport" [meta; mydata] () - -let of_xml input = - let open Utils.Xmlm_utils in - let read_row i = - read_block "row" - (fun i -> - let time = get_el "t" i in - let values = read_all "v" (get_el "v") i [] in - { - time= Int64.of_string time - ; row_data= Array.of_list (List.map (fun v -> float_of_string v) values) - } - ) - i - in - - let read_data i = Array.of_list (read_all "row" read_row i []) in - - let read_meta i = - read_block "meta" - (fun i -> - let start_time = get_el "start" i |> Int64.of_string in - let step = get_el "step" i |> Int64.of_string in - let end_time = get_el "end" i |> Int64.of_string in - let rows = get_el "rows" i |> int_of_string in - let columns = get_el "columns" i |> int_of_string in - let legend = - read_block "legend" - (fun i -> read_all "entry" (get_el "entry") i []) - i - |> Array.of_list - in - let data = [||] in - let meta = {start_time; step; end_time; legend; data} in - (meta, rows, columns) - ) - i - in - - accept (`Dtd None) input ; - read_block "xport" - (fun i -> - let meta, _, _ = read_meta i in - let data = read_block "data" read_data i in - {meta with data} - ) - input - -let json_of_t t = - let open Json in - let map_to_list f arr = Array.to_seq arr |> Seq.map f |> List.of_seq in - let data_record row = - record - [ - ("t", int64 row.time) - ; ( "values" - , array (map_to_list (fun x -> string (Utils.f_to_s x)) row.row_data) - ) - ] - in - let meta = - record - [ - ( "meta" - , record - [ - ("start", int64 t.start_time) - ; ("step", int64 t.step) - ; ("end", int64 t.end_time) - ; ("rows", int (Array.length t.data)) - ; ("columns", int (Array.length t.legend)) - ; ("legend", array (map_to_list string t.legend)) - ; ("data", array (map_to_list data_record t.data)) - ] - ) - ] - in - Yojson.to_string meta - -(** Export data from a bunch of rrds. Specify a prefix per rrd to be - put onto legend. Note that each rrd *must* have the same timestep - and have been updated at the same time, and *must* have - homogeneous rras too. If not, those that dont look like the 1st - one will be silently dropped. The export format is the rrdtool - 'xport' format. *) - -let create_multi prefixandrrds start interval cfopt = - let timestep, last_updated = - match prefixandrrds with - | (_, r) :: _ -> - (r.timestep, r.last_updated) - | [] -> - raise No_RRA_Available - in - - let pdp_interval = Int64.to_int (Int64.div interval timestep) in - - (* Sanity - make sure the RRDs are homogeneous *) - let prefixandrrds = - List.filter (fun (_prefix, rrd) -> rrd.timestep = timestep) prefixandrrds - in - - (* Treat -ve start values as relative to the latest update. *) - let start = - prefixandrrds - |> List.map (fun (_, rrd) -> - if start < 0L then - Int64.(add start (of_float rrd.last_updated)) - else - start - ) - |> List.fold_left min Int64.max_int - in - - let rras = - List.map - (fun (_prefix, rrd) -> - (* Find the rrds that satisfy the requirements *) - Rrd.find_best_rras rrd pdp_interval cfopt start - ) - prefixandrrds - in - let first_rra = - rras |> List.find_opt (fun x -> x <> []) |> function - | Some (x :: _) -> - x - | Some [] | None -> - raise No_RRA_Available - in - let rras = - let only_valid_pdp_and_num_rows rra = - rra.rra_pdp_cnt = first_rra.rra_pdp_cnt - && rra.rra_row_cnt = first_rra.rra_row_cnt - in - List.map (List.filter only_valid_pdp_and_num_rows) rras - in - - let legends = - Array.concat - (List.map2 - (fun (prefix, rrd) rras -> - let ds_legends = - Array.map (fun ds -> prefix ^ ds.ds_name) rrd.rrd_dss - in - let ds_legends_with_cf_prefix = - Array.concat - (List.map - (fun rra -> - Array.map - (fun name -> cf_type_to_string rra.rra_cf ^ ":" ^ name) - ds_legends - ) - rras - ) - in - ds_legends_with_cf_prefix - ) - prefixandrrds rras - ) - in - - let rras = List.flatten rras in - - (* The following timestep is that of the archive *) - let rra_timestep = Int64.mul timestep (Int64.of_int first_rra.rra_pdp_cnt) in - - (* Get the last and first times of the CDPs to be returned *) - let last_cdp_time, _age = get_times last_updated rra_timestep in - let first_cdp_time_minus_one, _age = - get_times (Int64.to_float start) rra_timestep - in - let first_cdp_time = Int64.add first_cdp_time_minus_one rra_timestep in - - create rra_timestep rras first_rra last_cdp_time first_cdp_time start legends - -let export ?(json = false) prefixandrrds start interval cfopt = - let t = create_multi prefixandrrds start interval cfopt in - if json then - json_of_t t - else - let buffer = Buffer.create 10 in - let output = Xmlm.make_output (`Buffer buffer) in - xml_of t output ; Buffer.contents buffer - -let of_string s = - let input = Xmlm.make_input (`String (0, s)) in - of_xml input diff --git a/ocaml/libs/xapi-rrd/lib/rrd_utils.ml b/ocaml/libs/xapi-rrd/lib/rrd_utils.ml deleted file mode 100644 index c0863d0175f..00000000000 --- a/ocaml/libs/xapi-rrd/lib/rrd_utils.ml +++ /dev/null @@ -1,139 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -(* Utils, some from stdext originally *) - -(** - * @group Performance Monitoring -*) - -exception Parse_error - -module BoundedFloat : sig - type t = private float - - type entry_fun = Clamp | To_Nan - - val of_float : minimum:float -> maximum:float -> f:entry_fun -> float -> t - - val to_float : t -> float -end = struct - type t = float - - type entry_fun = Clamp | To_Nan - - let of_float ~minimum ~maximum ~f x = - match f with - | Clamp -> - min maximum (max minimum x) - | To_Nan when x < minimum || x > maximum -> - nan - | To_Nan -> - x - - let to_float x = x -end - -let isnan x = match classify_float x with FP_nan -> true | _ -> false - -let array_index e a = - let len = Array.length a in - let rec check i = - if len <= i then - -1 - else if a.(i) = e then - i - else - check (i + 1) - in - check 0 - -let array_remove n a = - Array.append (Array.sub a 0 n) (Array.sub a (n + 1) (Array.length a - n - 1)) - -let filter_map f list = - let rec inner acc l = - match l with - | [] -> - List.rev acc - | x :: xs -> - let acc = match f x with Some res -> res :: acc | None -> acc in - inner acc xs - in - inner [] list - -let rec setify = function - | [] -> - [] - | x :: xs -> - if List.mem x xs then setify xs else x :: setify xs - -(** C# and JS representation of special floats are 'NaN' and 'Infinity' which - are different from ocaml's native representation. Caml is fortunately more - forgiving when doing a float_of_string, and can cope with these forms, so - we make a generic float_to_string function here *) -let f_to_s f = - match classify_float f with - | FP_normal | FP_subnormal -> - Printf.sprintf "%0.5g" f - | FP_nan -> - "NaN" - | FP_infinite -> - if f > 0.0 then "Infinity" else "-Infinity" - | FP_zero -> - "0.0" - -module Xmlm_utils = struct - let tag n = (("", n), []) - - let start_tag n = `El_start (tag n) - - let accept s i = if Xmlm.input i = s then () else raise Parse_error - - let rec iter_seq el acc i = - match Xmlm.peek i with - | `El_start _ -> - iter_seq el (el i :: acc) i - | `El_end -> - List.rev acc - | _ -> - raise Parse_error - - let get_el n i = - if Xmlm.input i = start_tag n then ( - let d = - match Xmlm.peek i with - | `Data d -> - ignore (Xmlm.input i) ; - d - | `El_end -> - "" - | _ -> - raise Parse_error - in - accept `El_end i ; d - ) else - raise Parse_error - - let rec read_all t read_f i acc = - if Xmlm.peek i = start_tag t then - read_all t read_f i (read_f i :: acc) - else - List.rev acc - - let read_block t f i = - accept (start_tag t) i ; - let res = f i in - accept `El_end i ; res -end diff --git a/ocaml/libs/xapi-rrd/lib_test/crowbar_tests.ml b/ocaml/libs/xapi-rrd/lib_test/crowbar_tests.ml deleted file mode 100644 index 2aecd81d030..00000000000 --- a/ocaml/libs/xapi-rrd/lib_test/crowbar_tests.ml +++ /dev/null @@ -1,102 +0,0 @@ -module Fring = Rrd.Fring -module Cb = Crowbar - -(* cast double-precision floats to single-precision and return them in - ascending order *) -let castd2s x y = - let _data = Bigarray.Array1.create Bigarray.float32 Bigarray.c_layout 1 in - _data.{0} <- x ; - let x = _data.{0} in - _data.{0} <- y ; - let y = _data.{0} in - if x > y then - (y, x) - else - (x, y) - -let in_range min max values = - let between value = - if Rrd.Utils.isnan value then - true - else if min > value then - Cb.fail (Printf.sprintf "value (%f) lower than min (%f); " value min) - else if max < value then - Cb.fail (Printf.sprintf "value (%f) higher than max (%f); " value max) - else - true - in - Cb.check @@ Array.for_all between values - -(* Checks if all the values in the archives are within the limits set by the data sources - * Each archive (RRA) has a ring for each datasource (DS) *) -let test_ranges rrd = - let open Rrd in - let in_range_fring ds fring = - in_range ds.ds_min ds.ds_max (Fring.get fring) - in - let in_range_rra dss rra = Array.iter2 in_range_fring dss rra.rra_data in - Array.iter (in_range_rra rrd.rrd_dss) rrd.rrd_rras - -let same_input_type vf vf' = - let open Rrd in - match vf vf' with - | VT_Unknown, VT_Unknown -> - true - | VT_Int64 _, VT_Int64 _ -> - true - | VT_Float _, VT_Float _ -> - true - | _ -> - false - -let cf = - Cb.choose - [ - Cb.const Rrd.CF_Average - ; Cb.const Rrd.CF_Min - ; Cb.const Rrd.CF_Max - ; Cb.const Rrd.CF_Last - ] - -let rra = - Cb.map [cf] (fun consolidation -> Rrd.rra_create consolidation 10 1 0.5) - -let ds_value = - Cb.choose - [Cb.const Rrd.VT_Unknown; Cb.map Cb.[int64] (fun v -> Rrd.VT_Int64 v)] - -(* Cast generated floats for min and max values to single-precision. - This is done because all values that get into the RRAs get converted - to single precision as well. In the case that one of these two values - cannot be represented with single-recision the values will clamp to - be infinity, leading to a comparison where the clamped value is out of range. - This is not an issue when normally running as there are no data sources which - such outrageous limits. -*) -let ds = - let open Rrd in - let ds_type = Cb.(choose [const Derive; const Absolute; const Gauge]) in - Cb.( - map [ds_value; float; float; ds_type] (fun v x y typ -> - let min, max = castd2s x y in - ds_create (ds_type_to_string typ) ~min ~max typ v - ) - ) - -let rrd = - Cb.(map [list1 int64; rra; ds]) (fun values rra ds -> - let open Rrd in - let init_time = 0. in - - let rrd = rrd_create [|ds|] [|rra|] 5L init_time in - - List.iteri - (fun i v -> - let t = 5. *. (init_time +. float_of_int i) in - ds_update rrd t [|VT_Int64 v|] [|Fun.id|] (i = 0) - ) - values ; - rrd - ) - -let () = Cb.add_test ~name:"Out-of-bounds rates in archives" [rrd] test_ranges diff --git a/ocaml/libs/xapi-rrd/lib_test/dune b/ocaml/libs/xapi-rrd/lib_test/dune deleted file mode 100644 index 2b1a00908bf..00000000000 --- a/ocaml/libs/xapi-rrd/lib_test/dune +++ /dev/null @@ -1,23 +0,0 @@ -(test - (name unit_tests) - (modules unit_tests) - (deps (source_tree test_data)) - (libraries - bigarray - alcotest - unix - xapi-rrd - xapi-stdext-unix - ) -) - -(test - (name crowbar_tests) - (modules crowbar_tests) - (libraries - bigarray - crowbar - unix - xapi-rrd - ) -) diff --git a/ocaml/libs/xapi-rrd/lib_test/test_data/flip_flop.xml b/ocaml/libs/xapi-rrd/lib_test/test_data/flip_flop.xml deleted file mode 100644 index 8e368ed41b7..00000000000 --- a/ocaml/libs/xapi-rrd/lib_test/test_data/flip_flop.xml +++ /dev/null @@ -1,2 +0,0 @@ - -00035100flip_flopDERIVEInfinity0Infinity00.00AVERAGE10.50000.00.00.00NaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaN0.01.0000-3.00003.0000-5.00005.0000-7.00007.0000-9.00009.0000-11.000011.0000-13.000013.0000-15.000015.0000-17.000017.0000-19.000019.0000MIN10.50000.00.019.00000NaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaN0.01.0000-3.0000-3.0000-5.0000-5.0000-7.0000-7.0000-9.0000-9.0000-11.0000-11.0000-13.0000-13.0000-15.0000-15.0000-17.0000-17.0000-19.0000-19.0000MAX10.50000.00.019.00000NaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaNNaN0.01.00001.00003.00003.00005.00005.00007.00007.00009.00009.000011.000011.000013.000013.000015.000015.000017.000017.000019.0000 diff --git a/ocaml/libs/xapi-rrd/lib_test/unit_tests.ml b/ocaml/libs/xapi-rrd/lib_test/unit_tests.ml deleted file mode 100644 index d1938b68a42..00000000000 --- a/ocaml/libs/xapi-rrd/lib_test/unit_tests.ml +++ /dev/null @@ -1,381 +0,0 @@ -open Rrd - -(* pick between absolute or relative tolerance of a number *) -let tolerance x = max 1e-4 (abs_float x *. 1e-12) - -let compare_float message x y = - Alcotest.(check @@ float @@ tolerance x) message x y - -let assert_ds_equal d1 d2 = - Alcotest.(check string) __LOC__ d1.ds_name d2.ds_name ; - assert (d1.ds_ty = d2.ds_ty) ; - compare_float __LOC__ d1.ds_min d2.ds_min ; - compare_float __LOC__ d1.ds_max d2.ds_max ; - compare_float __LOC__ d1.ds_mrhb d2.ds_mrhb ; - compare_float __LOC__ d1.ds_value d2.ds_value ; - compare_float __LOC__ d1.ds_unknown_sec d2.ds_unknown_sec - -let assert_dss_equal d1s d2s = - let d1s = Array.to_list d1s in - let d2s = Array.to_list d2s in - List.iter2 assert_ds_equal d1s d2s - -let assert_cdp_prep_equal c1 c2 = - compare_float __LOC__ c1.cdp_value c2.cdp_value ; - Alcotest.(check int) __LOC__ c1.cdp_unknown_pdps c2.cdp_unknown_pdps - -let assert_fring_equal f1 f2 = - for i = 0 to Fring.length f1 - 1 do - let peek1 = Fring.peek f1 i in - let peek2 = Fring.peek f2 i in - let msg = Printf.sprintf "Fring value must match: %f, %f" peek1 peek2 in - Alcotest.(check @@ float @@ tolerance peek1) msg peek1 peek2 - done - -let assert_rra_equal a1 a2 = - assert (a1.rra_cf = a2.rra_cf) ; - Alcotest.(check int) __LOC__ a1.rra_row_cnt a2.rra_row_cnt ; - Alcotest.(check int) __LOC__ a1.rra_pdp_cnt a2.rra_pdp_cnt ; - compare_float __LOC__ a1.rra_xff a2.rra_xff ; - List.iter2 assert_cdp_prep_equal - (Array.to_list a1.rra_cdps) - (Array.to_list a2.rra_cdps) ; - List.iter2 assert_fring_equal - (Array.to_list a1.rra_data) - (Array.to_list a2.rra_data) - -let assert_rras_equal a1s a2s = - List.iter2 assert_rra_equal (Array.to_list a1s) (Array.to_list a2s) - -let assert_rrds_equal r1 r2 = - compare_float __LOC__ r1.last_updated r2.last_updated ; - Alcotest.(check int64) __LOC__ r1.timestep r2.timestep ; - assert_dss_equal r1.rrd_dss r2.rrd_dss ; - assert_rras_equal r1.rrd_rras r2.rrd_rras - -let in_range min max values = - let between value = - if not (Utils.isnan value) then ( - Alcotest.(check bool) - (Printf.sprintf "value (%f) higher than min (%f); " value min) - true (min <= value) ; - Alcotest.(check bool) - (Printf.sprintf "value (%f) ≤ max (%f); " value max) - true (max >= value) - ) - in - List.iter between values - -let fring_to_list fring = Array.to_list @@ Fring.get fring - -(* Checks if all the values in the archives are within the limits set by the data sources - * Each archive (RRA) has a ring for each datasource (DS) *) -let test_ranges rrd () = - let in_range_fring ds fring = - in_range ds.ds_min ds.ds_max (fring_to_list fring) - in - let in_range_rra dss rra = - List.iter2 in_range_fring dss (Array.to_list rra.rra_data) - in - let range_is_not_empty ds = - Alcotest.(check bool) - (Printf.sprintf "min (%f) < max (%f); " ds.ds_min ds.ds_max) - true (ds.ds_min < ds.ds_max) - in - - Array.iter range_is_not_empty rrd.rrd_dss ; - List.iter - (in_range_rra @@ Array.to_list rrd.rrd_dss) - (Array.to_list rrd.rrd_rras) - -let test_marshall rrd ~json () = - ignore - ( if json then - Rrd.json_to_string rrd - else - let out = Buffer.create 2048 in - Rrd.xml_to_output rrd (Xmlm.make_output (`Buffer out)) ; - Buffer.contents out - ) - -let test_marshall_unmarshall rrd () = - let out = Buffer.create 2048 in - Rrd.xml_to_output rrd (Xmlm.make_output (`Buffer out)) ; - let contents = Buffer.contents out in - let xml = Xmlm.make_input (`String (0, contents)) in - let rrd' = Rrd.from_xml xml in - assert_rrds_equal rrd rrd' - -let test_export rrd () = - let check_same_as_rras (updates : Rrd_updates.row array) (rras : Rrd.rra array) - = - let cf_count = Array.length rras in - for i = 0 to cf_count - 1 do - (* consolidation functions *) - for j = 0 to Array.length rras.(0).Rrd.rra_data - 1 do - (* datasources *) - for k = 0 to Rrd_fring.length rras.(0).Rrd.rra_data.(0) - 1 do - (* time datapoints *) - let update_value = - updates.(k).Rrd_updates.row_data.(i + (j * cf_count)) - in - let rra_value = Rrd_fring.peek rras.(i).Rrd.rra_data.(j) k in - compare_float - (Printf.sprintf "CF: %d Datasource: %d datapoint: %d " i j k) - update_value rra_value - done - done - done - in - - let updates = Rrd_updates.(of_string @@ export [("", rrd)] 0L 5L None) in - check_same_as_rras updates.Rrd_updates.data rrd.rrd_rras - -let test_length_invariants rrd () = - let check_length_of_fring dss (frings : Rrd_fring.t array) = - Alcotest.(check int) - (Printf.sprintf - "Number of elements in Datasource (%d) must be the same as Frings in \ - a RRA (%d)" - (Array.length dss) (Array.length frings) - ) - (Array.length dss) (Array.length frings) - in - let check_length dss rra = check_length_of_fring dss rra.rra_data in - Array.iter (check_length rrd.rrd_dss) rrd.rrd_rras - -let gauge_rrd = - let rra = rra_create CF_Average 100 1 0.5 in - let rra2 = rra_create CF_Average 100 10 0.5 in - let rra3 = rra_create CF_Average 100 100 0.5 in - let rra4 = rra_create CF_Average 100 1000 0.5 in - let ds = ds_create "foo" Gauge ~mrhb:10.0 (VT_Float 0.0) in - let ds2 = ds_create "bar" Gauge ~mrhb:10.0 (VT_Float 0.0) in - let ds3 = ds_create "baz" Gauge ~mrhb:10.0 (VT_Float 0.0) in - let ds4 = ds_create "boo" Gauge ~mrhb:10.0 (VT_Float 0.0) in - let rrd = - rrd_create [|ds; ds2; ds3; ds4|] [|rra; rra2; rra3; rra4|] 1L 1000000000.0 - in - let id x = x in - for i = 1 to 100000 do - let t = 1000000000.0 +. (0.7 *. float_of_int i) in - let v1 = VT_Float (0.5 +. (0.5 *. sin (t /. 10.0))) in - let v2 = VT_Float (1.5 +. (0.5 *. cos (t /. 80.0))) in - let v3 = VT_Float (3.5 +. (0.5 *. sin (t /. 700.0))) in - let v4 = VT_Float (6.5 +. (0.5 *. cos (t /. 5000.0))) in - ds_update rrd t [|v1; v2; v3; v4|] [|id; id; id; id|] false - done ; - rrd - -let of_file filename = - let body = Xapi_stdext_unix.Unixext.string_of_file filename in - let input = Xmlm.make_input (`String (0, body)) in - Rrd.from_xml input - -(* Used to generate flip_flop.xml for test_ca_325844, - * then gets edited manually to set min to 0 *) -let deserialize_verify_rrd = - let init_time = 0. in - - let rra1 = rra_create CF_Average 100 1 0.5 in - let rra2 = rra_create CF_Min 100 1 0.5 in - let rra3 = rra_create CF_Max 100 1 0.5 in - let ds = ds_create "flip_flop" Derive (VT_Int64 0L) in - - let rrd = rrd_create [|ds|] [|rra1; rra2; rra3|] 5L init_time in - - let id x = x in - for i = 1 to 100 do - let t = init_time +. float_of_int i in - let t64 = Int64.of_float t in - let v = VT_Int64 Int64.(mul t64 (mul (-1L) (rem t64 2L))) in - ds_update rrd t [|v|] [|id|] false - done ; - rrd - -let ca_322008_rrd = - let init_time = 0. in - - let rra1 = rra_create CF_Average 100 1 0.5 in - let rra2 = rra_create CF_Min 100 1 0.5 in - let rra3 = rra_create CF_Max 100 1 0.5 in - let ds = ds_create "even or zero" Derive ~min:0. (VT_Int64 0L) in - - let rrd = rrd_create [|ds|] [|rra1; rra2; rra3|] 5L init_time in - - let id x = x in - - for i = 1 to 100000 do - let t = init_time +. float_of_int i in - let t64 = Int64.of_float t in - let v = VT_Int64 (Int64.mul t64 (Int64.rem t64 2L)) in - ds_update rrd t [|v|] [|id|] false - done ; - rrd - -let ca_329043_rrd_1 = - let init_time = 0. in - - let rra1 = rra_create CF_Average 3 1 0.5 in - let rra2 = rra_create CF_Min 3 1 0.5 in - let rra3 = rra_create CF_Max 3 1 0.5 in - let ds = ds_create "derive_with_min" ~min:0. ~max:1. Derive VT_Unknown in - - let rrd = rrd_create [|ds|] [|rra1; rra2; rra3|] 5L init_time in - - let id x = x in - - let time_value_of_i i = - let t = 5. *. (init_time +. float_of_int i) in - if i = 1 then - (t, VT_Int64 0L) - else - (t, VT_Int64 Int64.(of_float t)) - in - for i = 0 to 4 do - let t, v = time_value_of_i i in - ds_update rrd t [|v|] [|id|] (i = 0) - done ; - rrd - -let create_rrd ?(rows = 2) values min max = - let init_time = 0. in - - let rra1 = rra_create CF_Average rows 10 0.5 in - let rra2 = rra_create CF_Min rows 10 0.5 in - let rra3 = rra_create CF_Max rows 10 0.5 in - let rra4 = rra_create CF_Last rows 10 0.5 in - let ds1 = ds_create "derive" ~min ~max Derive VT_Unknown in - let ds2 = ds_create "absolute" ~min ~max Derive VT_Unknown in - let ds3 = ds_create "gauge" ~min ~max Derive VT_Unknown in - - let rrd = - rrd_create [|ds1; ds2; ds3|] [|rra1; rra2; rra3; rra4|] 5L init_time - in - - let id x = x in - - List.iteri - (fun i v -> - let t = 5. *. (init_time +. float_of_int i) in - ds_update rrd t [|VT_Int64 v|] [|id; id; id; id|] (i = 0) - ) - values ; - rrd - -let ca_329043_rrd_2 = - create_rrd - [-3710420213458133667L; -4382108469022348614L] - (-115833951388699606673086965578224992861890232359671476890007240704.000000) - (-13815257.710330) - -let ca_329813_rrd = - let rrd = create_rrd [0L; 5L; 10L] 0. 1. in - let new_ds = ds_create "new!" Derive VT_Unknown in - Rrd.rrd_add_ds rrd rrd.last_updated new_ds - -let test_ca_322008 () = - let rrd = ca_322008_rrd in - - (* Check against the maximum reasonable value of this series, - * the time in seconds when it was last updated, setting max - * value may cause the bug to not trigger *) - let in_range_fring ds fring = - in_range ds.ds_min rrd.last_updated (fring_to_list fring) - in - let in_range_rra dss rra = - List.iter2 in_range_fring dss (Array.to_list rra.rra_data) - in - List.iter (in_range_rra @@ Array.to_list rrd.rrd_dss) - @@ Array.to_list rrd.rrd_rras - -let test_ca_325844 () = - let rrd = of_file (Filename.concat "test_data" "flip_flop.xml") in - test_ranges rrd () - -let suite_create_multi = - let module RU = Rrd_updates in - let assert_size t = - (* we can't to check that the number of rows is consistent, - since this is defined purely by the number of rows - the number of columns should match the number of items in the legend - - each element in the legend array defines the contents for one column *) - let num_cols_in_legend = Array.length t.RU.legend in - t.RU.data - |> Array.iteri (fun i r -> - Alcotest.(check int) - (Printf.sprintf - "number of cols in legend must matche number of cols in row[%i]" - i - ) - num_cols_in_legend - (Array.length r.RU.row_data) - ) - in - let test_no_rrds () = - Alcotest.check_raises "should raise error" No_RRA_Available (fun () -> - let _ = RU.create_multi [] 0L 1L None in - () - ) - in - (* confusingly, rows in an rra are used to define the cols in the rrd_updates/ xml... - essentially we usually expect 'rows' in each rrd to be the same (test_rows_with_same_num_cols) - however, we should also handle the case where they are not (test_rows_with_different_num_cols) *) - let valid_rrd_tests = - [ - ("one_rrd", [create_rrd ~rows:2 [0L; 5L; 10L] 0. 1.]) - ; ( "rows_with_same_num_cols" - , [ - create_rrd ~rows:3 [0L; 5L; 10L] 0. 1. - ; create_rrd ~rows:3 [1L; 6L; 11L] 0. 1. - ] - ) - ; ( "rows_with_different_num_cols" - , [ - create_rrd ~rows:3 [0L; 5L; 10L] 0. 1. - ; create_rrd ~rows:2 [1L; 6L; 11L] 0. 1. - ] - ) - ] - |> List.map (fun (name, rrds) -> - ( name - , `Quick - , fun () -> - let rrds = - List.mapi (fun i rrd -> (Printf.sprintf "row[%i]" i, rrd)) rrds - in - RU.create_multi rrds 0L 1L None |> assert_size - ) - ) - in - ("no rrds", `Quick, test_no_rrds) :: valid_rrd_tests - -let rrd_suite rrd = - [ - ("Save xml to disk", `Quick, test_marshall ~json:false rrd) - ; ("Save json to disk", `Quick, test_marshall ~json:true rrd) - ; (* there is no json deserializer implementation *) - ("Save and restore from disk", `Quick, test_marshall_unmarshall rrd) - ; ("Length invariants", `Quick, test_length_invariants rrd) - ; ("Values in range", `Quick, test_ranges rrd) - ] - -let regression_suite = - [ - ("CA-322008", `Quick, test_ca_322008) - ; ("CA-325844", `Quick, test_ca_325844) - ; ("CA-329043 (1)", `Quick, test_ranges ca_329043_rrd_1) - ; ("CA-329043 (2)", `Quick, test_ranges ca_329043_rrd_2) - ; ("CA-329813", `Quick, test_ranges ca_329813_rrd) - ] - -let () = - Alcotest.run "Test RRD library" - [ - ("Gauge RRD", rrd_suite gauge_rrd) - ; ("RRD for CA-322008", rrd_suite ca_322008_rrd) - ; ("RRD for CA-329043", rrd_suite ca_329043_rrd_1) - ; ("RRD for CA-329813", rrd_suite ca_329813_rrd) - ; ("CP-33354", suite_create_multi) - ; ("Regressions", regression_suite) - ] diff --git a/ocaml/libs/xapi-rrd/unix/dune b/ocaml/libs/xapi-rrd/unix/dune deleted file mode 100644 index 0a6b533348f..00000000000 --- a/ocaml/libs/xapi-rrd/unix/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name rrd_unix) - (public_name xapi-rrd.unix) - (wrapped false) - (libraries - unix - uuidm - xapi-rrd - xapi-stdext-pervasives - xmlm - ) -) diff --git a/ocaml/libs/xapi-rrd/unix/rrd_unix.ml b/ocaml/libs/xapi-rrd/unix/rrd_unix.ml deleted file mode 100644 index da91c99fd65..00000000000 --- a/ocaml/libs/xapi-rrd/unix/rrd_unix.ml +++ /dev/null @@ -1,41 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -(* - * RRD Unix module - * This module provides Unix tools for dealing with RRDs - *) -(** - * @group Performance Monitoring -*) - -let finally = Xapi_stdext_pervasives.Pervasiveext.finally - -let with_out_channel_output fd f = - let oc = Unix.(out_channel_of_descr (dup fd)) in - finally - (fun () -> - let output = Xmlm.make_output (`Channel oc) in - f output - ) - (fun () -> Out_channel.close_noerr oc) - -let xml_to_fd rrd fd = with_out_channel_output fd (Rrd.xml_to_output rrd) - -let json_to_fd rrd fd = - let payload = Rrd.json_to_string rrd |> Bytes.unsafe_of_string in - let len = Bytes.length payload in - Unix.write fd payload 0 len |> ignore - -let to_fd ?(json = false) rrd fd = - (if json then json_to_fd else xml_to_fd) rrd fd diff --git a/ocaml/libs/xapi-rrd/unix/rrd_unix.mli b/ocaml/libs/xapi-rrd/unix/rrd_unix.mli deleted file mode 100644 index bddb4553413..00000000000 --- a/ocaml/libs/xapi-rrd/unix/rrd_unix.mli +++ /dev/null @@ -1,19 +0,0 @@ -(* - Copyright (C) Citrix Systems Inc. - - This program 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; version 2.1 only. with the special - exception on linking described in file LICENSE. - - 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 Lesser General Public License for more details. - *) -(** RRD Unix module - This module provides Unix tools for dealing with RRDs - *) - -val to_fd : ?json:bool -> Rrd.rrd -> Unix.file_descr -> unit -(** Serialize the rrd to xml / json and offer it through a file descriptor *) diff --git a/ocaml/libs/xapi-stdext/.gitignore b/ocaml/libs/xapi-stdext/.gitignore deleted file mode 100644 index 4e66100e8f3..00000000000 --- a/ocaml/libs/xapi-stdext/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -_build/ -*.install -.merlin diff --git a/ocaml/libs/xapi-stdext/CHANGES.md b/ocaml/libs/xapi-stdext/CHANGES.md deleted file mode 100644 index 0973572d6da..00000000000 --- a/ocaml/libs/xapi-stdext/CHANGES.md +++ /dev/null @@ -1,149 +0,0 @@ -## v4.24.0 (17-Jan-2024) -- unix: really_read now retries reads on EINTR -- std: add Listext.List.find_minimum - -## v4.23.0 (30-Oct-2023) -- unix: fix blkgetsize return type mismatch (CA-382014) -- unix: add function to recursively remove files - -## v4.22.0 (24-May-2023) -- date, pervasive, std: remove deprecated code -- encodings: Optimize XML_UTF8.is_valid: avoid allocating an int32 for each unicode codepoint - -## v4.21.0 (29-Nov-2022) - - unix: add permissions to write_{bytes,string}_to_file - - Use a dune version with fixed metadata generation - - threads, unix: avoid using C functions deprecated in OCaml 5 - - Avoid warnings and add the check to detect them to the CI - - zerocheck: remove wrong, unused code. It was dangerous to leave it available - -## v4.20.0 (17-Nov-2022) - - date: consolidate the types into a single t - - date: add conversion functions that have semantic meaning, the previous functions containing 'float' and 'string' will be deprecated in a future release. - -## v4.19.0 (17-Jun-2022) - - maintenance: give a name to the project - - threads: Remove all the modules except Mutex - - Add license to opam metadata, remove unused opam files - -## v4.18.0 (15-Jun-2021) - - CP-31119: Enable documentation upload - - CP-31119: Prepare to generate documentation - - CP-34643: Prepare doc comments for odoc - - CP-34643: Reorder functions in listext interface - - CP-34643: drop deprecated methods from listext - - unix: remove unused stdext-std dependency - -## v4.17.0 (01-Mar-2021) - - listext: avoid traversing list twice on assoc_default - - maintenance: format with ocamlformat - - maintenance: prepare for ocamlformat - - CP-34643: listext: add drop function, rework some functions - - CP-34643: add unit tests for listext - - CP-34643: Listext: deprecate functions in Stdlib.List - - CP-34643: listext: remove implementations for functions in Stdlib.List - -## v4.16.0 (29-Dec-2020) - - ci: remove travis workflow - - Create ocaml-ci.yml - - date: allow timezones other than UTC for printing - - XSI-894 date.iso8601.to_float should assume UTC - -## v4.15.0 (14-Dec-2020) - - XSI-894 handle iso8601's with no timezone - - maintenance: format xstringext files with ocamlformat - - xapi-stdext-std: Do not duplicate functions from Stdlib - - CP-34643: add tests for xstringext - - maintenance: reformat pervasivesext with ocamlformat - - CP-34643: Deprecated non-idiomatic pervasivesext functions - - unixext: remove Fdset module and stubs - -## v4.14.0 (11-Aug-2020) - - CP-33121: Move encodings test to the package directory - - CP-33121: remove dependency of date in encodings tests - -## v4.13.0 (11-Aug-2020) - - CA-342171 allow clients to create an iso8601 from localtime - -## v4.12.0 (24-Jul-2020) - - CP-33121: run encodings tests as part of the encodings package - - maintenance: update travis config - - maintenance: prepare for ocamlformat - - CP-33121: remove obsoleted modules and packages - -## v4.11.0 (24-Apr-2020) - - CA-338243 remove legacy variant in iso8601 - -## v4.09.0 (23-Apr-2020) - - CA-338243 iso8601.to_string backwards compatibility - -## v4.8.0 (15-Apr-2020) - - CA-333908 accept YYYY-MM-DD date format - - unixext: better description for write___to_file - - fixup! CP-32686: Ensure durability with atomic_write_to_file - - fixup! CP-32686: Ensure durability with atomic_write_to_file - - maintenance: whitespace - - CP-32686: Ensure durability with atomic_write_to_file - - ci: use environment vars from xs-opam - - ci: do do not pin base64, it doesn't exist - -## v4.7.0 (04-Jun-2019) - - CP-30756: Remove Base64 - -## v4.6.0 (02-Apr-2019) -- CA-314001: release runtime lock around long running system calls - -## v4.5.0 (13-Mar-2019) - - Update .travis.yml - - CA-310525 fix C binding for statvfs - -## 4.4.1 (21-Jan-2019) - - Replaced jbuild files with dune. - -## 4.4.0 (05-Jul-2018): -- xapi-stdext-pervasives only -* CA-292641: Use Logs to log cleanup exn instead of shadowing the original one with it - -## 4.3.0 (30-May-2018): -* CP-28365: improve backtraces by using finally - -## 4.2.0 (25-May-2018): -- xapi-stdext-unix only -* unixext: update interface to mimick the ocaml Unix one - -## 4.1.0 (25-Apr-2018): -- xapi-stdext-unix only -* really_write: - - use single_write_substring and avoid an unsafe coercion - - remove deprecation and make robust against EINTR -* unixext_open_stubs: fix use of uninitialised variable - -## 4.0.0 (15-Mar-2018): -* Make safe-string safe (xap-stdext-{bigbuffer, encodings, std, threads, unix} 1.1.0) -* Remove bigbuffer from the default stdext set of packages -* Use backward compatible naming for stdext xapi-stdext - -## 3.0.0 (02-Aug-2017): -* Remove unused packages -* Refactor in a backward compatible wrapper and 12 new separate libraries (see https://github.com/xapi-project/stdext/pull/21) -* Port to jbuilder - -## 2.1.0 (20-Oct-2016): -* New Semaphore module - -## 2.0.0 (22-Jun-2016): -* Namespace everything under Stdext. This is a backwards incompatible change. - -## 0.13.0 (20-Nov-2014): -* Depend on Backtrace from xapi-backtrace -* Add an opam file - -## 0.12.0 (26-Sep-2014): -* Fix build errors on OS X - -## 0.11.0 (30-May-2013): -* Change Stringext module to Xstringext to avoid conflict with other packages - -## 0.9.1 (10-Sep-2013): -* Add Unixext.domain_of_addr -* Add String.sub_{before,after} - -## 0.9.0 (3-Jun-2013): -* first public release diff --git a/ocaml/libs/xapi-stdext/LICENSE b/ocaml/libs/xapi-stdext/LICENSE deleted file mode 100644 index 1b1ce97cb5c..00000000000 --- a/ocaml/libs/xapi-stdext/LICENSE +++ /dev/null @@ -1,521 +0,0 @@ -This repository is distributed under the terms of the GNU Lesser General -Public License version 2.1 (included below). - -As a special exception to the GNU Lesser General Public License, you -may link, statically or dynamically, a "work that uses the Library" -with a publicly distributed version of the Library to produce an -executable file containing portions of the Library, and distribute -that executable file under terms of your choice, without any of the -additional requirements listed in clause 6 of the GNU Lesser General -Public License. By "a publicly distributed version of the Library", -we mean either the unmodified Library as distributed, or a -modified version of the Library that is distributed under the -conditions defined in clause 3 of the GNU Library General Public -License. This exception does not however invalidate any other reasons -why the executable file might be covered by the GNU Lesser General -Public License. - ------------- - - GNU LESSER GENERAL PUBLIC LICENSE - Version 2.1, February 1999 - - Copyright (C) 1991, 1999 Free Software Foundation, Inc. - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -[This is the first released version of the Lesser GPL. It also counts - as the successor of the GNU Library Public License, version 2, hence - the version number 2.1.] - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -Licenses are intended to guarantee your freedom to share and change -free software--to make sure the software is free for all its users. - - This license, the Lesser General Public License, applies to some -specially designated software packages--typically libraries--of the -Free Software Foundation and other authors who decide to use it. You -can use it too, but we suggest you first think carefully about whether -this license or the ordinary General Public License is the better -strategy to use in any particular case, based on the explanations below. - - When we speak of free software, we are referring to freedom of use, -not price. Our General Public Licenses are designed to make sure that -you have the freedom to distribute copies of free software (and charge -for this service if you wish); that you receive source code or can get -it if you want it; that you can change the software and use pieces of -it in new free programs; and that you are informed that you can do -these things. - - To protect your rights, we need to make restrictions that forbid -distributors to deny you these rights or to ask you to surrender these -rights. These restrictions translate to certain responsibilities for -you if you distribute copies of the library or if you modify it. - - For example, if you distribute copies of the library, whether gratis -or for a fee, you must give the recipients all the rights that we gave -you. You must make sure that they, too, receive or can get the source -code. If you link other code with the library, you must provide -complete object files to the recipients, so that they can relink them -with the library after making changes to the library and recompiling -it. And you must show them these terms so they know their rights. - - We protect your rights with a two-step method: (1) we copyright the -library, and (2) we offer you this license, which gives you legal -permission to copy, distribute and/or modify the library. - - To protect each distributor, we want to make it very clear that -there is no warranty for the free library. Also, if the library is -modified by someone else and passed on, the recipients should know -that what they have is not the original version, so that the original -author's reputation will not be affected by problems that might be -introduced by others. - - Finally, software patents pose a constant threat to the existence of -any free program. We wish to make sure that a company cannot -effectively restrict the users of a free program by obtaining a -restrictive license from a patent holder. Therefore, we insist that -any patent license obtained for a version of the library must be -consistent with the full freedom of use specified in this license. - - Most GNU software, including some libraries, is covered by the -ordinary GNU General Public License. This license, the GNU Lesser -General Public License, applies to certain designated libraries, and -is quite different from the ordinary General Public License. We use -this license for certain libraries in order to permit linking those -libraries into non-free programs. - - When a program is linked with a library, whether statically or using -a shared library, the combination of the two is legally speaking a -combined work, a derivative of the original library. The ordinary -General Public License therefore permits such linking only if the -entire combination fits its criteria of freedom. The Lesser General -Public License permits more lax criteria for linking other code with -the library. - - We call this license the "Lesser" General Public License because it -does Less to protect the user's freedom than the ordinary General -Public License. It also provides other free software developers Less -of an advantage over competing non-free programs. These disadvantages -are the reason we use the ordinary General Public License for many -libraries. However, the Lesser license provides advantages in certain -special circumstances. - - For example, on rare occasions, there may be a special need to -encourage the widest possible use of a certain library, so that it becomes -a de-facto standard. To achieve this, non-free programs must be -allowed to use the library. A more frequent case is that a free -library does the same job as widely used non-free libraries. In this -case, there is little to gain by limiting the free library to free -software only, so we use the Lesser General Public License. - - In other cases, permission to use a particular library in non-free -programs enables a greater number of people to use a large body of -free software. For example, permission to use the GNU C Library in -non-free programs enables many more people to use the whole GNU -operating system, as well as its variant, the GNU/Linux operating -system. - - Although the Lesser General Public License is Less protective of the -users' freedom, it does ensure that the user of a program that is -linked with the Library has the freedom and the wherewithal to run -that program using a modified version of the Library. - - The precise terms and conditions for copying, distribution and -modification follow. Pay close attention to the difference between a -"work based on the library" and a "work that uses the library". The -former contains code derived from the library, whereas the latter must -be combined with the library in order to run. - - GNU LESSER GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License Agreement applies to any software library or other -program which contains a notice placed by the copyright holder or -other authorized party saying it may be distributed under the terms of -this Lesser General Public License (also called "this License"). -Each licensee is addressed as "you". - - A "library" means a collection of software functions and/or data -prepared so as to be conveniently linked with application programs -(which use some of those functions and data) to form executables. - - The "Library", below, refers to any such software library or work -which has been distributed under these terms. A "work based on the -Library" means either the Library or any derivative work under -copyright law: that is to say, a work containing the Library or a -portion of it, either verbatim or with modifications and/or translated -straightforwardly into another language. (Hereinafter, translation is -included without limitation in the term "modification".) - - "Source code" for a work means the preferred form of the work for -making modifications to it. For a library, complete source code means -all the source code for all modules it contains, plus any associated -interface definition files, plus the scripts used to control compilation -and installation of the library. - - Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running a program using the Library is not restricted, and output from -such a program is covered only if its contents constitute a work based -on the Library (independent of the use of the Library in a tool for -writing it). Whether that is true depends on what the Library does -and what the program that uses the Library does. - - 1. You may copy and distribute verbatim copies of the Library's -complete source code as you receive it, in any medium, provided that -you conspicuously and appropriately publish on each copy an -appropriate copyright notice and disclaimer of warranty; keep intact -all the notices that refer to this License and to the absence of any -warranty; and distribute a copy of this License along with the -Library. - - You may charge a fee for the physical act of transferring a copy, -and you may at your option offer warranty protection in exchange for a -fee. - - 2. You may modify your copy or copies of the Library or any portion -of it, thus forming a work based on the Library, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) The modified work must itself be a software library. - - b) You must cause the files modified to carry prominent notices - stating that you changed the files and the date of any change. - - c) You must cause the whole of the work to be licensed at no - charge to all third parties under the terms of this License. - - d) If a facility in the modified Library refers to a function or a - table of data to be supplied by an application program that uses - the facility, other than as an argument passed when the facility - is invoked, then you must make a good faith effort to ensure that, - in the event an application does not supply such function or - table, the facility still operates, and performs whatever part of - its purpose remains meaningful. - - (For example, a function in a library to compute square roots has - a purpose that is entirely well-defined independent of the - application. Therefore, Subsection 2d requires that any - application-supplied function or table used by this function must - be optional: if the application does not supply it, the square - root function must still compute square roots.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Library, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Library, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote -it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Library. - -In addition, mere aggregation of another work not based on the Library -with the Library (or with a work based on the Library) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may opt to apply the terms of the ordinary GNU General Public -License instead of this License to a given copy of the Library. To do -this, you must alter all the notices that refer to this License, so -that they refer to the ordinary GNU General Public License, version 2, -instead of to this License. (If a newer version than version 2 of the -ordinary GNU General Public License has appeared, then you can specify -that version instead if you wish.) Do not make any other change in -these notices. - - Once this change is made in a given copy, it is irreversible for -that copy, so the ordinary GNU General Public License applies to all -subsequent copies and derivative works made from that copy. - - This option is useful when you wish to copy part of the code of -the Library into a program that is not a library. - - 4. You may copy and distribute the Library (or a portion or -derivative of it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you accompany -it with the complete corresponding machine-readable source code, which -must be distributed under the terms of Sections 1 and 2 above on a -medium customarily used for software interchange. - - If distribution of object code is made by offering access to copy -from a designated place, then offering equivalent access to copy the -source code from the same place satisfies the requirement to -distribute the source code, even though third parties are not -compelled to copy the source along with the object code. - - 5. A program that contains no derivative of any portion of the -Library, but is designed to work with the Library by being compiled or -linked with it, is called a "work that uses the Library". Such a -work, in isolation, is not a derivative work of the Library, and -therefore falls outside the scope of this License. - - However, linking a "work that uses the Library" with the Library -creates an executable that is a derivative of the Library (because it -contains portions of the Library), rather than a "work that uses the -library". The executable is therefore covered by this License. -Section 6 states terms for distribution of such executables. - - When a "work that uses the Library" uses material from a header file -that is part of the Library, the object code for the work may be a -derivative work of the Library even though the source code is not. -Whether this is true is especially significant if the work can be -linked without the Library, or if the work is itself a library. The -threshold for this to be true is not precisely defined by law. - - If such an object file uses only numerical parameters, data -structure layouts and accessors, and small macros and small inline -functions (ten lines or less in length), then the use of the object -file is unrestricted, regardless of whether it is legally a derivative -work. (Executables containing this object code plus portions of the -Library will still fall under Section 6.) - - Otherwise, if the work is a derivative of the Library, you may -distribute the object code for the work under the terms of Section 6. -Any executables containing that work also fall under Section 6, -whether or not they are linked directly with the Library itself. - - 6. As an exception to the Sections above, you may also combine or -link a "work that uses the Library" with the Library to produce a -work containing portions of the Library, and distribute that work -under terms of your choice, provided that the terms permit -modification of the work for the customer's own use and reverse -engineering for debugging such modifications. - - You must give prominent notice with each copy of the work that the -Library is used in it and that the Library and its use are covered by -this License. You must supply a copy of this License. If the work -during execution displays copyright notices, you must include the -copyright notice for the Library among them, as well as a reference -directing the user to the copy of this License. Also, you must do one -of these things: - - a) Accompany the work with the complete corresponding - machine-readable source code for the Library including whatever - changes were used in the work (which must be distributed under - Sections 1 and 2 above); and, if the work is an executable linked - with the Library, with the complete machine-readable "work that - uses the Library", as object code and/or source code, so that the - user can modify the Library and then relink to produce a modified - executable containing the modified Library. (It is understood - that the user who changes the contents of definitions files in the - Library will not necessarily be able to recompile the application - to use the modified definitions.) - - b) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (1) uses at run time a - copy of the library already present on the user's computer system, - rather than copying library functions into the executable, and (2) - will operate properly with a modified version of the library, if - the user installs one, as long as the modified version is - interface-compatible with the version that the work was made with. - - c) Accompany the work with a written offer, valid for at - least three years, to give the same user the materials - specified in Subsection 6a, above, for a charge no more - than the cost of performing this distribution. - - d) If distribution of the work is made by offering access to copy - from a designated place, offer equivalent access to copy the above - specified materials from the same place. - - e) Verify that the user has already received a copy of these - materials or that you have already sent this user a copy. - - For an executable, the required form of the "work that uses the -Library" must include any data and utility programs needed for -reproducing the executable from it. However, as a special exception, -the materials to be distributed need not include anything that is -normally distributed (in either source or binary form) with the major -components (compiler, kernel, and so on) of the operating system on -which the executable runs, unless that component itself accompanies -the executable. - - It may happen that this requirement contradicts the license -restrictions of other proprietary libraries that do not normally -accompany the operating system. Such a contradiction means you cannot -use both them and the Library together in an executable that you -distribute. - - 7. You may place library facilities that are a work based on the -Library side-by-side in a single library together with other library -facilities not covered by this License, and distribute such a combined -library, provided that the separate distribution of the work based on -the Library and of the other library facilities is otherwise -permitted, and provided that you do these two things: - - a) Accompany the combined library with a copy of the same work - based on the Library, uncombined with any other library - facilities. This must be distributed under the terms of the - Sections above. - - b) Give prominent notice with the combined library of the fact - that part of it is a work based on the Library, and explaining - where to find the accompanying uncombined form of the same work. - - 8. You may not copy, modify, sublicense, link with, or distribute -the Library except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense, link with, or -distribute the Library is void, and will automatically terminate your -rights under this License. However, parties who have received copies, -or rights, from you under this License will not have their licenses -terminated so long as such parties remain in full compliance. - - 9. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Library or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Library (or any work based on the -Library), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Library or works based on it. - - 10. Each time you redistribute the Library (or any work based on the -Library), the recipient automatically receives a license from the -original licensor to copy, distribute, link with or modify the Library -subject to these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties with -this License. - - 11. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Library at all. For example, if a patent -license would not permit royalty-free redistribution of the Library by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Library. - -If any portion of this section is held invalid or unenforceable under any -particular circumstance, the balance of the section is intended to apply, -and the section as a whole is intended to apply in other circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 12. If the distribution and/or use of the Library is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Library under this License may add -an explicit geographical distribution limitation excluding those countries, -so that distribution is permitted only in or among countries not thus -excluded. In such case, this License incorporates the limitation as if -written in the body of this License. - - 13. The Free Software Foundation may publish revised and/or new -versions of the Lesser General Public License from time to time. -Such new versions will be similar in spirit to the present version, -but may differ in detail to address new problems or concerns. - -Each version is given a distinguishing version number. If the Library -specifies a version number of this License which applies to it and -"any later version", you have the option of following the terms and -conditions either of that version or of any later version published by -the Free Software Foundation. If the Library does not specify a -license version number, you may choose any version ever published by -the Free Software Foundation. - - 14. If you wish to incorporate parts of the Library into other free -programs whose distribution conditions are incompatible with these, -write to the author to ask for permission. For software which is -copyrighted by the Free Software Foundation, write to the Free -Software Foundation; we sometimes make exceptions for this. Our -decision will be guided by the two goals of preserving the free status -of all derivatives of our free software and of promoting the sharing -and reuse of software generally. - - NO WARRANTY - - 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO -WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. -EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR -OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY -KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE -LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME -THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN -WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY -AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU -FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR -CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE -LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING -RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A -FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Libraries - - If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms of the -ordinary General Public License). - - To apply these terms, attach the following notices to the library. It is -safest to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - 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.1 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 - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the library, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James Random Hacker. - - , 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! diff --git a/ocaml/libs/xapi-stdext/README.md b/ocaml/libs/xapi-stdext/README.md deleted file mode 100644 index 258f7cb3732..00000000000 --- a/ocaml/libs/xapi-stdext/README.md +++ /dev/null @@ -1,11 +0,0 @@ -Deprecated misc utility functions -================================= - -These utility functions are used by several other services. Much of this -should be replaced with other libraries such as - * Stdlib - * Bos - -Eventually this library should disappear. - -In the meantime documentation can be found at http://xapi-project.github.io/stdext/index.html diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.ml deleted file mode 100644 index 77f3994fe68..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.ml +++ /dev/null @@ -1,189 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -let months = - [| - "Jan" - ; "Feb" - ; "Mar" - ; "Apr" - ; "May" - ; "Jun" - ; "Jul" - ; "Aug" - ; "Sep" - ; "Oct" - ; "Nov" - ; "Dec" - |] - -let days = [|"Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"|] - -type print_timezone = Empty | TZ of string - -(* we must store the print_type with iso8601 to handle the case where the local time zone is UTC *) -type t = Ptime.date * Ptime.time * print_timezone - -let utc = TZ "Z" - -let of_dt print_type dt = - let date, time = dt in - (date, time, print_type) - -let to_dt (date, time, _) = (date, time) - -let best_effort_iso8601_to_rfc3339 x = - (* (a) add dashes - * (b) add UTC tz if no tz provided *) - let x = - try - Scanf.sscanf x "%04d%02d%02dT%s" (fun y mon d rest -> - Printf.sprintf "%04d-%02d-%02dT%s" y mon d rest - ) - with _ -> x - in - let tz = - try - Scanf.sscanf x "%04d-%02d-%02dT%02d:%02d:%02d%s" (fun _ _ _ _ _ _ tz -> - Some tz - ) - with _ -> None - in - match tz with - | None | Some "" -> - (* the caller didn't specify a tz. we must try to add one so that ptime can at least attempt to parse *) - (Printf.sprintf "%sZ" x, Empty) - | Some tz -> - (x, TZ tz) - -let of_iso8601 x = - let rfc3339, print_timezone = best_effort_iso8601_to_rfc3339 x in - match Ptime.of_rfc3339 rfc3339 |> Ptime.rfc3339_error_to_msg with - | Error _ -> - invalid_arg (Printf.sprintf "%s: %s" __FUNCTION__ x) - | Ok (t, tz, _) -> ( - match tz with - | None | Some 0 -> - Ptime.to_date_time t |> of_dt print_timezone - | Some _ -> - invalid_arg (Printf.sprintf "%s: %s" __FUNCTION__ x) - ) - -let to_rfc3339 ((y, mon, d), ((h, min, s), _), print_type) = - match print_type with - | TZ tz -> - Printf.sprintf "%04i%02i%02iT%02i:%02i:%02i%s" y mon d h min s tz - | Empty -> - Printf.sprintf "%04i%02i%02iT%02i:%02i:%02i" y mon d h min s - -let weekday ~year ~mon ~day = - let a = (14 - mon) / 12 in - let y = year - a in - let m = mon + (12 * a) - 2 in - (day + y + (y / 4) - (y / 100) + (y / 400) + (31 * m / 12)) mod 7 - -let to_rfc822 ((year, mon, day), ((h, min, s), _), print_type) = - let timezone = - match print_type with Empty | TZ "Z" -> "GMT" | TZ tz -> tz - in - let weekday = weekday ~year ~mon ~day in - Printf.sprintf "%s, %d %s %d %02d:%02d:%02d %s" days.(weekday) day - months.(mon - 1) - year h min s timezone - -let to_ptime_t t = - match to_dt t |> Ptime.of_date_time with - | Some t -> - t - | None -> - let _, (_, offset), _ = t in - invalid_arg - (Printf.sprintf "%s: dt='%s', offset='%i' is invalid" __FUNCTION__ - (to_rfc3339 t) offset - ) - -let to_ptime = to_ptime_t - -let of_ptime t = Ptime.to_date_time t |> of_dt utc - -let of_unix_time s = - match Ptime.of_float_s s with - | None -> - invalid_arg (Printf.sprintf "%s: %f" __FUNCTION__ s) - | Some t -> - of_ptime t - -let to_unix_time t = to_ptime_t t |> Ptime.to_float_s - -let _localtime current_tz_offset t = - let tz_offset_s = current_tz_offset |> Option.value ~default:0 in - let localtime = t |> Ptime.to_date_time ~tz_offset_s |> of_dt Empty in - let _, (_, localtime_offset), _ = localtime in - if localtime_offset <> tz_offset_s then - invalid_arg - (Printf.sprintf "%s: offsets don't match. offset='%i', t='%s'" - __FUNCTION__ tz_offset_s (Ptime.to_rfc3339 t) - ) ; - localtime - -let _localtime_string current_tz_offset t = - _localtime current_tz_offset t |> to_rfc3339 - -let localtime () = - _localtime (Ptime_clock.current_tz_offset_s ()) (Ptime_clock.now ()) - -let now () = of_ptime (Ptime_clock.now ()) - -let epoch = of_ptime Ptime.epoch - -let is_earlier ~than t = Ptime.is_earlier ~than:(to_ptime than) (to_ptime t) - -let is_later ~than t = Ptime.is_later ~than:(to_ptime than) (to_ptime t) - -let diff a b = Ptime.diff (to_ptime a) (to_ptime b) - -let compare_print_tz a b = - match (a, b) with - | Empty, Empty -> - 0 - | TZ a_s, TZ b_s -> - String.compare a_s b_s - | Empty, TZ _ -> - -1 - | TZ _, Empty -> - 1 - -let compare ((_, _, a_z) as a) ((_, _, b_z) as b) = - let ( ) a b = if a = 0 then b else a in - Ptime.compare (to_ptime a) (to_ptime b) compare_print_tz a_z b_z - -let eq x y = compare x y = 0 - -let never = epoch - -let of_string = of_iso8601 - -let to_string = to_rfc3339 - -let of_float = of_unix_time - -let to_float = to_unix_time - -let rfc822_of_float = of_unix_time - -let rfc822_to_string = to_rfc822 - -type iso8601 = t - -type rfc822 = t diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.mli deleted file mode 100644 index 62e894808bf..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.mli +++ /dev/null @@ -1,105 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -(** date-time with support for keeping timezone for ISO 8601 conversion *) -type t - -(** Conversions *) - -val of_ptime : Ptime.t -> t -(** Convert ptime to time in UTC *) - -val to_ptime : t -> Ptime.t -(** Convert date/time to a ptime value: the number of seconds since 00:00:00 - UTC, 1 Jan 1970. Assumes the underlying {!t} is in UTC *) - -val of_unix_time : float -> t -(** Convert calendar time [x] (as returned by e.g. Unix.time), to time in UTC *) - -val to_unix_time : t -> float -(** Convert date/time to a unix timestamp: the number of seconds since - 00:00:00 UTC, 1 Jan 1970. Assumes the underlying {!t} is in UTC *) - -val to_rfc822 : t -> string -(** Convert date/time to email-formatted (RFC 822) string. *) - -val to_rfc3339 : t -> string -(** Convert date/time to an RFC-3339-formatted string. It also complies with - the ISO 8601 format *) - -val of_iso8601 : string -> t -(** Convert ISO 8601 formatted string to a date/time value. Does not accept a - timezone annotated datetime - i.e. string must be UTC, and end with a Z *) - -val epoch : t -(** 00:00:00 UTC, 1 Jan 1970, in UTC *) - -val now : unit -> t -(** Count the number of seconds passed since 00:00:00 UTC, 1 Jan 1970, in UTC *) - -val _localtime_string : Ptime.tz_offset_s option -> Ptime.t -> string -(** exposed for testing *) - -val localtime : unit -> t -(** Count the number of seconds passed since 00:00:00 UTC, 1 Jan 1970, in local - time *) - -(** Comparisons *) - -val eq : t -> t -> bool -(** [eq a b] returns whether [a] and [b] are equal *) - -val compare : t -> t -> int -(** [compare a b] returns -1 if [a] is earlier than [b], 1 if [a] is later than - [b] or the ordering of the timezone printer *) - -val is_earlier : than:t -> t -> bool -(** [is_earlier ~than a] returns whether the timestamp [a] happens before - [than] *) - -val is_later : than:t -> t -> bool -(** [is_later ~than a] returns whether the timestamp [a] happens after [than] - *) - -val diff : t -> t -> Ptime.Span.t -(** [diff a b] returns the span of time corresponding to [a - b] *) - -(** Deprecated bindings, these will be removed in a future release: *) - -val rfc822_to_string : t -> string -(** Same as {!to_rfc822} *) - -val rfc822_of_float : float -> t -(** Same as {!of_unix_time} *) - -val of_float : float -> t -(** Same as {!of_unix_time} *) - -val to_float : t -> float -(** Same as {!to_unix_time} *) - -val to_string : t -> string -(** Same as {!to_rfc3339} *) - -val of_string : string -> t -(** Same as {!of_iso8601} *) - -val never : t -(** Same as {!epoch} *) - -(** Deprecated alias for {!t} *) -type iso8601 = t - -(** Deprecated alias for {!t} *) -type rfc822 = t diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/dune deleted file mode 100644 index c2ed6c448da..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/dune +++ /dev/null @@ -1,16 +0,0 @@ -(library - (name xapi_stdext_date) - (public_name xapi-stdext-date) - (modules :standard \ test) - (libraries astring - ptime - ptime.clock.os - unix) -) - -(test - (name test) - (package xapi-stdext-date) - (modules test) - (libraries alcotest xapi-stdext-date ptime) -) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/test.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/test.ml deleted file mode 100644 index 66ec59696da..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/test.ml +++ /dev/null @@ -1,135 +0,0 @@ -open Xapi_stdext_date.Date - -let check_float = Alcotest.(check @@ float 1e-2) - -let check_float_neq = Alcotest.(check @@ neg @@ float 1e-2) - -let check_string = Alcotest.(check string) - -let check_true str = Alcotest.(check bool) str true - -let dash_time_str = "2020-04-07T08:28:32Z" - -let no_dash_utc_time_str = "20200407T08:28:32Z" - -let tests = - let test_of_unix_time_invertible () = - let non_int_time = 1586245987.70200706 in - let time = non_int_time |> Float.floor in - check_float "to_unix_time inverts of_unix_time" time - (time |> of_unix_time |> to_unix_time) ; - check_true "of_unix_time inverts to_unix_time" - @@ eq (time |> of_unix_time) - (time |> of_unix_time |> to_unix_time |> of_unix_time) - in - let test_only_utc () = - let utc = "2020-12-20T18:10:19Z" in - let _ = of_iso8601 utc in - (* UTC is valid *) - let non_utc = "2020-12-20T18:10:19+02:00" in - let exn = - Invalid_argument - "Xapi_stdext_date__Date.of_iso8601: 2020-12-20T18:10:19+02:00" - in - Alcotest.check_raises "only UTC is accepted" exn (fun () -> - of_iso8601 non_utc |> ignore - ) - in - let test_ca333908 () = - check_float "dash time and no dash time represent the same unix timestamp" - (dash_time_str |> of_iso8601 |> to_unix_time) - (no_dash_utc_time_str |> of_iso8601 |> to_unix_time) - in - let test_of_iso8601_invertible_when_no_dashes () = - check_string "to_rfc3339 inverts of_iso8601" no_dash_utc_time_str - (no_dash_utc_time_str |> of_iso8601 |> to_rfc3339) ; - check_true "of_iso8601 inverts to_rfc3339" - (eq - (no_dash_utc_time_str |> of_iso8601) - (no_dash_utc_time_str |> of_iso8601 |> to_rfc3339 |> of_iso8601) - ) - in - (* CA-338243 - breaking backwards compatibility will break XC and XRT *) - let test_to_rfc3339_backwards_compatibility () = - check_string "to_rfc3339 is backwards compatible" no_dash_utc_time_str - (dash_time_str |> of_iso8601 |> to_rfc3339) - in - let test_localtime_string () = - let[@warning "-8"] (Ok (t, _, _)) = - Ptime.of_rfc3339 "2020-04-07T09:01:28Z" - in - let minus_2_hrs = -7200 in - let plus_3_hrs = 10800 in - let zero_hrs = 0 in - check_string "can subtract 2 hours" - (_localtime_string (Some minus_2_hrs) t) - "20200407T07:01:28" ; - check_string "can add 3 hours" - (_localtime_string (Some plus_3_hrs) t) - "20200407T12:01:28" ; - check_string "can add None" (_localtime_string None t) "20200407T09:01:28" ; - check_string "can add zero" - (_localtime_string (Some zero_hrs) t) - "20200407T09:01:28" - in - (* sanity check (on top of test_localtime_string) that localtime produces valid looking output *) - let test_ca342171 () = - (* no exception is thrown + backward compatible formatting *) - let localtime_string = localtime () |> to_rfc3339 in - Alcotest.(check int) - "localtime string has correct number of chars" - (String.length localtime_string) - (String.length no_dash_utc_time_str - 1) ; - Alcotest.(check bool) - "localtime string does not contain a Z" false - (String.contains localtime_string 'Z') - in - let test_xsi894 () = - let missing_tz_no_dash = "20201210T17:19:20" in - let missing_tz_dash = "2020-12-10T17:19:20" in - check_string "can process missing tz no dash" missing_tz_no_dash - (missing_tz_no_dash |> of_iso8601 |> to_rfc3339) ; - check_string "can process missing tz with dashes, but return without dashes" - missing_tz_no_dash - (missing_tz_dash |> of_iso8601 |> to_rfc3339) ; - check_float "to_unix_time assumes UTC" 1607620760. - (missing_tz_no_dash |> of_iso8601 |> to_unix_time) ; - let localtime' = localtime () in - check_string "to_rfc3339 inverts of_iso8601 for localtime" - (localtime' |> to_rfc3339) - (localtime' |> to_rfc3339 |> of_iso8601 |> to_rfc3339) - in - let test_email_date (unix_timestamp, expected) = - let formatted = of_unix_time unix_timestamp |> to_rfc822 in - check_string "String is properly RFC-822-formatted" expected formatted - in - let test_email_dates () = - let dates = - [ - (-1221847200., "Tue, 14 Apr 1931 06:00:00 GMT") - ; (0., "Thu, 1 Jan 1970 00:00:00 GMT") - ; (626637180., "Thu, 9 Nov 1989 17:53:00 GMT") - ; (2889734400., "Thu, 28 Jul 2061 00:00:00 GMT") - ] - in - List.iter test_email_date dates - in - [ - ("test_of_unix_time_invertible", `Quick, test_of_unix_time_invertible) - ; ("test_only_utc", `Quick, test_only_utc) - ; ("test_ca333908", `Quick, test_ca333908) - ; ( "test_of_iso8601_invertible_when_no_dashes" - , `Quick - , test_of_iso8601_invertible_when_no_dashes - ) - ; ( "test_to_rfc3339_backwards_compatibility" - , `Quick - , test_to_rfc3339_backwards_compatibility - ) - ; ("test_localtime_string", `Quick, test_localtime_string) - ; ("test_ca342171", `Quick, test_ca342171) - ; ("test_xsi894", `Quick, test_xsi894) - ; ("RFC 822 formatting", `Quick, test_email_dates) - ] - -let () = Alcotest.run "Date" [("Conversions", tests)] diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/bechamel_simple_cli.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/bechamel_simple_cli.ml deleted file mode 100644 index fef03cce765..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/bechamel_simple_cli.ml +++ /dev/null @@ -1,56 +0,0 @@ -(* based on bechamel example code *) -open Bechamel -open Toolkit - -let instances = Instance.[monotonic_clock; minor_allocated; major_allocated] - -let benchmark tests = - let cfg = Benchmark.cfg () in - Benchmark.all cfg instances tests - -let analyze raw_results = - let ols = - Analyze.ols ~r_square:true ~bootstrap:0 ~predictors:[|Measure.run|] - in - let results = - List.map (fun instance -> Analyze.all ols instance raw_results) instances - in - (Analyze.merge ols instances results, raw_results) - -let () = - List.iter (fun i -> Bechamel_notty.Unit.add i (Measure.unit i)) instances - -let img (window, results) = - Bechamel_notty.Multiple.image_of_ols_results ~rect:window - ~predictor:Measure.run results - -open Notty_unix - -let cli tests = - Format.printf "@,Running benchmarks@." ; - let results, _ = tests |> benchmark |> analyze in - (* compute speed from duration *) - let () = - Hashtbl.find results (Measure.label Instance.monotonic_clock) - |> Hashtbl.iter @@ fun name result -> - try - (* this relies on extracting input size from test name, - which works if Test.make_indexed* was used *) - Scanf.sscanf name "%_s@:%d" @@ fun length -> - match Analyze.OLS.estimates result with - | Some [duration] -> - (* unit is ns *) - let speed = 1e9 *. float length /. duration /. 1048576.0 in - Fmt.pf Fmt.stdout "@[%s = %.1f MiB/s@]@." name speed - | _ -> - () - with Failure _ | Scanf.Scan_failure _ -> () - in - let window = - match winsize Unix.stdout with - | Some (w, h) -> - {Bechamel_notty.w; h} - | None -> - {Bechamel_notty.w= 80; h= 1} - in - img (window, results) |> eol |> output_image diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/bench_encodings.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/bench_encodings.ml deleted file mode 100644 index 7308c756d8b..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/bench_encodings.ml +++ /dev/null @@ -1,15 +0,0 @@ -open Bechamel -open Xapi_stdext_encodings.Encodings - -let test name f = - Test.make_indexed_with_resource ~name ~args:[10; 1000; 10000] - Test.multiple (* TODO: Test.uniq segfaults here, bechamel bug *) - ~allocate:(fun i -> String.make i 'x') - ~free:ignore - (fun (_ : int) -> Staged.stage f) - -let benchmarks = - Test.make_grouped ~name:"Encodings.validate" - [test "UTF8_XML" UTF8_XML.validate] - -let () = Bechamel_simple_cli.cli benchmarks diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/dune deleted file mode 100644 index 9f12bcbf8ce..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/bench/dune +++ /dev/null @@ -1,6 +0,0 @@ -(executable - (name bench_encodings) - (modes exe) - (optional) - (libraries bechamel xapi_stdext_encodings bechamel-notty notty.unix fmt) -) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/dune deleted file mode 100644 index 742dd212f1e..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name xapi_stdext_encodings) - (public_name xapi-stdext-encodings) - (modules :standard \ test) -) - -(test - (name test) - (package xapi-stdext-encodings) - (modules test) - (libraries alcotest xapi-stdext-encodings) -) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.ml deleted file mode 100644 index 8d6d07e012a..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.ml +++ /dev/null @@ -1,167 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -exception UCS_value_out_of_range - -exception UCS_value_prohibited_in_UTF8 - -exception UCS_value_prohibited_in_XML - -exception UTF8_character_incomplete - -exception UTF8_header_byte_invalid - -exception UTF8_continuation_byte_invalid - -exception UTF8_encoding_not_canonical - -exception String_incomplete - -(* === Unicode Functions === *) - -module UCS = struct - let is_non_character value = - false - || (0xfdd0 <= value && value <= 0xfdef) (* case 1 *) - || Int.logand 0xfffe value = 0xfffe - (* case 2 *) - [@@inline] -end - -module XML = struct - let is_illegal_control_character value = - let value = Uchar.to_int value in - value < 0x20 && value <> 0x09 && value <> 0x0a && value <> 0x0d - [@@inline] -end - -(* === UCS Validators === *) - -module type UCS_VALIDATOR = sig - val validate : Uchar.t -> unit [@@inline] -end - -module UTF8_UCS_validator = struct - let validate value = - if (UCS.is_non_character [@inlined]) (Uchar.to_int value) then - raise UCS_value_prohibited_in_UTF8 - [@@inline] -end - -module XML_UTF8_UCS_validator = struct - let validate value = - (UTF8_UCS_validator.validate [@inlined]) value ; - if (XML.is_illegal_control_character [@inlined]) value then - raise UCS_value_prohibited_in_XML -end - -(* === String Validators === *) - -module type STRING_VALIDATOR = sig - val is_valid : string -> bool - - val validate : string -> unit - - val longest_valid_prefix : string -> string -end - -exception Validation_error of int * exn - -module UTF8_XML : STRING_VALIDATOR = struct - let decode_continuation_byte byte = - if byte land 0b11000000 = 0b10000000 then - byte land 0b00111111 - else - raise UTF8_continuation_byte_invalid - - let rec decode_continuation_bytes string last value index = - if index <= last then - let chunk = decode_continuation_byte (Char.code string.[index]) in - let value = (value lsl 6) lor chunk in - decode_continuation_bytes string last value (index + 1) - else - value - - let validate_character_utf8 string byte index = - let value, width = - if byte land 0b10000000 = 0b00000000 then - (byte, 1) - else if byte land 0b11100000 = 0b11000000 then - (byte land 0b0011111, 2) - else if byte land 0b11110000 = 0b11100000 then - (byte land 0b0001111, 3) - else if byte land 0b11111000 = 0b11110000 then - (byte land 0b0000111, 4) - else - raise UTF8_header_byte_invalid - in - let value = - if width = 1 then - value - else - decode_continuation_bytes string (index + width - 1) value (index + 1) - in - XML_UTF8_UCS_validator.validate (Uchar.unsafe_of_int value) ; - width - - let rec validate_aux string length index = - if index = length then - () - else - let width = - try - let byte = string.[index] |> Char.code in - validate_character_utf8 string byte index - with - | Invalid_argument _ -> - raise String_incomplete - | error -> - raise (Validation_error (index, error)) - in - validate_aux string length (index + width) - - let validate string = validate_aux string (String.length string) 0 - - let rec validate_with_fastpath string stop pos = - if pos < stop then - (* the compiler is smart enough to optimize the 'int32' away here, - and not allocate *) - let i32 = String.get_int32_ne string pos |> Int32.to_int in - (* test that for all bytes 0x20 <= byte < 0x80. - If any is <0x20 it would cause a negative value to appear in that byte, - which we can detect if we use 0x80 as a mask. - Byte >= 0x80 can be similarly detected with a mask of 0x80 on each byte. - We don't want to see a 0x80 from either of these, hence we bitwise or the 2 values together. - *) - if i32 lor (i32 - 0x20_20_20_20) land 0x80_80_80_80 = 0 then - validate_with_fastpath string stop (pos + 4) - else (* when the condition doesn't hold fall back to full UTF8 decoder *) - validate_aux string (String.length string) pos - else - validate_aux string (String.length string) pos - - let validate_with_fastpath string = - validate_with_fastpath string (String.length string - 3) 0 - - let validate = - if Sys.word_size = 64 then - validate_with_fastpath - else - validate - - let is_valid string = try validate string ; true with _ -> false - - let longest_valid_prefix string = - try validate string ; string - with Validation_error (index, _) -> String.sub string 0 index -end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.mli deleted file mode 100644 index 2a139ae3786..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.mli +++ /dev/null @@ -1,84 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -(** Encoding helper modules *) - -(** {2 Exceptions} *) - -exception UCS_value_out_of_range - -exception UCS_value_prohibited_in_UTF8 - -exception UCS_value_prohibited_in_XML - -exception UTF8_character_incomplete - -exception UTF8_header_byte_invalid - -exception UTF8_continuation_byte_invalid - -exception UTF8_encoding_not_canonical - -exception String_incomplete - -(** {2 UCS Validators} *) - -(** Validates UCS character values. *) -module type UCS_VALIDATOR = sig - val validate : Uchar.t -> unit -end - -(** Accepts all values within the UCS character value range except - * those which are invalid for all UTF-8-encoded XML documents. *) -module XML_UTF8_UCS_validator : UCS_VALIDATOR - -module XML : sig - val is_illegal_control_character : Uchar.t -> bool - (** Returns true if and only if the given value corresponds to - * a illegal control character as defined in section 2.2 of - * the XML specification, version 1.0. *) -end - -(** {2 String Validators} *) - -(** Provides functionality for validating and processing - * strings according to a particular character encoding. *) -module type STRING_VALIDATOR = sig - val is_valid : string -> bool - (** Returns true if and only if the given string is validly-encoded. *) - - val validate : string -> unit - (** Raises an encoding error if the given string is not validly-encoded. *) - - val longest_valid_prefix : string -> string - (** Returns the longest validly-encoded prefix of the given string. *) -end - -(** Represents a validation error as a tuple [(i,e)], where: - * [i] = the index of the first non-compliant character; - * [e] = the reason for non-compliance. *) -exception Validation_error of int * exn - -(** Provides functions for validating and processing - * strings according to the UTF-8 character encoding, - * with certain additional restrictions on UCS values - * imposed by the XML specification. - * - * Validly-encoded strings must satisfy both RFC 3629 - * and section 2.2 of the XML specification. - * - * For further information, see: - * http://www.rfc.net/rfc3629.html - * http://www.w3.org/TR/REC-xml/#charsets *) -module UTF8_XML : STRING_VALIDATOR diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/test.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/test.ml deleted file mode 100644 index e94825accae..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/test.ml +++ /dev/null @@ -1,607 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -module E = Xapi_stdext_encodings.Encodings - -(* Pull in the infix operators from Encodings used in this test *) -let ( --- ), ( +++ ), ( <<< ) = (Int.sub, Int.add, Int.shift_left) - -(* === Mock exceptions ==================================================== *) - -(** Simulates a decoding error. *) -exception Decode_error - -(* === Mock types ===========================================================*) - -(** Generates mock character widths, in bytes. *) -module type WIDTH_GENERATOR = sig - val next : unit -> int -end - -(* === Mock UCS validators ================================================= *) - -(** A validator that always succeeds. *) -module Lenient_UCS_validator : E.UCS_VALIDATOR = struct - let validate _ = () -end - -(* === Mock character validators ============================================= *) - -(** A validator that succeeds for all characters. *) -module Universal_character_validator = struct - let validate _ = () -end - -(** A validator that fails for all characters. *) -module Failing_character_validator = struct - let validate _ = raise Decode_error -end - -(** A validator that succeeds for all characters except the letter 'F'. *) -module Selective_character_validator = struct - let validate uchar = - if Uchar.equal uchar (Uchar.of_char 'F') then raise Decode_error -end - -(* === Test helpers ======================================================== *) - -let assert_true = Alcotest.(check bool) "true" true - -let assert_false = Alcotest.(check bool) "false" false - -let check_indices = Alcotest.(check (list int)) "indices" - -let assert_raises_match exception_match fn = - try - fn () ; - Alcotest.fail "assert_raises_match: failure expected" - with failure -> - if not (exception_match failure) then - raise failure - else - () - -(* === Mock codecs ========================================================= *) - -module UCS = struct - (* === Unicode Functions === *) - let min_value = 0x000000 - - let max_value = 0x10ffff - (* used to be 0x1fffff, but this changed and Unicode won't allocate larger than 0x10ffff *) - - let is_non_character value = - false - || (0xfdd0 <= value && value <= 0xfdef) (* case 1 *) - || Int.logand 0xfffe value = 0xfffe - (* case 2 *) - - let is_out_of_range value = value < min_value || value > max_value - - let is_surrogate value = 0xd800 <= value && value <= 0xdfff - - (** A list of UCS non-characters values, including: - a. non-characters within the basic multilingual plane; - b. non-characters at the end of the basic multilingual plane; - c. non-characters at the end of the private use area. *) - let non_characters = - [ - 0x00fdd0 - ; 0x00fdef - ; (* case a. *) - 0x00fffe - ; 0x00ffff - ; (* case b. *) - 0x1ffffe - ; 0x1fffff (* case c. *) - ] - - (** A list of UCS character values located immediately before or - after UCS non-character values, including: - a. non-characters within the basic multilingual plane; - b. non-characters at the end of the basic multilingual plane; - c. non-characters at the end of the private use area. *) - let valid_characters_next_to_non_characters = - [ - 0x00fdcf - ; 0x00fdf0 - ; (* case a. *) - 0x00fffd - ; 0x010000 - ; (* case b. *) - 0x1ffffd - ; 0x200000 (* case c. *) - ] - - let test_is_non_character () = - List.iter (fun value -> assert_true (is_non_character value)) non_characters ; - List.iter - (fun value -> assert_false (is_non_character value)) - valid_characters_next_to_non_characters - - let test_is_out_of_range () = - assert_true (is_out_of_range (min_value --- 1)) ; - assert_false (is_out_of_range min_value) ; - assert_false (is_out_of_range max_value) ; - assert_true (is_out_of_range (max_value +++ 1)) - - let test_is_surrogate () = - assert_false (is_surrogate 0xd7ff) ; - assert_true (is_surrogate 0xd800) ; - assert_true (is_surrogate 0xdfff) ; - assert_false (is_surrogate 0xe000) - - let tests = - [ - ("test_is_non_character", `Quick, test_is_non_character) - ; ("test_is_out_of_range", `Quick, test_is_out_of_range) - ; ("test_is_surrogate", `Quick, test_is_surrogate) - ] -end - -module Lenient_UTF8_codec = struct - let decode_header_byte byte = - if byte land 0b10000000 = 0b00000000 then - (byte, 1) - else if byte land 0b11100000 = 0b11000000 then - (byte land 0b0011111, 2) - else if byte land 0b11110000 = 0b11100000 then - (byte land 0b0001111, 3) - else if byte land 0b11111000 = 0b11110000 then - (byte land 0b0000111, 4) - else - raise E.UTF8_header_byte_invalid - - let decode_continuation_byte byte = - if byte land 0b11000000 = 0b10000000 then - byte land 0b00111111 - else - raise E.UTF8_continuation_byte_invalid - - let width_required_for_ucs_value value = - if value < 0x000080 (* 1 lsl 7 *) then - 1 - else if value < 0x000800 (* 1 lsl 11 *) then - 2 - else if value < 0x010000 (* 1 lsl 16 *) then - 3 - else - 4 - - let decode_character string index = - let value, width = decode_header_byte (Char.code string.[index]) in - let value = - if width = 1 then - value - else - let value = ref value in - for index = index + 1 to index + width - 1 do - let chunk = decode_continuation_byte (Char.code string.[index]) in - value := (!value lsl 6) lor chunk - done ; - if width > width_required_for_ucs_value !value then - raise E.UTF8_encoding_not_canonical ; - !value - in - (value, width) -end - -(* === Mock string validators ============================================== *) -module Mock_String_validator (Validator : E.UCS_VALIDATOR) : - E.STRING_VALIDATOR = struct - (* no longer a functor in Encodings for performance reasons, - so modify the original string passed as argument instead replacing - characters that would be invalid with a known invalid XML char: 0x0B. - *) - - let transform str = - let b = Buffer.create (String.length str) in - let rec loop pos = - if pos < String.length str then - let value, width = Lenient_UTF8_codec.decode_character str pos in - let () = - try - let u = Uchar.of_int value in - Validator.validate u ; Buffer.add_utf_8_uchar b u - with _ -> Buffer.add_char b '\x0B' - in - loop (pos + width) - in - loop 0 ; Buffer.contents b - - let is_valid str = E.UTF8_XML.is_valid (transform str) - - let validate str = - try E.UTF8_XML.validate (transform str) - with E.Validation_error (pos, _) -> - raise (E.Validation_error (pos, Decode_error)) - - let longest_valid_prefix str = E.UTF8_XML.longest_valid_prefix (transform str) -end - -(** A validator that accepts all strings. *) -module Universal_string_validator = - Mock_String_validator (Universal_character_validator) - -(** A validator that rejects all strings. *) -module Failing_string_validator = - Mock_String_validator (Failing_character_validator) - -(** A validator that rejects strings containing the character 'F'. *) -module Selective_string_validator = - Mock_String_validator (Selective_character_validator) - -(* === Tests =============================================================== *) - -module String_validator = struct - let test_is_valid () = - assert_true (Universal_string_validator.is_valid "") ; - assert_true (Universal_string_validator.is_valid "123456789") ; - assert_true (Selective_string_validator.is_valid "") ; - assert_true (Selective_string_validator.is_valid "123456789") ; - assert_false (Selective_string_validator.is_valid "F23456789") ; - assert_false (Selective_string_validator.is_valid "1234F6789") ; - assert_false (Selective_string_validator.is_valid "12345678F") ; - assert_false (Selective_string_validator.is_valid "FFFFFFFFF") - - let test_longest_valid_prefix () = - Alcotest.(check string) - "prefix" - (Universal_string_validator.longest_valid_prefix "") - "" ; - Alcotest.(check string) - "prefix" - (Universal_string_validator.longest_valid_prefix "123456789") - "123456789" ; - Alcotest.(check string) - "prefix" - (Selective_string_validator.longest_valid_prefix "") - "" ; - Alcotest.(check string) - "prefix" - (Selective_string_validator.longest_valid_prefix "123456789") - "123456789" ; - Alcotest.(check string) - "prefix" - (Selective_string_validator.longest_valid_prefix "F23456789") - "" ; - Alcotest.(check string) - "prefix" - (Selective_string_validator.longest_valid_prefix "1234F6789") - "1234" ; - Alcotest.(check string) - "prefix" - (Selective_string_validator.longest_valid_prefix "12345678F") - "12345678" ; - Alcotest.(check string) - "prefix" - (Selective_string_validator.longest_valid_prefix "FFFFFFFFF") - "" - - (** Tests that validation does not fail for an empty string. *) - let test_validate_with_empty_string () = E.UTF8_XML.validate "" - - let test_validate_with_incomplete_string () = - Alcotest.check_raises "Validation fails correctly for an incomplete string" - E.String_incomplete (fun () -> E.UTF8_XML.validate "\xc2" - ) - - let test_validate_with_failing_decoders () = - Failing_string_validator.validate "" ; - assert_raises_match - (function E.Validation_error (0, Decode_error) -> true | _ -> false) - (fun () -> Selective_string_validator.validate "F") ; - assert_raises_match - (function E.Validation_error (0, Decode_error) -> true | _ -> false) - (fun () -> Selective_string_validator.validate "F12345678") ; - assert_raises_match - (function E.Validation_error (4, Decode_error) -> true | _ -> false) - (fun () -> Selective_string_validator.validate "0123F5678") ; - assert_raises_match - (function E.Validation_error (8, Decode_error) -> true | _ -> false) - (fun () -> Selective_string_validator.validate "01234567F") ; - assert_raises_match - (function E.Validation_error (0, Decode_error) -> true | _ -> false) - (fun () -> Selective_string_validator.validate "FFFFFFFFF") - - let tests = - [ - ("test_is_valid", `Quick, test_is_valid) - ; ("test_longest_valid_prefix", `Quick, test_longest_valid_prefix) - ; ( "test_validate_with_empty_string" - , `Quick - , test_validate_with_empty_string - ) - ; ( "test_validate_with_incomplete_string" - , `Quick - , test_validate_with_incomplete_string - ) - ; ( "test_validate_with_failing_decoders" - , `Quick - , test_validate_with_failing_decoders - ) - ] -end - -module XML = struct - include E.XML - - let test_is_illegal_control_character () = - assert_true (is_illegal_control_character (Uchar.of_int 0x00)) ; - assert_true (is_illegal_control_character (Uchar.of_int 0x19)) ; - assert_false (is_illegal_control_character (Uchar.of_int 0x09)) ; - assert_false (is_illegal_control_character (Uchar.of_int 0x0a)) ; - assert_false (is_illegal_control_character (Uchar.of_int 0x0d)) ; - assert_false (is_illegal_control_character (Uchar.of_int 0x20)) - - let tests = - [ - ( "test_is_illegal_control_character" - , `Quick - , test_is_illegal_control_character - ) - ] -end - -(** Tests the XML-specific UTF-8 UCS validation function. *) -module XML_UTF8_UCS_validator = struct - include E.XML_UTF8_UCS_validator - - let validate uchar = - if Uchar.is_valid uchar then - validate @@ Uchar.of_int uchar - else if uchar < Uchar.to_int Uchar.min || uchar > Uchar.to_int Uchar.max - then - raise E.UCS_value_out_of_range - else - raise E.UCS_value_prohibited_in_UTF8 - - let test_validate () = - let value = ref (UCS.min_value --- 1) in - while !value <= UCS.max_value +++ 1 do - if UCS.is_out_of_range !value then - Alcotest.check_raises "should fail" E.UCS_value_out_of_range (fun () -> - validate !value - ) - else if UCS.is_non_character !value || UCS.is_surrogate !value then - Alcotest.check_raises "should fail" E.UCS_value_prohibited_in_UTF8 - (fun () -> validate !value - ) - else if - Uchar.is_valid !value - && XML.is_illegal_control_character (Uchar.of_int !value) - then - Alcotest.check_raises "should fail" E.UCS_value_prohibited_in_XML - (fun () -> validate !value - ) - else - validate !value ; - value := !value +++ 1 - done - - let tests = [("test_validate", `Quick, test_validate)] -end - -module UTF8_codec = struct - (** A list of canonical encoding widths of UCS values, - represented by tuples of the form (v, w), where: - v = the UCS character value to be encoded; and - w = the width of the encoded character, in bytes. *) - let valid_ucs_value_widths = - [ - (1, 1) - ; ((1 <<< 7) --- 1, 1) - ; (1 <<< 7, 2) - ; ((1 <<< 11) --- 1, 2) - ; (1 <<< 11, 3) - ; ((1 <<< 16) --- 1, 3) - ; (1 <<< 16, 4) - ; ((1 <<< 21) --- 1, 4) - ] - - let width_required_for_ucs_value value = - if value < 0x000080 (* 1 lsl 7 *) then - 1 - else if value < 0x000800 (* 1 lsl 11 *) then - 2 - else if value < 0x010000 (* 1 lsl 16 *) then - 3 - else - 4 - - let test_width_required_for_ucs_value () = - List.iter - (fun (value, width) -> - Alcotest.(check int) - "same ints" - (width_required_for_ucs_value value) - width - ) - valid_ucs_value_widths - - (** A list of valid header byte decodings, represented by - tuples of the form (b, (v, w)), where: - b = a valid header byte; - v = the (partial) value contained within the byte; and - w = the total width of the encoded character, in bytes. *) - let valid_header_byte_decodings = - [ - (0b00000000, (0b00000000, 1)) - ; (0b00000001, (0b00000001, 1)) - ; (0b01111111, (0b01111111, 1)) - ; (0b11000000, (0b00000000, 2)) - ; (0b11000001, (0b00000001, 2)) - ; (0b11011111, (0b00011111, 2)) - ; (0b11100000, (0b00000000, 3)) - ; (0b11100001, (0b00000001, 3)) - ; (0b11101111, (0b00001111, 3)) - ; (0b11110000, (0b00000000, 4)) - ; (0b11110001, (0b00000001, 4)) - ; (0b11110111, (0b00000111, 4)) - ] - - (** A list of invalid header bytes that should not be decodable. *) - let invalid_header_bytes = - [ - 0b10000000 - ; 0b10111111 - ; 0b11111000 - ; 0b11111011 - ; 0b11111100 - ; 0b11111101 - ; 0b11111110 - ; 0b11111111 - ] - - (** A list of valid continuation byte decodings, represented - by tuples of the form (b, v), where: - b = a valid continuation byte; and - v = the partial value contained within the byte. *) - let valid_continuation_byte_decodings = - [ - (0b10000000, 0b00000000) - ; (0b10000001, 0b00000001) - ; (0b10111110, 0b00111110) - ; (0b10111111, 0b00111111) - ] - - (** A list of invalid continuation bytes that should not be decodable. *) - let invalid_continuation_bytes = - [ - 0b00000000 - ; 0b01111111 - ; 0b11000000 - ; 0b11011111 - ; 0b11100000 - ; 0b11101111 - ; 0b11110000 - ; 0b11110111 - ; 0b11111000 - ; 0b11111011 - ; 0b11111100 - ; 0b11111101 - ; 0b11111111 - ; 0b11111110 - ] - - (** A list of valid character decodings represented by - tuples of the form (s, (v, w)), where: - - s = a validly-encoded UTF-8 string; - v = the UCS value represented by the string; - (which may or may not be valid in its own right) - w = the width of the encoded string, in bytes. - - For each byte length b in [1...4], the list contains - decodings for: - - v_min = the smallest UCS value encodable in b bytes. - v_max = the greatest UCS value encodable in b bytes. *) - let valid_character_decodings = - [ - (* 7654321 *) - (* 0b0xxxxxxx *) - (* 00000000000000xxxxxxx *) - ( "\x00" (* 0b00000000 *) - , (0b000000000000000000000, 1) - ) - ; ( "\x7f" (* 0b01111111 *) - , (0b000000000000001111111, 1) - ) - ; (* 10987654321 *) - (* 0b110xxxsx 0b10xxxxxx *) - (* 0000000000xxxsxxxxxxx *) - ( "\xc2\x80" (* 0b11000010 0b10000000 *) - , (0b000000000000010000000, 2) - ) - ; ( "\xdf\xbf" (* 0b11011111 0b10111111 *) - , (0b000000000011111111111, 2) - ) - ; (* 6543210987654321 *) - (* 0b1110xxxx 0b10sxxxxx 0b10xxxxxx *) - (* xxxxsxxxxxxxxxxx *) - ( "\xe0\xa0\x80" (* 0b11100000 0b10100000 0b10000000 *) - , (0b000000000100000000000, 3) - ) - ; ( "\xef\xbf\xbf" (* 0b11101111 0b10111111 0b10111111 *) - , (0b000001111111111111111, 3) - ) - ; (* 109876543210987654321 *) - (* 0b11110xxx 0b10xsxxxx 0b10xxxxxx 0b10xxxxxx *) - (* xxxxsxxxxxxxxxxxxxxxx *) - ( "\xf0\x90\x80\x80" (* 0b11110000 0b10010000 0b10000000 0b10000000 *) - , (0b000010000000000000000, 4) - ) - ; ( "\xf7\xbf\xbf\xbf" (* 0b11110111 0b10111111 0b10111111 0b10111111 *) - , (0b111111111111111111111, 4) - ) - ] - - let uchar = Alcotest.int - - let test_decode_character_when_valid () = - List.iter - (fun (string, (value, width)) -> - Alcotest.(check (pair uchar int)) - "same pair" - (Lenient_UTF8_codec.decode_character string 0) - (value, width) - ) - valid_character_decodings - - (** A list of strings containing overlong character encodings. - For each byte length b in [2...4], this list contains the - overlong encoding e (v), where v is the UCS value one less - than the smallest UCS value validly-encodable in b bytes. *) - let overlong_character_encodings = - [ - "\xc1\xbf" (* 0b11000001 0b10111111 *) - ; "\xe0\x9f\xbf" (* 0b11100000 0b10011111 0b10111111 *) - ; "\xf0\x8f\xbf\xbf" (* 0b11110000 0b10001111 0b10111111 0b10111111 *) - ] - - let test_decode_character_when_overlong () = - List.iter - (fun string -> - Alcotest.check_raises "should fail" E.UTF8_encoding_not_canonical - (fun () -> Lenient_UTF8_codec.decode_character string 0 |> ignore - ) - ) - overlong_character_encodings - - let tests = - [ - ( "test_width_required_for_ucs_value" - , `Quick - , test_width_required_for_ucs_value - ) - ; ( "test_decode_character_when_valid" - , `Quick - , test_decode_character_when_valid - ) - ; ( "test_decode_character_when_overlong" - , `Quick - , test_decode_character_when_overlong - ) - ] -end - -let () = - Alcotest.run "Encodings" - [ - ("UCS", UCS.tests) - ; ("XML", XML.tests) - ; ("String_validator", String_validator.tests) - ; ("XML_UTF8_UCS_validator", XML_UTF8_UCS_validator.tests) - ; ("UTF8_codec", UTF8_codec.tests) - ] diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/dune deleted file mode 100644 index 2a12545a2b9..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name xapi_stdext_pervasives) - (public_name xapi-stdext-pervasives) - (libraries - logs - xapi-backtrace) -) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.ml deleted file mode 100644 index 7d8e16c4346..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.ml +++ /dev/null @@ -1,69 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -(** apply the clean_f function after fct function has been called. - * Even if fct raises an exception, clean_f is applied -*) - -let src = - Logs.Src.create "pervasiveext" - ~doc:"logs from Xapi_stdext_pervasives.Pervasiveext" - -let finally fct clean_f = - let result = - try fct () - with exn -> - Backtrace.is_important exn ; - ( try - (* We catch and log exceptions raised by clean_f to avoid shadowing - the original exception raised by fct *) - clean_f () - with cleanup_exn -> - Logs.warn ~src (fun m -> - m - "finally: Error while running cleanup after failure of main \ - function: %s" - (Printexc.to_string cleanup_exn) - ) - ) ; - raise exn - in - clean_f () ; result - -(** execute fct ignoring exceptions *) -let ignore_exn fct = try fct () with _ -> () - -(* non polymorphic ignore function *) -let ignore_int v = - let (_ : int) = v in - () - -let ignore_int64 v = - let (_ : int64) = v in - () - -let ignore_int32 v = - let (_ : int32) = v in - () - -let ignore_string v = - let (_ : string) = v in - () - -let ignore_float v = - let (_ : float) = v in - () - -let ignore_bool v = - let (_ : bool) = v in - () diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.mli deleted file mode 100644 index 4190071de07..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-pervasives/pervasiveext.mli +++ /dev/null @@ -1,31 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -val finally : (unit -> 'a) -> (unit -> unit) -> 'a -(** [finally f g] returns [f ()] guaranteeing to run clean-up actions - [g ()] even if [f ()] throws an exception. *) - -val ignore_exn : (unit -> unit) -> unit - -val ignore_int : int -> unit - -val ignore_int32 : int32 -> unit - -val ignore_int64 : int64 -> unit - -val ignore_string : string -> unit - -val ignore_float : float -> unit - -val ignore_bool : bool -> unit diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/dune deleted file mode 100644 index dd8393a4427..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/dune +++ /dev/null @@ -1,11 +0,0 @@ -(library - (public_name xapi-stdext-std) - (name xapi_stdext_std) - (modules :standard \ xstringext_test listext_test) -) -(tests - (names xstringext_test listext_test) - (package xapi-stdext-std) - (modules xstringext_test listext_test) - (libraries xapi_stdext_std alcotest) -) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml deleted file mode 100644 index 39ebb6c6ea6..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml +++ /dev/null @@ -1,203 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -module List = struct - open! List - - (** Turn a list into a set *) - let rec setify = function - | [] -> - [] - | x :: xs -> - if mem x xs then setify xs else x :: setify xs - - let subset s1 s2 = - List.fold_left ( && ) true (List.map (fun s -> List.mem s s2) s1) - - let set_equiv s1 s2 = subset s1 s2 && subset s2 s1 - - let iteri_right f list = iteri f (rev list) - - let rec inv_assoc k = function - | [] -> - raise Not_found - | (v, k') :: _ when k = k' -> - v - | _ :: t -> - inv_assoc k t - - (* Tail-recursive map. *) - let map_tr f l = rev (rev_map f l) - - let count pred l = - fold_left (fun count e -> count + if pred e then 1 else 0) 0 l - - let position pred l = - let aux (i, is) e = (i + 1, if pred e then i :: is else is) in - snd (fold_left aux (0, []) l) - - let rev_mapi f l = - let rec aux n accu = function - | h :: t -> - aux (n + 1) (f n h :: accu) t - | [] -> - accu - in - aux 0 [] l - - let mapi_tr f l = rev (rev_mapi f l) - - let take n list = - let rec loop i acc = function - | x :: xs when i < n -> - loop (i + 1) (x :: acc) xs - | _ -> - List.rev acc - in - loop 0 [] list - - let drop n list = - let rec loop i = function - | _ :: xs when i < n -> - loop (i + 1) xs - | l -> - l - in - loop 0 list - - let sub i j l = drop i l |> take (j - max i 0) - - let rec chop i l = - match (i, l) with - | j, _ when j < 0 -> - invalid_arg "chop: index cannot be negative" - | 0, l -> - ([], l) - | _, h :: t -> - (fun (fr, ba) -> (h :: fr, ba)) (chop (i - 1) t) - | _, [] -> - invalid_arg "chop: index not in list" - - let rev_chop i l = - let rec aux i fr ba = - match (i, fr, ba) with - | i, _, _ when i < 0 -> - invalid_arg "rev_chop: index cannot be negative" - | 0, fr, ba -> - (fr, ba) - | i, fr, h :: t -> - aux (i - 1) (h :: fr) t - | _ -> - invalid_arg "rev_chop" - in - aux i [] l - - let chop_tr i l = (fun (fr, ba) -> (rev fr, ba)) (rev_chop i l) - - let rec dice m l = - match chop m l with l, [] -> [l] | l1, l2 -> l1 :: dice m l2 - - let remove i l = - match rev_chop i l with - | rfr, _ :: t -> - rev_append rfr t - | _ -> - invalid_arg "remove" - - let insert i e l = - match rev_chop i l with rfr, ba -> rev_append rfr (e :: ba) - - let replace i e l = - match rev_chop i l with - | rfr, _ :: t -> - rev_append rfr (e :: t) - | _ -> - invalid_arg "replace" - - let morph i f l = - match rev_chop i l with - | rfr, h :: t -> - rev_append rfr (f h :: t) - | _ -> - invalid_arg "morph" - - let rec between e = function - | [] -> - [] - | [h] -> - [h] - | h :: t -> - h :: e :: between e t - - let between_tr e l = - let rec aux accu e = function - | [] -> - rev accu - | [h] -> - rev (h :: accu) - | h :: t -> - aux (e :: h :: accu) e t - in - aux [] e l - - let inner fold_left2 base f l1 l2 g = - fold_left2 (fun accu e1 e2 -> g accu (f e1 e2)) base l1 l2 - - let rec is_sorted compare list = - match list with - | x :: y :: list -> - if compare x y <= 0 then - is_sorted compare (y :: list) - else - false - | _ -> - true - - let intersect xs ys = List.filter (fun x -> List.mem x ys) xs - - let set_difference a b = List.filter (fun x -> not (List.mem x b)) a - - let assoc_default k l d = Option.value ~default:d (List.assoc_opt k l) - - let map_assoc_with_key op al = List.map (fun (k, v1) -> (k, op k v1)) al - - (* Thanks to sharing we only use linear space. (Roughly double the space needed for the spine of the original list) *) - let rec tails = function [] -> [[]] | _ :: xs as l -> l :: tails xs - - let replace_assoc key new_value existing = - (key, new_value) :: List.filter (fun (k, _) -> k <> key) existing - - let update_assoc update existing = - update @ List.filter (fun (k, _) -> not (List.mem_assoc k update)) existing - - let make_assoc op l = map (fun key -> (key, op key)) l - - let unbox_list l = List.filter_map Fun.id l - - let restrict_with_default default keys al = - make_assoc (fun k -> assoc_default k al default) keys - - let range lower = - let rec aux accu upper = - if lower >= upper then - accu - else - aux ((upper - 1) :: accu) (upper - 1) - in - aux [] - - let find_minimum compare = - let min a b = if compare a b <= 0 then a else b in - function [] -> None | x :: xs -> Some (List.fold_left min x xs) -end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.mli deleted file mode 100644 index d3fcfdf79f0..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.mli +++ /dev/null @@ -1,173 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -module List : sig - (** {1 Comparison} *) - - val is_sorted : ('a -> 'a -> int) -> 'a list -> bool - (** [is_sorted cmp l] returns whether [l] is sorted according to [cmp]. *) - - (** {1 Iterators} *) - - val take : int -> 'a list -> 'a list - (** [take n list] returns the first [n] elements of [list] (or less if list - is shorter).*) - - val drop : int -> 'a list -> 'a list - (** [drop n list] returns the list without the first [n] elements of [list] - (or [] if list is shorter). *) - - val rev_mapi : (int -> 'a -> 'b) -> 'a list -> 'b list - (** [rev_map f l] gives the same result as {!Stdlib.List.rev}[ (] - {!Stdlib.List.mapi}[ f l)], but is tail-recursive and more efficient. *) - - val map_tr : ('a -> 'b) -> 'a list -> 'b list - (** [map_tr f l] is {!Stdlib.List.rev}[ (]{!Stdlib.List.rev_map}[ f l)]. *) - - val mapi_tr : (int -> 'a -> 'b) -> 'a list -> 'b list - (** [mapi_tr f l] is {!Stdlib.List.rev}[ (]{!rev_mapi}[ f l)]. *) - - val unbox_list : 'a option list -> 'a list - (** Unbox all values from the option list. *) - - val count : ('a -> bool) -> 'a list -> int - (** Count the number of list elements matching the given predicate. *) - - val position : ('a -> bool) -> 'a list -> int list - (** Find the indices of all elements matching the given predicate. *) - - val iteri_right : (int -> 'a -> unit) -> 'a list -> unit - (** [iteri_right f l] is {!Stdlib.List.iteri}[ f (]{!Stdlib.List.rev}[ l)] *) - - (** {1 List searching} *) - - val find_minimum : ('a -> 'a -> int) -> 'a list -> 'a option - (** [find_minimum cmp l] returns the lowest element in [l] according to - the sort order of [cmp], or [None] if the list is empty. When two ore - more elements match the lowest value, the left-most is returned. *) - - (** {1 Using indices to manipulate lists} *) - - val chop : int -> 'a list -> 'a list * 'a list - (** [chop k l] splits [l] at index [k] to return a pair of lists. Raises - invalid_arg when [i] is negative or greater than the length of [l]. *) - - val rev_chop : int -> 'a list -> 'a list * 'a list - (** [rev_chop k l] splits [l] at index [k] to return a pair of lists, the - first in reverse order. Raises invalid_arg when [i] is negative or - greater than the length of [l]. *) - - val chop_tr : int -> 'a list -> 'a list * 'a list - (** Tail-recursive {!chop}. *) - - val dice : int -> 'a list -> 'a list list - (** [dice k l] splits [l] into lists with [k] elements each. Raises - {!Invalid_arg} if [List.length l] is not divisible by [k]. *) - - val sub : int -> int -> 'a list -> 'a list - (** [sub from to l] returns the sub-list of [l] that starts at index [from] - and ends at [to] or an empty list if [to] is equal or less than [from]. - Negative indices are treated as 0 and indeces higher than [List.length l - - 1] are treated as [List.length l - 1]. *) - - val remove : int -> 'a list -> 'a list - (** Remove the element at the given index. *) - - val insert : int -> 'a -> 'a list -> 'a list - (** Insert the given element at the given index. *) - - val replace : int -> 'a -> 'a list -> 'a list - (** Replace the element at the given index with the given value. *) - - val morph : int -> ('a -> 'a) -> 'a list -> 'a list - (** Apply the given function to the element at the given index. *) - - (** {1 Association Lists} *) - - val make_assoc : ('a -> 'b) -> 'a list -> ('a * 'b) list - - val assoc_default : 'a -> ('a * 'b) list -> 'b -> 'b - (** Act as List.assoc, but return the given default value if the - key is not in the list. *) - - val replace_assoc : 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list - (** Replace the value belonging to a key in an association list. Adds the key/value pair - if it does not yet exist in the list. If the same key occurs multiple time in the original - list, all occurances are removed and replaced by a single new key/value pair. - This function is useful is the assoc list is used as a lightweight map/hashtable/dictonary. *) - - val update_assoc : ('a * 'b) list -> ('a * 'b) list -> ('a * 'b) list - (** Includes everything from [update] and all key/value pairs from [existing] for - which the key does not exist in [update]. In other words, it is like [replace_assoc] - but then given a whole assoc list of updates rather than a single key/value pair. *) - - val map_assoc_with_key : - ('k -> 'v1 -> 'v2) -> ('k * 'v1) list -> ('k * 'v2) list - (** [map_assoc_with_key op al] transforms every value in [al] based on the - key and the value using [op]. *) - - val inv_assoc : 'a -> ('b * 'a) list -> 'b - (** Perform a lookup on an association list of (value, key) pairs. *) - - val restrict_with_default : 'v -> 'k list -> ('k * 'v) list -> ('k * 'v) list - (** [restrict_with_default default keys al] makes a new association map - from [keys] to previous values for [keys] in [al]. If a key is not found - in [al], the [default] is used. *) - - (** {1 Run-length encoded lists} - There are no known users of these functions. *) - - (** {1 Generative functions} - These are usually useful for coding challenges like Advent of Code.*) - - val range : int -> int -> int list - (** range lower upper = [lower; lower + 1; ...; upper - 1] - Returns the empty list if lower >= upper. - Consider building an {!Stdlib.Seq}, it's more flexible *) - - val between : 'a -> 'a list -> 'a list - (** [between e l] Intersperses [e] between elements of [l]. *) - - val between_tr : 'a -> 'a list -> 'a list - (** Tail-recursive {!between}. *) - - val inner : - (('a -> 'b -> 'c -> 'd) -> 'e -> 'f -> 'g -> 'h) - -> 'e - -> ('b -> 'c -> 'i) - -> 'f - -> 'g - -> ('a -> 'i -> 'd) - -> 'h - (** Compute the inner product of two lists. *) - - val tails : 'a list -> 'a list list - - (** {1 Lists as sets, avoid} - Please use Set.Make instead, these functions have quadratic costs! *) - - val setify : 'a list -> 'a list - (** [setify a] removes all duplicates from [a] while maintaining order. - Please use [List.sort_uniq] instead to deduplicate lists if possible *) - - val subset : 'a list -> 'a list -> bool - (** [subset a b] returns whether all elements in [b] can be found in [a]*) - - val set_equiv : 'a list -> 'a list -> bool - - val set_difference : 'a list -> 'a list -> 'a list - (** Returns the set difference of two lists *) - - val intersect : 'a list -> 'a list -> 'a list - (** Returns the intersection of two lists. *) -end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext_test.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext_test.ml deleted file mode 100644 index 2ff7961760e..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext_test.ml +++ /dev/null @@ -1,240 +0,0 @@ -(* Copyright (C) Citrix Systems Inc. - - This program 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; version 2.1 only. with the special - exception on linking described in file LICENSE. - - 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 Lesser General Public License for more details. -*) - -module Listext = Xapi_stdext_std.Listext.List - -let test_list tested_f (name, case, expected) = - let check () = Alcotest.(check @@ list int) name expected (tested_f case) in - (name, `Quick, check) - -let test_option typ tested_f (name, case, expected) = - let check () = Alcotest.(check @@ option typ) name expected (tested_f case) in - (name, `Quick, check) - -let test_chopped_list tested_f (name, case, expected) = - let check () = - Alcotest.(check @@ pair (list int) (list int)) name expected (tested_f case) - in - (name, `Quick, check) - -let test_error tested_f (name, case, expected) = - let check () = Alcotest.check_raises name expected (tested_f case) in - (name, `Quick, check) - -let test_iteri_right = - let specs = - [ - ([], []) - ; ([0], [(0, 0)]) - ; ([2; 4], [(0, 4); (1, 2)]) - ; ([2; 4; 8], [(0, 8); (1, 4); (2, 2)]) - ] - in - let test (list, expected) = - let name = - Printf.sprintf "iteri over from [%s]" - (String.concat "; " (List.map string_of_int list)) - in - let accum = ref [] in - let tested_f = Listext.iteri_right (fun i x -> accum := (i, x) :: !accum) in - let check () = - tested_f list ; - (* reverse the list so the lists in the specs reflect the order of - processing *) - let result = List.rev !accum in - Alcotest.(check @@ list @@ pair int int) name expected result - in - (name, `Quick, check) - in - let tests = List.map test specs in - ("iteri_right", tests) - -let test_take = - let specs = - [ - ([], -1, []) - ; ([], 0, []) - ; ([], 1, []) - ; ([1; 2; 3], -1, []) - ; ([1; 2; 3], 0, []) - ; ([1; 2; 3], 1, [1]) - ; ([1; 2; 3], 2, [1; 2]) - ; ([1; 2; 3], 3, [1; 2; 3]) - ; ([1; 2; 3], 4, [1; 2; 3]) - ; ([1; 2; 3], 5, [1; 2; 3]) - ] - in - let test (whole, number, expected) = - let name = - Printf.sprintf "take %i from [%s]" number - (String.concat "; " (List.map string_of_int whole)) - in - test_list (Listext.take number) (name, whole, expected) - in - let tests = List.map test specs in - ("take", tests) - -let test_drop = - let specs = - [ - ([], -1, []) - ; ([], 0, []) - ; ([], 1, []) - ; ([1; 2; 3], -1, [1; 2; 3]) - ; ([1; 2; 3], 0, [1; 2; 3]) - ; ([1; 2; 3], 1, [2; 3]) - ; ([1; 2; 3], 2, [3]) - ; ([1; 2; 3], 3, []) - ; ([1; 2; 3], 4, []) - ; ([1; 2; 3], 5, []) - ] - in - let test (whole, number, expected) = - let name = - Printf.sprintf "drop %i from [%s]" number - (String.concat "; " (List.map string_of_int whole)) - in - test_list (Listext.drop number) (name, whole, expected) - in - let tests = List.map test specs in - ("drop", tests) - -let test_chop = - let specs = - [ - ([], 0, ([], [])) - ; ([0], 0, ([], [0])) - ; ([0], 1, ([0], [])) - ; ([0; 1], 0, ([], [0; 1])) - ; ([0; 1], 1, ([0], [1])) - ; ([0; 1], 2, ([0; 1], [])) - ] - in - let error_specs = - [ - ([0], -1, Invalid_argument "chop: index cannot be negative") - ; ([0], 2, Invalid_argument "chop: index not in list") - ] - in - let test (whole, number, expected) = - let name = - Printf.sprintf "chop [%s] with %i" - (String.concat "; " (List.map string_of_int whole)) - number - in - test_chopped_list (Listext.chop number) (name, whole, expected) - in - let tests = List.map test specs in - let error_test (whole, number, error) = - let name = - Printf.sprintf "chop [%s] with %i fails" - (String.concat "; " (List.map string_of_int whole)) - number - in - test_error - (fun ls () -> ignore (Listext.chop number ls)) - (name, whole, error) - in - let error_tests = List.map error_test error_specs in - ("chop", tests @ error_tests) - -let test_sub = - let specs = - [ - ([], 0, 0, []) - ; ([], 0, 1, []) - ; ([0], 0, 0, []) - ; ([0], 0, 1, [0]) - ; ([0], 1, 1, []) - ; ([0], 0, 2, [0]) - ; ([0; 1], 0, 0, []) - ; ([0; 1], 0, 1, [0]) - ; ([0; 1], 0, 2, [0; 1]) - ; ([0; 1], 1, 1, []) - ; ([0; 1], 1, 2, [1]) - ; ([0; 1], 2, 2, []) - (* test_cases below used to fail *) [@ocamlformat "disable"] - ; ([0], -1, 0, []) - ; ([0], 0, -1, []) - ; ([0; 1], 1, 0, []) - ] - in - let test (whole, from, until, expected) = - let name = - Printf.sprintf "sub [%s] from %i to %i" - (String.concat "; " (List.map string_of_int whole)) - from until - in - test_list (Listext.sub from until) (name, whole, expected) - in - let tests = List.map test specs in - ("sub", tests) - -let test_find_minimum (name, pp, typ, specs) = - let test ((cmp, cmp_name), input, expected) = - let name = Printf.sprintf "%s of [%s]" cmp_name (pp input) in - test_option typ (Listext.find_minimum cmp) (name, input, expected) - in - let tests = List.map test specs in - (Printf.sprintf "find_minimum (%s)" name, tests) - -let test_find_minimum_int = - let ascending = (Int.compare, "ascending") in - let descending = ((fun a b -> Int.compare b a), "descending") in - let specs_int = - ( "int" - , (fun a -> String.concat "; " (List.map string_of_int a)) - , Alcotest.int - , [ - (ascending, [], None) - ; (ascending, [1; 2; 3; 4; 5], Some 1) - ; (ascending, [2; 3; 1; 5; 4], Some 1) - ; (descending, [], None) - ; (descending, [1; 2; 3; 4; 5], Some 5) - ; (descending, [2; 3; 1; 5; 4], Some 5) - ] - ) - in - test_find_minimum specs_int - -let test_find_minimum_tuple = - let ascending = ((fun (a, _) (b, _) -> Int.compare a b), "ascending") in - let descending = ((fun (a, _) (b, _) -> Int.compare b a), "descending") in - let specs_tuple = - ( "tuple" - , (fun a -> - String.concat "; " - (List.map (fun (a, b) -> "(" ^ string_of_int a ^ ", " ^ b ^ ")") a) - ) - , Alcotest.(pair int string) - , [ - (ascending, [(1, "fst"); (1, "snd")], Some (1, "fst")) - ; (descending, [(1, "fst"); (1, "snd")], Some (1, "fst")) - ; (ascending, [(1, "fst"); (1, "snd"); (2, "nil")], Some (1, "fst")) - ; (descending, [(1, "nil"); (2, "fst"); (2, "snd")], Some (2, "fst")) - ] - ) - in - test_find_minimum specs_tuple - -let () = - Alcotest.run "Listext" - [ - test_iteri_right - ; test_take - ; test_drop - ; test_chop - ; test_sub - ; test_find_minimum_int - ; test_find_minimum_tuple - ] diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml deleted file mode 100644 index 7fb16aba6f8..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml +++ /dev/null @@ -1,223 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -module String = struct - include String - - let of_char c = String.make 1 c - - let rev_map f string = - let n = length string in - String.init n (fun i -> f string.[n - i - 1]) - - let rev_iter f string = - for i = length string - 1 downto 0 do - f string.[i] - done - - let fold_left f accu string = - let accu = ref accu in - for i = 0 to length string - 1 do - accu := f !accu string.[i] - done ; - !accu - - let fold_right f string accu = - let accu = ref accu in - for i = length string - 1 downto 0 do - accu := f string.[i] !accu - done ; - !accu - - let explode string = fold_right (fun h t -> h :: t) string [] - - let implode list = concat "" (List.map of_char list) - - (** True if string 'x' ends with suffix 'suffix' *) - let endswith suffix x = - let x_l = String.length x and suffix_l = String.length suffix in - suffix_l <= x_l && String.sub x (x_l - suffix_l) suffix_l = suffix - - (** True if string 'x' starts with prefix 'prefix' *) - let startswith prefix x = - let x_l = String.length x and prefix_l = String.length prefix in - prefix_l <= x_l && String.sub x 0 prefix_l = prefix - - (** Returns true for whitespace characters, false otherwise *) - let isspace = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false - - (** Removes all the characters from the ends of a string for which the predicate is true *) - let strip predicate string = - let rec remove = function - | [] -> - [] - | c :: cs -> - if predicate c then remove cs else c :: cs - in - implode (List.rev (remove (List.rev (remove (explode string))))) - - let escaped ?rules string = - match rules with - | None -> - String.escaped string - | Some rules -> - let aux h t = - ( if List.mem_assoc h rules then - List.assoc h rules - else - of_char h - ) - :: t - in - concat "" (fold_right aux string []) - - (** Take a predicate and a string, return a list of strings separated by - runs of characters where the predicate was true (excluding those characters from the result) *) - let split_f p str = - let not_p x = not (p x) in - let rec split_one p acc = function - | [] -> - (List.rev acc, []) - | c :: cs -> - if p c then split_one p (c :: acc) cs else (List.rev acc, c :: cs) - in - let rec alternate acc drop chars = - if chars = [] then - acc - else - let a, b = split_one (if drop then p else not_p) [] chars in - alternate (if drop then acc else a :: acc) (not drop) b - in - List.rev (List.map implode (alternate [] true (explode str))) - - let index_opt s c = - let rec loop i = - if String.length s = i then - None - else if s.[i] = c then - Some i - else - loop (i + 1) - in - loop 0 - - let rec split ?(limit = -1) c s = - let i = match index_opt s c with Some x -> x | None -> -1 in - let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in - if i = -1 || nlimit = 0 then - [s] - else - let a = String.sub s 0 i - and b = String.sub s (i + 1) (String.length s - i - 1) in - a :: split ~limit:nlimit c b - - let rtrim s = - let n = String.length s in - if n > 0 && s.[n - 1] = '\n' then - String.sub s 0 (n - 1) - else - s - - (** has_substr str sub returns true if sub is a substring of str. Simple, naive, slow. *) - let has_substr str sub = - if String.length sub > String.length str then - false - else - let result = ref false in - for start = 0 to String.length str - String.length sub do - if String.sub str start (String.length sub) = sub then result := true - done ; - !result - - (** find all occurences of needle in haystack and return all their respective index *) - let find_all needle haystack = - let m = String.length needle and n = String.length haystack in - if m > n then - [] - else - let i = ref 0 and found = ref [] in - while !i < n - m + 1 do - if String.sub haystack !i m = needle then ( - found := !i :: !found ; - i := !i + m - ) else - incr i - done ; - List.rev !found - - (* replace all @f substring in @s by @t *) - let replace f t s = - let indexes = find_all f s in - let n = List.length indexes in - if n > 0 then ( - let len_f = String.length f and len_t = String.length t in - let new_len = String.length s + (n * len_t) - (n * len_f) in - let new_b = Bytes.make new_len '\000' in - let orig_offset = ref 0 and dest_offset = ref 0 in - List.iter - (fun h -> - let len = h - !orig_offset in - Bytes.blit_string s !orig_offset new_b !dest_offset len ; - Bytes.blit_string t 0 new_b (!dest_offset + len) len_t ; - orig_offset := !orig_offset + len + len_f ; - dest_offset := !dest_offset + len + len_t - ) - indexes ; - Bytes.blit_string s !orig_offset new_b !dest_offset - (String.length s - !orig_offset) ; - Bytes.unsafe_to_string new_b - ) else - s - - let filter_chars s valid = - let badchars = ref false in - let buf = Buffer.create 0 in - for i = 0 to String.length s - 1 do - if !badchars then ( - if valid s.[i] then - Buffer.add_char buf s.[i] - ) else if not (valid s.[i]) then ( - Buffer.add_substring buf s 0 i ; - badchars := true - ) - done ; - if !badchars then Buffer.contents buf else s - - let map_unlikely s f = - let changed = ref false in - let m = ref 0 in - let buf = Buffer.create 0 in - for i = 0 to String.length s - 1 do - match f s.[i] with - | None -> - () - | Some n -> - changed := true ; - Buffer.add_substring buf s !m (i - !m) ; - Buffer.add_string buf n ; - m := i + 1 - done ; - if !changed then ( - Buffer.add_substring buf s !m (String.length s - !m) ; - Buffer.contents buf - ) else - s - - let sub_to_end s start = - let length = String.length s in - String.sub s start (length - start) - - let sub_before c s = String.sub s 0 (String.index s c) - - let sub_after c s = sub_to_end s (String.index s c + 1) -end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli deleted file mode 100644 index e2587929916..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli +++ /dev/null @@ -1,88 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -module String : sig - include module type of String - - val of_char : char -> string - - val rev_map : (char -> char) -> string -> string - (** Map a string to a string, applying the given function in reverse - order. *) - - val rev_iter : (char -> unit) -> string -> unit - (** Iterate over the characters in a string in reverse order. *) - - val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a - (** Fold over the characters in a string. *) - - val fold_right : (char -> 'a -> 'a) -> string -> 'a -> 'a - (** Iterate over the characters in a string in reverse order. *) - - val explode : string -> char list - (** Split a string into a list of characters. *) - - val implode : char list -> string - (** Concatenate a list of characters into a string. *) - - val endswith : string -> string -> bool - (** True if string 'x' ends with suffix 'suffix' *) - - val startswith : string -> string -> bool - (** True if string 'x' starts with prefix 'prefix' *) - - val isspace : char -> bool - (** True if the character is whitespace *) - - val strip : (char -> bool) -> string -> string - (** Removes all the characters from the ends of a string for which the predicate is true *) - - val escaped : ?rules:(char * string) list -> string -> string - (** Backward-compatible string escaping, defaulting to the built-in - OCaml string escaping but allowing an arbitrary mapping from characters - to strings. *) - - val split_f : (char -> bool) -> string -> string list - (** Take a predicate and a string, return a list of strings separated by - runs of characters where the predicate was true *) - - val split : ?limit:int -> char -> string -> string list - (** split a string on a single char *) - - val rtrim : string -> string - (** FIXME document me|remove me if similar to strip *) - - val has_substr : string -> string -> bool - (** True if sub is a substr of str *) - - val find_all : string -> string -> int list - (** find all occurences of needle in haystack and return all their respective index *) - - val replace : string -> string -> string -> string - (** replace all [f] substring in [s] by [t] *) - - val filter_chars : string -> (char -> bool) -> string - (** filter chars from a string *) - - val map_unlikely : string -> (char -> string option) -> string - (** map a string trying to fill the buffer by chunk *) - - val sub_to_end : string -> int -> string - (** a substring from the specified position to the end of the string *) - - val sub_before : char -> string -> string - (** a substring from the start of the string to the first occurrence of a given character, excluding the character *) - - val sub_after : char -> string -> string - (** a substring from the first occurrence of a given character to the end of the string, excluding the character *) -end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext_test.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext_test.ml deleted file mode 100644 index 7d2766cbaf4..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext_test.ml +++ /dev/null @@ -1,197 +0,0 @@ -(* Copyright (C) Citrix Systems Inc. - - This program 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; version 2.1 only. with the special - exception on linking described in file LICENSE. - - 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 Lesser General Public License for more details. -*) - -module XString = Xapi_stdext_std.Xstringext.String - -let test_boolean tested_f (name, case, expected) = - let check () = Alcotest.(check bool) name expected (tested_f case) in - (name, `Quick, check) - -let test_string tested_f (name, case, expected) = - let check () = Alcotest.(check string) name expected (tested_f case) in - (name, `Quick, check) - -let test_list tested_f (name, case, expected) = - let check () = - Alcotest.(check @@ list string) name expected (tested_f case) - in - (name, `Quick, check) - -let test_rev_map = - let spec_rev = [("", ""); ("foo bar", "rab oof")] in - let spec_func = [("id", Fun.id); ("uppercase_ascii", Char.uppercase_ascii)] in - let test (f_name, f) (case, expected) = - let expected = String.map f expected in - let name = - Printf.sprintf {|"%s" produces "%s" (%s)|} case expected f_name - in - test_string (XString.rev_map f) (name, case, expected) - in - let tests = - (* Generate the product of the two lists to generate the tests *) - List.concat (List.map (fun func -> List.map (test func) spec_rev) spec_func) - in - ("rev_map", tests) - -let test_split = - let test ?limit (splitter, splitted, expected) = - let split, name = - match limit with - | None -> - let name = Printf.sprintf {|'%c' splits "%s"|} splitter splitted in - (* limit being set to -1 is the same as not using the parameter *) - let split = XString.split ~limit:(-1) in - (split, name) - | Some limit -> - let name = - Printf.sprintf {|'%c' splits "%s" with limit %i|} splitter splitted - limit - in - let split = XString.split ~limit in - (split, name) - in - test_list (split splitter) (name, splitted, expected) - in - let specs_no_limit = - [ - ('.', "...", [""; ""; ""; ""]); ('.', "foo.bar.baz", ["foo"; "bar"; "baz"]) - ] - in - let tests_no_limit = List.map test specs_no_limit in - let specs_limit = - [ - (0, [('.', "...", ["..."]); ('.', "foo.bar.baz", ["foo.bar.baz"])]) - ; (1, [('.', "...", ["..."]); ('.', "foo.bar.baz", ["foo.bar.baz"])]) - ; (2, [('.', "...", [""; ".."]); ('.', "foo.bar.baz", ["foo"; "bar.baz"])]) - ; ( 3 - , [ - ('.', "...", [""; ""; "."]) - ; ('.', "foo.bar.baz", ["foo"; "bar"; "baz"]) - ] - ) - ; (4, [('.', "...", [""; ""; ""; ""])]) - ] - in - let tests_limit = - List.map (fun (limit, spec) -> List.map (test ~limit) spec) specs_limit - |> List.concat - in - ("split", List.concat [tests_no_limit; tests_limit]) - -let test_split_f = - let specs = - [ - (XString.isspace, "foo bar", ["foo"; "bar"]) - ; (XString.isspace, "foo bar", ["foo"; "bar"]) - ; (XString.isspace, "foo \n\t\r bar", ["foo"; "bar"]) - ; (XString.isspace, " foo bar ", ["foo"; "bar"]) - ; (XString.isspace, "", []) - ; (XString.isspace, " ", []) - ] - in - let test (splitter, splitted, expected) = - let name = Printf.sprintf {|"%s"|} (String.escaped splitted) in - test_list (XString.split_f splitter) (name, splitted, expected) - in - let tests = List.map test specs in - ("split_f", tests) - -let test_has_substr = - let spec = - [ - ("", "", true) - ; ("", "foo bar", true) - ; ("f", "foof", true) - ; ("foofo", "foof", false) - ; ("foof", "foof", true) - ; ("f", "foof", true) - ; ("fo", "foof", true) - ; ("of", "foof", true) - ; ("ff", "foof", false) - ] - in - let test (contained, container, expected) = - let name = Printf.sprintf {|"%s" in "%s"|} contained container in - test_boolean (XString.has_substr container) (name, contained, expected) - in - ("has_substr", List.map test spec) - -let test_startswith = - let spec = - [ - ("", "", true) - ; ("", "foo bar", true) - ; ("foofo", "foof", false) - ; ("foof", "foof", true) - ; ("f", "foof", true) - ; ("fo", "foof", true) - ; ("of", "foof", false) - ; ("ff", "foof", false) - ] - in - let test (contained, container, expected) = - let name = Printf.sprintf {|"%s" starts with "%s"|} container contained in - test_boolean (XString.startswith contained) (name, container, expected) - in - ("startswith", List.map test spec) - -let test_endswith = - let spec = - [ - ("", "", true) - ; ("", "foo bar", true) - ; ("ofoof", "foof", false) - ; ("foof", "foof", true) - ; ("f", "foof", true) - ; ("fo", "foof", false) - ; ("of", "foof", true) - ; ("ff", "foof", false) - ] - in - let test (contained, container, expected) = - let name = Printf.sprintf {|"%s" ends with "%s"|} container contained in - test_boolean (XString.endswith contained) (name, container, expected) - in - ("endswith", List.map test spec) - -let test_rtrim = - let spec = - [ - ("", "") - ; ("\n", "") - ; ("\n\n", "\n") - ; ("\n ", "\n ") - ; ("foo\n", "foo") - ; ("fo\no", "fo\no") - ] - in - let test (case, expected) = - let name = - Printf.sprintf {|"%s" gets trimmed to "%s"|} (String.escaped case) - (String.escaped expected) - in - test_string XString.rtrim (name, case, expected) - in - ("rtrim", List.map test spec) - -let () = - Alcotest.run "Xstringext" - [ - test_rev_map - ; test_split - ; test_split_f - ; test_has_substr - ; test_startswith - ; test_endswith - ; test_rtrim - ] diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/dune deleted file mode 100644 index fe2cc6dd85a..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/dune +++ /dev/null @@ -1,8 +0,0 @@ -(library - (public_name xapi-stdext-threads) - (name xapi_stdext_threads) - (libraries - threads.posix - unix - xapi-stdext-pervasives) -) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/semaphore.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/semaphore.ml deleted file mode 100644 index 06621049c91..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/semaphore.ml +++ /dev/null @@ -1,57 +0,0 @@ -(* - * Copyright (C) Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -type t = {mutable n: int; m: Mutex.t; c: Condition.t} - -let create n = - if n <= 0 then - invalid_arg (Printf.sprintf "Semaphore value must be positive, got %d" n) ; - let m = Mutex.create () and c = Condition.create () in - {n; m; c} - -exception Inconsistent_state of string - -let inconsistent_state fmt = - Printf.ksprintf (fun msg -> raise (Inconsistent_state msg)) fmt - -let acquire s k = - if k <= 0 then - invalid_arg - (Printf.sprintf "Semaphore acquisition requires a positive value, got %d" - k - ) ; - Mutex.lock s.m ; - while s.n < k do - Condition.wait s.c s.m - done ; - if not (s.n >= k) then - inconsistent_state "Semaphore value cannot be smaller than %d, got %d" k s.n ; - s.n <- s.n - k ; - Condition.signal s.c ; - Mutex.unlock s.m - -let release s k = - if k <= 0 then - invalid_arg - (Printf.sprintf "Semaphore release requires a positive value, got %d" k) ; - Mutex.lock s.m ; - s.n <- s.n + k ; - Condition.signal s.c ; - Mutex.unlock s.m - -let execute_with_weight s k f = - acquire s k ; - Xapi_stdext_pervasives.Pervasiveext.finally f (fun () -> release s k) - -let execute s f = execute_with_weight s 1 f diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/semaphore.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/semaphore.mli deleted file mode 100644 index 207e612032d..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/semaphore.mli +++ /dev/null @@ -1,40 +0,0 @@ -(* - * Copyright (C) Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -type t - -exception Inconsistent_state of string - -val create : int -> t -(** [create n] create a semaphore with initial value [n] (a positive integer). - Raise {!Invalid_argument} if [n] <= 0 *) - -val acquire : t -> int -> unit -(** [acquire k s] block until the semaphore value is >= [k] (a positive integer), - then atomically decrement the semaphore value by [k]. - Raise {!Invalid_argument} if [k] <= 0 *) - -val release : t -> int -> unit -(** [release k s] atomically increment the semaphore value by [k] (a positive - integer). - Raise {!Invalid_argument} if [k] <= 0 *) - -val execute_with_weight : t -> int -> (unit -> 'a) -> 'a -(** [execute_with_weight s k f] {!acquire} the semaphore with [k], - then run [f ()], and finally {!release} the semaphore with the same value [k] - (even in case of failure in the execution of [f]). - Return the value of [f ()] or re-raise the exception if any. *) - -val execute : t -> (unit -> 'a) -> 'a -(** [execute s f] same as [{execute_with_weight} s 1 f] *) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/threadext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/threadext.ml deleted file mode 100644 index 56025d51154..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/threadext.ml +++ /dev/null @@ -1,113 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -module M = Mutex - -module Mutex = struct - (** execute the function f with the mutex hold *) - let execute lock f = - Mutex.lock lock ; - Xapi_stdext_pervasives.Pervasiveext.finally f (fun () -> Mutex.unlock lock) -end - -(** Parallel List.iter. Remembers all exceptions and returns an association list mapping input x to an exception. - Applications of x which succeed will be missing from the returned list. *) -let thread_iter_all_exns f xs = - let exns = ref [] in - let m = M.create () in - List.iter Thread.join - (List.map - (fun x -> - Thread.create - (fun () -> - try f x - with e -> Mutex.execute m (fun () -> exns := (x, e) :: !exns) - ) - () - ) - xs - ) ; - !exns - -(** Parallel List.iter. Remembers one exception (at random) and throws it in the - error case. *) -let thread_iter f xs = - match thread_iter_all_exns f xs with [] -> () | (_, e) :: _ -> raise e - -module Delay = struct - (* Concrete type is the ends of a pipe *) - type t = { - (* A pipe is used to wake up a thread blocked in wait: *) - mutable pipe_out: Unix.file_descr option - ; mutable pipe_in: Unix.file_descr option - ; (* Indicates that a signal arrived before a wait: *) - mutable signalled: bool - ; m: M.t - } - - let make () = - {pipe_out= None; pipe_in= None; signalled= false; m= M.create ()} - - exception Pre_signalled - - let wait (x : t) (seconds : float) = - let finally = Xapi_stdext_pervasives.Pervasiveext.finally in - let to_close = ref [] in - let close' fd = - if List.mem fd !to_close then Unix.close fd ; - to_close := List.filter (fun x -> fd <> x) !to_close - in - finally - (fun () -> - try - let pipe_out = - Mutex.execute x.m (fun () -> - if x.signalled then ( - x.signalled <- false ; - raise Pre_signalled - ) ; - let pipe_out, pipe_in = Unix.pipe () in - (* these will be unconditionally closed on exit *) - to_close := [pipe_out; pipe_in] ; - x.pipe_out <- Some pipe_out ; - x.pipe_in <- Some pipe_in ; - x.signalled <- false ; - pipe_out - ) - in - let r, _, _ = Unix.select [pipe_out] [] [] seconds in - (* flush the single byte from the pipe *) - if r <> [] then ignore (Unix.read pipe_out (Bytes.create 1) 0 1) ; - (* return true if we waited the full length of time, false if we were woken *) - r = [] - with Pre_signalled -> false - ) - (fun () -> - Mutex.execute x.m (fun () -> - x.pipe_out <- None ; - x.pipe_in <- None ; - List.iter close' !to_close - ) - ) - - let signal (x : t) = - Mutex.execute x.m (fun () -> - match x.pipe_in with - | Some fd -> - ignore (Unix.write fd (Bytes.of_string "X") 0 1) - | None -> - x.signalled <- true - (* If the wait hasn't happened yet then store up the signal *) - ) -end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/threadext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/threadext.mli deleted file mode 100644 index 8349ab71366..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/threadext.mli +++ /dev/null @@ -1,35 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -module Mutex : sig - val execute : Mutex.t -> (unit -> 'a) -> 'a -end - -val thread_iter_all_exns : ('a -> unit) -> 'a list -> ('a * exn) list - -val thread_iter : ('a -> unit) -> 'a list -> unit - -module Delay : sig - type t - - val make : unit -> t - - val wait : t -> float -> bool - (** Blocks the calling thread for a given period of time with the option of - returning early if someone calls 'signal'. Returns true if the full time - period elapsed and false if signalled. Note that multple 'signals' are - coalesced; 'signals' sent before 'wait' is called are not lost. *) - - val signal : t -> unit - (** Sends a signal to a waiting thread. See 'wait' *) -end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/blkgetsize.h b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/blkgetsize.h deleted file mode 100644 index a9cd75bfedc..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/blkgetsize.h +++ /dev/null @@ -1,6 +0,0 @@ -#ifndef BLKGETSIZE_H -#define BLKGETSIZE_H - -#include -int stdext_blkgetsize(int fd, uint64_t *psize); -#endif diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/blkgetsize_stubs.c b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/blkgetsize_stubs.c deleted file mode 100644 index 0324f3dfb3f..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/blkgetsize_stubs.c +++ /dev/null @@ -1,78 +0,0 @@ -/* - * Copyright (C) 2012-2013 Citrix Inc - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - */ - -#include -#include -#include - -#include -#include -#include -#include - -#include -#include -#include -#include -#include -#include - -#include "blkgetsize.h" -#ifdef __linux__ -#include - -int stdext_blkgetsize(int fd, uint64_t *psize) -{ -#ifdef BLKGETSIZE64 - int ret = ioctl(fd, BLKGETSIZE64, psize); -#elif BLKGETSIZE - unsigned long sectors = 0; - int ret = ioctl(fd, BLKGETSIZE, §ors); - *psize = sectors * 512ULL; -#else -# error "Linux configuration error (blkgetsize)" -#endif - return ret; -} - -#elif defined(__APPLE__) -#include - -int stdext_blkgetsize(int fd, uint64_t *psize) -{ - unsigned long blocksize = 0; - int ret = ioctl(fd, DKIOCGETBLOCKSIZE, &blocksize); - if (!ret) { - unsigned long nblocks; - ret = ioctl(fd, DKIOCGETBLOCKCOUNT, &nblocks); - if (!ret) - *psize = (uint64_t)nblocks * blocksize; - } - return ret; -} - -#elif defined(__FreeBSD__) -#include - -int stdext_blkgetsize(int fd, uint64_t *psize) -{ - int ret = ioctl(fd, DIOCGMEDIASIZE, psize); - return ret; -} - -#else -# error "Unable to query block device size: unsupported platform, please report." -#endif diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/dune deleted file mode 100644 index da0b509d2d2..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/dune +++ /dev/null @@ -1,16 +0,0 @@ -(library - (name xapi_stdext_unix) - (public_name xapi-stdext-unix) - (libraries - fd-send-recv - unix - xapi-backtrace - xapi-stdext-pervasives) - (foreign_stubs - (language c) - (names - blkgetsize_stubs - unixext_open_stubs - unixext_stubs - unixext_write_stubs)) -) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml deleted file mode 100644 index 4cf628d45e9..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml +++ /dev/null @@ -1,819 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -open Xapi_stdext_pervasives.Pervasiveext - -exception Unix_error of int - -let _exit = Unix._exit - -(** remove a file, but doesn't raise an exception if the file is already removed *) -let unlink_safe file = - try Unix.unlink file with (* Unix.Unix_error (Unix.ENOENT, _ , _)*) _ -> () - -(** create a directory but doesn't raise an exception if the directory already exist *) -let mkdir_safe dir perm = - try Unix.mkdir dir perm with Unix.Unix_error (Unix.EEXIST, _, _) -> () - -(** create a directory, and create parent if doesn't exist *) -let mkdir_rec dir perm = - let rec p_mkdir dir = - let p_name = Filename.dirname dir in - if p_name <> "/" && p_name <> "." then - p_mkdir p_name ; - mkdir_safe dir perm - in - p_mkdir dir - -(** removes a file or recursively removes files/directories below a directory without following - symbolic links. If path is a directory, it is only itself removed if rm_top is true. If path - is non-existent nothing happens, it does not lead to an error. *) -let rm_rec ?(rm_top = true) path = - let ( // ) = Filename.concat in - let rec rm rm_top path = - match Unix.lstat path with - | exception Unix.Unix_error (Unix.ENOENT, _, _) -> - () (*noop*) - | exception e -> - raise e - | st -> ( - match st.Unix.st_kind with - | Unix.S_DIR -> - Sys.readdir path |> Array.iter (fun file -> rm true (path // file)) ; - if rm_top then Unix.rmdir path - | _ -> - Unix.unlink path - ) - in - rm rm_top path - -(** write a pidfile file *) -let pidfile_write filename = - let fd = - Unix.openfile filename [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o640 - in - finally - (fun () -> - let pid = Unix.getpid () in - let buf = string_of_int pid ^ "\n" in - let len = String.length buf in - if Unix.write fd (Bytes.unsafe_of_string buf) 0 len <> len then - failwith "pidfile_write failed" - ) - (fun () -> Unix.close fd) - -(** read a pidfile file, return either Some pid or None *) -let pidfile_read filename = - let fd = Unix.openfile filename [Unix.O_RDONLY] 0o640 in - finally - (fun () -> - try - let buf = Bytes.create 80 in - let rd = Unix.read fd buf 0 (Bytes.length buf) in - if rd = 0 then - failwith "pidfile_read failed" ; - Scanf.sscanf (Bytes.sub_string buf 0 rd) "%d" (fun i -> Some i) - with _ -> None - ) - (fun () -> Unix.close fd) - -(** open a file, and make sure the close is always done *) -let with_file file mode perms f = - let fd = Unix.openfile file mode perms in - Xapi_stdext_pervasives.Pervasiveext.finally - (fun () -> f fd) - (fun () -> Unix.close fd) - -(* !! Must call this before spawning any threads !! *) - -(** daemonize a process *) -let daemonize () = - match Unix.fork () with - | 0 -> ( - if Unix.setsid () == -1 then - failwith "Unix.setsid failed" ; - match Unix.fork () with - | 0 -> - with_file "/dev/null" [Unix.O_WRONLY] 0 (fun nullfd -> - Unix.close Unix.stdin ; - Unix.dup2 nullfd Unix.stdout ; - Unix.dup2 nullfd Unix.stderr - ) - | _ -> - exit 0 - ) - | _ -> - exit 0 - -exception Break - -let lines_fold f start input = - let accumulator = ref start in - let running = ref true in - while !running do - let line = try Some (input_line input) with End_of_file -> None in - match line with - | Some line -> ( - try accumulator := f !accumulator line with Break -> running := false - ) - | None -> - running := false - done ; - !accumulator - -let lines_iter f = lines_fold (fun () line -> ignore (f line)) () - -(** open a file, and make sure the close is always done *) -let with_input_channel file f = - let input = open_in file in - finally (fun () -> f input) (fun () -> close_in input) - -let file_lines_fold f start file_path = - with_input_channel file_path (lines_fold f start) - -let read_lines ~(path : string) : string list = - List.rev (file_lines_fold (fun acc line -> line :: acc) [] path) - -let file_lines_iter f = file_lines_fold (fun () line -> ignore (f line)) () - -let readfile_line = file_lines_iter - -(** [fd_blocks_fold block_size f start fd] folds [f] over blocks (strings) - from the fd [fd] with initial value [start] *) -let fd_blocks_fold block_size f start fd = - let block = Bytes.create block_size in - let rec fold acc = - let n = Unix.read fd block 0 block_size in - (* Consider making the interface explicitly use Substrings *) - let b = if n = block_size then block else Bytes.sub block 0 n in - if n = 0 then acc else fold (f acc b) - in - fold start - -let with_directory dir f = - let dh = Unix.opendir dir in - Xapi_stdext_pervasives.Pervasiveext.finally - (fun () -> f dh) - (fun () -> Unix.closedir dh) - -let buffer_of_fd fd = - fd_blocks_fold 1024 - (fun b s -> Buffer.add_bytes b s ; b) - (Buffer.create 1024) fd - -let string_of_fd fd = Buffer.contents (buffer_of_fd fd) - -let buffer_of_file file_path = - with_file file_path [Unix.O_RDONLY] 0 buffer_of_fd - -let string_of_file file_path = Buffer.contents (buffer_of_file file_path) - -(** Write a file, ensures atomicity and durability. *) -let atomic_write_to_file fname perms f = - let dir_path = Filename.dirname fname in - let tmp_path, tmp_chan = - Filename.open_temp_file ~temp_dir:dir_path "" ".tmp" - in - let tmp_fd = Unix.descr_of_out_channel tmp_chan in - let write_tmp_file () = - let result = f tmp_fd in - Unix.fchmod tmp_fd perms ; Unix.fsync tmp_fd ; result - in - let write_and_persist () = - let result = finally write_tmp_file (fun () -> Stdlib.close_out tmp_chan) in - Unix.rename tmp_path fname ; - (* sync parent directory to make sure the file is persisted *) - let dir_fd = Unix.openfile dir_path [O_RDONLY] 0 in - finally (fun () -> Unix.fsync dir_fd) (fun () -> Unix.close dir_fd) ; - result - in - finally write_and_persist (fun () -> unlink_safe tmp_path) - -(** Atomically write a string to a file *) -let write_bytes_to_file ?(perms = 0o644) fname b = - atomic_write_to_file fname perms (fun fd -> - let len = Bytes.length b in - let written = Unix.write fd b 0 len in - if written <> len then failwith "Short write occured!" - ) - -let write_string_to_file ?(perms = 0o644) fname s = - write_bytes_to_file fname ~perms (Bytes.unsafe_of_string s) - -let execv_get_output cmd args = - let pipe_exit, pipe_entrance = Unix.pipe () in - let r = - try - Unix.set_close_on_exec pipe_exit ; - true - with _ -> false - in - match Unix.fork () with - | 0 -> ( - Unix.dup2 pipe_entrance Unix.stdout ; - Unix.close pipe_entrance ; - if not r then - Unix.close pipe_exit ; - try Unix.execv cmd args with _ -> exit 127 - ) - | pid -> - Unix.close pipe_entrance ; (pid, pipe_exit) - -let copy_file_internal ?limit reader writer = - let buffer = Bytes.make 65536 '\000' in - let buffer_len = Int64.of_int (Bytes.length buffer) in - let finished = ref false in - let total_bytes = ref 0L in - let limit = ref limit in - while not !finished do - let requested = min (Option.value ~default:buffer_len !limit) buffer_len in - let num = reader buffer 0 (Int64.to_int requested) in - let num64 = Int64.of_int num in - limit := Option.map (fun x -> Int64.sub x num64) !limit ; - ignore_int (writer buffer 0 num) ; - total_bytes := Int64.add !total_bytes num64 ; - finished := num = 0 || !limit = Some 0L - done ; - !total_bytes - -let copy_file ?limit ifd ofd = - copy_file_internal ?limit (Unix.read ifd) (Unix.write ofd) - -let file_exists file_path = - try - Unix.access file_path [Unix.F_OK] ; - true - with _ -> false - -let touch_file file_path = - let fd = - Unix.openfile file_path - [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_NOCTTY; Unix.O_NONBLOCK] - 0o666 - in - Unix.close fd ; - Unix.utimes file_path 0.0 0.0 - -let is_empty_file file_path = - try - let stats = Unix.stat file_path in - stats.Unix.st_size = 0 - with Unix.Unix_error (Unix.ENOENT, _, _) -> false - -let delete_empty_file file_path = - if is_empty_file file_path then ( - Sys.remove file_path ; true - ) else - false - -(** Create a new file descriptor, connect it to host:port and return it *) -exception Host_not_found of string - -let open_connection_fd host port = - let open Unix in - let addrinfo = - getaddrinfo host (string_of_int port) [AI_SOCKTYPE SOCK_STREAM] - in - match addrinfo with - | [] -> - failwith (Printf.sprintf "Couldn't resolve hostname: %s" host) - | ai :: _ -> ( - let s = socket ai.ai_family ai.ai_socktype 0 in - try connect s ai.ai_addr ; s - with e -> Backtrace.is_important e ; close s ; raise e - ) - -let open_connection_unix_fd filename = - let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in - try - let addr = Unix.ADDR_UNIX filename in - Unix.connect s addr ; s - with e -> Backtrace.is_important e ; Unix.close s ; raise e - -module CBuf = struct - (** A circular buffer constructed from a string *) - type t = { - mutable buffer: bytes - ; mutable len: int (** bytes of valid data in [buffer] *) - ; mutable start: int (** index of first valid byte in [buffer] *) - ; mutable r_closed: bool (** true if no more data can be read due to EOF *) - ; mutable w_closed: bool - (** true if no more data can be written due to EOF *) - } - - let empty length = - { - buffer= Bytes.create length - ; len= 0 - ; start= 0 - ; r_closed= false - ; w_closed= false - } - - let drop (x : t) n = - if n > x.len then failwith (Printf.sprintf "drop %d > %d" n x.len) ; - x.start <- (x.start + n) mod Bytes.length x.buffer ; - x.len <- x.len - n - - let should_read (x : t) = - (not x.r_closed) && x.len < Bytes.length x.buffer - 1 - - let should_write (x : t) = (not x.w_closed) && x.len > 0 - - let end_of_reads (x : t) = x.r_closed && x.len = 0 - - let end_of_writes (x : t) = x.w_closed - - let write (x : t) fd = - (* Offset of the character after the substring *) - let next = min (Bytes.length x.buffer) (x.start + x.len) in - let len = next - x.start in - let written = - try Unix.single_write fd x.buffer x.start len - with _ -> - x.w_closed <- true ; - len - in - drop x written - - let read (x : t) fd = - (* Offset of the next empty character *) - let next = (x.start + x.len) mod Bytes.length x.buffer in - let len = - min (Bytes.length x.buffer - next) (Bytes.length x.buffer - x.len) - in - let read = Unix.read fd x.buffer next len in - if read = 0 then x.r_closed <- true ; - x.len <- x.len + read -end - -exception Process_still_alive - -let kill_and_wait ?(signal = Sys.sigterm) ?(timeout = 10.) pid = - let proc_entry_exists pid = - try - Unix.access (Printf.sprintf "/proc/%d" pid) [Unix.F_OK] ; - true - with _ -> false - in - if pid > 0 && proc_entry_exists pid then ( - let loop_time_waiting = 0.03 in - let left = ref timeout in - let readcmdline pid = - try string_of_file (Printf.sprintf "/proc/%d/cmdline" pid) with _ -> "" - in - let reference = readcmdline pid and quit = ref false in - Unix.kill pid signal ; - (* We cannot do a waitpid here, since we might not be parent of - the process, so instead we are waiting for the /proc/%d to go - away. Also we verify that the cmdline stay the same if it's still here - to prevent the very very unlikely event that the pid get reused before - we notice it's gone *) - while proc_entry_exists pid && (not !quit) && !left > 0. do - let cmdline = readcmdline pid in - if cmdline = reference then ( - (* still up, let's sleep a bit *) - ignore (Unix.select [] [] [] loop_time_waiting) ; - left := !left -. loop_time_waiting - ) else (* not the same, it's gone ! *) - quit := true - done ; - if !left <= 0. then - raise Process_still_alive - ) - -let string_of_signal x = - let table = - [ - (Sys.sigabrt, "SIGABRT") - ; (Sys.sigalrm, "SIGALRM") - ; (Sys.sigfpe, "SIGFPE") - ; (Sys.sighup, "SIGHUP") - ; (Sys.sigill, "SIGILL") - ; (Sys.sigint, "SIGINT") - ; (Sys.sigkill, "SIGKILL") - ; (Sys.sigpipe, "SIGPIPE") - ; (Sys.sigquit, "SIGQUIT") - ; (Sys.sigsegv, "SIGSEGV") - ; (Sys.sigterm, "SIGTERM") - ; (Sys.sigusr1, "SIGUSR1") - ; (Sys.sigusr2, "SIGUSR2") - ; (Sys.sigchld, "SIGCHLD") - ; (Sys.sigcont, "SIGCONT") - ; (Sys.sigstop, "SIGSTOP") - ; (Sys.sigttin, "SIGTTIN") - ; (Sys.sigttou, "SIGTTOU") - ; (Sys.sigvtalrm, "SIGVTALRM") - ; (Sys.sigprof, "SIGPROF") - ] - in - if List.mem_assoc x table then - List.assoc x table - else - Printf.sprintf "(ocaml signal %d with an unknown name)" x - -let proxy (a : Unix.file_descr) (b : Unix.file_descr) = - let size = 64 * 1024 in - (* [a'] is read from [a] and will be written to [b] *) - (* [b'] is read from [b] and will be written to [a] *) - let a' = CBuf.empty size and b' = CBuf.empty size in - Unix.set_nonblock a ; - Unix.set_nonblock b ; - try - while true do - let r = - (if CBuf.should_read a' then [a] else []) - @ if CBuf.should_read b' then [b] else [] - in - let w = - (if CBuf.should_write a' then [b] else []) - @ if CBuf.should_write b' then [a] else [] - in - (* If we can't make any progress (because fds have been closed), then stop *) - if r = [] && w = [] then raise End_of_file ; - let r, w, _ = Unix.select r w [] (-1.0) in - (* Do the writing before the reading *) - List.iter - (fun fd -> if a = fd then CBuf.write b' a else CBuf.write a' b) - w ; - List.iter (fun fd -> if a = fd then CBuf.read a' a else CBuf.read b' b) r ; - (* If there's nothing else to read or write then signal the other end *) - List.iter - (fun (buf, fd) -> - if CBuf.end_of_reads buf then Unix.shutdown fd Unix.SHUTDOWN_SEND ; - if CBuf.end_of_writes buf then Unix.shutdown fd Unix.SHUTDOWN_RECEIVE - ) - [(a', b); (b', a)] - done - with _ -> ( - (try Unix.clear_nonblock a with _ -> ()) ; - (try Unix.clear_nonblock b with _ -> ()) ; - (try Unix.close a with _ -> ()) ; - try Unix.close b with _ -> () - ) - -let try_read_string ?limit fd = - let buf = Buffer.create 0 in - let chunk = match limit with None -> 4096 | Some x -> x in - let cache = Bytes.make chunk '\000' in - let finished = ref false in - while not !finished do - let to_read = - match limit with - | Some x -> - min (x - Buffer.length buf) chunk - | None -> - chunk - in - let read_bytes = Unix.read fd cache 0 to_read in - Buffer.add_subbytes buf cache 0 read_bytes ; - if read_bytes = 0 then finished := true - done ; - Buffer.contents buf - -(* From https://ocaml.github.io/ocamlunix/ocamlunix.html#sec118 - The function write of the Unix module iterates the system call write until - all the requested bytes are effectively written. - val write : file_descr -> string -> int -> int -> int - However, when the descriptor is a pipe (or a socket, see chapter 6), writes - may block and the system call write may be interrupted by a signal. In this - case the OCaml call to Unix.write is interrupted and the error EINTR is raised. - The problem is that some of the data may already have been written by a - previous system call to write but the actual size that was transferred is - unknown and lost. This renders the function write of the Unix module useless - in the presence of signals. - - To address this problem, the Unix module also provides the “raw” system call - write under the name single_write. - - We can use multiple single_write calls to write exactly the requested - amount of data (but not atomically!). -*) -let rec restart_on_EINTR f x = - try f x with Unix.Unix_error (Unix.EINTR, _, _) -> restart_on_EINTR f x - -and really_write fd buffer offset len = - let n = restart_on_EINTR (Unix.single_write_substring fd buffer offset) len in - if n < len then really_write fd buffer (offset + n) (len - n) - -(* Ideally, really_write would be implemented with optional arguments ?(off=0) ?(len=String.length string) *) -let really_write_string fd string = - really_write fd string 0 (String.length string) - -let rec really_read fd string off n = - if n = 0 then - () - else - let m = restart_on_EINTR (Unix.read fd string off) n in - if m = 0 then raise End_of_file ; - really_read fd string (off + m) (n - m) - -let really_read_string fd length = - let buf = Bytes.make length '\000' in - really_read fd buf 0 length ; - Bytes.unsafe_to_string buf - -(* --------------------------------------------------------------------------------------- *) -(* Functions to read and write to/from a file descriptor with a given latest response time *) - -exception Timeout - -(* Write as many bytes to a file descriptor as possible from data before a given clock time. *) -(* Raises Timeout exception if the number of bytes written is less than the specified length. *) -(* Writes into the file descriptor at the current cursor position. *) -let time_limited_write_internal - (write : Unix.file_descr -> 'a -> int -> int -> int) filedesc length data - target_response_time = - let total_bytes_to_write = length in - let bytes_written = ref 0 in - let now = ref (Unix.gettimeofday ()) in - while !bytes_written < total_bytes_to_write && !now < target_response_time do - let remaining_time = target_response_time -. !now in - let _, ready_to_write, _ = Unix.select [] [filedesc] [] remaining_time in - (* Note: there is a possibility that the storage could go away after the select and before the write, so the write would block. *) - ( if List.mem filedesc ready_to_write then - let bytes_to_write = total_bytes_to_write - !bytes_written in - let bytes = - try write filedesc data !bytes_written bytes_to_write - with - | Unix.Unix_error (Unix.EAGAIN, _, _) - | Unix.Unix_error (Unix.EWOULDBLOCK, _, _) - -> - 0 - in - (* write from buffer=data from offset=bytes_written, length=bytes_to_write *) - bytes_written := bytes + !bytes_written - ) ; - now := Unix.gettimeofday () - done ; - if !bytes_written = total_bytes_to_write then - () - else (* we ran out of time *) - raise Timeout - -let time_limited_write filedesc length data target_response_time = - time_limited_write_internal Unix.write filedesc length data - target_response_time - -let time_limited_write_substring filedesc length data target_response_time = - time_limited_write_internal Unix.write_substring filedesc length data - target_response_time - -(* Read as many bytes to a file descriptor as possible before a given clock time. *) -(* Raises Timeout exception if the number of bytes read is less than the desired number. *) -(* Reads from the file descriptor at the current cursor position. *) -let time_limited_read filedesc length target_response_time = - let total_bytes_to_read = length in - let bytes_read = ref 0 in - let buf = Bytes.make total_bytes_to_read '\000' in - let now = ref (Unix.gettimeofday ()) in - while !bytes_read < total_bytes_to_read && !now < target_response_time do - let remaining_time = target_response_time -. !now in - let ready_to_read, _, _ = Unix.select [filedesc] [] [] remaining_time in - ( if List.mem filedesc ready_to_read then - let bytes_to_read = total_bytes_to_read - !bytes_read in - let bytes = - try Unix.read filedesc buf !bytes_read bytes_to_read - with - | Unix.Unix_error (Unix.EAGAIN, _, _) - | Unix.Unix_error (Unix.EWOULDBLOCK, _, _) - -> - 0 - in - (* read into buffer=buf from offset=bytes_read, length=bytes_to_read *) - if bytes = 0 then - raise End_of_file (* End of file has been reached *) - else - bytes_read := bytes + !bytes_read - ) ; - now := Unix.gettimeofday () - done ; - if !bytes_read = total_bytes_to_read then - Bytes.unsafe_to_string buf - else (* we ran out of time *) - raise Timeout - -(* --------------------------------------------------------------------------------------- *) - -(* Read a given number of bytes of data from the fd, or stop at EOF, whichever comes first. *) -(* A negative ~max_bytes indicates that all the data should be read from the fd until EOF. This is the default. *) -let read_data_in_chunks_internal (sub : bytes -> int -> int -> 'a) - (f : 'a -> int -> unit) ?(block_size = 1024) ?(max_bytes = -1) from_fd = - let buf = Bytes.make block_size '\000' in - let rec do_read acc = - let remaining_bytes = max_bytes - acc in - if remaining_bytes = 0 then - acc (* we've read the amount requested *) - else - let bytes_to_read = - if max_bytes < 0 || remaining_bytes > block_size then - block_size - else - remaining_bytes - in - let bytes_read = Unix.read from_fd buf 0 bytes_to_read in - if bytes_read = 0 then - acc (* we reached EOF *) - else ( - f (sub buf 0 bytes_read) bytes_read ; - do_read (acc + bytes_read) - ) - in - do_read 0 - -let read_data_in_string_chunks (f : string -> int -> unit) ?(block_size = 1024) - ?(max_bytes = -1) from_fd = - read_data_in_chunks_internal Bytes.sub_string f ~block_size ~max_bytes from_fd - -let read_data_in_chunks (f : bytes -> int -> unit) ?(block_size = 1024) - ?(max_bytes = -1) from_fd = - read_data_in_chunks_internal Bytes.sub f ~block_size ~max_bytes from_fd - -let spawnvp ?(pid_callback = fun _ -> ()) cmd args = - match Unix.fork () with - | 0 -> - Unix.execvp cmd args - | pid -> - (try pid_callback pid with _ -> ()) ; - snd (Unix.waitpid [] pid) - -let double_fork f = - match Unix.fork () with - | 0 -> ( - match Unix.fork () with - (* NB: use _exit (calls C lib _exit directly) to avoid - calling at_exit handlers and flushing output channels - which wouild cause intermittent deadlocks if we - forked from a threaded program *) - | 0 -> - (try f () with _ -> ()) ; - _exit 0 - | _ -> - _exit 0 - ) - | pid -> - ignore (Unix.waitpid [] pid) - -external set_tcp_nodelay : Unix.file_descr -> bool -> unit - = "stub_unixext_set_tcp_nodelay" - -external set_sock_keepalives : Unix.file_descr -> int -> int -> int -> unit - = "stub_unixext_set_sock_keepalives" - -external fsync : Unix.file_descr -> unit = "stub_unixext_fsync" - -external blkgetsize64 : Unix.file_descr -> int64 = "stub_unixext_blkgetsize64" - -external get_max_fd : unit -> int = "stub_unixext_get_max_fd" - -let int_of_file_descr (x : Unix.file_descr) : int = Obj.magic x - -let file_descr_of_int (x : int) : Unix.file_descr = Obj.magic x - -(** Forcibly closes all open file descriptors except those explicitly passed in as arguments. - Useful to avoid accidentally passing a file descriptor opened in another thread to a - process being concurrently fork()ed (there's a race between open/set_close_on_exec). - NB this assumes that 'type Unix.file_descr = int' -*) -let close_all_fds_except (fds : Unix.file_descr list) = - (* get at the file descriptor within *) - let fds' = List.map int_of_file_descr fds in - let close' (x : int) = try Unix.close (file_descr_of_int x) with _ -> () in - let highest_to_keep = List.fold_left max (-1) fds' in - (* close all the fds higher than the one we want to keep *) - for i = highest_to_keep + 1 to get_max_fd () do - close' i - done ; - (* close all the rest *) - for i = 0 to highest_to_keep - 1 do - if not (List.mem i fds') then close' i - done - -(** Remove "." and ".." from paths (NB doesn't attempt to resolve symlinks) *) -let resolve_dot_and_dotdot (path : string) : string = - let of_string (x : string) : string list = - let rec rev_split path = - let basename = Filename.basename path - and dirname = Filename.dirname path in - let rest = - if Filename.dirname dirname = dirname then [] else rev_split dirname - in - basename :: rest - in - let abs_path path = - if Filename.is_relative path then - Filename.concat "/" path (* no notion of a cwd *) - else - path - in - rev_split (abs_path x) - in - let to_string (x : string list) = - List.fold_left Filename.concat "/" (List.rev x) - in - (* Process all "." and ".." references *) - let rec remove_dots (n : int) (x : string list) = - match (x, n) with - | [], _ -> - [] - | "." :: rest, _ -> - remove_dots n rest (* throw away ".", don't count as parent for ".." *) - | ".." :: rest, _ -> - remove_dots (n + 1) rest (* note the number of ".." *) - | x :: rest, 0 -> - x :: remove_dots 0 rest - | _ :: rest, n -> - remove_dots (n - 1) rest (* munch *) - in - to_string (remove_dots 0 (of_string path)) - -(** Seek to an absolute offset within a file descriptor *) -let seek_to fd pos = Unix.lseek fd pos Unix.SEEK_SET - -(** Seek to an offset within a file descriptor, relative to the current cursor position *) -let seek_rel fd diff = Unix.lseek fd diff Unix.SEEK_CUR - -(** Return the current cursor position within a file descriptor *) -let current_cursor_pos fd = - (* 'seek' to the current position, exploiting the return value from Unix.lseek as the new cursor position *) - Unix.lseek fd 0 Unix.SEEK_CUR - -let wait_for_path path delay timeout = - let rec inner ttl = - if ttl = 0 then failwith "No path!" ; - try ignore (Unix.stat path) - with _ -> - delay 0.5 ; - inner (ttl - 1) - in - inner (timeout * 2) - -let _ = Callback.register_exception "unixext.unix_error" (Unix_error 0) - -let send_fd = Fd_send_recv.send_fd - -let send_fd_substring = Fd_send_recv.send_fd_substring - -let recv_fd = Fd_send_recv.recv_fd - -type statvfs_t = { - f_bsize: int64 - ; f_frsize: int64 - ; f_blocks: int64 - ; f_bfree: int64 - ; f_bavail: int64 - ; f_files: int64 - ; f_ffree: int64 - ; f_favail: int64 - ; f_fsid: int64 - ; f_flag: int64 - ; f_namemax: int64 -} - -external statvfs : string -> statvfs_t = "stub_statvfs" - -(** Returns Some Unix.PF_INET or Some Unix.PF_INET6 if passed a valid IP address, otherwise returns None. *) -let domain_of_addr str = - try - let addr = Unix.inet_addr_of_string str in - Some (Unix.domain_of_sockaddr (Unix.ADDR_INET (addr, 1))) - with _ -> None - -module Direct = struct - type t = Unix.file_descr - - external openfile : string -> Unix.open_flag list -> Unix.file_perm -> t - = "stub_stdext_unix_open_direct" - - let close = Unix.close - - let with_openfile path flags perms f = - let t = openfile path flags perms in - finally (fun () -> f t) (fun () -> close t) - - external unsafe_write : t -> bytes -> int -> int -> int - = "stub_stdext_unix_write" - - let write fd buf ofs len = - if ofs < 0 || len < 0 || ofs > Bytes.length buf - len then - invalid_arg "Unixext.write" - else - unsafe_write fd buf ofs len - - let copy_from_fd ?limit socket fd = - copy_file_internal ?limit (Unix.read socket) (write fd) - - let fsync x = fsync x - - let lseek fd x cmd = Unix.LargeFile.lseek fd x cmd -end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli deleted file mode 100644 index c6168150b54..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli +++ /dev/null @@ -1,276 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -(** A collection of extensions to the [Unix] module. *) - -val _exit : int -> unit - -val unlink_safe : string -> unit - -val mkdir_safe : string -> Unix.file_perm -> unit - -val mkdir_rec : string -> Unix.file_perm -> unit - -val rm_rec : ?rm_top:bool -> string -> unit -(** removes a file or recursively removes files/directories below a directory without following - symbolic links. If path is a directory, it is only itself removed if rm_top is true. If path - is non-existent nothing happens, it does not lead to an error. *) - -val pidfile_write : string -> unit - -val pidfile_read : string -> int option - -val daemonize : unit -> unit - -val with_file : - string - -> Unix.open_flag list - -> Unix.file_perm - -> (Unix.file_descr -> 'a) - -> 'a - -val with_input_channel : string -> (in_channel -> 'a) -> 'a - -val with_directory : string -> (Unix.dir_handle -> 'a) -> 'a - -(** Exception to be raised in function to break out of [file_lines_fold]. *) -exception Break - -val lines_fold : ('a -> string -> 'a) -> 'a -> in_channel -> 'a -(** Folds function [f] over every line in the input channel *) - -val lines_iter : (string -> unit) -> in_channel -> unit -(** Applies function [f] to every line in the input channel *) - -val file_lines_fold : ('a -> string -> 'a) -> 'a -> string -> 'a -(** Folds function [f] over every line in the file at [file_path] using the - starting value [start]. *) - -val read_lines : path:string -> string list -(** [read_lines path] returns a list of lines in the file at [path]. *) - -val file_lines_iter : (string -> unit) -> string -> unit -(** Applies function [f] to every line in the file at [file_path]. *) - -val fd_blocks_fold : int -> ('a -> bytes -> 'a) -> 'a -> Unix.file_descr -> 'a -(** [fd_blocks_fold block_size f start fd] folds [f] over blocks (strings) - from the fd [fd] with initial value [start] *) - -val readfile_line : (string -> 'a) -> string -> unit -(** Alias for function [file_lines_iter]. *) - -val buffer_of_fd : Unix.file_descr -> Buffer.t -(** [buffer_of_fd fd] returns a Buffer.t containing all data read from [fd] up to EOF *) - -val string_of_fd : Unix.file_descr -> string -(** [string_of_fd fd] returns a string containing all data read from [fd] up to EOF *) - -val buffer_of_file : string -> Buffer.t -(** [buffer_of_file file] returns a Buffer.t containing the contents of [file] *) - -val string_of_file : string -> string -(** [string_of_file file] returns a string containing the contents of [file] *) - -val atomic_write_to_file : - string -> Unix.file_perm -> (Unix.file_descr -> 'a) -> 'a -(** [atomic_write_to_file fname perms f] writes a file to path [fname] - using the function [f] with permissions [perms]. In case of error during - the operation the file with the path [fname] is not modified at all. *) - -val write_string_to_file : ?perms:Unix.file_perm -> string -> string -> unit -(** [write_string_to_file fname contents] creates a file with path [fname] - with the string [contents] as its contents, atomically *) - -val write_bytes_to_file : ?perms:Unix.file_perm -> string -> bytes -> unit -(** [write_string_to_file fname contents] creates a file with path [fname] - with the buffer [contents] as its contents, atomically *) - -val execv_get_output : string -> string array -> int * Unix.file_descr - -val copy_file : ?limit:int64 -> Unix.file_descr -> Unix.file_descr -> int64 - -val file_exists : string -> bool -(** Returns true if and only if a file exists at the given path. *) - -val touch_file : string -> unit -(** Sets both the access and modification times of the file - * at the given path to the current time. Creates an empty - * file at the given path if no such file already exists. *) - -val is_empty_file : string -> bool -(** Returns true if and only if an empty file exists at the given path. *) - -val delete_empty_file : string -> bool -(** Safely deletes a file at the given path if (and only if) the - * file exists and is empty. Returns true if a file was deleted. *) - -exception Host_not_found of string - -val open_connection_fd : string -> int -> Unix.file_descr - -val open_connection_unix_fd : string -> Unix.file_descr - -exception Process_still_alive - -val kill_and_wait : ?signal:int -> ?timeout:float -> int -> unit - -val string_of_signal : int -> string -(** [string_of_signal x] translates an ocaml signal number into - * a string suitable for logging. *) - -val proxy : Unix.file_descr -> Unix.file_descr -> unit - -val really_read : Unix.file_descr -> bytes -> int -> int -> unit - -val really_read_string : Unix.file_descr -> int -> string - -val really_write : Unix.file_descr -> string -> int -> int -> unit -(** [really_write] keeps repeating the write operation until all bytes - * have been written or an error occurs. This is not atomic but is - * robust against EINTR errors. - * See: https://ocaml.github.io/ocamlunix/ocamlunix.html#sec118 *) - -val really_write_string : Unix.file_descr -> string -> unit - -val try_read_string : ?limit:int -> Unix.file_descr -> string - -exception Timeout - -val time_limited_write : Unix.file_descr -> int -> bytes -> float -> unit - -val time_limited_write_substring : - Unix.file_descr -> int -> string -> float -> unit - -val time_limited_read : Unix.file_descr -> int -> float -> string - -val read_data_in_string_chunks : - (string -> int -> unit) - -> ?block_size:int - -> ?max_bytes:int - -> Unix.file_descr - -> int - -val read_data_in_chunks : - (bytes -> int -> unit) - -> ?block_size:int - -> ?max_bytes:int - -> Unix.file_descr - -> int - -val spawnvp : - ?pid_callback:(int -> unit) -> string -> string array -> Unix.process_status - -val double_fork : (unit -> unit) -> unit - -external set_tcp_nodelay : Unix.file_descr -> bool -> unit - = "stub_unixext_set_tcp_nodelay" - -external set_sock_keepalives : Unix.file_descr -> int -> int -> int -> unit - = "stub_unixext_set_sock_keepalives" - -external fsync : Unix.file_descr -> unit = "stub_unixext_fsync" - -external get_max_fd : unit -> int = "stub_unixext_get_max_fd" - -external blkgetsize64 : Unix.file_descr -> int64 = "stub_unixext_blkgetsize64" - -val int_of_file_descr : Unix.file_descr -> int - -val file_descr_of_int : int -> Unix.file_descr - -val close_all_fds_except : Unix.file_descr list -> unit - -val resolve_dot_and_dotdot : string -> string - -val seek_to : Unix.file_descr -> int -> int - -val seek_rel : Unix.file_descr -> int -> int - -val current_cursor_pos : Unix.file_descr -> int - -val wait_for_path : string -> (float -> unit) -> int -> unit - -val send_fd : - Unix.file_descr - -> bytes - -> int - -> int - -> Unix.msg_flag list - -> Unix.file_descr - -> int - -val send_fd_substring : - Unix.file_descr - -> string - -> int - -> int - -> Unix.msg_flag list - -> Unix.file_descr - -> int - -val recv_fd : - Unix.file_descr - -> bytes - -> int - -> int - -> Unix.msg_flag list - -> int * Unix.sockaddr * Unix.file_descr - -type statvfs_t = { - f_bsize: int64 - ; f_frsize: int64 - ; f_blocks: int64 - ; f_bfree: int64 - ; f_bavail: int64 - ; f_files: int64 - ; f_ffree: int64 - ; f_favail: int64 - ; f_fsid: int64 - ; f_flag: int64 - ; f_namemax: int64 -} - -val statvfs : string -> statvfs_t - -val domain_of_addr : string -> Unix.socket_domain option -(** Returns Some Unix.PF_INET or Some Unix.PF_INET6 if passed a valid IP address, otherwise returns None. *) - -module Direct : sig - (** Perform I/O in O_DIRECT mode using 4KiB page-aligned buffers *) - - (** represents a file open in O_DIRECT mode *) - type t - - val openfile : string -> Unix.open_flag list -> Unix.file_perm -> t - (** [openfile name flags perm] behaves the same as [Unix.openfile] but includes the O_DIRECT flag *) - - val close : t -> unit - (** [close t] closes [t], a file open in O_DIRECT mode *) - - val with_openfile : - string -> Unix.open_flag list -> Unix.file_perm -> (t -> 'a) -> 'a - (** [with_openfile name flags perm f] opens [name], applies the result to [f] and closes *) - - val write : t -> bytes -> int -> int -> int - (** [write t buf ofs len] writes [len] bytes at offset [ofs] from buffer [buf] to - [t] using page-aligned buffers. *) - - val copy_from_fd : ?limit:int64 -> Unix.file_descr -> t -> int64 - (** [copy_from_fd ?limit fd t] copies from [fd] to [t] up to [limit] *) - - val fsync : t -> unit - (** [fsync t] commits all outstanding writes, throwing an error if necessary. *) - - val lseek : t -> int64 -> Unix.seek_command -> int64 - (** [lseek t offset command]: see Unix.LargeFile.lseek *) -end diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_open_stubs.c b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_open_stubs.c deleted file mode 100644 index d15cfeff0b1..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_open_stubs.c +++ /dev/null @@ -1,75 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id: open.c 9547 2010-01-22 12:48:24Z doligez $ */ - -#define _GNU_SOURCE /* O_DIRECT */ - -#include -#include -#include -#include -#include -#include -#include - -#ifndef O_NONBLOCK -#define O_NONBLOCK O_NDELAY -#endif -#ifndef O_DSYNC -#define O_DSYNC 0 -#endif -#ifndef O_SYNC -#define O_SYNC 0 -#endif -#ifndef O_RSYNC -#define O_RSYNC 0 -#endif - -static int open_flag_table[] = { - O_RDONLY, O_WRONLY, O_RDWR, O_NONBLOCK, O_APPEND, O_CREAT, O_TRUNC, O_EXCL, - O_NOCTTY, O_DSYNC, O_SYNC, O_RSYNC -}; - -CAMLprim value stub_stdext_unix_open_direct(value path, value flags, value perm) -{ - CAMLparam3(path, flags, perm); - int fd, cv_flags; -#ifndef O_DIRECT - int ret; -#endif - char * p; - - cv_flags = caml_convert_flag_list(flags, open_flag_table); - -#ifdef O_DIRECT - cv_flags |= O_DIRECT; -#endif - p = caml_stat_alloc(caml_string_length(path) + 1); - strcpy(p, String_val(path)); - /* open on a named FIFO can block (PR#1533) */ - caml_enter_blocking_section(); - fd = open(p, cv_flags, Int_val(perm)); -#ifndef O_DIRECT - if (fd != -1) - ret = fcntl(fd, F_NOCACHE); -#endif - caml_leave_blocking_section(); - caml_stat_free(p); - if (fd == -1) uerror("open", path); -#ifndef O_DIRECT - if (ret == -1) uerror("fcntl", path); -#endif - - CAMLreturn (Val_int(fd)); -} diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_stubs.c b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_stubs.c deleted file mode 100644 index 28fd7f9af89..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_stubs.c +++ /dev/null @@ -1,172 +0,0 @@ -/* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - */ -#include -#include -#include -#include -#include -#include -#include -#include /* needed for _SC_OPEN_MAX */ -#include /* snprintf */ -#include -#include -#if defined(__linux__) -# include -#endif - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "blkgetsize.h" - -/* Set the TCP_NODELAY flag on a Unix.file_descr */ -CAMLprim value stub_unixext_set_tcp_nodelay (value fd, value bool) -{ - CAMLparam2 (fd, bool); - int c_fd = Int_val(fd); - int opt = (Bool_val(bool)) ? 1 : 0; - if (setsockopt(c_fd, IPPROTO_TCP, TCP_NODELAY, (void *)&opt, sizeof(opt)) != 0){ - uerror("setsockopt", Nothing); - } - CAMLreturn(Val_unit); -} - -CAMLprim value stub_unixext_fsync (value fd) -{ - CAMLparam1(fd); - int c_fd = Int_val(fd); - int rc; - - caml_release_runtime_system(); - rc = fsync(c_fd); - caml_acquire_runtime_system(); - if (rc != 0) uerror("fsync", Nothing); - CAMLreturn(Val_unit); -} - - -CAMLprim value stub_unixext_blkgetsize64(value fd) -{ - CAMLparam1(fd); - uint64_t size; - int c_fd = Int_val(fd); - int rc; - - caml_release_runtime_system(); - /* mirage-block-unix binding: */ - rc = stdext_blkgetsize(c_fd, &size); - caml_acquire_runtime_system(); - - if (rc) { - uerror("ioctl(BLKGETSIZE64)", Nothing); - } - CAMLreturn(caml_copy_int64(size)); -} - -CAMLprim value stub_unixext_get_max_fd (value unit) -{ - CAMLparam1 (unit); - long maxfd; - maxfd = sysconf(_SC_OPEN_MAX); - CAMLreturn(Val_int(maxfd)); -} - -#if defined(__linux__) -# define TCP_LEVEL SOL_TCP -#elif defined(__APPLE__) -# define TCP_LEVEL IPPROTO_TCP -#else -# error "Don't know how to use setsockopt on this platform" -#endif - -CAMLprim value stub_unixext_set_sock_keepalives(value fd, value count, value idle, value interval) -{ - CAMLparam4(fd, count, idle, interval); - - int c_fd = Int_val(fd); - int optval; - socklen_t optlen=sizeof(optval); - - optval = Int_val(count); - if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPCNT, &optval, optlen) < 0) { - uerror("setsockopt(TCP_KEEPCNT)", Nothing); - } -#if defined(__linux__) - optval = Int_val(idle); - if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPIDLE, &optval, optlen) < 0) { - uerror("setsockopt(TCP_KEEPIDLE)", Nothing); - } -#endif - optval = Int_val(interval); - if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPINTVL, &optval, optlen) < 0) { - uerror("setsockopt(TCP_KEEPINTVL)", Nothing); - } - - CAMLreturn(Val_unit); -} - -void unixext_error(int code) -{ - static const value *exn = NULL; - - if (!exn) { - exn = caml_named_value("unixext.unix_error"); - if (!exn) - caml_invalid_argument("unixext.unix_error not initialiazed"); - } - caml_raise_with_arg(*exn, Val_int(code)); -} - -CAMLprim value stub_statvfs(value filename) -{ - CAMLparam1(filename); - CAMLlocal1(v); - int ret; - struct statvfs buf; - - /* We want to release the runtime lock, so we must copy - * all OCaml arguments. - * See the manual section 20.12.2 Parallel execution of long running C code */ - char *name = caml_stat_strdup(String_val(filename)); - - caml_release_runtime_system(); - ret = statvfs(name, &buf); - caml_stat_free(name); - caml_acquire_runtime_system(); - - if(ret == -1) uerror("statvfs", Nothing); - - v=caml_alloc(11,0); - Store_field(v, 0, caml_copy_int64(buf.f_bsize)); - Store_field(v, 1, caml_copy_int64(buf.f_frsize)); - Store_field(v, 2, caml_copy_int64(buf.f_blocks)); - Store_field(v, 3, caml_copy_int64(buf.f_bfree)); - Store_field(v, 4, caml_copy_int64(buf.f_bavail)); - Store_field(v, 5, caml_copy_int64(buf.f_files)); - Store_field(v, 6, caml_copy_int64(buf.f_ffree)); - Store_field(v, 7, caml_copy_int64(buf.f_favail)); - Store_field(v, 8, caml_copy_int64(buf.f_fsid)); - Store_field(v, 9, caml_copy_int64(buf.f_flag)); - Store_field(v,10, caml_copy_int64(buf.f_namemax)); - - CAMLreturn(v); -} diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_write_stubs.c b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_write_stubs.c deleted file mode 100644 index e4be9f68018..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_write_stubs.c +++ /dev/null @@ -1,65 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id: write.c 9547 2010-01-22 12:48:24Z doligez $ */ - -#include -#include -#include -#include -#include -#include - -#define PAGE_SIZE 4096 - -#ifndef EAGAIN -#define EAGAIN (-1) -#endif -#ifndef EWOULDBLOCK -#define EWOULDBLOCK (-1) -#endif - -CAMLprim value stub_stdext_unix_write(value fd, value buf, value vofs, value vlen) -{ - long ofs, len, written; - int numbytes, ret; - void *iobuf = NULL; - - Begin_root (buf); - ofs = Long_val(vofs); - len = Long_val(vlen); - written = 0; - while (len > 0) { - numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len; - ret = posix_memalign(&iobuf, PAGE_SIZE, numbytes); - if (ret != 0) - uerror("write/posix_memalign", Nothing); - - memmove (iobuf, &Byte(buf, ofs), numbytes); - caml_enter_blocking_section(); - ret = write(Int_val(fd), iobuf, numbytes); - caml_leave_blocking_section(); - free(iobuf); - - if (ret == -1) { - if ((errno == EAGAIN || errno == EWOULDBLOCK) && written > 0) break; - uerror("write", Nothing); - } - written += ret; - ofs += ret; - len -= ret; - } - End_roots(); - return Val_long(written); -} - diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/dune deleted file mode 100644 index ec7532c6a9a..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/dune +++ /dev/null @@ -1,5 +0,0 @@ -(library - (public_name xapi-stdext-zerocheck) - (name xapi_stdext_zerocheck) - (foreign_stubs (language c) (names zerocheck_stub)) -) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.ml deleted file mode 100644 index e128431c588..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.ml +++ /dev/null @@ -1,14 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) -external is_all_zeros : string -> int -> bool = "is_all_zeros" diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.mli deleted file mode 100644 index 08eb9b73d4e..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.mli +++ /dev/null @@ -1,16 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - *) - -external is_all_zeros : string -> int -> bool = "is_all_zeros" -(** [is_all_zeroes x len] returns true if the substring is all zeroes *) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck_stub.c b/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck_stub.c deleted file mode 100644 index 776ef854849..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck_stub.c +++ /dev/null @@ -1,41 +0,0 @@ -/* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program 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; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * 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 Lesser General Public License for more details. - */ - -#include - -/* for better performance in all case, we should process the unalign data at - * the beginning until we reach a 32 bit align value, however since ocaml - * allocate the string and we don't use any offset in this string, the string - * is always correctly aligned. - */ -value is_all_zeros(value string, value length) -{ - CAMLparam2(string, length); - const char *s = String_val(string); - unsigned int *p; - int len = Int_val(length); - int i; - - p = (unsigned int *) s; - for (i = len / 4; i > 0; i--) - if (*p++ != 0) - goto notallzero; - s = (unsigned char *) p; - for (i = 0; i < len % 4; i++) - if (s[i] != 0) - goto notallzero; - CAMLreturn(Val_true); -notallzero: - CAMLreturn(Val_false); -} diff --git a/ocaml/message-switch/.ocamlformat b/ocaml/message-switch/.ocamlformat new file mode 100644 index 00000000000..ea8e56a85a7 --- /dev/null +++ b/ocaml/message-switch/.ocamlformat @@ -0,0 +1,8 @@ +profile=ocamlformat +indicate-multiline-delimiters=closing-on-separate-line +if-then-else=fit-or-vertical +dock-collection-brackets=true +break-struct=natural +break-separators=before +break-infix=fit-or-vertical +break-infix-before-func=false diff --git a/ocaml/xapi-idl/.gitarchive-info b/ocaml/xapi-idl/.gitarchive-info new file mode 100644 index 00000000000..83e5b86e569 --- /dev/null +++ b/ocaml/xapi-idl/.gitarchive-info @@ -0,0 +1,2 @@ +Changeset: $Format:%H$ +Commit date: $Format:%cD$ diff --git a/ocaml/xapi-idl/.gitattributes b/ocaml/xapi-idl/.gitattributes new file mode 100644 index 00000000000..f7bf506d392 --- /dev/null +++ b/ocaml/xapi-idl/.gitattributes @@ -0,0 +1 @@ +.gitarchive-info export-subst diff --git a/ocaml/xapi-idl/.github/workflows/ocaml-ci.yml b/ocaml/xapi-idl/.github/workflows/ocaml-ci.yml new file mode 100644 index 00000000000..b08cc575bb8 --- /dev/null +++ b/ocaml/xapi-idl/.github/workflows/ocaml-ci.yml @@ -0,0 +1,40 @@ +name: Build and test + +on: + push: + pull_request: + +jobs: + ocaml-test: + name: Ocaml tests + runs-on: ubuntu-20.04 + env: + package: "xapi-idl" + + steps: + - name: Checkout code + uses: actions/checkout@v2 + + - name: Pull configuration from xs-opam + run: | + curl --fail --silent https://raw.githubusercontent.com/xapi-project/xs-opam/master/tools/xs-opam-ci.env | cut -f2 -d " " > .env + - name: Load environment file + id: dotenv + uses: falti/dotenv-action@v0.2.4 + + - name: Use ocaml + uses: avsm/setup-ocaml@v1 + with: + ocaml-version: ${{ steps.dotenv.outputs.ocaml_version_full }} + opam-repository: ${{ steps.dotenv.outputs.repository }} + + - name: Install dependencies + run: | + opam pin add . --no-action + opam depext -u ${{ env.package }} + opam install ${{ env.package }} --deps-only --with-test -v + - name: Build + run: | + opam exec -- make all + - name: Run tests + run: opam exec -- make test diff --git a/ocaml/xapi-idl/.ocamlformat b/ocaml/xapi-idl/.ocamlformat new file mode 100644 index 00000000000..ea8e56a85a7 --- /dev/null +++ b/ocaml/xapi-idl/.ocamlformat @@ -0,0 +1,8 @@ +profile=ocamlformat +indicate-multiline-delimiters=closing-on-separate-line +if-then-else=fit-or-vertical +dock-collection-brackets=true +break-struct=natural +break-separators=before +break-infix=fit-or-vertical +break-infix-before-func=false diff --git a/quality-gate.sh b/quality-gate.sh index 224e852aa32..d0a1a7ee296 100755 --- a/quality-gate.sh +++ b/quality-gate.sh @@ -3,7 +3,7 @@ set -e list-hd () { - N=318 + N=317 LIST_HD=$(git grep -r --count 'List.hd' -- **/*.ml | cut -d ':' -f 2 | paste -sd+ - | bc) if [ "$LIST_HD" -eq "$N" ]; then echo "OK counted $LIST_HD List.hd usages" @@ -25,7 +25,7 @@ verify-cert () { } mli-files () { - N=530 + N=518 # do not count ml files from the tests in ocaml/{tests/perftest/quicktest} MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) @@ -40,7 +40,7 @@ mli-files () { } structural-equality () { - N=10 + N=9 EQ=$(git grep -r --count ' == ' -- '**/*.ml' ':!ocaml/sdk-gen/**/*.ml' | cut -d ':' -f 2 | paste -sd+ - | bc) if [ "$EQ" -eq "$N" ]; then echo "OK counted $EQ usages of ' == '" diff --git a/xapi-inventory.opam b/xapi-inventory.opam deleted file mode 100644 index 3783ff02467..00000000000 --- a/xapi-inventory.opam +++ /dev/null @@ -1,30 +0,0 @@ -# This file is generated by dune, edit dune-project instead - -opam-version: "2.0" -name: "xapi-inventory" -maintainer: "xen-api@lists.xen.org" -authors: "xen-api@lists.xen.org" -homepage: "https://github.com/xapi-project/xcp-inventory" -bug-reports: "https://github.com/xapi-project/xcp-inventory/issues" -dev-repo: "git+http://github.com/xapi-project/xcp-inventory.git" -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -tags: [ "org:xapi-project" ] -build: [ - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -depends: [ - "ocaml" - "ocamlfind" {build} - "dune" {build} - "base-threads" - "astring" - "xapi-stdext-unix" - "xapi-stdext-threads" - "cmdliner" - "uuidm" -] -synopsis: "Library for accessing the xapi toolstack inventory file" -description: """ -The inventory file provides global host identify information -needed by multiple services.""" diff --git a/xapi-inventory.opam.template b/xapi-inventory.opam.template deleted file mode 100644 index 7d6338dc108..00000000000 --- a/xapi-inventory.opam.template +++ /dev/null @@ -1,28 +0,0 @@ -opam-version: "2.0" -name: "xapi-inventory" -maintainer: "xen-api@lists.xen.org" -authors: "xen-api@lists.xen.org" -homepage: "https://github.com/xapi-project/xcp-inventory" -bug-reports: "https://github.com/xapi-project/xcp-inventory/issues" -dev-repo: "git+http://github.com/xapi-project/xcp-inventory.git" -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -tags: [ "org:xapi-project" ] -build: [ - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -depends: [ - "ocaml" - "ocamlfind" {build} - "dune" {build} - "base-threads" - "astring" - "xapi-stdext-unix" - "xapi-stdext-threads" - "cmdliner" - "uuidm" -] -synopsis: "Library for accessing the xapi toolstack inventory file" -description: """ -The inventory file provides global host identify information -needed by multiple services.""" diff --git a/xapi-rrd.opam b/xapi-rrd.opam deleted file mode 100644 index abc1e4bb28c..00000000000 --- a/xapi-rrd.opam +++ /dev/null @@ -1,37 +0,0 @@ -# This file is generated by dune, edit dune-project instead - -opam-version: "2.0" -maintainer: "Xapi project maintainers" -authors: ["Dave Scott" "Jon Ludlam" "John Else"] -homepage: "https://github.com/xapi-project/xcp-rrd" -bug-reports: "https://github.com/xapi-project/xcp-rrd/issues" -dev-repo: "git+https://github.com/xapi-project/xcp-rrd.git" -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -tags: [ - "org:xapi-project" -] -build: [ - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -depends: [ - "ocaml" {>= "4.14"} - "dune" {>= "2.0.0"} - "base-bigarray" - "base-unix" - "ppx_deriving_rpc" {>= "6.1.0"} - "rpclib" - "xmlm" - "uuidm" - "xapi-stdext-pervasives" - "yojson" - "alcotest" {with-test} - "crowbar" {with-test} - "xapi-stdext-unix" {with-test} -] -available: [arch != "ppc64"] -synopsis: "RRD library for use with xapi" -description: """ -Round-Robin Databases (RRDs) are constant-space datastructures -used for archiving historical data where the older data is stored -at a lower resolution.""" diff --git a/xapi-rrd.opam.template b/xapi-rrd.opam.template deleted file mode 100644 index 8185db9f7aa..00000000000 --- a/xapi-rrd.opam.template +++ /dev/null @@ -1,35 +0,0 @@ -opam-version: "2.0" -maintainer: "Xapi project maintainers" -authors: ["Dave Scott" "Jon Ludlam" "John Else"] -homepage: "https://github.com/xapi-project/xcp-rrd" -bug-reports: "https://github.com/xapi-project/xcp-rrd/issues" -dev-repo: "git+https://github.com/xapi-project/xcp-rrd.git" -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -tags: [ - "org:xapi-project" -] -build: [ - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -depends: [ - "ocaml" {>= "4.14"} - "dune" {>= "2.0.0"} - "base-bigarray" - "base-unix" - "ppx_deriving_rpc" {>= "6.1.0"} - "rpclib" - "xmlm" - "uuidm" - "xapi-stdext-pervasives" - "yojson" - "alcotest" {with-test} - "crowbar" {with-test} - "xapi-stdext-unix" {with-test} -] -available: [arch != "ppc64"] -synopsis: "RRD library for use with xapi" -description: """ -Round-Robin Databases (RRDs) are constant-space datastructures -used for archiving historical data where the older data is stored -at a lower resolution.""" diff --git a/xapi-stdext-date.opam b/xapi-stdext-date.opam deleted file mode 100644 index a7f4951d856..00000000000 --- a/xapi-stdext-date.opam +++ /dev/null @@ -1,32 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "Xapi's standard library extension, Dates" -maintainer: ["Xapi project maintainers"] -authors: ["xen-api@lists.xen.org"] -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api/issues" -depends: [ - "dune" {>= "2.0"} - "ocaml" {>= "4.12"} - "alcotest" {with-test} - "astring" - "base-unix" - "ptime" - "odoc" {with-doc} -] -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/xapi-project/xen-api.git" diff --git a/xapi-stdext-encodings.opam b/xapi-stdext-encodings.opam deleted file mode 100644 index c3538116761..00000000000 --- a/xapi-stdext-encodings.opam +++ /dev/null @@ -1,33 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "Xapi's standard library extension, Encodings" -maintainer: ["Xapi project maintainers"] -authors: ["xen-api@lists.xen.org"] -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api/issues" -depends: [ - "dune" {>= "2.0"} - "ocaml" {>= "4.13.0"} - "alcotest" {>= "0.6.0" & with-test} - "odoc" {with-doc} - "bechamel" {with-test} - "bechamel-notty" {with-test} - "notty" {with-test} -] -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/xapi-project/xen-api.git" -available: arch != "arm32" & arch != "x86_32" diff --git a/xapi-stdext-encodings.opam.template b/xapi-stdext-encodings.opam.template deleted file mode 100644 index 66595f2d564..00000000000 --- a/xapi-stdext-encodings.opam.template +++ /dev/null @@ -1 +0,0 @@ -available: arch != "arm32" & arch != "x86_32" diff --git a/xapi-stdext-pervasives.opam b/xapi-stdext-pervasives.opam deleted file mode 100644 index 53fd4b34939..00000000000 --- a/xapi-stdext-pervasives.opam +++ /dev/null @@ -1,30 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "Xapi's standard library extension, Pervasives" -maintainer: ["Xapi project maintainers"] -authors: ["xen-api@lists.xen.org"] -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api/issues" -depends: [ - "dune" {>= "2.0"} - "ocaml" {>= "4.08"} - "logs" - "odoc" {with-doc} - "xapi-backtrace" -] -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/xapi-project/xen-api.git" diff --git a/xapi-stdext-std.opam b/xapi-stdext-std.opam deleted file mode 100644 index 95b61c73e3e..00000000000 --- a/xapi-stdext-std.opam +++ /dev/null @@ -1,29 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "Xapi's standard library extension, Stdlib" -maintainer: ["Xapi project maintainers"] -authors: ["xen-api@lists.xen.org"] -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api/issues" -depends: [ - "dune" {>= "2.0"} - "ocaml" {>= "4.08.0"} - "alcotest" {with-test} - "odoc" {with-doc} -] -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/xapi-project/xen-api.git" diff --git a/xapi-stdext-threads.opam b/xapi-stdext-threads.opam deleted file mode 100644 index 9dcc9ff090c..00000000000 --- a/xapi-stdext-threads.opam +++ /dev/null @@ -1,31 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "Xapi's standard library extension, Threads" -maintainer: ["Xapi project maintainers"] -authors: ["xen-api@lists.xen.org"] -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api/issues" -depends: [ - "dune" {>= "2.0"} - "ocaml" - "base-threads" - "base-unix" - "odoc" {with-doc} - "xapi-stdext-pervasives" {= version} -] -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/xapi-project/xen-api.git" diff --git a/xapi-stdext-unix.opam b/xapi-stdext-unix.opam deleted file mode 100644 index f8e709afe7f..00000000000 --- a/xapi-stdext-unix.opam +++ /dev/null @@ -1,34 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "Xapi's standard library extension, Unix" -maintainer: ["Xapi project maintainers"] -authors: ["xen-api@lists.xen.org"] -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api/issues" -depends: [ - "dune" {>= "2.0"} - "ocaml" {>= "4.12.0"} - "base-unix" - "fd-send-recv" {>= "2.0.0"} - "odoc" {with-doc} - "xapi-backtrace" - "xapi-stdext-pervasives" {= version} -] -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/xapi-project/xen-api.git" -depexts: ["linux-headers"] {os-distribution = "alpine"} -available: [ os = "macos" | os = "linux" ] diff --git a/xapi-stdext-unix.opam.template b/xapi-stdext-unix.opam.template deleted file mode 100644 index ae75bf72ee5..00000000000 --- a/xapi-stdext-unix.opam.template +++ /dev/null @@ -1,2 +0,0 @@ -depexts: ["linux-headers"] {os-distribution = "alpine"} -available: [ os = "macos" | os = "linux" ] diff --git a/xapi-stdext-zerocheck.opam b/xapi-stdext-zerocheck.opam deleted file mode 100644 index 30861bf3dc1..00000000000 --- a/xapi-stdext-zerocheck.opam +++ /dev/null @@ -1,28 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "Xapi's standard library extension, Zerocheck" -maintainer: ["Xapi project maintainers"] -authors: ["xen-api@lists.xen.org"] -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api/issues" -depends: [ - "dune" {>= "2.0"} - "ocaml" - "odoc" {with-doc} -] -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/xapi-project/xen-api.git" diff --git a/xapi-stdext.opam b/xapi-stdext.opam deleted file mode 100644 index e2654f782ab..00000000000 --- a/xapi-stdext.opam +++ /dev/null @@ -1,34 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "Xapi's standard library extension" -description: "Dummy package that enables the usage of dune-release" -maintainer: ["Xapi project maintainers"] -authors: ["xen-api@lists.xen.org"] -license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" -homepage: "https://xapi-project.github.io/" -bug-reports: "https://github.com/xapi-project/xen-api/issues" -depends: [ - "dune" {>= "2.0"} - "xapi-stdext-date" {= version} - "xapi-stdext-encodings" {= version} - "xapi-stdext-pervasives" {= version} - "xapi-stdext-std" {= version} - "xapi-stdext-threads" {= version} - "xapi-stdext-unix" {= version} - "xapi-stdext-zerocheck" {= version} -] -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/xapi-project/xen-api.git"