filetree_markup.cmi: slave_types.cmi
filetree_markup.cmo: utils.cmi slave_types.cmi filetree_markup.cmi
filetree_markup.cmx: utils.cmx slave_types.cmx filetree_markup.cmi
-main.cmo: window.cmi utils.cmi slave.cmi op_view_file.cmi op_inspection_dialog.cmi op_file_information.cmi op_download_file.cmi op_download_dir_tarball.cmi op_download_dir_find0.cmi op_download_as_reg.cmi op_disk_usage.cmi op_copy_regvalue.cmi op_checksum_file.cmi menu_open_uri.cmi menu_open_disk.cmi menu_about.cmi config.cmi cmdline.cmi
-main.cmx: window.cmx utils.cmx slave.cmx op_view_file.cmx op_inspection_dialog.cmx op_file_information.cmx op_download_file.cmx op_download_dir_tarball.cmx op_download_dir_find0.cmx op_download_as_reg.cmx op_disk_usage.cmx op_copy_regvalue.cmx op_checksum_file.cmx menu_open_uri.cmx menu_open_disk.cmx menu_about.cmx config.cmx cmdline.cmx
+main.cmo: window.cmi utils.cmi slave.cmi op_view_file.cmi op_inspection_dialog.cmi op_file_properties.cmi op_file_information.cmi op_download_file.cmi op_download_dir_tarball.cmi op_download_dir_find0.cmi op_download_as_reg.cmi op_disk_usage.cmi op_copy_regvalue.cmi op_checksum_file.cmi menu_open_uri.cmi menu_open_disk.cmi menu_about.cmi config.cmi cmdline.cmi
+main.cmx: window.cmx utils.cmx slave.cmx op_view_file.cmx op_inspection_dialog.cmx op_file_properties.cmx op_file_information.cmx op_download_file.cmx op_download_dir_tarball.cmx op_download_dir_find0.cmx op_download_as_reg.cmx op_disk_usage.cmx op_copy_regvalue.cmx op_checksum_file.cmx menu_open_uri.cmx menu_open_disk.cmx menu_about.cmx config.cmx cmdline.cmx
menu_about.cmi: window.cmi
menu_about.cmo: utils.cmi config.cmi menu_about.cmi
menu_about.cmx: utils.cmx config.cmx menu_about.cmi
op_file_information.cmi: filetree.cmi
op_file_information.cmo: utils.cmi slave.cmi op_file_information.cmi
op_file_information.cmx: utils.cmx slave.cmx op_file_information.cmi
+op_file_properties.cmi: filetree.cmi
+op_file_properties.cmo: utils.cmi slave_types.cmi slave.cmi op_file_properties.cmi
+op_file_properties.cmx: utils.cmx slave_types.cmx slave.cmx op_file_properties.cmi
op_inspection_dialog.cmi: slave_types.cmi filetree.cmi
op_inspection_dialog.cmo: utils.cmi slave_types.cmi slave.cmi op_inspection_dialog.cmi
op_inspection_dialog.cmx: utils.cmx slave_types.cmx slave.cmx op_inspection_dialog.cmi
op_download_file.ml \
op_file_information.mli \
op_file_information.ml \
+ op_file_properties.mli \
+ op_file_properties.ml \
op_inspection_dialog.mli \
op_inspection_dialog.ml \
op_view_file.mli \
op_download_dir_tarball.cmo \
op_download_file.cmo \
op_file_information.cmo \
+ op_file_properties.cmo \
op_inspection_dialog.cmo \
op_view_file.cmo \
menu_open_uri.cmo \
* (ie. GtkTreeView).
*)
class tree ?packing () =
- let clear_tree = new GUtil.signal () in
- let op_checksum_file = new GUtil.signal () in
- let op_copy_regvalue = new GUtil.signal () in
- let op_disk_usage = new GUtil.signal () in
- let op_download_as_reg = new GUtil.signal () in
- let op_download_dir_find0 = new GUtil.signal () in
- let op_download_dir_tarball = new GUtil.signal () in
- let op_download_file = new GUtil.signal () in
- let op_file_information = new GUtil.signal () in
- let op_inspection_dialog = new GUtil.signal () in
- let op_view_file = new GUtil.signal () in
-
let view = GTree.view ?packing () in
(*view#set_rules_hint true;*)
(*view#selection#set_mode `MULTIPLE; -- add this later *)
(* Create the model. *)
let model = GTree.tree_store cols in
+ (* Signals. *)
+ let clear_tree = new GUtil.signal () in
+ let op_checksum_file = new GUtil.signal () in
+ let op_copy_regvalue = new GUtil.signal () in
+ let op_disk_usage = new GUtil.signal () in
+ let op_download_as_reg = new GUtil.signal () in
+ let op_download_dir_find0 = new GUtil.signal () in
+ let op_download_dir_tarball = new GUtil.signal () in
+ let op_download_file = new GUtil.signal () in
+ let op_file_information = new GUtil.signal () in
+ let op_file_properties = new GUtil.signal () in
+ let op_inspection_dialog = new GUtil.signal () in
+ let op_view_file = new GUtil.signal () in
+
object (self)
inherit GTree.view view#as_tree_view
inherit GUtil.ml_signals [clear_tree#disconnect;
op_download_dir_tarball#disconnect;
op_download_file#disconnect;
op_file_information#disconnect;
+ op_file_properties#disconnect;
op_inspection_dialog#disconnect;
op_view_file#disconnect]
+ (* Signals. *)
+ method clear_tree : callback:(unit -> unit) -> GtkSignal.id =
+ clear_tree#connect ~after
+ method op_checksum_file = op_checksum_file#connect ~after
+ method op_copy_regvalue = op_copy_regvalue#connect ~after
+ method op_disk_usage = op_disk_usage#connect ~after
+ method op_download_as_reg = op_download_as_reg#connect ~after
+ method op_download_dir_find0 = op_download_dir_find0#connect ~after
+ method op_download_dir_tarball = op_download_dir_tarball#connect ~after
+ method op_download_file = op_download_file#connect ~after
+ method op_file_information = op_file_information#connect ~after
+ method op_file_properties = op_file_properties#connect ~after
+ method op_inspection_dialog = op_inspection_dialog#connect ~after
+ method op_view_file = op_view_file#connect ~after
+
initializer
(* Open a context menu when a button is pressed. *)
ignore (view#event#connect#button_press ~callback:self#button_press);
in
loop []
- (* Signals. *)
- method clear_tree : callback:(unit -> unit) -> GtkSignal.id =
- clear_tree#connect ~after
- method op_checksum_file = op_checksum_file#connect ~after
- method op_copy_regvalue = op_copy_regvalue#connect ~after
- method op_disk_usage = op_disk_usage#connect ~after
- method op_download_as_reg = op_download_as_reg#connect ~after
- method op_download_dir_find0 = op_download_dir_find0#connect ~after
- method op_download_dir_tarball = op_download_dir_tarball#connect ~after
- method op_download_file = op_download_file#connect ~after
- method op_file_information = op_file_information#connect ~after
- method op_inspection_dialog = op_inspection_dialog#connect ~after
- method op_view_file = op_view_file#connect ~after
-
(* Handle mouse button press on the selected row. This opens the
* pop-up context menu.
* http://scentric.net/tutorial/sec-selections-context-menus.html
let item = factory#add_item "Download ..." in
ignore (item#connect#activate
~callback:(fun () -> op_download_file#call path));
+ ignore (factory#add_separator ());
+ let item = factory#add_item "Properties ..." in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_file_properties#call path))
and add_directory_items path =
let item = factory#add_item "Directory information" in
let item = factory#add_item "Download list of filenames ..." in
ignore (item#connect#activate
~callback:(fun () -> op_download_dir_find0#call path));
+ ignore (factory#add_separator ());
+ let item = factory#add_item "Properties ..." in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_file_properties#call path))
and add_top_os_items os path =
let item = factory#add_item "Operating system information ..." in
| { content=RegKey _ }, _ -> assert false
| { content=RegValue _ }, _ -> assert false
+ method get_direntry row =
+ let hdata = self#get_hdata row in
+ match hdata with
+ | { content=Directory direntry}
+ | { content=File direntry} -> direntry
+ | _ -> assert false
+
(* Search up to the top of the tree from a registry key.
*
* The path up the tree will always look something like:
Don't use this on registry entries. Use {!get_registry_path}
instead. *)
+ method get_direntry : Gtk.tree_iter -> Slave_types.direntry
+ (** [get_direntry row] returns the file and stat information for a
+ file or directory. *)
+
method get_registry_path : Gtk.tree_iter -> registry_t * string list
(** Use [get_registry_path row] on a [row] representing a registry
entry. It searches back up the tree and returns a tuple
callback:(Gtk.tree_path -> unit) -> GtkSignal.id
method op_file_information :
callback:(Gtk.tree_path -> unit) -> GtkSignal.id
+ method op_file_properties :
+ callback:(Gtk.tree_path -> unit) -> GtkSignal.id
method op_inspection_dialog :
callback:(Slave_types.inspection_os -> unit) -> GtkSignal.id
method op_view_file :
(* Mark up mode. *)
let markup_of_mode mode =
- let c =
- if is_socket mode then 's'
- else if is_symlink mode then 'l'
- else if is_regular_file mode then '-'
- else if is_block mode then 'b'
- else if is_directory mode then 'd'
- else if is_char mode then 'c'
- else if is_fifo mode then 'p' else '?' in
- let ru = if is_ru mode then 'r' else '-' in
- let wu = if is_wu mode then 'w' else '-' in
- let xu = if is_xu mode then 'x' else '-' in
- let rg = if is_rg mode then 'r' else '-' in
- let wg = if is_wg mode then 'w' else '-' in
- let xg = if is_xg mode then 'x' else '-' in
- let ro = if is_ro mode then 'r' else '-' in
- let wo = if is_wo mode then 'w' else '-' in
- let xo = if is_xo mode then 'x' else '-' in
- let str = sprintf "%c%c%c%c%c%c%c%c%c%c" c ru wu xu rg wg xg ro wo xo in
-
- let suid = is_suid mode in
- let sgid = is_sgid mode in
- let svtx = is_svtx mode in
- if suid then str.[3] <- 's';
- if sgid then str.[6] <- 's';
- if svtx then str.[9] <- 't';
-
+ let str = file_permissions_string mode in
"<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
(* Mark up dates. *)
~callback:(Op_download_file.download_file tree));
ignore (tree#op_file_information
~callback:(Op_file_information.file_information tree));
+ ignore (tree#op_file_properties
+ ~callback:(Op_file_properties.file_properties tree));
ignore (tree#op_inspection_dialog
~callback:(Op_inspection_dialog.inspection_dialog tree));
ignore (tree#op_view_file
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Slave_types
+open Utils
+
+open Printf
+
+(* I'd like to open CalendarLib but unfortunately it contains a
+ * submodule also called Utils, which clashes with our module.
+ *)
+module CL = CalendarLib
+module G = Guestfs
+
+let rec file_properties tree path =
+ let model = tree#model in
+ let row = model#get_iter path in
+ let src, pathname = tree#get_pathname row in
+
+ debug "file properties dialog %s" pathname;
+
+ let title = "File properties" in
+ let d = GWindow.dialog ~width:400 ~height:600 ~title () in
+ let nb = GPack.notebook ~packing:d#vbox#add () in
+
+ let dent = tree#get_direntry row in
+ let stat = dent.dent_stat in
+ let mode = stat.G.mode in
+
+ let filetype =
+ if is_socket mode then "Socket"
+ else if is_symlink mode then "Symbolic link"
+ else if is_regular_file mode then "File"
+ else if is_block mode then "Block device"
+ else if is_directory mode then "Directory"
+ else if is_char mode then "Character device"
+ else if is_fifo mode then "Pipe"
+ else "Unknown" in
+
+ (* Fill in the basic information. *)
+ let vbox = tab filetype nb in
+ let tbl = GPack.table ~columns:4 ~rows:1 ~packing:vbox#add () in
+ tbl#set_col_spacings 8;
+ tbl#set_row_spacings 8;
+
+ wide tbl 0 "Name: " dent.dent_name;
+ wide tbl 1 "" pathname;
+ wide tbl 2 "Size: " (sprintf "%Ld bytes" stat.G.size);
+ wide tbl 3 "" (human_size stat.G.size);
+ simple tbl 4 0 "Type: " filetype;
+ if is_block mode || is_char mode then
+ simple tbl 4 2 "Device: " (sprintf "0x%Lx" stat.G.rdev)
+ else if is_symlink mode then
+ simple tbl 4 2 "Link: " dent.dent_link;
+ simple tbl 5 0 "UID: " (Int64.to_string stat.G.uid);
+ simple tbl 5 2 "GID: " (Int64.to_string stat.G.gid);
+
+ wide tbl 6 "" (file_permissions_string mode);
+
+ simple tbl 7 0 "Perms: " (sprintf "0%Lo" (mode &^ 0o777L));
+ simple tbl 7 2 "Sticky bit: " (if is_svtx mode then "yes" else "no");
+ simple tbl 8 0 "Setuid bit: " (if is_suid mode then "yes" else "no");
+ simple tbl 8 2 "Setgid bit: " (if is_sgid mode then "yes" else "no");
+
+ wide2 tbl 9 "Last access: " (display_time stat.G.atime);
+ wide2 tbl 10 "Last modification: " (display_time stat.G.mtime);
+ wide2 tbl 11 "Last status change: " (display_time stat.G.ctime);
+
+ (* Extended attrs. *)
+ let vbox = tab "Extended attrs" nb in
+ xattrs_view ~packing:vbox#add src pathname;
+
+ (* Make sure dialog is destroyed when the tree is cleared. *)
+ let sigid =
+ tree#clear_tree ~callback:(
+ fun () ->
+ debug "inspection clear_tree -> destroy dialog";
+ d#destroy ()
+ ) in
+
+ let destroy_dialog () =
+ tree#disconnect sigid;
+ d#destroy ()
+ in
+
+ (* Add a close button. *)
+ let close_button = GButton.button ~label:"Close"
+ ~packing:d#action_area#add () in
+ ignore (close_button#connect#clicked ~callback:destroy_dialog);
+
+ (* Destroy dialog when WM close button is pressed. *)
+ ignore (d#connect#destroy ~callback:destroy_dialog);
+
+ d#show ()
+
+(* Helper functions. *)
+and tab text nb =
+ let vbox = GPack.vbox ~border_width:8 () in
+ let tab_label = (GMisc.label ~text () :> GObj.widget) in
+ ignore (nb#append_page ~tab_label (vbox :> GObj.widget));
+ vbox
+
+and simple tbl top left label text =
+ let markup = sprintf "<b>%s</b>" (markup_escape text) in
+ ignore (GMisc.label ~xalign:1. ~text:label
+ ~packing:(tbl#attach ~top ~left) ());
+ let left = left + 1 in
+ ignore (GMisc.label ~xalign:0. ~markup ~packing:(tbl#attach ~top ~left) ());
+
+and wide tbl top label text =
+ let markup = sprintf "<b>%s</b>" (markup_escape text) in
+ ignore (GMisc.label ~xalign:1.
+ ~text:label ~packing:(tbl#attach ~top ~left:0) ());
+ ignore (GMisc.label ~xalign:0.
+ ~markup ~packing:(tbl#attach ~top ~left:1 ~right:4) ());
+
+and wide2 tbl top label text =
+ let markup = sprintf "<b>%s</b>" (markup_escape text) in
+ ignore (GMisc.label ~xalign:1.
+ ~text:label ~packing:(tbl#attach ~top ~left:0 ~right:2) ());
+ ignore (GMisc.label ~xalign:0.
+ ~markup ~packing:(tbl#attach ~top ~left:2 ~right:4) ());
+
+and display_time t =
+ let t = Int64.to_float t in
+ let cal = CL.Calendar.from_unixfloat t in
+ let cal = CL.Calendar.convert cal CL.Time_Zone.UTC CL.Time_Zone.Local in
+ CL.Printer.Calendar.to_string cal
+
+(* Extended attrs: loaded on demand. *)
+and xattrs_view ?packing src pathname =
+ let cols = new GTree.column_list in
+ let name_col = cols#add Gobject.Data.string in
+ let value_col = cols#add Gobject.Data.string in
+
+ let model = GTree.list_store cols in
+
+ let sw =
+ GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
+
+ let view = GTree.view ~model ~packing:sw#add () in
+ view#selection#set_mode `NONE;
+
+ let renderer = GTree.cell_renderer_text [], ["text", name_col] in
+ let vc = GTree.view_column ~title:"Name" ~renderer () in
+ vc#set_resizable true;
+ ignore (view#append_column vc);
+ let renderer = GTree.cell_renderer_text [], ["text", value_col] in
+ let vc = GTree.view_column ~title:"Value" ~renderer () in
+ vc#set_resizable true;
+ ignore (view#append_column vc);
+
+ Slave.file_xattrs src pathname
+ (when_xattrs_loaded model name_col value_col)
+
+and when_xattrs_loaded model name_col value_col xattrs =
+ Array.iter (
+ fun { G.attrname = name; attrval = value } ->
+ let value = sprintf "%S" value in (* OCaml string escaping *)
+ let row = model#append () in
+ model#set ~row ~column:name_col name;
+ model#set ~row ~column:value_col value
+ ) xattrs
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** Display the file properties dialog. *)
+
+val file_properties : Filetree.tree -> Gtk.tree_path -> unit
| 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
+ | File_xattrs of source * string * G.xattr array 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
(string_of_source src) remotefile localfile check
| File_information (src, pathname, _) ->
sprintf "File_information (%s, %s)" (string_of_source src) pathname
+ | File_xattrs (src, pathname, _) ->
+ sprintf "File_xattrs (%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
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 file_xattrs ?fail src pathname cb =
+ send_to_slave ?fail (File_xattrs (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))
status "Finished calculating file information for %s" pathname;
callback_if_not_discarded cb r
+ | File_xattrs (src, pathname, cb) ->
+ status "Getting file xattrs for %s ..." pathname;
+
+ let g = get_g () in
+ let r =
+ with_mount_ro g src (
+ fun () ->
+ g#getxattrs pathname
+ ) in
+
+ status "Finished calculating file information for %s" pathname;
+ callback_if_not_discarded cb r
+
| List_applications (os, cb) ->
status "Listing applications ...";
(** [file_information src pathname cb] calculates the file
information of the file [pathname]. *)
+val file_xattrs : ?fail:exn callback -> Slave_types.source -> string -> Guestfs.xattr array callback -> unit
+ (** [file_xattrs src pathname cb] returns the extended
+ attributes of the file [pathname]. *)
+
val list_applications : ?fail:exn callback -> Slave_types.inspection_os -> Guestfs.application array callback -> unit
(** [list_applications os cb] lists the applications in the
guest using libguestfs inspection. *)
let (-^) = Int64.sub
let ( *^ ) = Int64.mul
let (/^) = Int64.div
+let (&^) = Int64.logand
type ('a, 'b) either = Left of 'a | Right of 'b
and test_bit mask mode = Int64.logand mode mask = mask
+let file_permissions_string mode =
+ let c =
+ if is_socket mode then 's'
+ else if is_symlink mode then 'l'
+ else if is_regular_file mode then '-'
+ else if is_block mode then 'b'
+ else if is_directory mode then 'd'
+ else if is_char mode then 'c'
+ else if is_fifo mode then 'p' else '?' in
+ let ru = if is_ru mode then 'r' else '-' in
+ let wu = if is_wu mode then 'w' else '-' in
+ let xu = if is_xu mode then 'x' else '-' in
+ let rg = if is_rg mode then 'r' else '-' in
+ let wg = if is_wg mode then 'w' else '-' in
+ let xg = if is_xg mode then 'x' else '-' in
+ let ro = if is_ro mode then 'r' else '-' in
+ let wo = if is_wo mode then 'w' else '-' in
+ let xo = if is_xo mode then 'x' else '-' in
+ let str = sprintf "%c%c%c%c%c%c%c%c%c%c" c ru wu xu rg wg xg ro wo xo in
+
+ let suid = is_suid mode in
+ let sgid = is_sgid mode in
+ let svtx = is_svtx mode in
+ if suid then str.[3] <- 's';
+ if sgid then str.[6] <- 's';
+ if svtx then str.[9] <- 't';
+
+ str
+
let tmpdir () =
let chan = open_in "/dev/urandom" in
let data = String.create 16 in
val (-^) : int64 -> int64 -> int64
val ( *^ ) : int64 -> int64 -> int64
val (/^) : int64 -> int64 -> int64
+val (&^) : int64 -> int64 -> int64
(** Int64 arithmetic operators. *)
type ('a, 'b) either = Left of 'a | Right of 'b
val is_xo : int64 -> bool
(** rwx/ugo bits. *)
+val file_permissions_string : int64 -> string
+ (** Convert [0755] to [-rwxr-xr-x] etc. *)
+
val tmpdir : unit -> string
(** [tmpdir ()] returns a newly created temporary directory. The
tmp directory is automatically removed when the program exits.
git.annexia.org / guestfs-browser.git / commitdiff