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