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