├── .coverage.sh ├── .gitarchive-info ├── .gitattributes ├── .github ├── python-nosetests.sh └── workflows │ ├── 0.150-lcm.yml │ ├── 0.150.5-lcm.yml │ └── main.yml ├── .gitignore ├── .ocamlformat ├── COVERAGE.md ├── CREDITS ├── ChangeLog ├── LICENSE ├── MAINTAINERS ├── Makefile ├── README.md ├── TODO.md ├── VERSION ├── c_stubs ├── dune ├── sockopt_stubs.c ├── tuntap_stubs.c └── xenctrlext_stubs.c ├── cli ├── common.ml ├── dune ├── main.ml ├── table.ml ├── xn.ml ├── xn_cfg_lexer.mll ├── xn_cfg_parser.mly └── xn_cfg_types.ml ├── configure ├── configure.ml ├── dbgring ├── dbgring.ml └── dune ├── doc ├── README.md ├── architecture │ ├── README.md │ ├── host.svg │ └── xenopsd.svg ├── design │ ├── Events.md │ ├── README.md │ ├── Tasks.md │ ├── suspend-image-considerations.md │ └── suspend-image-framing-format.md ├── features │ └── README.md ├── futures │ └── README.md └── walk-throughs │ ├── README.md │ └── VM.start.md ├── dune ├── dune-project ├── lib ├── bootloader.ml ├── bootloader.mli ├── cancellable_subprocess.ml ├── dune ├── interface.ml ├── io.ml ├── ionice.ml ├── mac.ml ├── platform.ml ├── platform.mli ├── resources.ml ├── sockopt.ml ├── sockopt.mli ├── softaffinity.ml ├── softaffinity.mli ├── storage.ml ├── suspend_image.ml ├── suspend_image.mli ├── topology.ml ├── topology.mli ├── xenops_hooks.ml ├── xenops_migrate.ml ├── xenops_sandbox.ml ├── xenops_server.ml ├── xenops_server_plugin.ml ├── xenops_server_simulator.ml ├── xenops_server_skeleton.ml ├── xenops_task.ml ├── xenops_utils.ml └── xenopsd.ml ├── list_domains ├── dune ├── list_domains.ml └── table.ml ├── profiling ├── coverage.ml ├── coverage.mli └── dune ├── scripts ├── block ├── common.py ├── igmp_query_injector.py ├── make-custom-xenopsd.conf ├── network.conf ├── qemu-dm-wrapper ├── qemu-vif-script ├── qemu-wrapper ├── setup-pvs-proxy-rules ├── setup-vif-rules ├── tap ├── test_igmp_query_injector.py ├── vif-real ├── vif.in └── xen-backend.rules.in ├── simulator ├── README.md ├── dune ├── xenops_simulator_main.ml └── xenopsd.conf ├── squeezed ├── ChangeLog ├── doc │ ├── Makefile │ ├── README.md │ ├── architecture │ │ └── README.md │ ├── design │ │ ├── README.md │ │ └── figs │ │ │ ├── fraction.latex │ │ │ ├── g.latex │ │ │ ├── hostfreemem.latex │ │ │ ├── reservation.latex │ │ │ ├── unused.latex │ │ │ ├── x.latex │ │ │ └── xtotpages.latex │ └── squeezer.tex ├── lib │ ├── dune │ └── squeeze.ml ├── scripts │ ├── init.d-squeezed │ └── squeezed.conf ├── src │ ├── dune │ ├── memory_server.ml │ ├── squeeze_xen.ml │ ├── squeezed.ml │ ├── squeezed_state.ml │ └── squeezed_xenstore.ml └── test │ ├── dune │ ├── squeeze_test.ml │ └── squeeze_test_main.ml ├── suspend_image_viewer ├── dune ├── suspend_image_viewer.ml └── view.sh ├── test ├── check-no-xenctrl.sh ├── dune ├── test.ml └── test_topology.ml ├── tools ├── dune └── set_domain_uuid.ml ├── xapi-squeezed.opam ├── xapi-xenopsd-cli.opam ├── xapi-xenopsd-simulator.opam ├── xapi-xenopsd-xc.opam ├── xapi-xenopsd.opam ├── xc ├── README.md ├── cancel_utils.ml ├── cancel_utils_test.ml ├── device.ml ├── device.mli ├── device_common.ml ├── device_common.mli ├── domain.ml ├── domain.mli ├── domain_sethandle.ml ├── dune ├── emu_manager.ml ├── fence │ ├── dune │ └── fence.ml ├── hotplug.ml ├── memory_breakdown.ml ├── memory_summary.ml ├── netdev.ml ├── netman.ml ├── readln.ml ├── readln.mli ├── stats.ml ├── stats.mli ├── tuntap.ml ├── tuntap.mli ├── xc_resources.ml ├── xenbus_utils.ml ├── xenctrlext.ml ├── xenctrlext.mli ├── xenguestHelper.ml ├── xenops_helpers.ml ├── xenops_server_xen.ml ├── xenops_xc_main.ml └── xenstore_watch.ml └── xenopsd.conf /.coverage.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -ex 4 | 5 | COVERAGE_DIR=.coverage 6 | rm -rf $COVERAGE_DIR 7 | mkdir -p $COVERAGE_DIR 8 | pushd $COVERAGE_DIR 9 | if [ -z "$KEEP" ]; then trap "popd; rm -rf $COVERAGE_DIR" EXIT; fi 10 | 11 | $(which cp) -r ../* . 12 | 13 | opam pin add bisect_ppx 1.3.0 -y 14 | opam install ocveralls -y 15 | 16 | export BISECT_ENABLE=YES 17 | jbuilder runtest 18 | 19 | outs=$(find . | grep bisect.*.out) 20 | bisect-ppx-report -I $(dirname $outs[1]) -text report $outs 21 | bisect-ppx-report -I $(dirname $outs[1]) -summary-only -text summary $outs 22 | if [ -n "$HTML" ]; then bisect-ppx-report -I $(dirname $outs[1]) -html ../html-report $outs; fi 23 | 24 | if [ -n "$TRAVIS" ]; then 25 | echo "\$TRAVIS set; running ocveralls and sending to coveralls.io..." 26 | ocveralls --prefix _build/default $outs --send 27 | else 28 | echo "\$TRAVIS not set; displaying results of bisect-report..." 29 | cat report 30 | cat summary 31 | fi 32 | -------------------------------------------------------------------------------- /.gitarchive-info: -------------------------------------------------------------------------------- 1 | Changeset: 809bf2b9812cfe8562f01c8f8cf45db2855cd322 2 | Commit date: Wed, 18 Oct 2023 14:14:46 +0100 3 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | .gitarchive-info export-subst 2 | -------------------------------------------------------------------------------- /.github/python-nosetests.sh: -------------------------------------------------------------------------------- 1 | # SUMMARY: 2 | # Run python unittests using nose 3 | 4 | set -uex 5 | 6 | sudo apt-get install -y python-mock python-nose 7 | 8 | nosetests scripts 9 | -------------------------------------------------------------------------------- /.github/workflows/0.150-lcm.yml: -------------------------------------------------------------------------------- 1 | name: Build and test (0.150-lcm, scheduled) 2 | 3 | on: 4 | schedule: 5 | # run every Monday, this refreshes the cache 6 | - cron: '13 2 * * 1' 7 | 8 | jobs: 9 | python-test: 10 | name: Python tests 11 | runs-on: ubuntu-20.04 12 | strategy: 13 | fail-fast: false 14 | steps: 15 | - name: Checkout code 16 | uses: actions/checkout@v2 17 | with: 18 | ref: '0.150-lcm' 19 | 20 | - name: Run python tests 21 | run: bash .github/python-nosetests.sh 22 | 23 | ocaml-test: 24 | name: Ocaml tests 25 | runs-on: ubuntu-20.04 26 | env: 27 | package: "xapi-xenopsd xapi-xenopsd-simulator xapi-xenopsd-cli xapi-xenopsd-xc" 28 | 29 | steps: 30 | - name: Update apt cache 31 | run: sudo apt-get update 32 | 33 | - name: Checkout code 34 | uses: actions/checkout@v2 35 | with: 36 | ref: '0.150-lcm' 37 | 38 | - name: Pull configuration from xs-opam 39 | run: | 40 | curl --fail --silent https://raw.githubusercontent.com/xapi-project/xs-opam/release/yangtze/lcm/tools/xs-opam-ci.env | cut -f2 -d " " > .env 41 | 42 | - name: Load environment file 43 | id: dotenv 44 | uses: falti/dotenv-action@v0.2.6 45 | 46 | - name: Retrieve date for cache key (year-week) 47 | id: cache-key 48 | run: echo "::set-output name=date::$(/bin/date -u "+%Y%W")" 49 | shell: bash 50 | 51 | - name: Restore opam cache 52 | id: opam-cache 53 | uses: actions/cache@v2 54 | with: 55 | path: "~/.opam" 56 | # invalidate cache daily, gets built daily using a scheduled job 57 | key: ${{ steps.cache-key.outputs.date }}-0.150 58 | 59 | - name: Use ocaml 60 | uses: avsm/setup-ocaml@v1 61 | with: 62 | ocaml-version: ${{ steps.dotenv.outputs.ocaml_version_full }} 63 | opam-repository: ${{ steps.dotenv.outputs.repository }} 64 | 65 | - name: Update opam metadata 66 | run: | 67 | opam update 68 | opam pin add . --no-action 69 | 70 | - name: Install external dependencies 71 | run: opam depext -u ${{ env.package }} 72 | 73 | - name: Install dependencies 74 | run: | 75 | opam upgrade 76 | opam install ${{ env.package }} --deps-only --with-test -v 77 | 78 | - name: Build 79 | run: | 80 | opam exec -- ./configure 81 | opam exec -- make 82 | 83 | - name: Run tests 84 | run: opam exec -- make test 85 | 86 | - name: Avoid built packages to appear in the cache 87 | # only packages in this repository follow a branch, the rest point to a tag 88 | run: opam uninstall ${{ env.package }} 89 | -------------------------------------------------------------------------------- /.github/workflows/0.150.5-lcm.yml: -------------------------------------------------------------------------------- 1 | name: Build and test (0.150.5-lcm, scheduled) 2 | 3 | on: 4 | schedule: 5 | # run every Monday, this refreshes the cache 6 | - cron: '5 2 * * 1' 7 | 8 | jobs: 9 | python-test: 10 | name: Python tests 11 | runs-on: ubuntu-20.04 12 | strategy: 13 | fail-fast: false 14 | steps: 15 | - name: Checkout code 16 | uses: actions/checkout@v2 17 | with: 18 | ref: '0.150.5-lcm' 19 | 20 | - name: Run python tests 21 | run: bash .github/python-nosetests.sh 22 | 23 | ocaml-test: 24 | name: Ocaml tests 25 | runs-on: ubuntu-20.04 26 | env: 27 | package: "xapi-xenopsd xapi-xenopsd-simulator xapi-xenopsd-cli xapi-xenopsd-xc" 28 | 29 | steps: 30 | - name: Checkout code 31 | uses: actions/checkout@v2 32 | with: 33 | ref: '0.150.5-lcm' 34 | 35 | - name: Pull configuration from xs-opam 36 | run: | 37 | curl --fail --silent https://raw.githubusercontent.com/xapi-project/xs-opam/release/stockholm/lcm/tools/xs-opam-ci.env | cut -f2 -d " " > .env 38 | 39 | - name: Load environment file 40 | id: dotenv 41 | uses: falti/dotenv-action@v0.2.6 42 | 43 | - name: Retrieve date for cache key (year-week) 44 | id: cache-key 45 | run: echo "::set-output name=date::$(/bin/date -u "+%Y%W")" 46 | shell: bash 47 | 48 | - name: Restore opam cache 49 | id: opam-cache 50 | uses: actions/cache@v2 51 | with: 52 | path: "~/.opam" 53 | # invalidate cache daily, gets built daily using a scheduled job 54 | key: ${{ steps.cache-key.outputs.date }}-0.150.5 55 | 56 | - name: Use ocaml 57 | uses: avsm/setup-ocaml@v1 58 | with: 59 | ocaml-version: ${{ steps.dotenv.outputs.ocaml_version_full }} 60 | opam-repository: ${{ steps.dotenv.outputs.repository }} 61 | 62 | - name: Update opam metadata 63 | run: | 64 | opam update 65 | opam pin add . --no-action 66 | 67 | - name: Install external dependencies 68 | run: opam depext -u ${{ env.package }} 69 | 70 | - name: Install dependencies 71 | run: | 72 | opam upgrade 73 | opam install ${{ env.package }} --deps-only --with-test -v 74 | 75 | - name: Build 76 | run: | 77 | opam exec -- ./configure 78 | opam exec -- make 79 | 80 | - name: Run tests 81 | run: opam exec -- make test 82 | 83 | - name: Avoid built packages to appear in the cache 84 | # only packages in this repository follow a branch, the rest point to a tag 85 | run: opam uninstall ${{ env.package }} 86 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Build and test 2 | 3 | on: 4 | push: 5 | pull_request: 6 | schedule: 7 | # run daily, this refreshes the cache 8 | - cron: '13 2 * * *' 9 | 10 | jobs: 11 | python-test: 12 | name: Python tests 13 | runs-on: ubuntu-20.04 14 | strategy: 15 | fail-fast: false 16 | steps: 17 | - name: Checkout code 18 | uses: actions/checkout@v2 19 | 20 | - name: Run python tests 21 | run: bash .github/python-nosetests.sh 22 | 23 | ocaml-test: 24 | name: Ocaml tests 25 | runs-on: ubuntu-20.04 26 | env: 27 | package: "xapi-xenopsd xapi-xenopsd-simulator xapi-xenopsd-cli xapi-xenopsd-xc xapi-squeezed" 28 | 29 | steps: 30 | - name: Checkout code 31 | uses: actions/checkout@v2 32 | 33 | - name: Pull configuration from xs-opam 34 | run: | 35 | curl --fail --silent https://raw.githubusercontent.com/xapi-project/xs-opam/master/tools/xs-opam-ci.env | cut -f2 -d " " > .env 36 | 37 | - name: Load environment file 38 | id: dotenv 39 | uses: falti/dotenv-action@v0.2.6 40 | 41 | - name: Retrieve date for cache key 42 | id: cache-key 43 | run: echo "::set-output name=date::$(/bin/date -u "+%Y%m%d")" 44 | shell: bash 45 | 46 | - name: Restore opam cache 47 | id: opam-cache 48 | uses: actions/cache@v2 49 | with: 50 | path: "~/.opam" 51 | # invalidate cache daily, gets built daily using a scheduled job 52 | key: ${{ steps.cache-key.outputs.date }} 53 | 54 | - name: Use ocaml 55 | uses: avsm/setup-ocaml@v1 56 | with: 57 | ocaml-version: ${{ steps.dotenv.outputs.ocaml_version_full }} 58 | opam-repository: ${{ steps.dotenv.outputs.repository }} 59 | 60 | - name: Update opam metadata 61 | run: | 62 | opam update 63 | opam pin add . --no-action 64 | 65 | - name: Install external dependencies 66 | run: opam depext -u ${{ env.package }} 67 | 68 | - name: Install dependencies 69 | run: | 70 | opam upgrade 71 | opam install ${{ env.package }} --deps-only --with-test -v 72 | 73 | - name: Build 74 | run: | 75 | opam exec -- ./configure 76 | opam exec -- make 77 | 78 | - name: Run tests 79 | run: opam exec -- make test 80 | 81 | - name: Uninstall unversioned packages 82 | # This should purge them from the cache, unversioned package have 83 | # 'master' as its version 84 | run: opam list | awk -F " " '$2 == "master" { print $1 }' | xargs opam uninstall 85 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.install 3 | .merlin 4 | 5 | *.orig 6 | *.rej 7 | 8 | scripts/vif 9 | scripts/xen-backend.rules 10 | scripts/xen-backend-xl.rules 11 | config.mk 12 | config.ml 13 | xentoollog_flags 14 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile=ocamlformat 2 | indicate-multiline-delimiters=closing-on-separate-line 3 | if-then-else=fit-or-vertical 4 | dock-collection-brackets=true 5 | break-struct=natural 6 | break-separators=before 7 | break-infix=fit-or-vertical 8 | break-infix-before-func=false 9 | sequence-blank-line=preserve-one 10 | -------------------------------------------------------------------------------- /COVERAGE.md: -------------------------------------------------------------------------------- 1 | # Coverage Analysis 2 | 3 | This project can be compiled for coverage analysis using [bisect_ppx]. By 4 | default, this is not done. To compile for coverage analysis, do: 5 | 6 | ./configure --enable-coverage 7 | make 8 | 9 | This sets the `BISECT_ENABLE` make and environment variable, which adds a dependency 10 | on `bisect_ppx` at `make setup.ml` time. 11 | This ensures that a proper dependency gets added to the META file, so that other 12 | projects can successfully link `xenopsd` even if they are themselves not built 13 | with `bisect_ppx`. 14 | 15 | To get a non-coverage build simply run a default build: 16 | 17 | ./configure 18 | make clean && make 19 | 20 | ## Support Files 21 | 22 | See [profiling/coverage.ml](./profiling/coverage.ml) for the run-time 23 | setup of coverage profiling. This code has no effect when not profiling 24 | during execution. Once [bixect_ppx] has better defaults we could get rid 25 | of it. 26 | 27 | ## Execution and Logging 28 | 29 | During program execution, a binary writes coverage data to 30 | 31 | /tmp/bisect--*.out 32 | 33 | This can be overridden by setting the `BISECT_FILE` environment 34 | variable, which is otherwise set at startup using the code in 35 | `profiling/coverage.ml`; 36 | 37 | ## Analysis 38 | 39 | See the [bisect_ppx] documentation for details but try from the 40 | top-level directory: 41 | 42 | bisect-ppx-report -I _build -html coverage /tmp/bisect-*.out 43 | 44 | This creates an HTML document in [coverage/](./coverage]. 45 | 46 | [bisect_ppx]: https://github.com/aantron/bisect_ppx 47 | -------------------------------------------------------------------------------- /CREDITS: -------------------------------------------------------------------------------- 1 | This is a partial list of people who have contributed code to this repository, 2 | sorted alphabetically. 3 | 4 | Andrew Peace 5 | Anil Madhavapeddy 6 | David Scott 7 | Ewan Mellor 8 | Henry Hughes 9 | Hugh Warrington 10 | Ian Campbell 11 | Jon Harrop 12 | Jonathan Davies 13 | Jonathan Knowles 14 | Jonathan Ludlam 15 | Magnus Therning 16 | Marcus Granado 17 | Richard Sharp 18 | Rob Hoes 19 | Stephen Rice 20 | Stephen Turner 21 | Thomas Gazagnaire 22 | Tim Deegan 23 | Tom Wilkie 24 | Vincent Hanquez 25 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 0.12.0 (09-Sep-2015): 2 | * Use `xl pci-plug` and `xl pci-unplug` 3 | * Write licensing information to Xenstore 4 | * Write guest agent xenstore keys in a transaction 5 | 6 | 0.11.0 (14-Aug-2015): 7 | * Replace 'xcp' in alternatives path with 'xapi' 8 | * Use 'xl pci-attach' for PCI passthrough 9 | * Turn on TCP keepalives on migration sockets 10 | * libxl: update to serial_list (Xen 4.5) 11 | * Add support for configuring Windows update 12 | * Support for blkback with raw format block devices 13 | * Failing to add a vif to a bridge is a hard error 14 | * Improved VGPU support 15 | * Support SMAPIv3 16 | 17 | 0.10.1 (7-Apr-2015): 18 | * update libvirt xenopsd to xapi-idl.0.10.0 19 | 20 | 0.10.0 (4-Apr-2015): 21 | * update to cohttp.0.15.2 22 | * update following xcp-rrd renamed to rrd in ocamlfind 23 | * support read-caching 24 | * allow block backend-kind to be overridden by SM plugins 25 | * support IGD passthrough 26 | * add hooks for post-resume and post-migrate 27 | * support floppy disk images (useful for packer and cloudinit) 28 | * allow calling "VM plugins" 29 | * allow HVM linux VMs to use >4 disks 30 | 31 | 0.9.46 (20-Nov-2014): 32 | * add some high-level documentation 33 | * xl: fix block device handling 34 | * xl: allow the storage backend to choose between Blkback and Qdisk 35 | * update to new Backtrace API 36 | * Fix parsing of VDI locations containing '/' 37 | * update following xentoollog change 38 | * fix "make install" 39 | * "make clean" nolonger deletes configure information 40 | * add an opam file 41 | 42 | 0.9.44 (22-Sep-2014): 43 | * better libxl support 44 | * improved robustness should the event thread throw an exception 45 | * Improve logging around cancellation 46 | 47 | 0.9.40 (22-Aug-2014): 48 | * add man pages and more regular command-line interface 49 | * read the kthread-pid from the right path: needed for VBD QoS 50 | * eliloader, pygrub, vncterm and hvmloader are now optional dependencies 51 | * improve the convert-legacy-stream logging 52 | 53 | 0.9.39 (20-Aug-2014): 54 | * allow vCPU hotplug for HVM if feature-vcpu-hotplug is set 55 | * by default use the upstream qemu with libxl 56 | * fix the 'make install' target 57 | * safeguard against malicious suspend images 58 | 59 | 0.9.37 (4-Jun-2014): 60 | * Lots of changes! 61 | * Update to Cohttp 0.11.2 62 | * Update to Stdext 0.11.0 63 | 64 | 0.9.24 (10-Sep-2013): 65 | * update to xenstore 1.2.3 66 | 67 | 0.9.22 (10-Sep-2013): 68 | * fix bug setting up VIFs on systems with python 2.4 69 | * fix bug where updates from the guest agent were lost 70 | * fix bug in suspend/resume/migrate on Windows with PV drivers 71 | * fix migrate when not using the message switch 72 | 73 | 0.9.21 (15-Aug-2013): 74 | * will autodetect xenlight, libvirt devel packages and only build those 75 | backends if they are available 76 | 77 | 0.9.20 (15-Aug-2013): 78 | * update to xen-api c/s f45d493e7ed9b5a60fed1db64ce52708c76465a6; see 79 | https://github.com/djs55/xenopsd/pull/35 80 | 81 | 0.9.19 (14-Aug-2013): 82 | * disable by default the libvirt build 83 | 84 | 0.9.18 (8-Aug-2013): 85 | * libxl: add support for .qcow2 format disks 86 | 87 | 0.9.17 (5-Jul-2013): 88 | * libxl: fix hotplug and unplug 89 | 90 | 0.9.16 (5-Jul-2013): 91 | * libxl: fix the network device enumeration for Linux guests 92 | 93 | 0.9.15 (1-Jul-2013): 94 | * libxl: use a PV frontend in dom0 for pygrub 95 | 96 | 0.9.14 (27-Jun-2013): 97 | * libxl: PV guests install and start normally 98 | * libxl: fixed deadlock in clean shutdown 99 | * libxl: suspend and resume work 100 | 101 | 0.9.12 (26-Jun-2013): 102 | * libxl: emulated NICs are working 103 | 104 | 0.9.9 (25-Jun-2013): 105 | * libxl: VM shutdown is more reliable 106 | * libxl: VM consoles work 107 | 108 | 0.9.6 (23-Jun-2013): 109 | * Migration works again with classic backend 110 | 111 | 0.9.5 (21-Jun-2013): 112 | * Experimental libxl backend 113 | 114 | 0.9.4 (19-Jun-2013): 115 | * HVM CD eject and VM poweroff now work 116 | 117 | 0.9.3 (17-Jun-2013): 118 | * xenopsd-xc will set domain 0's uuid on startup 119 | 120 | 0.9.1 (3-Jun-2013): 121 | * -daemon true option works with libxc version 122 | 123 | 0.9.0 (3-Jun-2013): 124 | * first public release 125 | 126 | -------------------------------------------------------------------------------- /MAINTAINERS: -------------------------------------------------------------------------------- 1 | How to submit changes to this project 2 | ===================================== 3 | 4 | Please submit changes as pull requests to the repository on github. 5 | Please ensure that all changes have descriptive commit comments and 6 | include a Signed-off-by: line. 7 | 8 | Maintainers list 9 | ---------------- 10 | 11 | * David Scott 12 | * Jonathan Ludlam 13 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | include config.mk 2 | 3 | .PHONY: build clean release test format install uninstall doc 4 | 5 | release: 6 | dune build @install --profile=release 7 | 8 | build: 9 | dune build @install --profile=dev 10 | 11 | clean: 12 | dune clean 13 | 14 | test: 15 | dune runtest --no-buffer --profile=release 16 | 17 | format: 18 | dune build @fmt --auto-promote 19 | 20 | #requires odoc 21 | doc: 22 | dune build @doc --profile=release 23 | 24 | install: 25 | dune install -p xapi-xenopsd 26 | install -D _build/install/default/bin/xenopsd-simulator $(DESTDIR)/$(SBINDIR)/xenopsd-simulator 27 | install -D _build/install/default/man/man1/xenopsd-simulator.1.gz $(DESTDIR)/$(MANDIR)/man1/xenopsd-simulator.1.gz 28 | install -D _build/install/default/bin/xenopsd-xc $(DESTDIR)/$(SBINDIR)/xenopsd-xc 29 | install -D _build/install/default/bin/fence.bin $(DESTDIR)/$(OPTDIR)/fence.bin 30 | install -D _build/install/default/man/man1/xenopsd-xc.1.gz $(DESTDIR)/$(MANDIR)/man1/xenopsd-xc.1.gz 31 | install -D _build/install/default/bin/set-domain-uuid $(DESTDIR)/$(LIBEXECDIR)/set-domain-uuid 32 | install -D _build/install/default/bin/xenops-cli $(DESTDIR)/$(SBINDIR)/xenops-cli 33 | install -D _build/install/default/man/man1/xenops-cli.1.gz $(DESTDIR)/$(MANDIR)/man1/xenops-cli.1.gz 34 | install -D _build/install/default/bin/list_domains $(DESTDIR)/$(BINDIR)/list_domains 35 | install -D ./scripts/vif $(DESTDIR)/$(LIBEXECDIR)/vif 36 | install -D ./scripts/vif-real $(DESTDIR)/$(LIBEXECDIR)/vif-real 37 | install -D ./scripts/block $(DESTDIR)/$(LIBEXECDIR)/block 38 | install -D ./scripts/xen-backend.rules $(DESTDIR)/$(ETCDIR)/udev/rules.d/xen-backend.rules 39 | install -D ./scripts/tap $(DESTDIR)/$(LIBEXECDIR)/tap 40 | install -D ./scripts/qemu-dm-wrapper $(DESTDIR)/$(LIBEXECDIR)/qemu-dm-wrapper 41 | install -D ./scripts/qemu-vif-script $(DESTDIR)/$(LIBEXECDIR)/qemu-vif-script 42 | install -D ./scripts/setup-vif-rules $(DESTDIR)/$(LIBEXECDIR)/setup-vif-rules 43 | install -D ./scripts/setup-pvs-proxy-rules $(DESTDIR)/$(LIBEXECDIR)/setup-pvs-proxy-rules 44 | install -D ./scripts/common.py $(DESTDIR)/$(LIBEXECDIR)/common.py 45 | install -D ./scripts/igmp_query_injector.py $(DESTDIR)/$(LIBEXECDIR)/igmp_query_injector.py 46 | install -D ./scripts/qemu-wrapper $(DESTDIR)/$(QEMU_WRAPPER_DIR)/qemu-wrapper 47 | install -D _build/install/default/bin/squeezed $(DESTDIR)/$(SBINDIR)/squeezed 48 | DESTDIR=$(DESTDIR) SBINDIR=$(SBINDIR) QEMU_WRAPPER_DIR=$(QEMU_WRAPPER_DIR) LIBEXECDIR=$(LIBEXECDIR) ETCDIR=$(ETCDIR) ./scripts/make-custom-xenopsd.conf 49 | 50 | uninstall: 51 | dune uninstall -p xapi-xenopsd 52 | rm -f $(DESTDIR)/$(SBINDIR)/xenopsd-xc 53 | rm -f $(DESTDIR)/$(OPTDIR)/fence.bin 54 | rm -f $(DESTDIR)/$(SBINDIR)/xenopsd-simulator 55 | rm -f $(DESTDIR)/$(MANDIR)/man1/xenopsd-xc.1 56 | rm -f $(DESTDIR)/$(MANDIR)/man1/xenopsd-simulator.1 57 | rm -f $(DESTDIR)/$(LIBEXECDIR)/set-domain-uuid 58 | rm -f $(DESTDIR)/$(SBINDIR)/xenops-cli 59 | rm -f $(DESTDIR)/$(MANDIR)/man1/xenops-cli.1 60 | rm -f $(DESTDIR)/$(BINDIR)/list_domains 61 | rm -f $(DESTDIR)/$(ETCDIR)/xenopsd.conf 62 | rm -f $(DESTDIR)/$(LIBEXECDIR)/vif 63 | rm -f $(DESTDIR)/$(LIBEXECDIR)/vif-real 64 | rm -f $(DESTDIR)/$(LIBEXECDIR)/block 65 | rm -f $(DESTDIR)/$(ETCDIR)/udev/rules.d/xen-backend.rules 66 | rm -f $(DESTDIR)/$(LIBEXECDIR)/tap 67 | rm -f $(DESTDIR)/$(LIBEXECDIR)/qemu-dm-wrapper 68 | rm -f $(DESTDIR)/$(LIBEXECDIR)/qemu-vif-script 69 | rm -f $(DESTDIR)/$(LIBEXECDIR)/setup-vif-rules 70 | rm -f $(DESTDIR)/$(LIBEXECDIR)/setup-pvs-proxy-rules 71 | rm -f $(DESTDIR)/$(LIBEXECDIR)/common.py* 72 | rm -f $(DESTDIR)/$(LIBEXECDIR)/igmp_query_injector.py* 73 | rm -f $(DESTDIR)/$(QEMU_WRAPPER_DIR)/qemu-wrapper 74 | 75 | .DEFAULT_GOAL := release 76 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/xapi-project/xenopsd.svg?branch=master)](https://travis-ci.org/xapi-project/xenopsd) 2 | [![Lines of Code](https://tokei.rs/b1/github/xapi-project/xenopsd)](https://github.com/xapi-project/xenopsd) 3 | 4 | xenopsd: a simple VM manager 5 | ============================ 6 | 7 | xenopsd manages VMs running 8 | 9 | * on Xen, via direct libxc calls 10 | * on Xen/KVM via libvirt [experimental] 11 | * on KVM via qemu directly [experimental] 12 | 13 | and provides a simple RPC control interface to the layer above (typically xapi). 14 | 15 | ## Coverage Profiling 16 | 17 | This code can be profiled for coverage. See [COVERAGE.md]. 18 | 19 | 20 | [COVERAGE.md]: ./COVERAGE.md 21 | 22 | squeezed: a xen host memory ballooning daemon 23 | --------------------------------------------- 24 | 25 | Squeezed uses [ballooning](http://static.usenix.org/events/osdi02/tech/full_papers/waldspurger/waldspurger_html/node6.html) 26 | to move memory between running VMs. It is able to: 27 | 28 | 1. avoid wasting host memory: unused memory can be gifted to VMs 29 | 2. share memory according to a configured policy, so some VMs will use more than others 30 | 3. "squeeze" existing VMs to make room to start new VMs. 31 | 32 | Squeezed is an optional component of the [xapi toolstack](http://wiki.xen.org/wiki/Choice_of_Toolstacks). 33 | 34 | documentation 35 | ------------- 36 | 37 | - [Architecture](squeezed/doc/architecture/README.md): a high-level overview of Squeezed. 38 | - [Design](squeezed/doc/design/README.md): discover the low-level details, formats, protocols, 39 | concurrency etc. 40 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | 2 | Cohttp support for basic auth (done) 3 | Cohttp support for cookies (done) 4 | Need to send and receive fds (done) 5 | FD passing (done) 6 | Config file parsing (done) (tested) 7 | Daemonize helper (done) 8 | -------------------------------------------------------------------------------- /VERSION: -------------------------------------------------------------------------------- 1 | 0.10.1 2 | -------------------------------------------------------------------------------- /c_stubs/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name c_stubs) 3 | (public_name xapi-xenopsd.c_stubs) 4 | (wrapped false) 5 | (foreign_stubs 6 | (language c) 7 | (names sockopt_stubs) 8 | ) 9 | ) 10 | 11 | (library 12 | (name xc_stubs) 13 | (public_name xapi-xenopsd-xc.c_stubs) 14 | (wrapped false) 15 | (libraries xenctrl) 16 | (foreign_stubs 17 | (language c) 18 | (names tuntap_stubs xenctrlext_stubs) 19 | (flags (:include xentoollog_flags.sexp)) 20 | ) 21 | ) 22 | 23 | (rule 24 | (targets xentoollog_flags.sexp) 25 | (deps ../xentoollog_flags) 26 | (action 27 | (with-stdout-to 28 | %{targets} 29 | (bash "echo \"($(< %{deps}))\"") 30 | ) 31 | ) 32 | ) 33 | -------------------------------------------------------------------------------- /c_stubs/sockopt_stubs.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | */ 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | #include 20 | #include 21 | #include /* needed for _SC_OPEN_MAX */ 22 | #include /* snprintf */ 23 | #include 24 | #include 25 | #if defined(__linux__) 26 | # include 27 | #endif 28 | 29 | #include 30 | #include 31 | #include 32 | #include 33 | #include 34 | #include 35 | #include 36 | #include 37 | 38 | #if defined(__linux__) 39 | # define TCP_LEVEL SOL_TCP 40 | #elif defined(__APPLE__) 41 | # define TCP_LEVEL IPPROTO_TCP 42 | #else 43 | # error "Don't know how to use setsockopt on this platform" 44 | #endif 45 | 46 | CAMLprim value stub_sockopt_set_sock_keepalives(value fd, value count, value idle, value interval) 47 | { 48 | CAMLparam4(fd, count, idle, interval); 49 | 50 | int c_fd = Int_val(fd); 51 | int optval; 52 | socklen_t optlen=sizeof(optval); 53 | 54 | optval = Int_val(count); 55 | if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPCNT, &optval, optlen) < 0) { 56 | uerror("setsockopt(TCP_KEEPCNT)", Nothing); 57 | } 58 | #if defined(__linux__) 59 | optval = Int_val(idle); 60 | if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPIDLE, &optval, optlen) < 0) { 61 | uerror("setsockopt(TCP_KEEPIDLE)", Nothing); 62 | } 63 | #endif 64 | optval = Int_val(interval); 65 | if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPINTVL, &optval, optlen) < 0) { 66 | uerror("setsockopt(TCP_KEEPINTVL)", Nothing); 67 | } 68 | 69 | CAMLreturn(Val_unit); 70 | } 71 | 72 | -------------------------------------------------------------------------------- /c_stubs/tuntap_stubs.c: -------------------------------------------------------------------------------- 1 | /* 2 | * (c) Citrix 3 | * 4 | * This could be replaced by https://github.com/mirage/ocaml-tuntap 5 | * if more features are required. 6 | */ 7 | 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | 15 | 16 | #include 17 | #include 18 | #include 19 | #include 20 | 21 | #define PATH_NET_TUN "/dev/net/tun" 22 | 23 | /* open /dev/net/tun and set it up 24 | * external _tap_open : string -> Unix.file_descr = "stub_tap_open" 25 | */ 26 | CAMLprim value stub_tap_open(value ocaml_ifname) 27 | { 28 | CAMLparam1(ocaml_ifname); 29 | unsigned int features; 30 | struct ifreq ifr; 31 | const char *ifname = String_val(ocaml_ifname); 32 | 33 | memset(&ifr, 0, sizeof(ifr)); 34 | 35 | size_t len = strlen(ifname); 36 | if (len == 0) { 37 | caml_failwith("empty string argument in " __FILE__); 38 | } 39 | if (len >= IFNAMSIZ) { 40 | caml_failwith("string argument too long in "__FILE__); 41 | } 42 | strncpy(ifr.ifr_name, ifname, IFNAMSIZ); 43 | 44 | int fd = open(PATH_NET_TUN, O_RDWR); 45 | if (fd < 0) { 46 | caml_failwith("open(" PATH_NET_TUN ") failed in " __FILE__); 47 | } 48 | 49 | if (ioctl(fd, TUNGETFEATURES, &features) == -1) { 50 | close(fd); 51 | caml_failwith("TUNGETFEATURES failed in " __FILE__); 52 | } 53 | 54 | ifr.ifr_flags = IFF_TAP | IFF_NO_PI | (features & IFF_ONE_QUEUE); 55 | if (ioctl(fd, TUNSETIFF, (void *) &ifr) != 0) { 56 | close(fd); 57 | caml_failwith("ioctl failed in " __FILE__); 58 | } 59 | 60 | fcntl(fd, F_SETFL, O_NONBLOCK); 61 | CAMLreturn(Val_int(fd)); 62 | } 63 | 64 | -------------------------------------------------------------------------------- /cli/common.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | type t = {verbose: bool; debug: bool; socket: string} [@@deriving rpc] 16 | 17 | let make verbose debug socket queue = 18 | Xenops_interface.default_path := socket ; 19 | ( match queue with 20 | | None -> 21 | () 22 | | Some name -> 23 | Xenops_interface.queue_name := name ; 24 | Xcp_client.use_switch := true 25 | ) ; 26 | {verbose; debug; socket} 27 | 28 | let to_string x = Jsonrpc.to_string (rpc_of_t x) 29 | 30 | let print oc x = output_string oc (to_string x) 31 | -------------------------------------------------------------------------------- /cli/dune: -------------------------------------------------------------------------------- 1 | (ocamlyacc xn_cfg_parser) 2 | (ocamllex xn_cfg_lexer) 3 | 4 | (executable 5 | (name main) 6 | (public_name xenops-cli) 7 | (package xapi-xenopsd-cli) 8 | (libraries 9 | cmdliner 10 | re 11 | result 12 | rpclib.core 13 | rpclib.json 14 | rresult 15 | threads 16 | uuidm 17 | xapi-idl 18 | xapi-idl.xen 19 | xapi-idl.xen.interface 20 | xapi-idl.xen.interface.types 21 | ) 22 | (preprocess (pps ppx_deriving_rpc)) 23 | ) 24 | 25 | (rule 26 | (with-stdout-to 27 | xenops-cli.1 28 | (run %{dep:main.exe} --help=groff) 29 | ) 30 | ) 31 | 32 | (rule 33 | (targets xenops-cli.1.gz) 34 | (action 35 | (run gzip %{dep:xenops-cli.1})) 36 | ) 37 | 38 | (install 39 | (section man) 40 | (files xenops-cli.1.gz) 41 | (package xapi-xenopsd-cli) 42 | ) 43 | -------------------------------------------------------------------------------- /cli/table.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | (** Some string handling functions to help drawing text tables. Modified from 15 | Richard's code in the CLI *) 16 | 17 | let pad n s before = 18 | if String.length s > n then 19 | if String.length s > 2 then 20 | String.sub s 0 (n - 2) ^ ".." 21 | else 22 | String.sub s 0 n 23 | else 24 | let padding = String.make (n - String.length s) ' ' in 25 | if before then padding ^ s else s ^ padding 26 | 27 | let left n s = pad n s false 28 | 29 | let right n s = pad n s true 30 | 31 | let compute_col_widths rows = 32 | let mkints n = 33 | let rec f x = if x = n then [] else x :: f (x + 1) in 34 | f 0 35 | in 36 | let numcols = List.length (List.hd rows) in 37 | let column x = List.map (fun row -> List.nth row x) rows in 38 | let cols = List.map column (mkints numcols) in 39 | let max n str = max n (String.length str) in 40 | List.map (List.fold_left max 0) cols 41 | 42 | let print (rows : string list list) = 43 | match rows with 44 | | [] -> 45 | () 46 | | _ -> 47 | let widths = compute_col_widths rows in 48 | let sll = List.map (List.map2 right widths) rows in 49 | List.iter (fun line -> print_endline (String.concat " | " line)) sll 50 | -------------------------------------------------------------------------------- /cli/xn_cfg_lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Xn_cfg_parser 3 | let unquote x = String.sub x 1 (String.length x - 2) 4 | } 5 | rule token = parse 6 | ['a'-'z']['_''0'-'9''a'-'z']* as x { IDENT x } 7 | | ['0'-'9']['0'-'9''a'-'f''x']* as x { INT (int_of_string x) } 8 | | '\''([^'\'''\n']|'.')*'\'' as x { STRING (unquote x) } 9 | | '"'([^'"''\n']|'.')*'"' as x { STRING (unquote x) } 10 | | ',' { COMMA } 11 | | '[' { LBRACKET } 12 | | ']' { RBRACKET } 13 | | '=' { EQ } 14 | | ';' { SEMICOLON } 15 | | '\n' 16 | | '#'[^'\n']*'\n' { NEWLINE } 17 | | [' ' '\t' ] { token lexbuf } 18 | | eof { EOF } 19 | -------------------------------------------------------------------------------- /cli/xn_cfg_parser.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | open Xn_cfg_types 3 | %} 4 | %token IDENT STRING 5 | %token INT 6 | %token COMMA LBRACKET RBRACKET EQ SEMICOLON NEWLINE EOF 7 | %start file /* the entry point */ 8 | %type file 9 | %% 10 | file: EOF { [] } 11 | | NEWLINE file { $2 } 12 | | setting file { $1 :: $2 } 13 | ; 14 | 15 | setting: IDENT EQ value endstmt { $1, $3 } 16 | ; 17 | 18 | endstmt: NEWLINE { () } 19 | | SEMICOLON { () } 20 | ; 21 | 22 | value: atom { $1 } 23 | | LBRACKET nlok valuelist RBRACKET { List $3 } 24 | ; 25 | 26 | atom: STRING { String $1 } 27 | | INT { Int $1 } 28 | ; 29 | 30 | valuelist: /* empty */ { [] } 31 | | values { $1 } 32 | | values COMMA nlok { $1 } 33 | ; 34 | 35 | values: atom nlok { [ $1 ] } 36 | | values COMMA nlok atom nlok { $4 :: $1 } 37 | ; 38 | 39 | nlok: /* empty */ { () } 40 | | nlok NEWLINE { () } 41 | ; 42 | -------------------------------------------------------------------------------- /cli/xn_cfg_types.ml: -------------------------------------------------------------------------------- 1 | let ( |> ) a b = b a 2 | 3 | type value = String of string | Int of int | List of value list 4 | [@@deriving rpc] 5 | 6 | exception Type_error of string * string 7 | 8 | let string = function 9 | | String x -> 10 | x 11 | | x -> 12 | raise (Type_error ("string", x |> rpc_of_value |> Jsonrpc.to_string)) 13 | 14 | let int = function 15 | | Int x -> 16 | x 17 | | x -> 18 | raise (Type_error ("int", x |> rpc_of_value |> Jsonrpc.to_string)) 19 | 20 | let bool = function 21 | | Int 1 -> 22 | true 23 | | Int 0 -> 24 | false 25 | | x -> 26 | raise (Type_error ("bool", x |> rpc_of_value |> Jsonrpc.to_string)) 27 | 28 | let list f = function 29 | | List vs -> 30 | List.map f vs 31 | | x -> 32 | raise (Type_error ("int", x |> rpc_of_value |> Jsonrpc.to_string)) 33 | 34 | type config = (string * value) list [@@deriving rpc] 35 | 36 | (* Well-known constants *) 37 | let _kernel = "kernel" 38 | 39 | let _ramdisk = "ramdisk" 40 | 41 | let _root = "root" 42 | 43 | let _builder = "builder" 44 | 45 | let _bootloader = "bootloader" 46 | 47 | let _boot = "boot" 48 | 49 | let _name = "name" 50 | 51 | let _uuid = "uuid" 52 | 53 | let _memory = "memory" (* MiB *) 54 | 55 | let _cpus = "cpus" (* pCPUs *) 56 | 57 | let _vcpus = "vcpus" (* number of vCPUs *) 58 | 59 | let _vif = "vif" 60 | 61 | let _backend = "backend" 62 | 63 | let _bridge = "bridge" 64 | 65 | let _ip = "ip" 66 | 67 | let _mac = "mac" 68 | 69 | let _script = "script" 70 | 71 | let _type = "type" 72 | 73 | let _vifname = "vifname" 74 | 75 | let _disk = "disk" 76 | 77 | let _pci = "pci" 78 | 79 | let _msitranslate = "msitranslate" 80 | 81 | let _power_mgmt = "power_mgmt" 82 | 83 | let _vm_pci_msitranslate = "pci_msitranslate" 84 | 85 | let _vm_pci_power_mgmt = "pci_power_mgmt" 86 | 87 | let _vm_has_vendor_device = "has_vendor_device" 88 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | D=$(mktemp -d "${TMPDIR:-/tmp}/configure.XXXXX") 4 | function cleanup { 5 | cd / 6 | rm -rf $D 7 | } 8 | trap cleanup EXIT 9 | 10 | cp configure.ml $D 11 | (cd $D; ocamlfind ocamlopt -package "cmdliner,findlib,unix" -linkpkg configure.ml -o configure) 12 | $D/configure $* 13 | -------------------------------------------------------------------------------- /dbgring/dbgring.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | open Xenops_utils 15 | 16 | let xenstored_proc_port = "/proc/xen/xsd_port" 17 | 18 | let xenstored_proc_kva = "/proc/xen/xsd_kva" 19 | 20 | let open_ring0 () = 21 | let fd = Unix.openfile xenstored_proc_kva [Unix.O_RDWR] 0o600 in 22 | let sz = Xenmmap.getpagesize () in 23 | let intf = Xenmmap.mmap fd Xenmmap.RDWR Xenmmap.SHARED sz 0 in 24 | Unix.close fd ; intf 25 | 26 | let open_ringU domid mfn = 27 | let xc = Xenctrl.interface_open () in 28 | Xapi_stdext_pervasives.Pervasiveext.finally 29 | (fun () -> Xenctrl.map_foreign_range xc domid (Xenmmap.getpagesize ()) mfn) 30 | (fun () -> Xenctrl.interface_close xc) 31 | 32 | let open_ring domid mfn = 33 | if domid = 0 then 34 | open_ring0 () 35 | else 36 | open_ringU domid mfn 37 | 38 | let hexify s = 39 | let hexseq_of_char c = Printf.sprintf "%02x" (Char.code c) in 40 | let hs = Bytes.create (String.length s * 2) in 41 | for i = 0 to String.length s - 1 do 42 | let seq = hexseq_of_char s.[i] in 43 | Bytes.set hs (i * 2) seq.[0] ; 44 | Bytes.set hs ((i * 2) + 1) seq.[1] 45 | done ; 46 | Bytes.to_string hs 47 | 48 | let ring_size = 1024 49 | 50 | let alpha ~req_cons ~req_prod ~rsp_cons ~rsp_prod s = 51 | let s = Bytes.of_string s in 52 | for i = 0 to Bytes.length s - 1 do 53 | if 54 | (i < 2 * ring_size && i >= req_cons && i <= req_prod) 55 | || (i < 4 * ring_size && i >= rsp_cons && i <= rsp_prod) 56 | then 57 | Bytes.set s i '$' 58 | else if 59 | (Bytes.get s i >= 'a' && Bytes.get s i <= 'z') 60 | || (Bytes.get s i >= 'A' && Bytes.get s i <= 'Z') 61 | || (Bytes.get s i >= '0' && Bytes.get s i <= '9') 62 | || Bytes.get s i = '/' 63 | || Bytes.get s i = '-' 64 | || Bytes.get s i = '@' 65 | then 66 | () 67 | else 68 | Bytes.set s i '+' 69 | done ; 70 | Bytes.to_string s 71 | 72 | let int_from_page ss n = 73 | let b1 = String.sub ss n 2 in 74 | let b2 = String.sub ss (n + 2) 2 in 75 | int_of_string ("0x" ^ b2 ^ b1) mod ring_size 76 | 77 | let _ = 78 | let domid, mfn = 79 | try (int_of_string Sys.argv.(1), Nativeint.of_string Sys.argv.(2)) 80 | with _ -> (0, Nativeint.zero) 81 | in 82 | let sz = Xenmmap.getpagesize () - 1024 - 512 in 83 | let intf = open_ring domid mfn in 84 | let s = Xenmmap.read intf 0 sz in 85 | let ss = hexify s in 86 | let req_cons = int_from_page ss (4 * ring_size) in 87 | let req_prod = int_from_page ss (8 + (4 * ring_size)) in 88 | let rsp_cons = ring_size + int_from_page ss (16 + (4 * ring_size)) in 89 | let rsp_prod = ring_size + int_from_page ss (24 + (4 * ring_size)) in 90 | let ss2 = alpha ~req_cons ~req_prod ~rsp_cons ~rsp_prod s in 91 | Printf.printf "req-cons=%i \t req-prod=%i \t rsp-cons=%i \t rsp-prod=%i\n" 92 | req_cons req_prod (rsp_cons - ring_size) (rsp_prod - ring_size) ; 93 | Printf.printf "==== requests ====\n" ; 94 | for i = 0 to (sz / 64) - 1 do 95 | if i = ring_size / 64 then 96 | Printf.printf "==== replied ====\n" ; 97 | if i = 2 * ring_size / 64 then 98 | Printf.printf "==== other ====\n" ; 99 | let x = String.sub ss (i * 128) 128 in 100 | Printf.printf "%.4d " (i * 64) ; 101 | for j = 0 to (128 / 4) - 1 do 102 | Printf.printf "%s " (String.sub x (j * 4) 4) 103 | done ; 104 | Printf.printf "%s" (String.sub ss2 (i * 64) 64) ; 105 | Printf.printf "\n" 106 | done 107 | -------------------------------------------------------------------------------- /dbgring/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name dbgring) 3 | (public_name dbgring) 4 | (package xapi-xenopsd-xc) 5 | (libraries 6 | xapi-xenopsd 7 | xenctrl 8 | xenstore 9 | xenstore.unix 10 | xenstore_transport 11 | xenstore_transport.unix 12 | threads 13 | xapi-idl.xen 14 | rpclib.core 15 | uutf 16 | xapi-idl 17 | rpclib.json 18 | xapi-stdext-pervasives 19 | ) 20 | ) 21 | -------------------------------------------------------------------------------- /doc/README.md: -------------------------------------------------------------------------------- 1 | Xenopsd: the developer handbook 2 | =============================== 3 | 4 | Xenopsd is the [xapi-project](http://github.com/xapi-project) VM manager. 5 | Xenopsd is responsible for 6 | - starting, stopping, suspending, resuming, migrating VMs 7 | - hotplugging and unplugging disks (VBDs) 8 | - hotplugging and unplugging nics (VIFs) 9 | - hotplugging and unplugging PCI devices 10 | - setting up VM consoles 11 | - running bootloaders 12 | - setting QoS parameters 13 | - configuring SMBIOS tables 14 | - handling crashes 15 | etc 16 | 17 | Check out the [full features list](features.md). 18 | 19 | Principles 20 | ---------- 21 | 22 | 1. do no harm: Xenopsd should never touch domains/VMs which it hasn't been 23 | asked to manage. This means that it can co-exist with other VM managers 24 | such as 'xl' and 'libvirt' 25 | 2. be independent: Xenopsd should be able to work in isolation. In particular 26 | the loss of some other component (e.g. the network) should not by itself 27 | prevent VMs being managed locally (including shutdown and reboot). 28 | 3. asynchronous by default: Xenopsd exposes task monitoring and offers 29 | cancellation for all operations. Xenopsd ensures that the system is always 30 | in a manageable state after an operation has been cancelled. 31 | 4. avoid state duplication: where another component owns some state, Xenopsd 32 | will always defer to it. We will avoid creating out-of-sync caches of 33 | this state. 34 | 5. be debuggable: Xenopsd will expose diagnostic APIs and tools to allow 35 | its internal state to be inspected and modified. 36 | 37 | Contents 38 | -------- 39 | 40 | - [Architecture](architecture/README.md): read about how Xenopsd fits into 41 | the overall system; and the major pieces and patterns within Xenopsd. 42 | - [Features](features/README.md): learn about the features supported by Xenopsd and 43 | how they work. 44 | - [Design](design/README.md): discover the low-level details, formats, protocols, 45 | concurrency etc. 46 | - [Walk-throughs](walk-throughs/README.md): follow operations end-to-end to 47 | understand how it all fits together. 48 | - [Futures](futures/README.md): find out how Xenopsd is likely to change and 49 | how you can help. 50 | -------------------------------------------------------------------------------- /doc/design/Events.md: -------------------------------------------------------------------------------- 1 | 2 | - ids rather than data; inherently coalescable 3 | - blocking poll + async operations implies a client needs 2 connections 4 | - coarse granularity 5 | - similarity and differences with: XenAPI, event channels, xenstore watches 6 | 7 | https://github.com/xapi-project/xen-api/blob/30cc9a72e8726d1e7501cd01ddb27ced6d53b9be/ocaml/xapi/xapi_xenops.ml#L1467 8 | -------------------------------------------------------------------------------- /doc/design/README.md: -------------------------------------------------------------------------------- 1 | Xenopsd design details 2 | ====================== 3 | 4 | Before reading these, first familiarise yourself with the 5 | [architecture](../architecture/README.md). 6 | 7 | - Communication 8 | - Concepts: names, requests, responses 9 | - Metadata 10 | - Registered VMs 11 | - Backend-private data 12 | - Task handling 13 | - Cancellation: including discussion of the necessary invariants and testing 14 | techniques 15 | - Event handling 16 | - Principles: level-triggered, no queues, lazy-resync style 17 | - Watching xenstore 18 | - The 'domain action request' 19 | - Suspend/resume/migrate 20 | - Discussion of the [needs of the suspend image format](suspend-image-considerations.md) 21 | - The [suspend image framing format](suspend-image-framing-format.md) 22 | - Storage driver domains 23 | -------------------------------------------------------------------------------- /doc/design/suspend-image-considerations.md: -------------------------------------------------------------------------------- 1 | Suspend image considerations 2 | ============================ 3 | 4 | We are currently (Dec 2013) undergoing a transition from the 'classic' xenopsd 5 | backend (built upon calls to libxc) to the 'xenlight' backend built on top of 6 | the officially supported libxl API. 7 | 8 | During this work, we have come across an incompatibility between the suspend 9 | images created using the 'classic' backend and those created using the new 10 | libxl-based backend. This needed to be fixed to enable RPU to any new version 11 | of XenServer. 12 | 13 | Historic 'classic' stack 14 | ------------------------ 15 | Prior to this work, xenopsd was involved in the construction of the suspend 16 | image and we ended up with an image with the following format: 17 | 18 | +-----------------------------+ 19 | | "XenSavedDomain\n" | <-- added by xenopsd-classic 20 | |-----------------------------| 21 | | Memory image dump | <-- libxc 22 | |-----------------------------| 23 | | "QemuDeviceModelRecord\n" | 24 | | | <-- added by xenopsd-classic 25 | | (a 32-bit big-endian int) | 26 | |-----------------------------| 27 | | "QEVM" | <-- libxc/qemu 28 | | Qemu device record | 29 | +-----------------------------+ 30 | 31 | We have also been carrying a patch in the Xen patchqueue against 32 | xc_domain_restore. This patch (revert_qemu_tail.patch) stopped 33 | xc_domain_restore from attempting to read past the memory image dump. At which 34 | point xenopsd-classic would just take over and restore what it had put there. 35 | 36 | Requirements for new stack 37 | -------------------------- 38 | For xenopsd-xenlight to work, we need to operate without the 39 | revert_qemu_tail.patch since libxl assumes it is operating on top of an 40 | upstream libxc. 41 | 42 | We need the following relationship between suspend images created on one 43 | backend being able to be restored on another backend. Where the backends are 44 | old-classic (OC), new-classic (NC) and xenlight (XL). Obviously all suspend 45 | images created on any backend must be able to be restored on the same backend: 46 | 47 | OC _______ NC _______ XL 48 | \ >>>>> >>>>> / 49 | \__________________/ 50 | >>>>>>>>>>>>>>>> 51 | 52 | It turns out this was not so simple. After removing the patch against 53 | xc_domain_restore and allowing libxc to restore the hvm_buffer_tail, we found 54 | that supsend images created with OC (detailed in the previous section) are not 55 | of a valid format for two reasons: 56 | 57 | i. The "XenSavedDomain\n" was extraneous; 58 | ii. The Qemu signature section (prior to the record) is not of valid form. 59 | 60 | It turns out that the section with the Qemu signature can be one of the 61 | following: 62 | 63 | a. "QemuDeviceModelRecord" (NB. no newline) followed by the record to EOF; 64 | b. "DeviceModelRecord0002" then a uint32_t length followed by record; 65 | c. "RemusDeviceModelState" then a uint32_t length followed by record; 66 | 67 | The old-classic (OC) backend not only uses an invalid signature (since it 68 | contains a trailing newline) but it also includes a length, _and_ the length is 69 | in big-endian when the uint32_t is seen to be little-endian. 70 | 71 | We considered creating a proxy for the fd in the incompatible cases but since 72 | this would need to be a 22-lookahead byte-by-byte proxy this was deemed 73 | impracticle. Instead we have made patched libxc with a much simpler patch to 74 | understand this legacy format. 75 | 76 | Because peek-ahead is not possible on pipes, the patch for (ii) needed to be 77 | applied at a point where the hvm tail had been read completely. We piggy-backed 78 | on the point after (a) had been detected. At this point the remainder of the fd 79 | is buffered (only around 7k) and the magic "QEVM" is expected at the head of 80 | this buffer. So we simply added a patch to check if there was a pesky newline 81 | and the buffer[5:8] was "QEVM" and if it was we could discard the first 82 | 5 bytes: 83 | 84 | 0 1 2 3 4 5 6 7 8 85 | Legacy format from OC: [...| \n | \x | \x | \x | \x | Q | E | V | M |...] 86 | 87 | Required at this point: [...| Q | E | V | M |...] 88 | 89 | Changes made 90 | ------------ 91 | To make the above use-cases work, we have made the following changes: 92 | 93 | 1. Make new-classic (NC) not restore Qemu tail (let libxc do it) 94 | xenopsd.git:ef3bf4b 95 | 96 | 2. Make new-classic use valid signature (b) for future restore images 97 | xenopsd.git:9ccef3e 98 | 99 | 3. Make xc_domain_restore in libxc understand legacy xenopsd (OC) format 100 | xen-4.3.pq.hg:libxc-restore-legacy-image.patch 101 | 102 | 4. Remove revert-qemu-tail.patch from Xen patchqueue 103 | xen-4.3.pq.hg:3f0e16f2141e 104 | 105 | 5. Make xenlight (XL) use "XenSavedDomain\n" start-of-image signature 106 | xenopsd.git:dcda545 107 | 108 | This has made the required use-cases work as follows: 109 | 110 | OC __134__ NC __245__ XL 111 | \ >>>>> >>>>> / 112 | \_______345________/ 113 | >>>>>>>>>>>>>>>> 114 | 115 | And the suspend-resume on same backends work by virtue of: 116 | 117 | OC --> OC : Just works 118 | NC --> NC : By 1,2,4 119 | XL --> XL : By 4 (5 is used but not required) 120 | 121 | New components 122 | -------------- 123 | The output of the changes above are: 124 | * A new xenops-xc binary for NC 125 | * A new xenops-xl binary for XL 126 | * A new libxenguest.4.3 for both of NC and XL 127 | 128 | Future considerations 129 | --------------------- 130 | This should serve as a useful reference when considering making changes to the 131 | suspend image in any way. 132 | -------------------------------------------------------------------------------- /doc/design/suspend-image-framing-format.md: -------------------------------------------------------------------------------- 1 | Suspend image format 2 | -------------------- 3 | 4 | Example suspend image layout: 5 | 6 | +----------------------------+ 7 | | 1. Suspend image signature | 8 | +============================+ 9 | | 2.0 Xenops header | 10 | | 2.1 Xenops record | 11 | +============================+ 12 | | 3.0 Libxc header | 13 | | 3.1 Libxc record | 14 | +============================+ 15 | | 4.0 Qemu header | 16 | | 4.1 Qemu save record | 17 | +============================+ 18 | | 5.0 End_of_image footer | 19 | +----------------------------+ 20 | 21 | A suspend image is now constucted as a series of header-record pairs. The 22 | initial signature (1.) is used to determine whether we are dealing with the 23 | unstructured, "legacy" suspend image or the new, structured format. 24 | 25 | Each header is two 64-bit integers: the first identifies the header type and 26 | the second is the length of the record that follows in bytes. The following 27 | types have been defined (the ones marked with a (*) have yet to be 28 | implemented): 29 | 30 | * Xenops : Metadata for the suspend image 31 | * Libxc : The result of a xc_domain_save 32 | * Libxl* : Not implemented 33 | * Libxc_legacy : Marked as a libxc record saved using pre-Xen-4.5 34 | * Qemu_trad : The qemu save file for the Qemu used in XenServer 35 | * Qemu_xen* : Not implemented 36 | * Demu* : Not implemented 37 | * Varstored* : Not implemented 38 | * End_of_image : A footer marker to denote the end of the suspend image 39 | 40 | Some of the above types do not have the notion of a length since they cannot be 41 | known upfront before saving and also are delegated to other layers of the stack 42 | on restoring. Specifically these are the memory image sections, libxc and 43 | libxl. 44 | 45 | -------------------------------------------------------------------------------- /doc/features/README.md: -------------------------------------------------------------------------------- 1 | General 2 | ------- 3 | 4 | - Pluggable backends including 5 | - xc: drives Xen via libxc and libxenguest 6 | - xenlight: drives Xen via libxenlight and libxc 7 | - libvirt: drives Xen via libvirt 8 | - qemu: drives KVM by running qemu processes 9 | - simulator: simulates operations for component-testing 10 | - Supports running multiple instances and backends on the same host, looking 11 | after different sets of VMs 12 | - Distribution agnostic, known to work on 13 | - XenServer 14 | - CentOS 6.* 15 | - Ubuntu 14.04 16 | - Fedora 21 17 | - Extensive configuration via command-line (see manpage) and config 18 | file 19 | - Command-line tool for easy VM administration and troubleshooting 20 | - User-settable degree of concurrency to get VMs started quickly 21 | 22 | VMs 23 | --- 24 | - VM start/shutdown/reboot 25 | - VM suspend/resume/checkpoint/migrate 26 | - VM pause/unpause 27 | - VM s3suspend/s3resume 28 | - customisable SMBIOS tables for OEM-locked VMs 29 | - hooks for 3rd party extensions: 30 | - pre-start 31 | - pre-destroy 32 | - post-destroy 33 | - pre-reboot 34 | - per-VM xenguest replacement 35 | - suppression of VM reboot loops 36 | - live vCPU hotplug and unplug 37 | - vCPU to pCPU affinity setting 38 | - vCPU QoS settings (weight and cap for the Xen credit2 scheduler) 39 | - DMC memory-ballooning support 40 | - support for storage driver domains 41 | - live update of VM shadow memory 42 | - guest-initiated disk/nic hotunplug 43 | - guest-initiated disk eject 44 | - force disk/nic unplug 45 | - support for 'surprise-removable' devices 46 | - disk QoS configuration 47 | - nic QoS configuration 48 | - persistent RTC 49 | - two-way guest agent communication for monitoring and control 50 | - network carrier configuration 51 | - port-locking for nics 52 | - text and VNC consoles over TCP and Unix domain sockets 53 | - PV kernel and ramdisk whitelisting 54 | - configurable VM videoram 55 | - programmable action-after-crash behaviour including: shutting down 56 | the VM, taking a crash dump or leaving the domain paused for inspection 57 | - ability to move nics between bridges/switches 58 | - advertises the VM memory footprints 59 | - PCI passthrough 60 | - support for discrete emulators (e.g. 'demu') 61 | - PV keyboard and mouse 62 | - qemu stub domains 63 | - cirrus and stdvga graphics cards 64 | - HVM serial console (useful for debugging) 65 | - support for vGPU 66 | - workaround for 'spurious page faults' kernel bug 67 | - workaround for 'machine address size' kernel bug 68 | 69 | Hosts 70 | ----- 71 | - CPUid masking for heterogenous pools: reports true features and current 72 | features 73 | - Host console reading 74 | - Hypervisor version and capabilities reporting 75 | - Host CPU querying 76 | 77 | APIs 78 | ---- 79 | - versioned json-rpc API with feature advertisements 80 | - clients can disconnect, reconnect and easily resync with the latest 81 | VM state without losing updates 82 | - all operations have task control including 83 | - asychronous cancellation: for both subprocesses and xenstore watches 84 | - progress updates 85 | - subtasks 86 | - per-task debug logs 87 | - asynchronous event watching API 88 | - advertises VM metrics 89 | - memory usage 90 | - balloon driver co-operativeness 91 | - shadow memory usage 92 | - domain ids 93 | - channel passing (via sendmsg(2)) for efficent memory image copying 94 | -------------------------------------------------------------------------------- /doc/futures/README.md: -------------------------------------------------------------------------------- 1 | Xenopsd futures 2 | =============== 3 | 4 | Nothing is ever perfect; how would we like Xenopsd to change and why? 5 | 6 | - light-weight concurrency via Core/Async 7 | - channel-passing rather than fd-passing 8 | - support for libxl-style inter-domain communication channels 9 | - use journalling throughput for restart-ability 10 | -------------------------------------------------------------------------------- /doc/walk-throughs/README.md: -------------------------------------------------------------------------------- 1 | Xenopsd operation walk-throughs 2 | =============================== 3 | 4 | Let's trace through interesting operations to see how the whole system 5 | works. 6 | 7 | - [Starting a VM](VM.start.md) 8 | - Shutting down a VM and waiting for it to happen 9 | - A VM wants to reboot itself 10 | - A disk is hotplugged 11 | - A disk refuses to hotunplug 12 | - A VM is suspended 13 | - A VM is migrated 14 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (gprof 3 | (ocamlopt_flags 4 | (:standard -g -p -w -39) 5 | ) 6 | (flags 7 | (:standard -w -39) 8 | ) 9 | ) 10 | (dev 11 | (flags 12 | (:standard -g -w -39) 13 | ) 14 | ) 15 | (release 16 | (flags 17 | (:standard -w -39) 18 | ) 19 | ) 20 | ) 21 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | (allow_approximate_merlin) 3 | (formatting (enabled_for ocaml)) 4 | -------------------------------------------------------------------------------- /lib/bootloader.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | (** Raised when we can't parse the output of the bootloader *) 16 | exception Bad_sexpr of string 17 | 18 | (** Raised when we can't parse the error from the bootloader *) 19 | exception Bad_error of string 20 | 21 | (** Raised when the bootloader returns an error *) 22 | exception Error_from_bootloader of string 23 | 24 | (** Raised when an unknown bootloader is used *) 25 | exception Unknown_bootloader of string 26 | 27 | val supported_bootloaders : string list 28 | (** Bootloaders which are known to the system *) 29 | 30 | (** Parsed representation of bootloader's stdout, as used by xend *) 31 | type t = {kernel_path: string; initrd_path: string option; kernel_args: string} 32 | 33 | val extract : 34 | Xenops_task.Xenops_task.task_handle 35 | -> bootloader:string 36 | -> disk:string 37 | -> ?legacy_args:string 38 | -> ?extra_args:string 39 | -> ?pv_bootloader_args:string 40 | -> vm:string 41 | -> unit 42 | -> t 43 | (** Extract the default kernel from the disk *) 44 | 45 | val delete : t -> unit 46 | (** Delete the extracted kernel *) 47 | -------------------------------------------------------------------------------- /lib/cancellable_subprocess.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | open Xenops_utils 15 | open Xenops_task 16 | 17 | module D = Debug.Make (struct let name = "xenops" end) 18 | 19 | open D 20 | open Forkhelpers 21 | 22 | let finally = Xapi_stdext_pervasives.Pervasiveext.finally 23 | 24 | let run (task : Xenops_task.task_handle) ?env ?stdin fds 25 | ?(syslog_stdout = NoSyslogging) cmd args = 26 | let stdinandpipes = 27 | Option.map 28 | (fun str -> 29 | let x, y = Unix.pipe () in 30 | (str, x, y) 31 | ) 32 | stdin 33 | in 34 | (* Used so that cancel -> kills subprocess -> Unix.WSIGNALED -> raise 35 | cancelled *) 36 | let cancelled = ref false in 37 | finally 38 | (fun () -> 39 | match 40 | with_logfile_fd "execute_command_get_out" (fun out_fd -> 41 | with_logfile_fd "execute_command_get_err" (fun err_fd -> 42 | let t = 43 | safe_close_and_exec ?env 44 | (Option.map (fun (_, fd, _) -> fd) stdinandpipes) 45 | (Some out_fd) (Some err_fd) fds ~syslog_stdout cmd args 46 | in 47 | let done_waitpid = ref false in 48 | finally 49 | (fun () -> 50 | let pid' = Forkhelpers.getpid t in 51 | Xenops_task.with_cancel task 52 | (fun () -> 53 | cancelled := true ; 54 | info "Cancelling: sending SIGKILL to %d" pid' ; 55 | try Unix.kill pid' Sys.sigkill with _ -> () 56 | ) 57 | (fun () -> 58 | Option.iter 59 | (fun (str, _, wr) -> 60 | Unixext.really_write wr str 0 (String.length str) 61 | ) 62 | stdinandpipes ; 63 | done_waitpid := true ; 64 | snd (Forkhelpers.waitpid t) 65 | ) 66 | ) 67 | (fun () -> if not !done_waitpid then Forkhelpers.dontwaitpid t) 68 | ) 69 | ) 70 | with 71 | | Success (out, Success (err, status)) -> ( 72 | match status with 73 | | Unix.WEXITED 0 -> 74 | (out, err) 75 | | Unix.WEXITED n -> 76 | raise (Spawn_internal_error (err, out, Unix.WEXITED n)) 77 | | Unix.WSTOPPED n -> 78 | raise (Spawn_internal_error (err, out, Unix.WSTOPPED n)) 79 | | Unix.WSIGNALED n -> 80 | if !cancelled then ( 81 | debug 82 | "Subprocess %s exited with signal %d and cancel requested; \ 83 | raising Cancelled" 84 | cmd n ; 85 | Xenops_task.raise_cancelled task 86 | ) else ( 87 | debug "Subprocess %s exited with signal %d" cmd n ; 88 | raise (Spawn_internal_error (err, out, Unix.WSIGNALED n)) 89 | ) 90 | ) 91 | | Success (_, Failure (_, exn)) | Failure (_, exn) -> 92 | raise exn 93 | ) 94 | (fun () -> 95 | Option.iter (fun (_, x, y) -> Unix.close x ; Unix.close y) stdinandpipes 96 | ) 97 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (with-stdout-to 3 | version.ml 4 | (bash "echo \"let version = \\\"$(cat ../VERSION)\\\"\"") 5 | ) 6 | ) 7 | 8 | (library 9 | (name xenopsd) 10 | (public_name xapi-xenopsd) 11 | (wrapped false) 12 | (flags :standard -warn-error +a-3) 13 | (libraries 14 | astring 15 | c_stubs 16 | cohttp 17 | fd-send-recv 18 | fmt 19 | forkexec 20 | re 21 | result 22 | rpclib.core 23 | rpclib.json 24 | rresult 25 | sexplib 26 | sexplib0 27 | uri 28 | uuidm 29 | uutf 30 | threads.posix 31 | xapi-backtrace 32 | xapi-idl 33 | xapi-idl.storage 34 | xapi-idl.storage.interface 35 | xapi-idl.updates 36 | xapi-idl.varstore.privileged 37 | xapi-idl.xen 38 | xapi-idl.xen.interface 39 | xapi-idl.xen.interface.types 40 | xapi-stdext-date 41 | xapi-stdext-pervasives 42 | xapi-stdext-threads 43 | xapi-stdext-unix 44 | xmlm 45 | ) 46 | (preprocess 47 | (pps ppx_deriving_rpc ppx_sexp_conv) 48 | ) 49 | ) 50 | -------------------------------------------------------------------------------- /lib/interface.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | open Xenops_interface 16 | open Xenops_utils 17 | 18 | (* The network manipulation scripts need to find the VM metadata given only an 19 | interface name (e.g. "tapX.Y" or "fooUUID"?) *) 20 | 21 | module Interface = struct 22 | type t = {name: string; vif: Vif.id} [@@deriving rpcty] 23 | 24 | let rpc_of_t x = Rpcmarshal.marshal t.Rpc.Types.ty x 25 | 26 | let t_of_rpc x = 27 | match Rpcmarshal.unmarshal t.Rpc.Types.ty x with 28 | | Ok y -> 29 | y 30 | | Error (`Msg msg) -> 31 | failwith msg 32 | end 33 | 34 | module DB = TypedTable (struct 35 | include Interface 36 | 37 | let namespace = "interface" 38 | 39 | type key = string 40 | 41 | let key x = [x] 42 | end) 43 | -------------------------------------------------------------------------------- /lib/io.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | let ( ||| ) a b = Int64.logor a b 16 | 17 | (* read size bytes and return the completed buffer *) 18 | let read fd size = 19 | let buf = Bytes.create size in 20 | let i = ref size in 21 | while !i <> 0 do 22 | let rd = Unix.read fd buf (size - !i) !i in 23 | if rd <= 0 then raise End_of_file ; 24 | i := !i - rd 25 | done ; 26 | Bytes.unsafe_to_string buf 27 | 28 | (** write a buf to fd *) 29 | let write fd buf = 30 | let len = String.length buf in 31 | let i = ref len in 32 | while !i <> 0 do 33 | let wd = Unix.write_substring fd buf (len - !i) !i in 34 | i := !i - wd 35 | done 36 | 37 | (** connect to the host and port, and give the fd *) 38 | let connect host port = 39 | let sockaddr = Unix.ADDR_INET (host, port) in 40 | let fd = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in 41 | try Unix.connect fd sockaddr ; fd with e -> Unix.close fd ; raise e 42 | 43 | let byte_order_of_int ~endianness = 44 | match endianness with `big -> (0, 1, 2, 3) | `little -> (3, 2, 1, 0) 45 | 46 | let byte_order_of_int64 ~endianness = 47 | match endianness with 48 | | `big -> 49 | (0, 1, 2, 3, 4, 5, 6, 7) 50 | | `little -> 51 | (7, 6, 5, 4, 3, 2, 1, 0) 52 | 53 | let marshall_int ~endianness x = 54 | let buffer = Bytes.of_string "\000\000\000\000" in 55 | let a, b, c, d = byte_order_of_int ~endianness in 56 | Bytes.set buffer a @@ char_of_int ((x lsr 24) land 0xff) ; 57 | Bytes.set buffer b @@ char_of_int ((x lsr 16) land 0xff) ; 58 | Bytes.set buffer c @@ char_of_int ((x lsr 8) land 0xff) ; 59 | Bytes.set buffer d @@ char_of_int ((x lsr 0) land 0xff) ; 60 | Bytes.unsafe_to_string buffer 61 | 62 | let write_int ~endianness fd x = write fd (marshall_int ~endianness x) 63 | 64 | let marshall_int64 ~endianness x = 65 | let buffer = Bytes.of_string "\000\000\000\000\000\000\000\000" in 66 | let a, b, c, d, e, f, g, h = byte_order_of_int64 ~endianness in 67 | Bytes.set buffer a 68 | @@ char_of_int Int64.(to_int (logand (shift_right_logical x 56) 0xffL)) ; 69 | Bytes.set buffer b 70 | @@ char_of_int Int64.(to_int (logand (shift_right_logical x 48) 0xffL)) ; 71 | Bytes.set buffer c 72 | @@ char_of_int Int64.(to_int (logand (shift_right_logical x 40) 0xffL)) ; 73 | Bytes.set buffer d 74 | @@ char_of_int Int64.(to_int (logand (shift_right_logical x 32) 0xffL)) ; 75 | Bytes.set buffer e 76 | @@ char_of_int Int64.(to_int (logand (shift_right_logical x 24) 0xffL)) ; 77 | Bytes.set buffer f 78 | @@ char_of_int Int64.(to_int (logand (shift_right_logical x 16) 0xffL)) ; 79 | Bytes.set buffer g 80 | @@ char_of_int Int64.(to_int (logand (shift_right_logical x 8) 0xffL)) ; 81 | Bytes.set buffer h 82 | @@ char_of_int Int64.(to_int (logand (shift_right_logical x 0) 0xffL)) ; 83 | Bytes.unsafe_to_string buffer 84 | 85 | let write_int64 ~endianness fd x = write fd (marshall_int64 ~endianness x) 86 | 87 | let unmarshall_int ~endianness buffer = 88 | let a, b, c, d = byte_order_of_int ~endianness in 89 | let a = int_of_char buffer.[a] 90 | and b = int_of_char buffer.[b] 91 | and c = int_of_char buffer.[c] 92 | and d = int_of_char buffer.[d] in 93 | (a lsl 24) lor (b lsl 16) lor (c lsl 8) lor d 94 | 95 | let read_int ~endianness fd = 96 | let buffer = read fd 4 in 97 | unmarshall_int ~endianness buffer 98 | 99 | let unmarshall_int64 ~endianness buffer = 100 | let char_to_int64 x = Int64.of_int (int_of_char buffer.[x]) in 101 | let a, b, c, d, e, f, g, h = byte_order_of_int64 ~endianness in 102 | let a = char_to_int64 a 103 | and b = char_to_int64 b 104 | and c = char_to_int64 c 105 | and d = char_to_int64 d 106 | and e = char_to_int64 e 107 | and f = char_to_int64 f 108 | and g = char_to_int64 g 109 | and h = char_to_int64 h in 110 | Int64.( 111 | shift_left a 56 112 | ||| shift_left b 48 113 | ||| shift_left c 40 114 | ||| shift_left d 32 115 | ||| shift_left e 24 116 | ||| shift_left f 16 117 | ||| shift_left g 8 118 | ||| h 119 | ) 120 | 121 | let read_int64 ~endianness fd = 122 | let buffer = read fd 8 in 123 | unmarshall_int64 ~endianness buffer 124 | 125 | exception Integer_truncation 126 | 127 | let int_of_int64_exn i64 = 128 | let i = Int64.to_int i64 in 129 | if Int64.of_int i = i64 then 130 | i 131 | else 132 | raise Integer_truncation 133 | -------------------------------------------------------------------------------- /lib/ionice.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | open Xenops_interface.Vbd 16 | 17 | (* ionice invocations apply a 'class' and a 'parameter' to a process *) 18 | let to_class_param = 19 | let to_param = function 20 | | Highest -> 21 | 0 22 | | High -> 23 | 2 24 | | Normal -> 25 | 4 26 | | Low -> 27 | 6 28 | | Lowest -> 29 | 7 30 | | Other x -> 31 | x 32 | in 33 | function 34 | | RealTime x -> 35 | (1, to_param x) 36 | | Idle -> 37 | (3, to_param Lowest) 38 | | BestEffort x -> 39 | (2, to_param x) 40 | 41 | let of_class_param_exn cls param = 42 | let param = 43 | match param with 44 | | "7" -> 45 | Lowest 46 | | "6" -> 47 | Low 48 | | "4" -> 49 | Normal 50 | | "2" -> 51 | High 52 | | "0" -> 53 | Highest 54 | | x -> 55 | Other (int_of_string x) 56 | in 57 | match cls with 58 | | "idle" | "3" -> 59 | Idle 60 | | "realtime" | "1" -> 61 | RealTime param 62 | | "best-effort" | "2" -> 63 | BestEffort param 64 | | _ -> 65 | raise Not_found 66 | 67 | (* caught below *) 68 | 69 | exception Parse_failed of string 70 | 71 | let parse_result_exn s : qos_scheduler option = 72 | try 73 | match Astring.String.fields ~empty:false s with 74 | | [cls_colon; "prio"; param] -> ( 75 | match String.sub cls_colon 0 (String.length cls_colon - 1) with 76 | | "unknown" | "none" -> 77 | None 78 | | cls -> 79 | Some (of_class_param_exn cls param) 80 | ) 81 | | _ -> 82 | raise (Parse_failed s) 83 | with _ -> raise (Parse_failed s) 84 | 85 | let set_args qos pid = 86 | let cls, param = to_class_param qos in 87 | [ 88 | Printf.sprintf "-c%d" cls 89 | ; Printf.sprintf "-n%d" param 90 | ; Printf.sprintf "-p%d" pid 91 | ] 92 | 93 | let get_args pid = [Printf.sprintf "-p%d" pid] 94 | -------------------------------------------------------------------------------- /lib/mac.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | exception Invalid_Mac of string 16 | 17 | let check_mac mac = 18 | try 19 | if String.length mac <> 17 then failwith "mac length" ; 20 | Scanf.sscanf mac "%2x:%2x:%2x:%2x:%2x:%2x" (fun _ _ _ _ _ _ -> ()) ; 21 | mac 22 | with _ -> raise (Invalid_Mac mac) 23 | 24 | let xensource_oui = [0x00; 0x16; 0x3e] 25 | 26 | let xensource_mac () = 27 | let bytes = [0x00; 0x16; 0x3e] @ List.map Random.int [0x80; 0x100; 0x100] in 28 | String.concat ":" (List.map (Printf.sprintf "%02x") bytes) 29 | 30 | let make_local_mac bytes = 31 | (* make sure bit 1 (local) is set and bit 0 (unicast) is clear *) 32 | bytes.(0) <- bytes.(0) lor 0x2 land lnot 0x1 ; 33 | (* libvirt:virnetdevtap.c rejects MAC addresses starting with reserved value 34 | 0xfe *) 35 | if bytes.(0) = 0xfe then bytes.(0) <- 0xfd ; 36 | Printf.sprintf "%02x:%02x:%02x:%02x:%02x:%02x" bytes.(0) bytes.(1) bytes.(2) 37 | bytes.(3) bytes.(4) bytes.(5) 38 | 39 | (* Generate a completely random local MAC *) 40 | let random_local_mac () = 41 | make_local_mac (Array.init 6 (fun _ -> Random.int 0x100)) 42 | 43 | let hashchain_local_mac dev seed = 44 | let hash x = Digest.string x in 45 | let rec chain n f acc = 46 | if n = 0 then 47 | Digest.string acc 48 | else 49 | chain (n - 1) f (f acc) 50 | in 51 | let hashed_seed = chain (dev * 2) hash seed in 52 | let mac_data_1 = hashed_seed in 53 | let mac_data_2 = Digest.string hashed_seed in 54 | let take_byte n s = Char.code s.[n] in 55 | make_local_mac 56 | [| 57 | take_byte 0 mac_data_1 58 | ; take_byte 1 mac_data_1 59 | ; take_byte 2 mac_data_1 60 | ; take_byte 3 mac_data_1 61 | ; take_byte 1 mac_data_2 62 | ; take_byte 2 mac_data_2 63 | |] 64 | -------------------------------------------------------------------------------- /lib/platform.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | type platformdata = (string * string) list 16 | 17 | let is_valid ~key ~platformdata = 18 | (not (List.mem_assoc key platformdata)) 19 | || 20 | match List.assoc key platformdata |> String.lowercase_ascii with 21 | | "true" | "1" | "false" | "0" -> 22 | true 23 | | _ -> 24 | false 25 | 26 | let is_true ~key ~platformdata ~default = 27 | try 28 | match List.assoc key platformdata |> String.lowercase_ascii with 29 | | "true" | "1" -> 30 | true 31 | | "false" | "0" -> 32 | false 33 | | _ -> 34 | default 35 | (* Check for validity using is_valid if required *) 36 | with Not_found -> default 37 | -------------------------------------------------------------------------------- /lib/platform.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | (* This module defines interpretation of boolean platform values. It 16 | * matches the interpretation implemented in XenAPI for these values. 17 | *) 18 | 19 | type platformdata = (string * string) list 20 | 21 | val is_valid : key:string -> platformdata:platformdata -> bool 22 | (** [is_valid key platformdata] returns true if: 1. The key is _not_ in 23 | platformdata (absence of key is valid) or 2. The key is in platformdata, 24 | associated with a booleanish value *) 25 | 26 | val is_true : key:string -> platformdata:platformdata -> default:bool -> bool 27 | (** [is_true key platformdata default] returns true, if the platformdata 28 | contains a value for key that is "true" or "1". It returns false, if a value 29 | "0" or "false" exists. If the key doesn't exist or contains none of the 30 | values above, [default] is returned. *) 31 | -------------------------------------------------------------------------------- /lib/resources.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | let network_conf = ref "/etc/xcp/network.conf" 16 | 17 | let qemu_dm_wrapper = ref "qemu-dm-wrapper" 18 | 19 | let qemu_system_i386 = ref "qemu-system-i386" 20 | 21 | let upstream_compat_qemu_dm_wrapper = ref "qemu-wrapper" 22 | 23 | let chgrp = ref "chgrp" 24 | 25 | let modprobe = ref "/usr/sbin/modprobe" 26 | 27 | let rmmod = ref "/usr/sbin/rmmod" 28 | 29 | let hvmloader = ref "hvmloader" 30 | 31 | let pygrub = ref "pygrub" 32 | 33 | let eliloader = ref "eliloader" 34 | 35 | let legacy_conv_tool = ref "convert-legacy-stream" 36 | 37 | let verify_libxc_v2 = ref "verify-stream-v2" 38 | 39 | let cpu_info_file = ref "/etc/xensource/boot_time_cpus" 40 | 41 | let pvinpvh_xen = ref "/usr/libexec/xen/boot/xen-shim" 42 | 43 | open Unix 44 | 45 | let hvm_guests = 46 | [ 47 | (R_OK, "hvmloader", hvmloader, "path to the hvmloader binary for HVM guests") 48 | ; ( X_OK 49 | , "qemu-dm-wrapper" 50 | , qemu_dm_wrapper 51 | , "path to the qemu-dm-wrapper script" 52 | ) 53 | ; ( X_OK 54 | , "qemu-system-i386" 55 | , qemu_system_i386 56 | , "path to the qemu-system-i386 binary" 57 | ) 58 | ; ( X_OK 59 | , "upstream-compat-qemu-dm-wrapper" 60 | , upstream_compat_qemu_dm_wrapper 61 | , "path to the upstream compat qemu-dm-wrapper script" 62 | ) 63 | ] 64 | 65 | let pv_guests = 66 | [ 67 | (X_OK, "pygrub", pygrub, "path to the pygrub bootloader binary") 68 | ; (X_OK, "eliloader", eliloader, "path to the eliloader bootloader binary") 69 | ] 70 | 71 | let pvinpvh_guests = 72 | [ 73 | ( X_OK 74 | , "pvinpvh-xen" 75 | , pvinpvh_xen 76 | , "path to the inner-xen for PV-in-PVH guests" 77 | ) 78 | ] 79 | 80 | (* libvirt xc *) 81 | let network_configuration = 82 | [(R_OK, "network-conf", network_conf, "path to the network backend switch")] 83 | 84 | let essentials = 85 | [ 86 | (X_OK, "chgrp", chgrp, "path to the chgrp binary") 87 | ; (X_OK, "modprobe", modprobe, "path to the modprobe binary") 88 | ; (X_OK, "rmmod", rmmod, "path to the rmmod binary") 89 | ] 90 | 91 | let nonessentials = 92 | [ 93 | ( X_OK 94 | , "convert-legacy-stream" 95 | , legacy_conv_tool 96 | , "path to convert-legacy-stream tool" 97 | ) 98 | ; (R_OK, "cpu-info-file", cpu_info_file, "Where to cache boot-time CPU info") 99 | ; ( X_OK 100 | , "verify-stream-v2" 101 | , verify_libxc_v2 102 | , "tool to verify suspend image libxc stream" 103 | ) 104 | ] 105 | 106 | let make_resources ~essentials ~nonessentials = 107 | let open Xcp_service in 108 | List.map 109 | (fun (perm, name, path, description) -> 110 | {essential= true; name; description; path; perms= [perm]} 111 | ) 112 | essentials 113 | @ List.map 114 | (fun (perm, name, path, description) -> 115 | {essential= false; name; description; path; perms= [perm]} 116 | ) 117 | nonessentials 118 | -------------------------------------------------------------------------------- /lib/sockopt.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | external _set_sock_keepalives : Unix.file_descr -> int -> int -> int -> unit 16 | = "stub_sockopt_set_sock_keepalives" 17 | 18 | let set_sock_keepalives ?(count = 5) ?(idle = 30) ?(interval = 2) fd = 19 | let open Unix in 20 | if (fstat fd).st_kind = S_SOCK then ( 21 | setsockopt fd SO_KEEPALIVE true ; 22 | _set_sock_keepalives fd count idle interval 23 | ) 24 | -------------------------------------------------------------------------------- /lib/sockopt.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | val set_sock_keepalives : 16 | ?count:int -> ?idle:int -> ?interval:int -> Unix.file_descr -> unit 17 | -------------------------------------------------------------------------------- /lib/softaffinity.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2019 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | open Topology 16 | 17 | val plan : NUMA.t -> NUMAResource.t array -> vm:NUMARequest.t -> CPUSet.t option 18 | (** [plan host nodes ~vm] returns the CPU soft affinity recommended for [vm], 19 | Such that the memory latency between the NUMA nodes of the vCPUs is small, 20 | and usage of NUMA nodes is balanced. 21 | 22 | The default in Xen is to stripe memory accross all NUMA nodes, which would 23 | cause increased latency and hitting the bandwidth limits of the CPU 24 | interconnects. The plan returned here attempts to reduce this, but doesn't 25 | look for an optimal plan (which would potentially require solving an NP 26 | complete problem). 27 | 28 | Upon return the amount of memory available in [nodes] is updated, so that 29 | concurrent VM starts will have more accurate information without serializing 30 | domain builds. *) 31 | -------------------------------------------------------------------------------- /lib/storage.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | open Xenops_interface 16 | open Xenops_task 17 | 18 | module D = Debug.Make (struct let name = service_name end) 19 | 20 | open D 21 | open Storage_interface 22 | module Client = Storage_client.Client 23 | 24 | let transform_exception f x = 25 | try f x with 26 | | Storage_error (Backend_error_with_backtrace (code, backtrace :: params)) as 27 | e -> 28 | let backtrace = Backtrace.Interop.of_json "SM" backtrace in 29 | let exn = Xenopsd_error (Storage_backend_error (code, params)) in 30 | Backtrace.add exn backtrace ; 31 | Backtrace.reraise e exn 32 | | Storage_error (Backend_error (code, params)) as e -> 33 | error "Re-raising exception %s: %s" code (String.concat "; " params) ; 34 | Backtrace.reraise e (Xenopsd_error (Storage_backend_error (code, params))) 35 | 36 | (* Used to identify this VBD to the storage layer *) 37 | let id_of frontend vbd = Printf.sprintf "vbd/%s/%s" frontend (snd vbd) 38 | 39 | let epoch_begin task sr vdi domid persistent = 40 | transform_exception 41 | (fun () -> 42 | Client.VDI.epoch_begin (Xenops_task.get_dbg task) sr vdi domid persistent 43 | ) 44 | () 45 | 46 | let epoch_end task sr vdi domid = 47 | transform_exception 48 | (fun () -> Client.VDI.epoch_end (Xenops_task.get_dbg task) sr vdi domid) 49 | () 50 | 51 | let vm_of_domid vmdomid = 52 | match vmdomid with 53 | | Some domid -> 54 | Storage_interface.Vm.of_string (string_of_int domid) 55 | | None -> 56 | (* If vm is going down the domid might have been removed from xenstore, 57 | pass empty string in this case*) 58 | debug 59 | "Invalid domid, could not be converted to int, passing empty string." ; 60 | Storage_interface.Vm.of_string "" 61 | 62 | let attach_and_activate ~task ~_vm ~vmdomid ~dp ~sr ~vdi ~read_write = 63 | let result = 64 | Xenops_task.with_subtask task 65 | (Printf.sprintf "VDI.attach3 %s" dp) 66 | (transform_exception (fun () -> 67 | Client.VDI.attach3 "attach_and_activate_impl" dp sr vdi vmdomid 68 | read_write 69 | ) 70 | ) 71 | in 72 | Xenops_task.with_subtask task 73 | (Printf.sprintf "VDI.activate3 %s" dp) 74 | (transform_exception (fun () -> 75 | Client.VDI.activate3 "attach_and_activate_impl" dp sr vdi vmdomid 76 | ) 77 | ) ; 78 | result 79 | 80 | let deactivate task dp sr vdi vmdomid = 81 | debug "Deactivating disk %s %s" (Sr.string_of sr) (Vdi.string_of vdi) ; 82 | Xenops_task.with_subtask task 83 | (Printf.sprintf "VDI.deactivate %s" dp) 84 | (transform_exception (fun () -> 85 | Client.VDI.deactivate "deactivate" dp sr vdi vmdomid 86 | ) 87 | ) 88 | 89 | let dp_destroy task dp = 90 | Xenops_task.with_subtask task 91 | (Printf.sprintf "DP.destroy %s" dp) 92 | (transform_exception (fun () -> 93 | let waiting_for_plugin = ref true in 94 | while !waiting_for_plugin do 95 | try 96 | Client.DP.destroy "dp_destroy" dp false ; 97 | waiting_for_plugin := false 98 | with 99 | | Storage_interface.Storage_error (No_storage_plugin_for_sr _sr) as e 100 | -> 101 | (* Since we have an activated disk in this SR, assume we are 102 | still waiting for xapi to register the SR's plugin. *) 103 | debug "Caught %s - waiting for xapi to register storage plugins." 104 | (Printexc.to_string e) ; 105 | Thread.delay 5.0 106 | | e -> 107 | (* Backends aren't supposed to return exceptions on 108 | deactivate/detach, but they frequently do. Log and ignore *) 109 | warn "DP destroy returned unexpected exception: %s" 110 | (Printexc.to_string e) ; 111 | waiting_for_plugin := false 112 | done 113 | ) 114 | ) 115 | 116 | let get_disk_by_name _task path = 117 | match Astring.String.cut ~sep:"/" path with 118 | | Some (sr, vdi) -> 119 | info "Processing disk SR=%s VDI=%s" sr vdi ; 120 | (Sr.of_string sr, Vdi.of_string vdi) 121 | | None -> 122 | error "Failed to parse VDI name %s (expected SR/VDI)" path ; 123 | raise (Storage_interface.Storage_error (Vdi_does_not_exist path)) 124 | -------------------------------------------------------------------------------- /lib/suspend_image.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2014 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | module M : sig 15 | type ('a, 'b) t = ('a, 'b) Result.t 16 | 17 | val ( >>= ) : ('a, 'b) t -> ('a -> ('c, 'b) t) -> ('c, 'b) t 18 | 19 | val return : 'a -> ('a, 'b) t 20 | 21 | val fold : ('a -> 'b -> ('b, 'c) t) -> 'a list -> 'b -> ('b, 'c) t 22 | end 23 | 24 | module Xenops_record : sig 25 | type t 26 | 27 | val make : ?vm_str:string -> ?xs_subtree:(string * string) list -> unit -> t 28 | 29 | val to_string : t -> (string, exn) Result.t 30 | 31 | val of_string : string -> (t, exn) Result.t 32 | end 33 | 34 | type header_type = 35 | | Xenops 36 | | Libxc 37 | | Libxl 38 | | Libxc_legacy 39 | | Qemu_trad 40 | | Qemu_xen 41 | | Demu 42 | | Varstored 43 | | End_of_image 44 | 45 | type format = Structured | Legacy 46 | 47 | type header = header_type * int64 48 | 49 | val string_of_header : header -> string 50 | 51 | val save_signature : string 52 | 53 | val read_save_signature : Unix.file_descr -> (format, string) Result.t 54 | 55 | val read_legacy_qemu_header : Unix.file_descr -> (int64, string) Result.t 56 | 57 | val write_qemu_header_for_legacy_libxc : 58 | Unix.file_descr -> int64 -> (unit, exn) Result.t 59 | 60 | val write_header : Unix.file_descr -> header -> (unit, exn) Result.t 61 | 62 | val read_header : Unix.file_descr -> (header, exn) Result.t 63 | 64 | val with_conversion_script : 65 | Xenops_task.Xenops_task.task_handle 66 | -> string 67 | -> bool 68 | -> Unix.file_descr 69 | -> (Unix.file_descr -> 'a) 70 | -> ('a, exn) Result.t 71 | 72 | val wrap : (unit -> 'a) -> ('a, exn) Result.t 73 | 74 | val wrap_exn : (unit -> ('a, exn) Result.t) -> ('a, exn) Result.t 75 | -------------------------------------------------------------------------------- /lib/xenops_hooks.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2011 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | open Xenops_interface 16 | open Xenops_utils 17 | 18 | module D = Debug.Make (struct let name = "xenops_hooks" end) 19 | 20 | open D 21 | 22 | let hooks_dir = "/etc/xapi.d/" 23 | 24 | (* Names of VM script hooks *) 25 | let scriptname__vm_pre_destroy = "vm-pre-shutdown" 26 | 27 | let scriptname__vm_pre_migrate = "vm-pre-migrate" 28 | 29 | let scriptname__vm_post_migrate = "vm-post-migrate" 30 | 31 | let scriptname__vm_pre_suspend = "vm-pre-suspend" 32 | 33 | let scriptname__vm_pre_start = "vm-pre-start" 34 | 35 | let scriptname__vm_pre_reboot = "vm-pre-reboot" 36 | 37 | let scriptname__vm_pre_resume = "vm-pre-resume" 38 | 39 | let scriptname__vm_post_resume = "vm-post-resume" 40 | 41 | let scriptname__vm_post_destroy = "vm-post-destroy" 42 | 43 | (* VM Script hook reason codes *) 44 | let reason__clean_shutdown = "clean-shutdown" 45 | 46 | let reason__hard_shutdown = "hard-shutdown" 47 | 48 | let reason__clean_reboot = "clean-reboot" 49 | 50 | let reason__hard_reboot = "hard-reboot" 51 | 52 | let reason__suspend = "suspend" 53 | 54 | let reason__migrate_source = "source" 55 | 56 | (* passed to pre-migrate hook on source host *) 57 | 58 | let reason__migrate_dest = "destination" 59 | 60 | (* passed to post-migrate hook on destination host *) 61 | 62 | let reason__none = "none" 63 | 64 | (* Names of arguments *) 65 | let arg__vmdomid = "-vmdomid" 66 | 67 | (* Exit codes: *) 68 | (* success = 0 *) 69 | let exitcode_log_and_continue = 1 70 | 71 | (* all other exit codes cause xapi to abort operation and raise XAPI_HOOK_FAILED 72 | api exception *) 73 | 74 | let list_individual_hooks ~script_name = 75 | let script_dir = hooks_dir ^ script_name ^ "/" in 76 | if 77 | try 78 | Unix.access script_dir [Unix.F_OK] ; 79 | true 80 | with _ -> false 81 | then ( 82 | let scripts = Sys.readdir script_dir in 83 | Array.stable_sort compare scripts ; 84 | scripts 85 | ) else 86 | [||] 87 | 88 | let execute_vm_hook ~script_name ~id ~reason ~extra_args = 89 | let args = ["-vmuuid"; id; "-reason"; reason] @ extra_args in 90 | let scripts = list_individual_hooks ~script_name in 91 | let script_dir = hooks_dir ^ script_name ^ "/" in 92 | Array.iter 93 | (fun script -> 94 | try 95 | debug "Executing hook '%s/%s' with args [ %s ]" script_name script 96 | (String.concat "; " args) ; 97 | ignore 98 | (Forkhelpers.execute_command_get_output (script_dir ^ script) args) 99 | with 100 | | Forkhelpers.Spawn_internal_error (_, stdout, Unix.WEXITED i) 101 | (* i<>0 since that case does not generate exn *) 102 | -> 103 | if i = exitcode_log_and_continue then 104 | debug "Hook '%s/%s' with args [ %s ] logged '%s'" script_name script 105 | (String.concat "; " args) (String.escaped stdout) 106 | else 107 | raise 108 | (Xenopsd_error 109 | (Errors.Hook_failed 110 | (script_name ^ "/" ^ script, reason, stdout, string_of_int i) 111 | ) 112 | ) 113 | ) 114 | scripts 115 | 116 | type script = 117 | | VM_pre_destroy 118 | | VM_pre_migrate 119 | | VM_post_migrate 120 | | VM_pre_suspend 121 | | VM_pre_start 122 | | VM_pre_reboot 123 | | VM_pre_resume 124 | | VM_post_resume 125 | | VM_post_destroy 126 | [@@deriving rpcty] 127 | 128 | let vm ~script ~reason ~id = 129 | let script_name = 130 | match script with 131 | | VM_pre_destroy -> 132 | scriptname__vm_pre_destroy 133 | | VM_pre_migrate -> 134 | scriptname__vm_pre_migrate 135 | | VM_post_migrate -> 136 | scriptname__vm_post_migrate 137 | | VM_pre_suspend -> 138 | scriptname__vm_pre_suspend 139 | | VM_pre_start -> 140 | scriptname__vm_pre_start 141 | | VM_pre_reboot -> 142 | scriptname__vm_pre_reboot 143 | | VM_pre_resume -> 144 | scriptname__vm_pre_resume 145 | | VM_post_resume -> 146 | scriptname__vm_post_resume 147 | | VM_post_destroy -> 148 | scriptname__vm_post_destroy 149 | in 150 | execute_vm_hook ~script_name ~reason ~id 151 | -------------------------------------------------------------------------------- /lib/xenops_migrate.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | module D = Debug.Make (struct let name = "xenops_migrate" end) 16 | 17 | open D 18 | 19 | exception Remote_failed of string 20 | 21 | (** Functions to synchronise between the sender and receiver via binary messages 22 | of the form: 23 | 24 | 00 00 -- success 25 | 26 | 11 22 <0x1122 bytes of data> -- failure, with error message. 27 | 28 | Used rather than the API for signalling between sender and receiver to avoid 29 | having to go through the master and interact with locking. *) 30 | module Handshake = struct 31 | type result = Success | Error of string 32 | 33 | let string_of_result = function 34 | | Success -> 35 | "Success" 36 | | Error x -> 37 | "Error: " ^ x 38 | 39 | let rec really_read fd buf ofs len = 40 | let n = Unix.read fd buf ofs len in 41 | if n = 0 then raise End_of_file ; 42 | if n < len then really_read fd buf (ofs + n) (len - n) 43 | 44 | (** Receive a 'result' from the remote *) 45 | let recv ?(verbose = false) (s : Unix.file_descr) : result = 46 | let buf = Bytes.make 2 '\000' in 47 | if verbose then 48 | debug "Handshake.recv: about to read result code from remote." ; 49 | ( try really_read s buf 0 (Bytes.length buf) 50 | with _ -> raise (Remote_failed "unmarshalling result code from remote") 51 | ) ; 52 | if verbose then 53 | debug "Handshake.recv: finished reading result code from remote." ; 54 | let len = 55 | (int_of_char (Bytes.get buf 0) lsl 8) lor (int_of_char @@ Bytes.get buf 1) 56 | in 57 | if len = 0 then 58 | Success 59 | else 60 | let msg = Bytes.make len '\000' in 61 | if verbose then 62 | debug "Handshake.recv: about to read error message from remote." ; 63 | ( try really_read s msg 0 len 64 | with _ -> 65 | raise (Remote_failed "unmarshalling error message from remote") 66 | ) ; 67 | if verbose then 68 | debug "Handshake.recv: finished reading error message from remote." ; 69 | Error (Bytes.unsafe_to_string msg) 70 | 71 | (** Expects to receive a success code from the server, throws an exception 72 | otherwise *) 73 | let recv_success ?verbose (s : Unix.file_descr) : unit = 74 | match recv ?verbose s with 75 | | Success -> 76 | () 77 | | Error x -> 78 | raise (Remote_failed ("error from remote: " ^ x)) 79 | 80 | (** Transmit a 'result' to the remote *) 81 | let send ?(verbose = false) (s : Unix.file_descr) (r : result) = 82 | let len = match r with Success -> 0 | Error msg -> String.length msg in 83 | let buf = Bytes.make (2 + len) '\000' in 84 | Bytes.set buf 0 @@ char_of_int ((len lsr 8) land 0xff) ; 85 | Bytes.set buf 1 @@ char_of_int ((len lsr 0) land 0xff) ; 86 | (match r with Success -> () | Error msg -> String.blit msg 0 buf 2 len) ; 87 | if verbose then debug "Handshake.send: about to write result to remote." ; 88 | if Unix.write s buf 0 (len + 2) <> len + 2 then 89 | raise (Remote_failed "writing result to remote") ; 90 | if verbose then debug "Handshake.send: finished writing result to remote." 91 | end 92 | 93 | module Forwarded_http_request = struct 94 | (** Subset of the structure sent by xapi *) 95 | type t = { 96 | uri: string 97 | ; query: (string * string) list 98 | ; cookie: (string * string) list 99 | ; body: string option 100 | } 101 | [@@deriving rpc] 102 | end 103 | -------------------------------------------------------------------------------- /lib/xenops_sandbox.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | module D = Debug.Make (struct let name = "xenops_sandbox" end) 16 | 17 | module Chroot : sig 18 | (* can access fields, but can only be created through of_domid and create *) 19 | type t = private {root: string; uid: int; gid: int} 20 | 21 | module Path : sig 22 | type t 23 | 24 | val of_string : relative:string -> t 25 | end 26 | 27 | val absolute_path_outside : t -> Path.t -> string 28 | (** [absolute_path_outside chroot path] returns the absolute path outside the 29 | chroot *) 30 | 31 | val chroot_path_inside : Path.t -> string 32 | (** [chroot_path_inside path] returns the path when inside the chroot *) 33 | 34 | val of_domid : daemon:string -> domid:int -> vm_uuid:string -> t 35 | (** [of_domid daemon domid] describes a chroot for specified daemon and domain *) 36 | 37 | val create : daemon:string -> domid:int -> vm_uuid:string -> Path.t list -> t 38 | (** [create daemon domid paths] Creates the specified chroot with appropriate 39 | permissions, and ensures that all [paths] are owned by the chrooted daemon 40 | and rw- *) 41 | 42 | val destroy : t -> unit 43 | (** [destroy chroot] Deletes the chroot *) 44 | end = struct 45 | type t = {root: string; uid: int; gid: int} 46 | 47 | module Path = struct 48 | type t = string 49 | 50 | let of_string ~relative = 51 | if not (Filename.is_implicit relative) then 52 | invalid_arg 53 | (Printf.sprintf "Expected implicit filename, but got '%s' (at %s)" 54 | relative __LOC__ 55 | ) ; 56 | relative 57 | end 58 | 59 | let absolute_path_outside chroot path = Filename.concat chroot.root path 60 | 61 | let chroot_path_inside path = Filename.concat "/" path 62 | 63 | let qemu_base_uid () = (Unix.getpwnam "qemu_base").Unix.pw_uid 64 | 65 | let qemu_base_gid () = (Unix.getpwnam "qemu_base").Unix.pw_gid 66 | 67 | let of_domid ~daemon ~domid ~vm_uuid = 68 | let root = 69 | if domid = 0 then 70 | Printf.sprintf "/var/run/xen/%s-root-%d-%s" daemon domid vm_uuid 71 | else 72 | Printf.sprintf "/var/run/xen/%s-root-%d" daemon domid 73 | in 74 | (* per VM uid/gid as for QEMU *) 75 | let uid = qemu_base_uid () + domid in 76 | let gid = qemu_base_gid () + domid in 77 | {root; uid; gid} 78 | 79 | let create ~daemon ~domid ~vm_uuid paths = 80 | let chroot = of_domid ~daemon ~domid ~vm_uuid in 81 | try 82 | Xenops_utils.Unixext.mkdir_rec chroot.root 0o755 ; 83 | (* we want parent dir to be 0o755 and this dir 0o750 *) 84 | Unix.chmod chroot.root 0o750 ; 85 | (* the chrooted daemon will have r-x permissions *) 86 | Unix.chown chroot.root 0 chroot.gid ; 87 | D.debug "Created chroot %s" chroot.root ; 88 | let prepare path = 89 | let fullpath = absolute_path_outside chroot path in 90 | Xenops_utils.Unixext.with_file fullpath [Unix.O_CREAT; Unix.O_EXCL] 91 | 0o600 (fun fd -> Unix.fchown fd chroot.uid chroot.gid 92 | ) 93 | in 94 | List.iter prepare paths ; chroot 95 | with e -> 96 | Backtrace.is_important e ; 97 | D.warn "Failed to create chroot at %s for UID %d: %s" chroot.root 98 | chroot.uid (Printexc.to_string e) ; 99 | raise e 100 | 101 | let destroy chroot = 102 | Xenops_utils.best_effort (Printf.sprintf "removing chroot %s" chroot.root) 103 | (fun () -> Xenops_utils.FileFS.rmtree chroot.root 104 | ) 105 | end 106 | 107 | module Varstore_guard = struct 108 | let daemon = "varstored" 109 | 110 | let varstored_chroot ~domid ~vm_uuid = Chroot.of_domid ~daemon ~domid ~vm_uuid 111 | 112 | let socket_path = Chroot.Path.of_string ~relative:"xapi-depriv-socket" 113 | 114 | (** [start dbg ~vm_uuid ~domid ~paths] prepares a chroot for [domid], and asks 115 | varstore-guard to create a socket restricted to [vm_uuid]. Also creates 116 | empty files specified in [paths] owned by [domid] user.*) 117 | let start dbg ~vm_uuid ~domid ~paths = 118 | let chroot = Chroot.create ~daemon ~domid ~vm_uuid paths in 119 | let absolute_socket_path = 120 | Chroot.absolute_path_outside chroot socket_path 121 | in 122 | let vm_uuidm = 123 | match Uuidm.of_string vm_uuid with 124 | | Some uuid -> 125 | uuid 126 | | None -> 127 | failwith (Printf.sprintf "Invalid VM uuid %s" vm_uuid) 128 | in 129 | Varstore_privileged_client.Client.create dbg vm_uuidm chroot.gid 130 | absolute_socket_path ; 131 | (chroot, Chroot.chroot_path_inside socket_path) 132 | 133 | (** [prepare ~domid path] creates an empty [path] file owned by [domid] inside 134 | the chroot for [domid] and returns the absolute path to it outside the 135 | chroot *) 136 | let prepare ~domid ~vm_uuid path = 137 | let chroot = Chroot.create ~daemon ~domid ~vm_uuid [path] in 138 | Chroot.absolute_path_outside chroot path 139 | 140 | let read ~domid path ~vm_uuid = 141 | let chroot = varstored_chroot ~domid ~vm_uuid in 142 | path 143 | |> Chroot.absolute_path_outside chroot 144 | |> Xenops_utils.Unixext.string_of_file 145 | 146 | let stop dbg ~domid ~vm_uuid = 147 | let chroot = varstored_chroot ~domid ~vm_uuid in 148 | if Sys.file_exists chroot.root then ( 149 | let gid = chroot.Chroot.gid in 150 | let absolute_socket_path = 151 | Chroot.absolute_path_outside chroot socket_path 152 | in 153 | Xenops_utils.best_effort "Stop listening on deprivileged socket" 154 | (fun () -> 155 | Varstore_privileged_client.Client.destroy dbg gid absolute_socket_path 156 | ) ; 157 | Chroot.destroy chroot 158 | ) 159 | end 160 | -------------------------------------------------------------------------------- /lib/xenops_server_skeleton.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | open Xenops_interface 16 | open Xenops_utils 17 | 18 | let unimplemented x = raise (Xenopsd_error (Unimplemented x)) 19 | 20 | let init () = () 21 | 22 | module HOST = struct 23 | let stat () = 24 | { 25 | Host.cpu_info= 26 | { 27 | Host.cpu_count= 0 28 | ; socket_count= 0 29 | ; vendor= "unknown" 30 | ; speed= "" 31 | ; modelname= "" 32 | ; family= "" 33 | ; model= "" 34 | ; stepping= "" 35 | ; flags= "" 36 | ; features= [||] 37 | ; features_pv= [||] 38 | ; features_hvm= [||] 39 | ; features_oldstyle= [||] 40 | ; features_pv_host= [||] 41 | ; features_hvm_host= [||] 42 | } 43 | ; hypervisor= {Host.version= ""; capabilities= ""} 44 | ; chipset_info= {iommu= false; hvm= false} 45 | } 46 | 47 | let get_console_data () = "" 48 | 49 | let get_total_memory_mib () = 0L 50 | 51 | let send_debug_keys _ = () 52 | 53 | let update_guest_agent_features _ = () 54 | 55 | let upgrade_cpu_features _ _ = [||] 56 | end 57 | 58 | module VM = struct 59 | let add _ = () 60 | 61 | let rename _ _ _ = () 62 | 63 | let remove _ = () 64 | 65 | let create _ _ _ _ = unimplemented "VM.create" 66 | 67 | let build ?restore_fd:_ _ _ _ _ _ = unimplemented "VM.build" 68 | 69 | let create_device_model _ _ _ _ _ = unimplemented "VM.create_device_model" 70 | 71 | let destroy_device_model _ _ = unimplemented "VM.destroy_device_model" 72 | 73 | let destroy _ _ = unimplemented "VM.destroy" 74 | 75 | let pause _ _ = unimplemented "VM.pause" 76 | 77 | let unpause _ _ = unimplemented "VM.unpause" 78 | 79 | let set_xsdata _ _ _ = unimplemented "VM.set_xsdata" 80 | 81 | let set_vcpus _ _ _ = unimplemented "VM.set_vcpus" 82 | 83 | let set_shadow_multiplier _ _ _ = unimplemented "VM.set_shadow_multipler" 84 | 85 | let set_memory_dynamic_range _ _ _ _ = 86 | unimplemented "VM.set_memory_dynamic_range" 87 | 88 | let request_shutdown _ _ _ _ = unimplemented "VM.request_shutdown" 89 | 90 | let wait_shutdown _ _ _ _ = unimplemented "VM.wait_shutdown" 91 | 92 | let assert_can_save _ = unimplemented "VM.assert_can_save" 93 | 94 | let save _ _ _ _ _ _ _ = unimplemented "VM.save" 95 | 96 | let restore _ _ _ _ _ _ _ = unimplemented "VM.restore" 97 | 98 | let s3suspend _ _ = unimplemented "VM.s3suspend" 99 | 100 | let s3resume _ _ = unimplemented "VM.s3resume" 101 | 102 | let soft_reset _ _ = unimplemented "VM.soft_reset" 103 | 104 | let get_state _ = Xenops_utils.halted_vm 105 | 106 | let request_rdp _ _ = unimplemented "VM.request_rdp" 107 | 108 | let run_script _ _ _ = unimplemented "VM.run_script" 109 | 110 | let set_domain_action_request _ _ = () 111 | 112 | let get_domain_action_request _ = None 113 | 114 | let get_hook_args _ = [] 115 | 116 | let generate_state_string _ = "" 117 | 118 | let get_internal_state _ _ _ = "" 119 | 120 | let set_internal_state _ _ = () 121 | 122 | let wait_ballooning _ _ = () 123 | 124 | let minimum_reboot_delay = 0. 125 | end 126 | 127 | module PCI = struct 128 | let get_state _ _ = unplugged_pci 129 | 130 | let dequarantine _ = () 131 | 132 | let plug _ _ _ = unimplemented "PCI.plug" 133 | 134 | let unplug _ _ _ = unimplemented "PCI.unplug" 135 | 136 | let get_device_action_request _ _ = None 137 | end 138 | 139 | module VBD = struct 140 | let set_active _ _ _ _ = () 141 | 142 | let epoch_begin _ _ _ _ = () 143 | 144 | let epoch_end _ _ _ = () 145 | 146 | let plug _ _ _ = unimplemented "VBD.plug" 147 | 148 | let unplug _ _ _ _ = unimplemented "VBD.unplug" 149 | 150 | let insert _ _ _ _ = unimplemented "VBD.insert" 151 | 152 | let eject _ _ _ = unimplemented "VBD.eject" 153 | 154 | let set_qos _ _ _ = () 155 | 156 | let get_state _ _ = unplugged_vbd 157 | 158 | let get_device_action_request _ _ = None 159 | end 160 | 161 | module VIF = struct 162 | let set_active _ _ _ _ = () 163 | 164 | let plug _ _ _ = unimplemented "VIF.plug" 165 | 166 | let unplug _ _ _ _ = unimplemented "VIF.unplug" 167 | 168 | let move _ _ _ _ = unimplemented "VIF.move" 169 | 170 | let set_carrier _ _ _ _ = unimplemented "VIF.set_carrier" 171 | 172 | let set_locking_mode _ _ _ _ = unimplemented "VIF.set_locking_mode" 173 | 174 | let set_ipv4_configuration _ _ _ _ = 175 | unimplemented "VIF.set_ipv4_configuration" 176 | 177 | let set_ipv6_configuration _ _ _ _ = 178 | unimplemented "VIF.set_ipv6_configuration" 179 | 180 | let set_pvs_proxy _ _ _ _ = unimplemented "VIF.set_pvs_proxy" 181 | 182 | let get_state _ _ = unplugged_vif 183 | 184 | let get_device_action_request _ _ = None 185 | end 186 | 187 | module VGPU = struct 188 | let start _ _ _ _ = unimplemented "VGPU.start" 189 | 190 | let set_active _ _ _ _ = () 191 | 192 | let get_state _ _ = unplugged_vgpu 193 | end 194 | 195 | module VUSB = struct 196 | let plug _ _ _ = unimplemented "VUSB.plug" 197 | 198 | let unplug _ _ _ = unimplemented "VUSB.unplug" 199 | 200 | let get_state _ _ = unplugged_vusb 201 | 202 | let get_device_action_request _ _ = None 203 | end 204 | 205 | module UPDATES = struct 206 | let get _ _ = 207 | while true do 208 | Thread.delay 5. 209 | done ; 210 | assert false 211 | end 212 | 213 | module DEBUG = struct let trigger _ _ = unimplemented "DEBUG.trigger" end 214 | -------------------------------------------------------------------------------- /lib/xenops_task.ml: -------------------------------------------------------------------------------- 1 | open Xenops_utils 2 | 3 | module XI = struct 4 | include Xenops_interface 5 | 6 | let cancelled s = Xenopsd_error (Errors.Cancelled s) 7 | 8 | let does_not_exist (x, y) = Xenopsd_error (Errors.Does_not_exist (x, y)) 9 | 10 | let marshal_exn e = 11 | match e with 12 | | Xenopsd_error e' -> 13 | Rpcmarshal.marshal Errors.error.Rpc.Types.ty e' 14 | | _ -> 15 | Rpcmarshal.marshal Errors.error.Rpc.Types.ty 16 | (Errors.Internal_error (Printexc.to_string e)) 17 | end 18 | 19 | module Xenops_task = Task_server.Task (XI) 20 | module Updates = Updates.Updates (XI) 21 | 22 | let scheduler = Scheduler.make () 23 | 24 | let updates = Updates.empty scheduler 25 | 26 | let tasks = Xenops_task.empty () 27 | 28 | let event_wait local_updates task ?from ?timeout_start timeout p = 29 | let start = 30 | match timeout_start with Some s -> s | None -> Unix.gettimeofday () 31 | in 32 | let rec inner remaining event_id = 33 | if remaining > 0.0 then 34 | let _, deltas, next_id = 35 | Updates.get 36 | (Printf.sprintf "event_wait task %s" (Xenops_task.id_of_handle task)) 37 | ~with_cancel:(Xenops_task.with_cancel task) 38 | event_id 39 | (Some (remaining |> ceil |> int_of_float)) 40 | local_updates 41 | in 42 | let success = List.fold_left (fun acc d -> acc || p d) false deltas in 43 | let finished = success in 44 | if not finished then 45 | let elapsed = Unix.gettimeofday () -. start in 46 | inner (timeout -. elapsed) (Some next_id) 47 | else 48 | success 49 | else 50 | false 51 | in 52 | let result = inner timeout from in 53 | Xenops_task.check_cancelling task ; 54 | result 55 | 56 | let task_ended id = 57 | let handle = Xenops_task.handle_of_id tasks id in 58 | match Xenops_task.get_state handle with 59 | | Completed _ | Failed _ -> 60 | true 61 | | Pending _ -> 62 | false 63 | 64 | let task_finished_p task = 65 | let open Xenops_interface in 66 | function Dynamic.Task id -> id = task && task_ended id | _ -> false 67 | -------------------------------------------------------------------------------- /list_domains/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name list_domains) 3 | (public_name list_domains) 4 | (package xapi-xenopsd-xc) 5 | (libraries xenctrl xapi-idl.memory ezxenstore.watch uuidm) 6 | ) 7 | -------------------------------------------------------------------------------- /list_domains/table.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | (** Some string handling functions to help drawing text tables. Modified from 15 | Richard's code in the CLI *) 16 | 17 | let pad n s before = 18 | if String.length s > n then 19 | if String.length s > 2 then 20 | String.sub s 0 (n - 2) ^ ".." 21 | else 22 | String.sub s 0 n 23 | else 24 | let padding = String.make (n - String.length s) ' ' in 25 | if before then padding ^ s else s ^ padding 26 | 27 | let left n s = pad n s false 28 | 29 | let right n s = pad n s true 30 | 31 | let compute_col_widths rows = 32 | let mkints n = 33 | let rec f x = if x = n then [] else x :: f (x + 1) in 34 | f 0 35 | in 36 | let numcols = List.length (List.hd rows) in 37 | let column x = List.map (fun row -> List.nth row x) rows in 38 | let cols = List.map column (mkints numcols) in 39 | let max n str = max n (String.length str) in 40 | List.map (List.fold_left max 0) cols 41 | 42 | let print (rows : string list list) = 43 | match rows with 44 | | [] -> 45 | () 46 | | _ -> 47 | let widths = compute_col_widths rows in 48 | let sll = List.map (List.map2 right widths) rows in 49 | List.iter (fun line -> print_endline (String.concat " | " line)) sll 50 | -------------------------------------------------------------------------------- /profiling/coverage.ml: -------------------------------------------------------------------------------- 1 | (** This module sets up the env variable for bisect_ppx which describes where 2 | log files are written. *) 3 | 4 | (** [init name] sets up coverage profiling for binary [name]. You could use 5 | [Sys.argv.(0)] for [name]. *) 6 | 7 | let init name = 8 | let ( // ) = Filename.concat in 9 | let tmpdir = Filename.get_temp_dir_name () in 10 | try ignore (Sys.getenv "BISECT_FILE") 11 | with Not_found -> 12 | Unix.putenv "BISECT_FILE" (tmpdir // Printf.sprintf "bisect-%s-" name) 13 | -------------------------------------------------------------------------------- /profiling/coverage.mli: -------------------------------------------------------------------------------- 1 | (** [init name] sets up coverage profiling for binary [name]. You could use 2 | [Sys.argv.(0)] for [name]. *) 3 | 4 | val init : string -> unit 5 | -------------------------------------------------------------------------------- /profiling/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name profiling) 3 | (wrapped false) 4 | (modules Coverage) 5 | (libraries unix) 6 | ) 7 | -------------------------------------------------------------------------------- /scripts/block: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | TYPE=`echo ${XENBUS_PATH} | cut -f 2 -d '/'` 4 | DOMID=`echo ${XENBUS_PATH} | cut -f 3 -d '/'` 5 | DEVID=`echo ${XENBUS_PATH} | cut -f 4 -d '/'` 6 | 7 | VM=$(xenstore-read "/local/domain/${DOMID}/vm" 2> /dev/null) 8 | DOMUUID=$(xenstore-read "${VM}/uuid" 2> /dev/null) 9 | PRIVATE=/xapi/${DOMUUID}/private/${TYPE}/${DEVID} 10 | HOTPLUG=/xapi/${DOMUUID}/hotplug/${DOMID}/${TYPE}/${DEVID} 11 | HOTPLUG_STATUS="${XENBUS_PREFIX}${XENBUS_PATH}/hotplug-status" 12 | 13 | syslog () 14 | { 15 | logger -tscripts-block "$*" 16 | } 17 | 18 | case "$1" in 19 | add) 20 | if [ "$XENBUS_PREFIX" = "" ]; then 21 | params=$(xenstore-read "${XENBUS_PATH}/params") 22 | params=$(readlink -f $params || echo $params) 23 | frontend="/local/domain/${DOMID}/device/${TYPE}/${DEVID}" 24 | syslog "${XENBUS_PATH}: add params=\"${params}\"" 25 | physical_device=$(/usr/bin/stat --format="%t:%T" "${params}") 26 | syslog "${XENBUS_PATH}: physical-device=${physical_device}" 27 | xenstore-exists "${XENBUS_PATH}/physical-device" 28 | if [ $? -eq 1 ]; then 29 | syslog "${XENBUS_PATH}: writing physical-device=${physical_device}" 30 | xenstore-write "${XENBUS_PATH}/physical-device" "${physical_device}" 31 | fi 32 | fi 33 | xenstore-write "${HOTPLUG}/hotplug" "online" 34 | xenstore-write "${HOTPLUG_STATUS}" "connected" 35 | ;; 36 | change) 37 | syslog "${XENBUS_PATH}: change" 38 | ;; 39 | remove) 40 | syslog "${XENBUS_PATH}: remove" 41 | xenstore-exists "${HOTPLUG_STATUS}" && xenstore-rm "${HOTPLUG_STATUS}" 42 | xenstore-exists "${HOTPLUG}/hotplug" && xenstore-rm "${HOTPLUG}/hotplug" 43 | # so that exitcode is 0 even if above xenstore-exists has failed 44 | true 45 | ;; 46 | esac 47 | -------------------------------------------------------------------------------- /scripts/make-custom-xenopsd.conf: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Create a custom xenopsd.conf containing paths for the script 4 | # dependencies. This is useful to customise the result of a 'make install' 5 | 6 | install -D ./xenopsd.conf ${DESTDIR}/${ETCDIR}/xenopsd.conf 7 | 8 | # Find xen: 9 | for i in /usr/local/lib/xen /usr/lib/xen /usr/lib/xen-4.5 /usr/lib/xen-4.4 /usr/lib/xen-4.3 /usr/lib/xen-4.2; do 10 | if [ -d $i -a -z "$myxen" ]; then 11 | myxen=$i 12 | fi 13 | done 14 | if [ -z "$myxen" ]; then 15 | echo "WARNING: I couldn't find an installation of xen" 16 | echo "Please check the search-path in the config file" 17 | fi 18 | 19 | 20 | # Find a group 21 | for i in root wheel xapi xendev; do 22 | egrep -i "^$i" /etc/group > /dev/null && group=$i 23 | done 24 | 25 | rm -f ${DESTDIR}/${ETCDIR}/xenopsd.conf 26 | cat >> ${DESTDIR}/${ETCDIR}/xenopsd.conf < hardlimit: 61 | hardlimit = limit 62 | setrlimit(RLIMIT_CORE, (limit, hardlimit)) 63 | return limit 64 | 65 | def main(argv): 66 | qemu_env = os.environ 67 | qemu_dm_list = ['/usr/lib/xen/bin/qemu-dm', 68 | '/usr/lib64/xen/bin/qemu-dm', 69 | '/usr/lib/xen-4.1/bin/qemu-dm', 70 | '/usr/lib/xen-4.2/bin/qemu-dm', 71 | '/usr/lib/xen-4.4/bin/qemu-dm'] 72 | qemu_dm = None 73 | for loc in qemu_dm_list: 74 | if os.path.exists(loc): 75 | qemu_dm = loc 76 | if qemu_dm is None: 77 | raise Exception("Cannot find qemu-dm in %s" % qemu_dm_list) 78 | 79 | domid = int(argv[1]) 80 | qemu_args = ['qemu-dm-%d'%domid] + argv[2:] 81 | 82 | # Workaround http://unix.stackexchange.com/questions/39495/domain-ubuntu-hvm-does-not-exists-xen-ubuntu-hvm-guest-os-installation-pro 83 | if os.path.exists("/usr/share/qemu-linaro/qemu"): 84 | qemu_args = qemu_args + ["-L", "/usr/share/qemu-linaro/qemu"] 85 | 86 | nic = xenstore_read("/local/domain/%d/platform/nic_type" % domid) 87 | if nic: 88 | qemu_args = map(lambda x: x.replace("model=rtl8139", "model=%s" % nic), qemu_args) 89 | 90 | print("qemu-dm-wrapper in python:") 91 | print("Using domid: %d" % domid) 92 | print("Starting: %s" % qemu_dm) 93 | print("Arguments: %s" % " ".join(qemu_args)) 94 | print("everything else is from qemu-dm:") 95 | 96 | core_dump_limit = enable_core_dumps() 97 | print("core dump limit: %d" % core_dump_limit) 98 | 99 | pid = os.getpid() 100 | xenstore_write("/local/domain/%d/qemu-pid" % domid, "%d" % pid) 101 | 102 | if cgroup_slice is not None: 103 | # Move to nominated cgroup slice 104 | print("Moving to cgroup slice '%s'" % cgroup_slice) 105 | try: 106 | # Note the default slice uses /sys/fs/cgroup/cpu/tasks but 107 | # other.slice uses /sys/fs/cgroup/cpu/other.slice/tasks. 108 | f = open("/sys/fs/cgroup/cpu/%s/tasks" % cgroup_slice, 'w') 109 | f.write(str(pid)) 110 | f.close() 111 | except IOError as e: 112 | print("Warning: writing pid to '%s' tasks file: %s" \ 113 | % (cgroup_slice, e)) 114 | 115 | os.dup2(1, 2) 116 | sys.stdout.flush() 117 | os.execve(qemu_dm, qemu_args, qemu_env) 118 | 119 | if __name__ == '__main__': 120 | raise SystemExit(main(sys.argv)) 121 | -------------------------------------------------------------------------------- /scripts/qemu-vif-script: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | 3 | from __future__ import print_function 4 | from common import * 5 | 6 | if __name__ == "__main__": 7 | if len(sys.argv) != 2: 8 | print("Usage:", file=sys.stderr) 9 | print(" %s " % sys.argv[0], file=sys.stderr) 10 | sys.exit(1) 11 | name = sys.argv[1] 12 | send_to_syslog("setting up interface %s" % name) 13 | i = Interface(name) 14 | i.online() 15 | -------------------------------------------------------------------------------- /scripts/tap: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | TYPE=`echo ${XENBUS_PATH} | cut -f 2 -d '/'` 4 | DOMID=`echo ${XENBUS_PATH} | cut -f 3 -d '/'` 5 | DEVID=`echo ${XENBUS_PATH} | cut -f 4 -d '/'` 6 | 7 | XAPI=/xapi/${DOMID}/hotplug/${TYPE}/${DEVID} 8 | 9 | syslog () 10 | { 11 | BLKTAP=daemon 12 | logger -p$BLKTAP.info -tscripts-tap "$*" 13 | } 14 | 15 | case "$1" in 16 | add) 17 | syslog "$XAPI: hotplug deferred to backend change" 18 | ;; 19 | change) 20 | syslog "$XAPI: backend changed" 21 | xenstore-write "${XAPI}/hotplug" "online" 22 | ;; 23 | remove) 24 | syslog "$XAPI: backend removed" 25 | xenstore-rm "${XAPI}/hotplug" 26 | ;; 27 | esac 28 | -------------------------------------------------------------------------------- /scripts/test_igmp_query_injector.py: -------------------------------------------------------------------------------- 1 | import unittest 2 | from contextlib import contextmanager 3 | import time 4 | import sys 5 | from mock import patch, MagicMock 6 | 7 | # mock modules since this repo does not contain them 8 | sys.modules['xcp'] = MagicMock() 9 | sys.modules['xen'] = MagicMock() 10 | sys.modules['xen.lowlevel'] = MagicMock() 11 | sys.modules['xen.lowlevel.xs'] = MagicMock() 12 | sys.modules['scapy'] = MagicMock() 13 | sys.modules['scapy.all'] = MagicMock() 14 | sys.modules['scapy.contrib'] = MagicMock() 15 | sys.modules['scapy.contrib.igmp'] = MagicMock() 16 | 17 | 18 | sys.path.append('./scripts') 19 | 20 | from igmp_query_injector import XSWatcher, IGMPQueryInjector, get_vif_state_path 21 | 22 | 23 | class TestXSWatcher(unittest.TestCase): 24 | def test_watch(self): 25 | watcher = XSWatcher() 26 | path = '/a/b/c' 27 | watcher.watch(path, '000') 28 | self.assertIn(path, watcher.watches) 29 | 30 | def test_unwatch(self): 31 | watcher = XSWatcher() 32 | path = '/a/b/c' 33 | token = '000' 34 | watcher.watch(path, token) 35 | self.assertIn(path, watcher.watches) 36 | 37 | watcher.unwatch(path, token) 38 | self.assertNotIn(path, watcher.watches) 39 | 40 | 41 | class TestIGMPQueryInjector(unittest.TestCase): 42 | @contextmanager 43 | def assert_time_elapse_in(self, min, max): 44 | start = time.time() 45 | yield 46 | elapse = time.time() - start 47 | self.assertTrue(min <= elapse <= max, 'elapse time %f should in [%f, %f]' % (elapse, min, max)) 48 | 49 | @patch('igmp_query_injector.IGMPQueryInjector.inject_to_vif') 50 | @patch('igmp_query_injector.IGMPQueryInjector._inject_with_connection_state_check') 51 | def test_inject_without_connection_state_check(self, mock_inject_with_connection_state_check, 52 | mock_inject_to_vif): 53 | injector = IGMPQueryInjector(100, ['vif1.1', 'vif2.1'], 0) 54 | injector.inject() 55 | mock_inject_with_connection_state_check.assert_not_called() 56 | self.assertEqual(mock_inject_to_vif.call_count, 2) 57 | 58 | @patch('igmp_query_injector.IGMPQueryInjector.inject_to_vif') 59 | @patch('igmp_query_injector.XSWatcher.read_watch') 60 | def test_inject_with_connection_state_check_timeout(self, mock_read_watch, mock_inject_to_vif): 61 | mock_read_watch.return_value = ('path', 'vif1.1') 62 | injector = IGMPQueryInjector(100, ['vif1.1', 'vif2.1'], 3) 63 | # should timeout in 3 seconds 64 | with self.assert_time_elapse_in(2, 4): 65 | injector.inject() 66 | # won't inject query to any vif 67 | mock_inject_to_vif.assert_not_called() 68 | 69 | @patch('igmp_query_injector.IGMPQueryInjector.inject_to_vif') 70 | @patch('igmp_query_injector.XSWatcher.read_watch') 71 | @patch('igmp_query_injector.g_xs_handler') 72 | def test_inject_with_connection_state_check_succ(self, mock_gs_handler, mock_read_watch, mock_inject_to_vif): 73 | mock_gs_handler.read.return_value = '4' 74 | 75 | def get_domain_path(domid): 76 | return '/local/domain/%d' % domid 77 | 78 | mock_gs_handler.get_domain_path = get_domain_path 79 | vifs = [] 80 | side_effect = [] 81 | for vif in ('vif1.2', 'vif2.3'): 82 | state_path, backend_state_path = get_vif_state_path(vif) 83 | side_effect.append((state_path, vif)) 84 | side_effect.append((backend_state_path, vif)) 85 | vifs.append(vif) 86 | mock_read_watch.side_effect = side_effect 87 | injector = IGMPQueryInjector(100, vifs, 3) 88 | with self.assert_time_elapse_in(0, 1): 89 | injector.inject() 90 | self.assertEqual(mock_inject_to_vif.call_count, 2) 91 | 92 | 93 | if __name__ == '__main__': 94 | unittest.main() 95 | -------------------------------------------------------------------------------- /scripts/vif.in: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Environment variables that are passed by udev: 4 | # 5 | # for VIFs: 6 | # 7 | # XENBUS_PATH 8 | # XENBUS_TYPE 9 | # XENBUS_BASE_PATH -- these three come from linux.git/drivers/xen/xenbus/xenbus_probe_backend.c 10 | # 11 | # for TAPs: 12 | # 13 | # INTERFACE -- set by linux.git/net/core/net-sysfs.c 14 | # 15 | # 16 | # we pass these as arguments to the real vif udev script 17 | 18 | REAL_UDEV_SCRIPT=@LIBEXEC@/vif-real 19 | ACTION=$1 20 | 21 | TYPE=`echo $2 | cut -d= -f2` 22 | 23 | case ${TYPE} in 24 | tap) 25 | # This must be a tap device. Extract domid/devid accordingly 26 | DOMID=`echo ${INTERFACE#tap} | cut -f 1 -d '.'` 27 | DEVID=`echo ${INTERFACE#tap} | cut -f 2 -d '.'` 28 | ;; 29 | vif) 30 | # Must be a vif then. 31 | DOMID=`echo ${XENBUS_PATH} | cut -f 3 -d '/'` 32 | DEVID=`echo ${XENBUS_PATH} | cut -f 4 -d '/'` 33 | ;; 34 | *) 35 | echo "Unknown type: ${TYPE}" 36 | exit 1 37 | esac 38 | 39 | $REAL_UDEV_SCRIPT $TYPE $DOMID $DEVID $ACTION 40 | 41 | -------------------------------------------------------------------------------- /scripts/xen-backend.rules.in: -------------------------------------------------------------------------------- 1 | SUBSYSTEM=="xen-backend", KERNEL=="tap*", RUN+="@LIBEXEC@/tap $env{ACTION}" 2 | SUBSYSTEM=="xen-backend", KERNEL=="vbd*|qdisk*", RUN+="@LIBEXEC@/block $env{ACTION}" 3 | 4 | SUBSYSTEM=="xen-backend", KERNEL=="vif*", RUN+="@LIBEXEC@/vif $env{ACTION} type_if=vif" 5 | SUBSYSTEM=="net", KERNEL=="tap*", RUN+="@LIBEXEC@/vif $env{ACTION} type_if=tap" 6 | 7 | KERNEL=="evtchn", NAME="xen/%k" 8 | -------------------------------------------------------------------------------- /simulator/README.md: -------------------------------------------------------------------------------- 1 | Simulation backend 2 | ================== 3 | 4 | This backend allows testing of the higher-level xenops logic. 5 | -------------------------------------------------------------------------------- /simulator/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name xenops_simulator_main) 3 | (public_name xenopsd-simulator) 4 | (package xapi-xenopsd-simulator) 5 | (flags 6 | (:standard -warn-error +a-3) 7 | ) 8 | (libraries 9 | profiling 10 | xapi-idl.xen.interface 11 | xapi-xenopsd 12 | ) 13 | ) 14 | 15 | (rule 16 | (with-stdout-to 17 | xenopsd-simulator.1 18 | (run %{dep:xenops_simulator_main.exe} --help=groff) 19 | ) 20 | ) 21 | 22 | (rule 23 | (targets xenopsd-simulator.1.gz) 24 | (action 25 | (run gzip %{dep:xenopsd-simulator.1})) 26 | ) 27 | 28 | (install 29 | (section man) 30 | (files xenopsd-simulator.1.gz) 31 | (package xapi-xenopsd-simulator) 32 | ) 33 | -------------------------------------------------------------------------------- /simulator/xenops_simulator_main.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | (* Start the program with the simulator backend *) 16 | let _ = 17 | Coverage.init "xenops-simulator" ; 18 | Xenops_interface.queue_name := !Xenops_interface.queue_name ^ ".simulator" ; 19 | Xenops_utils.set_root "xenopsd/simulator" ; 20 | Xenopsd.configure () ; 21 | Xenopsd.main (module Xenops_server_simulator : Xenops_server_plugin.S) 22 | -------------------------------------------------------------------------------- /simulator/xenopsd.conf: -------------------------------------------------------------------------------- 1 | pidfile=xenopsd.pid 2 | daemon=false 3 | simulate=true 4 | persist=false 5 | sockets-path=. 6 | -------------------------------------------------------------------------------- /squeezed/ChangeLog: -------------------------------------------------------------------------------- 1 | 0.12.1 (22-Jul-2016): 2 | * Bugfixes 3 | * Update to stdext-2.0.0 4 | 5 | 0.12.0 (14-Aug-2015): 6 | * Remove dependency on Re_str 7 | * Fix FD leak while reading /sysfs 8 | 9 | 0.11.0 (7-Apr-2015): 10 | * CA-155888: do not clean memory reservation in transfer 11 | * Add lots of documentation 12 | 13 | 0.10.7 (9-Oct-2014): 14 | * Create a fast-path when there is plenty of memory 15 | * Use a more robust method for discovering domain 0 memory 16 | 17 | 0.10.6 (30-May-2014): 18 | * Update to stdext 0.11.0 19 | 20 | 0.10.4 (24-Sep-2013): 21 | * Use new xcp-idl Syslog interface 22 | 23 | 0.10.2 (10-Sep-2013): 24 | * Update to use the xenstore 1.2.3 interface 25 | 26 | 0.10.0 (2-Sep-2013): 27 | * Allow managing of domain 0 (enabled via the config file 28 | option 'manage-domain-zero=true'). This is useful if you 29 | want domain 0 to own all memory by default, and only 30 | give it up for starting VMs -- a common developer configuration. 31 | 32 | 0.9.0 (3-Jun-2013): 33 | * first public release 34 | 35 | -------------------------------------------------------------------------------- /squeezed/doc/Makefile: -------------------------------------------------------------------------------- 1 | default: 2 | pdflatex main.tex 3 | pdflatex main.tex 4 | 5 | -------------------------------------------------------------------------------- /squeezed/doc/README.md: -------------------------------------------------------------------------------- 1 | Squeezed: the developer handbook 2 | =============================== 3 | 4 | Squeezed is the [xapi-project](http://github.com/xapi-project) host 5 | memory manager (aka balloon driver driver). Squeezed uses ballooning 6 | to move memory between running VMs, to avoid wasting host memory. 7 | 8 | Principles 9 | ---------- 10 | 11 | 1. avoid wasting host memory: unused memory should be put to use by returning 12 | it to VMs 13 | 2. memory should be shared in proportion to the configured policy 14 | 3. operate entirely at the level of domains (not VMs), and be independent of 15 | Xen toolstack 16 | 17 | Contents 18 | -------- 19 | - [Architecture](architecture/README.md): a high-level overview of Squeezed. 20 | - [Design](design/README.md): discover the low-level details, formats, protocols, 21 | concurrency etc. 22 | -------------------------------------------------------------------------------- /squeezed/doc/architecture/README.md: -------------------------------------------------------------------------------- 1 | Squeezed architecture 2 | ===================== 3 | 4 | Squeezed is responsible for managing the memory on a single host. Squeezed 5 | "balances" memory between VMs according to a policy written to Xenstore. 6 | 7 | The following diagram shows the internals of Squeezed: 8 | 9 | ![Internals of squeezed](http://xapi-project.github.io/squeezed/doc/architecture/squeezed.png) 10 | 11 | At the center of squeezed is an abstract model of a Xen host. The model includes 12 | - the amount of already-used host memory (used by fixed overheads such as Xen 13 | and the crash kernel) 14 | - per-domain memory policy specifically ```dynamic-min``` and ```dynamic-max``` which 15 | together describe a range, within which the domain's actual used memory should remain 16 | - per-domain calibration data which allows us to compute the necessary balloon target 17 | value to achive a particular memory usage value. 18 | 19 | Squeezed is a single-threaded program which receives commands from 20 | [Xenopsd](https://github.com/xapi-project/xenopsd) over a Unix domain socket. 21 | When Xenopsd wishes to start a new VM, squeezed will be asked to create a "reservation". 22 | Note this is different to the Xen notion of a reservation. A squeezed reservation consists 23 | of an amount of memory squeezed will guarantee to keep free labelled with an id. 24 | When Xenopsd later creates the domain to notionally use the reservation, the reservation 25 | is "transferred" to the domain before the domain is built. 26 | 27 | Squeezed will also wake up every 30s and attempt to rebalance the memory on a host. This 28 | is useful to correct imbalances caused by balloon drivers temporarily failing to reach 29 | their targets. Note that ballooning is fundamentally a co-operative process, so squeezed 30 | must handle cases where the domains refuse to obey commands. 31 | 32 | The "output" of squeezed is a list of "actions" which include: 33 | - set domain x's ```memory/target``` to a new value 34 | - set the ```maxmem``` of a domain to a new value (as a hard limit beyond which the domain 35 | cannot allocate) 36 | 37 | -------------------------------------------------------------------------------- /squeezed/doc/design/figs/fraction.latex: -------------------------------------------------------------------------------- 1 | $$\frac{ 2 | \texttt{memory/target}-\texttt{memory/dynamic-min} 3 | }{ 4 | \texttt{memory/dynamic-max}-\texttt{memory/dynamic-min} 5 | }$$ 6 | -------------------------------------------------------------------------------- /squeezed/doc/design/figs/g.latex: -------------------------------------------------------------------------------- 1 | $$g {\stackrel{def}{=}}\frac{x + \mathit{d1} + \mathit{d2} + \mathit{d3}}{3}$$ 2 | -------------------------------------------------------------------------------- /squeezed/doc/design/figs/hostfreemem.latex: -------------------------------------------------------------------------------- 1 | $$\mathit{host\ free\ memory} >= s + \sum_i{\mathit{reservation}_i}$$ 2 | -------------------------------------------------------------------------------- /squeezed/doc/design/figs/reservation.latex: -------------------------------------------------------------------------------- 1 | $\mathit{reservation}_i$ 2 | -------------------------------------------------------------------------------- /squeezed/doc/design/figs/unused.latex: -------------------------------------------------------------------------------- 1 | $$\mathit{unused}(i) {\stackrel{def}{=}}i.\mathit{reservation} - i.\texttt{totpages}$$ 2 | -------------------------------------------------------------------------------- /squeezed/doc/design/figs/x.latex: -------------------------------------------------------------------------------- 1 | $x$ 2 | -------------------------------------------------------------------------------- /squeezed/doc/design/figs/xtotpages.latex: -------------------------------------------------------------------------------- 1 | $x+\texttt{totpages}+\texttt{memory-offset}$ 2 | -------------------------------------------------------------------------------- /squeezed/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name squeeze) 3 | (flags (:standard :standard -bin-annot)) 4 | (libraries 5 | re 6 | re.str 7 | xapi-idl 8 | threads 9 | ) 10 | (wrapped false) 11 | ) 12 | -------------------------------------------------------------------------------- /squeezed/scripts/init.d-squeezed: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | # 3 | # squeezed Start/Stop the memory ballooning daemon 4 | # 5 | # chkconfig: 2345 22 77 6 | # description: Memory ballooning daemon 7 | # processname: squeezed 8 | # pidfile: /var/run/squeezed.pid 9 | 10 | # Source function library. 11 | . /etc/init.d/functions 12 | 13 | # Memory ballooning daemon 14 | 15 | # location of the executable: 16 | SQUEEZED="@LIBEXECDIR@/squeezed" 17 | 18 | # pidfile: 19 | PID_FILE="/var/run/squeezed.pid" 20 | 21 | # lock file 22 | SUBSYS_FILE="/var/lock/subsys/squeezed" 23 | 24 | # Source function library. 25 | . /etc/init.d/functions 26 | 27 | # Enable core dumping 28 | ulimit -c unlimited 29 | 30 | start() { 31 | echo -n $"Starting the memory ballooning daemon: " 32 | 33 | # XXX: remove when domain 0 advertises ballooning via guest agent 34 | xenstore-write /local/domain/0/control/feature-balloon 1 35 | 36 | if [ -e ${SUBSYS_FILE} ]; then 37 | if [ -e ${PID_FILE} ] && [ -e /proc/`cat ${PID_FILE}` ]; then 38 | echo -n $"cannot start squeezed: already running." 39 | failure $"cannot start squeezed: already running." 40 | echo 41 | return 1 42 | fi 43 | fi 44 | 45 | xenstore-rm /squeezed 46 | ${SQUEEZED} -daemon -pidfile ${PID_FILE} >/dev/null 2>&1 /dev/null) 52 | kill -0 ${PID} 2> /dev/null 53 | if [ $? -eq 0 ]; then 54 | touch ${SUBSYS_FILE} 55 | success 56 | echo 57 | return 0 58 | fi 59 | sleep 1 60 | echo -n . 61 | RETRY=$(( ${RETRY} + 1 )) 62 | done 63 | echo -n $"failed to start squeezed." 64 | failure $"failed to start squeezed." 65 | killproc squeezed 66 | rm -f ${SUBSYS_FILE} ${PID_FILE} 67 | echo 68 | return 1 69 | } 70 | 71 | stop() { 72 | echo -n $"Stopping the memory ballooning daemon: " 73 | 74 | if [ ! -e ${SUBSYS_FILE} ]; then 75 | echo -n $"cannot stop squeezed: squeezed is not running." 76 | failure $"cannot stop squeezed: squeezed is not running." 77 | echo 78 | return 1; 79 | fi 80 | 81 | killproc squeezed 82 | RETVAL=$? 83 | echo 84 | [ $RETVAL -eq 0 ] && rm -f ${SUBSYS_FILE} 85 | return $RETVAL 86 | } 87 | 88 | restart() { 89 | stop 90 | start 91 | } 92 | 93 | case "$1" in 94 | start) 95 | start 96 | ;; 97 | stop) 98 | stop 99 | ;; 100 | restart) 101 | restart 102 | ;; 103 | *) 104 | echo $"Usage: $0 {start|stop|restart}" 105 | exit 1 106 | esac 107 | -------------------------------------------------------------------------------- /squeezed/scripts/squeezed.conf: -------------------------------------------------------------------------------- 1 | # Configuration file for squeezed 2 | 3 | log=syslog:squeezed 4 | pidfile=/var/run/squeezed.pid 5 | 6 | # Omit some sources of log-spam by default 7 | disable-logging-for=http 8 | 9 | # Host memory will be re-examined and possibly re-balanced 10 | # every balance-check-interval 11 | balance-check-interval=10 12 | 13 | # Set to true if you want domain zero to be automatically ballooned 14 | # manage-domain-zero=false 15 | 16 | # If managing domain zero, we won't balloon lower than this value 17 | # domain-zero-dynamic-min = 1073741824 18 | 19 | # If managing domain zero, we won't balloon higher than this value 20 | # 'auto' means use all available memory (where 'available' means 21 | # available to domain 0, possibly constrained by the xen commandline) 22 | # domain-zero-dynamic-max = auto 23 | 24 | -------------------------------------------------------------------------------- /squeezed/src/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (modes byte exe) 3 | (name squeezed) 4 | (public_name squeezed) 5 | (package xapi-squeezed) 6 | (flags (:standard -bin-annot)) 7 | (libraries 8 | xapi-stdext-threads 9 | xapi-stdext-pervasives 10 | xapi-stdext-unix 11 | astring 12 | squeeze 13 | xenctrl 14 | xenstore 15 | xenstore.unix 16 | xenstore_transport 17 | xenstore_transport.unix 18 | rpclib 19 | xapi-idl 20 | xapi-idl.memory 21 | uuidm 22 | re 23 | re.str 24 | ) 25 | ) 26 | -------------------------------------------------------------------------------- /squeezed/src/squeezed.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | open Xcp_service 15 | 16 | module D = Debug.Make (struct let name = Memory_interface.service_name end) 17 | 18 | open D 19 | 20 | let name = "squeezed" 21 | 22 | let major_version = 0 23 | 24 | let minor_version = 10 25 | 26 | let balance_check_interval = ref 10. 27 | 28 | let options = 29 | [ 30 | ( "balance-check-interval" 31 | , Arg.Set_float balance_check_interval 32 | , (fun () -> string_of_float !balance_check_interval) 33 | , "Seconds between memory balancing attempts" 34 | ) 35 | ; ( "manage-domain-zero" 36 | , Arg.Bool (fun b -> Squeeze.manage_domain_zero := b) 37 | , (fun () -> string_of_bool !Squeeze.manage_domain_zero) 38 | , "Manage domain zero" 39 | ) 40 | ; ( "domain-zero-dynamic-min" 41 | , Arg.String (fun x -> Squeeze.domain_zero_dynamic_min := Int64.of_string x) 42 | , (fun () -> Int64.to_string !Squeeze.domain_zero_dynamic_min) 43 | , "Always leave domain 0 with at least this much memory" 44 | ) 45 | ; ( "domain-zero-dynamic-max" 46 | , Arg.String 47 | (fun x -> 48 | Squeeze.domain_zero_dynamic_max := 49 | if x = "auto" then None else Some (Int64.of_string x) 50 | ) 51 | , (fun () -> 52 | match !Squeeze.domain_zero_dynamic_max with 53 | | None -> 54 | "using the static-max value" 55 | | Some x -> 56 | Int64.to_string x 57 | ) 58 | , "Maximum memory to allow domain 0" 59 | ) 60 | ; ( "boot-time-host-free-memory-minimal-constant-count" 61 | , Arg.String 62 | (fun x -> 63 | Squeeze.boot_time_host_free_memory_constant_count_min := 64 | int_of_string x 65 | ) 66 | , (fun () -> 67 | Printf.sprintf "%d" 68 | !Squeeze.boot_time_host_free_memory_constant_count_min 69 | ) 70 | , "Boot time host memory is constant until geting this count of same \ 71 | result of free memory" 72 | ) 73 | ; ( "boot-time-host-free-memory-check-interval " 74 | , Arg.String 75 | (fun x -> 76 | Squeeze.boot_time_host_free_memory_check_interval := float_of_string x 77 | ) 78 | , (fun () -> 79 | Printf.sprintf "%.2f" !Squeeze.boot_time_host_free_memory_check_interval 80 | ) 81 | , "Seconds between boot time host free memory check" 82 | ) 83 | ] 84 | 85 | (* This constructs a server instance using the IDL - we use the GenServerExn 86 | module as we're expecting to raise exceptions from the implementations rather 87 | than return a Result.result. Once all the methods are bound, the function 88 | S.implementation : Rpc.call -> Rpc.response is the dispatcher. *) 89 | module S = Memory_interface.API (Idl.Exn.GenServer ()) 90 | 91 | (* This is where we bind the method declarations to the implementations. Care 92 | has to be taken to bind each and every method declared as there is no 93 | checking done in version of the library we're currently using. *) 94 | let bind () = 95 | let open Memory_server in 96 | S.get_diagnostics get_diagnostics ; 97 | S.login login ; 98 | S.reserve_memory reserve_memory ; 99 | S.reserve_memory_range reserve_memory_range ; 100 | S.delete_reservation delete_reservation ; 101 | S.transfer_reservation_to_domain transfer_reservation_to_domain ; 102 | S.query_reservation_of_domain query_reservation_of_domain ; 103 | S.balance_memory balance_memory ; 104 | S.get_host_reserved_memory get_host_reserved_memory ; 105 | S.get_host_initial_free_memory get_host_initial_free_memory ; 106 | S.get_domain_zero_policy get_domain_zero_policy 107 | 108 | let _ = 109 | Debug.set_facility Syslog.Local5 ; 110 | debug "squeezed version %d.%d starting" major_version minor_version ; 111 | configure ~options () ; 112 | bind () ; 113 | let server = 114 | Xcp_service.make ~path:Memory_interface.xml_path 115 | ~queue_name:Memory_interface.queue_name 116 | ~rpc_fn:(Idl.Exn.server S.implementation) 117 | () 118 | in 119 | maybe_daemonize () ; 120 | (* NB Initialise the xenstore connection after daemonising, otherwise we lose 121 | our connection *) 122 | let _ = Thread.create Memory_server.record_boot_time_host_free_memory () in 123 | let rpc_server = Thread.create Xcp_service.serve_forever server in 124 | Memory_server.start_balance_thread balance_check_interval ; 125 | Squeeze_xen.Domain.start_watch_xenstore_thread () ; 126 | if !Squeeze.manage_domain_zero then Squeeze_xen.configure_domain_zero () ; 127 | Thread.join rpc_server 128 | -------------------------------------------------------------------------------- /squeezed/src/squeezed_state.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | open Squeezed_xenstore 15 | 16 | module D = Debug.Make (struct let name = Memory_interface.service_name end) 17 | 18 | open D 19 | 20 | let _service = "squeezed" 21 | 22 | let initial_host_free_memory_file = 23 | "/var/run/nonpersistent/xapi/boot_time_memory" 24 | 25 | let listdir path = 26 | try 27 | List.filter 28 | (fun x -> x <> "") 29 | (Client.immediate (get_client ()) (fun xs -> Client.directory xs path)) 30 | with Xs_protocol.Enoent _ -> [] 31 | 32 | let xs_read path = 33 | try Client.immediate (get_client ()) (fun xs -> Client.read xs path) 34 | with Xs_protocol.Enoent _ as e -> 35 | debug "xenstsore-read %s returned ENOENT" path ; 36 | raise e 37 | 38 | let xs_read_option path = 39 | try Some (Client.immediate (get_client ()) (fun xs -> Client.read xs path)) 40 | with Xs_protocol.Enoent _ -> None 41 | 42 | let path = String.concat "/" 43 | 44 | (** Path in xenstore where the daemon stores state, specifically reservations *) 45 | let state_path service = path [""; service; "state"] 46 | 47 | (** Path in xenstore where the deamon puts the amount of host memory it needs to 48 | keep eg for lowmem_emergency_pool *) 49 | let reserved_host_memory_path service = 50 | path [""; service; "reserved-host-memory"] 51 | 52 | (** Path where a specific reservation is stored *) 53 | let reservation_path service session_id reservation_id = 54 | path [""; service; "state"; session_id; reservation_id] 55 | 56 | let add_reservation service session_id reservation_id kib = 57 | Client.immediate (get_client ()) (fun xs -> 58 | Client.write xs (reservation_path service session_id reservation_id) kib 59 | ) 60 | 61 | let del_reservation service session_id reservation_id = 62 | Client.immediate (get_client ()) (fun xs -> 63 | Client.rm xs (reservation_path service session_id reservation_id) 64 | ) 65 | 66 | (** Return the total amount of memory reserved *) 67 | let total_reservations service domain_infolist = 68 | let dom_list = List.map (fun di -> di.Xenctrl.domid) domain_infolist in 69 | let session_ids = listdir (path [""; service; "state"]) in 70 | let already_counted sid rid = 71 | match 72 | xs_read_option (path [""; service; "state"; sid; rid; "in-transfer"]) 73 | with 74 | | Some domid when List.mem (int_of_string domid) dom_list -> 75 | true 76 | | _ -> 77 | false 78 | in 79 | let session_total sid = 80 | let rids = listdir (path [""; service; "state"; sid]) in 81 | List.fold_left Int64.add 0L 82 | (List.map 83 | (fun rid -> 84 | if already_counted sid rid then 85 | 0L 86 | else 87 | Int64.of_string (xs_read (path [""; service; "state"; sid; rid])) 88 | ) 89 | rids 90 | ) 91 | in 92 | List.fold_left Int64.add 0L (List.map session_total session_ids) 93 | -------------------------------------------------------------------------------- /squeezed/src/squeezed_xenstore.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | module D = Debug.Make (struct let name = Memory_interface.service_name end) 15 | 16 | open D 17 | module Client = Xs_client_unix.Client (Xs_transport_unix_client) 18 | 19 | let myclient = ref None 20 | 21 | let myclient_m = Mutex.create () 22 | 23 | let open_client () = 24 | try Client.make () 25 | with e -> 26 | error "Failed to connect to xenstore. The raw error was: %s" 27 | (Printexc.to_string e) ; 28 | ( match e with 29 | | Unix.Unix_error (Unix.EACCES, _, _) -> 30 | error "Access to xenstore was denied." ; 31 | let euid = Unix.geteuid () in 32 | if euid <> 0 then ( 33 | error "My effective uid is %d." euid ; 34 | error "Typically xenstore can only be accessed by root (uid 0)." ; 35 | error "Please switch to root (uid 0) and retry." 36 | ) 37 | | Unix.Unix_error (Unix.ECONNREFUSED, _, _) -> 38 | error "Access to xenstore was refused." ; 39 | error "This normally indicates that the service is not running." ; 40 | error "Please start the xenstore service and retry." 41 | | _ -> 42 | () 43 | ) ; 44 | raise e 45 | 46 | let get_client () = 47 | Xapi_stdext_threads.Threadext.Mutex.execute myclient_m (fun () -> 48 | match !myclient with 49 | | None -> ( 50 | let finished = ref false in 51 | while not !finished do 52 | try 53 | let client = open_client () in 54 | myclient := Some client ; 55 | finished := true 56 | with e -> 57 | error 58 | "Caught %s connecting to xenstore; waiting 5s before retrying" 59 | (Printexc.to_string e) ; 60 | Thread.delay 5. 61 | done ; 62 | match !myclient with None -> assert false | Some x -> x 63 | ) 64 | | Some c -> 65 | c 66 | ) 67 | -------------------------------------------------------------------------------- /squeezed/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name squeeze_test_main) 3 | (package xapi-squeezed) 4 | (flags (:standard -bin-annot)) 5 | (libraries 6 | alcotest 7 | xapi-stdext-pervasives 8 | xapi-stdext-unix 9 | xenctrl 10 | unix 11 | squeeze 12 | xapi-idl 13 | ) 14 | ) 15 | -------------------------------------------------------------------------------- /squeezed/test/squeeze_test_main.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | let _ = Squeeze_test.go () 15 | -------------------------------------------------------------------------------- /suspend_image_viewer/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name suspend_image_viewer) 3 | (flags :standard -warn-error +a-3) 4 | (libraries 5 | cmdliner 6 | forkexec 7 | profiling 8 | uuidm 9 | xapi-idl 10 | xapi-stdext-unix 11 | xapi-xenopsd 12 | ) 13 | ) 14 | -------------------------------------------------------------------------------- /suspend_image_viewer/suspend_image_viewer.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2014 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | open Suspend_image 16 | 17 | let opt_debug = ref true 18 | 19 | let msg ~prefix s = Printf.printf "%s: %s\n%!" prefix s 20 | 21 | let debug fmt = 22 | Printf.ksprintf (fun s -> if !opt_debug then msg ~prefix:"debug" s) fmt 23 | 24 | let error fmt = Printf.ksprintf (msg ~prefix:"error") fmt 25 | 26 | let verify_libxc_v2_record fd = 27 | let fd_uuid = Uuidm.(to_string (create `V4)) in 28 | let path = !Resources.verify_libxc_v2 in 29 | let args = ["--in"; fd_uuid; "--syslog"] in 30 | ( try Unix.(access path [X_OK]) 31 | with _ -> failwith (Printf.sprintf "Executable not found: %s" path) 32 | ) ; 33 | let pid = 34 | Forkhelpers.safe_close_and_exec None (Some Unix.stdout) (Some Unix.stderr) 35 | [(fd_uuid, fd)] path args 36 | in 37 | match Forkhelpers.waitpid pid with 38 | | _, Unix.WEXITED 0 -> 39 | () 40 | | _ -> 41 | failwith "Failed to verify Libxc v2 record" 42 | 43 | let parse_layout fd = 44 | debug "Reading save signature..." ; 45 | match read_save_signature fd with 46 | | Error e -> 47 | error "Error reading save signature: %s" e ; 48 | failwith e 49 | | Ok Legacy -> 50 | [] 51 | | Ok Structured -> ( 52 | let open Suspend_image.M in 53 | let rec aux acc = 54 | debug "Reading header..." ; 55 | read_header fd >>= fun h -> 56 | debug "Read header <%s>" (string_of_header h) ; 57 | debug "Dummy-processing record..." ; 58 | match h with 59 | | Xenops, len -> 60 | Io.read fd (Io.int_of_int64_exn len) |> ignore ; 61 | aux (h :: acc) 62 | | Libxc, _ -> 63 | verify_libxc_v2_record fd ; 64 | aux (h :: acc) 65 | | Qemu_trad, len -> 66 | Io.read fd (Io.int_of_int64_exn len) |> ignore ; 67 | aux (h :: acc) 68 | | Varstored, len -> 69 | Io.read fd (Io.int_of_int64_exn len) |> ignore ; 70 | aux (h :: acc) 71 | | End_of_image, _ -> 72 | return (h :: acc) 73 | | Libxl, _ -> 74 | failwith "Unsupported: libxl" 75 | | Libxc_legacy, _ -> 76 | failwith "Unsupported: libxc-legacy" 77 | | Demu, _ -> 78 | failwith "Unsupported: demu" 79 | | Qemu_xen, _ -> 80 | failwith "Unsupported: qemu-xen" 81 | in 82 | match aux [] with 83 | | Ok hs -> 84 | List.rev hs 85 | | Error e -> 86 | failwith 87 | (Printf.sprintf "Error parsing image: %s" (Printexc.to_string e)) 88 | ) 89 | 90 | let print_layout headers = 91 | let module S = String in 92 | let default_width = 10 in 93 | let max_header_word_length = 94 | List.map (fun h -> string_of_header h |> S.length) headers 95 | |> List.fold_left max default_width 96 | in 97 | let left_pad = "| " and right_pad = " |" in 98 | let col_width = 99 | max_header_word_length + S.length left_pad + S.length right_pad 100 | in 101 | Printf.printf "+%s+\n" (S.make (col_width - 2) '-') ; 102 | let rec inner = function 103 | | [] -> 104 | () 105 | | h :: hs -> 106 | let h_str = string_of_header h in 107 | let filled_space = 108 | List.map S.length [left_pad; h_str; right_pad] 109 | |> List.fold_left ( + ) 0 110 | in 111 | let padding = S.make (col_width - filled_space) ' ' in 112 | Printf.printf "%s%s%s%s\n" left_pad h_str padding right_pad ; 113 | Printf.printf "+%s+\n" (S.make (col_width - 2) '-') ; 114 | inner hs 115 | in 116 | inner headers 117 | 118 | module D = Debug.Make (struct let name = "suspend-image-viewer" end) 119 | 120 | let print_image path = 121 | Xapi_stdext_unix.Unixext.with_file path [Unix.O_RDONLY] 0o400 (fun fd -> 122 | print_layout (parse_layout fd) 123 | ) 124 | 125 | (* Command line interface *) 126 | let () = 127 | let resources = 128 | Resources.make_resources ~essentials:Resources.essentials 129 | ~nonessentials:Resources.nonessentials 130 | in 131 | let doc = "Print the layout of a suspend image" in 132 | let path = ref "" in 133 | let options = 134 | [ 135 | ( "path" 136 | , Arg.Set_string path 137 | , (fun () -> !path) 138 | , "Path to the suspend image device" 139 | ) 140 | ] 141 | in 142 | match 143 | Xcp_service.configure2 ~name:"suspend-image-viewer" ~version:Version.version 144 | ~resources ~doc ~options () 145 | with 146 | | `Ok () -> 147 | print_image !path 148 | | `Error m -> 149 | error "%s" m ; exit 1 150 | -------------------------------------------------------------------------------- /suspend_image_viewer/view.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # Usage: copy this script and suspend_image_viewer executable to a box 3 | # Given a snapshot called `snap-mem` view its suspend image VDI: 4 | # /opt/xensource/debug/with-vdi $(xe snapshot-list name-label=uefi-mem params=suspend-VDI-uuid --minimal) ./view.sh 5 | ./suspend_image_viewer --config /etc/xenopsd.conf --path /dev/$DEVICE 6 | -------------------------------------------------------------------------------- /test/check-no-xenctrl.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | XC=libxenctrl 4 | 5 | ldd "$1" | grep -q $XC 2>&1 6 | if [ $? -eq 1 ]; then 7 | echo -e "\n\033[32;1m[OK]\033[0m $1 does not depend on $XC"; 8 | exit 0 9 | else 10 | echo -e "\n\033[31;1m[ERROR]\033[0m $1 depends on $XC"; 11 | exit 1 12 | fi 13 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test) 3 | (package xapi-xenopsd) 4 | (libraries 5 | alcotest 6 | fmt 7 | result 8 | rpclib.core 9 | rpclib.json 10 | xapi-idl 11 | xapi-idl.xen.interface 12 | xapi-idl.xen.interface.types 13 | xapi-stdext-pervasives 14 | xapi-xenopsd 15 | xenstore_transport.unix 16 | ) 17 | (preprocess 18 | (pps ppx_deriving_rpc ppx_sexp_conv) 19 | ) 20 | ) 21 | 22 | (rule 23 | (alias runtest) 24 | (package xapi-xenopsd) 25 | (deps 26 | (:x ../lib/xenopsd.cmxs) 27 | ) 28 | (action (run ./check-no-xenctrl.sh %{x})) 29 | ) 30 | 31 | (rule 32 | (alias runtest) 33 | (package xapi-xenopsd-simulator) 34 | (deps 35 | (:x ../simulator/xenops_simulator_main.exe) 36 | ) 37 | (action (run ./check-no-xenctrl.sh %{x})) 38 | ) 39 | -------------------------------------------------------------------------------- /tools/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name set_domain_uuid) 3 | (public_name set-domain-uuid) 4 | (package xapi-xenopsd-xc) 5 | (flags :standard -warn-error +a-3) 6 | (libraries xenctrl uuidm cmdliner profiling) 7 | ) 8 | -------------------------------------------------------------------------------- /tools/set_domain_uuid.ml: -------------------------------------------------------------------------------- 1 | (* Set the uuid of the specified domain *) 2 | 3 | (* Intended use case is to set dom0's uuid *) 4 | 5 | let is_uuid_valid uuid = 6 | match Uuidm.of_string uuid with None -> false | Some _ -> true 7 | 8 | let set domain uuid = 9 | if not (is_uuid_valid uuid) then 10 | `Error (false, "Invalid uuid") 11 | else 12 | let xc = Xenctrl.interface_open () in 13 | try 14 | Xenctrl.domain_sethandle xc domain uuid ; 15 | `Ok () 16 | with e -> 17 | `Error 18 | ( false 19 | , Printf.sprintf "Caught exception while setting uuid: %s" 20 | (Printexc.to_string e) 21 | ) 22 | 23 | open Cmdliner 24 | 25 | let info = 26 | let doc = "Utility to set a domain's uuid" in 27 | let man = [] in 28 | Term.info "set_domain_uuid" ~version:"1.0" ~doc ~man 29 | 30 | let uuid = 31 | let doc = "Uuid of the domain" in 32 | Arg.(required & pos 0 (some string) None & info [] ~docv:"UUID" ~doc) 33 | 34 | let domid = 35 | let doc = "Id of the domain" in 36 | Arg.(required & pos 1 (some int) None & info [] ~docv:"DOMID" ~doc) 37 | 38 | let cmd = Term.(ret (pure set $ domid $ uuid)) 39 | 40 | let () = match Term.eval (cmd, info) with `Error _ -> exit 1 | _ -> exit 0 41 | -------------------------------------------------------------------------------- /xapi-squeezed.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | author: "dave.scott@eu.citrix.com" 3 | maintainer: "xen-api@lists.xen.org" 4 | homepage: "https://github.com/xapi-project/squeezed" 5 | bug-reports: "https://github.com/xapi-project/squeezed/issues" 6 | dev-repo: "git://github.com/xapi-project/squeezed.git" 7 | build: [ 8 | ["dune" "build" "-p" name "-j" jobs] 9 | ["dune" "runtest" "-p" name] {with-test} 10 | ] 11 | depends: [ 12 | "ocaml" 13 | "dune" {build} 14 | "uuidm" 15 | "xapi-stdext-pervasives" 16 | "xapi-stdext-threads" 17 | "xapi-stdext-unix" 18 | "cohttp" {>= "0.11.0"} 19 | "uri" 20 | "re" 21 | "rpclib" 22 | "xapi-idl" 23 | "xenstore" 24 | "xenstore_transport" 25 | "xenctrl" {>= "0.9.20"} 26 | ] 27 | synopsis: "A memory ballooning daemon for the Xen hypervisor" 28 | description: """ 29 | The squeezed daemon shares host memory among running VMs using the 30 | balloon drivers to move memory.""" 31 | url { 32 | src: 33 | "https://github.com/xapi-project/squeezed/archive/master/master.tar.gz" 34 | } 35 | -------------------------------------------------------------------------------- /xapi-xenopsd-cli.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "xen-api@lists.xen.org" 3 | authors: [ "xen-api@lists.xen.org" ] 4 | homepage: "https://github.com/xapi-project/xenopsd" 5 | bug-reports: "https://github.com/xapi-project/xenopsd/issues" 6 | dev-repo: "git+https://github.com/xapi-project/xenopsd.git" 7 | build: [ 8 | ["dune" "build" "-p" name "-j" jobs] 9 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 10 | ] 11 | depends: [ 12 | "ocaml" 13 | "dune" {build} 14 | "base-threads" 15 | "cmdliner" 16 | "re" 17 | "rpclib" 18 | "rresult" 19 | "uuidm" 20 | "xapi-idl" 21 | "xenstore_transport" {with-test} 22 | ] 23 | synopsis: "A simple command-line tool for interacting with xenopsd" 24 | description: """ 25 | A simple command-line tool for interacting with xenopsd 26 | """ 27 | url { 28 | src: "https://github.com/xapi-project/xenopsd/archive/master.tar.gz" 29 | } 30 | -------------------------------------------------------------------------------- /xapi-xenopsd-simulator.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "xapi-xenopsd-simulator" 3 | maintainer: "xen-api@lists.xen.org" 4 | authors: "xen-api@lists.xen.org" 5 | homepage: "https://github.com/xapi-project/xenopsd" 6 | dev-repo: "git+https://github.com/xapi-project/xenopsd.git" 7 | bug-reports: "https://github.com/xapi-project/xenopsd/issues" 8 | build: [ 9 | ["./configure"] 10 | [ "dune" "build" "-p" name "-j" jobs ] 11 | ] 12 | depends: [ 13 | "ocaml" 14 | "dune" {build} 15 | "base-unix" 16 | "xapi-xenopsd" 17 | ] 18 | synopsis: 19 | "Simulation backend allowing testing of the higher-level xenops logic" 20 | url { 21 | src: "https://github.com/xapi-project/xenopsd/archive/master/master.tar.gz" 22 | } 23 | -------------------------------------------------------------------------------- /xapi-xenopsd-xc.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "xapi-xenopsd-xc" 3 | maintainer: "xen-api@lists.xen.org" 4 | authors: "xen-api@lists.xen.org" 5 | homepage: "https://github.com/xapi-project/xenopsd" 6 | dev-repo: "git+https://github.com/xapi-project/xenopsd.git" 7 | bug-reports: "https://github.com/xapi-project/xenopsd/issues" 8 | build: [ 9 | ["./configure"] 10 | [ "dune" "build" "-p" name "-j" jobs ] 11 | [ "dune" "runtest" "-p" name "-j" jobs] {with-test} 12 | ] 13 | depends: [ 14 | "ocaml" 15 | "dune" {build} 16 | "ounit2" {with-test} 17 | "astring" 18 | "base-threads" 19 | "base-unix" 20 | "ezxenstore" 21 | "fd-send-recv" 22 | "fmt" 23 | "forkexec" 24 | "mtime" 25 | "polly" 26 | "ppx_deriving_rpc" 27 | "ppx_sexp_conv" 28 | "qmp" 29 | "re" 30 | "result" 31 | "rpclib" 32 | "rresult" 33 | "sexplib0" 34 | "uuid" 35 | "uuidm" 36 | "xapi-backtrace" 37 | "xapi-idl" 38 | "xapi-rrd" 39 | "xapi-stdext-date" 40 | "xapi-stdext-pervasives" 41 | "xapi-stdext-std" 42 | "xapi-stdext-threads" 43 | "xapi-stdext-unix" 44 | "xapi-xenopsd" 45 | "xenctrl" 46 | "xenstore" 47 | "xenstore_transport" 48 | ] 49 | synopsis: 50 | "A xenops plugin which knows how to use xenstore, xenctrl and xenguest to manage" 51 | description: "VMs on a xen host." 52 | url { 53 | src: "https://github.com/xapi-project/xenopsd/archive/master/master.tar.gz" 54 | } 55 | -------------------------------------------------------------------------------- /xapi-xenopsd.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "xapi-xenopsd" 3 | maintainer: "xen-api@lists.xen.org" 4 | authors: "xen-api@lists.xen.org" 5 | homepage: "https://github.com/xapi-project/xenopsd" 6 | dev-repo: "git+https://github.com/xapi-project/xenopsd.git" 7 | bug-reports: "https://github.com/xapi-project/xenopsd/issues" 8 | build: [ 9 | ["./configure"] 10 | ["dune" "build" "-p" name "-j" jobs] 11 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 12 | ] 13 | depends: [ 14 | "ocaml" 15 | "dune" {build} 16 | "base-threads" 17 | "alcotest" {with-test} 18 | "astring" 19 | "cohttp" 20 | "fd-send-recv" 21 | "fmt" { >= "0.8.8" } 22 | "forkexec" 23 | "ppx_deriving_rpc" 24 | "ppx_sexp_conv" 25 | "re" 26 | "result" 27 | "rpclib" 28 | "rresult" 29 | "sexplib" 30 | "sexplib0" 31 | "uri" 32 | "uuidm" 33 | "uutf" 34 | "xapi-backtrace" 35 | "xapi-idl" 36 | "xapi-stdext-date" 37 | "xapi-stdext-pervasives" 38 | "xapi-stdext-threads" 39 | "xapi-stdext-unix" 40 | "xenctrl" 41 | "xenstore_transport" {with-test} 42 | "xmlm" 43 | ] 44 | synopsis: "A single-host domain/VM manager for the Xen hypervisor" 45 | description: """ 46 | The xenopsd daemon allows a set of VMs on a single host to be controlled 47 | via a simple API. The API has been tailored to suit the needs of xapi, 48 | which manages clusters of hosts running Xen, but it can also be used 49 | standalone.""" 50 | url { 51 | src: "https://github.com/xapi-project/xenopsd/archive/master/master.tar.gz" 52 | } 53 | -------------------------------------------------------------------------------- /xc/README.md: -------------------------------------------------------------------------------- 1 | Backend using xenctrl/xenguest/xenstore 2 | ======================================= 3 | 4 | A xenops plugin which knows how to use xenstore, xenctrl and 5 | xenguest to manage VMs on a xen host. 6 | -------------------------------------------------------------------------------- /xc/cancel_utils_test.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | open OUnit 15 | open Xenops_interface 16 | open Cancel_utils 17 | open Xenops_task 18 | 19 | exception Did_not_cancel 20 | 21 | let tasks = Xenops_task.empty () 22 | 23 | let xenstore_test xs _ = 24 | let task = Xenops_task.add tasks "test" (fun _ -> None) in 25 | let (_ : Thread.t) = 26 | Thread.create 27 | (fun () -> 28 | Thread.delay 1. ; 29 | Xenops_task.with_cancel task (fun () -> ()) (fun () -> ()) 30 | ) 31 | () 32 | in 33 | try 34 | let (_ : bool) = 35 | cancellable_watch (TestPath "/test/cancel") [] [] task ~xs ~timeout:3. () 36 | in 37 | raise Did_not_cancel 38 | with Xenopsd_error (Cancelled _) -> (* success *) 39 | () 40 | 41 | let _ = 42 | let verbose = ref false in 43 | Arg.parse 44 | [("-verbose", Arg.Unit (fun _ -> verbose := true), "Run in verbose mode")] 45 | (fun x -> Printf.fprintf stderr "Ignoring argument: %s\n" x) 46 | "Test cancellation functions" ; 47 | try 48 | Xenstore.with_xs (fun xs -> 49 | let suite = "cancel test" >::: ["xenstore" >:: xenstore_test xs] in 50 | run_test_tt ~verbose:!verbose suite |> ignore 51 | ) 52 | with Xs_transport.Could_not_find_xenstore -> 53 | (* ignore test, we're not running on domain 0 *) 54 | () 55 | -------------------------------------------------------------------------------- /xc/device_common.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | type kind = Vif | Tap | Pci | Vfs | Vfb | Vkbd | Vbd of string | NetSriovVf 16 | 17 | val vbd_kind_of_string : string -> kind 18 | 19 | val default_vbd_frontend_kind : kind 20 | 21 | type devid = int 22 | 23 | (** Represents one end of a device *) 24 | type endpoint = {domid: int; kind: kind; devid: int} 25 | 26 | (** Represent a device as a pair of endpoints *) 27 | type device = {frontend: endpoint; backend: endpoint} 28 | 29 | val typ_of_device : device Rpc.Types.typ 30 | 31 | val device : device Rpc.Types.def 32 | 33 | exception Device_frontend_already_connected of device 34 | 35 | exception Device_disconnect_timeout of device 36 | 37 | exception Device_error of device * string 38 | 39 | exception Device_unrecognized of string 40 | 41 | exception Hotplug_script_expecting_field of device * string 42 | 43 | (** domid, message *) 44 | exception QMP_Error of int * string 45 | 46 | exception QMP_connection_error of int * string 47 | 48 | val block_device_of_device : device -> string 49 | 50 | val backend_path : xs:Xenstore.Xs.xsh -> endpoint -> Xenctrl.domid -> string 51 | 52 | val backend_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 53 | 54 | val frontend_rw_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 55 | 56 | val frontend_ro_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 57 | 58 | val disconnect_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 59 | 60 | val kthread_pid_paths_of_device : xs:Xenstore.Xs.xsh -> device -> string list 61 | 62 | val error_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 63 | 64 | val backend_error_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 65 | 66 | val backend_shutdown_request_path_of_device : 67 | xs:Xenstore.Xs.xsh -> device -> string 68 | 69 | val backend_shutdown_done_path_of_device : 70 | xs:Xenstore.Xs.xsh -> device -> string 71 | 72 | val backend_pause_request_path_of_device : 73 | xs:Xenstore.Xs.xsh -> device -> string 74 | 75 | val backend_pause_token_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 76 | 77 | val backend_pause_done_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 78 | 79 | val backend_state_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 80 | 81 | val get_private_path : Xenctrl.domid -> string 82 | 83 | val get_private_path_by_uuid : Uuidm.t -> string 84 | 85 | val get_private_data_path_of_device : device -> string 86 | 87 | val extra_xenserver_path_of_device : xs:Xenstore.Xs.xsh -> device -> string 88 | 89 | val string_of_endpoint : endpoint -> string 90 | 91 | val string_of_device : device -> string 92 | 93 | val string_of_kind : kind -> string 94 | 95 | val kind_of_string : string -> kind 96 | 97 | val list_backends : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> device list 98 | (** [list_backends xs domid] returns a list of devices where there is a backend 99 | in [domid]. This function only reads data stored in the backend directory.*) 100 | 101 | val list_frontends : 102 | xs:Xenstore.Xs.xsh -> ?for_devids:int list -> Xenctrl.domid -> device list 103 | (** [list_frontends xs domid] returns a list of devices where there is a 104 | frontend in [domid]. This function only reads data stored in the frontend 105 | directory.*) 106 | 107 | val list_devices_between : 108 | xs:Xenstore.Xs.xsh -> Xenctrl.domid -> Xenctrl.domid -> device list 109 | (** Return a list of devices connecting two domains. Ignore those whose kind we 110 | don't recognise *) 111 | 112 | val device_of_backend : endpoint -> Xenctrl.domid -> device 113 | 114 | val add_backend_keys : 115 | xs:Xenstore.Xs.xsh -> device -> string -> (string * string) list -> unit 116 | 117 | val remove_backend_keys : 118 | xs:Xenstore.Xs.xsh -> device -> string -> string list -> unit 119 | 120 | type protocol = Protocol_Native | Protocol_X86_32 | Protocol_X86_64 121 | 122 | val string_of_protocol : protocol -> string 123 | 124 | val protocol_of_string : string -> protocol 125 | 126 | val qemu_save_path : (int -> 'a, 'b, 'a) format 127 | 128 | val qemu_restore_path : (int -> 'a, 'b, 'a) format 129 | 130 | val demu_save_path : (int -> 'a, 'b, 'a) format 131 | 132 | val demu_restore_path : (int -> 'a, 'b, 'a) format 133 | 134 | val var_run_xen_path : string 135 | 136 | val qmp_libxl_path : int -> string 137 | 138 | val qmp_event_path : int -> string 139 | 140 | val device_model_path : qemu_domid:int -> int -> string 141 | (** Directory in xenstore where qemu writes its state *) 142 | 143 | val xenops_domain_path : string 144 | 145 | val xenops_path_of_domain : Xenctrl.domid -> string 146 | 147 | val xenops_vgpu_path : Xenctrl.domid -> devid -> string 148 | 149 | val is_upstream_qemu : Xenctrl.domid -> bool 150 | 151 | val qmp_send_cmd : 152 | ?send_fd:Unix.file_descr (* send this fd ahead of command *) 153 | -> Xenctrl.domid 154 | -> Qmp.command 155 | -> Qmp.result 156 | (** may raise QMP_Error *) 157 | -------------------------------------------------------------------------------- /xc/domain_sethandle.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | let xc = Xenctrl.interface_open () 15 | 16 | let domid = ref None 17 | 18 | let handle = ref None 19 | 20 | let _ = 21 | Arg.parse 22 | (Arg.align 23 | [ 24 | ( "-domid" 25 | , Arg.Int (fun i -> domid := Some i) 26 | , " the domain id whose handle we will change" 27 | ) 28 | ; ( "-handle" 29 | , Arg.String (fun i -> handle := Some i) 30 | , " the new handle value" 31 | ) 32 | ] 33 | ) 34 | (fun x -> Printf.printf "Warning, ignoring unknown argument: %s" x) 35 | "Set a domain's handle" ; 36 | match (!domid, !handle) with 37 | | Some domid, Some handle -> 38 | Xenctrl.domain_sethandle xc domid handle 39 | | _, _ -> 40 | failwith "Must have -domid and -handle arguments" 41 | -------------------------------------------------------------------------------- /xc/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name xenopsd_xc) 3 | (flags -warn-error +a-3) 4 | (modules :standard \ 5 | xenops_xc_main 6 | memory_breakdown 7 | memory_summary 8 | domain_sethandle 9 | cancel_utils_test) 10 | (libraries 11 | astring 12 | ezxenstore.core 13 | ezxenstore.watch 14 | fd-send-recv 15 | fmt 16 | forkexec 17 | mtime 18 | mtime.clock.os 19 | polly 20 | re 21 | result 22 | rpclib.core 23 | rpclib.json 24 | rresult 25 | sexplib0 26 | qmp 27 | threads.posix 28 | uuidm 29 | xapi-backtrace 30 | xapi-idl 31 | xapi-idl.memory 32 | xapi-idl.network 33 | xapi-idl.rrd 34 | xapi-idl.rrd.interface 35 | xapi-idl.storage 36 | xapi-idl.storage.interface 37 | xapi-idl.xen.interface 38 | xapi-idl.xen.interface.types 39 | xapi-rrd 40 | xapi-stdext-date 41 | xapi-stdext-pervasives 42 | xapi-stdext-std 43 | xapi-stdext-threads 44 | xapi-stdext-unix 45 | xapi-xenopsd 46 | xapi-xenopsd.c_stubs 47 | xapi-xenopsd-xc.c_stubs 48 | xenctrl 49 | xenstore 50 | xenstore_transport.unix 51 | ) 52 | 53 | (preprocess 54 | (pps ppx_deriving_rpc ppx_sexp_conv) 55 | ) 56 | (wrapped false) 57 | ) 58 | (executable 59 | (name xenops_xc_main) 60 | (public_name xenopsd-xc) 61 | (package xapi-xenopsd-xc) 62 | (flags -warn-error +a-3) 63 | (modules xenops_xc_main) 64 | 65 | (libraries 66 | ezxenstore.core 67 | profiling 68 | uuidm 69 | xapi-idl.varstore.privileged 70 | xapi-idl.xen.interface 71 | xapi-inventory 72 | xapi-stdext-unix 73 | xapi-xenopsd 74 | xenctrl 75 | xenstore_transport.unix 76 | xenopsd_xc 77 | ) 78 | ) 79 | 80 | (executable 81 | (name memory_breakdown) 82 | (flags -warn-error +a-3) 83 | (modules memory_breakdown) 84 | (libraries 85 | astring 86 | cmdliner 87 | ezxenstore.core 88 | uuid 89 | xapi-idl.memory 90 | xapi-stdext-date 91 | xapi-stdext-unix 92 | xenctrl 93 | xenopsd_xc 94 | xenstore_transport.unix 95 | ) 96 | ) 97 | 98 | (executable 99 | (name memory_summary) 100 | (flags -warn-error +a-3) 101 | (modules memory_summary) 102 | (libraries 103 | xapi-stdext-date 104 | xapi-stdext-unix 105 | xapi-xenopsd 106 | xenctrl 107 | ) 108 | ) 109 | 110 | (executable 111 | (name domain_sethandle) 112 | (flags -warn-error +a-3) 113 | (modules domain_sethandle) 114 | (libraries 115 | cmdliner 116 | ezxenstore 117 | xenctrl 118 | ) 119 | ) 120 | 121 | (test 122 | (name cancel_utils_test) 123 | (package xapi-xenopsd-xc) 124 | (modules cancel_utils_test) 125 | (libraries 126 | cmdliner 127 | ezxenstore.core 128 | ounit2 129 | threads.posix 130 | xapi-idl.xen.interface 131 | xapi-xenopsd 132 | xenctrl 133 | xenopsd_xc 134 | xenstore_transport.unix 135 | ) 136 | 137 | ) 138 | (rule 139 | (with-stdout-to 140 | xenopsd-xc.1 141 | (run %{dep:xenops_xc_main.exe} --help=groff) 142 | ) 143 | ) 144 | 145 | (rule 146 | (targets xenopsd-xc.1.gz) 147 | (action 148 | (run gzip %{dep:xenopsd-xc.1})) 149 | ) 150 | 151 | (install 152 | (section man) 153 | (files xenopsd-xc.1.gz) 154 | (package xapi-xenopsd-xc) 155 | ) 156 | -------------------------------------------------------------------------------- /xc/fence/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name fence) 3 | (public_name fence.bin) 4 | (package xapi-xenopsd-xc) 5 | (flags -warn-error +a-3) 6 | (libraries xenctrl) 7 | ) 8 | -------------------------------------------------------------------------------- /xc/fence/fence.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | (* The world's simplest program which attempts to reboot domain 0 *) 15 | 16 | let _ = 17 | if Array.length Sys.argv <> 2 || Sys.argv.(1) <> "yesreally" then ( 18 | Printf.fprintf stderr 19 | "Immediately fence this host - use with extreme caution\n" ; 20 | Printf.fprintf stderr "Usage: %s yesreally\n" Sys.argv.(0) ; 21 | exit 1 22 | ) ; 23 | let xc = Xenctrl.interface_open () in 24 | (* Clear both watchdog slots *) 25 | (try ignore (Xenctrl.watchdog xc 1 0l) with _ -> ()) ; 26 | (try ignore (Xenctrl.watchdog xc 2 0l) with _ -> ()) ; 27 | (* set a very short timeout *) 28 | Xenctrl.watchdog xc 0 0l 29 | 30 | (* boom? *) 31 | -------------------------------------------------------------------------------- /xc/memory_summary.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | module Date = Xapi_stdext_date.Date 15 | module Unixext = Xapi_stdext_unix.Unixext 16 | open Xenops_utils 17 | 18 | let xc = Xenctrl.interface_open () 19 | 20 | let hash = ref false 21 | 22 | let delay = ref (-1.0) 23 | 24 | let _ = 25 | Arg.parse 26 | [ 27 | ("-hash", Arg.Set hash, "Use hashes") 28 | ; ("-delay", Arg.Set_float delay, "Delay between updates") 29 | ] 30 | (fun x -> Printf.fprintf stderr "Ignoring argument: %s" x) 31 | "Display domains and memory use" ; 32 | if not !hash then 33 | Printf.printf 34 | "# time host_total host_free domainN_total domainN+1_total...\n" ; 35 | let ( +* ) = Int64.add and ( /* ) = Int64.div and ( ** ) = Int64.mul in 36 | let finished = ref false in 37 | while not !finished do 38 | finished := !delay < 0. ; 39 | if !delay > 0. then ignore (Unix.select [] [] [] !delay) ; 40 | flush stdout ; 41 | let physinfo = Xenctrl.physinfo xc in 42 | let one_page = 4096L in 43 | let total_pages = Int64.of_nativeint physinfo.Xenctrl.total_pages in 44 | let free_pages = 45 | Int64.of_nativeint physinfo.Xenctrl.free_pages 46 | +* Int64.of_nativeint physinfo.Xenctrl.scrub_pages 47 | in 48 | let domains = Xenctrl.domain_getinfolist xc 0 in 49 | let domains = 50 | List.map 51 | (fun di -> 52 | (di.Xenctrl.domid, Int64.of_nativeint di.Xenctrl.total_memory_pages) 53 | ) 54 | domains 55 | in 56 | if not !hash then ( 57 | Printf.printf "%s %Ld %Ld" 58 | (Date.to_string (Date.of_float (Unix.gettimeofday ()))) 59 | (total_pages ** one_page) (free_pages ** one_page) ; 60 | let domains = 61 | List.stable_sort (fun (a, _) (b, _) -> compare a b) domains 62 | in 63 | List.iter 64 | (fun (_, total) -> Printf.printf " %Ld" (total ** one_page)) 65 | domains ; 66 | Printf.printf "\n" 67 | ) else ( 68 | Printf.printf "Total host memory: %Ld MiB\n\n" (total_pages /* 256L) ; 69 | let nhashes = 55 in 70 | let hashes pages = 71 | let n = 72 | int_of_float 73 | (Int64.to_float pages 74 | /. Int64.to_float total_pages 75 | *. float_of_int nhashes 76 | ) 77 | in 78 | let hashes = String.make n '#' in 79 | let spaces = String.make (nhashes - n) ' ' in 80 | hashes ^ spaces 81 | in 82 | Printf.printf "%10s %s (%Ld MiB)\n" "free" (hashes free_pages) 83 | (free_pages /* 256L) ; 84 | List.iter 85 | (fun (domid, total) -> 86 | Printf.printf "%10s %s (%Ld MiB)\n" (string_of_int domid) 87 | (hashes total) (total /* 256L) 88 | ) 89 | domains 90 | ) 91 | done 92 | -------------------------------------------------------------------------------- /xc/netdev.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | open Xenops_utils 15 | 16 | module D = Debug.Make (struct let name = "netdev" end) 17 | 18 | open D 19 | 20 | type network = Bridge of string | VSwitch of string 21 | -------------------------------------------------------------------------------- /xc/netman.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | open Xenops_utils 15 | 16 | module D = Debug.Make (struct let name = "netman" end) 17 | 18 | open D 19 | 20 | type netty = Bridge of string | Vswitch of string | DriverDomain | Nat 21 | -------------------------------------------------------------------------------- /xc/readln.ml: -------------------------------------------------------------------------------- 1 | (* Read newline-delimited strings from a file descriptor *) 2 | 3 | type result = Ok of string list | Error of string | EOF 4 | 5 | let input = Hashtbl.create 100 (* holds unconsumed input per fd *) 6 | 7 | let lookup tbl k = try Hashtbl.find tbl k with Not_found -> [] 8 | 9 | let free fd = Hashtbl.remove input fd 10 | 11 | let read fd = 12 | let buffer_size = 4096 in 13 | let buffer = Bytes.make buffer_size '\000' in 14 | match Unix.read fd buffer 0 buffer_size with 15 | | 0 -> 16 | let pending = try Hashtbl.find input fd with Not_found -> Bytes.empty in 17 | Hashtbl.remove input fd ; 18 | if pending = Bytes.empty then 19 | EOF 20 | else 21 | Error 22 | (Printf.sprintf "Unconsumed data at EOF: '%s'" 23 | (Bytes.to_string pending) 24 | ) 25 | | n -> 26 | let data = Bytes.sub buffer 0 n in 27 | let inpt = try Hashtbl.find input fd with Not_found -> Bytes.empty in 28 | Hashtbl.replace input fd (Bytes.cat inpt data) ; 29 | let rec loop msgs = 30 | let data = Hashtbl.find input fd in 31 | (* never fails *) 32 | match Bytes.index data '\n' with 33 | | exception Not_found -> 34 | Ok (List.rev msgs) 35 | | index -> 36 | let remain = 37 | Bytes.sub data (index + 1) (Bytes.length data - index - 1) 38 | in 39 | Hashtbl.replace input fd remain ; 40 | (* reset input *) 41 | loop (Bytes.sub_string data 0 index :: msgs) 42 | (* store msg *) 43 | in 44 | loop [] 45 | | exception Unix.Unix_error (error, _, _) -> 46 | Error (Unix.error_message error) 47 | 48 | (* 49 | * Copyright (C) Citrix Systems Inc. 50 | * 51 | * This program is free software; you can redistribute it and/or modify 52 | * it under the terms of the GNU Lesser General Public License as published 53 | * by the Free Software Foundation; version 2.1 only. with the special 54 | * exception on linking described in file LICENSE. 55 | * 56 | * This program is distributed in the hope that it will be useful, 57 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 58 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 59 | * GNU Lesser General Public License for more details. 60 | *) 61 | -------------------------------------------------------------------------------- /xc/readln.mli: -------------------------------------------------------------------------------- 1 | type result = Ok of string list | Error of string | EOF 2 | 3 | val read : Unix.file_descr -> result 4 | (** [read] calls [Unix.read] and returns zero or more newline-delimited byte 5 | strings. This is in contrast to [input_line], which only reads the next 6 | newline-delimited string. In case input is available but does not constitute 7 | a complete string, [read] will return an empty list and buffer the read 8 | input. It will be returned at a subsequent call. *) 9 | 10 | val free : Unix.file_descr -> unit 11 | (** [free fd] removes all buffers associated with [fd]. However, it does not 12 | close the file descriptor. *) 13 | 14 | (* 15 | * Copyright (C) Citrix Systems Inc. 16 | * 17 | * This program is free software; you can redistribute it and/or modify 18 | * it under the terms of the GNU Lesser General Public License as published 19 | * by the Free Software Foundation; version 2.1 only. with the special 20 | * exception on linking described in file LICENSE. 21 | * 22 | * This program is distributed in the hope that it will be useful, 23 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 24 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 25 | * GNU Lesser General Public License for more details. 26 | *) 27 | -------------------------------------------------------------------------------- /xc/stats.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | val summarise : unit -> (string * string) list 16 | (** Produce a string name -> string mean, standard deviation summary for each 17 | population *) 18 | 19 | val time_this : string -> (unit -> 'a) -> 'a 20 | (** Time the given function and attribute the result to the named population *) 21 | 22 | type dbcallty = Read | Write | Create | Drop 23 | 24 | val log_db_call : string option -> string -> dbcallty -> unit 25 | 26 | val summarise_db_calls : 27 | unit 28 | -> string list 29 | * string list 30 | * string list 31 | * string list 32 | * (string * (string * string) list) list 33 | * (int * (string * string) list) list 34 | 35 | val log_stats : bool ref 36 | -------------------------------------------------------------------------------- /xc/tuntap.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) Citrix 3 | *) 4 | 5 | external _tap_open : string -> Unix.file_descr = "stub_tap_open" 6 | 7 | let finally = Xapi_stdext_pervasives.Pervasiveext.finally 8 | 9 | let tap_open ifname = 10 | try _tap_open ifname 11 | with Failure msg -> 12 | raise Xenops_interface.(Xenopsd_error (Errors.Internal_error msg)) 13 | 14 | let with_tap ifname ~fn = 15 | let fd = tap_open ifname in 16 | finally (fun () -> fn fd) (fun () -> Unix.close fd) 17 | -------------------------------------------------------------------------------- /xc/tuntap.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright Citrix 3 | *) 4 | 5 | val tap_open : string -> Unix.file_descr 6 | (** [tap_open ifname] opens /dev/net/tun for interface [ifname]. *) 7 | 8 | val with_tap : string -> fn:(Unix.file_descr -> 'a) -> 'a 9 | (** [with_tap ifname fn] applies [fn] to the file descriptor for [ifname] and 10 | closes the file descriptor subsequently even in the presence of exceptions *) 11 | -------------------------------------------------------------------------------- /xc/xc_resources.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | let vif_script = ref "/usr/lib/xcp/scripts/vif" 16 | 17 | let vbd_script = ref "/etc/xen/scripts/block" 18 | 19 | let pci_flr_script = ref "/usr/lib/xcp/lib/pci-flr" 20 | 21 | let igmp_query_injector_script = 22 | ref "/usr/libexec/xenopsd/igmp_query_injector.py" 23 | 24 | let vncterm = ref "vncterm" 25 | 26 | let xenguest = ref "xenguest" 27 | 28 | let emu_manager = ref "emu-manager" 29 | 30 | let tune2fs = ref "tune2fs" 31 | 32 | let mount = ref "mount" 33 | 34 | let umount = ref "umount" 35 | 36 | let ionice = ref "ionice" 37 | 38 | let setup_vif_rules = ref "setup-vif-rules" 39 | 40 | let setup_pvs_proxy_rules = ref "setup-pvs-proxy-rules" 41 | 42 | let vgpu = ref "vgpu" 43 | 44 | let gimtool = ref "/opt/xensource/bin/gimtool" 45 | 46 | let varstored = ref "varstored" 47 | 48 | let alternatives = ref "/usr/lib/xapi/alternatives" 49 | 50 | let usb_reset_script = ref "/opt/xensource/libexec/usb_reset.py" 51 | 52 | open Unix 53 | 54 | let essentials = 55 | [ 56 | (X_OK, "vbd-script", vbd_script, "path to the vbd backend script") 57 | ; (X_OK, "vif-script", vif_script, "path to the vif backend script") 58 | ; (X_OK, "xenguest", xenguest, "path to the xenguest binary") 59 | ; (X_OK, "emu-manager", emu_manager, "path to the emu-manager binary") 60 | ; (X_OK, "tune2fs", tune2fs, "path to the tune2fs binary") 61 | ; (X_OK, "mount", mount, "path to the mount binary") 62 | ; (X_OK, "umount", umount, "path to the umount binary") 63 | ; (X_OK, "ionice", ionice, "path to the ionice binary") 64 | ; ( X_OK 65 | , "setup-vif-rules" 66 | , setup_vif_rules 67 | , "path to the setup-vif-rules script" 68 | ) 69 | ; ( X_OK 70 | , "setup-pvs-proxy-rules" 71 | , setup_pvs_proxy_rules 72 | , "path to the setup-pvs-proxy-rules script" 73 | ) 74 | ] 75 | @ Resources.network_configuration 76 | 77 | let nonessentials = 78 | [ 79 | ( X_OK 80 | , "pci-flr-script" 81 | , pci_flr_script 82 | , "path to the PCI function-level reset script" 83 | ) 84 | ; (X_OK, "alternatives", alternatives, "path to the alternative xenguests") 85 | ; (X_OK, "vgpu", vgpu, "path to the vgpu binary") 86 | ; (X_OK, "varstored", varstored, "path to the varstored binary") 87 | ; (X_OK, "vncterm", vncterm, "path to the vncterm binary") 88 | ; (X_OK, "gimtool", gimtool, "path to the gimtool binary") 89 | ; ( X_OK 90 | , "igmp-query-injector-script" 91 | , igmp_query_injector_script 92 | , "path to the igmp query injector script" 93 | ) 94 | ] 95 | @ Resources.hvm_guests 96 | @ Resources.pv_guests 97 | @ Resources.pvinpvh_guests 98 | -------------------------------------------------------------------------------- /xc/xenbus_utils.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | open Xenstore 15 | 16 | type state = 17 | | Unknown 18 | | Initialising 19 | | InitWait 20 | | Initialised 21 | | Connected 22 | | Closing 23 | | Closed 24 | 25 | let int_of = function 26 | | Unknown -> 27 | 0 28 | | Initialising -> 29 | 1 30 | | InitWait -> 31 | 2 32 | | Initialised -> 33 | 3 34 | | Connected -> 35 | 4 36 | | Closing -> 37 | 5 38 | | Closed -> 39 | 6 40 | 41 | let of_int = function 42 | | 0 -> 43 | Unknown 44 | | 1 -> 45 | Initialising 46 | | 2 -> 47 | InitWait 48 | | 3 -> 49 | Initialised 50 | | 4 -> 51 | Connected 52 | | 5 -> 53 | Closing 54 | | 6 -> 55 | Closed 56 | | _ -> 57 | Unknown 58 | 59 | let of_string x = of_int (int_of_string x) 60 | 61 | let string_of x = string_of_int (int_of x) 62 | 63 | let to_string_desc = function 64 | | Unknown -> 65 | "unknown" 66 | | Initialising -> 67 | "initialising" 68 | | InitWait -> 69 | "initwait" 70 | | Initialised -> 71 | "initialised" 72 | | Connected -> 73 | "connected" 74 | | Closing -> 75 | "closing" 76 | | Closed -> 77 | "closed" 78 | 79 | (** Allows a guest to read/write this node and children *) 80 | let rwperm_for_guest domid = 81 | Xs_protocol.ACL.{owner= domid; other= NONE; acl= []} 82 | 83 | (** Dom0 can read/write this node and children, domU can only read children *) 84 | let roperm_for_guest domid = 85 | Xs_protocol.ACL.{owner= 0; other= NONE; acl= [(domid, READ)]} 86 | 87 | open Device_common 88 | 89 | let device_frontend device = 90 | Xs_protocol.ACL. 91 | { 92 | owner= device.frontend.domid 93 | ; other= NONE 94 | ; acl= [(device.backend.domid, READ)] 95 | } 96 | 97 | 98 | let device_backend device = 99 | Xs_protocol.ACL. 100 | { 101 | owner= device.backend.domid 102 | ; other= NONE 103 | ; acl= [(device.frontend.domid, READ)] 104 | } 105 | 106 | 107 | let hotplug device = 108 | Xs_protocol.ACL.{owner= device.backend.domid; other= NONE; acl= []} 109 | -------------------------------------------------------------------------------- /xc/xenctrlext.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | open Xenctrl 16 | 17 | external get_boot_cpufeatures : 18 | handle -> int32 * int32 * int32 * int32 * int32 * int32 * int32 * int32 19 | = "stub_xenctrlext_get_boot_cpufeatures" 20 | 21 | external domain_set_timer_mode : handle -> domid -> int -> unit 22 | = "stub_xenctrlext_domain_set_timer_mode" 23 | 24 | external domain_send_s3resume : handle -> domid -> unit 25 | = "stub_xenctrlext_domain_send_s3resume" 26 | 27 | external domain_get_acpi_s_state : handle -> domid -> int 28 | = "stub_xenctrlext_domain_get_acpi_s_state" 29 | 30 | exception Unix_error of Unix.error * string 31 | 32 | let _ = 33 | Callback.register_exception "Xenctrlext.Unix_error" 34 | (Unix_error (Unix.E2BIG, "")) 35 | 36 | type runstateinfo = { 37 | state: int32 38 | ; missed_changes: int32 39 | ; state_entry_time: int64 40 | ; time0: int64 41 | ; time1: int64 42 | ; time2: int64 43 | ; time3: int64 44 | ; time4: int64 45 | ; time5: int64 46 | } 47 | 48 | external domain_get_runstate_info : handle -> int -> runstateinfo 49 | = "stub_xenctrlext_get_runstate_info" 50 | 51 | external get_max_nr_cpus : handle -> int = "stub_xenctrlext_get_max_nr_cpus" 52 | 53 | external domain_set_target : handle -> domid -> domid -> unit 54 | = "stub_xenctrlext_domain_set_target" 55 | 56 | external physdev_map_pirq : handle -> domid -> int -> int 57 | = "stub_xenctrlext_physdev_map_pirq" 58 | 59 | external assign_device : handle -> domid -> int -> int -> unit 60 | = "stub_xenctrlext_assign_device" 61 | 62 | external deassign_device : handle -> domid -> int -> unit 63 | = "stub_xenctrlext_deassign_device" 64 | 65 | external domid_quarantine : unit -> int = "stub_xenctrlext_domid_quarantine" 66 | 67 | external domain_soft_reset : handle -> domid -> unit 68 | = "stub_xenctrlext_domain_soft_reset" 69 | 70 | external domain_update_channels : handle -> domid -> int -> int -> unit 71 | = "stub_xenctrlext_domain_update_channels" 72 | 73 | external vcpu_setaffinity_soft : handle -> domid -> int -> bool array -> unit 74 | = "stub_xenctrlext_vcpu_setaffinity_soft" 75 | 76 | type meminfo = {memfree: int64; memsize: int64} 77 | 78 | type numainfo = {memory: meminfo array; distances: int array array} 79 | 80 | type cputopo = {core: int; socket: int; node: int} 81 | 82 | external numainfo : handle -> numainfo = "stub_xenctrlext_numainfo" 83 | 84 | external cputopoinfo : handle -> cputopo array = "stub_xenctrlext_cputopoinfo" 85 | -------------------------------------------------------------------------------- /xc/xenctrlext.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | open Xenctrl 16 | 17 | external get_boot_cpufeatures : 18 | handle -> int32 * int32 * int32 * int32 * int32 * int32 * int32 * int32 19 | = "stub_xenctrlext_get_boot_cpufeatures" 20 | 21 | external domain_set_timer_mode : handle -> domid -> int -> unit 22 | = "stub_xenctrlext_domain_set_timer_mode" 23 | 24 | external domain_send_s3resume : handle -> domid -> unit 25 | = "stub_xenctrlext_domain_send_s3resume" 26 | 27 | external domain_get_acpi_s_state : handle -> domid -> int 28 | = "stub_xenctrlext_domain_get_acpi_s_state" 29 | 30 | exception Unix_error of Unix.error * string 31 | 32 | type runstateinfo = { 33 | state: int32 34 | ; missed_changes: int32 35 | ; state_entry_time: int64 36 | ; time0: int64 37 | ; time1: int64 38 | ; time2: int64 39 | ; time3: int64 40 | ; time4: int64 41 | ; time5: int64 42 | } 43 | 44 | external domain_get_runstate_info : handle -> int -> runstateinfo 45 | = "stub_xenctrlext_get_runstate_info" 46 | 47 | external get_max_nr_cpus : handle -> int = "stub_xenctrlext_get_max_nr_cpus" 48 | 49 | external domain_set_target : handle -> domid -> domid -> unit 50 | = "stub_xenctrlext_domain_set_target" 51 | 52 | external physdev_map_pirq : handle -> domid -> int -> int 53 | = "stub_xenctrlext_physdev_map_pirq" 54 | 55 | external assign_device : handle -> domid -> int -> int -> unit 56 | = "stub_xenctrlext_assign_device" 57 | 58 | external deassign_device : handle -> domid -> int -> unit 59 | = "stub_xenctrlext_deassign_device" 60 | 61 | external domid_quarantine : unit -> int = "stub_xenctrlext_domid_quarantine" 62 | 63 | external domain_soft_reset : handle -> domid -> unit 64 | = "stub_xenctrlext_domain_soft_reset" 65 | 66 | external domain_update_channels : handle -> domid -> int -> int -> unit 67 | = "stub_xenctrlext_domain_update_channels" 68 | 69 | type meminfo = {memfree: int64; memsize: int64} 70 | 71 | type numainfo = {memory: meminfo array; distances: int array array} 72 | 73 | type cputopo = {core: int; socket: int; node: int} 74 | 75 | external vcpu_setaffinity_soft : handle -> domid -> int -> bool array -> unit 76 | = "stub_xenctrlext_vcpu_setaffinity_soft" 77 | 78 | external numainfo : handle -> numainfo = "stub_xenctrlext_numainfo" 79 | 80 | external cputopoinfo : handle -> cputopo array = "stub_xenctrlext_cputopoinfo" 81 | -------------------------------------------------------------------------------- /xc/xenops_helpers.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) 2006-2009 Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | open Xenops_utils 15 | open Xenstore 16 | 17 | (** {2 XC, XS and XAL interface helpers.} *) 18 | 19 | let with_xc f = Xenctrl.with_intf f 20 | 21 | let with_xc_and_xs f = Xenctrl.with_intf (fun xc -> with_xs (fun xs -> f xc xs)) 22 | 23 | let with_xc_and_xs_final f cf = 24 | with_xc_and_xs (fun xc xs -> 25 | Xapi_stdext_pervasives.Pervasiveext.finally (fun () -> f xc xs) cf 26 | ) 27 | 28 | exception Domain_not_found 29 | 30 | let uuid_of_domid ~xs domid = 31 | try 32 | let vm = xs.Xs.getdomainpath domid ^ "/vm" in 33 | let vm_dir = xs.Xs.read vm in 34 | match Uuidm.of_string (xs.Xs.read (vm_dir ^ "/uuid")) with 35 | | Some uuid -> 36 | uuid 37 | | None -> 38 | raise Domain_not_found 39 | with _ -> raise Domain_not_found 40 | 41 | let domains_of_uuid ~xc uuid = 42 | List.filter 43 | (fun x -> Ez_xenctrl_uuid.uuid_of_handle x.Xenctrl.handle = uuid) 44 | (Xenctrl.domain_getinfolist xc 0) 45 | -------------------------------------------------------------------------------- /xc/xenops_xc_main.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | (* Ensure domain 0 has a sensible uuid *) 16 | let check_domain0_uuid () = 17 | let xc = Xenctrl.interface_open () in 18 | let uuid = 19 | try Inventory.lookup Inventory._control_domain_uuid 20 | with _ -> 21 | let uuid = Uuidm.(to_string (create `V4)) in 22 | Inventory.update Inventory._control_domain_uuid uuid ; 23 | uuid 24 | in 25 | Xenops_server.set_dom0_uuid uuid ; 26 | Xenctrl.domain_sethandle xc 0 uuid ; 27 | (* make the minimum entries for dom0 *) 28 | let kvs = 29 | [ 30 | ("/local/domain/0/domid", "0") 31 | ; ("/local/domain/0/vm", "/vm/" ^ uuid) 32 | ; ("/local/domain/0/name", "Domain-0") 33 | ; (Printf.sprintf "/vm/%s/uuid" uuid, uuid) 34 | ; (Printf.sprintf "/vm/%s/name" uuid, "Domain-0") 35 | ; (Printf.sprintf "/vm/%s/domains/0" uuid, "/local/domain/0") 36 | ; (Printf.sprintf "/vm/%s/domains/0/create-time" uuid, "0") 37 | ] 38 | in 39 | let open Xenstore in 40 | with_xs (fun xs -> List.iter (fun (k, v) -> xs.Xs.write k v) kvs) ; 41 | (* before daemonizing we need to forget the xenstore client because the 42 | background thread will be gone after the fork() *) 43 | forget_client () 44 | 45 | let make_var_run_xen () = 46 | Xapi_stdext_unix.Unixext.mkdir_rec Device_common.var_run_xen_path 0o0755 47 | 48 | (* Start the program with the xen backend *) 49 | let _ = 50 | Coverage.init "xenopsd-xc" ; 51 | (* set up coverage profiling *) 52 | Xenops_interface.queue_name := !Xenops_interface.queue_name ^ ".classic" ; 53 | Xenops_utils.set_root "xenopsd/classic" ; 54 | Xenopsd.configure ~specific_essential_paths:Xc_resources.essentials 55 | ~specific_nonessential_paths:Xc_resources.nonessentials () ; 56 | check_domain0_uuid () ; 57 | make_var_run_xen () ; 58 | Xenopsd.main (module Xenops_server_xen : Xenops_server_plugin.S) 59 | -------------------------------------------------------------------------------- /xc/xenstore_watch.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (C) Citrix Systems Inc. 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published 6 | * by the Free Software Foundation; version 2.1 only. with the special 7 | * exception on linking described in file LICENSE. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | *) 14 | 15 | (* This module provides what used to be Xenstore_watch in this 16 | * repository. 17 | *) 18 | 19 | module XSW_Debug = Debug.Make (struct let name = "xenstore_watch" end) 20 | 21 | include Ez_xenstore_watch.Make (XSW_Debug) 22 | -------------------------------------------------------------------------------- /xenopsd.conf: -------------------------------------------------------------------------------- 1 | # Configuration file for xenopsd 2 | 3 | # Default paths to search for binaries 4 | # search-path= 5 | 6 | # The location of the inventory file 7 | inventory = /etc/xensource-inventory 8 | 9 | # True to use the message switch; false for direct Unix domain socket 10 | # comms 11 | use-switch = false 12 | 13 | # false means use the real xen backend; true the simulation backend 14 | simulate=false 15 | 16 | # true means persist data across restarts 17 | persist=true 18 | 19 | log=syslog:xenopsd 20 | pidfile=/var/run/xenopsd.pid 21 | 22 | # Omit some sources of log-spam by default 23 | disable-logging-for=http 24 | 25 | # Where to place the listening sockets 26 | # sockets-path=/var/xapi 27 | 28 | # Group which can access the listening socket 29 | # sockets-group=xapi 30 | 31 | # Number of threads which will service the VM operation queues 32 | # worker-pool-size=4 33 | 34 | # Directory tree containing VM metadata 35 | # database-path=/var/run/nonpersistent/xenopsd 36 | 37 | # Path to hvmloader 38 | # hvmloader="/usr/lib/xen/boot/hvmloader" 39 | 40 | # Path to pygrub 41 | # pygrub=/usr/lib/xen-4.1/bin/pygrub 42 | 43 | # Path to eliloader 44 | # eliloader=/usr/bin/eliloader 45 | 46 | # Path to the network backend switch 47 | # network_conf="/etc/xcp/network.conf" 48 | 49 | # Where to cache boot-time CPU info 50 | # cpu-info-file = /etc/xensource/boot_time_cpus 51 | 52 | # True means that xenopsd will run the hotplug scripts itself (preferred) 53 | # run_hotplug_scripts = true 54 | 55 | # Path to the vif backend script 56 | # vif-script=/etc/xensource/scripts/vif 57 | 58 | # Path to the vif backend script 59 | # vif-xl-script=/etc/xensource/scripts/vif 60 | 61 | # Path to the vbd backend script 62 | # vbd-xl-script=/usr/lib/xcp/scripts/block 63 | 64 | # Path to the qemu vif script 65 | # qemu-vif-script=/etc/xcp/scripts/qemu-vif-script 66 | 67 | # Path to the PCI FLR script 68 | # pci-flr-script=/opt/xensource/libexec/pci-flr 69 | 70 | # Path to the vncterm binary 71 | # vncterm=/usr/lib/xen/bin/vncterm 72 | 73 | # Path to the xenguest binary 74 | # xenguest=/opt/xensource/libexec/xenguest 75 | 76 | # Path to the emu-manager binary 77 | # emu-manager=/opt/xensource/libexec/emu-manager 78 | 79 | # Path to the qemu-dm wrapper script 80 | # qemu-dm-wrapper=/opt/xensource/libexec/qemu-dm-wrapper 81 | 82 | # Path to the setup-vif-rules script 83 | # setup-vif-rules=/opt/xensource/libexec/setup-vif-rules 84 | 85 | # Path to the setup-pvs-proxy-rules script 86 | # setup-pvs-proxy-rules=/usr/libexec/xenopsd/setup-pvs-proxy-rules 87 | 88 | # Paths to standard system utilities: 89 | # tune2fs=/sbin/tune2fs 90 | # mkfs=/sbin/mkfs 91 | # mount=/bin/mount 92 | # umount=/bin/umount 93 | # ionice=/usr/bin/ionice 94 | # chgrp=/bin/chgrp 95 | 96 | # Default backend for VBDs (used in XenStore) 97 | # default-vbd-backend-kind=vbd 98 | 99 | # Use the upstream qemu by default 100 | # use-upstream-qemu=false 101 | 102 | # Workaround for ca-140252: evtchn misalignment workaround for legacy PV tools 103 | # ca-140252-workaround=false 104 | 105 | # Xenopsd does not have a way to pause a ballooning process that is being too 106 | # slow or has reached a "good enough" memory level. 107 | # The following tiemout indicates the time that we allow the guests drivers to 108 | # do additional memory ballooning before live migration if we detect that 109 | # the ballooning is still in progress or has suddenly restarted. 110 | # Reaching the timeout will cancel the migration but leave the VM in a usable 111 | # running state. 112 | # additional-ballooning-timeout=120.0 113 | 114 | # time to wait for in-guest PV drivers to acknowledge a shutdown request 115 | # before we conclude that the drivers have failed 116 | # domain_shutdown_ack_timeout = 60 117 | --------------------------------------------------------------------------------