#!/usr/bin/expect

# This file provides many valuable expect procedures like handle_timeout and
# handle_eof.

my_source [list print.tcl]


proc handle_timeout { description } {

  # Print timeout error message to stderr and exit 1.

  # Description of argument(s):
  # description                     A description of what was being expected
  #                                 (e.g. "an SOL login prompt").

  global spawn_id
  global expect_out

  set timeout [get_stack_var timeout {} 2]

  if { $timeout == 1 } {
    set seconds "second"
  } else {
    set seconds "seconds"
  }

  puts stderr ""
  print_error "Did not get ${description} after $timeout ${seconds}.\n"
  # Using uplevel to be able to access expect_out.
  if { [ catch {uplevel { puts stderr [sprint_var expect_out]}} result ] } {
    puts stderr [sprint_varx expect_out "<not set>"]
  }
  # If caller has exit_proc defined, call it.  Otherwise, just call exit.
  if { [info procs "exit_proc"] != "" } {
    exit_proc 1
  }
  exit 1

}


proc handle_eof { description } {

  # Print end-of-file error message to stderr and exit 1.

  # Description of argument(s):
  # description                     A description of what was being expected
  #                                 (e.g. "an SOL login prompt").

  global spawn_id

  puts stderr ""
  print_error "Reached end of file before getting $description.\n"
  # Using uplevel to be able to access expect_out.
  if { [ catch {uplevel { puts stderr [sprint_var expect_out]}} result ] } {
    puts stderr [sprint_varx expect_out "<not set>"]
  }
  # If caller has exit_proc defined, call it.  Otherwise, just call exit.
  if { [info procs "exit_proc"] != "" } {
    exit_proc 1
  }
  exit 1

}


proc expect_wrap {pattern_list message {timeout 15} {fail_on_timeout 1}} {

  # Run the expect command for the caller and return the list index of the
  # matching pattern.

  # This function offers the following benefits over calling the expect
  # command directly:
  # - It makes program debug easier.  When the program is run with --debug=1,
  # this function prints useful debug output.
  # - It will do standardized timeout and eof handling.

  # Description of argument(s):
  # pattern_list                    A list of patterns to be matched.  If one
  #                                 of the patterns matches, the list index of
  #                                 the matching item will be returned.  By
  #                                 default, each pattern is presumed to be a
  #                                 regex.  If the caller wishes to, they may
  #                                 precede each pattern with either of the
  #                                 following: "-re ", "-gl " or "-ex " in
  #                                 order to explicitly choose the kind of
  #                                 match to be done..
  # message                         A message explaining what is being
  #                                 expected (e.g. "an SOL login prompt").
  #                                 This will be included in output messages.
  # timeout                         The expect timeout value.
  # fail_on_timeout                 A flag governing the behavior when the
  #                                 expect command results in a timeout. If
  #                                 set to 1, this procedure will print an
  #                                 error message to standard error and exit
  #                                 the program with a non-zero return code.
  #                                 If set to 0, it will return
  #                                 [expect_wrap_timeout].

  # Example usage:
  #   set result [expect_wrap\
  #     [list $bad_user_pw_regex "sh: xauth: command not found"]\
  #     "an SOL prompt" 10]
  #
  #   switch $result {
  #     0 {
  #       puts stderr "" ; print_error "Invalid username or password.\n"
  #       exit_proc 1
  #     }
  #     1 {
  #       dict set state ssh_logged_in 1
  #     }
  #   }

  global spawn_id
  global expect_out

  # Recognized flags.
  set flags [list "-re" "-ex" "-gl"]

  # This helps debug efforts by removing leftover, stale entries.
  array unset expect_out \[1-9\],string

  # Prepare the expect statement.
  append cmd_buf "global spawn_id\n"
  append cmd_buf "global expect_out\n"
  append cmd_buf "expect {\n"
  set ix 0
  foreach pattern $pattern_list {
    # Check to see whether the caller has specified a flag (e.g. "-re",
    # "-ex", etc.) at the beginning of the pattern.
    set tokens [split $pattern " "]
    if { [lsearch $flags [lindex $tokens 0]] != -1 } {
      # Caller specified a flag.
      set flag [lindex $tokens 0]
      # Strip the flag from the pattern.
      set pattern [string range $pattern 4 end]
    } else {
      set flag "-re"
    }
    append cmd_buf "  ${flag} {$pattern} {set expect_result $ix}\n"
    incr ix
  }
  if { $fail_on_timeout } {
    append cmd_buf "  timeout {handle_timeout \$message}\n"
  } else {
    append cmd_buf "  timeout {set expect_result \[expect_wrap_timeout\]}\n"
  }
  append cmd_buf "  eof {handle_eof \$message}\n"
  append cmd_buf "}\n"

  dprint_timen "Expecting $message."
  dprint_issuing "\n${cmd_buf}"
  eval ${cmd_buf}

  dprintn ; dprint_vars expect_out expect_result

  return $expect_result

}


proc expect_wrap_timeout {} {

  # Return constant value of 1000.

  return 1000

}


proc send_wrap {buffer {add_lf 1}} {

  # Send the buffer to the spawned process.

  # This function offers the following benefits over calling the send command
  # directly:
  # - It makes program debug easier.  When the program is run with --debug=1,
  # this function prints useful debug output.

  # Description of argument(s):
  # buffer                          The string to be sent to the spawned
  #                                 process.
  # add_lf                          Send a line feed after sending the buffer.

  # Example usage.
  # Close the ssh session.
  #   send_wrap "~."
  #
  #   set expect_result [expect_wrap\
  #     [list "Connection to $host closed"]\
  #     "a connection closed message" 5]

  global spawn_id
  global expect_out

  set cmd_buf "send -- {${buffer}}"
  dprint_issuing
  eval ${cmd_buf}

  if { $add_lf } {
    send -- "\n"
    set cmd_buf "send -- \"\\n\""
    dprint_issuing
    eval ${cmd_buf}
  }

}


proc shell_command {command_string {prompt_regex} { quiet {} } \
  { test_mode {} } { show_err {} } { ignore_err {} } {trim_cr_lf 1}} {

  # Execute the command_string on the shell command line and return a list
  # consisting of 1) the return code of the command 2) the stdout/stderr.

  # It is the caller's responsibility to spawn the appropriate process
  # (ssh,telnet) and to get the process to a shell command line (by logging
  # in, etc.).

  # Description of argument(s):
  # command_string                  The command string which is to be run on
  #                                 the shell (e.g. "hostname" or "grep this
  #                                 that").
  # prompt_regex                    A regular expression to match the prompt
  #                                 for current shell to run on (e.g "/ #").
  # quiet                           Indicates whether this procedure should
  #                                 run the print_issuing() procedure which
  #                                 prints "Issuing: <cmd string>" to stdout.
  #                                 The default value is 0.
  # test_mode                       If test_mode is set, this procedure will
  #                                 not actually run the command.  If
  #                                 print_output is set, it will print
  #                                 "(test_mode) Issuing: <cmd string>" to
  #                                 stdout.  The default value is 0.
  # show_err                        If show_err is set, this procedure will
  #                                 print a standardized error report if the
  #                                 shell command returns non-zero.  The
  #                                 default value is 1.
  # ignore_err                      If ignore_err is set, this procedure will
  #                                 not fail if the shell command fails.
  #                                 However, if ignore_err is not set, this
  #                                 procedure will exit 1 if the shell command
  #                                 fails.  The default value is 1.
  # trim_cr_lf                      Trim any trailing carriage return or line
  #                                 feed from the result.

  # Set defaults (this section allows users to pass blank values for certain
  # args).
  set_var_default quiet [get_stack_var quiet 0 2]
  set_var_default test_mode 0
  set_var_default show_err 1
  set_var_default ignore_err 0
  set_var_default acceptable_shell_rcs 0

  global spawn_id
  global expect_out

  qprintn ; qprint_issuing ${command_string} ${test_mode}

  if { $test_mode } {
    return [list 0 ""]
  }

  send_wrap "${command_string}"

  set expect_result [expect_wrap\
    [list "-ex $command_string"]\
    "the echoed command" 5]
  set expect_result [expect_wrap\
    [list {[\n\r]{1,2}}]\
    "one or two line feeds" 5]
  # Note the non-greedy specification in the regex below (the "?").
  set expect_result [expect_wrap\
    [list "(.*?)$prompt_regex"]\
    "command output plus prompt" -1]
  # The command's stdout/stderr should be captured as match #1.
  set out_buf $expect_out(1,string)

  if { $trim_cr_lf } {
    set out_buf [ string trimright $out_buf "\r\n" ]
  }

  # Get rc via recursive call to this function.
  set rc 0
  set proc_name [get_stack_proc_name]
  set calling_proc_name [get_stack_proc_name -2]
  if { $calling_proc_name != $proc_name } {
    set sub_result [shell_command {echo ${?}} $prompt_regex 1]
    dprintn ; dprint_list sub_result
    set rc [lindex $sub_result 1]
  }

  if { $rc != 0 } {
    if { $show_err } {
      puts stderr "" ; print_error_report "The prior shell command failed.\n"
    }
    if { ! $ignore_err } {
      if { [info procs "exit_proc"] != "" } {
        exit_proc 1
      }
    }
  }

  return [list $rc $out_buf]

}