Hardened xorriso-tcltk against filenames with newlines

frontend/README-tcltk

@@ -72,11 +72,11 @@ Options:
  --help
      Print this text and exit.
  --stdio
-     Establishes connection to xorriso via stdin and stdout.
+     Establish connection to xorriso via stdin and stdout.
      E.g. when letting xorriso start this frontend program:
        xorriso -launch_frontend $(which xorriso-tcltk) --stdio --
  --named_pipes cmd_fifo reply_fifo
-     Establishes connection to a xorriso process started by:
+     Establish connection to a xorriso process started by:
        xorriso -dialog on <cmd_fifo >reply_fifo
      which is then ready for a run of:
        xorriso-tcltk --named_pipes cmd_fifo reply_fifo
@@ -93,13 +93,18 @@ Options:
      Sets the position of the main window.
  --click_to_focus
      Chooses that input fields and list boxes get the keyboard
-     focus only when being clicked by the mouse.
+     focus only when being clicked by the mouse. (Default)
  --auto_focus
      Chooses that the keyboard focus is where the mouse
-     pointer is. (Default)
+     pointer is.
- --log_file path
+ --pipe_log_file path
      Set a file address for logging of xorriso commands and
-     reply messages. The log lines will be appended.
+     reply messages and enable this logging.
+     The log lines will be appended. Path "-" means stderr.
+ --script_log_file path
+     Set a file address for logging of major xorriso commands
+     and enable this logging.
+     The log lines will be appended. Path "-" means stderr.
 
 If neither --stdio nor --named_pipes is given, then this script
 will try to locate itself in the filesystem and start a xorriso

frontend/xorriso-tcltk

@@ -120,10 +120,6 @@ set highest_seen_cmd_sev ALL
 # State of last read_sieve command
 set sieve_ret 0
 
-# Mode for parsing replies with multiple words of arbitrary characters
-# 0= single -msg_op parse commands
-# 1= -msg_op parse_bulk (less problems with connection latency)
-set bulk_parse_mode 1
 # How many texts to pass with one parse_bulk command
 set bulk_parse_max_chunk 200
 # Parse parameters
@@ -182,6 +178,9 @@ set debug_logging 0
 # The result of the most recent isofs_ls run
 set isofs_ls_result ""
 
+# The result of the most recent localfs_ls run
+set localfs_ls_result ""
+
 # The communication channel where to log files (if it is not the empty text)
 set cmd_log_conn ""
 
@@ -389,11 +388,11 @@ proc scan_info_for_event {line} {
   }
   if {[compare_sev $sev $highest_total_sev] >= 0} {
     set highest_total_sev $sev
-    set highest_total_sev_msg [escape_newline $line]
+    set highest_total_sev_msg [escape_newline $line 0]
   }
   if {[compare_sev $sev $highest_cmd_sev] >= 0} {
     set highest_cmd_sev $sev
-    set highest_cmd_sev_msg [escape_newline $line]
+    set highest_cmd_sev_msg [escape_newline $line 0]
   }
 }
 
@@ -736,6 +735,66 @@ proc isofs_filetype {path} {
 }
 
 
+# The xorriso commands have the advantage to be always available and to
+# need no unescaping.
+# On the other hand, shell and tcl lstat are faster with large directories.
+#
+set localfs_ls_by_sh 0
+set localfs_filetype_by_tcl 0
+
+
+if {$localfs_ls_by_sh == 0} {
+
+# Parse-by-xorriso handler function for proc localfs_ls
+#
+proc localfs_ls_handler {} {
+  global result_list localfs_ls_result
+
+  if {[lindex $result_list 0] == "total"} {return ""}
+  lappend localfs_ls_result \
+       "[string range [lindex $result_list 0] 0 0] [lindex $result_list 8]"
+}
+
+
+# Return the list of files of a hard disk filesystem directory
+#
+proc localfs_ls {dir} {
+  global localfs_ls_result
+
+  set localfs_ls_result ""
+  if {[localfs_filetype $dir] != "d"} {return ""}
+
+  set disp_en_mem [set_display_msg 0]
+  send_marked_cmd "-lslx [make_text_shellsafe $dir]"
+  handle_result_list localfs_ls_handler "''" "''" 0 0
+  set_display_msg $disp_en_mem
+  return $localfs_ls_result
+}
+
+
+# <<< $localfs_ls_by_sh == 0
+}
+if {$localfs_filetype_by_tcl == 0} {
+
+
+# Tells the file type of an absolute path in the ISO model.
+# Indicator characters like with ls -l. Empty text means non existing file.
+#
+proc localfs_filetype {path} {
+  global result_list
+
+  set disp_en_mem [set_display_msg 0]
+  send_marked_cmd "-lsdlx [make_text_shellsafe $path]"
+  set_display_msg $disp_en_mem
+  if {[llength $result_list] < 1} {return ""} 
+  return [string range [lindex $result_list 0] 0 0]
+}
+
+
+# <<< $localfs_filetype_by_tcl == 0
+}
+
+
 # Verify that the connected process runs a xorriso program that is modern
 # enough. This is done before sending xorriso the setup commands.
 #
@@ -800,9 +859,7 @@ proc setup_xorriso {} {
   set cmd "$cmd -iso_rr_pattern off"
   set cmd "$cmd -disk_pattern off"
 
-  set cmd "$cmd -for_backup"
+  set cmd "$cmd [xorriso_loggable_init_cmds]"
-  set cmd "$cmd -hardlinks off"
-  set cmd "$cmd -follow mount:limit=100"
 
   send_marked_cmd $cmd
   inquire_severity_list
@@ -818,6 +875,7 @@ proc xorriso_loggable_init_cmds {} {
   # image manipulations. So for now -hardlinks is set to off.
   set cmd "$cmd -hardlinks off"
 
+  set cmd "$cmd -backslash_codes on"
   set cmd "$cmd -follow mount:limit=100"
   return $cmd
 }
@@ -856,7 +914,7 @@ proc effectuate_permission_policy {} {
 # of e.g. -lsl into single words from which this frontend can pick information.
 #
 proc start_bulkparse {prefix separators max_words flag num_lines} {
-  global bulk_parse_mode bulk_parse_prefix bulk_parse_separators
+  global bulk_parse_prefix bulk_parse_separators
   global bulk_parse_max_words bulk_parse_flag bulk_parse_num_texts
 
   if {$num_lines <= 0} {return ""}
@@ -866,11 +924,9 @@ proc start_bulkparse {prefix separators max_words flag num_lines} {
   set bulk_parse_max_words $max_words
   set bulk_parse_flag $flag
   set bulk_parse_num_texts $num_lines
-  if {$bulk_parse_mode == 1} {
+  set cmd "-msg_op parse_bulk \"$prefix $separators $max_words $flag $num_lines\""
-    set cmd "-msg_op parse_bulk \"$prefix $separators $max_words $flag $num_lines\""
+  send_async_cmd $cmd
-    send_async_cmd $cmd
+  # Do not wait for mark
-    # Do not wait for mark
-  }
 }
 
 
@@ -880,44 +936,18 @@ proc start_bulkparse {prefix separators max_words flag num_lines} {
 proc submit_bulkparse {text} {
   global cmd_conn reply_conn
   global result_list result_count
-  global bulk_parse_mode bulk_parse_prefix bulk_parse_separators
+  global bulk_parse_prefix bulk_parse_separators
   global bulk_parse_max_words bulk_parse_flag
 
-  if {$bulk_parse_mode != 1} {
-    clear_reply_lists
-  }
   set disp_en_mem [set_display_msg 0]
 
   set num_lines [expr [count_newlines $text] + 1]
 
-  if {$bulk_parse_mode == 0} {
+  debug_log_puts ">>>>>  $num_lines"
-    set cmd "-msg_op parse \"$bulk_parse_prefix $bulk_parse_separators $bulk_parse_max_words $bulk_parse_flag $num_lines\""
+  puts $cmd_conn $num_lines
-    send_async_cmd $cmd
-  } else {
-    debug_log_puts ">>>>>  $num_lines"
-    puts $cmd_conn $num_lines
-  }
   debug_log_puts ">>>>>  $text"
   puts $cmd_conn $text
   flush $cmd_conn
-
-  if {$bulk_parse_mode != 1} {
-    set loop_limit 2
-    while {$result_count < $loop_limit} {
-      set ret [gets $reply_conn line]
-      if {$ret < 0} { return ""}
-      debug_log_puts $line
-      de_pkt_line $line
-      if {$result_count == 1} {
-        set parse_ret [lindex $result_list 0]
-      }
-      if {$result_count == 2} {
-        set num_replies [lindex $result_list 1]
-        set loop_limit [expr "$num_replies * 2 + 2"]
-      }
-    }
-    de_sieve
-  }
   set_display_msg $disp_en_mem
 }
 
@@ -927,10 +957,6 @@ proc submit_bulkparse {text} {
 # Each input line of the parser yields one reply buffer full of parsed words.
 #
 proc read_bulkparse {handler_proc num_texts} {
-  global bulk_parse_mode 
-
-  if {$bulk_parse_mode != 1} { return ""}
-
   set disp_en_mem [set_display_msg 0]
   for {set i 0} {$i < $num_texts} {incr i} {
     clear_reply_lists
@@ -947,21 +973,47 @@ proc read_parse_reply {} {
   global reply_conn
   global result_list result_count
 
+  set sieve_result_count 0
+  set payload ""
+  set num_lines 0
+  set acc ""
   set loop_limit 2
   while {$result_count < $loop_limit} {
     set ret [gets $reply_conn line]
     if {$ret < 0} { return ""}
     debug_log_puts $line
     de_pkt_line $line
+    set line [lindex $result_list [expr $result_count-1]]
     if {$result_count == 1} {
-      set parse_ret [lindex $result_list 0]
+      set parse_ret $line
-    }
+    } else { if {$result_count == 2} {
-    if {$result_count == 2} {
+      set num_replies $line
-      set num_replies [lindex $result_list 1]
+      # The minimum number of lines
       set loop_limit [expr "$num_replies * 2 + 2"]
-    }
+    } else {
+      if {$num_lines <= 0} {
+        set num_lines $line
+        if {$num_lines > 1} {
+          # Need to read extra lines
+          incr loop_limit [expr $num_lines-1]
+        }
+        set acc ""
+      } else {
+        incr num_lines -1
+        if {$acc != ""} {
+          set acc "$acc\n$line"
+        } else {
+          set acc $line
+        }
+        if {$num_lines <= 0} {
+          lappend payload $acc
+          incr sieve_result_count
+        }
+      }
+    }}
   }
-  de_sieve
+  set result_list $payload
+  set result_count $sieve_result_count
 }
 
 
@@ -976,7 +1028,7 @@ proc read_parse_reply {} {
 proc handle_result_list {handler_proc \
                          prefix separators max_words flag } {
   global result_list
-  global bulk_parse_mode bulk_parse_max_chunk
+  global bulk_parse_max_chunk
 
   set raw_list $result_list
   set raw_line_count [expr [llength $raw_list]]
@@ -992,10 +1044,7 @@ proc handle_result_list {handler_proc \
     submit_bulkparse $i
     incr submit_count
     incr submit_in_chunk_count
-    if {$bulk_parse_mode != 1} {
+    if {$submit_in_chunk_count == $chunk_size} {
-      $handler_proc
-    }
-    if {$bulk_parse_mode == 1 && $submit_in_chunk_count == $chunk_size} {
       read_bulkparse $handler_proc $chunk_size
       set todo [expr "$raw_line_count - $submit_count"]
       if {$todo <= 0} {
@@ -1455,7 +1504,6 @@ proc isodir_return {caller} {
   global isodir_is_pwd highest_cmd_sev highest_cmd_sev_msg
   global indev_adr outdev_adr eff_indev_adr
   global .isolist
-  global bulk_parse_mode
   global bulk_parse_max_chunk
 
   set chunk_size 0
@@ -1537,11 +1585,7 @@ proc pick_isodir {} {
     return ""
   }
   set idx [lindex $selected 0]
-  if {[lindex $isolist_types $idx] != "d"} {
+  if {[lindex $isolist_types $idx] != "d"} { return "" }
-    xorriso_tcltk_errmsg \
-       "xorriso-tcltk : SORRY : You may only double-click a directory"
-    return ""
-  }
   if {$isodir_adr == "/"} {
     set isodir_adr ""
   }
@@ -2034,7 +2078,7 @@ proc handle_overwriting {target_fs target target_ftype
             != 1} { return "0" }
       } else {
         if {$target_fs != "isofs"} {
-          xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : Will not replace directories on hard disk by file of other type"
+          xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : Will not replace directory on hard disk by file of other type\n[make_text_shellsafe $target]"
           return "0"
         }
         if {$overwrite_dirs == 1} {
@@ -2042,7 +2086,7 @@ proc handle_overwriting {target_fs target target_ftype
                "Really overwrite $to_fs directory\n\n[make_text_shellsafe $target]\n\nby $from_fs file\n[make_text_shellsafe $source]\n?"] \
               != 1} { return "0" }
         } else {
-          xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You would have to enable \"Overwrite $overwrite_fs dirs\""
+          xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You would have to enable \"Overwrite $overwrite_fs dirs\" for\n[make_text_shellsafe $target]"
           return "0"
         }
       }
@@ -2053,7 +2097,7 @@ proc handle_overwriting {target_fs target target_ftype
           return "0"
         }
       } else {
-        xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You would have to enable \"Overwrite $overwrite_fs files\""
+        xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You would have to enable \"Overwrite $overwrite_fs files\" for\n[make_text_shellsafe $target]"
         return "0"
       }
     }
@@ -2434,6 +2478,10 @@ proc browse_tree_accept {adr_var_name do_return tr selected} {
   global isomanip_move_target indev_adr outdev_adr cmd_log_target
   global debug_log_file execute_script_adr
 
+  if {[llength $selected] > 1} {
+    xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You may only select a single file"
+    return ""
+  }
   if {[llength $selected] == 0} {
     set value ""
   } else {
@@ -2524,6 +2572,7 @@ proc browse_tree_topic {adr_var_name} {
 #
 proc browse_tree_accept_sel {adr_var_name do_return tr} {
   set selected [$tr selection get]
+
   if {[llength $selected] != 1} {
     xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select a single tree item before clicking the \"Accept\" button."
     return ""
@@ -2545,6 +2594,14 @@ proc browse_tree_accept_entry {adr_var_name do_return tr} {
 }
 
 
+# Hand the variable from double click over to browse_tree_accept as list.
+# Called by double click in browser tree
+#
+proc browse_tree_accept_bindtext {adr_var_name do_return tr item} {
+  browse_tree_accept $adr_var_name $do_return $tr [list $item]
+}
+
+
 # Move up one directory level of the file browser selection
 #
 proc browse_tree_up {adr_var_name tr which_fs} {
@@ -2789,10 +2846,12 @@ proc browse_tree {adr_var which_fs} {
                    -xscrollcommand "$w.treescroll_x set"
 
       # ??? why doesn't <Return> work ?
-      # $w.tree bindText <Return> "browse_tree_accept $adr_var 1 $w.tree"
+      # $w.tree bindText <Return> \
+      #                  "browse_tree_accept_bindtext $adr_var 1 $w.tree"
 
       # At least double-click does work
-      $w.tree bindText <Double-Button-1> "browse_tree_accept $adr_var 1 $w.tree"
+      $w.tree bindText <Double-Button-1> \
+                       "browse_tree_accept_bindtext $adr_var 1 $w.tree"
 
       $w.tree bindText <Button-3> {browse_tree_help "Browse tree" grey}
 
@@ -2854,11 +2913,11 @@ proc browse_tree {adr_var which_fs} {
     pack $w.text_frame -side top -expand 1 -fill both
   }
   raise $w
-  update idletasks
   if {$have_bwidget == 1} {
     browse_tree_populate $which_fs
     focus $w.tree
   }
+  update idletasks
 }
 
  
@@ -2882,7 +2941,7 @@ proc display_msg {msg} {
     if {[.msglist index end] > $msglist_max_fill} {
       .msglist delete 0 0
     }
-    .msglist insert end [escape_newline $msg]
+    .msglist insert end [escape_newline $msg 0]
     .msglist see [expr "[.msglist index end]-1"]
     update idletasks
   }
@@ -2911,7 +2970,7 @@ proc set_display_msg {mode} {
 proc xorriso_tcltk_errmsg {msg} {
   global highest_cmd_sev_msg
 
-  set highest_cmd_sev_msg [escape_newline $msg]
+  set highest_cmd_sev_msg [escape_newline $msg 0]
   display_msg $msg
   window_ack $msg "grey" "toplevel"
   update idletasks
@@ -3575,7 +3634,7 @@ proc init_msgbox {} {
   bind_help .msglist "message box"
   set msglist_running 1
   foreach i $pre_msglist {
-    display_msg [escape_newline $i]
+    display_msg [escape_newline $i 0]
   }
   scrollbar .msgscroll -command ".msglist yview"
   pack .msglist   -in .msgbox -side left  -expand 1 -fill both
@@ -5459,9 +5518,14 @@ proc yell_xorriso_tcltk {} {
 }
 
 
+if {$localfs_filetype_by_tcl == 1} {
+# <<< Now via xorriso -lslx
+
+
 # Tells whether an absolute path leads to a directory on hard disk 
 #
-proc localfs_filetype {path} {
+proc localfs_filetype {path_in} {
+  set path [unescape_string $path_in]
   catch {file lstat $path stbuf}
   if {[info exists stbuf] == 1} {
     set t [string range $stbuf(type) 0 0]
@@ -5474,18 +5538,25 @@ proc localfs_filetype {path} {
 }
 
 
+# <<< $localfs_filetype_by_tcl == 1
+}
+if {$localfs_ls_by_sh == 1} {
+
+
 # Return the list of files of a hard disk filesystem directory
 #
-proc localfs_ls {dir} {
+proc localfs_ls {dir_in} {
-
+  set dir [unescape_string $dir_in]
   set result ""
   if {[localfs_filetype $dir] != "d"} {return ""}
-  set conn [open "|ls {$dir}" r]
+  set conn [open "|ls -1b [list $dir]" r]
   while {1} {
     set ret [gets $conn line]
     if {$ret == -1} {
   break
     }
+    # ls -b has the habit to escape blanks, xorriso has not.
+    set line [string map [list "\\\\" "\\\\" "\\ " " "] $line]
     set adr [combine_dir_and_name $dir $line]
     set filetype [localfs_filetype $adr]
     if {$filetype == ""} {set filetype "?"}
@@ -5496,6 +5567,10 @@ proc localfs_ls {dir} {
 }
 
 
+# <<< $localfs_ls_by_sh == 1
+}
+
+
 # Log a command (if enabled)
 #
 proc log_command {cmd} {
@@ -5680,11 +5755,34 @@ proc execute_script {close_window} {
 
 # Convert newline into \n
 #
-proc escape_newline {text} {
+proc escape_newline {text backslash_too} {
-  return [string map [list "\n" "\\n"] $text]
+  if {$backslash_too == 0} {
+    return [string map [list "\n" "\\n"] $text]
+  }
+  return [string map [list "\n" "\\n" "\\" "\\\\"] $text]
 }
 
 
+if {$localfs_ls_by_sh == 1 || $localfs_filetype_by_tcl == 1} {
+
+
+proc unescape_string {text} {
+  # The Tcl backslash escaping nearly matches the one of xorriso.
+  # Only code \e is not known to Tcl.
+  # So protect \\e from being converted, convert \e, and escape $[{"   (not }])
+  set escpd [string map [list "\\\\" "\\\\" "\\e" "\x1b" "\$" "\\\$" \
+                              "\[" "\\\["   "\{"  "\\\{"  "\"" "\\\""] \
+                        $text]
+  # And now let Tcl unescape it
+  eval set escpd \"$escpd\"
+  return $escpd
+}
+
+
+# <<< $localfs_ls_by_sh == 1 || $localfs_filetype_by_tcl == 1
+} 
+
+
 # -------- start living
 
 

xorriso/xorriso_timestamp.h

@@ -1 +1 @@
-#define Xorriso_timestamP "2013.01.05.214951"
+#define Xorriso_timestamP "2013.01.05.220937"