blob: aea4b3d97cfcb1fb26ec38b8b4119691b8579e1b [file] [log] [blame]
#!/usr/bin/wish
# This file provides many valuable validation procedures such as valid_value, valid_integer, etc.
my_source [list print.tcl call_stack.tcl]
proc valid_value { var_name { invalid_values {}} { valid_values {}} } {
# If the value of the variable named in var_name is not valid, print an error message and exit the program
# with a non-zero return code.
# Description of arguments:
# var_name The name of the variable whose value is to be validated.
# invalid_values A list of invalid values. If the variable value is equal to any value in
# the invalid_values list, it is deemed to be invalid. Note that if you
# specify anything for invalid_values (below), the valid_values list is not
# even processed. In other words, specify either invalid_values or
# valid_values but not both. If no value is specified for either
# invalid_values or valid_values, invalid_values will default to a list
# with one blank entry. This is useful if you simply want to ensure that
# your variable is non blank.
# valid_values A list of invalid values. The variable value must be equal to one of the
# values in this list to be considered valid.
# Call get_stack_var_level to relieve the caller of the need for declaring the variable as global.
set stack_level [get_stack_var_level $var_name]
# Access the variable value.
upvar $stack_level $var_name var_value
set len_invalid_values [llength $invalid_values]
set len_valid_values [llength $valid_values]
if { $len_valid_values > 0 && $len_invalid_values > 0 } {
append error_message "Programmer error - You must provide either an"
append error_message " invalid_values list or a valid_values"
append error_message " list but NOT both.\n"
append error_message [sprint_list invalid_values "" "" 1]
append error_message [sprint_list valid_values "" "" 1]
print_error_report $error_message
exit 1
}
set caller [get_stack_proc_name -2]
if { $caller == "valid_list" } {
set exit_on_fail 0
} else {
set exit_on_fail 1
}
if { $len_valid_values > 0 } {
# Processing the valid_values list.
if { [lsearch -exact $valid_values "${var_value}"] != -1 } { return }
append error_message "The following variable has an invalid value:\n"
append error_message [sprint_varx $var_name $var_value "" "" 1]
append error_message "\nIt must be one of the following values:\n"
append error_message [sprint_list valid_values "" "" 1]
if { $exit_on_fail } {
print_error_report $error_message
exit 1
} else {
error [sprint_error_report $error_message]
}
}
if { $len_invalid_values == 0 } {
# Assign default value.
set invalid_values [list ""]
}
# Assertion: We have an invalid_values list. Processing it now.
if { [lsearch -exact $invalid_values "${var_value}"] == -1 } { return }
if { [lsearch -exact $valid_values "${var_value}"] != -1 } { return }
append error_message "The following variable has an invalid value:\n"
append error_message [sprint_varx $var_name $var_value "" "" 1]
append error_message "\nIt must NOT be any of the following values:\n"
append error_message [sprint_list invalid_values "" "" 1]
if { $exit_on_fail } {
print_error_report $error_message
exit 1
} else {
error [sprint_error_report $error_message]
}
}
proc valid_list { var_name args } {
# If the value of the list variable named in var_name is not valid, print an error message and exit the
# program with a non-zero return code.
# Description of arguments:
# var_name The name of the variable whose value is to be validated. This variable
# should be a list. For each list alement, a call to valid_value will be
# done.
# args args will be passed directly to valid_value. Please see valid_value for
# details.
# Example call:
# set valid_procs [list "one" "two" "three"]
# set proc_names [list "zero" "one" "two" "three" "four"]
# valid_list proc_names {} ${valid_procs}
# In this example, this procedure will fail with the following message:
##(CDT) 2018/03/27 12:26:49.904870 - **ERROR** The following list has one or more invalid values (marked
# #with "*"):
#
# proc_names:
# proc_names[0]: zero*
# proc_names[1]: one
# proc_names[2]: two
# proc_names[3]: three
# proc_names[4]: four*
#
# It must be one of the following values:
#
# valid_values:
# valid_values[0]: one
# valid_values[1]: two
# valid_values[2]: three
# Call get_stack_var_level to relieve the caller of the need for declaring the variable as global.
set stack_level [get_stack_var_level $var_name]
# Access the variable value.
upvar $stack_level $var_name var_value
set ix 0
# Create a list of index values which point to invalid list elements.
set invalid_ix_list [list]
foreach list_entry $var_value {
incr ix
if { [catch {valid_value list_entry {*}$args} result] } {
lappend invalid_ix_list ${ix}
}
}
# No errors found so return.
if { [llength $invalid_ix_list] == 0 } { return }
# We want to do a print_list on the caller's list but we want to put an asterisk by each invalid entry
# (see example in prolog).
# Make the caller's variable name, contained in $var_name, directly accessible to this procedure.
upvar $stack_level $var_name $var_name
# print_list the caller's list to a string.
set printed_var [sprint_list $var_name "" "" 1]
# Now convert the caller's printed var string to a list for easy manipulation.
set printed_var_list [split $printed_var "\n"]
# Loop through the erroneous index list and mark corresponding entries in printed_var_list with asterisks.
foreach ix $invalid_ix_list {
set new_value "[lindex $printed_var_list $ix]*"
set printed_var_list [lreplace $printed_var_list ${ix} ${ix} $new_value]
}
# Convert the printed var list back to a string.
set printed_var [join $printed_var_list "\n"]
append error_message "The following list has one or more invalid values"
append error_message " (marked with \"*\"):\n\n"
append error_message $printed_var
# Determine whether the caller passed invalid_values or valid_values in order to create appropriate error
# message.
if { [lindex $args 0] != "" } {
append error_message "\nIt must NOT be any of the following values:\n\n"
set invalid_values [lindex $args 0]
append error_message [sprint_list invalid_values "" "" 1]
} else {
append error_message "\nIt must be one of the following values:\n\n"
set valid_values [lindex $args 1]
append error_message [sprint_list valid_values "" "" 1]
}
print_error_report $error_message
exit 1
}
proc valid_integer { var_name } {
# If the value of the variable named in var_name is not a valid integer, print an error message and exit
# the program with a non-zero return code.
# Description of arguments:
# var_name The name of the variable whose value is to be validated.
# Call get_stack_var_level to relieve the caller of the need for declaring the variable as global.
set stack_level [get_stack_var_level $var_name]
# Access the variable value.
upvar $stack_level $var_name var_value
if { [catch {format "0x%08x" "$var_value"} result] } {
append error_message "Invalid integer value:\n"
append error_message [sprint_varx $var_name $var_value]
print_error_report $error_message
exit 1
}
}
proc valid_dir_path { var_name { add_slash 1 } } {
# If the value of the variable named in var_name is not a valid directory path, print an error message and
# exit the program with a non-zero return code.
# Description of arguments:
# var_name The name of the variable whose value is to be validated.
# add_slash If set to 1, this procedure will add a trailing slash to the directory
# path value.
# Call get_stack_var_level to relieve the caller of the need for declaring the variable as global.
set stack_level [get_stack_var_level $var_name]
# Access the variable value.
upvar $stack_level $var_name var_value
expand_shell_string var_value
if { ![file isdirectory $var_value] } {
append error_message "The following directory does not exist:\n"
append error_message [sprint_varx $var_name $var_value "" "" 1]
print_error_report $error_message
exit 1
}
if { $add_slash } { add_trailing_string var_value / }
}
proc valid_file_path { var_name } {
# If the value of the variable named in var_name is not a valid file path, print an error message and exit
# the program with a non-zero return code.
# Description of arguments:
# var_name The name of the variable whose value is to be validated.
# Call get_stack_var_level to relieve the caller of the need for declaring the variable as global.
set stack_level [get_stack_var_level $var_name]
# Access the variable value.
upvar $stack_level $var_name var_value
expand_shell_string var_value
if { ![file isfile $var_value] } {
append error_message "The following file does not exist:\n"
append error_message [sprint_varx $var_name $var_value "" "" 1]
print_error_report $error_message
exit 1
}
}
proc get_password { {password_var_name password} } {
# Prompt user for password and return result.
# On error, print to stderr and terminate the program with non-zero return code.
set prompt\
[string trimright [sprint_varx "Please enter $password_var_name" ""] "\n"]
puts -nonewline $prompt
flush stdout
stty -echo
gets stdin password1
stty echo
puts ""
set prompt [string\
trimright [sprint_varx "Please re-enter $password_var_name" ""] "\n"]
puts -nonewline $prompt
flush stdout
stty -echo
gets stdin password2
stty echo
puts ""
if { $password1 != $password2 } {
print_error_report "Passwords do not match.\n"
gen_exit_proc 1
}
if { $password1 == "" } {
print_error_report "Need a non-blank value for $password_var_name.\n"
gen_exit_proc 1
}
return $password1
}
proc valid_password { var_name { prompt_user 1 } } {
# If the value of the variable named in var_name is not a valid password, print an error message and exit
# the program with a non-zero return code.
# Description of arguments:
# var_name The name of the variable whose value is to be validated.
# prompt_user If the variable has a blank value, prompt the user for a value.
# Call get_stack_var_level to relieve the caller of the need for declaring the variable as global.
set stack_level [get_stack_var_level $var_name]
# Access the variable value.
upvar $stack_level $var_name var_value
if { $var_value == "" && $prompt_user } {
global $var_name
set $var_name [get_password $var_name]
}
if { $var_value == "" } {
print_error_report "Need a non-blank value for $var_name.\n"
gen_exit_proc 1
}
}
proc process_pw_file_path {pw_file_path_var_name} {
# Process a password file path parameter by setting or validating the corresponding password variable.
# For example, let's say you have an os_pw_file_path parm defined. This procedure will set the global
# os_password variable.
# If there is no os_password program parm defined, then the pw_file_path must exist and will be validated
# by this procedure. If there is an os_password program parm defined, then either the os_pw_file_path must
# be valid or the os_password must be valid. Again, this procedure will verify all of this.
# When a valid pw_file_path exists, this program will read the password from it and set the global
# password variable with the value.
# Finally, this procedure will call valid_password which will prompt user if password has not been
# obtained by this point.
# Description of argument(s):
# pw_file_path_var_name The name of a global variable that contains a file path which in turn
# contains a password value. The variable name must end in "pw_file_path"
# (e.g. "os_pw_file_path").
# Verify that $pw_file_path_var_name ends with "pw_file_path".
if { ! [regexp -expanded "pw_file_path$" $pw_file_path_var_name] } {
append message "Programming error - Proc [get_stack_proc_name] its"
append message " pw_file_path_var_name parameter to contain a value that"
append message "ends in \"pw_file_path\" instead of the current value:\n"
append message [sprint_var pw_file_path_var_name]
print_error $message
gen_exit_proc 1
}
global $pw_file_path_var_name
expand_shell_string $pw_file_path_var_name
# Get the prefix portion of pw_file_path_var_name which is obtained by stripping "pw_file_path" from the
# end.
regsub -expanded {pw_file_path$} $pw_file_path_var_name {} var_prefix
# Create password_var_name.
set password_var_name ${var_prefix}password
global $password_var_name
global longoptions pos_parms
regsub -all ":" "${longoptions} ${pos_parms}" {} parm_names
if { [lsearch -exact parm_names $password_var_name] == -1 } {
# If no corresponding password program parm has been defined, then the pw_file_path must be valid.
valid_file_path $pw_file_path_var_name
}
if { [file isfile [set $pw_file_path_var_name]] } {
# Read the entire password file into a list, filtering comments out.
set file_descriptor [open [set $pw_file_path_var_name] r]
set file_data [list_filter_comments [split [read $file_descriptor] "\n"]]
close $file_descriptor
# Assign the password value to the global password variable.
set $password_var_name [lindex $file_data 0]
# Register the password to prevent printing it.
register_passwords [set $password_var_name]
}
# Validate the password, which includes prompting the user if need be.
valid_password $password_var_name
}