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