xapi-project · simonjbeaumont · May 17, 2016 · Apr 29, 2016 · Apr 29, 2016 · Apr 29, 2016
diff --git a/Dockerfile b/Dockerfile
@@ -15,15 +15,17 @@ ENV HOME /home/opam
 WORKDIR /home/opam
 
 RUN opam pin add -n -y mirage-xen \
-    git://github.com/jonludlam/mirage-platform#reenable-suspend-resume
+    git://github.com/jonludlam/mirage-platform#reenable-suspend-resume2
 RUN opam pin add -n -y mirage-bootvar-xen \
     git://github.com/jonludlam/mirage-bootvar-xen#better-parser
 RUN opam pin add -n -y minios-xen \
     git://github.com/jonludlam/mini-os#suspend-resume3
+
 RUN opam install -q -y mirage-xen
 RUN opam install -q -y mirage-console
 RUN opam install -q -y mirage-bootvar-xen
 RUN opam install -q -y mirage
+RUN opam install -q -y yojson
 
 ENTRYPOINT [ "opam", "config", "exec", "--" ]
 CMD [ "bash" ]
diff --git a/Makefile b/Makefile
@@ -1,30 +1,30 @@
-# vim:ft=make ts=8: 
+# vim: set ft=make ts=8: 
 #
-#
-
 
-HOST 		= "root@dt87"
+PACKAGE = 	xen-test-vm
+PREFIX = 	.
+LIB = 		$(PREFIX)/$(PACKAGE)/lib
+VM = 		src/test-vm.xen.gz
 
 all:		src
 		$(MAKE) -C src/ all
-		ls -lh src/test-vm.xen.gz
+		ls -lh $(VM)
 
-
-install: 	all
-		ssh $(HOST) "test -d /boot/guest || mkdir /boot/guest"
-		ssh $(HOST) "cd /boot/guest; rm -f test-vm.xen"
-		scp src/test-vm.xen.gz $(HOST):/boot/guest
+package: 	src
+		opam pin add -y xen-test-vm .
+		opam install xen-test-vm
 
-remove: 	
-		true
+install: 	
+		mkdir -p $(LIB)
+		cp $(VM) $(LIB)
 
+remove: 	
+		rm -f $(LIB)/$(VM)
+
 clean:
 		$(MAKE) -C src clean
 
-release: 	opam descr
-
-
-.PHONY: all clean install release
+.PHONY: 	all clean install release
 
 
 

diff --git a/README.md b/README.md
@@ -1,3 +1,5 @@
+<!-- vim: set ts=4 sw=4 et: -->
+
 [![Build Status](https://travis-ci.org/xapi-project/xen-test-vm.svg?branch=master)](https://travis-ci.org/xapi-project/xen-test-vm)
 
 # Xen Test VM
@@ -8,24 +10,20 @@ using the Mirage unikernel framework.
 
 # Binary Releases
 
-Binary releases are hosted on 
+Binary releases are hosted on
 [GitHub](https://github.com/xapi-project/xen-test-vm/releases) as
-`xen-test.vm.gz`. The uncompressed file is the kernel that needs to be
-installed. You could use the following code in a script:
+`xen-test.vm.gz`. 
 
-```sh
-VERSION="0.0.5"
-NAME="xen-test-vm-$VERSION"
-GH="https://github.com/xapi-project"
-VM="$GH/xen-test-vm/releases/download/$VERSION/test-vm.xen.gz"
-KERNEL="xen-test-vm-${VERSION//./-}.xen.gz"
+    VERSION="0.0.5"
+    GH="https://github.com/xapi-project"
+    VM="$GH/xen-test-vm/releases/download/$VERSION/test-vm.xen.gz"
+    KERNEL="xen-test-vm-${VERSION//./-}.xen.gz"
 
-curl --fail -s -L "$VM" > "$KERNEL"
-```
+    curl --fail -s -L "$VM" > "$KERNEL"
 
 # Installing the VM
 
-The VM is built as `src/test-vm.xen` and available as binary
+The VM is built as `src/test-vm.xen.gz` and available as binary
 release. The file goes into `/boot/guest` on a host:
 
     HOST=host
@@ -44,17 +42,20 @@ XenCenter.
 
 # Building from Source Code
 
-The code relies on some pinned OCaml packages in Opam. This dependency
-cannot be expressed naturally in the depends section of an `opam` file. For
-now, this requires to install the dependencies manually. Apart from that,
-calling `make` will build `src/test-vm.xen`
+The easiest way is to let opam manage the installation of dependencies:
 
+    opam pin add -n -y mirage-xen \
+    git://github.com/jonludlam/mirage-platform#reenable-suspend-resume2
+
+    opam pin add -n -y mirage-bootvar-xen \
+    git://github.com/jonludlam/mirage-bootvar-xen#better-parser
+
+    opam pin add -n -y minios-xen \
+    git://github.com/jonludlam/mini-os#suspend-resume3
 
-        ./setup.sh # executes opam installations
-        make
+    opam pin add xen-test-vm .
+    opam install -v xen-test-vm
 
-A `Dockerfile` can be used to create a Docker container environment for
-compiling the VM. It is used for building on Travis.
 
 # Travis CI
 
@@ -64,51 +65,65 @@ The VM is built on Travis using the [Dockerfile](./Dockerfile) - see the
 
 # Out-of-Band Control Messages
 
-The kernel reads control messages from the Xen Store from
-"control/shutdown" and responds to them. In addition, it reads from 
-"control/testing". 
+In addition to the shutdown messages sent by Xen, the kernel monitors
+the Xen Store for messages. These are used to control the response to
+shutdown messages.
 
 ## Shutdown Messages
 
-The kernel responds to these messages in the "control/shutdown". Usually
+The kernel responds to these messages in "control/shutdown". Usually
 the hypervisor only sends these.
 
     suspend  
     poweroff 
     reboot   
     halt     
     crash    
-    ignore
+
+All other messages are logged and ignored. 
 
 ## Testing Messages
 
-The kernel reads messages in "control/testing". Legal messages are:
+The kernel reads messages in "control/testing". It acknowledges a
+message by replacing the read message with the empty string.
 
-    now:suspend  
-    now:poweroff 
-    now:reboot   
-    now:halt     
-    now:crash    
-    now:ignore
+A message in "control/testing" is a JSON object: 
 
-Each makes the kernel respond to these immediately. In addition, these
-messages are legal:
+    { "when":       "now"           // when to react
+    , "ack":        "ok"            // how to ack control/shutdown
+    , "action":     "reboot"        // how to react to control/shutdown
+    }
 
-    next:suspend  
-    next:poweroff 
-    next:reboot   
-    next:halt     
-    next:crash    
-    next:ignore
+Note that proper JSON does not permit _//_-style comments.  The message
+describes three aspects:
 
-The next time the kernel receives a shutdown message, it ignores the
-message it received and acts on the next:message instead. This permits
-to surprise the hypervisor.
+1. `"when"`: either `"now"` or `"onshutdown"`. The kernel will either
+   immediately or when then next shutdown message arrives perform the
+   `"action"`.
 
-Typically, control/shutdown is written only by Xen. To write to
-control/testing, use:
+2. `"ack"`: either `"ok"`, `"none"`, `"delete"`, or something else. This
+  controls, how the kernel acknowledges the next shutdown message.
+    * `"ok"`: regular behavior
+    * `"none"`: don't acknowledge the message
+    * `"delete"`: delete "control/shutdown"
+    * `"something"`: write the string read to "control/shutdown"
 
-  xenstore write /local/domain/<domid>/control/testing now:reboot
+3. `"action"`: what do do (eiter now or on shutdown). The message in
+   `control/shutdown` is ignored and superseeded by the `action` field: 
+    * `"suspend"`: suspend
+    * `"poweroff"`: power off
+    * `"reboot"`: reboot
+    * `"halt"`: halt
+    * `"crash"`: crash
+    * `"ignore"`: do nothing - ignore the message
+
+To write to `control/testing`, use:
+
+    msg='{"when":"now","ack":"ok","action":"reboot"}'
+    xenstore write /local/domain/<domid>/control/testing "$msg"
+
+The _domid_ is logged to the console and can be obtained through the Xen
+API.
 
 # Debugging the VM
 
@@ -118,4 +133,3 @@ To direct console output of the VM to a file, you can tell the $HOST:
 
 Output then goes to `/tmp/console.<domid>`.
 
-
diff --git a/descr b/descr
diff --git a/opam b/opam
diff --git a/opam/descr b/opam/descr
@@ -0,0 +1,6 @@
+xen-test-vm - minimal VM kernel for testing Xen
+
+This code builds a minimal kernel (or VM) that can be run on a Xen
+hypervisor for exercising tests. The behaviour of the kernel can be
+controlled with a JSON record that can be passed to the kernel via the
+XenStore.
diff --git a/opam/opam b/opam/opam
@@ -0,0 +1,26 @@
+opam-version: "1.2"
+name: "xen-test-vm"
+version: "0.2"
+maintainer: "Christian Lindig <[email protected]>"
+authors: "Christian Lindig <[email protected]>"
+build: [
+  [make]
+]
+install: [
+  make "PREFIX=%{prefix}%" "install"
+]
+remove: [
+  make "PREFIX=%{prefix}%" "remove"
+]
+homepage: "https://github.com/lindig/xen-test-vm"
+dev-repo: "https://github.com/lindig/xen-test-vm"
+bug-reports: "https://github.com/lindig/xen-test-vm"
+
+depends: [
+    "mirage-xen"
+    "mirage-console"
+    "mirage-bootvar-xen"
+    "mirage"
+    "yojson"
+]
+
diff --git a/setup.sh b/setup.sh
diff --git a/src/Makefile b/src/Makefile
@@ -14,12 +14,13 @@ OCB  	= ocamlbuild -use-ocamlfind $(OCBOPTS)
 all: 	
 	$(OCB) main.native.o
 	ld -d -static -nostdlib $(LIBS) -o $(VM)
-	gzip $(VM)
+	gzip -f $(VM)
 
 LIBS +=	_build/main.native.o 
 LIBS +=	-L$(OPAMLIB) 
 LIBS +=	-L$(OPAMLIB)/minios-xen 
 LIBS +=	-L$(OPAMLIB)/io-page 
+# LIBS += -L$(OPAMLIB)/yojson
 LIBS +=	$(OPAMLIB)/mirage-xen/libxencamlbindings.a 
 LIBS +=	$(OPAMLIB)/mirage-xen-ocaml/libxenasmrun.a 
 LIBS +=	$(OPAMLIB)/mirage-xen-ocaml/libxenotherlibs.a 

diff --git a/src/_tags b/src/_tags
@@ -1,6 +1,7 @@
 true:	        package(functoria.runtime)
 true:	        package(mirage-bootvar)
 true:	        package(mirage-console.xen)
+true:	        package(yojson)
 
 # true:	        package(mirage-types.lwt)
 # true:	        package(mirage-xen)

diff --git a/src/commands.ml b/src/commands.ml
@@ -0,0 +1,62 @@
+(* vim: set et sw=2 ts=2 *)
+
+module Y  = Yojson.Basic
+module U  = Yojson.Basic.Util
+
+exception Error of string
+let error fmt = Printf.ksprintf (fun msg -> raise (Error msg)) fmt
+
+(** actions a guest can take *)
+type action =
+  | Suspend
+  | PowerOff
+  | Reboot
+  | Halt
+  | Crash
+  | Ignore
+
+(** how is a control message from the host acknowledged by the guest *)
+type ack =
+  | AckOK               (* ack by putting empty string *)
+  | AckWrite of string  (* ack by putting string *)
+  | AckNone             (* don't ack *)
+  | AckDelete           (* delete key /control/shutdown *)
+
+(** message to a guest *)
+type t =
+  | Now           of action
+  | OnShutdown    of ack * action
+
+let action = function
+  | "suspend"   -> Suspend 
+  | "poweroff"  -> PowerOff 
+  | "reboot"    -> Reboot 
+  | "halt"      -> Halt 
+  | "crash"     -> Crash 
+  | "ignore"    -> Ignore 
+  | x           -> error "unknown action: %s" x
+
+let do_when ack action = function
+  | "now"       -> Now(action)
+  | "onshutdown"-> OnShutdown(ack, action)
+  | x           -> error "unknown when: %s" x
+
+let ack = function
+  | "ok"        -> AckOK
+  | "none"      -> AckNone
+  | "delete"    -> AckDelete
+  | x           -> AckWrite(x)
+
+let from_string str =
+  try
+    let json    = Y.from_string str in
+    let ack'    = json |> U.member "ack"     |> U.to_string |> ack in
+    let action' = json |> U.member "action"  |> U.to_string |> action in
+      json 
+      |> U.member "when" 
+      |> U.to_string
+      |> do_when ack' action'
+  with
+    Yojson.Json_error msg -> error "bad json: %s" msg
+
+