# PaCkAgE DaTaStReAm sct 1 3144 # end of header 0707070000000000001006440000000000030000010000001025235041000001400000000242sct/pkginfo PKG=sct NAME=System Certification Tests CATEGORY=application ARCH=IA32 VERSION=9.0.0g VENDOR=SCO CLASSES=none PSTAMP=OSR5/OSR6/UW7/UW2/OU8 05/02/01 PREDEPEND=sct 0707070000000000011006440000000000030000010000001025235041200001300000007416sct/pkgmap : 1 3144 1 d none /home ? ? ? 1 d none /home/sct 0755 bin bin 1 f none /home/sct/chwp 0755 bin bin 70310 29502 1118427786 1 f none /home/sct/chwpdump 0755 bin bin 43822 13285 1118427786 1 d none /home/sct/doc 0755 bin bin 1 f none /home/sct/doc/CONTENTS.html 0755 bin bin 521 40489 1113930782 1 f none /home/sct/doc/CTOC-scthelp.html 0755 bin bin 3069 51954 1113930782 1 f none /home/sct/doc/README 0755 bin bin 2596 30039 1114028918 1 f none /home/sct/doc/README.html 0755 bin bin 5809 19987 1114028415 1 f none /home/sct/doc/SCTDOC.book 0755 bin bin 127 10438 1113930782 1 f none /home/sct/doc/SCTDOC.desktop.osr5 0755 bin bin 135 12060 1110907570 1 f none /home/sct/doc/SCTDOC.desktop.uw7 0755 bin bin 133 11910 1110907572 1 f none /home/sct/doc/SCTDOC.hk 0755 bin bin 322 25205 1113930782 1 f none /home/sct/doc/SCTDOC.node 0755 bin bin 242 19912 1113930782 1 d none /home/sct/doc/graphics 0755 bin bin 1 f none /home/sct/doc/graphics/edit.gif 0755 bin bin 12001 58752 1113930900 1 f none /home/sct/doc/graphics/logfiles.gif 0755 bin bin 15069 39296 1113930900 1 f none /home/sct/doc/graphics/main.gif 0755 bin bin 14014 53884 1113930900 1 f none /home/sct/doc/graphics/testinprog.gif 0755 bin bin 10829 14525 1113930900 1 f none /home/sct/doc/scthelp.html 0755 bin bin 17727 12385 1113930782 1 f none /home/sct/handoff 0755 bin bin 70056 13647 1118427786 1 d none /home/sct/res 0755 bin bin 1 f none /home/sct/res/chwp.def 0755 bin bin 10208 63449 1114012352 1 f none /home/sct/res/e00folder_closed.px 0755 bin bin 661 35150 1104948355 1 f none /home/sct/res/e01folder_open.px 0755 bin bin 786 42120 1104948355 1 f none /home/sct/res/e02item_middle.px 0755 bin bin 660 34232 1104948355 1 f none /home/sct/res/e03item_last.px 0755 bin bin 660 28725 1104948355 1 f none /home/sct/res/e04hbar.px 0755 bin bin 660 31842 1104948355 1 f none /home/sct/res/e05blank.px 0755 bin bin 566 21268 1104948355 1 f none /home/sct/res/e06requiredok.px 0755 bin bin 656 27701 1106249016 1 f none /home/sct/res/e07requiredbad.px 0755 bin bin 656 27043 1106249005 1 f none /home/sct/res/eula 0755 bin bin 9132 45953 1114639185 1 f none /home/sct/res/p00disabled.px 0755 bin bin 566 21268 1104948355 1 f none /home/sct/res/p01enabled.px 0755 bin bin 662 29457 1104948355 1 f none /home/sct/res/p02running.px 0755 bin bin 662 35633 1104948355 1 f none /home/sct/res/p03stopped.px 0755 bin bin 661 35883 1104948355 1 f none /home/sct/res/p04error.px 0755 bin bin 661 29394 1104948355 1 f none /home/sct/res/p05noerror.px 0755 bin bin 566 21268 1104948355 1 f none /home/sct/res/splash.px 0755 bin bin 156716 45420 1109199823 1 f none /home/sct/sct 0755 bin bin 43174 48731 1118427786 1 f none /home/sct/sctrun 0755 bin bin 36818 8368 1118427786 1 d none /home/sct/tests 0755 bin bin 1 f none /home/sct/tests/cdrom 0755 bin bin 19760 26005 1118427787 1 f none /home/sct/tests/cdrw 0755 bin bin 19604 51899 1118427787 1 f none /home/sct/tests/cpu 0755 bin bin 19384 28484 1118427786 1 f none /home/sct/tests/disk 0755 bin bin 19420 58167 1118427786 1 f none /home/sct/tests/dvdrw 0755 bin bin 19608 50727 1118427787 1 f none /home/sct/tests/floppy 0755 bin bin 19480 42632 1118427786 1 f none /home/sct/tests/graphics 0755 bin bin 20308 28747 1118427786 1 f none /home/sct/tests/memory 0755 bin bin 18876 3350 1118427787 1 f none /home/sct/tests/mkimg 0755 bin bin 16948 21852 1118427787 1 f none /home/sct/tests/network 0755 bin bin 27560 49595 1118427786 1 f none /home/sct/tests/ostype 0755 bin bin 16424 4135 1118427787 1 f none /home/sct/tests/usbflash 0755 bin bin 19168 31340 1118427787 1 f none /home/sct/tests/usbflashrw 0755 bin bin 18812 23123 1118427787 1 f none /home/sct/tests/x11perf 0755 bin bin 738160 2990 1118427787 1 i copyright 63 4919 1107284867 1 i pkginfo 162 12258 1118425352 1 i postinstall 798 61892 1113932851 1 i preremove 645 51152 1113941772 0707070000000000021006440000000000030000010000000000000000000001300000000000TRAILER!!! CLASSES=none PSTAMP=OSR5/OSR6/UW7/UW2/OU8 05/02/01 PREDEPEND=sct 0707070000000000011006440000000000030000010000001025235041200001300000007416sct/pkgmap : 1 3144 1 d none /home ? ? ? 1 d none /home/sct 0755 bin bin 1 f none /home/sct/chwp 0755 bin bin 70310 29502 1118427786 1 f none /home/sct/chwpdump 0755 bin bin 43822 13285 110707070000000000001006440000000000030000010000001025235041000001000000000242pkginfo PKG=sct NAME=System Certification Tests CATEGORY=application ARCH=IA32 VERSION=9.0.0g VENDOR=SCO CLASSES=none PSTAMP=OSR5/OSR6/UW7/UW2/OU8 05/02/01 PREDEPEND=sct 0707070000000000011006440000000000030000010000001025235041200000700000007416pkgmap : 1 3144 1 d none /home ? ? ? 1 d none /home/sct 0755 bin bin 1 f none /home/sct/chwp 0755 bin bin 70310 29502 1118427786 1 f none /home/sct/chwpdump 0755 bin bin 43822 13285 1118427786 1 d none /home/sct/doc 0755 bin bin 1 f none /home/sct/doc/CONTENTS.html 0755 bin bin 521 40489 1113930782 1 f none /home/sct/doc/CTOC-scthelp.html 0755 bin bin 3069 51954 1113930782 1 f none /home/sct/doc/README 0755 bin bin 2596 30039 1114028918 1 f none /home/sct/doc/README.html 0755 bin bin 5809 19987 1114028415 1 f none /home/sct/doc/SCTDOC.book 0755 bin bin 127 10438 1113930782 1 f none /home/sct/doc/SCTDOC.desktop.osr5 0755 bin bin 135 12060 1110907570 1 f none /home/sct/doc/SCTDOC.desktop.uw7 0755 bin bin 133 11910 1110907572 1 f none /home/sct/doc/SCTDOC.hk 0755 bin bin 322 25205 1113930782 1 f none /home/sct/doc/SCTDOC.node 0755 bin bin 242 19912 1113930782 1 d none /home/sct/doc/graphics 0755 bin bin 1 f none /home/sct/doc/graphics/edit.gif 0755 bin bin 12001 58752 1113930900 1 f none /home/sct/doc/graphics/logfiles.gif 0755 bin bin 15069 39296 1113930900 1 f none /home/sct/doc/graphics/main.gif 0755 bin bin 14014 53884 1113930900 1 f none /home/sct/doc/graphics/testinprog.gif 0755 bin bin 10829 14525 1113930900 1 f none /home/sct/doc/scthelp.html 0755 bin bin 17727 12385 1113930782 1 f none /home/sct/handoff 0755 bin bin 70056 13647 1118427786 1 d none /home/sct/res 0755 bin bin 1 f none /home/sct/res/chwp.def 0755 bin bin 10208 63449 1114012352 1 f none /home/sct/res/e00folder_closed.px 0755 bin bin 661 35150 1104948355 1 f none /home/sct/res/e01folder_open.px 0755 bin bin 786 42120 1104948355 1 f none /home/sct/res/e02item_middle.px 0755 bin bin 660 34232 1104948355 1 f none /home/sct/res/e03item_last.px 0755 bin bin 660 28725 1104948355 1 f none /home/sct/res/e04hbar.px 0755 bin bin 660 31842 1104948355 1 f none /home/sct/res/e05blank.px 0755 bin bin 566 21268 1104948355 1 f none /home/sct/res/e06requiredok.px 0755 bin bin 656 27701 1106249016 1 f none /home/sct/res/e07requiredbad.px 0755 bin bin 656 27043 1106249005 1 f none /home/sct/res/eula 0755 bin bin 9132 45953 1114639185 1 f none /home/sct/res/p00disabled.px 0755 bin bin 566 21268 1104948355 1 f none /home/sct/res/p01enabled.px 0755 bin bin 662 29457 1104948355 1 f none /home/sct/res/p02running.px 0755 bin bin 662 35633 1104948355 1 f none /home/sct/res/p03stopped.px 0755 bin bin 661 35883 1104948355 1 f none /home/sct/res/p04error.px 0755 bin bin 661 29394 1104948355 1 f none /home/sct/res/p05noerror.px 0755 bin bin 566 21268 1104948355 1 f none /home/sct/res/splash.px 0755 bin bin 156716 45420 1109199823 1 f none /home/sct/sct 0755 bin bin 43174 48731 1118427786 1 f none /home/sct/sctrun 0755 bin bin 36818 8368 1118427786 1 d none /home/sct/tests 0755 bin bin 1 f none /home/sct/tests/cdrom 0755 bin bin 19760 26005 1118427787 1 f none /home/sct/tests/cdrw 0755 bin bin 19604 51899 1118427787 1 f none /home/sct/tests/cpu 0755 bin bin 19384 28484 1118427786 1 f none /home/sct/tests/disk 0755 bin bin 19420 58167 1118427786 1 f none /home/sct/tests/dvdrw 0755 bin bin 19608 50727 1118427787 1 f none /home/sct/tests/floppy 0755 bin bin 19480 42632 1118427786 1 f none /home/sct/tests/graphics 0755 bin bin 20308 28747 1118427786 1 f none /home/sct/tests/memory 0755 bin bin 18876 3350 1118427787 1 f none /home/sct/tests/mkimg 0755 bin bin 16948 21852 1118427787 1 f none /home/sct/tests/network 0755 bin bin 27560 49595 1118427786 1 f none /home/sct/tests/ostype 0755 bin bin 16424 4135 1118427787 1 f none /home/sct/tests/usbflash 0755 bin bin 19168 31340 1118427787 1 f none /home/sct/tests/usbflashrw 0755 bin bin 18812 23123 1118427787 1 f none /home/sct/tests/x11perf 0755 bin bin 738160 2990 1118427787 1 i copyright 63 4919 1107284867 1 i pkginfo 162 12258 1118425352 1 i postinstall 798 61892 1113932851 1 i preremove 645 51152 1113941772 0707070000000000021006440000000000030000010000001025235521200002300000211246root/home/sct/chwp #!/bin/osavtcl # # miscellaneous utilities shared by a few programs. # # globals set version 9.0.0g set RESPATH "[pwd]/res" set BINPATH "[pwd]/tests" set LICENSE "$RESPATH/license" set EULA "$RESPATH/eula" set PID [pid] set sct_config_file "$RESPATH/sct.config" # path to user created machine data file. set chwp_db_data_file "$RESPATH/chwp.data" # path where test run logs are kept set sctrun_logdir "[pwd]/logs" # path where test binaries are kept set sctrun_testdir "[pwd]/tests" # path where handoffs are created set sct_handoffdir "[pwd]/handoffs" # Test data items (cheap way to make a list work like a C structure) set TS(class) 0 set TS(type) 1 set TS(name) 2 set TS(description) 3 set TS(required) 4 set TS(media) 5 set TS(enabled) 6 set TS(mode) 7 set TS(running) 8 set TS(iteration) 9 set TS(errors) 10 set TS(pid) 11 set TS(elapsed) 12 set TS(normalstop) 13 # Configuration data items set CS(runtime) 0 set CS(netmachine) 1 set CS(ftpuser) 2 set CS(ftppass) 3 set CS(localgraphics) 4 set CS(certrun) 5 set CS(nofloppy) 6 set CS(nocdrom) 7 set CS(errormax) 8 set CS(cddevice) 9 set CS(usbdevice) 10 set CS(cdpattern) 11 # full list of run times set sct_run_list_full [list \ "1 min" "5 min" "15 min" "30 min" "1 hr" \ "2 hr" "4 hr" "8 hr" "16 hr" "24 hr" "36 hr" \ "48 hr" "72 hr" "96 hr" "120 hr" "Indefinite" ] # certification (short) list of run times. set sct_run_list_cert [list \ "36 hr" "48 hr" "72 hr" "96 hr" "120 hr" "Indefinite" ] set sct_run_indefinite_time 3600000 # # read in our saved values if any # returns zero if no file to read # proc \ sct_read_config { file } \ { global CS TS sct_config_db mainscreen_db sct_config_file if {$file == ""} { set file $sct_config_file } if {[catch {open $file r} fd] != 0} { return 0 } # silently ignore errors while {[gets $fd line] != -1} { set list [split $line ":"] set type [lindex $list 0] case $type { config { set name [lindex $list 1] set value [lindex $list 2] if {$name == "certrun"} { set sct_config_db [lreplace $sct_config_db $CS(certrun) $CS(certrun) $value] } if {$name == "runtime"} { set sct_config_db [lreplace $sct_config_db $CS(runtime) $CS(runtime) $value] } if {$name == "netmachine"} { set sct_config_db [lreplace $sct_config_db $CS(netmachine) $CS(netmachine) $value] } if {$name == "ftpuser"} { set sct_config_db [lreplace $sct_config_db $CS(ftpuser) $CS(ftpuser) $value] } if {$name == "ftppass"} { set sct_config_db [lreplace $sct_config_db $CS(ftppass) $CS(ftppass) $value] } if {$name == "localgraphics"} { set sct_config_db [lreplace $sct_config_db $CS(localgraphics) $CS(localgraphics) $value] } if {$name == "nofloppy"} { set sct_config_db [lreplace $sct_config_db $CS(nofloppy) $CS(nofloppy) $value] } if {$name == "nocdrom"} { set sct_config_db [lreplace $sct_config_db $CS(nocdrom) $CS(nocdrom) $value] } if {$name == "errormax"} { set sct_config_db [lreplace $sct_config_db $CS(errormax) $CS(errormax) $value] } if {$name == "cddevice"} { set sct_config_db [lreplace $sct_config_db $CS(cddevice) $CS(cddevice) $value] } if {$name == "cdpattern"} { set sct_config_db [lreplace $sct_config_db $CS(cdpattern) $CS(cdpattern) $value] } if {$name == "usbdevice"} { set sct_config_db [lreplace $sct_config_db $CS(usbdevice) $CS(usbdevice) $value] } } test { set name [lindex $list 1] set enabled [lindex $list 2] set mode [lindex $list 3] # find the test and update it set end [llength $mainscreen_db] loop ndx 0 $end { set entry [lindex $mainscreen_db $ndx] set tname [lindex $entry $TS(name)] if {$tname == $name} { set entry [lreplace $entry $TS(enabled) $TS(enabled) $enabled] set entry [lreplace $entry $TS(mode) $TS(mode) $mode] set mainscreen_db [lreplace $mainscreen_db $ndx $ndx $entry] } } } } } close $fd return 1 } # # write out the current configuration # proc \ sct_save_config { file } \ { global CS TS sct_config_db mainscreen_db sct_config_file BINPATH if {$file == ""} { set file $sct_config_file } if {[catch {open $file w} fd] != 0} { sct_query_eok "Unable to write file $file" sct_nop return 0 } # save config first set list $sct_config_db set certrun [lindex $list $CS(certrun)] set runtime [lindex $list $CS(runtime)] set netmachine [lindex $list $CS(netmachine)] set ftpuser [lindex $list $CS(ftpuser)] set ftppass [lindex $list $CS(ftppass)] set ostype [sct_ostype] set osversion [sct_osversion] set nofloppy [lindex $list $CS(nofloppy)] set nocdrom [lindex $list $CS(nocdrom)] set localgraphics [sct_localgraphics] set errormax [lindex $list $CS(errormax)] set cddevice [lindex $list $CS(cddevice)] set cdpattern [lindex $list $CS(cdpattern)] set usbdevice [lindex $list $CS(usbdevice)] puts $fd "config:certrun:$certrun" puts $fd "config:runtime:$runtime" puts $fd "config:netmachine:$netmachine" puts $fd "config:ftpuser:$ftpuser" puts $fd "config:ftppass:$ftppass" puts $fd "config:binpath:$BINPATH" puts $fd "config:ostype:$ostype" puts $fd "config:osversion:$osversion" puts $fd "config:localgraphics:$localgraphics" puts $fd "config:nofloppy:$nofloppy" puts $fd "config:nocdrom:$nocdrom" puts $fd "config:errormax:$errormax" puts $fd "config:cddevice:$cddevice" puts $fd "config:cdpattern:$cdpattern" puts $fd "config:usbdevice:$usbdevice" foreach entry $mainscreen_db { set name [lindex $entry $TS(name)] set enabled [lindex $entry $TS(enabled)] set mode [lindex $entry $TS(mode)] puts $fd "test:$name:$enabled:$mode" } close $fd return 1 } # load up the test list, and set all default values. proc \ sct_init_tests {} \ { global mainscreen_db sct_config_db set db "" set list [list test test cpu "CPU" "Required" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test disk "Disk" "Required" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test network "Network" "Required" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test memory "Memory" "Required" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test cdrom "CD/DVD" "Required" "CD or DVD with at least 300 Mb of data on it" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test floppy "Floppy" "Required" "Formatted Floppy with no bad spots" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test graphics "Graphics" "Optional" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test usbflash "USB Flash Mem" "Optional" "USB Flash Memory - with test pattern on it" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set mainscreen_db $db # init config data set sct_config_db "{36 hr} unknown.sco.com ftp ftp@unknown.com [sct_localgraphics] 0 0 0 100 auto auto 0" } # # get the ostype, known types are OS_OSR5, OS_OSR6, OS_UNIWARE7 # proc \ sct_ostype {} \ { global BINPATH set ostype [exec $BINPATH/ostype] return $ostype } # # get the version of the os # proc \ sct_osversion {} \ { global BINPATH set osversion [exec $BINPATH/ostype -v] return $osversion } # # given an ostype, produce a user readable form # proc \ sct_display_ostype { ostype } \ { case $ostype { OS_OSR5 { set osdisplay "Open Server 5" } OS_OSR6 { set osdisplay "Open Server 6" } OS_UNIXWARE7 { set osdisplay "UnixWare 7" } default { set osdisplay "Unknown Operating System" } } return $osdisplay } # # like split but instead of chars the entire string is the delimiter # allows multi-char delimiters. PERL had regular expressions for delimiters. # max is the maximum number of elements to split into # proc \ mysplit { string delimiter max } \ { set list "" set count 1 set len [clength $delimiter] while {$string != ""} { set ndx [string first $delimiter $string] if {$ndx < 0 || $count == $max} { lappend list $string set string "" } else { set str1 [csubstr $string 0 $ndx] lappend list $str1 set ndx [expr $ndx + $len] set string [csubstr $string $ndx 9999] } set count [expr $count + 1] } return $list } # # convert internal mode to display version # proc \ sct_mode_external { mode } \ { if {"$mode" == "Hard"} { set display_mode "Max-Stress Mode" } else { set display_mode "Certification Mode" } } # # convert external display mode to internal name # proc \ sct_mode_internal { mode } \ { if {"$mode" == "Max-Stress Mode"} { set internal_mode "Hard" } else { set internal_mode "Gentle" } } # # detect if we are in graphics mode and local # proc \ sct_localgraphics {} \ { global env # get DISPLAY from environment set list [array names env] if {[lsearch $list DISPLAY] == -1} { return 0 } set display $env(DISPLAY) set tokens [split $display ":"] set displayname [lindex $tokens 0] set hostname [exec hostname -s] if {$hostname == $displayname} { return 1 } return 0 } # # fixup our path so exec works. # we have a minimum set of path requirements. # this was provoked by /sbin and /usr/sbin being missing when # you log into X on legend., which broke hardware inquiries (hw command failed). # proc \ sct_fixpath {} \ { global env set ostype [sct_ostype] if {$ostype == "OS_OSR5"} { set minpath "/bin:/etc:/usr/bin:/tcb/bin" } if {$ostype == "OS_UNIXWARE7"} { set minpath "/sbin:/usr/sbin:/etc:/usr/bin:/usr/ccs/bin" } if {$ostype == "OS_OSR6"} { set minpath "/bin:/usr/bin:/tcb/bin:/sbin:/usr/sbin:/etc" } # make sure all required components are in the real path set envlist [split $env(PATH) ":"] set minlist [split $minpath ":"] foreach required $minlist { if {[lsearch $envlist $required] < 0} { lappend envlist $required } } set newpath [join $envlist ":"] set env(PATH) $newpath } # given a global variable name in a variable, get the value of it. proc\ ind { varname } \ { global $varname set iname "\$\{$varname\}" [eval return $iname] } # time conversion routines from my internal format "xx hr xx min xx sec" to secs proc \ sct_time_to_secs { timestr } \ { global sct_run_indefinite_time if {$timestr == "Indefinite"} { return $sct_run_indefinite_time } set list [split $timestr " "] # now we have pairs set len [llength $list] set secs 0 for {set i 0} {$i < $len} {set i [expr $i + 2]} { set str [lindex $list $i] set specndx [expr $i + 1] set specstr [lindex $list $specndx] if {$specstr == "hr"} { set secs [expr $secs + ( $str * 3600 ) ] } if {$specstr == "min"} { set secs [expr $secs + ( $str * 60 ) ] } if {$specstr == "sec"} { set secs [expr $secs + $str ] } } return $secs } # time conversion from seconds to my internal format "xx hr xx min". proc \ sct_secs_to_time { secs } \ { set remain $secs set hours [expr $remain / 3600] set remain [expr $remain % 3600] set mins [expr $remain / 60] set remain [expr $remain % 60] set secs $remain if {$hours} { set str "$hours hr $mins min $secs sec" } elseif {$mins} { set str "$mins min $secs sec" } else { set str "$secs sec" } return $str } # chwpobject.tcl # # The back-end object manager for the chwp program. # # # API is as follows: # # external routines # chwp_db_read - read the saved chwp data. Makes default file as needed. # chwp_db_write - writes modified chwp data back out - can be called as needed. # # chwp_db_container_expand(index) - mark a container as open or closed. # # chwp_db_attr_get_def(name) - get the object definition for editting. # chwp_db_attr_set(index, value) - updates the two internal views with the # new value for the attribute. index is relative to the onscreen view. # # chwp_db_version - get the database version. # chwp_db_cert_valid - get status of whether required fields are filled in. # # chwp_db_delete - delete the given container by backlink index # chwp_db_add_list - get list of valid containers to add # chwp_db_add - add the new container type to end of list # # chwp_db_def_dump - dump the object definition for comparison to CHWP website. # # internal routines (incomplete list): # chwp_dbi_make_mainscreen_db - make a new view from the internal database. # # chwp_dbi_read_def - read the definition file, validates object contents. # chwp_dbi_check_def - validate the object structure after the read. # chwp_dbi_read_data - read the data file - return error if fail. # chwp_dbi_make_data - make a default data file if read fails. # chwp_dbi_reconcile_dbs - reconcile the data file with the object definition. # # data structures maintained by these routeins: # chwp_db_def - the object definition from the definition file. # Just a list of objects, each object is a pair of items, # the key and value taken directory from the def file. # chwp_db_data - the user modified list of objects and values, # fully expanded even if values aren't defined. # mainscreen_db - the viewable portion of chwp_object_db # # db_data/mainscreen_db entry index definitions # object class: set MS(class) 0 # internal attribute/object name: set MS(name) 1 # indentation level for display: set MS(level) 2 # valid activate actions (edit/expand/del): set MS(action) 3 # containers only, if they are expanded or not.: set MS(open) 4 # attributes only, hardware hintkey and required for certification set MS(hintkey) 5 set MS(required) 6 # the description (for an attribute DisplayName). set MS(description) 7 # normally this is value entered by the user. # but for a container it is special: # contains the name of AttributeName in chwp_db_def # contains the value of AttributeName in mainscreen_db and chwp_db_data set MS(value) 8 # only in mainscreen_db, index of the db_data item it came from. set MS(backlink) 9 # list of attributes that can have multiple values set chwp_multiple [list {MustContain {}} {MayContain {}} {Attributes {}} {DisplayValues {}}] # path to chwp definition file. set chwp_db_def_file "$RESPATH/chwp.def" # # Begin chwp_db external routines # # # parse and read the definition file and the user data file. # create the default data file if not present. # if the data file version does not match the definition version, # do reconciliation. # returns if it is a new configuration or not. # proc \ chwp_db_read {} \ { global chwp_db_def global chwp_db_data mainscreen_db # phase one, read the definition file. chwp_dbi_read_def chwp_dbi_check_def # read the data file set new 0 if {[chwp_dbi_read_data] == 0} { chwp_dbi_make_data 0 set new 1 } # always reconcile for now if {[chwp_dbi_reconcile_dbs]} { echo "Updated to new chwp.def file" set new 2 } chwp_dbi_make_mainscreen_db return $new } # # save our data file # proc \ chwp_db_write {} \ { global chwp_db_data chwp_db_data_file MS global chwp_db_data_file_version if {[catch {open $chwp_db_data_file w} fd] == 0} { puts $fd "Version:$chwp_db_data_file_version:" foreach entry $chwp_db_data { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] set value [lindex $entry $MS(value)] set level [lindex $entry $MS(level)] set object [chwp_db_attr_get_def $name] set dtype "" keylget object "DisplayType" dtype if {$dtype == "TextMultiline"} { if {$level} { set prefix "\n\t\t" } else { set prefix "\n\t" } set list [split $value "\n"] set value [join $list $prefix] } set line "$class:$name:$value" if {$level} { set line "\t$line" } puts $fd $line } close $fd } } # # expand or contract the given container, index is relative to mainscreen_db # proc \ chwp_db_container_expand { index } \ { global chwp_db_data mainscreen_db MS # get the mainscreen object set object [lindex $mainscreen_db $index] set backlink [lindex $object $MS(backlink)] set entry [lindex $chwp_db_data $backlink] # change expanded state set open [lindex $entry $MS(open)] if {$open == "open"} { set open closed } else { set open open } # update the entry set entry [lreplace $entry $MS(open) $MS(open) $open] # update the data entry set chwp_db_data [lreplace $chwp_db_data $backlink $backlink $entry] chwp_dbi_make_mainscreen_db } # # given the attribute name, fetch the definition object # proc \ chwp_db_attr_get_def { name } \ { global chwp_db_def foreach entry $chwp_db_def { set tname [keylget entry ObjectName] if {$tname == $name} { return $entry } } echo "fatal error: definition for $name not found" exit 1 } # # Update both mainscreen_db and the data view with a changed object. # index is relative to mainscreen_db # proc \ chwp_db_attr_set { index entry } \ { global chwp_db_data mainscreen_db MS # get the mainscreen object set object [lindex $mainscreen_db $index] set backlink [lindex $object $MS(backlink)] # update the data entry set chwp_db_data [lreplace $chwp_db_data $backlink $backlink $entry] chwp_dbi_make_mainscreen_db } # # get the database version # proc \ chwp_db_version { } \ { global chwp_db_def_file_version chwp_db_data_file_version return $chwp_db_def_file_version } # # check if required fields are filled in for certification # proc \ chwp_db_cert_valid { passthru } \ { global chwp_db_data MS if {$passthru != "passthru" && $passthru != "nopassthru"} { echo Internal error chwp_db_cert_valid bad argument exit 1 } set valid 1 foreach entry $chwp_db_data { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] set value [lindex $entry $MS(value)] set required [lindex $entry $MS(required)] if {$name == "PassThruNumber"} { if {$passthru == "nopassthru"} { continue } } elseif {$required == ""} { continue } if {[chwp_required_attribute_valid $value]} { continue } set valid 0 break } return $valid } proc \ chwp_required_attribute_valid { value } \ { if {$value != "" && $value != "None" && $value != "Unknown"} { return 1 } return 0 } # # delete a given container, rebuild mainscreen db # proc \ chwp_db_delete { index } \ { global chwp_db_data MS # delete the container node down to the next container node or the end set start [expr $index + 1] set length [llength $chwp_db_data] for {set i $start} {$i < $length} {set i [expr $i + 1]} { set list [lindex $chwp_db_data $i] set class [lindex $list $MS(class)] set name [lindex $list $MS(name)] if {$class == "Container"} { break } } set i [expr $i - 1] set chwp_db_data [lreplace $chwp_db_data $index $i] chwp_dbi_make_mainscreen_db } # # enumerate the valid list of containers to add # proc \ chwp_db_add_list {} \ { global chwp_dbi_rootmay set list "" foreach name $chwp_dbi_rootmay { set object [chwp_dbi_def_find_object Container $name] set object [lindex $object 0] set description [keylget object DisplayName] set description [lindex $description 0] lappend list $description } return $list } # # add a new given container type, rebuild mainscreen db # proc \ chwp_db_add { tname } \ { global chwp_db_data rec_attributes MS global chwp_dbi_rootmay # translate display name to internal name foreach name $chwp_dbi_rootmay { set object [chwp_dbi_def_find_object Container $name] set object [lindex $object 0] set description [keylget object DisplayName] set description [lindex $description 0] if {$tname == $description} { set type $name } } set entry [chwp_dbi_make_new_container $type] lappend chwp_db_data $entry set attributes $rec_attributes # value of the AttributeName is filled in later foreach attribute $attributes { set entry [chwp_dbi_make_new_attribute $attribute 1] lappend chwp_db_data $entry } chwp_dbi_make_mainscreen_db } # # dump the object definitions for comparison with the CHWP website # fileter out the "None" values for various fields because those are # internal values to detect if a required field is filled in or not. # proc \ chwp_db_def_dump {} \ { global chwp_db_data chwp_data_def MS # first make a new list with all objects instantiated chwp_dbi_make_data 1 # now dump them and their complete attribute list set first 0 foreach entry $chwp_db_data { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] # get object definition set object [chwp_dbi_def_find_object $class $name] set object [lindex $object 0] set description [keylget object DisplayName] if {$class == "Container"} { if {$first} { echo } else { set first 1 } echo $description } else { # name, type, value list if not text set required "" set ret [keylget object Required required] if {$required != ""} { set required Required } else { set required Optional } set type [keylget object DisplayType] if {[csubstr $type 0 4] != "Text"} { set values [keylget object DisplayValues] # remove "None" if present. # set ndx [lsearch $values None] # if {$ndx >= 0} { # set values [lreplace $values $ndx $ndx] # } echo "\t$description $required $type $values" } else { echo "\t$description $required $type" } } } } # # Begin chwp_dbi internal routines # proc \ chwp_dbi_read_def {} \ { global chwp_db_def chwp_db_def_file chwp_db_def_file_version # open and parse the definition file into our main structure. if {[catch {open $chwp_db_def_file r} fd] != 0} { echo "Unable to open $chwp_db_def_file" exit 1 } set linenum 0 set chwp_db_def "" set object "" set attribute "" gets $fd line2 while {1} { set linenum [expr $linenum + 1] # one line behind set line $line2 # the lookahead line for blank lines and continuation lines if {[gets $fd line2] == -1} { if {$line == ""} { break } set line2 "" # fake a blank line if eof } set c [cindex $line 0] if {$c == "#"} { continue } if {$line != ""} { # check if continuation line if {[ctype space $c]} { set line [string trim $line "\t "] set attribute [concat $attribute $line] } else { set attribute $line } # if next line continuation go get it set c [cindex $line2 0] if {[ctype space $c]} { continue } } if {$attribute != ""} { # save new attribute line # verify that braces match, lrange bombs if not if {[catch {lrange $line 0 99}] != 0} { echo "$chwp_db_def_file: Syntax Error line $linenum:" echo "Mismatched curly braces" echo "$linenum:$line" exit 1 } # have a completed attribute set key [lindex $attribute 0] set val [lrange $attribute 1 999] # strip ':' set ndx [clength $key] set ndx [expr $ndx - 1] if {[cindex $key $ndx] != ":"} { echo "$chwp_db_def_file: Syntax Error line $linenum:" echo Missing key/colon: echo $linenum:$line exit 1 } set key [csubstr $key 0 $ndx] if {"$key" == ""} { echo "$chwp_db_def_file: Syntax Error line $linenum:" echo "Null key before the colon:" echo $linenum:$line exit 1 } set attribute "" # special case for version line, not part # of the object structure if {$key == "Version"} { set chwp_db_def_file_version $val continue } keylset object $key $val } if {$object == ""} { continue; } if {$line != ""} { continue } # end of a valid object, got a blank line # validate our known object types if {[keylget object "ObjectName" name] == 0} { echo "$chwp_db_def_file: Error line $linenum:" echo "Missing attribute ObjectName for object ending on line $linenum" exit 1 } if {[keylget object "ObjectType" type] == 0} { echo "$chwp_db_def_file: Error line $linenum:" echo "Missing attribute ObjectType for object ending on line $linenum" exit 1 } # validate each object type set optional "" if {$type == "RootContainer"} { set required [list ObjectName ObjectType MustContain Attributes MayContain] } elseif {$type == "Container"} { set required [list ObjectName ObjectType DisplayName Attributes MultipleObjects AttributeName] } elseif {$type == "Attribute"} { set required [list ObjectName ObjectType DisplayName DisplayType] set optional [list HintKey ReadOnly Required] keylget object "DisplayType" dtype case $dtype { SingleSelect { lappend required DisplayValues DisplayDefault } MultiSelect { lappend required DisplayValues } Text { lappend optional DisplayDefault } TextMultiline { lappend optional DisplayDefault } default { echo "$chwp_db_def_file: Error line $linenum:" echo "Bad attribute DisplayType for object ending on line $linenum" exit 1 } } if {[keylget object "Required" mtype]} { if {$mtype != "Yes"} { echo "Bad value for Required for object ending on line $linenum, only Yes value is allowed" exit 1 } } } else { echo "$chwp_db_def_file: Error line $linenum:" echo "Bad ObjectType: $type for object ending on line $linenum" exit 1 } chwp_dbi_validate_object_def $object $chwp_db_def_file $linenum $required $optional lappend chwp_db_def $object set object "" } close $fd # if any remnants then a trailing newline was missing. if {$object != ""} { echo "$chwp_db_def_file: Error line $linenum:" echo "Missing Newline at end of last object" exit 1 } if {$attribute != ""} { echo "$chwp_db_def_file: Error line $linenum:" echo "Missing Newline at end of last object" exit 1 } } # # routine to verify an object definition contains what we think it should # proc \ chwp_dbi_validate_object_def { object file linenum required optional } \ { global chwp_multiple set all [concat $required $optional] set keys [keylget object] # first make sure all attributes in the object are valid foreach i $keys { set found 0 foreach j $all { if {$i == $j} { set found 1 break } } if {$found} { set attribute [keylget object $i] # attributes cannot have colons or commas in them if {[lsearch $attribute "*\[,:\]*"] >= 0} { echo "$file: Error" echo "Bad attribute $i has colon or comma near line $linenum" } # verify the number of items is correct # one is always ok if {[llength $attribute] == 1} { continue } # only a few can have multiple values if {[keylget chwp_multiple $i ret] == 0} { echo "$file: Error" echo "Bad attribute $i has zero or multiple values near line $linenum" } continue } echo "$file: Error" echo "Bad attribute $i for object ending on line $linenum" exit 1 } # make sure all required ones are there. foreach i $required { set found 0 foreach j $keys { if {$i == $j} { set found 1 break } } if {$found} { continue } echo "$file: Error" echo "Missing attribute $i for object ending on line $linenum" exit 1 } } # # check the structure of the object definitions that have been read in # We check for hanging (uncontained objects), and that all # contained attributes are present. # the way we do this is to open the root container, find # all the rest of the containers, and build a container list. # We build an attribute list of all valid (contained attributes) and # check them in several passes, # 1) Check that no duplicate names exist (both attributes and containers). # 2) scan through all attributes and containers # and verify that they are contained properly. # 3) scan through container and attribute lists and validate # that they all exist. # proc \ chwp_dbi_check_def {} \ { global chwp_db_def chwp_db_def_file global chwp_dbi_rootmust chwp_dbi_rootmay # structural checking # find root container, make sure exactly one. set object [chwp_dbi_def_find_object RootContainer Root] if {[llength $object] != "1"} { echo "$chwp_db_def_file: Error: missing or multiple root containers" exit 1 } # save the list of all containers for later set object [lindex $object 0] set chwp_dbi_rootmust [keylget object MustContain] set chwp_dbi_rootmay [keylget object MayContain] # include Root because it has attributes too set containers [concat Root $chwp_dbi_rootmust $chwp_dbi_rootmay] # now for the attributes # pass 1 # have the bare bones structure, now check that no duplicate names # exist. Just go through and query on every name and count them. # brute force and inefficient, but modern computers got HP. foreach i $chwp_db_def { set name [keylget i ObjectName] set object [chwp_dbi_def_find_object "" $name] if {[llength $object] != "1"} { echo "$chwp_db_def_file: Error: multiple objects named: $name" exit 1 } } # pass 2 verify that every attribute is found in a container somewhere. # get each container's attribute list, we have the list already. set attributes "" foreach container $containers { set object [chwp_dbi_def_find_object "" $container] set object [lindex $object 0] set attributes [concat $attributes [keylget object Attributes]] } set kattributes "" foreach attribute $attributes { keylset kattributes $attribute "1" } foreach object $chwp_db_def { set name [keylget object ObjectName] set type [keylget object ObjectType] if {$type != "Attribute"} { continue; } # search to see it is contained if {[keylget kattributes $name ret] == 0} { echo "$chwp_db_def_file: Error: Attribute $name is not contained in a container" exit 1 } } # pass 3, scan to see that each named attribute in containes # actually exists as an object. foreach attribute $attributes { set object [chwp_dbi_def_find_object "" $attribute] if {[llength $object] != 1} { echo "$chwp_db_def_file: Error: Referenced attribute does not exist: $attribute" exit 1 } } # scan the containers two passes. # verify referenced containers exist. foreach container $containers { set object [chwp_dbi_def_find_object "" $container] if {[llength $object] != 1} { echo "$chwp_db_def_file: Error: Referenced container does not exist: $container" exit 1 } } # verify that each container is referenced set kcontainers "" foreach container $containers { keylset kcontainers $container "1" } foreach object $chwp_db_def { set name [keylget object ObjectName] set type [keylget object ObjectType] if {$type != "Container"} { continue; } # search to see it is contained if {[keylget kcontainers $name ret] == 0} { echo "$chwp_db_def_file: Error: Container $name is not referenced in the root container" exit 1 } } } # # find objects either by type or name or both # all matching objects are returned # proc \ chwp_dbi_def_find_object { want_type want_name } \ { global chwp_db_def set found "" foreach object $chwp_db_def { set name [keylget object ObjectName] set type [keylget object ObjectType] if {$want_type != ""} { if {$type != $want_type} { continue } } if {$want_name != ""} { if {$name != $want_name} { continue } } lappend found $object } return $found } proc \ chwp_dbi_read_data {} \ { global chwp_db_def MS global chwp_db_data chwp_db_data_file chwp_db_data_file_version # open and parse the data file into our main structure. if {[catch {open $chwp_db_data_file r} fd] != 0} { return 0 } set linenum 0 set chwp_db_data "" set object "" set attribute "" set chwp_db_data_file_version "Unknown" while {[gets $fd line] != -1} { set linenum [expr $linenum + 1] set level 0 if {[cindex $line 0] == "\t"} { set level 1 set line [csubstr $line 1 -1] } set list [mysplit $line ":" 3] set class [lindex $list 0] set name [lindex $list 1] # value is a comma seperated list set value [lindex $list 2] # special case for Version if {$class == "Version"} { set chwp_db_data_file_version $name continue } # validate class case $class { Attribute { set err 0 } Container { set err 0 } default { set err 1 } } if {$err} { echo "$chwp_db_data_file; Warning on line $linenum" echo "Ignoring invalid class: $class" set err 1 continue } # fetch the display name from the def file set object [chwp_dbi_def_find_object $class $name] if {$object == ""} { # object not found echo "$chwp_db_data_file; Warning on line $linenum" echo "Ignoring invalid name: $name" set err 1 continue } set object [lindex $object 0] set description [keylget object DisplayName] set description [lindex $description 0] set readonly "" set ret [keylget object ReadOnly readonly] set hintkey "" set ret [keylget object HintKey hintkey] set required "" set ret [keylget object Required required] if {"$required" != ""} { set required "required" } set oa [chwp_dbi_set_action $class $name $readonly] set open [lindex $oa 0] set action [lindex $oa 1] set entry [list $class $name $level $action $open $hintkey $required $description $value] # validate the value if {$class != "Attribute"} { lappend chwp_db_data $entry continue } set type [keylget object DisplayType] case $type { MultiSelect { # zero, one, or many may be set set vals [keylget object DisplayValues] } SingleSelect { # exactly one must be set set vals [keylget object DisplayValues] } Text { # anything goes set vals "" } TextMultiline { # scan ahead and get the whole thing if {$level} { set tlen 2 set tstr "\t\t" } else { set tlen 1 set tstr "\t" } set last [tell $fd] while {[gets $fd line] != -1} { if {[csubstr $line 0 $tlen] != $tstr} { seek $fd $last break } set new [csubstr $line $tlen 9999] set value "$value\n$new" set last [tell $fd] set linenum [expr $linenum + 1] } set entry [lreplace $entry $MS(value) $MS(value) $value] set vals "" } } if {$vals != ""} { # Now compare the values with the good list. set values [mysplit $value ", " 999] set err 0 foreach val1 $values { set found 0 foreach val2 $vals { if {$val1 == $val2} { set found 1 break } } if {$found == 0} { echo "$chwp_db_data_file; Warning on line $linenum" echo "Ignoring invalid value: $val1" set err 1 break } } } lappend chwp_db_data $entry } close $fd return 1 } # # make the data structure from the def structure. # all is whether all containers are enumerated # or if false only the required containers are enumerated. # all possible attributes are enumerated in order # for each container. # containers get an entry including their closed/open status. # we mirror mainscreen_db with this list. # onscreen order is driven by the def structure. # proc \ chwp_dbi_make_data { all } \ { global chwp_db_def chwp_db_data rec_attributes global chwp_db_data_file_version chwp_db_def_file_version global chwp_dbi_rootmust chwp_dbi_rootmay set chwp_db_data "" set chwp_db_data_file_version $chwp_db_def_file_version if {$all} { set containers [concat $chwp_dbi_rootmust $chwp_dbi_rootmay] } else { set containers $chwp_dbi_rootmust } # get root object set object [chwp_dbi_def_find_object RootContainer Root] set object [lindex $object 0] set topattributes [keylget object Attributes] # first do any attributes in the top level list foreach attribute $topattributes { set entry [chwp_dbi_make_new_attribute $attribute 0] lappend chwp_db_data $entry } # two loops, # outer one the container list # inner one the attributes for that container. foreach container $containers { # get attribute list for this container name set entry [chwp_dbi_make_new_container $container] lappend chwp_db_data $entry set attributes $rec_attributes # value of the AttributeName is filled in later foreach attribute $attributes { set entry [chwp_dbi_make_new_attribute $attribute 1] lappend chwp_db_data $entry } } } # # given an attribute name, make its entry for db_data # proc \ chwp_dbi_make_new_attribute { attribute level } \ { set object [chwp_dbi_def_find_object Attribute $attribute] set object [lindex $object 0] set name [keylget object DisplayName] set name [string trim $name "{}"] set value "" set ret [keylget object DisplayDefault value] set readonly "" set ret [keylget object ReadOnly readonly] set action [chwp_dbi_set_action Attribute $name $readonly] set hintkey "" set ret [keylget object HintKey hintkey] set required "" set ret [keylget object Required required] if {$required != ""} { set required "required" } set entry [list Attribute $attribute $level $action "" $hintkey $required $name $value] return $entry } # # rules for building the action list for an attribute or a container # proc \ chwp_dbi_set_action { class name readonly } \ { global chwp_dbi_rootmust chwp_dbi_rootmay if {$class == "Attribute"} { set action "" set open "" if {$readonly != "Yes"} { set action edit } } else { set open closed if {[lsearch $chwp_dbi_rootmust $name] >= 0} { set action expand } else { set action [list expand delete] } } return [list $open $action] } # # given a container name, make its entry for the db_data # proc \ chwp_dbi_make_new_container { container } \ { global rec_attributes set object [chwp_dbi_def_find_object Container $container] set object [lindex $object 0] set rec_attributes [keylget object Attributes] set name [keylget object DisplayName] set name [string trim $name "{}"] # get the attribute name set attributename [keylget object AttributeName] # create container entry set hintkey "" set required "" set readonly "" set class Container set ret [keylget object ReadOnly readonly] set oa [chwp_dbi_set_action $class $container $readonly] set open [lindex $oa 0] set action [lindex $oa 1] set entry [list Container $container 0 $action $open $hintkey $required $name $attributename] return $entry } # # reconcile a new def file with an existing data file # reconcile affects the attributes and the order of those attributes. # all we have to do is check for attributes appearing and disappearing. # everything else is checked for already. # proc \ chwp_dbi_reconcile_dbs {} \ { global chwp_db_def chwp_db_data MS chwp_db_data_file global chwp_db_def_file_version chwp_db_data_file_version global rec_attributes # get the def version set version_def $chwp_db_def_file_version # get the data version set version_data $chwp_db_data_file_version # Here we reconcile. # first extract the objects we read in. # this is an oddly structured list intended to make searching easier # one list item per container, and that item contains the container # and all its attributes set oldobjects "" set list "" foreach entry $chwp_db_data { set class [lindex $entry $MS(class)] if {$class == "Container"} { lappend oldobjects $list set list "" } lappend list $entry } if {$list != ""} { lappend oldobjects $list } # now scan through the new objects and extract as needed # special case for the root attributes if any. set rootdef [chwp_dbi_def_find_object RootContainer Root] set rootdef [lindex $rootdef 0] set rootattributes [keylget rootdef Attributes] set must [keylget rootdef MustContain] set may [keylget rootdef MayContain] set rootcontainers [concat $must $may] # the new data list set newlist "" foreach attribute $rootattributes { set object [chwp_dbi_rec_root_srch $oldobjects $attribute] # keep it if found if {$object != ""} { lappend newlist $object continue } # otherwise make a new one set entry [chwp_dbi_make_new_attribute $attribute 0] lappend newlist $entry } # now do all of each container type foreach containertype $rootcontainers { set match [chwp_dbi_rec_container_srch $oldobjects $containertype] if {$match == "" && [lsearch $must $containertype] >= 0} { # missing required container lappend newlist [chwp_dbi_make_new_container $containertype] set attributes $rec_attributes # value of the AttributeName is filled in later foreach attribute $attributes { set entry [chwp_dbi_make_new_attribute $attribute 1] lappend newlist $entry } } if {$match == ""} { continue } lappend newlist [chwp_dbi_make_new_container $containertype] # fetch the definition set containerdef [chwp_dbi_def_find_object Container $containertype] set containerdef [lindex $containerdef 0] set attributes [keylget containerdef Attributes] foreach container $match { # have a single container and its attributes foreach attribute $attributes { set newattr [chwp_dbi_rec_container_attribute_srch $container $attribute] if {$newattr != ""} { lappend newlist $newattr } else { lappend newlist [chwp_dbi_make_new_attribute $attribute 1] } } } } if {$newlist != $chwp_db_data} { set chwp_db_data $newlist return 1 } if {$version_def != $version_data} { return 1 } return 0 } # search the root attributes for the given attribute type. proc \ chwp_dbi_rec_root_srch { oldobjects attribute } \ { global MS set attributes [lindex $oldobjects 0] set firstentry [lindex $attributes 0] set class [lindex $firstentry $MS(class)] if {$class != "Attribute"} { return "" } foreach entry $attributes { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] if {$name == $attribute} { return $entry } } return "" } # search for all containers matching the given type proc \ chwp_dbi_rec_container_srch { oldobjects containertype } \ { global MS set newlist "" foreach object $oldobjects { set firstentry [lindex $object 0] set class [lindex $firstentry $MS(class)] set name [lindex $firstentry $MS(name)] if {$class != "Container"} { continue } if {$name != $containertype} { continue } lappend newlist $object } return $newlist } # given a container and its attributes find the given attribute proc \ chwp_dbi_rec_container_attribute_srch { containerobject attribute } \ { global MS set newlist "" foreach entry $containerobject { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] if {$class != "Attribute"} { continue } if {$name != $attribute} { continue } set newlist $entry break } return $newlist } # # build the mainscreen display database from the internal database # we filter out closed items and fill in container names # proc \ chwp_dbi_make_mainscreen_db {} \ { global chwp_db_def chwp_db_data MS mainscreen_db set mainscreen_db "" # assume one level of hierarchy set open open set index -1 set end [llength $chwp_db_data] foreach entry $chwp_db_data { set index [expr $index + 1] lappend entry $index set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] if {$class == "Attribute"} { if {$open == "open"} { lappend mainscreen_db $entry } continue } # have a container, extract its open state. set open [lindex $entry $MS(open)] # find the name attribute, get this from the object definition. set entrydef [chwp_dbi_def_find_object $class $name] set entrydef [lindex $entrydef 0] set sname [keylget entrydef AttributeName] # now find the value of it set found 0 set start [expr $index + 1] for {set ndx $start} {$ndx < $end} {set ndx [expr $ndx + 1]} { set object [lindex $chwp_db_data $ndx] set tname [lindex $object $MS(name)] if {$tname == $sname} { set value [lindex $object $MS(value)] set entry [lreplace $entry $MS(value) $MS(value) $value] set found 1 break } } if {$found == "0"} { error "Internal error, $sname object not found" } # add the entry to the mainscreen lappend mainscreen_db $entry } } # # The hardware detection stuff is here. # # # the high level auto-detect routine # # it returns a multiline text string suitable for display to the user # about the results of the auto-detection # generally two types of detections occur: # 1 - a field is filled in for you - we call this an authoritative hint. # 2 - some information is available but the user needs to choose # from several possible values to fill in a field. # this is called an advisory hint. # the text string describes each of these things in detail. # # argument determines whether the string will include the # hint items that failed to produce any hints # proc \ chwp_hw_autodetect { nohints } \ { global chwp_db_def chwp_db_data MS # # need to go through each field and do the detection # # path has to be right for this stuff sct_fixpath # the authoritative hints set hinta "" # the advisory hints set hintb "" # items that have no hints set hintc "" set index -1 foreach entry $chwp_db_data { set index [expr $index + 1] set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] set value [lindex $entry $MS(value)] set description [lindex $entry $MS(description)] set hintkey [lindex $entry $MS(hintkey)] set object [chwp_db_attr_get_def $name] if {$hintkey == ""} { continue } set list [chwp_hw_get_hint $hintkey] # list returned is {authoritative value} # non-authoritative are multiline strings if {$list == ""} { set tmp "$description: no hint" set hintc "$hintc$tmp\n" continue } set auth [lindex $list 0] set value [lindex $list 1] if {$auth} { # set the field set entry [lreplace $entry $MS(value) $MS(value) $value] set chwp_db_data [lreplace $chwp_db_data $index $index $entry] set tmp "$description: $value" set hinta "$hinta$tmp\n" } else { set tmp "$description: hints available" set hintb "$hintb$tmp\n" } } set tmpa "The following items have been auto-detected:" set tmpb "The following items have hints available but need manual intervention:" set hints "$tmpa\n\n$hinta\n$tmpb\n\n$hintb" if {$nohints && $hintc != ""} { set tmpc "The following items have no hints on this platform" set hints "$hints\n$tmpc\n\n$hintc" } return $hints } proc \ chwp_hw_get_hint { hintkey } \ { case $hintkey { CPUSpeed { set list [chwp_hw_clockspeed] } CPUManufacturer { set list [chwp_hw_cpumanufacturer] } CPUCount { set list [chwp_hw_cpucount] } CPUType { set list [chwp_hw_cputype] } Memsize { set list [chwp_hw_memsize] } MainBiosString { set list [chwp_hw_mainbiosstring] } default { echo Internal error, hintkey $hintkey invalid exit 1 } } return $list } proc \ chwp_hw_clockspeed {} \ { # get output of hw set ostype [sct_ostype] if {$ostype == "OS_OSR5"} { set lines [exec hw cpu] set list [split $lines "\n"] foreach line $list { set ndx [string first performs $line] if {$ndx < 0} { continue } set line [string trim $line " "] set tokens [split $line " "] set cpuspeed [lindex $tokens 5] if {[string first "Mhz" $cpuspeed] > 0} { set ret [list "1" $cpuspeed] return $ret } break } } if {$ostype == "OS_UNIXWARE7"} { set lines [exec uname -X] set list [split $lines "\n"] foreach line $list { if {[csubstr $line 0 10] != "Machine = "} { continue } set hint $line set ret [list "0" $hint] return $ret } } if {$ostype == "OS_OSR6"} { set lines [exec hw -r cpu] set list [split $lines "\n"] foreach line $list { set ndx [string first speed $line] if {$ndx < 0} { continue } set line [string trim $line " "] set tokens [split $line " "] set cpuspeed [lindex $tokens 7] if {[string first "Mhz" $cpuspeed] > 0} { set ret [list "1" $cpuspeed] return $ret } break } } } proc \ chwp_hw_cpumanufacturer {} \ { # get output of hw set ostype [sct_ostype] if {$ostype == "OS_OSR5"} { set lines [exec hw cpu] set list [split $lines "\n"] foreach line $list { set ndx [string first performs $line] if {$ndx < 0} { continue } set line [string trim $line " "] set tokens [mysplit $line " " 7] set cpustr [lindex $tokens 6] set cputype "" # one of Intel AMI AMD Cyrix if {[string first "Intel" $cpustr] >= 0} { set cputype "Intel" } if {[string first "AMD" $cpustr] >= 0} { set cputype "AMD" } if {[string first "AMI" $cpustr] >= 0} { set cputype "AMI" } if {[string first "Cyrix" $cpustr] >= 0} { set cputype "Cyrix" } if {$cputype != ""} { set ret [list "1" $cputype] return $ret } break } } if {$ostype == "OS_UNIXWARE7" || $ostype == "OS_OSR6"} { set lines [exec uname -X] set list [split $lines "\n"] foreach line $list { if {[csubstr $line 0 10] != "Machine = "} { continue } set hint $line set ret [list "0" $hint] return $ret } } } proc \ chwp_hw_cpucount {} \ { # get output of hw set ostype [sct_ostype] if {$ostype == "OS_OSR5"} { set lines [exec hw cpu] set list [split $lines "\n"] set cpucount 0 foreach line $list { set line [string trim $line " "] set ndx [string first "There is one CPU on this system" $line] if {$ndx >= 0} { set ret [list "1" "1"] return $ret } set ndx [string first "Physical CPU:" $line] if {$ndx >= 0} { set tmp [split $line ":"] set cpu [lindex $tmp 1] set cpu [string trim $cpu " "] if {$cpu > $cpucount} { set cpucount $cpu } } } if {$cpucount > 0} { set ret [list "1" "$cpucount"] return $ret } } if {$ostype == "OS_UNIXWARE7" || $ostype == "OS_OSR6"} { set lines [exec psrinfo] set list [split $lines "\n"] set cpucount 0 foreach line $list { set cpucount [expr $cpucount + 1] } if {$cpucount > 0} { set ret [list "1" "$cpucount"] return $ret } } } proc \ chwp_hw_cputype {} \ { # get output of hw set ostype [sct_ostype] if {$ostype == "OS_OSR5"} { set lines [exec hw cpu] set list [split $lines "\n"] foreach line $list { set ndx [string first performs $line] if {$ndx < 0} { continue } # set line [string trim $line " "] # set tokens [mysplit $line " " 7] # set cpustr [lindex $tokens 6] set ret [list "0" $line] return $ret } } if {$ostype == "OS_UNIXWARE7" || $ostype == "OS_OSR6"} { set lines [exec uname -X] set list [split $lines "\n"] foreach line $list { if {[csubstr $line 0 10] != "Machine = "} { continue } set hint $line set ret [list "0" $hint] return $ret } } } proc \ chwp_hw_memsize {} \ { # get output of hw set ostype [sct_ostype] set line [exec "memsize"] set line [string trim $line " "] set tokens [split $line " "] set memsize [lindex $tokens 0] set kb [expr $memsize / 1024] set mb [expr $kb / 1024] set list [list "1" "$mb Mb"] return $list } proc \ chwp_hw_mainbiosstring {} \ { # get output of hw set ostype [sct_ostype] if {$ostype == "OS_OSR5"} { set lines [exec hw -v ROM] set list [split $lines "\n"] set start 0 set ret "" foreach line $list { if {$start == 0} { set ndx [string first "System BIOS ROM" $line] if {$ndx >= 0} { set start 1 } continue } if {$start == 1} { set ndx [string first "Messages found in the BIOS ROM:" $line] if {$ndx >= 0} { set start 2 } else { continue } } # these are BIOS strings set line [string trim $line] if {$line == ""} { break } set ret "$ret$line\n" } if {$ret != ""} { set ret [list "0" $ret] return $ret } } if {$ostype == "OS_OSR6"} { set lines [exec hw -v -r ROM] set list [split $lines "\n"] set start 0 set ret "" foreach line $list { if {$start == 0} { set ndx [string first "System BIOS ROM" $line] if {$ndx >= 0} { set start 1 } continue } if {$start == 1} { set ndx [string first "Messages found in the BIOS ROM:" $line] if {$ndx >= 0} { set start 2 } else { continue } } # these are BIOS strings set line [string trim $line] if {$line == ""} { break } set ret "$ret$line\n" } if {$ret != ""} { set ret [list "0" $ret] return $ret } } } #!/bin/osavtcl # only if on Unixware, there is a way to check for this somehow. #loadlibindex /usr/lib/sysadm.tlib # globals set ME "[pwd]/chwp" set IC(folder_closed) 0 set IC(folder_open) 1 set IC(item_middle) 2 set IC(item_last) 3 set IC(item_hbar) 4 set IC(item_blank) 5 set IC(item_requiredok) 6 set IC(item_requiredbad) 7 set DIRTY 0 proc \ chwp_cmd_line {} \ { global argv if {$argv == ""} { return } if {[lindex $argv 0] == "-autodetect"} { set new [chwp_db_read] set string [chwp_hw_autodetect 1] echo $string } else { echo "usage: chwp \[-autodetect\]" } exit 0 } # # put up an information dialog box with the given callbacks # (ok Ok) # proc \ chwp_query_ok { msg ok } \ { global app set ret [VtInformationDialog $app.ok \ -message $msg \ -ok -okLabel Ok -okCallback $ok \ ] VtShow $ret } # # put up an error dialog box with the given callbacks # (eok Error Ok) # proc \ chwp_query_eok { msg ok } \ { global app set ret [VtErrorDialog $app.eok \ -message $msg \ -ok -okLabel Ok -okCallback $ok \ ] VtShow $ret } # # put up a question dialog box with the given callbacks # (qyn Question Yes No) # proc \ chwp_query_qyn { msg yes no } \ { global app set ret [VtQuestionDialog $app.qyn \ -message $msg \ -ok -okLabel Yes -okCallback $yes \ -cancel -cancelLabel no -cancelCallback $no \ ] VtShow $ret } # # user wants to redetect hardware, probably they want to see the message again. # proc \ chwp_menu_detect_cb { cbs } \ { global DIRTY set DIRTY 1 set string [chwp_hw_autodetect 0] chwp_query_ok $string chwp_nop } # # user elected to save changes unconditionally # proc \ chwp_menu_save_changes_cb { cbs } \ { set ret [chwp_query_qyn "Save Changes?" chwp_really_save_changes chwp_nop] } proc \ chwp_really_save_changes { cbs } \ { global DIRTY set DIRTY 0 chwp_db_write } # nop - no-op - no operation - dummy proc proc \ chwp_nop { cbs } \ { set nop b } proc \ chwp_menu_exit_cb { cbs } \ { global DIRTY if {$DIRTY} { chwp_query_qyn "Save Changes?" \ "chwp_really_save_and_exit save" \ "chwp_really_save_and_exit nosave" \ } else { VtClose exit 0 } } proc \ chwp_really_save_and_exit { code cbs } \ { if {$code == "save"} { chwp_db_write } VtClose exit 0 } proc \ chwp_stand_edit { file } \ { global MS app chwp_dialog_form global combo_values list_values text_value global chwp_stand_object chwp_stand_objectdef global chwp_stand_file set chwp_stand_file $file set fd [open $file r] set arglist [read $fd nonewline] close $fd system "rm -f $file" set chwp_stand_object [lindex $arglist 0] set chwp_stand_objectdef [lindex $arglist 1] set hint [lindex $arglist 2] set object $chwp_stand_object set objectdef $chwp_stand_objectdef set type [keylget objectdef DisplayType] set description [lindex $object $MS(description)] set value [lindex $object $MS(value)] # four types of dialogs, based on object type: # simple text dialog # multiple line text dialog. # combobox (single select, analogous to radio box. # multiple select list (analogous to checkbox) set app [VtOpen chwpchild] set chwp_dialog_form [ \ VtFormDialog $app.edit \ -title "Edit Attribute" \ -ok -okLabel Ok -okCallback chwp_stand_ok \ -cancel -cancelLabel "Cancel" -cancelCallback chwp_stand_quit \ ] set label [VtLabel $chwp_dialog_form.label \ -leftSide FORM -rightSide FORM \ -label "$description:" \ -labelLeft \ ] case $type { Text { set text_value [ \ VtText $chwp_dialog_form.text \ -topSide $label \ -columns 70 \ -value $value \ ] } TextMultiline { set text_value [ \ VtText $chwp_dialog_form.text \ -topSide $label \ -columns 70 \ -value $value \ -rows 12 \ -verticalScrollBar 1 \ ] } SingleSelect { set values [keylget objectdef DisplayValues] set combo_values [ \ VtComboBox $chwp_dialog_form.combo \ -itemList $values \ -readOnly \ -value $value \ -topSide $label \ ] } MultiSelect { set values [keylget objectdef DisplayValues] if {$hint == ""} { set rows 12 } else { set rows 7 } set list_values [ \ VtList $chwp_dialog_form.list \ -leftSide FORM -rightSide FORM -topSide $label \ -columns 70 -rows $rows \ -selection MULTIPLE \ -itemList $values \ ] set valuelist [mysplit $value ", " 999] if {$valuelist != ""} { VtListSelectItem $list_values -itemList $valuelist } } } if {$hint != ""} { set tmp "The following hints are available:" set hint_label [VtLabel $chwp_dialog_form.hint_label \ -leftSide FORM -rightSide FORM \ -label "$tmp" \ -labelLeft \ ] set hint_values [ \ VtText $chwp_dialog_form.hint \ -bottomSide FORM \ -columns 70 \ -rows 5 \ -value $hint \ -readOnly \ -verticalScrollBar 1 \ ] } VtShow $chwp_dialog_form VtMainLoop } proc \ chwp_stand_ok { cbs } \ { global MS app chwp_dialog_form global combo_values list_values text_value global chwp_stand_object chwp_stand_objectdef global chwp_stand_file set object $chwp_stand_object set objectdef $chwp_stand_objectdef set type [keylget objectdef DisplayType] case $type { Text { set value [VtGetValues $text_value -value] } TextMultiline { set value [VtGetValues $text_value -value] } SingleSelect { set value [VtGetValues $combo_values -value] } MultiSelect { set valuelist [VtListGetSelectedItem $list_values -byItemList ] set value [join $valuelist ", "] } } set object [lreplace $object $MS(value) $MS(value) $value] if {[catch {open $chwp_stand_file w} fd] == 0} { puts $fd $object close $fd } VtClose exit 0 } proc \ chwp_stand_quit { cbs } \ { VtClose exit 0 } # special combo box routine, # list in the file is three items: # 1 - title of dialog box # 2 - name of item # 3 - list of valid values for item # passed back is the item selected or an empty file for cancel proc \ chwp_stand_query_combo { file } \ { global MS app chwp_dialog_form global combo_values global chwp_stand_file set chwp_stand_file $file set fd [open $file r] set arglist [read $fd nonewline] close $fd system "rm -f $file" set title [lindex $arglist 0] set description [lindex $arglist 1] set values [lindex $arglist 2] set app [VtOpen chwpchild] set chwp_dialog_form [ \ VtFormDialog $app.edit \ -title "$title" \ -ok -okLabel Ok -okCallback chwp_stand_query_combo_ok \ -cancel -cancelLabel "Cancel" -cancelCallback chwp_stand_quit \ ] set label [VtLabel $chwp_dialog_form.label \ -leftSide FORM -rightSide FORM \ -label "$description:" \ -labelLeft \ ] set value [lindex $values 0] set combo_values [ \ VtComboBox $chwp_dialog_form.combo \ -itemList $values \ -readOnly \ -value $value \ -topSide $label \ ] VtShow $chwp_dialog_form VtMainLoop } proc \ chwp_stand_query_combo_ok { cbs } \ { global MS app chwp_dialog_form global combo_values global chwp_stand_file set value [VtGetValues $combo_values -value] if {[catch {open $chwp_stand_file w} fd] == 0} { puts $fd $value close $fd } VtClose exit 0 } # # enable and disable menu buttons as we go # proc \ chwp_select_cb { cbs } \ { global chwp_main_list mainscreen_db MS global chwp_edit_button chwp_delete_button chwp_add_button set index [VtDrawnListGetSelectedItem $chwp_main_list] if {$index == 0} { chwp_query_eok "Select an item first" chwp_nop return } keylset cbs itemPosition $index set index [expr $index - 1] set list [lindex $mainscreen_db $index] set class [lindex $list $MS(class)] set name [lindex $list $MS(name)] set action [lindex $list $MS(action)] if {[lsearch $action edit] < 0} { VtSetValues $chwp_edit_button -sensitive 0 } else { VtSetValues $chwp_edit_button -sensitive 1 } if {[lsearch $action delete] < 0} { VtSetValues $chwp_delete_button -sensitive 0 } else { VtSetValues $chwp_delete_button -sensitive 1 } } # # delete a peripheral # proc \ chwp_delete_cb { cbs } \ { global chwp_main_list mainscreen_db MS DIRTY set index [VtDrawnListGetSelectedItem $chwp_main_list] if {$index == 0} { chwp_query_eok "Select an item first" chwp_nop return } set index [expr $index - 1] set list [lindex $mainscreen_db $index] set class [lindex $list $MS(class)] set name [lindex $list $MS(name)] set description [lindex $list $MS(description)] set value [lindex $list $MS(value)] set backlink [lindex $list $MS(backlink)] chwp_db_delete $backlink chwp_display_mainlist set DIRTY 1 } # # add a new peripheral, prompt for type # proc \ chwp_add_cb { cbs } \ { global chwp_main_list mainscreen_db MS DIRTY PID ME # ask which one to add. # call to put up a combo box set file "/tmp/chwp.$PID" system "rm -f $file" set title "Select Peripheral to Add" set description "Peripheral" set values [chwp_db_add_list] set arglist [list $title $description $values] if {[catch {open $file w} fd] != 0} { chwp_query_eok "Unable to write file $file" chwp_nop return } puts $fd $arglist close $fd VtLock VtControl -suspend system "$ME -chwp_stand_query_combo $file" VtControl -resume VtUnLock if {[file exists $file] == 1} { set name [exec cat $file] system "rm -f $file" if {$name != ""} { chwp_db_add $name chwp_display_mainlist set DIRTY 1 } } } # # alternate way to edit an item, using the menu # proc \ chwp_edit_cb { cbs } \ { global chwp_main_list mainscreen_db MS set index [VtDrawnListGetSelectedItem $chwp_main_list] if {$index == 0} { chwp_query_eok "Select an item first" chwp_nop return } keylset cbs itemPosition $index set list [lindex $mainscreen_db $index] set class [lindex $list $MS(class)] set name [lindex $list $MS(name)] chwp_activate_cb $cbs } # # This is the master call to edit an item. # it calls different edit forms based on the class and type of the item. # we need to pass the edit object and the class definition object. # proc \ chwp_activate_cb { cbs } \ { global mainscreen_db MS PID ME DIRTY set index [keylget cbs itemPosition] set index [expr $index - 1] set list [lindex $mainscreen_db $index] set class [lindex $list $MS(class)] set name [lindex $list $MS(name)] set action [lindex $list $MS(action)] set hintkey [lindex $list $MS(hintkey)] # if a container expand/contract and redraw if {$class == "Container"} { chwp_db_container_expand $index chwp_display_mainlist chwp_select_mainlist $index chwp_select_cb $cbs return } if {[lsearch $action edit] < 0} { return } # call edit if an attribute # file is used to pass arguments to and results from child processes # this preserves stdout for the child process and avoids # passing long complicated tcl strings through the shell # which is problematic at best. set file "/tmp/chwp.$PID" system "rm -f $file" # pass two lists (as a single list) the onscreen item, and the # object definition from db_def set object [chwp_db_attr_get_def $name] set hint "" if {$hintkey != ""} { set hint [chwp_hw_get_hint $hintkey] set auth [lindex $hint 0] if {$auth == 0} { set hint [lindex $hint 1] } } set arglist [list $list $object $hint] if {[catch {open $file w} fd] != 0} { chwp_query_eok "Unable to write file $file" chwp_nop return } puts $fd $arglist close $fd VtLock VtControl -suspend system "$ME -chwp_stand_edit $file" VtControl -resume VtUnLock if {[file exists $file] == 1} { set newobject [exec cat $file] system "rm -f $file" if {$newobject != ""} { chwp_db_attr_set $index $newobject chwp_display_mainlist set DIRTY 1 } } chwp_status_bar_update } # # build main form, lock it, and return. proc \ chwp_uistart {} \ { global app version chwp_main_form menuBar global chwp_top_status chwp_bottom_status chwp_main_list global RESPATH chwp_save_button chwp_stop_button chwp_exit_button global chwp_edit_button chwp_delete_button chwp_add_button global LOADING set app [VtOpen sct -helpBook SCTDOC] set chwp_main_form [ \ VtFormDialog $app.main \ -title "CHWP Information Editor - version $version" \ ] # menu bar set menuBar [VtMenuBar $chwp_main_form.menubar \ -helpMenuItemList "ON_WINDOW ON_VERSION"] set optionsMenu [VtPulldown $menuBar.optionsMenu -label "Options" \ -mnemonic O] set chwp_detect_button [VtPushButton $optionsMenu.detect \ -label "Re-Auto-Detect Hardware" \ -callback chwp_menu_detect_cb -mnemonic D] set chwp_save_button [VtPushButton $optionsMenu.save -label \ "Save Changes" -callback chwp_menu_save_changes_cb -mnemonic S] VtSeparator $optionsMenu.sep1 set chwp_exit_button [VtPushButton $optionsMenu.exit -label "Exit" \ -callback chwp_menu_exit_cb -mnemonic E] set editMenu [VtPulldown $menuBar.editMenu -label "Edit" \ -mnemonic E] set chwp_edit_button [VtPushButton $editMenu.edit -label \ "Edit Item" -callback chwp_edit_cb -mnemonic E \ -sensitive 0] VtSeparator $editMenu.sep1 set chwp_add_button [VtPushButton $editMenu.add -label \ "Add Peripheral" -callback chwp_add_cb -mnemonic D] set chwp_delete_button [VtPushButton $editMenu.delete -label \ "Delete Peripheral" -callback chwp_delete_cb -mnemonic D \ -sensitive 0] # Top status line set chwp_top_status [VtLabel $chwp_main_form.toplab \ -leftSide FORM -rightSide FORM \ -labelLeft \ ] # main list widget set chwp_main_list [VtDrawnList $chwp_main_form.list \ -columns 75 -rows 14 \ -autoSelect TRUE -selection BROWSE \ -callback chwp_select_cb \ -defaultCallback chwp_activate_cb \ -leftSide FORM -rightSide FORM \ -horizontalScrollBar 1 \ -iconList [list \ $RESPATH/e00folder_closed.px \ $RESPATH/e01folder_open.px \ $RESPATH/e02item_middle.px \ $RESPATH/e03item_last.px \ $RESPATH/e04hbar.px \ $RESPATH/e05blank.px \ $RESPATH/e06requiredok.px \ $RESPATH/e07requiredbad.px \ ] \ -CHARM_iconList [list ">" ">" " " " " "-" " " "*" "x" ] \ ] # Bottom status line set chwp_bottom_status [VtLabel $chwp_main_form.status \ -leftSide FORM -rightSide FORM \ -labelLeft \ ] chwp_status_bar_update VtShow $chwp_main_form } # # update our status lines # proc \ chwp_status_bar_update {} \ { global app chwp_bottom_status chwp_top_status version LOADING if {$LOADING == 0} { VtSetAppValues $app -versionString "CHWP editor $version, CHWP database version: [chwp_db_version]" set label "CHWP database version [chwp_db_version]" if {[chwp_db_cert_valid nopassthru] == 0} { set label "$label, some required fields missing for certification" } VtSetValues $chwp_bottom_status -label $label VtSetValues $chwp_top_status -label "Select an item to edit it." } else { VtSetValues $chwp_bottom_status -label "Loading please wait..." VtSetValues $chwp_top_status -label "Loading please wait..." } } # # convert a db entry to the stuff needed to add it to the main_list # proc \ chwp_display_item { index } \ { global mainscreen_db MS IC # Current object set list [lindex $mainscreen_db $index] set class [lindex $list $MS(class)] set name [lindex $list $MS(name)] set level [lindex $list $MS(level)] set action [lindex $list $MS(action)] set open [lindex $list $MS(open)] set description [lindex $list $MS(description)] set value [lindex $list $MS(value)] set required [lindex $list $MS(required)] # look ahead set next [expr $index + 1] set list [lindex $mainscreen_db $next] set nextclass [lindex $list $MS(class)] if {$nextclass == ""} { set nextclass "Container" } set formatlist "" set fieldlist "" if {$class == "Container"} { lappend formatlist "ICON 1" if {$nextclass == "Container"} { lappend fieldlist $IC(folder_closed) } else { lappend fieldlist $IC(folder_open) } lappend formatlist "STRING 256" lappend fieldlist "$description: $value" } else { if {$level == 1} { # contained lappend formatlist "ICON 1" lappend formatlist "ICON 1" if {$nextclass == "Container"} { lappend fieldlist $IC(item_last) } else { lappend fieldlist $IC(item_middle) } lappend fieldlist $IC(item_hbar) } else { # top level attribute lappend formatlist "ICON 1" lappend fieldlist $IC(item_blank) } # required status lappend formatlist "ICON 1" set icon $IC(item_blank) if {$required != ""} { set icon $IC(item_requiredbad) if {[chwp_required_attribute_valid $value]} { set icon $IC(item_requiredok) } } lappend fieldlist $icon lappend formatlist "STRING 45" lappend fieldlist "$description" lappend formatlist "STRING 256" lappend fieldlist "$value" } return [list $fieldlist $formatlist] } # now draw them proc \ chwp_display_mainlist {} \ { global mainscreen_db chwp_main_list set llist [VtDrawnListGetItem $chwp_main_list -all] set mlen [llength $llist] set length [llength $mainscreen_db] # coerce list length if not match while {$length != $mlen} { if {$mlen < $length} { VtDrawnListAddItem $chwp_main_list \ -position 0 \ -formatList [list "STRING 1"] \ -fieldList [list " "] set mlen [expr $mlen + 1] } if {$mlen > $length} { VtDrawnListDeleteItem $chwp_main_list -position 0 set mlen [expr $mlen - 1] } } loop i 0 $length { set list [chwp_display_item $i] set fieldlist [lindex $list 0] set formatlist [lindex $list 1] set position [expr $i + 1] VtDrawnListSetItem $chwp_main_list \ -position $position \ -fieldList $fieldlist \ -formatList $formatlist } } # set an item as selected in the main list, 0 based argument proc \ chwp_select_mainlist { index } \ { global chwp_main_list set index [expr $index + 1] VtDrawnListSelectItem $chwp_main_list -position $index } proc \ main {} \ { global LOADING DIRTY # do command line options, # the routine does not return if command line arguments exist. chwp_cmd_line set LOADING 1 chwp_uistart VtLock set new [chwp_db_read] if {$new} { set DIRTY 1 set string [chwp_hw_autodetect 0] chwp_query_ok $string chwp_nop } set LOADING 0 chwp_display_mainlist chwp_status_bar_update VtUnLock VtMainLoop } if {[lindex $argv 0] == "-chwp_stand_edit"} { chwp_stand_edit [lindex $argv 1] exit } if {[lindex $argv 0] == "-chwp_stand_query_combo"} { chwp_stand_query_combo [lindex $argv 1] exit } main 0707070000000000031006440000000000030000010000001025235521200002700000125456root/home/sct/chwpdump #!/bin/osavtcl # # miscellaneous utilities shared by a few programs. # # globals set version 9.0.0g set RESPATH "[pwd]/res" set BINPATH "[pwd]/tests" set LICENSE "$RESPATH/license" set EULA "$RESPATH/eula" set PID [pid] set sct_config_file "$RESPATH/sct.config" # path to user created machine data file. set chwp_db_data_file "$RESPATH/chwp.data" # path where test run logs are kept set sctrun_logdir "[pwd]/logs" # path where test binaries are kept set sctrun_testdir "[pwd]/tests" # path where handoffs are created set sct_handoffdir "[pwd]/handoffs" # Test data items (cheap way to make a list work like a C structure) set TS(class) 0 set TS(type) 1 set TS(name) 2 set TS(description) 3 set TS(required) 4 set TS(media) 5 set TS(enabled) 6 set TS(mode) 7 set TS(running) 8 set TS(iteration) 9 set TS(errors) 10 set TS(pid) 11 set TS(elapsed) 12 set TS(normalstop) 13 # Configuration data items set CS(runtime) 0 set CS(netmachine) 1 set CS(ftpuser) 2 set CS(ftppass) 3 set CS(localgraphics) 4 set CS(certrun) 5 set CS(nofloppy) 6 set CS(nocdrom) 7 set CS(errormax) 8 set CS(cddevice) 9 set CS(usbdevice) 10 set CS(cdpattern) 11 # full list of run times set sct_run_list_full [list \ "1 min" "5 min" "15 min" "30 min" "1 hr" \ "2 hr" "4 hr" "8 hr" "16 hr" "24 hr" "36 hr" \ "48 hr" "72 hr" "96 hr" "120 hr" "Indefinite" ] # certification (short) list of run times. set sct_run_list_cert [list \ "36 hr" "48 hr" "72 hr" "96 hr" "120 hr" "Indefinite" ] set sct_run_indefinite_time 3600000 # # read in our saved values if any # returns zero if no file to read # proc \ sct_read_config { file } \ { global CS TS sct_config_db mainscreen_db sct_config_file if {$file == ""} { set file $sct_config_file } if {[catch {open $file r} fd] != 0} { return 0 } # silently ignore errors while {[gets $fd line] != -1} { set list [split $line ":"] set type [lindex $list 0] case $type { config { set name [lindex $list 1] set value [lindex $list 2] if {$name == "certrun"} { set sct_config_db [lreplace $sct_config_db $CS(certrun) $CS(certrun) $value] } if {$name == "runtime"} { set sct_config_db [lreplace $sct_config_db $CS(runtime) $CS(runtime) $value] } if {$name == "netmachine"} { set sct_config_db [lreplace $sct_config_db $CS(netmachine) $CS(netmachine) $value] } if {$name == "ftpuser"} { set sct_config_db [lreplace $sct_config_db $CS(ftpuser) $CS(ftpuser) $value] } if {$name == "ftppass"} { set sct_config_db [lreplace $sct_config_db $CS(ftppass) $CS(ftppass) $value] } if {$name == "localgraphics"} { set sct_config_db [lreplace $sct_config_db $CS(localgraphics) $CS(localgraphics) $value] } if {$name == "nofloppy"} { set sct_config_db [lreplace $sct_config_db $CS(nofloppy) $CS(nofloppy) $value] } if {$name == "nocdrom"} { set sct_config_db [lreplace $sct_config_db $CS(nocdrom) $CS(nocdrom) $value] } if {$name == "errormax"} { set sct_config_db [lreplace $sct_config_db $CS(errormax) $CS(errormax) $value] } if {$name == "cddevice"} { set sct_config_db [lreplace $sct_config_db $CS(cddevice) $CS(cddevice) $value] } if {$name == "cdpattern"} { set sct_config_db [lreplace $sct_config_db $CS(cdpattern) $CS(cdpattern) $value] } if {$name == "usbdevice"} { set sct_config_db [lreplace $sct_config_db $CS(usbdevice) $CS(usbdevice) $value] } } test { set name [lindex $list 1] set enabled [lindex $list 2] set mode [lindex $list 3] # find the test and update it set end [llength $mainscreen_db] loop ndx 0 $end { set entry [lindex $mainscreen_db $ndx] set tname [lindex $entry $TS(name)] if {$tname == $name} { set entry [lreplace $entry $TS(enabled) $TS(enabled) $enabled] set entry [lreplace $entry $TS(mode) $TS(mode) $mode] set mainscreen_db [lreplace $mainscreen_db $ndx $ndx $entry] } } } } } close $fd return 1 } # # write out the current configuration # proc \ sct_save_config { file } \ { global CS TS sct_config_db mainscreen_db sct_config_file BINPATH if {$file == ""} { set file $sct_config_file } if {[catch {open $file w} fd] != 0} { sct_query_eok "Unable to write file $file" sct_nop return 0 } # save config first set list $sct_config_db set certrun [lindex $list $CS(certrun)] set runtime [lindex $list $CS(runtime)] set netmachine [lindex $list $CS(netmachine)] set ftpuser [lindex $list $CS(ftpuser)] set ftppass [lindex $list $CS(ftppass)] set ostype [sct_ostype] set osversion [sct_osversion] set nofloppy [lindex $list $CS(nofloppy)] set nocdrom [lindex $list $CS(nocdrom)] set localgraphics [sct_localgraphics] set errormax [lindex $list $CS(errormax)] set cddevice [lindex $list $CS(cddevice)] set cdpattern [lindex $list $CS(cdpattern)] set usbdevice [lindex $list $CS(usbdevice)] puts $fd "config:certrun:$certrun" puts $fd "config:runtime:$runtime" puts $fd "config:netmachine:$netmachine" puts $fd "config:ftpuser:$ftpuser" puts $fd "config:ftppass:$ftppass" puts $fd "config:binpath:$BINPATH" puts $fd "config:ostype:$ostype" puts $fd "config:osversion:$osversion" puts $fd "config:localgraphics:$localgraphics" puts $fd "config:nofloppy:$nofloppy" puts $fd "config:nocdrom:$nocdrom" puts $fd "config:errormax:$errormax" puts $fd "config:cddevice:$cddevice" puts $fd "config:cdpattern:$cdpattern" puts $fd "config:usbdevice:$usbdevice" foreach entry $mainscreen_db { set name [lindex $entry $TS(name)] set enabled [lindex $entry $TS(enabled)] set mode [lindex $entry $TS(mode)] puts $fd "test:$name:$enabled:$mode" } close $fd return 1 } # load up the test list, and set all default values. proc \ sct_init_tests {} \ { global mainscreen_db sct_config_db set db "" set list [list test test cpu "CPU" "Required" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test disk "Disk" "Required" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test network "Network" "Required" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test memory "Memory" "Required" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test cdrom "CD/DVD" "Required" "CD or DVD with at least 300 Mb of data on it" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test floppy "Floppy" "Required" "Formatted Floppy with no bad spots" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test graphics "Graphics" "Optional" "" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set list [list test test usbflash "USB Flash Mem" "Optional" "USB Flash Memory - with test pattern on it" "Disabled" "Gentle" "Stopped" 0 0 0 0 0] lappend db $list set mainscreen_db $db # init config data set sct_config_db "{36 hr} unknown.sco.com ftp ftp@unknown.com [sct_localgraphics] 0 0 0 100 auto auto 0" } # # get the ostype, known types are OS_OSR5, OS_OSR6, OS_UNIWARE7 # proc \ sct_ostype {} \ { global BINPATH set ostype [exec $BINPATH/ostype] return $ostype } # # get the version of the os # proc \ sct_osversion {} \ { global BINPATH set osversion [exec $BINPATH/ostype -v] return $osversion } # # given an ostype, produce a user readable form # proc \ sct_display_ostype { ostype } \ { case $ostype { OS_OSR5 { set osdisplay "Open Server 5" } OS_OSR6 { set osdisplay "Open Server 6" } OS_UNIXWARE7 { set osdisplay "UnixWare 7" } default { set osdisplay "Unknown Operating System" } } return $osdisplay } # # like split but instead of chars the entire string is the delimiter # allows multi-char delimiters. PERL had regular expressions for delimiters. # max is the maximum number of elements to split into # proc \ mysplit { string delimiter max } \ { set list "" set count 1 set len [clength $delimiter] while {$string != ""} { set ndx [string first $delimiter $string] if {$ndx < 0 || $count == $max} { lappend list $string set string "" } else { set str1 [csubstr $string 0 $ndx] lappend list $str1 set ndx [expr $ndx + $len] set string [csubstr $string $ndx 9999] } set count [expr $count + 1] } return $list } # # convert internal mode to display version # proc \ sct_mode_external { mode } \ { if {"$mode" == "Hard"} { set display_mode "Max-Stress Mode" } else { set display_mode "Certification Mode" } } # # convert external display mode to internal name # proc \ sct_mode_internal { mode } \ { if {"$mode" == "Max-Stress Mode"} { set internal_mode "Hard" } else { set internal_mode "Gentle" } } # # detect if we are in graphics mode and local # proc \ sct_localgraphics {} \ { global env # get DISPLAY from environment set list [array names env] if {[lsearch $list DISPLAY] == -1} { return 0 } set display $env(DISPLAY) set tokens [split $display ":"] set displayname [lindex $tokens 0] set hostname [exec hostname -s] if {$hostname == $displayname} { return 1 } return 0 } # # fixup our path so exec works. # we have a minimum set of path requirements. # this was provoked by /sbin and /usr/sbin being missing when # you log into X on legend., which broke hardware inquiries (hw command failed). # proc \ sct_fixpath {} \ { global env set ostype [sct_ostype] if {$ostype == "OS_OSR5"} { set minpath "/bin:/etc:/usr/bin:/tcb/bin" } if {$ostype == "OS_UNIXWARE7"} { set minpath "/sbin:/usr/sbin:/etc:/usr/bin:/usr/ccs/bin" } if {$ostype == "OS_OSR6"} { set minpath "/bin:/usr/bin:/tcb/bin:/sbin:/usr/sbin:/etc" } # make sure all required components are in the real path set envlist [split $env(PATH) ":"] set minlist [split $minpath ":"] foreach required $minlist { if {[lsearch $envlist $required] < 0} { lappend envlist $required } } set newpath [join $envlist ":"] set env(PATH) $newpath } # given a global variable name in a variable, get the value of it. proc\ ind { varname } \ { global $varname set iname "\$\{$varname\}" [eval return $iname] } # time conversion routines from my internal format "xx hr xx min xx sec" to secs proc \ sct_time_to_secs { timestr } \ { global sct_run_indefinite_time if {$timestr == "Indefinite"} { return $sct_run_indefinite_time } set list [split $timestr " "] # now we have pairs set len [llength $list] set secs 0 for {set i 0} {$i < $len} {set i [expr $i + 2]} { set str [lindex $list $i] set specndx [expr $i + 1] set specstr [lindex $list $specndx] if {$specstr == "hr"} { set secs [expr $secs + ( $str * 3600 ) ] } if {$specstr == "min"} { set secs [expr $secs + ( $str * 60 ) ] } if {$specstr == "sec"} { set secs [expr $secs + $str ] } } return $secs } # time conversion from seconds to my internal format "xx hr xx min". proc \ sct_secs_to_time { secs } \ { set remain $secs set hours [expr $remain / 3600] set remain [expr $remain % 3600] set mins [expr $remain / 60] set remain [expr $remain % 60] set secs $remain if {$hours} { set str "$hours hr $mins min $secs sec" } elseif {$mins} { set str "$mins min $secs sec" } else { set str "$secs sec" } return $str } # chwpobject.tcl # # The back-end object manager for the chwp program. # # # API is as follows: # # external routines # chwp_db_read - read the saved chwp data. Makes default file as needed. # chwp_db_write - writes modified chwp data back out - can be called as needed. # # chwp_db_container_expand(index) - mark a container as open or closed. # # chwp_db_attr_get_def(name) - get the object definition for editting. # chwp_db_attr_set(index, value) - updates the two internal views with the # new value for the attribute. index is relative to the onscreen view. # # chwp_db_version - get the database version. # chwp_db_cert_valid - get status of whether required fields are filled in. # # chwp_db_delete - delete the given container by backlink index # chwp_db_add_list - get list of valid containers to add # chwp_db_add - add the new container type to end of list # # chwp_db_def_dump - dump the object definition for comparison to CHWP website. # # internal routines (incomplete list): # chwp_dbi_make_mainscreen_db - make a new view from the internal database. # # chwp_dbi_read_def - read the definition file, validates object contents. # chwp_dbi_check_def - validate the object structure after the read. # chwp_dbi_read_data - read the data file - return error if fail. # chwp_dbi_make_data - make a default data file if read fails. # chwp_dbi_reconcile_dbs - reconcile the data file with the object definition. # # data structures maintained by these routeins: # chwp_db_def - the object definition from the definition file. # Just a list of objects, each object is a pair of items, # the key and value taken directory from the def file. # chwp_db_data - the user modified list of objects and values, # fully expanded even if values aren't defined. # mainscreen_db - the viewable portion of chwp_object_db # # db_data/mainscreen_db entry index definitions # object class: set MS(class) 0 # internal attribute/object name: set MS(name) 1 # indentation level for display: set MS(level) 2 # valid activate actions (edit/expand/del): set MS(action) 3 # containers only, if they are expanded or not.: set MS(open) 4 # attributes only, hardware hintkey and required for certification set MS(hintkey) 5 set MS(required) 6 # the description (for an attribute DisplayName). set MS(description) 7 # normally this is value entered by the user. # but for a container it is special: # contains the name of AttributeName in chwp_db_def # contains the value of AttributeName in mainscreen_db and chwp_db_data set MS(value) 8 # only in mainscreen_db, index of the db_data item it came from. set MS(backlink) 9 # list of attributes that can have multiple values set chwp_multiple [list {MustContain {}} {MayContain {}} {Attributes {}} {DisplayValues {}}] # path to chwp definition file. set chwp_db_def_file "$RESPATH/chwp.def" # # Begin chwp_db external routines # # # parse and read the definition file and the user data file. # create the default data file if not present. # if the data file version does not match the definition version, # do reconciliation. # returns if it is a new configuration or not. # proc \ chwp_db_read {} \ { global chwp_db_def global chwp_db_data mainscreen_db # phase one, read the definition file. chwp_dbi_read_def chwp_dbi_check_def # read the data file set new 0 if {[chwp_dbi_read_data] == 0} { chwp_dbi_make_data 0 set new 1 } # always reconcile for now if {[chwp_dbi_reconcile_dbs]} { echo "Updated to new chwp.def file" set new 2 } chwp_dbi_make_mainscreen_db return $new } # # save our data file # proc \ chwp_db_write {} \ { global chwp_db_data chwp_db_data_file MS global chwp_db_data_file_version if {[catch {open $chwp_db_data_file w} fd] == 0} { puts $fd "Version:$chwp_db_data_file_version:" foreach entry $chwp_db_data { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] set value [lindex $entry $MS(value)] set level [lindex $entry $MS(level)] set object [chwp_db_attr_get_def $name] set dtype "" keylget object "DisplayType" dtype if {$dtype == "TextMultiline"} { if {$level} { set prefix "\n\t\t" } else { set prefix "\n\t" } set list [split $value "\n"] set value [join $list $prefix] } set line "$class:$name:$value" if {$level} { set line "\t$line" } puts $fd $line } close $fd } } # # expand or contract the given container, index is relative to mainscreen_db # proc \ chwp_db_container_expand { index } \ { global chwp_db_data mainscreen_db MS # get the mainscreen object set object [lindex $mainscreen_db $index] set backlink [lindex $object $MS(backlink)] set entry [lindex $chwp_db_data $backlink] # change expanded state set open [lindex $entry $MS(open)] if {$open == "open"} { set open closed } else { set open open } # update the entry set entry [lreplace $entry $MS(open) $MS(open) $open] # update the data entry set chwp_db_data [lreplace $chwp_db_data $backlink $backlink $entry] chwp_dbi_make_mainscreen_db } # # given the attribute name, fetch the definition object # proc \ chwp_db_attr_get_def { name } \ { global chwp_db_def foreach entry $chwp_db_def { set tname [keylget entry ObjectName] if {$tname == $name} { return $entry } } echo "fatal error: definition for $name not found" exit 1 } # # Update both mainscreen_db and the data view with a changed object. # index is relative to mainscreen_db # proc \ chwp_db_attr_set { index entry } \ { global chwp_db_data mainscreen_db MS # get the mainscreen object set object [lindex $mainscreen_db $index] set backlink [lindex $object $MS(backlink)] # update the data entry set chwp_db_data [lreplace $chwp_db_data $backlink $backlink $entry] chwp_dbi_make_mainscreen_db } # # get the database version # proc \ chwp_db_version { } \ { global chwp_db_def_file_version chwp_db_data_file_version return $chwp_db_def_file_version } # # check if required fields are filled in for certification # proc \ chwp_db_cert_valid { passthru } \ { global chwp_db_data MS if {$passthru != "passthru" && $passthru != "nopassthru"} { echo Internal error chwp_db_cert_valid bad argument exit 1 } set valid 1 foreach entry $chwp_db_data { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] set value [lindex $entry $MS(value)] set required [lindex $entry $MS(required)] if {$name == "PassThruNumber"} { if {$passthru == "nopassthru"} { continue } } elseif {$required == ""} { continue } if {[chwp_required_attribute_valid $value]} { continue } set valid 0 break } return $valid } proc \ chwp_required_attribute_valid { value } \ { if {$value != "" && $value != "None" && $value != "Unknown"} { return 1 } return 0 } # # delete a given container, rebuild mainscreen db # proc \ chwp_db_delete { index } \ { global chwp_db_data MS # delete the container node down to the next container node or the end set start [expr $index + 1] set length [llength $chwp_db_data] for {set i $start} {$i < $length} {set i [expr $i + 1]} { set list [lindex $chwp_db_data $i] set class [lindex $list $MS(class)] set name [lindex $list $MS(name)] if {$class == "Container"} { break } } set i [expr $i - 1] set chwp_db_data [lreplace $chwp_db_data $index $i] chwp_dbi_make_mainscreen_db } # # enumerate the valid list of containers to add # proc \ chwp_db_add_list {} \ { global chwp_dbi_rootmay set list "" foreach name $chwp_dbi_rootmay { set object [chwp_dbi_def_find_object Container $name] set object [lindex $object 0] set description [keylget object DisplayName] set description [lindex $description 0] lappend list $description } return $list } # # add a new given container type, rebuild mainscreen db # proc \ chwp_db_add { tname } \ { global chwp_db_data rec_attributes MS global chwp_dbi_rootmay # translate display name to internal name foreach name $chwp_dbi_rootmay { set object [chwp_dbi_def_find_object Container $name] set object [lindex $object 0] set description [keylget object DisplayName] set description [lindex $description 0] if {$tname == $description} { set type $name } } set entry [chwp_dbi_make_new_container $type] lappend chwp_db_data $entry set attributes $rec_attributes # value of the AttributeName is filled in later foreach attribute $attributes { set entry [chwp_dbi_make_new_attribute $attribute 1] lappend chwp_db_data $entry } chwp_dbi_make_mainscreen_db } # # dump the object definitions for comparison with the CHWP website # fileter out the "None" values for various fields because those are # internal values to detect if a required field is filled in or not. # proc \ chwp_db_def_dump {} \ { global chwp_db_data chwp_data_def MS # first make a new list with all objects instantiated chwp_dbi_make_data 1 # now dump them and their complete attribute list set first 0 foreach entry $chwp_db_data { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] # get object definition set object [chwp_dbi_def_find_object $class $name] set object [lindex $object 0] set description [keylget object DisplayName] if {$class == "Container"} { if {$first} { echo } else { set first 1 } echo $description } else { # name, type, value list if not text set required "" set ret [keylget object Required required] if {$required != ""} { set required Required } else { set required Optional } set type [keylget object DisplayType] if {[csubstr $type 0 4] != "Text"} { set values [keylget object DisplayValues] # remove "None" if present. # set ndx [lsearch $values None] # if {$ndx >= 0} { # set values [lreplace $values $ndx $ndx] # } echo "\t$description $required $type $values" } else { echo "\t$description $required $type" } } } } # # Begin chwp_dbi internal routines # proc \ chwp_dbi_read_def {} \ { global chwp_db_def chwp_db_def_file chwp_db_def_file_version # open and parse the definition file into our main structure. if {[catch {open $chwp_db_def_file r} fd] != 0} { echo "Unable to open $chwp_db_def_file" exit 1 } set linenum 0 set chwp_db_def "" set object "" set attribute "" gets $fd line2 while {1} { set linenum [expr $linenum + 1] # one line behind set line $line2 # the lookahead line for blank lines and continuation lines if {[gets $fd line2] == -1} { if {$line == ""} { break } set line2 "" # fake a blank line if eof } set c [cindex $line 0] if {$c == "#"} { continue } if {$line != ""} { # check if continuation line if {[ctype space $c]} { set line [string trim $line "\t "] set attribute [concat $attribute $line] } else { set attribute $line } # if next line continuation go get it set c [cindex $line2 0] if {[ctype space $c]} { continue } } if {$attribute != ""} { # save new attribute line # verify that braces match, lrange bombs if not if {[catch {lrange $line 0 99}] != 0} { echo "$chwp_db_def_file: Syntax Error line $linenum:" echo "Mismatched curly braces" echo "$linenum:$line" exit 1 } # have a completed attribute set key [lindex $attribute 0] set val [lrange $attribute 1 999] # strip ':' set ndx [clength $key] set ndx [expr $ndx - 1] if {[cindex $key $ndx] != ":"} { echo "$chwp_db_def_file: Syntax Error line $linenum:" echo Missing key/colon: echo $linenum:$line exit 1 } set key [csubstr $key 0 $ndx] if {"$key" == ""} { echo "$chwp_db_def_file: Syntax Error line $linenum:" echo "Null key before the colon:" echo $linenum:$line exit 1 } set attribute "" # special case for version line, not part # of the object structure if {$key == "Version"} { set chwp_db_def_file_version $val continue } keylset object $key $val } if {$object == ""} { continue; } if {$line != ""} { continue } # end of a valid object, got a blank line # validate our known object types if {[keylget object "ObjectName" name] == 0} { echo "$chwp_db_def_file: Error line $linenum:" echo "Missing attribute ObjectName for object ending on line $linenum" exit 1 } if {[keylget object "ObjectType" type] == 0} { echo "$chwp_db_def_file: Error line $linenum:" echo "Missing attribute ObjectType for object ending on line $linenum" exit 1 } # validate each object type set optional "" if {$type == "RootContainer"} { set required [list ObjectName ObjectType MustContain Attributes MayContain] } elseif {$type == "Container"} { set required [list ObjectName ObjectType DisplayName Attributes MultipleObjects AttributeName] } elseif {$type == "Attribute"} { set required [list ObjectName ObjectType DisplayName DisplayType] set optional [list HintKey ReadOnly Required] keylget object "DisplayType" dtype case $dtype { SingleSelect { lappend required DisplayValues DisplayDefault } MultiSelect { lappend required DisplayValues } Text { lappend optional DisplayDefault } TextMultiline { lappend optional DisplayDefault } default { echo "$chwp_db_def_file: Error line $linenum:" echo "Bad attribute DisplayType for object ending on line $linenum" exit 1 } } if {[keylget object "Required" mtype]} { if {$mtype != "Yes"} { echo "Bad value for Required for object ending on line $linenum, only Yes value is allowed" exit 1 } } } else { echo "$chwp_db_def_file: Error line $linenum:" echo "Bad ObjectType: $type for object ending on line $linenum" exit 1 } chwp_dbi_validate_object_def $object $chwp_db_def_file $linenum $required $optional lappend chwp_db_def $object set object "" } close $fd # if any remnants then a trailing newline was missing. if {$object != ""} { echo "$chwp_db_def_file: Error line $linenum:" echo "Missing Newline at end of last object" exit 1 } if {$attribute != ""} { echo "$chwp_db_def_file: Error line $linenum:" echo "Missing Newline at end of last object" exit 1 } } # # routine to verify an object definition contains what we think it should # proc \ chwp_dbi_validate_object_def { object file linenum required optional } \ { global chwp_multiple set all [concat $required $optional] set keys [keylget object] # first make sure all attributes in the object are valid foreach i $keys { set found 0 foreach j $all { if {$i == $j} { set found 1 break } } if {$found} { set attribute [keylget object $i] # attributes cannot have colons or commas in them if {[lsearch $attribute "*\[,:\]*"] >= 0} { echo "$file: Error" echo "Bad attribute $i has colon or comma near line $linenum" } # verify the number of items is correct # one is always ok if {[llength $attribute] == 1} { continue } # only a few can have multiple values if {[keylget chwp_multiple $i ret] == 0} { echo "$file: Error" echo "Bad attribute $i has zero or multiple values near line $linenum" } continue } echo "$file: Error" echo "Bad attribute $i for object ending on line $linenum" exit 1 } # make sure all required ones are there. foreach i $required { set found 0 foreach j $keys { if {$i == $j} { set found 1 break } } if {$found} { continue } echo "$file: Error" echo "Missing attribute $i for object ending on line $linenum" exit 1 } } # # check the structure of the object definitions that have been read in # We check for hanging (uncontained objects), and that all # contained attributes are present. # the way we do this is to open the root container, find # all the rest of the containers, and build a container list. # We build an attribute list of all valid (contained attributes) and # check them in several passes, # 1) Check that no duplicate names exist (both attributes and containers). # 2) scan through all attributes and containers # and verify that they are contained properly. # 3) scan through container and attribute lists and validate # that they all exist. # proc \ chwp_dbi_check_def {} \ { global chwp_db_def chwp_db_def_file global chwp_dbi_rootmust chwp_dbi_rootmay # structural checking # find root container, make sure exactly one. set object [chwp_dbi_def_find_object RootContainer Root] if {[llength $object] != "1"} { echo "$chwp_db_def_file: Error: missing or multiple root containers" exit 1 } # save the list of all containers for later set object [lindex $object 0] set chwp_dbi_rootmust [keylget object MustContain] set chwp_dbi_rootmay [keylget object MayContain] # include Root because it has attributes too set containers [concat Root $chwp_dbi_rootmust $chwp_dbi_rootmay] # now for the attributes # pass 1 # have the bare bones structure, now check that no duplicate names # exist. Just go through and query on every name and count them. # brute force and inefficient, but modern computers got HP. foreach i $chwp_db_def { set name [keylget i ObjectName] set object [chwp_dbi_def_find_object "" $name] if {[llength $object] != "1"} { echo "$chwp_db_def_file: Error: multiple objects named: $name" exit 1 } } # pass 2 verify that every attribute is found in a container somewhere. # get each container's attribute list, we have the list already. set attributes "" foreach container $containers { set object [chwp_dbi_def_find_object "" $container] set object [lindex $object 0] set attributes [concat $attributes [keylget object Attributes]] } set kattributes "" foreach attribute $attributes { keylset kattributes $attribute "1" } foreach object $chwp_db_def { set name [keylget object ObjectName] set type [keylget object ObjectType] if {$type != "Attribute"} { continue; } # search to see it is contained if {[keylget kattributes $name ret] == 0} { echo "$chwp_db_def_file: Error: Attribute $name is not contained in a container" exit 1 } } # pass 3, scan to see that each named attribute in containes # actually exists as an object. foreach attribute $attributes { set object [chwp_dbi_def_find_object "" $attribute] if {[llength $object] != 1} { echo "$chwp_db_def_file: Error: Referenced attribute does not exist: $attribute" exit 1 } } # scan the containers two passes. # verify referenced containers exist. foreach container $containers { set object [chwp_dbi_def_find_object "" $container] if {[llength $object] != 1} { echo "$chwp_db_def_file: Error: Referenced container does not exist: $container" exit 1 } } # verify that each container is referenced set kcontainers "" foreach container $containers { keylset kcontainers $container "1" } foreach object $chwp_db_def { set name [keylget object ObjectName] set type [keylget object ObjectType] if {$type != "Container"} { continue; } # search to see it is contained if {[keylget kcontainers $name ret] == 0} { echo "$chwp_db_def_file: Error: Container $name is not referenced in the root container" exit 1 } } } # # find objects either by type or name or both # all matching objects are returned # proc \ chwp_dbi_def_find_object { want_type want_name } \ { global chwp_db_def set found "" foreach object $chwp_db_def { set name [keylget object ObjectName] set type [keylget object ObjectType] if {$want_type != ""} { if {$type != $want_type} { continue } } if {$want_name != ""} { if {$name != $want_name} { continue } } lappend found $object } return $found } proc \ chwp_dbi_read_data {} \ { global chwp_db_def MS global chwp_db_data chwp_db_data_file chwp_db_data_file_version # open and parse the data file into our main structure. if {[catch {open $chwp_db_data_file r} fd] != 0} { return 0 } set linenum 0 set chwp_db_data "" set object "" set attribute "" set chwp_db_data_file_version "Unknown" while {[gets $fd line] != -1} { set linenum [expr $linenum + 1] set level 0 if {[cindex $line 0] == "\t"} { set level 1 set line [csubstr $line 1 -1] } set list [mysplit $line ":" 3] set class [lindex $list 0] set name [lindex $list 1] # value is a comma seperated list set value [lindex $list 2] # special case for Version if {$class == "Version"} { set chwp_db_data_file_version $name continue } # validate class case $class { Attribute { set err 0 } Container { set err 0 } default { set err 1 } } if {$err} { echo "$chwp_db_data_file; Warning on line $linenum" echo "Ignoring invalid class: $class" set err 1 continue } # fetch the display name from the def file set object [chwp_dbi_def_find_object $class $name] if {$object == ""} { # object not found echo "$chwp_db_data_file; Warning on line $linenum" echo "Ignoring invalid name: $name" set err 1 continue } set object [lindex $object 0] set description [keylget object DisplayName] set description [lindex $description 0] set readonly "" set ret [keylget object ReadOnly readonly] set hintkey "" set ret [keylget object HintKey hintkey] set required "" set ret [keylget object Required required] if {"$required" != ""} { set required "required" } set oa [chwp_dbi_set_action $class $name $readonly] set open [lindex $oa 0] set action [lindex $oa 1] set entry [list $class $name $level $action $open $hintkey $required $description $value] # validate the value if {$class != "Attribute"} { lappend chwp_db_data $entry continue } set type [keylget object DisplayType] case $type { MultiSelect { # zero, one, or many may be set set vals [keylget object DisplayValues] } SingleSelect { # exactly one must be set set vals [keylget object DisplayValues] } Text { # anything goes set vals "" } TextMultiline { # scan ahead and get the whole thing if {$level} { set tlen 2 set tstr "\t\t" } else { set tlen 1 set tstr "\t" } set last [tell $fd] while {[gets $fd line] != -1} { if {[csubstr $line 0 $tlen] != $tstr} { seek $fd $last break } set new [csubstr $line $tlen 9999] set value "$value\n$new" set last [tell $fd] set linenum [expr $linenum + 1] } set entry [lreplace $entry $MS(value) $MS(value) $value] set vals "" } } if {$vals != ""} { # Now compare the values with the good list. set values [mysplit $value ", " 999] set err 0 foreach val1 $values { set found 0 foreach val2 $vals { if {$val1 == $val2} { set found 1 break } } if {$found == 0} { echo "$chwp_db_data_file; Warning on line $linenum" echo "Ignoring invalid value: $val1" set err 1 break } } } lappend chwp_db_data $entry } close $fd return 1 } # # make the data structure from the def structure. # all is whether all containers are enumerated # or if false only the required containers are enumerated. # all possible attributes are enumerated in order # for each container. # containers get an entry including their closed/open status. # we mirror mainscreen_db with this list. # onscreen order is driven by the def structure. # proc \ chwp_dbi_make_data { all } \ { global chwp_db_def chwp_db_data rec_attributes global chwp_db_data_file_version chwp_db_def_file_version global chwp_dbi_rootmust chwp_dbi_rootmay set chwp_db_data "" set chwp_db_data_file_version $chwp_db_def_file_version if {$all} { set containers [concat $chwp_dbi_rootmust $chwp_dbi_rootmay] } else { set containers $chwp_dbi_rootmust } # get root object set object [chwp_dbi_def_find_object RootContainer Root] set object [lindex $object 0] set topattributes [keylget object Attributes] # first do any attributes in the top level list foreach attribute $topattributes { set entry [chwp_dbi_make_new_attribute $attribute 0] lappend chwp_db_data $entry } # two loops, # outer one the container list # inner one the attributes for that container. foreach container $containers { # get attribute list for this container name set entry [chwp_dbi_make_new_container $container] lappend chwp_db_data $entry set attributes $rec_attributes # value of the AttributeName is filled in later foreach attribute $attributes { set entry [chwp_dbi_make_new_attribute $attribute 1] lappend chwp_db_data $entry } } } # # given an attribute name, make its entry for db_data # proc \ chwp_dbi_make_new_attribute { attribute level } \ { set object [chwp_dbi_def_find_object Attribute $attribute] set object [lindex $object 0] set name [keylget object DisplayName] set name [string trim $name "{}"] set value "" set ret [keylget object DisplayDefault value] set readonly "" set ret [keylget object ReadOnly readonly] set action [chwp_dbi_set_action Attribute $name $readonly] set hintkey "" set ret [keylget object HintKey hintkey] set required "" set ret [keylget object Required required] if {$required != ""} { set required "required" } set entry [list Attribute $attribute $level $action "" $hintkey $required $name $value] return $entry } # # rules for building the action list for an attribute or a container # proc \ chwp_dbi_set_action { class name readonly } \ { global chwp_dbi_rootmust chwp_dbi_rootmay if {$class == "Attribute"} { set action "" set open "" if {$readonly != "Yes"} { set action edit } } else { set open closed if {[lsearch $chwp_dbi_rootmust $name] >= 0} { set action expand } else { set action [list expand delete] } } return [list $open $action] } # # given a container name, make its entry for the db_data # proc \ chwp_dbi_make_new_container { container } \ { global rec_attributes set object [chwp_dbi_def_find_object Container $container] set object [lindex $object 0] set rec_attributes [keylget object Attributes] set name [keylget object DisplayName] set name [string trim $name "{}"] # get the attribute name set attributename [keylget object AttributeName] # create container entry set hintkey "" set required "" set readonly "" set class Container set ret [keylget object ReadOnly readonly] set oa [chwp_dbi_set_action $class $container $readonly] set open [lindex $oa 0] set action [lindex $oa 1] set entry [list Container $container 0 $action $open $hintkey $required $name $attributename] return $entry } # # reconcile a new def file with an existing data file # reconcile affects the attributes and the order of those attributes. # all we have to do is check for attributes appearing and disappearing. # everything else is checked for already. # proc \ chwp_dbi_reconcile_dbs {} \ { global chwp_db_def chwp_db_data MS chwp_db_data_file global chwp_db_def_file_version chwp_db_data_file_version global rec_attributes # get the def version set version_def $chwp_db_def_file_version # get the data version set version_data $chwp_db_data_file_version # Here we reconcile. # first extract the objects we read in. # this is an oddly structured list intended to make searching easier # one list item per container, and that item contains the container # and all its attributes set oldobjects "" set list "" foreach entry $chwp_db_data { set class [lindex $entry $MS(class)] if {$class == "Container"} { lappend oldobjects $list set list "" } lappend list $entry } if {$list != ""} { lappend oldobjects $list } # now scan through the new objects and extract as needed # special case for the root attributes if any. set rootdef [chwp_dbi_def_find_object RootContainer Root] set rootdef [lindex $rootdef 0] set rootattributes [keylget rootdef Attributes] set must [keylget rootdef MustContain] set may [keylget rootdef MayContain] set rootcontainers [concat $must $may] # the new data list set newlist "" foreach attribute $rootattributes { set object [chwp_dbi_rec_root_srch $oldobjects $attribute] # keep it if found if {$object != ""} { lappend newlist $object continue } # otherwise make a new one set entry [chwp_dbi_make_new_attribute $attribute 0] lappend newlist $entry } # now do all of each container type foreach containertype $rootcontainers { set match [chwp_dbi_rec_container_srch $oldobjects $containertype] if {$match == "" && [lsearch $must $containertype] >= 0} { # missing required container lappend newlist [chwp_dbi_make_new_container $containertype] set attributes $rec_attributes # value of the AttributeName is filled in later foreach attribute $attributes { set entry [chwp_dbi_make_new_attribute $attribute 1] lappend newlist $entry } } if {$match == ""} { continue } lappend newlist [chwp_dbi_make_new_container $containertype] # fetch the definition set containerdef [chwp_dbi_def_find_object Container $containertype] set containerdef [lindex $containerdef 0] set attributes [keylget containerdef Attributes] foreach container $match { # have a single container and its attributes foreach attribute $attributes { set newattr [chwp_dbi_rec_container_attribute_srch $container $attribute] if {$newattr != ""} { lappend newlist $newattr } else { lappend newlist [chwp_dbi_make_new_attribute $attribute 1] } } } } if {$newlist != $chwp_db_data} { set chwp_db_data $newlist return 1 } if {$version_def != $version_data} { return 1 } return 0 } # search the root attributes for the given attribute type. proc \ chwp_dbi_rec_root_srch { oldobjects attribute } \ { global MS set attributes [lindex $oldobjects 0] set firstentry [lindex $attributes 0] set class [lindex $firstentry $MS(class)] if {$class != "Attribute"} { return "" } foreach entry $attributes { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] if {$name == $attribute} { return $entry } } return "" } # search for all containers matching the given type proc \ chwp_dbi_rec_container_srch { oldobjects containertype } \ { global MS set newlist "" foreach object $oldobjects { set firstentry [lindex $object 0] set class [lindex $firstentry $MS(class)] set name [lindex $firstentry $MS(name)] if {$class != "Container"} { continue } if {$name != $containertype} { continue } lappend newlist $object } return $newlist } # given a container and its attributes find the given attribute proc \ chwp_dbi_rec_container_attribute_srch { containerobject attribute } \ { global MS set newlist "" foreach entry $containerobject { set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] if {$class != "Attribute"} { continue } if {$name != $attribute} { continue } set newlist $entry break } return $newlist } # # build the mainscreen display database from the internal database # we filter out closed items and fill in container names # proc \ chwp_dbi_make_mainscreen_db {} \ { global chwp_db_def chwp_db_data MS mainscreen_db set mainscreen_db "" # assume one level of hierarchy set open open set index -1 set end [llength $chwp_db_data] foreach entry $chwp_db_data { set index [expr $index + 1] lappend entry $index set class [lindex $entry $MS(class)] set name [lindex $entry $MS(name)] if {$class == "Attribute"} { if {$open == "open"} { lappend mainscreen_db $entry } continue } # have a container, extract its open state. set open [lindex $entry $MS(open)] # find the name attribute, get this from the object definition. set entrydef [chwp_dbi_def_find_object $class $name] set entrydef [lindex $entrydef 0] set sname [keylget entrydef AttributeName] # now find the value of it set found 0 set start [expr $index + 1] for {set ndx $start} {$ndx < $end} {set ndx [expr $ndx + 1]} { set object [lindex $chwp_db_data $ndx] set tname [lindex $object $MS(name)] if {$tname == $sname} { set value [lindex $object $MS(value)] set entry [lreplace $entry $MS(value) $MS(value) $value] set found 1 break } } if {$found == "0"} { error "Internal error, $sname object not found" } # add the entry to the mainscreen lappend mainscreen_db $entry } } #!/bin/osavtcl # # dump the object definitions so they can be compared with # the CHWP database definition # proc \ main {} \ { chwp_db_read chwp_db_def_dump } main 0707070000000000041006440000000000030000010000001023123603600004000000001011root/home/sct/doc/CONTENTS.html
The System Certification Tests (sct) are a suite of automated tests to satisfy system configuration and stability requirements for the SCO Certified Hardware Program. The SCT interface controls the configuration and execution of system load tests and ensures that the necessary hardware configuration information is recorded. Finally, the SCT interface provides functions that collect and prepare a handoff file for delivery to SCO.
The SCT package replaces the SCO Balanced Load Tests, and is certified for the following SCO Operating System releases:
Those with older releases should continue to use the Balanced Load Test programs.
For current information about the entire UnixWare and SCO OpenServer Hardware Development Kit (HDK) release, see the HDK Release Notes.
NOTE: The documentation references man pages for the UnixWare and SCO OpenServer platforms. The sct documentation is available from the online library or from within the sct application in the context-sensitive help.
The package can be installed from a download or media distribution.
Downloaded files
pkgadd -d /tmp/sct.pkg all
Media distribution
pkgadd -d cdrom1 sct.pkg all
The package can be installed from a download or media distribution.
Downloaded files
tar xvf /tmp/sct.tar
The extracted files are of the form VOL.000.000, VOL.001.000, etc.
Media distribution
See the online help within the application for detailed information about configuration and usage.