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

frontend/xorriso-tcltk

@@ -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_silent_cmd "-msg_op clear_sieve -"
-  send_marked_cmd "-msg_op clear_sieve -"
-  set_display_msg $disp_en_mem
 }
 
 
 # Obtain a recorded item from the xorriso message sieve.
 #
 proc read_sieve {name} {
-  set disp_en_mem [set_display_msg 0]
+  send_silent_cmd "-msg_op read_sieve '$name'"
-  send_marked_cmd "-msg_op read_sieve '$name'"
-  set_display_msg $disp_en_mem
   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_silent_cmd "-changes_pending show_status"
-  send_marked_cmd "-changes_pending show_status"
-  set_display_msg $disp_en_mem
   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_silent_cmd "-lsdl [make_text_shellsafe $adr] --"
-  send_marked_cmd "-lsdl [make_text_shellsafe $adr] --"
-  set_display_msg $disp_en_mem
   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
+  button $button_name -text "/" -command "browse_tree $var_name $which_fs"
-
+  bind_help $button_name $help_name
-  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)"
-    }
-  }
 }
 
 
@@ -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
 
 

xorriso/xorriso_timestamp.h

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