|  | #!/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 | 
|  |  | 
|  | } |