Merge pull request #27 from MagnusS/master

Support for irmin 0.10.0
mirage · Oct 14, 2015 · 61a0523 · 61a0523
2 parents 1439b82 + 76bf34c
commit 61a0523
Show file tree

Hide file tree

Showing 8 changed files with 442 additions and 451 deletions.
diff --git a/Makefile b/Makefile
@@ -4,7 +4,7 @@ OPT=-linkpkg -g
 OCAMLOPT=ocamlopt -w A-4-44
 
 SRC=$(PWD)/src
-FILES=vm_stop_mode.ml vm_state.ml xenstore.ml backends.mli options.ml rumprun.ml libvirt_backend.ml xapi_backend.ml libxl_backend.ml irmin_backend.mli dns_helpers.ml irmin_backend.ml synjitsu.mli synjitsu.ml jitsu.mli jitsu.ml
+FILES=vm_stop_mode.ml vm_state.ml xenstore.ml backends.mli options.ml rumprun.ml libvirt_backend.ml xapi_backend.ml libxl_backend.ml dns_helpers.ml irmin_backend.ml synjitsu.mli synjitsu.ml jitsu.mli jitsu.ml
 MAIN=main.ml
 
 TEST_SRC=$(PWD)/lib_test

diff --git a/opam b/opam
@@ -24,7 +24,7 @@ depends: [  "lwt"
             "vchan"
             "uuidm"
             "irmin-unix"
-            "irmin" { >= "0.9.7" }
+            "irmin" { >= "0.10.0" }
             "git"
             "xen-api-client"
             "xenctrl"

diff --git a/src/backends.mli b/src/backends.mli
@@ -64,3 +64,84 @@ sig
   (** Start VM *)
 
 end
+
+module type STORAGE_BACKEND =
+sig
+  type t
+  type id
+
+  val create : ?root:string -> ?log:(string -> unit) -> unit -> t Lwt.t
+
+  val get_dns_db : t -> Dns.Loader.db Lwt.t
+  (** Get DNS DB representation for use with ocaml-dns *)
+
+  val add_vm_dns : t -> vm_uuid:Uuidm.t -> dns_name:Dns.Name.t -> dns_ttl:int -> unit Lwt.t
+  (** Add DNS record for VM *)
+
+  val add_vm : t -> vm_uuid:Uuidm.t -> vm_ip:Ipaddr.V4.t -> vm_stop_mode:Vm_stop_mode.t -> response_delay:float -> wait_for_key:string option -> use_synjitsu:bool -> vm_config:(string,string) Hashtbl.t -> unit Lwt.t
+  (** Add a new VM *)
+
+  val get_vm_config : t -> vm_uuid:Uuidm.t -> (string, string) Hashtbl.t Lwt.t
+  (** Additional configuration passed to the VM backend *)
+
+  val get_stop_mode : t -> vm_uuid:Uuidm.t -> Vm_stop_mode.t Lwt.t
+  (** Get VM stop mode *)
+
+  val set_stop_mode : t -> vm_uuid:Uuidm.t -> Vm_stop_mode.t -> unit Lwt.t
+  (** Set VM stop mode *)
+
+  val get_start_timestamp : t -> vm_uuid:Uuidm.t -> float option Lwt.t
+  (** Get VM start timestamp *)
+
+  val set_start_timestamp : t -> vm_uuid:Uuidm.t -> float -> unit Lwt.t
+  (** Set VM start timestamp *)
+
+  val get_last_request_timestamp : t -> vm_uuid:Uuidm.t -> dns_name:Dns.Name.t -> float option Lwt.t
+  (** Get timestamp for last DNS request to VM/DNS name pair *)
+
+  val set_last_request_timestamp : t -> vm_uuid:Uuidm.t -> dns_name:Dns.Name.t -> float -> unit Lwt.t
+  (** Set timestamp for last DNS request to VM/DNS name pair *)
+
+  val get_total_starts : t -> vm_uuid:Uuidm.t -> int Lwt.t
+  (** Get total number of times the VM has been started *)
+
+  val inc_total_starts : t -> vm_uuid:Uuidm.t -> unit Lwt.t
+  (** Increment the number of times the VM has been started *)
+
+  val get_response_delay : t -> vm_uuid:Uuidm.t -> float Lwt.t
+  (** Get additional delay to add to the DNS response for a VM *)
+
+  val set_response_delay : t -> vm_uuid:Uuidm.t -> float -> unit Lwt.t
+  (** Set additional delay to add to DNS response for a VM *)
+
+  val get_total_requests : t -> vm_uuid:Uuidm.t -> dns_name:Dns.Name.t -> int Lwt.t
+  (** Get total requests to a VM/DNS name pair *)
+
+  val inc_total_requests : t -> vm_uuid:Uuidm.t -> dns_name:Dns.Name.t -> unit Lwt.t
+  (** Increment total requests to a VM/DNS name pair *)
+
+  val get_ttl : t -> vm_uuid:Uuidm.t -> dns_name:Dns.Name.t -> int Lwt.t
+  (** Get DNS TTL for a VM/DNS name pair *)
+
+  val set_ttl : t -> vm_uuid:Uuidm.t -> dns_name:Dns.Name.t -> int -> unit Lwt.t
+  (** Set DNS TTL for a VM/DNS name pair *)
+
+  val get_ip : t -> vm_uuid:Uuidm.t -> Ipaddr.V4.t option Lwt.t
+  (** Get VM IP *)
+
+  val set_ip : t -> vm_uuid:Uuidm.t -> Ipaddr.V4.t -> unit Lwt.t
+  (** Set VM IP *)
+
+  val get_wait_for_key : t -> vm_uuid:Uuidm.t -> string option Lwt.t
+  (** Get key to wait for in Xenstore before returning DNS response *)
+
+  val get_use_synjitsu : t -> vm_uuid:Uuidm.t -> bool Lwt.t
+  (** Get synjitsu mode *)
+
+  val get_vm_list : t -> Uuidm.t list Lwt.t
+  (** Get list of registered VMs *)
+
+  val get_vm_dns_name_list : t -> vm_uuid:Uuidm.t -> Dns.Name.t list Lwt.t
+  (** Get list of DNS names registered for a VM *)
+
+end