libisoburn/frontend/xorriso-tcltk

#!/usr/bin/wish 
#
# xorriso-tcltk
# Copyright (C) 2012 - 2013
# Thomas Schmitt <scdbackup@gmx.net>, libburnia project.
# Provided under BSD license: Use, modify, and distribute as you like.
#
# This is mainly a proof of concept for xorriso serving under a frontend.
# It exercises several fundamental gestures of communication:
# - connecting via two named pipes
# - sending commands
# - receiving replies
# - inquiring the xorriso message sieve
# - using the xorriso parsing service

# Note that any other language than Tcl/Tk could be used, if it only can
# do i/o via standard input and standard output or via named pipes.
# Further it has to perform integer arithmetics and string manipulations.
# And, well, a graphical widget set would be nice.


set own_version "1.2.5"

# Minimum version of xorriso to be used as backend provess.
# Older versions of xorriso do not offer commands -msg_op and -launch_frontend
set min_xorriso_version "1.2.5"


proc print_usage {argv0} {
  puts stderr "Usage:"
  puts stderr "  $argv0 \[options\]"
  puts stderr "Options:"
  puts stderr " All options must be given with two dashes (\"--option\") in"
  puts stderr " order to distinguish them from any options of the Tcl shell."
  puts stderr " --help"
  puts stderr "     Print this text and exit."
  puts stderr " --stdio"
  puts stderr "     Establish connection to xorriso via stdin and stdout."
  puts stderr "     E.g. when letting xorriso start this frontend program:"
  puts stderr "       xorriso -launch_frontend \$(which xorriso-tcltk) --stdio --"
  puts stderr " --named_pipes cmd_fifo reply_fifo"
  puts stderr "     Establish connection to a xorriso process started by:"
  puts stderr "       xorriso -dialog on <cmd_fifo >reply_fifo"
  puts stderr "     which is then ready for a run of:"
  puts stderr "       xorriso-tcltk --named_pipes cmd_fifo reply_fifo"
  puts stderr "     It is important that the parent of xorriso and of this"
  puts stderr "     tcl/tk frontend opens the named pipe for commands before"
  puts stderr "     it opens the named pipe for replies. This avoids deadlock."
  puts stderr " --silent_start"
  puts stderr "     Do not issue the start message xorriso-tcltk-version."
  puts stderr "     This works only if --silent_start is the first argument."
  puts stderr " --no_bwidget"
  puts stderr "     Do not try to load the Tcl/Tk package BWidget which is"
  puts stderr "     a prerequisite for the \"/\" file browser buttons."
  puts stderr " --geometry {+|-}X{+|-}Y"
  puts stderr "     Sets the position of the main window."
  puts stderr " --click_to_focus"
  puts stderr "     Chooses that input fields and list boxes get the keyboard"
  puts stderr "     focus only when being clicked by the mouse. (Default)"
  puts stderr " --auto_focus"
  puts stderr "     Chooses that the keyboard focus is where the mouse"
  puts stderr "     pointer is."
  puts stderr " --pipe_log_file path"
  puts stderr "     Set a file address for logging of xorriso commands and"
  puts stderr "     reply messages and enable this logging."
  puts stderr "     The log lines will be appended. Path \"-\" means stderr."
  puts stderr " --script_log_file path"
  puts stderr "     Set a file address for logging of major xorriso commands"
  puts stderr "     and enable this logging."
  puts stderr "     The log lines will be appended. Path \"-\" means stderr."
  puts stderr ""
  puts stderr "If neither --stdio nor --named_pipes is given, then this script"
  puts stderr "will try to locate itself in the filesystem and start a xorriso"
  puts stderr "run that launches it again."
  puts stderr ""
  puts stderr "In the running GUI, click with the rightmost mouse button on"
  puts stderr "any GUI element to get its particular help text."
  puts stderr ""
}


# ------------------------------- the frontend ----------------------------
#
# Starts xorriso, connects to it, sends commands, receives replies,
# prepares replies for GUI

# Connection to xorriso
set cmd_conn ""
set reply_conn ""

# The addresses of the named pipes, if such are used (see option -named_pipe)
set cmd_pipe_adr ""
set reply_pipe_adr ""

# The command to send (resp. the command most recently sent)
set cmdline ""
# Wether to clear the cmdline after sending
set cmdline_clear true
# Command counter
set cmd_sent 0
# Current -mark synchronization text
set mark_count 0

# Results of most recent await_all_replies 
set info_list ""
set info_count 0
set emerging_info ""
set result_list ""
set result_count 0
set emerging_result ""

# Highest severities encountered in total and with most recent command
set highest_total_sev ALL
set highest_total_sev_msg ""
set highest_cmd_sev ALL
set highest_cmd_sev_msg ""
# This one registers like highest_cmd_sev with threshold ALL
set highest_seen_cmd_sev ALL

# State of last read_sieve command
set sieve_ret 0

# How many texts to pass with one parse_bulk command
set bulk_parse_max_chunk 200
# Parse parameters
set bulk_parse_prefix ""
set bulk_parse_separators ""
set bulk_parse_max_words ""
set bulk_parse_flag ""
# The announced number of texts to parse
set bulk_parse_num_texts ""

# Whether to complain on stderr about broken pipes.
# This may be expected when xorriso is being shut down by this frontend.
set expect_broken_pipes "0"


# Local copies of xorriso state

# Addresses of drives (or image files) as shown by their text fields in the GUI
set outdev_adr ""
set indev_adr ""

# Addresses of drives (or image files) as set in xorriso (after inquire_dev)
set eff_outdev_adr ""
set eff_indev_adr ""

# Whether the medium is blank, appendable, closed, missing
set indev_medium_status "missing"
set outdev_medium_status "missing"

# What kind of medium is presented by the drive
set indev_profile ""
set outdev_profile ""

# List of known drive addresses
set devlist ""

# Intermediate storage for messages until the GUI is up with .msglist box
set pre_msglist ""

# Whether overwriting of files in the ISO model is allowed
set overwrite_iso_files 1

# If overwrite_iso_files is 1: Wether overwriting of ISO directories is allowed
set overwrite_iso_dirs 0

# Whether overwriting of files on disk is allowed
set overwrite_disk_files 0

# The file where to log commands and replies for debugging purposes
set debug_log_file ""
set debug_log_conn stderr

# Whether to log all commands and replies to the debug_log_file 
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 ""

# The address under which cmd_log_conn was opened
set cmd_log_target ""

# Whether to log essential commands: 0=off , 1=no extract , 2=with extract
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

# List of severities (gets later overridden by -msg_op list_sev -)
set xorriso_severity_list {
  ALL DEBUG UPDATE NOTE HINT WARNING SORRY MISHAP FAILURE FATAL ABORT NEVER
}
set scan_event_threshold HINT


# --------- Communication between frontend and xorriso ----------


# Open the connection to a pair of named pipes. Program option -named_pipes
#
proc init_frontend_named_pipes {cmd_pipe reply_pipe} {
  global cmd_conn
  global reply_conn

  set cmd_conn [open $cmd_pipe w]
  set reply_conn [open $reply_pipe r]

  # Note: disencouraged flags would be necessary for opening idle fifo
  # set reply_conn [open $reply_pipe {RDONLY NONBLOCK}]

}


# Send a command line to the xorriso process. Do not wait for reply.
#
proc send_async_cmd {cmd} {
  global cmd_sent cmd_conn debug_logging debug_log_conn

  display_busy 1

  debug_log_puts \
         "     =============================================================="
  debug_log_puts "       $cmd"
  display_msg "======>  $cmd" 
  incr cmd_sent
  puts $cmd_conn $cmd
  flush $cmd_conn
}


# Send a command line and a -mark command to xorriso. Wait until the
# mark message confirms that all command output has been received.
#
proc send_marked_cmd {cmd} {
  global cmd_conn mark_count

  send_async_cmd $cmd
  incr mark_count
  set mark_cmd "-mark $mark_count"
  debug_log_puts "       $mark_cmd"
  puts $cmd_conn $mark_cmd
  flush $cmd_conn
  await_all_replies
}


# Send a command and make it a candidate for the log script
#
proc send_loggable_cmd {cmd} {
  log_command $cmd
  send_marked_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.
#
proc await_all_replies {} {
  global reply_conn mark_count result_count result_list
  global info_count info_list expect_broken_pipes
  global .busy_text 

  clear_reply_lists

  while {1} {
    set ret [gets $reply_conn line]
    if {$ret < 0} {
      if {$expect_broken_pipes != 1} {
        puts stderr "EOF at reply pipe"
      }
  break
    }
    debug_log_puts $line
    if {[string range $line 0 0] == "M"} {
       if {[string range $line 5 end] == $mark_count} {
  break
       } else {
         # outdated mark message
  continue
       }
    }

    de_pkt_line $line
  }

  display_busy 0
}


# Decode -pkt_output format to complete lines and buffer them.
#
proc de_pkt_line {line} {
  global info_list
  global info_count
  global emerging_info
  global result_list
  global result_count
  global emerging_result

  # Distinguish R and I
  set ch [string range $line 0 0]

  set payload [string range $line 5 end]
  if {$ch == "R"} {
    set emerging_result "$emerging_result$payload"
  } else { if {$ch == "I"} {
    set emerging_info "$emerging_info$payload"
  } else {
    return ""
  }}

  # if line end : add to list
  if {[string range $line 2 2] == "1"} {
    if {$ch == "R"} {
      lappend result_list $emerging_result
      incr result_count
      display_msg $emerging_result
      set emerging_result ""
    } else {
      lappend info_list $emerging_info
      incr info_count
      display_msg $emerging_info
      scan_info_for_event $emerging_info
      set emerging_info ""
    }
  }
}


# Search in the decoded info messages for the most severe event reports.
#
proc scan_info_for_event {line} {
  global highest_total_sev highest_total_sev_msg
  global highest_cmd_sev highest_cmd_sev_msg highest_seen_cmd_sev
  global scan_event_threshold
  global display_msg_enabled

  # check for word : CAPS : text ...
  set ret [regexp {[a-z][a-z]*[ ]*: [A-Z][A-Z]* :} $line]
      
  if {$ret != 1} {return ""}

  # retrieve severity
  set pos [string first ":" $line]
  set sev [string range $line [expr $pos+2] end]
  set pos [string first ":" $sev]
  set sev [string range $sev 0 [expr $pos-2]];

  if {[compare_sev $sev $highest_seen_cmd_sev] > 0} {
    set highest_seen_cmd_sev $sev
  }

  if {[compare_sev $sev $scan_event_threshold] < 0} {return ""}

  if {$display_msg_enabled == 0} {
    set display_msg_enabled 1
    display_msg $line
    set display_msg_enabled 0
  }
  if {[compare_sev $sev $highest_total_sev] >= 0} {
    set highest_total_sev $sev
    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 0]
  }
}


# Unpack the output format of -msg_op read_sieve into a result_list
# of strings which each hold one parsed word.
#
proc de_sieve {} {
  global result_list
  global sieve_ret
  
  set sieve_ret [lindex $result_list 0]
  set sieve_result_count [lindex $result_list 1]

  set payload ""
  set sieve_result_count 0
  for {set i 2} {$i < [llength $result_list]} {incr i} {
    set line ""
    set num_lines [lindex $result_list $i]
    for {set j 0} {$j < $num_lines} {incr j} {
      incr i
      set line "$line[lindex $result_list $i]"
      if {$j < $num_lines - 1} {
        set line "$line\n"
      } else {
        lappend payload $line
        incr sieve_result_count  
      }  
    }
  }
  set result_list $payload
  set result_count $sieve_result_count
}


# Alternative to proc await_all_replies. It waits for a line at one of the
# three channels and displays all lines which it receives before that line.
# Used before this frontend had the opportunity to set up xorriso by commands
# like -pkt_output "on".
#
proc wait_for_msg {prefix channel} {
  global reply_conn

  if {$channel == "M"} {
    set channel_prefix "M:0: "
  } else {
    set channel_prefix "$channel:1: "
  }

  set prefix_l [string length $prefix]
  while {1} {

    # >>> Have a timeout

    set ret [gets $reply_conn line]
    if {$ret < 0} {
  break
    }
    debug_log_puts $line
    if {[string length $line] < $prefix_l} {
      display_msg $line
  continue
    }
    if {[string range $line 0 [expr $prefix_l-1]] == $prefix} {
      return [string range $line $prefix_l end]
    }
    if {[string length $line] >= [expr $prefix_l+5]} {
      if {[string range $line 0 4] == $channel_prefix} {
        if {[string range $line 5 [expr $prefix_l+4]] == $prefix} {
          return [string range $line [expr $prefix_l+5] end] 
        }
      }
    }
    display_msg $line
  }
}


# Reset the buffer for result lines and info messages.
#
proc clear_reply_lists {} {
  global info_list
  global info_count
  global emerging_info
  global result_list
  global result_count
  global emerging_result

  set info_list ""
  set info_count 0
  set emerging_info ""
  set result_list ""
  set result_count 0
  set emerging_result ""
}


# Reset the register of the most severe event for command sequences.
# Typically this is done before executing the commands of a procedure
# that is triggered by the user interface.
#
proc reset_highest_cmd_sev {} {
  global highest_cmd_sev highest_cmd_sev_msg highest_seen_cmd_sev

  set highest_cmd_sev ALL
  set highest_cmd_sev_msg ""
  set highest_seen_cmd_sev ALL
}


# Clear the recordings of the xorriso message sieve.
#
proc clear_sieve {} {
  send_silent_cmd "-msg_op clear_sieve -"
}


# Obtain a recorded item from the xorriso message sieve.
#
proc read_sieve {name} {
  send_silent_cmd "-msg_op read_sieve '$name'"
  de_sieve
}


# ------- Inquiring xorriso status -------


# Get more information about drive that was inquired by recent -toc_of.
#
proc obtain_drive_info {dev} {
  global result_list
  global sieve_ret
  global indev_medium_status outdev_medium_status
  global indev_profile outdev_profile

  set line ""

  if {$dev == "in"} {
    set indev_medium_status "missing"
    set indev_profile ""
  } else {
    set outdev_medium_status "missing"
    set outdev_profile ""
  }
  read_sieve "Media status :"
  if {$sieve_ret > 0} {
    set reply [lindex $result_list 0]
    foreach i {blank appendable closed} {
      if {[string first $i $reply] != -1} {
        set line "$i "
        if {$dev == "in"} {
          set indev_medium_status $i
        } else {
          set outdev_medium_status $i
        }
    break
      }
    }
  }
  read_sieve "Media current:"
  if {$sieve_ret > 0} {
    set profile [lindex $result_list 0]
    if {$profile == "is not recognizable"} {
      set profile "no recognizable medium"
      set line "$line$profile"
      return $line
    } else {
      set line "$line$profile, "
      if {$dev == "in"} {
        set indev_profile $profile
      } else {
        set outdev_profile $profile
      }
    }
  }
  read_sieve "Media summary:"
  if {$sieve_ret > 0} {
    set line "$line[lindex $result_list 0] sessions, "
    if {$dev == "in"} {
      set line "$line[lindex $result_list 2] used"
    } else {
      set line "$line[lindex $result_list 3] free"
    }
  }
  return $line
}


# Inquire whether changes of the ISO image are pending.
#
proc changes_are_pending {} {
  global result_count result_list

  send_silent_cmd "-changes_pending show_status"
  if {$result_count >= 1} {
    if {[lindex $result_list 0] == "-changes_pending no"} {
      return "0"
    }
    return "1"
  }
  return ""
}


# Inquire the file type of an address in the xorriso ISO image tree.
# This is a precondition for writing the session. Vice versa pending changes
# block a change of the input drive or the program end.
#
proc get_iso_filetype {adr} {
  global result_list result_count scan_event_threshold

  set scan_event_mem $scan_event_threshold
  set scan_event_threshold "SORRY"
  send_silent_cmd "-lsdl [make_text_shellsafe $adr] --"
  set scan_event_threshold $scan_event_mem
  if {$result_count <= 0} {
    return ""
  }
  return [string range [lindex $result_list 0] 0 0]
}


# Inquire whether an ISO image model has been created inside xorriso.
# This is a precondition for inserting files into the ISO tree model.
#
proc assert_iso_image {with_msg} {
  global highest_seen_cmd_sev scan_event_threshold

  set highest_seen_cmd_sev ""
  set set_mem $scan_event_threshold
  set scan_event_threshold "FATAL"
  send_silent_cmd "-lsd / --"
  set scan_event_threshold $set_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"
    }
    return "0"
  }
  return "1"
}


# Obtain the list of possible event severity names, sorted in ascending order
#
proc inquire_severity_list {} {
  global xorriso_severity_list
  global result_list

  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-msg_op list_sev -"
  set_display_msg $disp_en_mem
  if {[lindex $result_list 0] != ""} {
    set xorriso_severity_list [split [lindex $result_list 0] " "]
  }
}


# Parse-by-xorriso handler function for proc inquire_dev
#
proc set_inquired_dev {} {
  global result_list eff_indev_adr eff_outdev_adr

  if {[llength $result_list] < 2} {return ""} 
  set what [lindex $result_list 0]
  if {$what == "-dev" || $what == "-indev"} {
    set eff_indev_adr [lindex $result_list 1]
  }
  if {$what == "-dev" || $what == "-outdev"} {
    set eff_outdev_adr [lindex $result_list 1]
  }
}


# Inquire -indev and -outdev from xorriso and install in eff_indev_adr
# and eff_outdev_adr.
# (This could be done by -toc_of like in proc refresh_indev. But here
#  i demonstrate the use of command -status and parsing its result by
#  help of xorriso.)
#
proc inquire_dev {} {
  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-status -dev"
  handle_result_list set_inquired_dev "''" "''" 2 0
  set_display_msg $disp_en_mem
  update idletasks
  return ""
}


# Inquire -indev and -outdev from xorriso and install in indev_adr
# and outdev_adr.
#
proc update_dev_var {} {
  global result_list eff_indev_adr eff_outdev_adr indev_adr outdev_adr

  inquire_dev
  set indev_adr $eff_indev_adr
  set outdev_adr $eff_outdev_adr
}


# Parse-by-xorriso handler function for proc isofs_ls
#
proc isofs_ls_handler {} {
  global result_list isofs_ls_result

  if {[lindex $result_list 0] == "total"} {return ""}
  lappend isofs_ls_result \
       "[string range [lindex $result_list 0] 0 0] [lindex $result_list 8]"
}


# Produce a list of all files in a directory of the ISO model
#
proc isofs_ls {dir} {
  global isofs_ls_result

  set isofs_ls_result ""
  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-lsl [make_text_shellsafe $dir]"
  handle_result_list isofs_ls_handler "''" "''" 0 0
  set_display_msg $disp_en_mem
  return $isofs_ls_result
}


# 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 isofs_filetype {path} {
  global result_list

  set disp_en_mem [set_display_msg 0]
  send_marked_cmd "-lsdl [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]
}


# 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.
#
proc check_xorriso_version {} {
  global sieve_ret result_list pre_msglist xorriso_version min_xorriso_version
  global reply_conn

  set version "0.0.0 (= unknown)"

  set disp_en_mem [set_display_msg 0]

  # In order to see the pre-frontend messages of xorriso
  # set an individual -mark and use send_async_cmd

  set mark_text "xorriso-tcltk-version-check-[clock seconds]"
  send_async_cmd "-mark [make_text_shellsafe $mark_text]"
  set_display_msg $disp_en_mem
  wait_for_msg $mark_text "M"

  set_display_msg 0
  send_async_cmd "-version"

  set xorriso_version [wait_for_msg "xorriso version   :  " "R"]

  if {$xorriso_version < $min_xorriso_version} {
    puts stderr "xorriso-tcltk: xorriso-$xorriso_version is too old."
    puts stderr "xorriso-tcltk: Need at least version $min_xorriso_version"
    window_ack \
    "xorriso-$xorriso_version is too old. Need at least version $min_xorriso_version" \
              "red" "embedded"
    central_exit 2
  }
  set_display_msg $disp_en_mem
}


# Commands which bring the connected xorriso process into the state that
# is expected by this frontend.
#
proc setup_xorriso {} {
  set cmd ""

  # Invalidate possible -mark 1
  set cmd "$cmd -mark 0" 

  # Make replies digestible for await_all_replies
  set cmd "$cmd -pkt_output on"

  # Report version early
  set cmd "$cmd -version"

  # This frontend relies heavily on the message sieve
  set cmd "$cmd -msg_op start_sieve -"

  # -reassure questions from xorriso would not be properly handled by
  # this frontend
  set cmd "$cmd -reassure off"

  set cmd "$cmd -abort_on NEVER"
  set cmd "$cmd -return_with ABORT 32"
  set cmd "$cmd -report_about UPDATE"
  set cmd "$cmd -iso_rr_pattern off"
  set cmd "$cmd -disk_pattern off"

  set cmd "$cmd [xorriso_loggable_init_cmds]"

  send_marked_cmd $cmd
  inquire_severity_list
}


# Commands which should also be at the start of a log script
#
proc xorriso_loggable_init_cmds {} {
  set cmd "-for_backup"

  # There is a performance problem in xorriso with -hardlinks on and
  # 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
}


proc effectuate_permission_policy {} {
  global permission_policy

  if {$permission_policy == "readable"} {
    send_loggable_cmd \
             "-find / -exec chmod a+r -- -find / -type d -exec chmod a+x --"
  }
  if {$permission_policy == "readonly"} {
    send_loggable_cmd \
             "-find / -exec chmod a=r -- -find / -type d -exec chmod a+x --"
  }
  if {$permission_policy == "mkisofs_r"} {
    send_loggable_cmd \
             "-find / -exec mkisofs_r"
  }
}


# ------ Parsing by help of xorriso ------

# Parsing by xorriso takes from the frontend the burden to understand
# and implement the quoting rules of xorriso input and output.
# Lines which are supposed to consist of several words get sent to
# xorriso command -msg_op. The result lines of this command encode
# the words unambigously in one or more text lines.
# This is supposed to be safe for even the weirdest file names.
# Only NUL characters cannot be part of names.


# If enabled: Start a bulk parser job by which xorriso shall split the output
# 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_prefix bulk_parse_separators
  global bulk_parse_max_words bulk_parse_flag bulk_parse_num_texts

  if {$num_lines <= 0} {return ""}

  set bulk_parse_prefix $prefix
  set bulk_parse_separators $separators
  set bulk_parse_max_words $max_words
  set bulk_parse_flag $flag
  set bulk_parse_num_texts $num_lines
  set cmd "-msg_op parse_bulk \"$prefix $separators $max_words $flag $num_lines\""
  send_async_cmd $cmd
  # Do not wait for mark
}


# Submit a new input line to the xorriso parser. If no bulk parser job was
# started then submit a single line parser command.
#
proc submit_bulkparse {text} {
  global cmd_conn reply_conn
  global result_list result_count
  global bulk_parse_prefix bulk_parse_separators
  global bulk_parse_max_words bulk_parse_flag

  set disp_en_mem [set_display_msg 0]

  set num_lines [expr [count_newlines $text] + 1]

  debug_log_puts ">>>>>  $num_lines"
  puts $cmd_conn $num_lines
  debug_log_puts ">>>>>  $text"
  puts $cmd_conn $text
  flush $cmd_conn
  set_display_msg $disp_en_mem
}


# If a bulk parsing job was started, then read the expected number of
# replies into the result buffer and call handler_proc to inspect them.
# Each input line of the parser yields one reply buffer full of parsed words.
#
proc read_bulkparse {handler_proc num_texts} {
  set disp_en_mem [set_display_msg 0]
  for {set i 0} {$i < $num_texts} {incr i} {
    clear_reply_lists
    read_parse_reply
    $handler_proc
  }