X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=slave.ml;h=034bbdf77202b3cd6d59f94068c58fedbc17fd0d;hb=87a075aaada42182cd7047d110f83eaa8273b78d;hp=c12f9a33fc46965cf1549d50736082df19d1213d;hpb=3b2348f5f4b770e3e7f886d851eeadc59bbd2357;p=guestfs-browser.git diff --git a/slave.ml b/slave.ml index c12f9a3..034bbdf 100644 --- a/slave.ml +++ b/slave.ml @@ -47,6 +47,7 @@ type command = | Download_dir_tarball of source * string * download_dir_tarball_format * string * unit callback | Download_file of source * string * string * bool * unit callback | File_information of source * string * string callback + | List_applications of inspection_os * G.application array callback | Open_domain of string * inspection_data callback | Open_images of (string * string option) list * inspection_data callback | Read_directory of source * string * direntry list callback @@ -73,6 +74,8 @@ let rec string_of_command = function (string_of_source src) remotefile localfile check | File_information (src, pathname, _) -> sprintf "File_information (%s, %s)" (string_of_source src) pathname + | List_applications (os, _) -> + sprintf "List_applications %s" os.insp_root | Open_domain (name, _) -> sprintf "Open_domain %s" name | Open_images (images, _) -> sprintf "Open_images %s" (string_of_images images) @@ -165,6 +168,8 @@ let download_file_if_not_exist ?fail src remotefile localfile cb = send_to_slave ?fail (Download_file (src, remotefile, localfile, true, cb)) let file_information ?fail src pathname cb = send_to_slave ?fail (File_information (src, pathname, cb)) +let list_applications ?fail os cb = + send_to_slave ?fail (List_applications (os, cb)) let open_domain ?fail name cb = send_to_slave ?fail (Open_domain (name, cb)) let open_images ?fail images cb = send_to_slave ?fail (Open_images (images, cb)) let read_directory ?fail src path cb = @@ -338,6 +343,19 @@ and execute_command = function status "Finished calculating file information for %s" pathname; callback_if_not_discarded cb r + | List_applications (os, cb) -> + status "Listing applications ..."; + + let g = get_g () in + let r = + with_mount_ro g (OS os) ( + fun () -> + g#inspect_list_applications os.insp_root + ) in + + status "Finished listing applications"; + callback_if_not_discarded cb r + | Open_domain (name, cb) -> status "Opening %s ..." name; @@ -491,7 +509,7 @@ and open_disk_images images cb = ignore ( g#set_event_callback ( fun g event handle buf array -> - if event == G.EVENT_PROGRESS && Array.length array == 4 then ( + if event == G.EVENT_PROGRESS && Array.length array >= 4 then ( let proc_nr = array.(0) and serial = array.(1) and position = array.(2) @@ -531,6 +549,12 @@ and open_disk_images images cb = let oses = List.map ( fun root -> let typ = g#inspect_get_type root in + let windows_current_control_set = + if typ <> "windows" then None + else ( + try Some (g#inspect_get_windows_current_control_set root) + with G.Error _ -> None + ) in let windows_systemroot = if typ <> "windows" then None else ( @@ -546,6 +570,7 @@ and open_disk_images images cb = insp_root = root; insp_arch = g#inspect_get_arch root; insp_distro = g#inspect_get_distro root; + insp_drive_mappings = g#inspect_get_drive_mappings root; insp_filesystems = g#inspect_get_filesystems root; insp_hostname = g#inspect_get_hostname root; insp_major_version = g#inspect_get_major_version root; @@ -554,7 +579,9 @@ and open_disk_images images cb = insp_package_format = g#inspect_get_package_format root; insp_package_management = g#inspect_get_package_management root; insp_product_name = g#inspect_get_product_name root; + insp_product_variant = g#inspect_get_product_variant root; insp_type = typ; + insp_windows_current_control_set = windows_current_control_set; insp_windows_systemroot = windows_systemroot; insp_winreg_DEFAULT = None; (* incomplete, see below *) insp_winreg_SAM = None;