exception Vm_didnt_shutdown
exception Vm_is_already_created of int * vmlifestate
-let mntdir_path uuid = "/var/lib/xenvm/mnt-" ^ (Uuid.to_string uuid)
+let mntdir_path uuid = "/var/lib/xenvm/mnt-" ^ uuid
-let _notify cfg code l =
+let _notify state code l =
let fdopt =
- match cfg.notify with
+ match state.vm_cfg.notify with
| NotifyUnix path ->
let fd = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Unix.connect fd (Unix.ADDR_UNIX path);
| None -> ()
| Some fd ->
(* notification format is "<uuid>:<code>:<message>\n" *)
- let s = String.concat ":" (Uuid.to_string cfg.uuid :: string_of_int code :: l) ^ "\n" in
+ let s = String.concat ":" (state.vm_uuid :: string_of_int code :: l) ^ "\n" in
let (_: int) = Unix.write fd s 0 (String.length s) in
(* FIXME we might want to cache it later on .. and catch EBADF or ECONNRESET for reopen signal. *)
Unix.close fd
-let notify cfg code l =
+let notify state code l =
info "sending notification %s" (String.concat ":" l);
try
- _notify cfg code l
+ _notify state code l
with exn ->
warn "notify failed: %s" (Printexc.to_string exn)
let change_vmstate state newstate =
state.vm_lifestate <- newstate;
- notify state.vm_cfg Xenvmlib.code_vmstate [ "vm"; "state"; string_of_vmlifestate newstate ];
+ notify state Xenvmlib.code_vmstate [ "vm"; "state"; string_of_vmlifestate newstate ];
if newstate = VmShutdown then (
maybe (fun cfg -> state.vm_cfg <- cfg) state.vm_next_cfg
)
let create_vm xc xs state =
with_create_lock state (fun () ->
+ let uuid = Uuid.uuid_of_string state.vm_uuid in
if state.vm_domid <> -1 then (
- let uuid_exists = check_uuid_exists xc state.vm_cfg.uuid in
+ let uuid_exists = check_uuid_exists xc uuid in
if uuid_exists then
raise (Vm_is_already_created (state.vm_domid, state.vm_lifestate));
warn "internal error: domain was marked as existing but wasn't -- state corrected"
Domain.platformdata = state.vm_cfg.platform;
Domain.xsdata = [];
} in
- let domid = Domain.make ~xc ~xs info state.vm_cfg.uuid in
+ let domid = Domain.make ~xc ~xs info uuid in
state.vm_domid <- domid;
change_vmstate state VmCreated
)
let suspend xc xs state flags file =
match String.split ':' file with
| "xenserver" :: dev :: _ ->
- let mntpoint = mntdir_path state.vm_cfg.uuid in
+ let mntpoint = mntdir_path state.vm_uuid in
Misc.create_ext3fs_on dev;
(* mount dev to some mkdir'ed tmp directory *)
Misc.with_mounted_fs dev mntpoint (fun () ->
let restore xc xs state delete file =
match String.split ':' file with
| "xenserver" :: dev :: _ ->
- let mntpoint = mntdir_path state.vm_cfg.uuid in
+ let mntpoint = mntdir_path state.vm_uuid in
Misc.with_mounted_fs dev mntpoint (fun () ->
restore_from_file xc xs state (mntpoint ^ "/suspend-image")
)
Xenvmlib.Ok
in
let nic_add args =
- let nic = Config.config_nic_of_string cfg.uuid (List.hd args) in
+ let nic = Config.config_nic_of_string state.vm_uuid (List.hd args) in
add_nic_to_vm ~xs state nic;
Xenvmlib.Ok
in
}
type config = {
- uuid: [ `domain ] Uuid.t;
+ __uuid: string option; (* do not use anymore *)
name: string option;
verbose: bool;
debug: bool;
let vector =
(if nic_id = -1 then [] else [ string_of_int nic_id ]) @
(match nic_model with None -> [] | Some x -> [ x ]) @
- [ Uuid.string_of_uuid vm_uuid ]
+ [ vm_uuid ]
in
let digest = Digest.to_hex (Digest.string (String.concat " " vector)) in
let hexs = List.map (fun i -> s_of_c digest.[i] digest.[i + 12]) [ 0; 2; 1; 7; 6; 4 ] in
| "inject-sci" -> { cfg with inject_sci = int_of_string value }
| _ -> raise (Unknown_field field)
-let of_file error_report file =
- let hvm = ref false
- and debug = ref false
- and verbose = ref false
- and no_mem_check = ref false
+let empty =
+ {
+ __uuid = None;
+ name = None;
+ debug = false;
+ verbose = false;
+ no_mem_check = false;
+ output = "";
+ startup = StartupStart;
+ hvm = false;
+ kernel = "";
+ cmdline = "";
+ serial = "";
+ initrd = None;
+ memory = -1L;
+ vcpus = 1;
+ pae = false;
+ acpi = false;
+ apic = false;
+ nx = false;
+ smbios_pt = false;
+ acpi_pt = false;
+ diskinfo_pt = false;
+ viridian = false;
+ videoram = None;
+ on_halt = ActionDestroy;
+ on_restart = ActionRestart;
+ on_crash = ActionDestroy;
+ disks = [];
+ nics = [];
+ pcis = [];
+ boot = "cd";
+ vnc = 0;
+ vnc_keymap = "en-us";
+ cpuid = [];
+ datadir = "";
+ platform = [];
+ extrahvm = [];
+ notify = NotifyNone;
+ daemonize = false;
+ power_management = 0;
+ oem_features = 0;
+ timer_mode = None;
+ timeoffset = None;
+ hpet = None;
+ vpt_align = None;
+ snapshot_mode = NoSnapshot;
+ extra_local_watches = [];
+ extra_vm_watches = [];
+ global_pci_msitranslate = 0;
+ global_pci_power_mgmt = 0;
+ sound = None;
+ inject_sci = 0;
+ }
+
+let of_file uuid error_report file =
+ let hvm = ref empty.hvm
+ and debug = ref empty.debug
+ and verbose = ref empty.verbose
+ and no_mem_check = ref empty.no_mem_check
and output = ref ""
and kernel = ref ""
and cmdline = ref ""
and boot = ref "cd"
and vnc = ref 0
and vnc_keymap = ref "en-us"
- and uuid = ref (Uuid.make_uuid ())
+ and __uuid = ref None
and name = ref ""
and cpuid = ref []
and startup = ref StartupStart
in
let set_nic s =
try
- let nic = config_nic_of_string !uuid s in
+ let nic = config_nic_of_string uuid s in
nics := nic :: !nics;
with exn ->
eprintf "error: vif config: %s\n%!"
("output", Config.Set_string output);
("verbose", Config.Set_bool verbose);
("name", Config.Set_string name);
- ("uuid", Config.String (fun s ->
- if String.length s = 36 then
- uuid := Uuid.of_string s
- else
- eprintf "uuid format problem -- ignoring\n%!"));
+ ("uuid", Config.String (fun s -> __uuid := Some s));
("kernel", Config.Set_string kernel);
("cmdline", Config.Set_string cmdline);
("serial", Config.Set_string serial);
if !memory = -1 then
failwith "you need to set memory";
{
- uuid = !uuid;
+ __uuid = !__uuid;
name = string_option_of_string !name;
debug = !debug;
verbose = !verbose;
sound = !sound;
inject_sci = !inject_sci;
}
+
+
end
}
type vm_state = {
+ vm_uuid: string;
mutable vm_config_path: string;
mutable vm_arch: Domain.domarch;
mutable vm_domid: int;
locks: locks;
}
-let state_init config_path cfg =
+let state_init uuid config_path cfg =
{
+ vm_uuid = uuid;
vm_config_path = config_path;
vm_arch = if cfg.hvm then Domain.Arch_HVM else Domain.Arch_native;
vm_domid = (-1);
let open_monitor_socket uuid name =
Unixext.mkdir_rec "/var/lib/xenvm" 0o640;
- let filename = sprintf "/var/lib/xenvm/vm-%s" (Uuid.to_string uuid) in
+ let filename = sprintf "/var/lib/xenvm/vm-%s" uuid in
bind_unix_socket filename 10, filename
let close_monitor_socket socket filename = Unix.close socket; Unixext.unlink_safe filename; ()
let check_vm uuid =
let is_running =
try
- let reply = Xenvmlib.request ~timeout:10. (Uuid.to_string uuid) ("status", []) in
+ let reply = Xenvmlib.request ~timeout:10. uuid ("status", []) in
begin match reply with
| Xenvmlib.Msg _ -> ()
| _ -> ()
info "VM is already handled by another xenvm";
exit 1;
);
- let path = Xenvmlib.path_of_socket (Uuid.to_string uuid) in
+ let path = Xenvmlib.path_of_socket uuid in
if Sys.file_exists path then (
info "stale socket left by previous xenvm. removing";
Unixext.unlink_safe path
);
with_xc (fun xc ->
- let domid = Vmact.domid_of_uuid xc uuid in
+ let domid = Vmact.domid_of_uuid xc (Uuid.uuid_of_string uuid) in
match domid with
| Some domid ->
info "domain still present at domid=%d. exiting" domid;
let callback_introduce ctx id =
let xc = Xal.xc_of_ctx ctx in
try
- if Domain.get_uuid ~xc id = state.vm_cfg.uuid then
+ if Uuid.to_string (Domain.get_uuid ~xc id) = state.vm_uuid then
state.vm_domid <- id
with Xc.Error _ -> ()
and callback_release ctx id =
info "domain died asynchronously: %s" (Xal.string_of_died_reason reason);
let action = match reason with
| Xal.Crashed ->
- Vmact.notify state.vm_cfg Xenvmlib.code_error [ "error"; "crashed" ];
+ Vmact.notify state Xenvmlib.code_error [ "error"; "crashed" ];
state.vm_cfg.on_crash
| Xal.Vanished -> ActionPreserve
| Xal.Halted -> state.vm_cfg.on_halt
)
in
let change_rtc uuid data =
- if uuid = (Uuid.to_string state.vm_cfg.uuid) then
- Vmact.notify state.vm_cfg Xenvmlib.code_vmset [ "rtc"; data ];
+ if uuid = state.vm_uuid then
+ Vmact.notify state Xenvmlib.code_vmset [ "rtc"; data ];
in
let extra_notification uuid node value =
(* either we are because it's a domain extra event in this case we
have a null uuid or in vm event we're suppose to get the vm's uuid *)
- if uuid = "" || uuid = (Uuid.to_string state.vm_cfg.uuid) then (
+ if uuid = "" || uuid = state.vm_uuid then (
let data = node :: match value with None -> [] | Some d -> [ d ] in
- Vmact.notify state.vm_cfg Xenvmlib.code_vmtrigger data
+ Vmact.notify state Xenvmlib.code_vmtrigger data
)
in
if state.vm_domid = id then (
| None -> state.vm_config_path
| Some path -> path
in
- let cfg = Config.of_file (fun errors -> () ) path in
+ let cfg = Config.of_file state.vm_uuid (fun errors -> ()) path in
state.vm_next_cfg <- Some cfg
let do_task quit state (task, args) =
*********)
let main state =
- let socket, name = open_monitor_socket state.vm_cfg.uuid state.vm_cfg.name in
+ let socket, name = open_monitor_socket state.vm_uuid state.vm_cfg.name in
- Vmact.notify state.vm_cfg Xenvmlib.code_ping [ "ping" ];
+ Vmact.notify state Xenvmlib.code_ping [ "ping" ];
finally (fun () ->
try
(* start the domain *)
| StartupPause | StartupStart ->
with_xcs (fun xc xs -> Vmact.start_vm xc xs state);
if state.vm_cfg.verbose then (
- info "started domain: %s" (Uuid.to_string state.vm_cfg.uuid);
+ info "started domain: %s" state.vm_uuid;
);
| StartupRestore (file, del) ->
Unixext.with_file (with_datadir state.vm_cfg file) [ Unix.O_RDONLY ] 0o640 (fun fd ->
try Sys.remove file with _ -> ()
);
if state.vm_cfg.verbose then (
- info "resumed domain: %s" (Uuid.to_string state.vm_cfg.uuid);
+ info "resumed domain: %s" state.vm_uuid;
);
);
monitor socket state;
with exn ->
let exnstr = string_of_exn exn in
error "fatal exception: %s" exnstr;
- Vmact.notify state.vm_cfg Xenvmlib.code_error [ "error"; exnstr ];
+ Vmact.notify state Xenvmlib.code_error [ "error"; exnstr ];
raise exn
) (fun () ->
- Vmact.notify state.vm_cfg Xenvmlib.code_hup [ "hup" ];
+ Vmact.notify state Xenvmlib.code_hup [ "hup" ];
close_monitor_socket socket name
)
config := List.hd !anon;
);
- if !config = "" then (
- eprintf "usage: %s <config>\n" Sys.argv.(0);
- exit 2
- );
-
Random.self_init ();
let error_report errs =
config_errors := errors_str;
in
- let cfg = Config.of_file error_report !config in
+ let uuid, state =
+ match !uuid, !config with
+ | "", "" ->
+ eprintf "error: you need to specify a uuid or a config file\n";
+ exit 3;
+ | "", configfile ->
+ let cfg = Config.of_file !uuid error_report configfile in
+ let uuid =
+ match cfg.__uuid with
+ | None -> eprintf "error: you need to specify a uuid in your config file\n"; exit 3;
+ | Some uuid -> uuid
+ in
+ (* reparse the config for things that are dependents of the uuid *)
+ let cfg = Config.of_file uuid error_report configfile in
+ verify_config cfg;
+ uuid, (state_init uuid configfile cfg)
+ | uuid, "" ->
+ uuid, (state_init uuid "" Config.empty)
+ | uuid, configfile ->
+ let cfg = Config.of_file uuid error_report configfile in
+ verify_config cfg;
+ uuid, (state_init uuid configfile cfg)
+ in
- verify_config cfg;
+ (*
+ if uuid = "" && cfg.__uuid !config = "" then (
+ eprintf "error: you need to specify a uuid or a config\n";
+ exit 2
+ );
+ *)
if !daemonize then
Unixext.daemonize ();
- if cfg.debug then (
+ if state.vm_cfg.debug then (
let a =
- if cfg.output = "" then
- sprintf "file:/tmp/xenvm-debug-%s" (Uuid.to_string cfg.uuid)
+ if state.vm_cfg.output = "" then
+ sprintf "file:/tmp/xenvm-debug-%s" uuid
else
- "file:/" ^ cfg.output
+ "file:/" ^ state.vm_cfg.output
in
Logs.set_default Log.Debug [ a ];
Logs.set_default Log.Info [ a ];
List.iter (fun s -> warn "%s" s) !config_errors
);
- let state = state_init !config cfg in
- check_vm cfg.uuid;
+ check_vm uuid;
main state
projects / xenclient / toolstack.git / commitdiff