From 38e0e295c438adea7a8acabd21c2fd02c236cc04 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Fri, 29 Jul 2011 19:53:57 +0100 Subject: [PATCH] Add file properties dialog. --- .depend | 7 +- Makefile.am | 3 + filetree.ml | 71 ++++++++++++-------- filetree.mli | 6 ++ filetree_markup.ml | 27 +------- main.ml | 2 + op_file_properties.ml | 178 +++++++++++++++++++++++++++++++++++++++++++++++++ op_file_properties.mli | 21 ++++++ slave.ml | 18 +++++ slave.mli | 4 ++ utils.ml | 30 +++++++++ utils.mli | 4 ++ 12 files changed, 317 insertions(+), 54 deletions(-) create mode 100644 op_file_properties.ml create mode 100644 op_file_properties.mli diff --git a/.depend b/.depend index f6277c8..b90ab9c 100644 --- a/.depend +++ b/.depend @@ -13,8 +13,8 @@ filetree.cmx: utils.cmx slave_types.cmx slave.cmx filetree_markup.cmx deviceSet. 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 @@ -48,6 +48,9 @@ op_download_file.cmx: utils.cmx slave.cmx op_download_file.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 diff --git a/Makefile.am b/Makefile.am index dbb23a5..8f811ad 100644 --- a/Makefile.am +++ b/Makefile.am @@ -69,6 +69,8 @@ SOURCES = \ 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 \ @@ -108,6 +110,7 @@ OBJECTS = \ 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 \ diff --git a/filetree.ml b/filetree.ml index 7217c4e..f6ffa7b 100644 --- a/filetree.ml +++ b/filetree.ml @@ -78,18 +78,6 @@ let root_key_of_registry_t (_, root_key, _, _) = root_key * (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 *) @@ -117,6 +105,20 @@ class tree ?packing () = (* 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; @@ -128,9 +130,25 @@ object (self) 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); @@ -528,20 +546,6 @@ object (self) 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 @@ -633,6 +637,10 @@ object (self) 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 @@ -655,6 +663,10 @@ object (self) 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 @@ -800,6 +812,13 @@ object (self) | { 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: diff --git a/filetree.mli b/filetree.mli index a805540..e2fcef2 100644 --- a/filetree.mli +++ b/filetree.mli @@ -60,6 +60,10 @@ object ('a) 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 @@ -139,6 +143,8 @@ object ('a) 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 : diff --git a/filetree_markup.ml b/filetree_markup.ml index 84c4288..b5f3b48 100644 --- a/filetree_markup.ml +++ b/filetree_markup.ml @@ -115,32 +115,7 @@ and darken (r, g, b) = (* 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 "" ^ str ^ "" (* Mark up dates. *) diff --git a/main.ml b/main.ml index f8a368d..69ee4e1 100644 --- a/main.ml +++ b/main.ml @@ -65,6 +65,8 @@ let () = ~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 diff --git a/op_file_properties.ml b/op_file_properties.ml new file mode 100644 index 0000000..70e027b --- /dev/null +++ b/op_file_properties.ml @@ -0,0 +1,178 @@ +(* 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 "%s" (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 "%s" (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 "%s" (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 diff --git a/op_file_properties.mli b/op_file_properties.mli new file mode 100644 index 0000000..1b70bcf --- /dev/null +++ b/op_file_properties.mli @@ -0,0 +1,21 @@ +(* 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 diff --git a/slave.ml b/slave.ml index 975ab35..360a11c 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 + | 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 @@ -75,6 +76,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 + | 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 @@ -171,6 +174,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 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)) @@ -353,6 +358,19 @@ and execute_command = function 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 ..."; diff --git a/slave.mli b/slave.mli index 5eaa9c9..eba36a0 100644 --- a/slave.mli +++ b/slave.mli @@ -113,6 +113,10 @@ val file_information : ?fail:exn callback -> Slave_types.source -> string -> str (** [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. *) diff --git a/utils.ml b/utils.ml index 4ec1531..57faf38 100644 --- a/utils.ml +++ b/utils.ml @@ -25,6 +25,7 @@ let (+^) = Int64.add let (-^) = Int64.sub let ( *^ ) = Int64.mul let (/^) = Int64.div +let (&^) = Int64.logand type ('a, 'b) either = Left of 'a | Right of 'b @@ -178,6 +179,35 @@ and is_xo mode = test_bit 0o001L mode 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 diff --git a/utils.mli b/utils.mli index 759dde1..ceff484 100644 --- a/utils.mli +++ b/utils.mli @@ -22,6 +22,7 @@ val (+^) : int64 -> int64 -> int64 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 @@ -118,6 +119,9 @@ val is_wo : int64 -> bool 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. -- 1.8.3.1