1 #
2 # CDDL HEADER START
3 #
4 # The contents of this file are subject to the terms of the
5 # Common Development and Distribution License (the "License").
6 # You may not use this file except in compliance with the License.
7 #
8 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
9 # or http://www.opensolaris.org/os/licensing.
10 # See the License for the specific language governing permissions
11 # and limitations under the License.
12 #
13 # When distributing Covered Code, include this CDDL HEADER in each
14 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
15 # If applicable, add the following below this CDDL HEADER, with the
16 # fields enclosed by brackets "[]" replaced with your own identifying
17 # information: Portions Copyright [yyyy] [name of copyright owner]
18 #
19 # CDDL HEADER END
20 #
21
22 #
23 # Copyright 2009 Sun Microsystems, Inc. All rights reserved.
24 # Use is subject to license terms.
25 #
26 # TCL testproc.tcl
27 # Useful procs to help during testing
28
29 # TESTROOT directory; must be set in the environment already
30 set TESTROOT $env(TESTROOT)
31
32 source [file join ${TESTROOT} tcl.init]
33
34 # NFSv4 constant:
35 set OPEN4_RESULT_CONFIRM 2
36
37
38 #--------------------------------------------------------------------
39 # Prints message to both STDOUT and log file.
40 # Usage: logputs log_file_id mesg_string
41 #
42 proc logputs { log mesg } {
43 if {[catch {puts $log $mesg} res]} {
44 puts stderr "cannot write to log file (id=$log)"
45 puts stderr $mesg
46 exit 99
47 }
48 }
49
50 #--------------------------------------------------------------------
51 # Prints messages to log/stdio's based on debug_level flag. If the
52 # debug_level is non-zero and the DEBUG flag is not on, the message
53 # string will not be printed.
54 # Usage: putmsg logid debug_level msg_string
55 #
56 proc putmsg { log debug_level mesg } {
57 global DEBUG
58 if { $debug_level == 0 || $DEBUG != 0 } {
59 if {[catch {puts $log $mesg} res]} {
60 puts stderr "cannot write to log file (id=$log)"
61 puts stderr $mesg
62 # XXX Do we need to exit here??? or Warning above is enough
63 exit 99
64 }
65 }
66 }
67
68 #--------------------------------------------------------------------
69 # Prints standard PASS/FAIL message to STDOUT
70 # Usage: logres testres
71 #
72 proc logres { tres } {
73 switch $tres {
74 PASS { puts stdout " Test PASS" }
75 FAIL { puts stdout " Test FAIL" }
76 default { puts stderr " Test result unknown" }
77 }
78 }
79
80 #--------------------------------------------------------------------
81 # Checks if server can accept nfsv4 connections
82 # Usage: ck_server server log_file_id
83 proc ck_server {SERVER log} {
84 set val [catch {connect $SERVER} res]
85 if {$val != 0} {
86 logputs $log "argv0: Server $SERVER not ready <$res>"
87 return 1
88 } else {
89 disconnect
90 return 0
91 }
92 }
93
94 #--------------------------------------------------------------------
95 # Execute compound op. Check for one of several possible result codes.
96 # Usage: check_op {op1 ... opN} {expected_status_value(s)} fail_mesg
97 # Executes the compound with operations op1 to opN, checking
98 # for any of expected errors, printing failure message and debug
99 # info to the log (stdout) if different status then expected.
100 # Return value is always the result of the compound.
101 # Expected status values is a list within braces of possible
102 # options for status (A OR B OR C ...) to declare test success.
103 # op1 to opN must be enclosed within braces.
104 #
105 proc check_op { ops exp_res_options {mesg "Test FAIL:"} {log stdout}} {
106
107 # pass tag if exists as global
108 if {[info vars ::tag] != ""} {
109 upvar 1 tag tag
110 }
111
112 set result [compound $ops]
113 if {[lsearch $exp_res_options $status] == -1} {
114 putmsg $log 0 "$mesg"
115 putmsg $log 1 "compound $ops"
116 putmsg $log 1 "$result"
117 putmsg $log 0 "status was $status expected $exp_res_options"
118 putmsg $log 1 " "
119 }
120 return $result
121 }
122
123
124 #--------------------------------------------------------------------
125 # Verifies the path is a file
126 # Usage: isafile $path
127 # path: the path to be verified in component format
128 # e.g. {export test file1}
129 # Return:
130 # type: the file-type of the $path
131 # NULL: if something failed during the process.
132 #
133 proc isafile { path } {
134 global NULL
135
136 # pass tag if exists as global
137 if {[info vars ::tag] != ""} {
138 upvar 1 tag tag
139 }
140
141 set fh [get_fh $path]
142 if {"$fh" == ""} {
143 putmsg stderr 1 "unable to get FH for <$path>"
144 return $NULL
145 }
146 set ops "Putfh $fh; Getattr type"
147 set result [compound $ops]
148 set type [lindex [lindex [lindex [lindex $result 1] 2] 0] 1]
149 if {$status != "OK"} {
150 putmsg stderr 1 \
151 "ERROR: compound \{$ops\} returned status=$status"
152 putmsg stderr 1 "result is: $result"
153 return $NULL
154 }
155 if {$type != "reg"} {
156 putmsg stderr 1 "<$path> is not a file"
157 return $NULL
158 }
159 return $type
160 }
161
162 #--------------------------------------------------------------------
163 # Verifies the path is a dir
164 # Usage: isadir $path
165 # path: the path to be verified in component format
166 # e.g. {export test dir1}
167 # Return:
168 # type: the file-type of the $path
169 # NULL: if something failed during the process.
170 #
171 proc isadir { path } {
172 global NULL
173
174 # pass tag if exists as global
175 if {[info vars ::tag] != ""} {
176 upvar 1 tag tag
177 }
178
179 set fh [get_fh $path]
180 if {"$fh" == ""} {
181 putmsg stderr 1 "unable to get FH for <$path>"
182 return $NULL
183 }
184 set ops "Putfh $fh; Getattr type"
185 set result [compound $ops]
186 set type [lindex [lindex [lindex [lindex $result 1] 2] 0] 1]
187 if {$status != "OK"} {
188 putmsg stderr 1 \
189 "ERROR: compound \{$ops\} returned status=$status"
190 putmsg stderr 1 "result is: $result"
191 return $NULL
192 }
193 if {$type != "dir"} {
194 putmsg stderr 1 "<$path> is not a directory"
195 return $NULL
196 }
197 return $type
198 }
199
200 #--------------------------------------------------------------------
201 # Kills named processes
202 # Usage: killproc $process_name
203
204 proc killproc { name } {
205 set pids [exec sh -c \
206 "ps -e | grep -w $name | sed -e 's/^ *//' -e 's/ .*//'"]
207 if { $pids != "" } {
208 exec kill $pids
209 }
210 }
211
212
213 #---------------------------------------------------------
214 # Generic test procedure to validate the result.
215 # Usage: ckres opname status expcode results prn-pass return_code
216 # return FALSE if result code error doesn't match any of expected
217 # values (one or more separated by '|' chars).
218 #
219 proc ckres {op status exp res {prn 0} {code "FAIL"}} {
220 global DEBUG
221
222 # in case more than one result is valid, create list of them
223 set nexp [split $exp '|']
224 if {[lsearch -exact $nexp $status] == -1} {
225 putmsg stderr 0 \
226 "\t Test $code: $op returned ($status), expected ($exp)"
227 putmsg stderr 1 "\t res=($res)"
228 putmsg stderr 1 " "
229 return false
230 } else {
231 if {$prn == 0} {
232 putmsg stdout 0 "\t Test PASS"
233 }
234 return true
235 }
236 }
237
238
239 #---------------------------------------------------------
240 # Generic test procedure to validate the given filehandle. The
241 # 'continue-flag' indicates if this procedure should be continued.
242 # Usage: verf_fh filehandle continue-flag prn-pass
243 # return FALSE if verification fails
244 #
245 proc verf_fh {fh cont {prn 0}} {
246 global DEBUG
247
248 # pass tag if exists as global
249 if {[info vars ::tag] != ""} {
250 upvar 1 tag tag
251 }
252
253 # stop the verification if 'continue-flag' is FALSE
254 if {[string equal $cont "false"]} { return false }
255
256 set res [compound {Putfh $fh; Getfh}]
257 if {$status != "OK"} {
258 putmsg stderr 0 "\t Test FAIL: verf_fh returned ($status)."
259 putmsg stderr 1 "\t res=($res)"
260 putmsg stderr 1 " "
261 return false
262 } else {
263 # verify the filehandle it get back is the same
264 set nfh [lindex [lindex $res 1] 2]
265 if {"$fh" != "$nfh"} {
266 putmsg stderr 0 "\t Test FAIL: verf_fh new FH is different"
267 putmsg stderr 1 "\t old fh=($fh)"
268 putmsg stderr 1 "\t new fh=($nfh)"
269 putmsg stderr 1 " "
270 return false
271 }
272 if {$prn == 0} {
273 putmsg stdout 0 "\t Test PASS"
274 }
275 }
276 }
277
278
279 #---------------------------------------------------------
280 # Generic test procedure to verify two given filehandles are the same.
281 # Usage: fh_equal FH1 FH2 continue-flag prn-pass
282 # fh1: filehandle 1 to be checked
283 # fh2: filehandle 2 to be checked
284 # cont: continue-flag (true|false) if we should continue
285 # prn: flag to indication if PASS message should be printed
286 #
287 # Return:
288 # true: if fh1 and fh2 are the same
289 # false: if filehandles are not different
290 #
291 proc fh_equal {fh1 fh2 cont prn} {
292 global DEBUG
293
294 # stop the verification if 'continue-flag' is FALSE
295 if {[string equal $cont "false"]} { return false }
296
297 if {"$fh1" != "$fh2"} {
298 if {$prn == 0} {
299 # do not print error in case user want to compare with NOT-equal
300 putmsg stderr 0 "\t Test FAIL: filehandles are not the same."
301 putmsg stderr 1 "\t fh1=($fh1)"
302 putmsg stderr 1 "\t fh2=($fh2)"
303 putmsg stderr 1 " "
304 }
305 return false
306 } else {
307 if {$prn == 0} {
308 putmsg stdout 0 "\t Test PASS"
309 }
310 return true
311 }
312 }
313
314
315 #---------------------------------------------------------
316 # Generic test procedure to create a filename longer than maxname
317 # Usage: set_maxname dir_FH
318 # dfh: the directory FH where the filename to be created
319 #
320 # Return:
321 # name: the new filename
322 # NULL: if something failed during the process.
323 #
324 proc set_maxname {dfh} {
325 global DEBUG NULL
326
327 # pass tag if exists as global
328 if {[info vars ::tag] != ""} {
329 upvar 1 tag tag
330 }
331
332 # first get the system's maxname value
333 set res [compound {Putfh $dfh; Getattr maxname}]
334 if {"$status" != "OK"} {
335 putmsg stderr 0 "\t Test UNRESOLVED: Unable to get dfh(maxname)"
336 putmsg stderr 1 "\t res=($res)"
337 putmsg stderr 1 " "
338 return $NULL
339 }
340 set maxn [lindex [lindex [lindex [lindex $res 1] 2] 0] 1]
341 set name [string repeat "a" $maxn]
342 # and add 1 extra byte
343 append name Z
344 return $name
345 }
346
347
348 #---------------------------------------------------------
349 # Test procedure to get server lease (grace) period
350 # Usage: getleasetm
351 # No argument needed
352 #
353 # Return:
354 # leasetm: the server least time
355 # -1: if anything fails during the process
356 #
357 proc getleasetm {} {
358
359 # pass tag if exists as global
360 if {[info vars ::tag] != ""} {
361 upvar 1 tag tag
362 }
363
364 set res [compound {Putrootfh; Getattr lease_time}]
365 if {$status != "OK"} {
366 putmsg stderr 1 "getleasetm failed, status=$status"
367 putmsg stderr 1 "\t res=$res"
368 return -1
369 }
370 return [extract_attr [lindex [lindex $res 1] 2] lease_time]
371 }
372
373
374 #--------------------------------------------------------------------
375 # setclient() Wrap for setclientid operation
376 # Usage: setclient verifier owner Acid Acidverf Ares {cb_prog netid addr}
377 # verifier: string to identify the client
378 # owner: owner_id to set the clientid
379 # Acid: Name of the external variable to hold the clientid
380 # Acidverf: Name of the external variable to hold the clientid verifier
381 # Ares: Name of the external variable to hold the operation's results
382 # cb_prog: the callback program
383 # netid: the callback program netid
384 # addr: the callback program address
385 #
386 # Return:
387 # Returns the status of the operation.
388 # Also the value of the clientid, clientid_verifier and results of the
389 # operation are directly stored in the variables (local to the calling
390 # environment) whose names are stored in Acid, Acidverf and Ares
391 # respectively.
392 #
393
394
395 proc setclient {verifier owner Aclientid Averifier Ares {callbck {0 0 0}}} {
396 upvar 1 $Aclientid clientid
397 upvar 1 $Averifier cid_verf
398 upvar 1 $Ares res
399
400 # pass tag if exists as global
401 if {[info vars ::tag] != ""} {
402 upvar 1 tag tag
403 }
404
405 set res [compound {Setclientid $verifier $owner $callbck}]
406 putmsg stdout 1 "\n"
407 putmsg stdout 1 "Setclientid $verifier $owner $callbck"
408 putmsg stdout 1 "Res=$res"
409 if {$status == "OK"} {
410 set clientid [lindex [lindex [lindex $res 0] 2] 0]
411 set cid_verf [lindex [lindex [lindex $res 0] 2] 1]
412 } else {
413 set clientid ""
414 set cid_verf ""
415 }
416
417 putmsg stdout 1 "return $status"
418 return $status
419 }
420
421 #--------------------------------------------------------------------
422 # setclientconf() Wrap for setclientid_confirm op.
423 # Usage: setclientconf clientid cid_verf Ares
424 # clientid: clientid provided by the server
425 # verifier: server provided verifier to identify the clientid
426 # Ares: Name of the external variable to hold the operation's results
427 #
428 # Return:
429 # Returns the status of the operation.
430 # Also the value of the results of the operation is directly stored
431 # in the variable (local to the calling environment) whose name
432 # is stored in Ares.
433 #
434
435
436 proc setclientconf {clientid verifier Ares} {
437 upvar 1 $Ares res
438
439 # pass tag if exists as global
440 if {[info vars ::tag] != ""} {
441 upvar 1 tag tag
442 }
443
444 set res [compound {Setclientid_confirm $clientid $verifier}]
445 putmsg stdout 1 "\n"
446 putmsg stdout 1 "Setclientid_confirm $clientid $verifier"
447 putmsg stdout 1 "Res: $res"
448
449 putmsg stdout 1 "return $status"
450 return $status
451 }
452
453 #---------------------------------------------------------
454 # Generic test procedure to set and confirm a clientid
455 # Usage: getclientid owner cb_prog netid addr
456 # owner: owner_id to set the clientid
457 # cb_prog: the callback program
458 # netid: the callback program netid
459 # addr: the callback program address
460 #
461 # Return:
462 # clientid: the clientid set/confirmed
463 # -1: if something failed during the process.
464 #
465 proc getclientid {owner {cb_prog 0} {netid 0} {addr 0}} {
466 global DEBUG
467
468 # default a unique verifier
469 set verifier "[pid][expr int([expr [expr rand()] * 100000000])]"
470
471 # negotiate cleintid
472 set clientid ""
473 set cidverf ""
474 set res ""
475 putmsg stdout 1 "getclientid: verifier=($verifier), owner=($owner)"
476 set status [setclient $verifier $owner clientid cidverf res \
477 {$cb_prog $netid $addr}]
478 if {$status != "OK"} {
479 putmsg stderr 0 "getclientid: Setclientid($verifier $owner) failed."
480 return -1
481 }
482
483 # confirm clientid
484 set status [setclientconf $clientid $cidverf res]
485 if {$status != "OK"} {
486 putmsg stderr 0 \
487 "getclientid: Setclientid_confirm($clientid $cidverf) failed."
488 return -1
489 }
490
491 return $clientid
492 }
493
494
495 #---------------------------------------------------------
496 # Generic test procedure to open and confirm a file
497 # Usage: basic_open dfh fname otype cid_owner Asid Aoseqid Astatus
498 # [seqid] [close] [mode] [size] [access] [deny] [ctype]
499 # dfh: directory FH where the file is located
500 # fname: the filename of the file to be opened
501 # otype: the opentype
502 # cid_owner: the {clientid owner} paire used to open the file
503 # Asid: the open_stateid to be returned
504 # Aoseqid: the open_seqid to be returned
505 # Astatus: the compound status to be returned
506 # seqid: the original seqid for OPEN, default 1
507 # close: flag to CLOSE the file or not, default "not to close"
508 # mode: the file mode for file creation, default 664
509 # size: the file size for file creation, default 0
510 # access: the file access to open the file, default READ/WRITE
511 # deny: the file deny mode to open the file, default NONE
512 # ctype: the createtype, default 0
513 #
514 # Return:
515 # nfh: the new filehandle for the opened file
516 # -1: if OPEN failed during the process.
517 # -2: if CLOSE failed during the process.
518 #
519 proc basic_open {dfh fname otype cid_owner Asid Aoseqid Astatus \
520 {seqid 1} {close 0} {mode 664} {size 0} {access 3} {deny 0} {ctype 0} } {
521 global OPEN4_RESULT_CONFIRM
522 upvar 1 $Asid stateid
523 upvar 1 $Aoseqid oseqid
524 upvar 1 $Astatus status
525
526 # pass tag if exists as global
527 if {[info vars ::tag] != ""} {
528 upvar 1 tag tag
529 } else {
530 set tag "basic_open"
531 }
532 set oseqid $seqid
533 putmsg stdout 1 " basic_open: Open $oseqid $access $deny $cid_owner"
534 putmsg stdout 1 "\t\t$otype $ctype, mode $mode, size $size, 0 $fname"
535 set res [compound {Putfh $dfh;
536 Open $oseqid $access $deny "$cid_owner" \
537 {$otype $ctype {{mode $mode} {size 0}}} {0 $fname};
538 Getfh}]
539 if {$status != "OK"} {
540 putmsg stdout 1 " basic_open: Open failed, status=($status)."
541 putmsg stdout 1 "\tRes: $res"
542 return -1
543 }
544 set stateid [lindex [lindex $res 1] 2]
545 set rflags [lindex [lindex $res 1] 4]
546 set nfh [lindex [lindex $res 2] 2]
547 # do open_confirm if needed, e.g. rflags has OPEN4_RESULT_CONFIRM set
548 if {[expr $rflags & $OPEN4_RESULT_CONFIRM] == $OPEN4_RESULT_CONFIRM} {
549 incr oseqid
550 putmsg stderr 1 " basic_open: Open_confirm $stateid $oseqid"
551 set res [compound {Putfh $nfh; Open_confirm $stateid $oseqid}]
552 if {$status != "OK"} {
553 putmsg stdout 1 \
554 " basic_open: Open_confirm failed, status=($status)."
555 putmsg stdout 1 "\tRes: $res"
556 return -2
557 }
558 set stateid [lindex [lindex $res 1] 2]
559 }
560
561 # set the size if caller specifies file(create) and size>0
562 if { ($otype == 1) && ($size > 0) } {
563 putmsg stderr 1 " basic_open: Setattr $stateid {{size $size}}"
564 set res [compound {Putfh $nfh; Setattr $stateid {{size $size}}}]
565 if {$status != "OK"} {
566 putmsg stderr 1 " basic_open: Setattr failed, status=($status)"
567 putmsg stdout 1 "\tRes: $res"
568 return -5
569 }
570 }
571
572 # if caller specify "close=1", Close the file as well.
573 if {$close == 1} {
574 incr oseqid
575 putmsg stderr 1 " basic_open: Close $oseqid $stateid"
576 set res [compound {Putfh $nfh; Close $oseqid $stateid}]
577 if {$status != "OK"} {
578 putmsg stderr 1 " basic_open: Close failed, status=($status)."
579 putmsg stdout 1 "\tRes: $res"
580 return -3
581 }
582 }
583
584 return $nfh
585 }
586
587
588 #----------------------------------------------------------------------------
589 #
590 # creatv4_file - This proc receives a full file name (path included) and
591 # optionally file parameters, to create a remote file via open.
592 # Optional parameters are file creation mode and file size.
593 # Returned value is NULL (0) if fails, or the filehandle of the new
594 # file if sucessful.
595 #
596 proc creatv4_file {apath {mode 664} {size 0}} {
597 global NULL env OPEN4_RESULT_CONFIRM
598 global DELM
599
600 # convert pathname to list, store filename and path separated;
601 set path [ path2comp $apath $DELM ]
602 set pathlen [expr [llength $path] -1]
603 set filename [lindex $path $pathlen]
604 set pathdir [lrange $path 0 [expr $pathlen - 1]]
605
606 putmsg stdout 1 " creatv4_file $apath $mode $size"
607 putmsg stdout 1 "\nfilename=$filename"
608 putmsg stdout 1 "pathdir=$pathdir"
609
610 # check if file is there (it should not, we want to create it)
611 set fh [get_fh $path]
612 if {$fh != ""} {
613 putmsg stderr 0 "File $apath already exists, no action taken."
614 return $NULL
615 }
616
617 # set string id (this is unique for each execution)
618 set id_string \
619 "[clock clicks] [expr int([expr [expr rand()] * 100000000])]]"
620
621 # negotiate cleintid
622 set clientid [getclientid $id_string]
623 if {$clientid == -1} {
624 putmsg stderr 0 "Unable to set clientid."
625 return $NULL
626 }
627
628 set dfh [get_fh $pathdir]
629 if {$dfh == ""} {
630 putmsg stderr 0 " Failed to get path directory FH."
631 return $NULL
632 }
633 # Now create the file with OPEN
634 set opentype 1
635 set createmode 0
636 set seqid 1
637 set nfh [basic_open $dfh $filename $opentype "$clientid $id_string" \
638 open_sid oseqid status $seqid 1 $mode $size]
639 putmsg stdout 1 "Open call with argument list:"
640 putmsg stdout 1 " $seqid 3 0 {$clientid $id_string}"
641 putmsg stdout 1 " {$opentype $createmode {{mode $mode} {size $size}}}"
642 putmsg stdout 1 " {0 $filename}"
643 if {($nfh < 0) && ($status != "OK")} {
644 putmsg stderr 0 "\t basic_open failed, got status=($status)"
645 return $NULL
646 }
647
648 return $nfh
649 }
650
651 #-----------------------------------------------------------------------
652 # Procedure to create a directory. Returns handle for directory or NULL.
653 #
654 proc creatv4_dir {dpath {mode 777} } {
655 global DELM
656
657 # convert pathname to list
658 set path [ path2comp $dpath $DELM ]
659 set pathlen [expr [llength $path] -1]
660 set dir_name [lindex $path $pathlen]
661 set pathdir [lrange $path 0 [expr $pathlen - 1]]
662
663 putmsg stdout 1 " creatv4_dir $dpath $dir_name $mode"
664 putmsg stdout 1 "\ndir_name=$dir_name"
665 putmsg stdout 1 "pathdir=$pathdir"
666
667 set dfh [get_fh $pathdir]
668 if {$dfh == ""} {
669 putmsg stderr 0 " Failed to get path directory FH for dir creation."
670 return $NULL
671 }
672
673 # Now create the directory.
674 set res [compound {Putfh $dfh; Create $dir_name {{mode $mode}} d; Getfh} ]
675 if {$status != "OK"} {
676 putmsg stderr 0 \
677 " creatv4_dir: Directory creation failed, status=($status)."
678 putmsg stdout 0 "\tRes: $res"
679 return $NULL
680 }
681
682 set dfh [lindex [lindex $res 2] 2]
683 return $dfh
684
685 }
686
687
688 #-----------------------------------------------------------------------
689 # Procedure to find if the server is still in the grace period
690 #
691 # Usage: chk_grace [wait_to_expire]
692 # wait_to_expire any value different from 0 causes the routine
693 # to wait until the grace period expires
694 #
695 # Return:
696 # GRACE if server is during the grace period, OK, if not, or status code
697 # on error.
698 #
699
700 proc chk_grace {{wait_to_expire 1}} {
701 global env
702
703 set fh [get_fh "$::BASEDIRS $env(TEXTFILE)"]
704 set stateid {0 0}
705 # use the lease time, as the approximation of the grace period
706 set delay $env(LEASE_TIME)
707 if {$delay <= 0} {
708 set delay 90
709 }
710 set magic_time [expr $delay/4 * 1000]
711
712 set counter 0
713 # once is used to enter the loop unconditionally the first time
714 # at that point, the rest of the loops depend on wait_to_expire only
715 set once 1
716 while {$wait_to_expire != 0 || $once == 1} {
717 set once 0
718 set res [compound {Putfh $fh; Read $stateid 0 16}]
719 # only OK or GRACE are expected
720 # or if in grace period, check if want to wait
721 if {$status == "OK" || $status != "GRACE" || \
722 $wait_to_expire == 0} {
723 return $status
724 }
725 # If still in grace, wait for 1/4 of the grace period,
726 # and try again
727 after $magic_time
728 # loop for one lease period only
729 incr counter
730 if {$counter >= 4} {
731 return $status
732 }
733 }
734 }
735
736 #---------------------------------------------------------
737 # Generic test procedure to connect to a nfsv4 server
738 # Usage: Connect runname
739 # runname: the test run name of calling program
740 # (default to the basename of pwd)
741 # Also, it uses the following globals that must be set
742 # SERVER nfsv4 server to connect to
743 # TRANSPORT tcp or udp
744 # PORT nfsv4 server port
745 # UNINITIATED error code in case normal initialization failed
746 # DELM the path delimiter
747 #
748 # Return:
749 # nothing
750 #
751
752 proc Connect { {runname ""} {do_grace 1} } {
753 global PORT TRANSPORT SERVER UNINITIATED DELM env TMPDIR
754
755 if {$runname == ""} {
756 set runname [lindex [split [pwd] $DELM] end]
757 }
758 putmsg stdout 1 "Connect {$SERVER $TRANSPORT $PORT}"
759 # connect to the test server
760 if {[catch {connect -p ${PORT} -t ${TRANSPORT} ${SERVER}} msg]} {
761 putmsg stderr 0 "$runname{init}: Setup ${TRANSPORT} connection"
762 putmsg stderr 0 \
763 "\t Test UNINITIATED: unable to connect to $SERVER"
764 putmsg stderr 0 $msg
765 exit $UNINITIATED
766 }
767 # check if server in grace once only
768 set filename [file join $TMPDIR "SERVER_NOT_IN_GRACE"]
769 if {![file exist $filename]} {
770 set fd [open $filename "w+" 0775]
771 close $fd
772 set grace 1
773 while {$do_grace == 1 && $grace > 0} {
774 set res [chk_grace]
775 if {$res == "OK"} {
776 break
777 }
778 if {$res != "GRACE"} {
779 putmsg stderr 0 \
780 "$runname{all}: error while checking if server in GRACE (got $res)"
781 putmsg stderr 0 " Test UNINITIATED"
782 exit $UNINITIATED
783 }
784 incr grace
785 # try 10 times (10 lease_periods)
786 if {$grace > 10} {
787 putmsg stderr 0 \
788 "$runname{all}: error server did not exit grace in 10 lease periods"
789 putmsg stderr 0 " Test UNINITIATED"
790 exit $UNINITIATED
791 }
792 }
793 }
794 }
795
796 #-----------------------------------------------------------------------
797 # Generic test procedure to disconnect from the nfsv4 server
798 # and wait for a period of time.
799 #
800 # Usage: Connect [waiting_time]
801 # waiting_time delay after disconnect, default 0
802 #
803 # Return:
804 # nothing
805 #
806
807 proc Disconnect {{wait_for 0}} {
808 putmsg stdout 1 "Disconnect $wait_for"
809 #Disconnect and wait for specified number of seconds
810 disconnect
811 after [expr $wait_for * 1000]
812 }
813
814 #-----------------------------------------------------------------------
815 # Procedure to get the domain for machine.
816 #
817 # Usage: get_domain machine [dns_server]
818 # machine machine name to get the domain
819 # dns_server in case getent does not use FQDN, DNS domain is used,
820 # default server is environment var DNS_SERVER
821 #
822 # Return:
823 # machine's domain if successful, or NULL on failure.
824 #
825
826 proc get_domain {machine {dns_server $::env(DNS_SERVER)}} {
827 global NULL
828 set mns ""
829 set domain ""
830 set machine [string tolower $machine]
831
832 #first attempt to get the live domain from machine:/var/run/nfs4_domain
833 if {[catch {exec rsh -n -l root $machine \
834 "cat /var/run/nfs4_domain"} mns]} {
835 putmsg stdout 1 "\trsh failed ($mns), trying DNS domain ..."
836 } else {
837 putmsg stdout 1 "\treturned $mns"
838 set domain $mns
839 # rsh will not fail when grep failed.
840 if {$domain != ""} {
841 return $domain
842 }
843 }
844
845 putmsg stdout 1 "\ncall to <get_domain $machine $dns_server>"
846 set ns "dig"
847 putmsg stdout 1 "getent hosts $machine"
848 if {[catch {exec sh -c \
849 "getent hosts $machine"} mns]} {
850 putmsg stdout 1 "\tfailed ($mns), returning NULL"
851 return $NULL
852 }
853 putmsg stdout 1 "\treturned $mns"
854
855 set ipaddr [lrange [split $mns] 0 0]
856
857 putmsg stdout 1 \
858 "$ns @$dns_server +noqu -x $ipaddr 2>&1 | grep 'PTR'"
859 if {[catch {exec sh -c \
860 "$ns @$dns_server +noqu -x $ipaddr 2>&1 | grep 'PTR'"} \
861 names]} {
862 putmsg stdout 1 "\tfailed ($names), returning NULL"
863 return $NULL
864 }
865 putmsg stdout 1 "\treturned $names"
866
867 set name ""
868 set names [lrange [split $names] 1 end]
869 if {[llength $names] == 1} {
870 set name $names
871 putmsg stdout 1 "$ns for $machine returned <$name>"
872 } else {
873 foreach i $names {
874 putmsg stdout 1 "looking for $machine in $i"
875 set lname [string tolower $i]
876 if {[string first $machine $lname] != -1} {
877 set name $lname
878 break
879 }
880 }
881 }
882 if {$name == ""} {
883 putmsg stdout 1 "warning $machine not in {$names}"
884 return $NULL
885 }
886
887 set name [lrange [split $name "."] 1 end]
888 putmsg stdout 1 "domain in list form <$name>"
889 set domain [lindex $name 0]
890 if {[llength $name] > 1} {
891 foreach i [lrange $name 1 end] {
892 set domain "$domain.$i"
893 }
894 }
895
896 set domain [string trim $domain .]
897
898 putmsg stdout 1 "\n\nThe domain for $machine is $domain\n\n"
899 return $domain
900 }
901
902 #-----------------------------------------------------------------------
903 # Procedure to test if seqid should be incremented based on status
904 #
905 # Usage: should_seqid_incr status_code
906 # status_code status code returned by compound
907 #
908 # Return:
909 # 0 if seqid should not be incremented, 1 otherwise
910 #
911
912 proc should_seqid_incr {status_code} {
913 set bad_errors "BAD_SEQID BAD_STATEID STALE_STATEID STALE_CLIENTID \
914 NOFILEHANDLE BADXDR RESOURCE"
915 if {[lsearch $bad_errors $status_code] == -1} {
916 return 1
917 } else {
918 return 0
919 }
920 }
921
922 #-----------------------------------------------------------------------
923 # Procedure to check if there is a CIPSO connection
924 # This is for Trusted Extensions testing.
925 #
926 # Usage: is_cipso <node name>
927 #
928 # Return:
929 # false if there is NOT a cipso connection
930 # true if there is a cipso connection
931 #
932
933 proc is_cipso { nodename } {
934 if {[catch {exec sh -c \
935 "/bin/test -x /usr/sbin/tninfo 2>/dev/null"}]} {
936 return false
937 }
938 if {[catch {exec sh -c \
939 "/usr/sbin/tninfo -h $nodename | grep cipso 2>/dev/null"}]} {
940 return false
941 }
942 return true
943 }
944
945 #-----------------------------------------------------------------------
946 # Procedure to get the current system time on both server and client
947 #
948 # Usage: get_sctime <server> <client>
949 #
950 # Return:
951 # string
952 #
953
954 proc get_sctime { server client } {
955 global DEBUG
956 set srvSysTime [exec rsh -n -l root $server "date"]
957 set clntSysTime [clock seconds]
958 set clntSysTime [clock format $clntSysTime]
959 set retStr "server: $server, client: $client"
960 set retStr "$retStr\n\tcurrent server time: $srvSysTime"
961 set retStr "$retStr\n\tcurrent client time: $clntSysTime"
962 }