Gave xorriso-tcltk an opportunity to execute files with xorriso commands

This commit is contained in:
Thomas Schmitt 2013-01-04 19:23:28 +00:00
parent 960311ebc7
commit a26cb8f9ca
2 changed files with 248 additions and 126 deletions

View File

@ -194,6 +194,16 @@ set cmd_logging_mode 0
# The last logged -cd path. Used to prevent redundant logging of -cd.
set recent_cd_path ""
# The file address and the channel for xorriso command script execution
set execute_script_adr ""
set execute_script_conn ""
# Whether extraction to disk shall be allowed in scripts
set script_with_osirrox 0
# Whether extraction to disk is currently allowed
set osirrox_allowed 1
# xorriso specific constants
@ -263,6 +273,15 @@ proc send_loggable_cmd {cmd} {
}
# Send a command that shall not be displayed in the message log
#
proc send_silent_cmd {cmd} {
set disp_en_mem [set_display_msg 0]
send_marked_cmd $cmd
set_display_msg $disp_en_mem
}
# Wait for the currently pending mark message to arrive.
# Buffer all received result lines and info messages.
#
@ -488,18 +507,14 @@ proc reset_highest_cmd_sev {} {
# Clear the recordings of the xorriso message sieve.
#
proc clear_sieve {} {
set disp_en_mem [set_display_msg 0]
send_marked_cmd "-msg_op clear_sieve -"
set_display_msg $disp_en_mem
send_silent_cmd "-msg_op clear_sieve -"
}
# Obtain a recorded item from the xorriso message sieve.
#
proc read_sieve {name} {
set disp_en_mem [set_display_msg 0]
send_marked_cmd "-msg_op read_sieve '$name'"
set_display_msg $disp_en_mem
send_silent_cmd "-msg_op read_sieve '$name'"
de_sieve
}
@ -573,9 +588,7 @@ proc obtain_drive_info {dev} {
proc changes_are_pending {} {
global result_count result_list
set disp_en_mem [set_display_msg 0]
send_marked_cmd "-changes_pending show_status"
set_display_msg $disp_en_mem
send_silent_cmd "-changes_pending show_status"
if {$result_count >= 1} {
if {[lindex $result_list 0] == "-changes_pending no"} {
return "0"
@ -595,9 +608,7 @@ proc get_iso_filetype {adr} {
set scan_event_mem $scan_event_threshold
set scan_event_threshold "SORRY"
set disp_en_mem [set_display_msg 0]
send_marked_cmd "-lsdl [make_text_shellsafe $adr] --"
set_display_msg $disp_en_mem
send_silent_cmd "-lsdl [make_text_shellsafe $adr] --"
set scan_event_threshold $scan_event_mem
if {$result_count <= 0} {
return ""
@ -612,13 +623,11 @@ proc get_iso_filetype {adr} {
proc assert_iso_image {with_msg} {
global highest_seen_cmd_sev scan_event_threshold
set disp_en_mem [set_display_msg 0]
set highest_seen_cmd_sev ""
set set_mem $scan_event_threshold
set scan_event_threshold "FATAL"
send_marked_cmd "-lsd / --"
send_silent_cmd "-lsd / --"
set scan_event_threshold $set_mem
set_display_msg $disp_en_mem
if {[compare_sev $highest_seen_cmd_sev "FAILURE"] >= 0} {
if {$with_msg == 1} {
xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : First you need to create or load an ISO image by selecting a drive or an image file"
@ -788,7 +797,6 @@ proc setup_xorriso {} {
set cmd "$cmd -abort_on NEVER"
set cmd "$cmd -return_with ABORT 32"
set cmd "$cmd -report_about UPDATE"
set cmd "$cmd -osirrox on"
set cmd "$cmd -iso_rr_pattern off"
set cmd "$cmd -disk_pattern off"
@ -2130,9 +2138,15 @@ proc insert_from {} {
#
proc extract_to {} {
global extract_to_adr extract_from_selected extract_underneath
global extract_auto_chmod
global extract_auto_chmod osirrox_allowed
global isodir_adr isolist_names
if {$osirrox_allowed != 1} {
xorriso_tcltk_errmsg \
"xorriso-tcltk : SORRY : Extraction from ISO to hard disk is irrevocably banned."
return ""
}
if {[assert_iso_image 1] == 0} {return ""}
if {$extract_to_adr == ""} {
xorriso_tcltk_errmsg \
@ -2297,98 +2311,6 @@ proc show_permission_policy {} {
}
# Start command logging
# Called by setup_by_args and by the "Script/Log" menu.
# (target == "." and mode == -1 preserve the current state.)
#
proc start_command_logging {target mode} {
global cmd_log_conn cmd_logging_mode msglist_running cmd_log_target
global .script_log.menu
set is_stderr 0
if {$cmd_log_target == "" || $cmd_log_target == "-" || \
$cmd_log_conn == "stderr"} {set is_stderr 1}
set errmsg ""
if {$target != "." && $cmd_log_conn != "" && $target != $cmd_log_target && \
$is_stderr == 0} {
catch "close $cmd_log_conn"
set cmd_log_conn ""
}
set ret 0
if {$cmd_log_conn == "" || $is_stderr == 1} {
if {$target == "-" || $target == "" || $target == "."} {
set cmd_log_conn stderr
} else {
set ret [catch {set cmd_log_conn [open $target a]} errmsg]
}
if {$target != "."} {
set cmd_log_target $target
}
}
if {$ret == 0 && $mode >= 0} {
set cmd_logging_mode $mode
}
if {$ret == 1} {
set msg "xorriso-tcltk : SORRY : Failed to open command log script [make_text_shellsafe $target] :\n$errmsg"
if {$msglist_running == 1} {
xorriso_tcltk_errmsg $msg
} else {
puts stderr $msg
}
return 0
}
if {$mode > 0} {
puts $cmd_log_conn "# xorriso-tcltk command log script"
puts $cmd_log_conn [xorriso_loggable_init_cmds]
}
return 1
}
# Start communications pipe logging
# Called by setup_by_args and by the "Script/Log" menu.
# (target == "." and mode == -1 preserve the current state.)
#
proc start_debug_logging {target mode} {
global debug_log_conn debug_log_file debug_logging msglist_running
global .script_log.menu
set is_stderr 0
if {$debug_log_file == "" || $debug_log_file == "-" || \
$debug_log_conn == "stderr"} {set is_stderr 1}
set errmsg ""
if {$target != "." && $debug_log_conn != "" && \
$target != $debug_log_file && $is_stderr == 0} {
catch "close $debug_log_conn"
set debug_log_conn ""
}
set ret 0
if {$debug_log_conn == "" || $is_stderr == 1} {
if {$target == "-" || $target == "" || $target == "."} {
set debug_log_conn stderr
} else {
set ret [catch {set debug_log_conn [open $target a]} errmsg]
}
if {$target != "."} {
set debug_log_file $target
}
}
if {$ret == 0 && $mode >= 0} {
set debug_logging $mode
}
if {$ret == 1} {
set msg "xorriso-tcltk : SORRY : Failed to open pipe log [make_text_shellsafe $target] :\n$errmsg"
if {$msglist_running == 1} {
xorriso_tcltk_errmsg $msg
} else {
puts stderr $msg
}
return 0
}
return 1
}
# Set the target address of command logging.
# Called by the "Script/Log" menu.
#
@ -2439,6 +2361,29 @@ proc effectuate_debug_logging {close_window} {
}
# Trigger execution of a script of xorriso commands.
# Called by the "Script/Log" menu.
#
proc start_script_execution {} {
browse_tree execute_script_adr "localfs"
# actual script start is done by browse_tree_accept -> execute_script
}
# Permanently ban any extraction from ISO to hard disk
#
proc osirrox_banned {} {
global osirrox_allowed
reset_yesno_to_all
if {[window_yesno \
"Really irrevocably ban any extraction from ISO to hard disk ?"] \
!= 1} { return "" }
send_loggable_cmd "-osirrox banned"
set osirrox_allowed 0
}
# ------ A primitive file tree browser for hard disk filesystem and ISO model
@ -2482,7 +2427,7 @@ proc browse_tree_select {adr_var_name tr selected} {
proc browse_tree_accept {adr_var_name do_return tr selected} {
global extract_to_adr insert_from_adr burn_write_image_adr isodir_adr
global isomanip_move_target indev_adr outdev_adr cmd_log_target
global debug_log_file
global debug_log_file execute_script_adr
if {[llength $selected] == 0} {
set value ""
@ -2525,6 +2470,10 @@ proc browse_tree_accept {adr_var_name do_return tr selected} {
set debug_log_file $value
if {$do_return == 1} {effectuate_debug_logging 1}
}
if {$adr_var_name == "execute_script_adr"} {
set execute_script_adr $value
if {$do_return == 1} {execute_script 1}
}
}
@ -2558,6 +2507,9 @@ proc browse_tree_topic {adr_var_name} {
if {$adr_var_name == "debug_log_file"} {
return "Set pipe log address"
}
if {$adr_var_name == "execute_script_adr"} {
return "Execute command script"
}
return $adr_var_name
}
@ -2580,7 +2532,7 @@ proc browse_tree_accept_sel {adr_var_name do_return tr} {
proc browse_tree_accept_entry {adr_var_name do_return tr} {
global extract_to_adr insert_from_adr burn_write_image_adr isodir_adr
global isomanip_move_target indev_adr outdev_adr cmd_log_target
global debug_log_file
global debug_log_file execute_script_adr
eval set text $$adr_var_name
set selected [list $text]
@ -3546,16 +3498,29 @@ proc init_input {} {
menu $m
$m add checkbutton -label "Log command script" \
-indicatoron 1 -selectcolor "" \
-command "effectuate_command_logging 0" \
-variable cmd_logging_mode \
-onvalue 1 -offvalue 0
$m add command -label "Set log script address" \
-command "set_log_script_address"
$m add separator
$m add checkbutton -label "Log pipes" \
-indicatoron 1 -selectcolor "" \
-variable debug_logging \
-onvalue 1 -offvalue 0
$m add command -label "Set pipe log address" \
-command "set_debug_log_address"
$m add separator
$m add separator
$m add command -label "Execute command script" \
-command "start_script_execution"
$m add checkbutton -label "Allow extract to disk" \
-indicatoron 1 -selectcolor "" \
-variable script_with_osirrox \
-onvalue 1 -offvalue 0
$m add separator
$m add command -label "Permanently ban extraction" \
-command "osirrox_banned"
button .help -text "Help" -command {window_help "Help" "grey"} \
-background "grey"
@ -4238,19 +4203,8 @@ proc bind_help {to_what help_name} {
proc create_browser_button {button_name var_name which_fs help_name} {
global have_bwidget
# >>> Remove dummy
if {1 || $have_bwidget == 1} {
button $button_name -text "/" -command "browse_tree $var_name $which_fs"
bind_help $button_name $help_name
} else {
button $button_name -text "/" -command "browser_dummy"
if {$which_fs == "localfs"} {
bind_help $button_name "Browse disk (dummy)"
} else {
bind_help $button_name "Browse ISO (dummy)"
}
}
button $button_name -text "/" -command "browse_tree $var_name $which_fs"
bind_help $button_name $help_name
}
@ -4500,6 +4454,7 @@ commands of the GUI session shall be written to the end of a script file
on hard disk. Not written will be the commands by which the GUI inspects
the xorriso state, but only those which set up that state and those which
get sent via the \"Command:\" field.
Commands -osirrox and -extract will be logged only as comments.
The item \"Set log script address\" pops up a file tree browser window
which asks for the target of appending to script. Address \"-\" means
@ -4513,7 +4468,22 @@ Caution: This log is verbous.
The item \"Set pipe log address\" pops up a file tree browser window
which asks for the target of pipe logging . Address \"-\" means
standard error. Else it must not yet exist or be a writable data file.
"
The item \"Execute command script\" executes the commands in a script
file that should stem from \"Log command script\".
At least it must begin by this line:
# xorriso-tcltk command log script
Be aware that xorriso will slavishly execute those commands. Better check
in advance whether the content of the script file is what you expect.
See man xorriso for the meaning of the commands.
The \"Allow extract to disk\" switch controls whether commands like -extract
are allowed in command scripts. If disabled, then command -osirrox is used
to temporarily block those commands (unless the script ublocks itself, which
would be nasty behavior).
The item \"Permanently ban extraction\" disables -extract irrevocably for
scripts and GUI alike."
}
if {$what == "message box"} {
return \
@ -5552,6 +5522,158 @@ proc log_command {cmd} {
}
# Start command logging
# Called by setup_by_args and by the "Script/Log" menu.
# (target == "." and mode == -1 preserve the current state.)
#
proc start_command_logging {target mode} {
global cmd_log_conn cmd_logging_mode msglist_running cmd_log_target
set is_stderr 0
if {$cmd_log_target == "" || $cmd_log_target == "-" || \
$cmd_log_conn == "stderr"} {set is_stderr 1}
set errmsg ""
if {$target != "." && $cmd_log_conn != "" && $target != $cmd_log_target && \
$is_stderr == 0} {
catch "close $cmd_log_conn"
set cmd_log_conn ""
}
set ret 0
if {$cmd_log_conn == "" || $is_stderr == 1} {
if {$target == "-" || $target == "" || $target == "."} {
set cmd_log_conn stderr
} else {
set ret [catch {set cmd_log_conn [open $target a]} errmsg]
}
if {$target != "."} {
set cmd_log_target $target
}
}
if {$ret == 0 && $mode >= 0} {
set cmd_logging_mode $mode
}
if {$ret == 1} {
set msg "xorriso-tcltk : SORRY : Failed to open command log script [make_text_shellsafe $target] :\n$errmsg"
if {$msglist_running == 1} {
xorriso_tcltk_errmsg $msg
} else {
puts stderr $msg
}
return 0
}
if {$mode > 0} {
puts $cmd_log_conn "# xorriso-tcltk command log script"
puts $cmd_log_conn [xorriso_loggable_init_cmds]
flush $cmd_log_conn
}
return 1
}
# Start communications pipe logging
# Called by setup_by_args and by the "Script/Log" menu.
# (target == "." and mode == -1 preserve the current state.)
#
proc start_debug_logging {target mode} {
global debug_log_conn debug_log_file debug_logging msglist_running
set is_stderr 0
if {$debug_log_file == "" || $debug_log_file == "-" || \
$debug_log_conn == "stderr"} {set is_stderr 1}
set errmsg ""
if {$target != "." && $debug_log_conn != "" && \
$target != $debug_log_file && $is_stderr == 0} {
catch "close $debug_log_conn"
set debug_log_conn ""
}
set ret 0
if {$debug_log_conn == "" || $is_stderr == 1} {
if {$target == "-" || $target == "" || $target == "."} {
set debug_log_conn stderr
} else {
set ret [catch {set debug_log_conn [open $target a]} errmsg]
}
if {$target != "."} {
set debug_log_file $target
}
}
if {$ret == 0 && $mode >= 0} {
set debug_logging $mode
}
if {$ret == 1} {
set msg "xorriso-tcltk : SORRY : Failed to open pipe log [make_text_shellsafe $target] :\n$errmsg"
if {$msglist_running == 1} {
xorriso_tcltk_errmsg $msg
} else {
puts stderr $msg
}
return 0
}
return 1
}
proc execute_script {close_window} {
global execute_script_conn execute_script_adr browse_disk_window_is_active
global osirrox_allowed script_with_osirrox cmd_logging_mode cmd_log_target
global highest_cmd_sev
if {$close_window == 1 && $browse_disk_window_is_active == 1} {
destroy_browse_disk .browse_disk_window
}
set n1 [file normalize $execute_script_adr]
set n2 [file normalize $cmd_log_target]
if {$n1 == $n2 && $cmd_logging_mode > 0} {
xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You first have to disable command script logging before using the log script"
return ""
}
set errmsg ""
set ret [catch {set execute_script_conn [open $execute_script_adr r]} errmsg]
if {$ret != 0} {
xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : Failed to open command log script [make_text_shellsafe $execute_script_adr] :\n$errmsg"
return ""
}
set line ""
set ret [gets $execute_script_conn line]
if {$ret < 0 || $line != "# xorriso-tcltk command log script"} {
xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : Given file does not look like a xorriso command log script"
close $execute_script_conn
return ""
}
# >>> ??? Show script
if {[window_yesno "Really perform the xorriso commands in file\n\n[make_text_shellsafe $execute_script_adr]\n\n?"] != 1} {
close $execute_script_conn
return ""
}
if {$script_with_osirrox != 1} {
send_silent_cmd "-osirrox blocked"
}
while {1} {
set ret [gets $execute_script_conn line]
if {$ret < 0} {
break
}
if {$line == "" || [string first "#" $line] == 0} {
continue
}
reset_highest_cmd_sev
send_loggable_cmd $line
if {[compare_sev $highest_cmd_sev "FAILURE"] >= 0} {
xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : Encountered problem event of severity '$highest_cmd_sev'.\nScript execution aborted."
break
}
}
close $execute_script_conn
if {$script_with_osirrox != 1} {
send_silent_cmd "-osirrox unblock"
}
}
# -------- start living

View File

@ -1 +1 @@
#define Xorriso_timestamP "2013.01.04.185925"
#define Xorriso_timestamP "2013.01.04.192238"