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 utsname = {
+ uts_kernel_name : string;
+ uts_nodename : string;
+ uts_kernel_release : string;
+ uts_kernel_version : string;
+ uts_machine : string;
+ uts_domainname : string;
}
+
+type kimage = {
+ dom : Libvirt.ro D.t option;
+ domname : string;
+ arch : architecture;
+ kernel_min : addr;
+ kernel_max : addr;
+ mem : ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t;
+ addrmap : Kernel.addrmap;
+ ksyms : ksymmap;
+ have_ksyms : bool;
+ have_kallsyms : bool;
+ utsname : utsname option;
+ have_tasks : bool;
+ have_net_devices : bool;
+}
+
+(* 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; arch = arch;
+ kernel_min = kernel_min; kernel_max = kernel_max;
+ mem = mem; addrmap = Kernel.AddrMap.empty;
+ ksyms = Ksymmap.empty; have_ksyms = false; have_kallsyms = false;
+ utsname = None;
+ have_tasks = false; have_net_devices = false }
+ )
+
+let load_memory ({ dom = dom; mem = mem; kernel_min = kernel_min;
+ kernel_max = kernel_max } as kimage) 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 kimage
+ else (
+ match dom with
+ | None ->
+ raise (LoadMemoryError (DomIsNull, "load_memory: dom = None"))
+ | Some dom ->
+ let mem = _load_memory mem dom start size in
+ { kimage with mem = mem }
+ )