libisoburn/frontend/xorriso-tcltk

#!/usr/bin/wish 
#
# xorriso-tcltk
# Copyright (C) 2012, Thomas Schmitt <scdbackup@gmx.net>, libburnia project.
# Provided under GNU GPL version 2 or later.
#
# 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"

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 "     Establishes 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 "     Establishes 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 " --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."
  puts stderr " --auto_focus"
  puts stderr "     Chooses that the keyboard focus is where the mouse"
  puts stderr "     pointer is. (Default)"
  puts stderr " --log_file path"
  puts stderr "     Set a file address for logging of xorriso commands and"
  puts stderr "     reply messages. The log lines will be appended."
  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

# 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
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)
set outdev_adr ""
set 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 ISO and on disk is allowed
set overwrite_files 1

# If overwrite_files is 1 : Wether overwriting of ISO directories is allowed
set overwrite_dirs 0

# The file where to log commands and replies for debugging purposes
set log_file ""
set log_conn stderr

# Whether to log all commands and replies to the log_file 
set logging 0


# 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 logging log_conn

  display_busy 1

  log_puts "     =============================================================="
  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"
  log_puts "       $mark_cmd"
  puts $cmd_conn "$mark_cmd"
  flush $cmd_conn
  await_all_replies
}


# 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
    }
    log_puts "$line"
    if {[string range "$line" 0 0] == "M"} {
       if {[string range "$line" 5 end] == "$mark_count"} {

         # <<<
         # puts stderr "sync mark"

  break
       } else {
         # outdated mark message
  continue
       }
    }

    de_pkt_line "$line"
  }

  display_busy 0

  # <<< debug
  # for {set i 0} {$i < $info_count} {incr i} {
  #   set line [lindex "$info_list" $i]
  #   puts stderr "info $i : $line"
  # }
  # for {set i 0} {$i < $result_count} {incr i} {
  #   set line [lindex "$result_list" $i]
  #   puts stderr "result $i : $line"
  # }
}


# 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"

      # <<<
      # puts stderr "result: $emerging_result"

      set emerging_result ""
    } else {
      lappend info_list "$emerging_info"
      incr info_count
      display_msg "$emerging_info"
      scan_info_for_event "$emerging_info"

      # <<<
      # puts stderr "info: $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 "$line"
  }
  if {[compare_sev "$sev" "$highest_cmd_sev"] >= 0} {
    set highest_cmd_sev "$sev"
    set highest_cmd_sev_msg "$line"
  }
}


# 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]

    # <<<
    # puts stderr "de_sieve : num_lines = $num_lines"

    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
    }
    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 {} {
  set disp_en_mem [set_display_msg 0]
  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_marked_cmd "-msg_op read_sieve '$name'"
  set_display_msg "$disp_en_mem"
  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

  set disp_en_mem [set_display_msg 0]
  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"
    }
    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"
  set disp_en_mem [set_display_msg 0]
  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 ""
  }
  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 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 / --"
  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"
    }
    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 indev_adr outdev_adr

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


# Inquire -indev and -outdev from xorriso and install in indev_adr
# and outdev_adr. Usually called when the user messed up the text fields.
# (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 {} {
  global result_list

  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 ""
}


# 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
  global reply_conn

  set min_version "1.2.5"
  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_version"} {
    puts stderr "xorriso-tcltk: xorriso-$xorriso_version is too old."
    puts stderr "xorriso-tcltk: Need at least version $min_version"
    window_ack \
    "xorriso-$xorriso_version is too old. Need at least version $min_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 -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 -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"

  send_marked_cmd "$cmd"

  inquire_severity_list
}


# ------ 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_mode 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"
  if {"$bulk_parse_mode" == 1} {
    set cmd "-msg_op parse_bulk \"$prefix $separators $max_words $flag $num_lines\""

    # <<<
    # puts stderr "start_bulkparse : $cmd"

    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_mode 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\""

    # <<<
    # puts stderr "submit_bulkparse: cmd = $cmd"

    send_async_cmd "$cmd"
  } else {
    log_puts ">>>>>  $num_lines"
    puts $cmd_conn "$num_lines"
  }
  log_puts ">>>>>  $text"
  puts $cmd_conn "$text"
  flush $cmd_conn

  # <<<
  # puts stderr "submit_bulkparse: text sent"

  if {"$bulk_parse_mode" != 1} {

    set loop_limit 2
    while {"$result_count" < "$loop_limit"} {
      set ret [gets "$reply_conn" line]
      if {"$ret" < 0} { return ""}
      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"]

        # <<<
        # puts stderr "submit_bulkparse: loop_limit = $loop_limit"

      }
    }
    de_sieve

  }
  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} {
  global bulk_parse_mode 

  if {"$bulk_parse_mode" != 1} { return ""}

  set disp_en_mem [set_display_msg 0]

  # <<<
  # puts stderr "read_bulkparse : handler_proc = $handler_proc , num_texts = $num_texts"

  for {set i 0} {"$i" < "$num_texts"} {incr i} {
    clear_reply_lists
    read_parse_reply
    $handler_proc
  }

  set_display_msg "$disp_en_mem"
}


# Read and decode the xorriso parser reply for one input line.
#
proc read_parse_reply {} {
  global reply_conn
  global result_list result_count

  set loop_limit 2
  while {"$result_count" < "$loop_limit"} {
    set ret [gets "$reply_conn" line]
    if {"$ret" < 0} { return ""}
    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"]

      # <<<
      # puts stderr "submit_bulkparse: loop_limit = $loop_limit"

    }
  }
  de_sieve
}


# Let xorriso parse the lines in the result buffer and call handler_proc
# with the parse result of each line.
# This is used to split the result lines of -lsl into words from which
# handler proc isolist_parse_handler picks the info which it displays
# in .stbox isolist .
# Note that iall parameters must be xorriso words. E.g. empty prefix or
# separator have to be submitted as tcl string "''" rather than "".
#
proc handle_result_list {handler_proc \
                         prefix separators max_words flag } {
  global result_list
  global bulk_parse_mode bulk_parse_max_chunk

  set raw_list "$result_list"
  set raw_line_count [expr [llength "$raw_list"]]
  if {"$raw_line_count" > "$bulk_parse_max_chunk"} {
    set chunk_size "$bulk_parse_max_chunk"
  } else {
    set chunk_size "$raw_line_count"
  }
  start_bulkparse "$prefix" "$separators" "$max_words" "$flag" "$chunk_size"

  # <<<
  # puts stderr "isodir_return : chunk_size = $chunk_size"

  set submit_count 0
  set submit_in_chunk_count 0
  foreach i "$raw_list" {
    # <<<
    # puts stderr "isodir_return : submit_bulkparse $i"

    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"} {

      # <<<
      # puts stderr "isodir_return : submit_in_chunk_count = $submit_in_chunk_count"

      read_bulkparse "$handler_proc" "$chunk_size"
      set todo [expr "$raw_line_count" - "$submit_count"]
      if {"$todo" <= 0} {
  break
      }
      if {"$todo" > "$bulk_parse_max_chunk"} {
        set chunk_size "$bulk_parse_max_chunk"
      } else {
        set chunk_size "$todo"
      }
      start_bulkparse "$prefix" "$separators" "$max_words" "$flag" \
                      "$chunk_size"

      # <<<
      # puts stderr "isodir_return : further chunk_size = $chunk_size"

      set submit_in_chunk_count 0
    }
  }
  display_busy 0
}


# ------------------------------- the GUI ----------------------------

# ------ State variables ------

# Whether to display messages in .msglist 
set display_msg_enabled 1

# Whether a device list is already displayed
set devices_scanned 0

# Currently displayed ISO directory
set isodir_adr ""
set isodir_is_pwd 0

# The plain names and types matching listbox .isolist
set isolist_names ""
set isolist_types ""

# The name which to select after isodir_return
set isodir_return_name ""

# The address where to move selected ISO files
set isomanip_move_target ""

# Memorized isolist selection
set memorized_isolist_selection ""

# Image file address for .burn_write_image
set burn_write_image_adr ""

# Whether to close medium after writing
set burn_write_close 0 

# Whether to force CD TAO, DVD-R Inremental, DVD+R/BD-R open ended track
set burn_write_tao 0

# Whether to engage Defect Management on formatted BD media
set burn_write_defect_mgt 0

# Answer of yes/no window
set answer_of_yesno ""

# The local filesystem address to be mapped into isodir_adr
set insert_from_adr ""

# Whether to insert with leafname of insert_from_adr underneath isodir_adr
# (else: -map $insert_from_adr $isodir_adr) 
set insert_underneath 1

# Whether to insert at or under the selected .isolist item
# rather than isodir_adr
set insert_at_selected 0

# The local filesystem address to which to extract from isodir_adr
set extract_to_adr ""

# Whether to insert with leafname of insert_from_adr underneath isodir_adr
# (else: -map $insert_from_adr $isodir_adr) 
set extract_underneath 1

# Whether to insert at or under the selected .isolist item
set extract_from_selected 0

# Whether to temporarily enforce rwx permissions for target directories on disk
set extract_auto_chmod 0

# Whether the display label .busy_text is already usable
set busy_text_exists 0

# Whether to demand a click before focus goes to entry or listbox
set click_to_focus "0"

# Whether .ack_window , .yesno_window , .help_window is already displayed 
# (>>> Better would be to block user interaction until they are gone)
set ack_window_is_active 0
set yesno_window_is_active 0
set help_window_is_active 0


# ------ GUI callback procedures ----


# Called when the Return key is hit in commandline.
#
proc cmdline_return {} {
  global cmdline cmdline_clear
  global .cmdline .cmdline_text .cmdline_entry
  global highest_cmd_sev
  global highest_cmd_sev_msg

  reset_highest_cmd_sev
  send_marked_cmd "$cmdline"
  set cmdline ""

  # To force display of GUI changes now and not some time later
  update idletasks
}


# Called when the input drive address shall be brought into effect with
# xorriso.
#
proc indev_return {} {
  global indev_adr
  global .indev_entry
  global .outdev_entry

  if {[assert_no_changes] == 0} {
    inquire_dev
    return "0"
  }
  reset_highest_cmd_sev
  send_marked_cmd "-indev [make_text_shellsafe $indev_adr]"
  set indev_mem_adr "$indev_adr"
  .indev_entry icursor 0
  refresh_indev
  return "1"
}


# Called when the "Eject" button for the input drive is hit.
#
proc eject_indev {} {
  if {[assert_no_changes] == 0} {return ""}
  reset_highest_cmd_sev
  send_marked_cmd "-eject indev"
  refresh_outdev
  refresh_indev
}


# Called when the output drive address shall be brought into effect with
# xorriso.
#
proc outdev_return {} {
  global outdev_adr indev_adr
  global .outdev_entry

  reset_highest_cmd_sev
  send_marked_cmd "-outdev [make_text_shellsafe $outdev_adr]"
  set outdev_mem_adr "$outdev_adr"
  .outdev_entry icursor 0
  refresh_outdev
  return "1"
}


# Called when the "Eject" button for the output drive is hit.
#
proc eject_outdev {} {
  global outdev_adr indev_adr

  if {"$outdev_adr" == "$indev_adr"} {
    if {[assert_no_changes] == 0} {return ""}
  }
  reset_highest_cmd_sev
  send_marked_cmd "-eject outdev"
  refresh_outdev
  refresh_indev
}


# Called when both drive addresses shall be brought into effect with xorriso.
#
proc dev_return {} {
  global outdev_adr indev_adr
  global .outdev_entry .indev_entry

  if {"$outdev_adr" != "$indev_adr"} {
    if {[indev_return] == 0} {return "0"}
    outdev_return
  } else {
    if {[assert_no_changes] == 0} {
      inquire_dev
      return "0"
    }
    reset_highest_cmd_sev
    send_marked_cmd "-dev [make_text_shellsafe $outdev_adr]"
    .outdev_entry icursor 0
    refresh_outdev
    .indev_entry icursor 0
    refresh_indev
  }
}


# Obtain and display the input drive status.
# Called after the input drive address may have changed.
#
proc refresh_indev {} {
  global result_list
  global indev_adr
  global sieve_ret
  global .indev_summary

  .indev_summary configure -text ""
  set indev_adr ""
  update idletasks

  set disp_en_mem [set_display_msg 0]
  clear_sieve
  send_marked_cmd "-toc_of in:short"
  read_sieve "Drive current:"
  set_display_msg "$disp_en_mem"
  if {"$sieve_ret" > 0} {
    set cmd [lindex "$result_list" 0]
    if {"$cmd" == "-indev" || "$cmd" == "-dev"} {
      set indev_adr [lindex "$result_list" 1]
    }
    set line [obtain_drive_info in]
    .indev_summary configure -text "$line"
  }
  .avail_label configure -text ""
  update idletasks
  isodir_return "refresh_indev"
}


# Obtain and display the output drive status.
# Called after the output drive address may have changed.
#
proc refresh_outdev {} {
  global result_list
  global outdev_adr
  global sieve_ret

  .outdev_summary configure -text ""
  set outdev_adr ""
  update idletasks

  set disp_en_mem [set_display_msg 0]
  clear_sieve
  send_marked_cmd "-toc_of out:short"
  read_sieve "Drive current:"
  set_display_msg "$disp_en_mem"
  if {"$sieve_ret" > 0} {
    set cmd [lindex "$result_list" 0]
    if {"$cmd" == "-outdev" || "$cmd" == "-dev"} {
      set outdev_adr [lindex "$result_list" 1]
    }
    set line [obtain_drive_info out]
    .outdev_summary configure -text "$line"
  }
  .avail_label configure -text ""
  update idletasks
}


# Scan the system for optical drives with rw permission
# Called when the "Scan for drives button" is hit.
#
proc scan_for_drives {} {
  global .drivelist
  global sieve_ret result_list devlist devices_scanned indev_adr outdev_adr

  if {[assert_no_changes] == 0} {return ""}
  if {"$indev_adr" != "" || "$outdev_adr" != ""} {
    if {[window_yesno \
             "Really give up aquired drives for scanning a new drive list ?"] \
      != 1} { return "" }
  }

  set max_idx [.drivelist index end]
  .drivelist delete 0 [expr "$max_idx-1"]
  set devlist ""

  reset_highest_cmd_sev
  clear_sieve
  send_marked_cmd "-devices"
  set max_idx 0
  while {1} {
    read_sieve "?  -dev"
    if {"$sieve_ret" > 0} {
      .drivelist insert end "[lindex "$result_list" 0] : [lindex "$result_list" 2] [lindex "$result_list" 3]"
      lappend devlist [lindex "$result_list" 0]
    } else {
  break
    }
  }
  while {1} {
    read_sieve "??  -dev"
    if {"$sieve_ret" > 0} {
      .drivelist insert end "[lindex "$result_list" 0] : [lindex "$result_list" 2] [lindex "$result_list" 3]"
      lappend devlist [lindex "$result_list" 0]
    } else {
  break
    }
  }
  set devices_scanned 1
  update idletasks

  # Command -devices drops all aquired drives
  refresh_indev
  refresh_outdev
}


# Refresh the display after some xorriso may have changed the status
# Called by the "Refresh state" display button and others.
#
proc refresh_state {} {
  refresh_indev
  refresh_outdev
}


# Reset the recorded Worst problem message.
# Called when the "Clear" button is hit.
#
proc clear_total_errmsg {} {
  global highest_total_sev
  global highest_total_sev_msg

  set highest_total_sev ALL
  set highest_total_sev_msg ""
  update idletasks
}


# Called when the "Pick input drive button" is hit.
#
proc pick_indev {} {
  pick_drive indev
}


# Called when the "Pick output drive button" is hit.
#
proc pick_outdev {} {
  pick_drive outdev
}


# Called when the "Pick drive for both roles" button is hit.
# or when an item in the scanned drive list is double-clicked.
#
proc pick_dev {} {
  pick_drive dev
}