diff options
| -rw-r--r-- | virt-ctrl/.depend | 4 | ||||
| -rw-r--r-- | virt-ctrl/vc_connections.ml | 63 | ||||
| -rw-r--r-- | virt-ctrl/vc_connections.mli | 4 | ||||
| -rw-r--r-- | virt-ctrl/vc_mainwindow.ml | 13 | ||||
| -rw-r--r-- | virt-ctrl/vc_mainwindow.mli | 2 | ||||
| -rw-r--r-- | virt-ctrl/virt_ctrl.ml | 1 |
6 files changed, 44 insertions, 43 deletions
diff --git a/virt-ctrl/.depend b/virt-ctrl/.depend index b8cd19e..fbef2c5 100644 --- a/virt-ctrl/.depend +++ b/virt-ctrl/.depend @@ -14,5 +14,5 @@ vc_mainwindow.cmo: vc_connections.cmi ../libvirt/libvirt.cmi \ vc_mainwindow.cmi vc_mainwindow.cmx: vc_connections.cmx ../libvirt/libvirt.cmx \ vc_mainwindow.cmi -virt_ctrl.cmo: vc_mainwindow.cmi vc_domain_ops.cmi vc_connections.cmi -virt_ctrl.cmx: vc_mainwindow.cmx vc_domain_ops.cmx vc_connections.cmx +virt_ctrl.cmo: vc_mainwindow.cmi vc_domain_ops.cmi +virt_ctrl.cmx: vc_mainwindow.cmx vc_domain_ops.cmx diff --git a/virt-ctrl/vc_connections.ml b/virt-ctrl/vc_connections.ml index c99b2c4..05024c5 100644 --- a/virt-ctrl/vc_connections.ml +++ b/virt-ctrl/vc_connections.ml @@ -43,22 +43,29 @@ let get_conns, add_conn, del_conn = in get_conns, add_conn, del_conn -(* The current state. This is used so that we can see changes that - * have happened and add or remove parts of the model. (Previously - * we used to recreate the whole model each time, but the problem - * with that is we "forget" things like the selection). - *) -type state = connection list -and connection = int (* connection ID *) * (active list * inactive list) -and active = int (* domain's ID *) -and inactive = string (* domain's name *) - (* Store the node_info and hostname for each connection, fetched * once just after we connect since these don't normally change. * Hash of connid -> (C.node_info, hostname option, uri) *) let static_conn_info = Hashtbl.create 13 +let open_connection uri = + (* If this fails, let the exception escape and be printed + * in the global exception handler. + *) + let conn = C.connect ~name:uri () in + + let node_info = C.get_node_info conn in + let hostname = + try Some (C.get_hostname conn) + with + | Libvirt.Not_supported "virConnectGetHostname" + | Libvirt.Virterror _ -> None in + + (* Add it to our list of connections. *) + let conn_id = add_conn conn in + Hashtbl.add static_conn_info conn_id (node_info, hostname, uri) + (* Stores the state and history for each domain. * Hash of (connid, domid) -> mutable domhistory structure. * We never delete entries in this hash table, which may be a problem @@ -92,6 +99,16 @@ let new_domhistory () = { let hist_max = 86400 (* max history stored, seconds *) let hist_rot = 3600 (* rotation of array when we hit max *) +(* The current state. This is used so that we can see changes that + * have happened and add or remove parts of the model. (Previously + * we used to recreate the whole model each time, but the problem + * with that is we "forget" things like the selection). + *) +type state = connection list +and connection = int (* connection ID *) * (active list * inactive list) +and active = int (* domain's ID *) +and inactive = string (* domain's name *) + (* The types of the display columns in the main window. The interesting * one of the final (int) field which stores the ID of the row, either * connid or domid. @@ -396,32 +413,6 @@ let make_treeview ?packing () = (tree, model, columns, state) -(* Callback function to open a connection. - * This should be a lot more sophisticated. XXX - *) -let open_connection () = - let title = "Open connection to hypervisor" in - let uri = - GToolbox.input_string ~title ~text:"xen:///" ~ok:"Open" "Connection:" in - match uri with - | None -> () - | Some uri -> - (* If this fails, let the exception escape and be printed - * in the global exception handler. - *) - let conn = C.connect ~name:uri () in - - let node_info = C.get_node_info conn in - let hostname = - try Some (C.get_hostname conn) - with - | Libvirt.Not_supported "virConnectGetHostname" - | Libvirt.Virterror _ -> None in - - (* Add it to our list of connections. *) - let conn_id = add_conn conn in - Hashtbl.add static_conn_info conn_id (node_info, hostname, uri) - (* Get historical data size. *) let get_hist_size connid domid = try diff --git a/virt-ctrl/vc_connections.mli b/virt-ctrl/vc_connections.mli index 22c40a1..261f853 100644 --- a/virt-ctrl/vc_connections.mli +++ b/virt-ctrl/vc_connections.mli @@ -45,8 +45,8 @@ val make_treeview : ?packing:(GObj.widget -> unit) -> unit -> GTree.view * GTree.tree_store * columns * state -(** This callback creates the Connect to hypervisor dialog. *) -val open_connection : unit -> unit +(** Open a new connection to the hypervisor URI given. *) +val open_connection : string -> unit (** Return the amount of historical data that we hold about a domain (in seconds). diff --git a/virt-ctrl/vc_mainwindow.ml b/virt-ctrl/vc_mainwindow.ml index b8ec4db..3ae9d7c 100644 --- a/virt-ctrl/vc_mainwindow.ml +++ b/virt-ctrl/vc_mainwindow.ml @@ -60,7 +60,18 @@ let () = icon#set_icon_size `DIALOG; GToolbox.message_box ~title ~icon label -let make ~open_connection +(* Open connection dialog. + * This should be a lot more sophisticated. XXX + *) +let open_connection () = + let title = "Open connection to hypervisor" in + let uri = + GToolbox.input_string ~title ~text:"xen:///" ~ok:"Open" "Connection:" in + match uri with + | None -> () + | Some uri -> Vc_connections.open_connection uri + +let make ~start_domain ~pause_domain ~resume_domain ~shutdown_domain ~open_domain_details = (* Create the main window. *) diff --git a/virt-ctrl/vc_mainwindow.mli b/virt-ctrl/vc_mainwindow.mli index 68843fb..39439e9 100644 --- a/virt-ctrl/vc_mainwindow.mli +++ b/virt-ctrl/vc_mainwindow.mli @@ -22,7 +22,7 @@ (** This function creates the main window. You have to pass in callback functions to wire everything up. *) -val make : open_connection:(unit -> unit) -> +val make : start_domain:Vc_domain_ops.dops_callback_fn -> pause_domain:Vc_domain_ops.dops_callback_fn -> resume_domain:Vc_domain_ops.dops_callback_fn -> diff --git a/virt-ctrl/virt_ctrl.ml b/virt-ctrl/virt_ctrl.ml index a9740c1..c7c4620 100644 --- a/virt-ctrl/virt_ctrl.ml +++ b/virt-ctrl/virt_ctrl.ml @@ -22,7 +22,6 @@ open Printf let () = (* Build the main window and wire up the buttons to the callback functions *) Vc_mainwindow.make - ~open_connection:Vc_connections.open_connection ~start_domain:Vc_domain_ops.start_domain ~pause_domain:Vc_domain_ops.pause_domain ~resume_domain:Vc_domain_ops.resume_domain |