X-Git-Url: http://git.annexia.org/?p=virt-mem.git;a=blobdiff_plain;f=lib%2Fvirt_mem_types.ml;h=556a3c7be5f44110f0092e4a2d5338ec7cef151c;hp=34f3fe7a9176b6b83c8dd7680d372bc7a5694d3d;hb=a877867243635176be3dc7735520fdd9a4098e10;hpb=643e58b5e26c18f2cfc1c7b9aa676cb44feee847

diff --git a/lib/virt_mem_types.ml b/lib/virt_mem_types.ml
index 34f3fe7..556a3c7 100644
--- a/lib/virt_mem_types.ml
+++ b/lib/virt_mem_types.ml
@@ -20,38 +20,123 @@
    Common types.
  *)
 
-(** A kernel image. *)
-type image0 =
-    int option				(* Domain ID, if known. *)
-    * string				(* Domain name. *)
-    * Virt_mem_utils.architecture	(* Architecture, eg. i386. *)
-    * ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t (* Memory map. *)
-
-(** A kernel symbol. *)
+module D = Libvirt.Domain
+
+open Virt_mem_utils
+open Virt_mem_mmap
+
 type ksym = string
 
-(** A kernel image, after finding kernel symbols. *)
-type image1 =
-    int option				(* Domain ID, if known. *)
-    * string				(* Domain name. *)
-    * Virt_mem_utils.architecture	(* Architecture, eg. i386. *)
-    * ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t (* Memory map. *)
-    * (ksym -> Virt_mem_mmap.addr)	(* Kernel symbol lookup function. *)
-
-(** A kernel image, after finding kernel version (like 'uname'). *)
-type image2 =
-    int option				(* Domain ID, if known. *)
-    * string				(* Domain name. *)
-    * Virt_mem_utils.architecture	(* Architecture, eg. i386. *)
-    * ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t (* Memory map. *)
-    * (ksym -> Virt_mem_mmap.addr)	(* Kernel symbol lookup function. *)
-    * utsname option			(* Kernel version, etc., if known. *)
-
-and utsname = {
-  kernel_name : string;
-  nodename : string;
-  kernel_release : string;
-  kernel_version : string;
-  machine : string;
-  domainname : string;
+module Ksymmap = Map.Make (String)
+
+type ksymmap = addr Ksymmap.t
+
+type image = {
+  dom : Libvirt.ro D.t option;
+  domname : string;
+  arch : architecture;
+  mem : ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t;
+  kernel_min : addr;
+  kernel_max : addr;
 }
+
+type utsname = {
+  uts_kernel_name : string;
+  uts_nodename : string;
+  uts_kernel_release : string;
+  uts_kernel_version : string;
+  uts_machine : string;
+  uts_domainname : string;
+}
+
+type task = {
+  task_state : int64;
+  task_prio : int64;
+  task_normal_prio : int64;
+  task_static_prio : int64;
+  task_comm : string;
+  task_pid : int64;
+}
+
+type net_device = {
+  netdev_name : string;
+  netdev_dev_addr : string;
+}
+
+type kdata = {
+  ksyms : ksymmap option;
+  utsname : utsname option;
+  tasks : task list option;
+  net_devices : net_device list option;
+}
+
+exception ParseError of string * string * string
+
+type fieldsig = {
+  field_available : bool;
+  field_offset : int;
+}
+
+(* This is the maximum we can download in one go over the libvirt
+ * remote connection.
+ *
+ * XXX Should have a 'D.max_peek' function.
+ *)
+let max_memory_peek = 65536
+
+type load_memory_error =
+  | AddressOutOfRange
+  | DomIsNull
+
+exception LoadMemoryError of load_memory_error * string
+
+let _load_memory mem dom start size =
+  let str = String.create size in
+  let rec loop i =
+    let remaining = size - i in
+    if remaining > 0 then (
+      let size = min remaining max_memory_peek in
+      D.memory_peek dom [D.Virtual] (start +^ Int64.of_int i) size str i;
+      loop (i + size)
+    )
+  in
+  loop 0;
+
+  Virt_mem_mmap.add_string mem str start
+
+let load_static_memory ~dom ~domname ~arch ~wordsize ~endian
+    ~kernel_min ~kernel_max start size =
+  if start < kernel_min then
+    raise (LoadMemoryError (AddressOutOfRange,
+			    "load_memory: start < kernel_min"))
+  else if start +^ Int64.of_int size > kernel_max then
+    raise (LoadMemoryError (AddressOutOfRange,
+			    "load_memory: start+size > kernel_max"))
+  else (
+    let mem = Virt_mem_mmap.create () in
+    let mem = Virt_mem_mmap.set_wordsize mem wordsize in
+    let mem = Virt_mem_mmap.set_endian mem endian in
+
+    let mem = _load_memory mem dom start size in
+
+    { dom = Some dom; domname = domname; mem = mem; arch = arch;
+      kernel_min = kernel_min; kernel_max = kernel_max }
+  )
+
+let load_memory ({ dom = dom; mem = mem; kernel_min = kernel_min;
+		   kernel_max = kernel_max } as image) start size =
+  if start < kernel_min then
+    raise (LoadMemoryError (AddressOutOfRange,
+			    "load_memory: start < kernel_min"))
+  else if start +^ Int64.of_int size > kernel_max then
+    raise (LoadMemoryError (AddressOutOfRange,
+			    "load_memory: start+size > kernel_max"))
+  else if Virt_mem_mmap.is_mapped_range mem start size then image
+  else (
+    match dom with
+    | None ->
+	raise (LoadMemoryError (DomIsNull, "load_memory: dom = None"))
+    | Some dom ->
+	let mem = _load_memory mem dom start size in
+	{ image with mem = mem }
+  )