1#!/usr/bin/wish 2 3# This file provides many valuable validation procedures such as valid_value, valid_integer, etc. 4 5my_source [list print.tcl call_stack.tcl] 6 7 8proc valid_value { var_name { invalid_values {}} { valid_values {}} } { 9 10 # If the value of the variable named in var_name is not valid, print an error message and exit the program 11 # with a non-zero return code. 12 13 # Description of arguments: 14 # var_name The name of the variable whose value is to be validated. 15 # invalid_values A list of invalid values. If the variable value is equal to any value in 16 # the invalid_values list, it is deemed to be invalid. Note that if you 17 # specify anything for invalid_values (below), the valid_values list is not 18 # even processed. In other words, specify either invalid_values or 19 # valid_values but not both. If no value is specified for either 20 # invalid_values or valid_values, invalid_values will default to a list 21 # with one blank entry. This is useful if you simply want to ensure that 22 # your variable is non blank. 23 # valid_values A list of invalid values. The variable value must be equal to one of the 24 # values in this list to be considered valid. 25 26 # Call get_stack_var_level to relieve the caller of the need for declaring the variable as global. 27 set stack_level [get_stack_var_level $var_name] 28 # Access the variable value. 29 upvar $stack_level $var_name var_value 30 31 set len_invalid_values [llength $invalid_values] 32 set len_valid_values [llength $valid_values] 33 34 if { $len_valid_values > 0 && $len_invalid_values > 0 } { 35 append error_message "Programmer error - You must provide either an" 36 append error_message " invalid_values list or a valid_values" 37 append error_message " list but NOT both.\n" 38 append error_message [sprint_list invalid_values "" "" 1] 39 append error_message [sprint_list valid_values "" "" 1] 40 print_error_report $error_message 41 exit 1 42 } 43 44 set caller [get_stack_proc_name -2] 45 if { $caller == "valid_list" } { 46 set exit_on_fail 0 47 } else { 48 set exit_on_fail 1 49 } 50 if { $len_valid_values > 0 } { 51 # Processing the valid_values list. 52 if { [lsearch -exact $valid_values "${var_value}"] != -1 } { return } 53 append error_message "The following variable has an invalid value:\n" 54 append error_message [sprint_varx $var_name $var_value "" "" 1] 55 append error_message "\nIt must be one of the following values:\n" 56 append error_message [sprint_list valid_values "" "" 1] 57 if { $exit_on_fail } { 58 print_error_report $error_message 59 exit 1 60 } else { 61 error [sprint_error_report $error_message] 62 } 63 } 64 65 if { $len_invalid_values == 0 } { 66 # Assign default value. 67 set invalid_values [list ""] 68 } 69 70 # Assertion: We have an invalid_values list. Processing it now. 71 if { [lsearch -exact $invalid_values "${var_value}"] == -1 } { return } 72 73 if { [lsearch -exact $valid_values "${var_value}"] != -1 } { return } 74 append error_message "The following variable has an invalid value:\n" 75 append error_message [sprint_varx $var_name $var_value "" "" 1] 76 append error_message "\nIt must NOT be any of the following values:\n" 77 append error_message [sprint_list invalid_values "" "" 1] 78 if { $exit_on_fail } { 79 print_error_report $error_message 80 exit 1 81 } else { 82 error [sprint_error_report $error_message] 83 } 84 85} 86 87 88proc valid_list { var_name args } { 89 90 # If the value of the list variable named in var_name is not valid, print an error message and exit the 91 # program with a non-zero return code. 92 93 # Description of arguments: 94 # var_name The name of the variable whose value is to be validated. This variable 95 # should be a list. For each list alement, a call to valid_value will be 96 # done. 97 # args args will be passed directly to valid_value. Please see valid_value for 98 # details. 99 100 # Example call: 101 102 # set valid_procs [list "one" "two" "three"] 103 # set proc_names [list "zero" "one" "two" "three" "four"] 104 # valid_list proc_names {} ${valid_procs} 105 106 # In this example, this procedure will fail with the following message: 107 108 ##(CDT) 2018/03/27 12:26:49.904870 - **ERROR** The following list has one or more invalid values (marked 109 # #with "*"): 110 # 111 # proc_names: 112 # proc_names[0]: zero* 113 # proc_names[1]: one 114 # proc_names[2]: two 115 # proc_names[3]: three 116 # proc_names[4]: four* 117 # 118 # It must be one of the following values: 119 # 120 # valid_values: 121 # valid_values[0]: one 122 # valid_values[1]: two 123 # valid_values[2]: three 124 125 # Call get_stack_var_level to relieve the caller of the need for declaring the variable as global. 126 set stack_level [get_stack_var_level $var_name] 127 # Access the variable value. 128 upvar $stack_level $var_name var_value 129 130 set ix 0 131 # Create a list of index values which point to invalid list elements. 132 set invalid_ix_list [list] 133 foreach list_entry $var_value { 134 incr ix 135 if { [catch {valid_value list_entry {*}$args} result] } { 136 lappend invalid_ix_list ${ix} 137 } 138 } 139 140 # No errors found so return. 141 if { [llength $invalid_ix_list] == 0 } { return } 142 143 # We want to do a print_list on the caller's list but we want to put an asterisk by each invalid entry 144 # (see example in prolog). 145 146 # Make the caller's variable name, contained in $var_name, directly accessible to this procedure. 147 upvar $stack_level $var_name $var_name 148 # print_list the caller's list to a string. 149 set printed_var [sprint_list $var_name "" "" 1] 150 # Now convert the caller's printed var string to a list for easy manipulation. 151 set printed_var_list [split $printed_var "\n"] 152 153 # Loop through the erroneous index list and mark corresponding entries in printed_var_list with asterisks. 154 foreach ix $invalid_ix_list { 155 set new_value "[lindex $printed_var_list $ix]*" 156 set printed_var_list [lreplace $printed_var_list ${ix} ${ix} $new_value] 157 } 158 159 # Convert the printed var list back to a string. 160 set printed_var [join $printed_var_list "\n"] 161 append error_message "The following list has one or more invalid values" 162 append error_message " (marked with \"*\"):\n\n" 163 append error_message $printed_var 164 # Determine whether the caller passed invalid_values or valid_values in order to create appropriate error 165 # message. 166 if { [lindex $args 0] != "" } { 167 append error_message "\nIt must NOT be any of the following values:\n\n" 168 set invalid_values [lindex $args 0] 169 append error_message [sprint_list invalid_values "" "" 1] 170 } else { 171 append error_message "\nIt must be one of the following values:\n\n" 172 set valid_values [lindex $args 1] 173 append error_message [sprint_list valid_values "" "" 1] 174 } 175 print_error_report $error_message 176 exit 1 177 178} 179 180 181proc valid_integer { var_name } { 182 183 # If the value of the variable named in var_name is not a valid integer, print an error message and exit 184 # the program with a non-zero return code. 185 186 # Description of arguments: 187 # var_name The name of the variable whose value is to be validated. 188 189 # Call get_stack_var_level to relieve the caller of the need for declaring the variable as global. 190 set stack_level [get_stack_var_level $var_name] 191 # Access the variable value. 192 upvar $stack_level $var_name var_value 193 194 if { [catch {format "0x%08x" "$var_value"} result] } { 195 append error_message "Invalid integer value:\n" 196 append error_message [sprint_varx $var_name $var_value] 197 print_error_report $error_message 198 exit 1 199 } 200 201} 202 203 204proc valid_dir_path { var_name { add_slash 1 } } { 205 206 # If the value of the variable named in var_name is not a valid directory path, print an error message and 207 # exit the program with a non-zero return code. 208 209 # Description of arguments: 210 # var_name The name of the variable whose value is to be validated. 211 # add_slash If set to 1, this procedure will add a trailing slash to the directory 212 # path value. 213 214 # Call get_stack_var_level to relieve the caller of the need for declaring the variable as global. 215 set stack_level [get_stack_var_level $var_name] 216 # Access the variable value. 217 upvar $stack_level $var_name var_value 218 219 expand_shell_string var_value 220 221 if { ![file isdirectory $var_value] } { 222 append error_message "The following directory does not exist:\n" 223 append error_message [sprint_varx $var_name $var_value "" "" 1] 224 print_error_report $error_message 225 exit 1 226 } 227 228 if { $add_slash } { add_trailing_string var_value / } 229 230} 231 232 233proc valid_file_path { var_name } { 234 235 # If the value of the variable named in var_name is not a valid file path, print an error message and exit 236 # the program with a non-zero return code. 237 238 # Description of arguments: 239 # var_name The name of the variable whose value is to be validated. 240 241 # Call get_stack_var_level to relieve the caller of the need for declaring the variable as global. 242 set stack_level [get_stack_var_level $var_name] 243 # Access the variable value. 244 upvar $stack_level $var_name var_value 245 246 expand_shell_string var_value 247 248 if { ![file isfile $var_value] } { 249 append error_message "The following file does not exist:\n" 250 append error_message [sprint_varx $var_name $var_value "" "" 1] 251 print_error_report $error_message 252 exit 1 253 } 254 255} 256 257 258proc get_password { {password_var_name password} } { 259 260 # Prompt user for password and return result. 261 262 # On error, print to stderr and terminate the program with non-zero return code. 263 264 set prompt\ 265 [string trimright [sprint_varx "Please enter $password_var_name" ""] "\n"] 266 puts -nonewline $prompt 267 flush stdout 268 stty -echo 269 gets stdin password1 270 stty echo 271 puts "" 272 273 set prompt [string\ 274 trimright [sprint_varx "Please re-enter $password_var_name" ""] "\n"] 275 puts -nonewline $prompt 276 flush stdout 277 stty -echo 278 gets stdin password2 279 stty echo 280 puts "" 281 282 if { $password1 != $password2 } { 283 print_error_report "Passwords do not match.\n" 284 gen_exit_proc 1 285 } 286 287 if { $password1 == "" } { 288 print_error_report "Need a non-blank value for $password_var_name.\n" 289 gen_exit_proc 1 290 } 291 292 return $password1 293 294} 295 296 297proc valid_password { var_name { prompt_user 1 } } { 298 299 # If the value of the variable named in var_name is not a valid password, print an error message and exit 300 # the program with a non-zero return code. 301 302 # Description of arguments: 303 # var_name The name of the variable whose value is to be validated. 304 # prompt_user If the variable has a blank value, prompt the user for a value. 305 306 # Call get_stack_var_level to relieve the caller of the need for declaring the variable as global. 307 set stack_level [get_stack_var_level $var_name] 308 # Access the variable value. 309 upvar $stack_level $var_name var_value 310 311 if { $var_value == "" && $prompt_user } { 312 global $var_name 313 set $var_name [get_password $var_name] 314 } 315 316 if { $var_value == "" } { 317 print_error_report "Need a non-blank value for $var_name.\n" 318 gen_exit_proc 1 319 } 320 321} 322 323 324proc process_pw_file_path {pw_file_path_var_name} { 325 326 # Process a password file path parameter by setting or validating the corresponding password variable. 327 328 # For example, let's say you have an os_pw_file_path parm defined. This procedure will set the global 329 # os_password variable. 330 331 # If there is no os_password program parm defined, then the pw_file_path must exist and will be validated 332 # by this procedure. If there is an os_password program parm defined, then either the os_pw_file_path must 333 # be valid or the os_password must be valid. Again, this procedure will verify all of this. 334 335 # When a valid pw_file_path exists, this program will read the password from it and set the global 336 # password variable with the value. 337 # Finally, this procedure will call valid_password which will prompt user if password has not been 338 # obtained by this point. 339 340 # Description of argument(s): 341 # pw_file_path_var_name The name of a global variable that contains a file path which in turn 342 # contains a password value. The variable name must end in "pw_file_path" 343 # (e.g. "os_pw_file_path"). 344 345 # Verify that $pw_file_path_var_name ends with "pw_file_path". 346 if { ! [regexp -expanded "pw_file_path$" $pw_file_path_var_name] } { 347 append message "Programming error - Proc [get_stack_proc_name] its" 348 append message " pw_file_path_var_name parameter to contain a value that" 349 append message "ends in \"pw_file_path\" instead of the current value:\n" 350 append message [sprint_var pw_file_path_var_name] 351 print_error $message 352 gen_exit_proc 1 353 } 354 355 global $pw_file_path_var_name 356 expand_shell_string $pw_file_path_var_name 357 358 # Get the prefix portion of pw_file_path_var_name which is obtained by stripping "pw_file_path" from the 359 # end. 360 regsub -expanded {pw_file_path$} $pw_file_path_var_name {} var_prefix 361 362 # Create password_var_name. 363 set password_var_name ${var_prefix}password 364 global $password_var_name 365 366 global longoptions pos_parms 367 regsub -all ":" "${longoptions} ${pos_parms}" {} parm_names 368 if { [lsearch -exact parm_names $password_var_name] == -1 } { 369 # If no corresponding password program parm has been defined, then the pw_file_path must be valid. 370 valid_file_path $pw_file_path_var_name 371 } 372 373 if { [file isfile [set $pw_file_path_var_name]] } { 374 # Read the entire password file into a list, filtering comments out. 375 set file_descriptor [open [set $pw_file_path_var_name] r] 376 set file_data [list_filter_comments [split [read $file_descriptor] "\n"]] 377 close $file_descriptor 378 379 # Assign the password value to the global password variable. 380 set $password_var_name [lindex $file_data 0] 381 # Register the password to prevent printing it. 382 register_passwords [set $password_var_name] 383 } 384 385 # Validate the password, which includes prompting the user if need be. 386 valid_password $password_var_name 387 388} 389