Hardened xorriso-tcltk against filenames with newlines
This commit is contained in:
parent
da0bddeced
commit
49ce1dd623
@ -72,11 +72,11 @@ Options:
|
|||||||
--help
|
--help
|
||||||
Print this text and exit.
|
Print this text and exit.
|
||||||
--stdio
|
--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:
|
E.g. when letting xorriso start this frontend program:
|
||||||
xorriso -launch_frontend $(which xorriso-tcltk) --stdio --
|
xorriso -launch_frontend $(which xorriso-tcltk) --stdio --
|
||||||
--named_pipes cmd_fifo reply_fifo
|
--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
|
xorriso -dialog on <cmd_fifo >reply_fifo
|
||||||
which is then ready for a run of:
|
which is then ready for a run of:
|
||||||
xorriso-tcltk --named_pipes cmd_fifo reply_fifo
|
xorriso-tcltk --named_pipes cmd_fifo reply_fifo
|
||||||
@ -93,13 +93,18 @@ Options:
|
|||||||
Sets the position of the main window.
|
Sets the position of the main window.
|
||||||
--click_to_focus
|
--click_to_focus
|
||||||
Chooses that input fields and list boxes get the keyboard
|
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
|
--auto_focus
|
||||||
Chooses that the keyboard focus is where the mouse
|
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
|
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
|
If neither --stdio nor --named_pipes is given, then this script
|
||||||
will try to locate itself in the filesystem and start a xorriso
|
will try to locate itself in the filesystem and start a xorriso
|
||||||
|
@ -120,10 +120,6 @@ set highest_seen_cmd_sev ALL
|
|||||||
# State of last read_sieve command
|
# State of last read_sieve command
|
||||||
set sieve_ret 0
|
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
|
# How many texts to pass with one parse_bulk command
|
||||||
set bulk_parse_max_chunk 200
|
set bulk_parse_max_chunk 200
|
||||||
# Parse parameters
|
# Parse parameters
|
||||||
@ -182,6 +178,9 @@ set debug_logging 0
|
|||||||
# The result of the most recent isofs_ls run
|
# The result of the most recent isofs_ls run
|
||||||
set isofs_ls_result ""
|
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)
|
# The communication channel where to log files (if it is not the empty text)
|
||||||
set cmd_log_conn ""
|
set cmd_log_conn ""
|
||||||
|
|
||||||
@ -389,11 +388,11 @@ proc scan_info_for_event {line} {
|
|||||||
}
|
}
|
||||||
if {[compare_sev $sev $highest_total_sev] >= 0} {
|
if {[compare_sev $sev $highest_total_sev] >= 0} {
|
||||||
set highest_total_sev $sev
|
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} {
|
if {[compare_sev $sev $highest_cmd_sev] >= 0} {
|
||||||
set highest_cmd_sev $sev
|
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
|
# Verify that the connected process runs a xorriso program that is modern
|
||||||
# enough. This is done before sending xorriso the setup commands.
|
# 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 -iso_rr_pattern off"
|
||||||
set cmd "$cmd -disk_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
|
send_marked_cmd $cmd
|
||||||
inquire_severity_list
|
inquire_severity_list
|
||||||
@ -818,6 +875,7 @@ proc xorriso_loggable_init_cmds {} {
|
|||||||
# image manipulations. So for now -hardlinks is set to off.
|
# image manipulations. So for now -hardlinks is set to off.
|
||||||
set cmd "$cmd -hardlinks off"
|
set cmd "$cmd -hardlinks off"
|
||||||
|
|
||||||
|
set cmd "$cmd -backslash_codes on"
|
||||||
set cmd "$cmd -follow mount:limit=100"
|
set cmd "$cmd -follow mount:limit=100"
|
||||||
return $cmd
|
return $cmd
|
||||||
}
|
}
|
||||||
@ -856,7 +914,7 @@ proc effectuate_permission_policy {} {
|
|||||||
# of e.g. -lsl into single words from which this frontend can pick information.
|
# of e.g. -lsl into single words from which this frontend can pick information.
|
||||||
#
|
#
|
||||||
proc start_bulkparse {prefix separators max_words flag num_lines} {
|
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
|
global bulk_parse_max_words bulk_parse_flag bulk_parse_num_texts
|
||||||
|
|
||||||
if {$num_lines <= 0} {return ""}
|
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_max_words $max_words
|
||||||
set bulk_parse_flag $flag
|
set bulk_parse_flag $flag
|
||||||
set bulk_parse_num_texts $num_lines
|
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} {
|
proc submit_bulkparse {text} {
|
||||||
global cmd_conn reply_conn
|
global cmd_conn reply_conn
|
||||||
global result_list result_count
|
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
|
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 disp_en_mem [set_display_msg 0]
|
||||||
|
|
||||||
set num_lines [expr [count_newlines $text] + 1]
|
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"
|
debug_log_puts ">>>>> $num_lines"
|
||||||
puts $cmd_conn $num_lines
|
puts $cmd_conn $num_lines
|
||||||
}
|
|
||||||
debug_log_puts ">>>>> $text"
|
debug_log_puts ">>>>> $text"
|
||||||
puts $cmd_conn $text
|
puts $cmd_conn $text
|
||||||
flush $cmd_conn
|
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
|
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.
|
# Each input line of the parser yields one reply buffer full of parsed words.
|
||||||
#
|
#
|
||||||
proc read_bulkparse {handler_proc num_texts} {
|
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]
|
set disp_en_mem [set_display_msg 0]
|
||||||
for {set i 0} {$i < $num_texts} {incr i} {
|
for {set i 0} {$i < $num_texts} {incr i} {
|
||||||
clear_reply_lists
|
clear_reply_lists
|
||||||
@ -947,21 +973,47 @@ proc read_parse_reply {} {
|
|||||||
global reply_conn
|
global reply_conn
|
||||||
global result_list result_count
|
global result_list result_count
|
||||||
|
|
||||||
|
set sieve_result_count 0
|
||||||
|
set payload ""
|
||||||
|
set num_lines 0
|
||||||
|
set acc ""
|
||||||
set loop_limit 2
|
set loop_limit 2
|
||||||
while {$result_count < $loop_limit} {
|
while {$result_count < $loop_limit} {
|
||||||
set ret [gets $reply_conn line]
|
set ret [gets $reply_conn line]
|
||||||
if {$ret < 0} { return ""}
|
if {$ret < 0} { return ""}
|
||||||
debug_log_puts $line
|
debug_log_puts $line
|
||||||
de_pkt_line $line
|
de_pkt_line $line
|
||||||
|
set line [lindex $result_list [expr $result_count-1]]
|
||||||
if {$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"]
|
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 \
|
proc handle_result_list {handler_proc \
|
||||||
prefix separators max_words flag } {
|
prefix separators max_words flag } {
|
||||||
global result_list
|
global result_list
|
||||||
global bulk_parse_mode bulk_parse_max_chunk
|
global bulk_parse_max_chunk
|
||||||
|
|
||||||
set raw_list $result_list
|
set raw_list $result_list
|
||||||
set raw_line_count [expr [llength $raw_list]]
|
set raw_line_count [expr [llength $raw_list]]
|
||||||
@ -992,10 +1044,7 @@ proc handle_result_list {handler_proc \
|
|||||||
submit_bulkparse $i
|
submit_bulkparse $i
|
||||||
incr submit_count
|
incr submit_count
|
||||||
incr submit_in_chunk_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
|
read_bulkparse $handler_proc $chunk_size
|
||||||
set todo [expr "$raw_line_count - $submit_count"]
|
set todo [expr "$raw_line_count - $submit_count"]
|
||||||
if {$todo <= 0} {
|
if {$todo <= 0} {
|
||||||
@ -1455,7 +1504,6 @@ proc isodir_return {caller} {
|
|||||||
global isodir_is_pwd highest_cmd_sev highest_cmd_sev_msg
|
global isodir_is_pwd highest_cmd_sev highest_cmd_sev_msg
|
||||||
global indev_adr outdev_adr eff_indev_adr
|
global indev_adr outdev_adr eff_indev_adr
|
||||||
global .isolist
|
global .isolist
|
||||||
global bulk_parse_mode
|
|
||||||
global bulk_parse_max_chunk
|
global bulk_parse_max_chunk
|
||||||
|
|
||||||
set chunk_size 0
|
set chunk_size 0
|
||||||
@ -1537,11 +1585,7 @@ proc pick_isodir {} {
|
|||||||
return ""
|
return ""
|
||||||
}
|
}
|
||||||
set idx [lindex $selected 0]
|
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 == "/"} {
|
if {$isodir_adr == "/"} {
|
||||||
set isodir_adr ""
|
set isodir_adr ""
|
||||||
}
|
}
|
||||||
@ -2034,7 +2078,7 @@ proc handle_overwriting {target_fs target target_ftype
|
|||||||
!= 1} { return "0" }
|
!= 1} { return "0" }
|
||||||
} else {
|
} else {
|
||||||
if {$target_fs != "isofs"} {
|
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"
|
return "0"
|
||||||
}
|
}
|
||||||
if {$overwrite_dirs == 1} {
|
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?"] \
|
"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" }
|
!= 1} { return "0" }
|
||||||
} else {
|
} 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"
|
return "0"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -2053,7 +2097,7 @@ proc handle_overwriting {target_fs target target_ftype
|
|||||||
return "0"
|
return "0"
|
||||||
}
|
}
|
||||||
} else {
|
} 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"
|
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 isomanip_move_target indev_adr outdev_adr cmd_log_target
|
||||||
global debug_log_file execute_script_adr
|
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} {
|
if {[llength $selected] == 0} {
|
||||||
set value ""
|
set value ""
|
||||||
} else {
|
} else {
|
||||||
@ -2524,6 +2572,7 @@ proc browse_tree_topic {adr_var_name} {
|
|||||||
#
|
#
|
||||||
proc browse_tree_accept_sel {adr_var_name do_return tr} {
|
proc browse_tree_accept_sel {adr_var_name do_return tr} {
|
||||||
set selected [$tr selection get]
|
set selected [$tr selection get]
|
||||||
|
|
||||||
if {[llength $selected] != 1} {
|
if {[llength $selected] != 1} {
|
||||||
xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select a single tree item before clicking the \"Accept\" button."
|
xorriso_tcltk_errmsg "xorriso-tcltk : SORRY : You must select a single tree item before clicking the \"Accept\" button."
|
||||||
return ""
|
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
|
# Move up one directory level of the file browser selection
|
||||||
#
|
#
|
||||||
proc browse_tree_up {adr_var_name tr which_fs} {
|
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"
|
-xscrollcommand "$w.treescroll_x set"
|
||||||
|
|
||||||
# ??? why doesn't <Return> work ?
|
# ??? 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
|
# 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}
|
$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
|
pack $w.text_frame -side top -expand 1 -fill both
|
||||||
}
|
}
|
||||||
raise $w
|
raise $w
|
||||||
update idletasks
|
|
||||||
if {$have_bwidget == 1} {
|
if {$have_bwidget == 1} {
|
||||||
browse_tree_populate $which_fs
|
browse_tree_populate $which_fs
|
||||||
focus $w.tree
|
focus $w.tree
|
||||||
}
|
}
|
||||||
|
update idletasks
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -2882,7 +2941,7 @@ proc display_msg {msg} {
|
|||||||
if {[.msglist index end] > $msglist_max_fill} {
|
if {[.msglist index end] > $msglist_max_fill} {
|
||||||
.msglist delete 0 0
|
.msglist delete 0 0
|
||||||
}
|
}
|
||||||
.msglist insert end [escape_newline $msg]
|
.msglist insert end [escape_newline $msg 0]
|
||||||
.msglist see [expr "[.msglist index end]-1"]
|
.msglist see [expr "[.msglist index end]-1"]
|
||||||
update idletasks
|
update idletasks
|
||||||
}
|
}
|
||||||
@ -2911,7 +2970,7 @@ proc set_display_msg {mode} {
|
|||||||
proc xorriso_tcltk_errmsg {msg} {
|
proc xorriso_tcltk_errmsg {msg} {
|
||||||
global highest_cmd_sev_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
|
display_msg $msg
|
||||||
window_ack $msg "grey" "toplevel"
|
window_ack $msg "grey" "toplevel"
|
||||||
update idletasks
|
update idletasks
|
||||||
@ -3575,7 +3634,7 @@ proc init_msgbox {} {
|
|||||||
bind_help .msglist "message box"
|
bind_help .msglist "message box"
|
||||||
set msglist_running 1
|
set msglist_running 1
|
||||||
foreach i $pre_msglist {
|
foreach i $pre_msglist {
|
||||||
display_msg [escape_newline $i]
|
display_msg [escape_newline $i 0]
|
||||||
}
|
}
|
||||||
scrollbar .msgscroll -command ".msglist yview"
|
scrollbar .msgscroll -command ".msglist yview"
|
||||||
pack .msglist -in .msgbox -side left -expand 1 -fill both
|
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
|
# 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}
|
catch {file lstat $path stbuf}
|
||||||
if {[info exists stbuf] == 1} {
|
if {[info exists stbuf] == 1} {
|
||||||
set t [string range $stbuf(type) 0 0]
|
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
|
# 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 ""
|
set result ""
|
||||||
if {[localfs_filetype $dir] != "d"} {return ""}
|
if {[localfs_filetype $dir] != "d"} {return ""}
|
||||||
set conn [open "|ls {$dir}" r]
|
set conn [open "|ls -1b [list $dir]" r]
|
||||||
while {1} {
|
while {1} {
|
||||||
set ret [gets $conn line]
|
set ret [gets $conn line]
|
||||||
if {$ret == -1} {
|
if {$ret == -1} {
|
||||||
break
|
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 adr [combine_dir_and_name $dir $line]
|
||||||
set filetype [localfs_filetype $adr]
|
set filetype [localfs_filetype $adr]
|
||||||
if {$filetype == ""} {set filetype "?"}
|
if {$filetype == ""} {set filetype "?"}
|
||||||
@ -5496,6 +5567,10 @@ proc localfs_ls {dir} {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# <<< $localfs_ls_by_sh == 1
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
# Log a command (if enabled)
|
# Log a command (if enabled)
|
||||||
#
|
#
|
||||||
proc log_command {cmd} {
|
proc log_command {cmd} {
|
||||||
@ -5680,8 +5755,31 @@ proc execute_script {close_window} {
|
|||||||
|
|
||||||
# Convert newline into \n
|
# Convert newline into \n
|
||||||
#
|
#
|
||||||
proc escape_newline {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]
|
||||||
|
}
|
||||||
|
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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -1 +1 @@
|
|||||||
#define Xorriso_timestamP "2013.01.05.214951"
|
#define Xorriso_timestamP "2013.01.05.220937"
|
||||||
|
Loading…
Reference in New Issue
Block a user