Hardened xorriso-tcltk against filenames with newlines

This commit is contained in:
Thomas Schmitt 2013-01-05 22:10:27 +00:00
parent da0bddeced
commit 49ce1dd623
3 changed files with 190 additions and 87 deletions

View File

@ -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)
--log_file path
pointer is.
--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

View File

@ -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 -hardlinks off"
set cmd "$cmd -follow mount:limit=100"
set cmd "$cmd [xorriso_loggable_init_cmds]"
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\""
send_async_cmd $cmd
# Do not wait for mark
}
set cmd "-msg_op parse_bulk \"$prefix $separators $max_words $flag $num_lines\""
send_async_cmd $cmd
# 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} {
set cmd "-msg_op parse \"$bulk_parse_prefix $bulk_parse_separators $bulk_parse_max_words $bulk_parse_flag $num_lines\""
send_async_cmd $cmd
} else {
debug_log_puts ">>>>> $num_lines"
puts $cmd_conn $num_lines
}
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]
}
if {$result_count == 2} {
set num_replies [lindex $result_list 1]
set parse_ret $line
} else { if {$result_count == 2} {
set num_replies $line
# 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} {
$handler_proc
}
if {$bulk_parse_mode == 1 && $submit_in_chunk_count == $chunk_size} {
if {$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"} {
xorriso_tcltk_errmsg \
"xorriso-tcltk : SORRY : You may only double-click a directory"
return ""
}
if {[lindex $isolist_types $idx] != "d"} { 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} {
return [string map [list "\n" "\\n"] $text]
proc escape_newline {text backslash_too} {
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

View File

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