# inf.tcl - Setup routines to process inf files.## Copyright 1998 Wind River Systems, Inc## Modification history# --------------------# 03b,13jul02,wmd  Change setup log message for failure to start service to#                  say "Unable to confirm..."# 03a,12jun01,j_w  Modified for Tornado 2.2# 02a,21jun00,bjl  Added int option to addRegistryLine.# 01z,31may00,j_w  Enabled the Tornado Registry Service to be re-started right#                  after removal (SPR 31316)# 01y,16mar00,bwd  Changed patch checking to support only Solaris 2.7# 01x,21oct99,bjl  removed parisc-hpux support.# 01w,13oct99,bjl  process TORNADO.INF for tornado-* products in#                  searchAndProcessSection.# 01v,22mar99,bjl  do not write to uninstall log for first reg subkey.# 01u,19mar99,wmd  Debug message writes to a file instead.# 01t,08mar98,wmd  added work-around to get setup running on HPUX, don't#                  redirect output to a file using exec.# 01s,03mar99,wmd  Place catches around exec calls.# 01r,24feb99,bjl  fixed default registry values to be empty when no values#                  are specified.# 01q,21feb99,bjl  fixed creation of first subkey directly below root key#                  in the windows registry.# 01p,01feb99,bjl  replaced ampersandReplace with subspecSpecialCharReplace.# 01o,08jan99,bjl  replace ampersands in regsub subspecs (fixes spr 24217).# 01n,09dec98,bjl  enhanced HPUX patch checking to check for list of#                  patch numbers or use patch description.# 01m,04dec98,bjl  limit Solaris 2.6 patch checking to 2.6 instead of 2.6.x.# 01l,11nov98,bjl  added processing of ALLPRODUCTS.INF to#                  selectedProductsProcessInfFile.# 01k,27oct98,bjl  added patch checking for HPUX 10, added required#                  and recommended criteria to patch checking.# 01j,25sep98,bjl  added required patch checking for Solaris.# 01i,15sep98,bjl  swapped args and dir position for addIconLine.# 01h,09sep98,bjl  added os version to filesCopy, account for unix paths.# 01g,03sep98,bjl  changed inf filenames to uppercase.# 01f,13aug98,bjl  added infputs wrapper and changed all puts to infputs.# 01e,13aug98,tcy  added extra argument "args" for linkCreateLog# 01d,12aug98,tcy  changed function calls in accordance with new OLE-based SETUP# 01c,11aug98,tcy  unixified# 01b,04aug98,bjl  added WarningsFile and InstallLast sections, tab cleanup.# 01a,26jul98,bjl  written.################################################################################ extractSectionName - extract the section name between the brackets## This procedure will extract the section name between the brackets.## SYNOPSIS# extractSectionName <bracketedName>## PARAMETERS:#   bracketedName : a section name in between brackets## RETURNS: the section name without brackets## ERRORS: N/A#proc extractSectionName {bracketedName} {    regexp {[^[]+} $bracketedName extractedName    regexp {[^]]+} $extractedName extractedName    return $extractedName}############################################################################### readLine - read the next line with data.## This procedure will read and return the next line from the inf file# containing valid data.  Blank lines are skipped.## SYNOPSIS# readLine## PARAMETERS: N/A## RETURNS: sucessfully read line from inf file.## ERRORS: N/A#proc readLine {} {    global infFileId    set lineRead 0    # skip over blank lines    while {$lineRead == 0} {        set lineRead [gets $infFileId line]    }    return $line}############################################################################### openFile - open the inf file for processing.## Opens the inf file specified by <fileName> and sets the global# inf file id.## SYNOPSIS# openFile <fileName>## PARAMETERS:#   fileName : name of the inf file to open.## RETURNS:#   0 if <fileName> cannot be opened.#   1 if successful.## ERRORS: N/A#proc openFile {fileName} {    global infFileId    if [catch {open $fileName r} infFileId] {        infputs "INF processing: Cannot open INF file $fileName"        return 0    }    return 1}############################################################################### closeFile - closes the inf file being processed## Closes the current inf file being processed, which is specified# by the global variable infFileId.## SYNOPSIS# closeFile## PARAMETERS: N/A## RETURNS: N/A## ERRORS: N/A#proc closeFile {} {    global infFileId    close $infFileId}############################################################################### getLineType - returns the line type of the specified line.## Returns whether the line contains a comment, section name, or data.## SYNOPSIS# getLineType <line>## PARAMETERS:#   line : a line read from the inf file.## RETURNS:#   "comment" if the line is a comment (begins with ";")#   "section_name" if the line contains a section name (begins with "[")#   "data" for all other cases#   "end_of_file" if the end of the file has been reached## ERRORS: N/A#proc getLineType {line} {    # end of file does not register as a blank line for readLine    if {[endOfFile]} {        return end_of_file    }    # get the first character that is not a space or tab    regexp {[^ \t]} $line firstCharacter    switch -exact -- $firstCharacter {        ;       { return comment }        [       { return section_name }        default { return data }    }}############################################################################### endOfFile - returns whether the end of the inf file has been reached.## Returns whether the end-of-file has been reached for the current inf file# begin processed.## SYNOPSIS# endOfFile## PARAMETERS: N/A## RETURNS:#   0 if eof has not been reached#   1 if eof has been reached## ERRORS: N/A#proc endOfFile {} {    global infFileId    return [eof $infFileId]}############################################################################### subspecSpecialCharReplace - replace all special characeters within a#                             string to be used as a regsub subspec.## For a given string that is to be used as a subspec for the regsub# command, this procedure replaces all special characters within# the string so that they retain their literal value.## All occurences of slashes are first replaced with four slashes.  Oddly# for the latest Tcl (8.0), this ensures that a literal slash is preserved# through the regsub, rather than becoming part of a character# interpretation.## All occurrences of & are replaced with \&.  A plain & in a subspec is# replaced with the string that matched the pattern.## SYNOPSIS# subspecSpecialCharReplace <value>## PARAMETERS:#   value : a string with possible special characters to be replaced.## RETURNS:#   A new value in which special characters have been replaced so they#   retain their literal values during a regsub, if the value is used as a#   replacement pattern (subspec).## ERRORS: N/A#proc subspecSpecialCharReplace {value} {    regsub -all {\\} $value {\\\\} value    regsub -all & $value \\\\& value    return $value}############################################################################### percentEvaluate - evaluates substring values between percent signs.## For a given string, this procedure evaluates and replaces all substrings# between percent signs.  A new string containing the replaced substrings is# returned.## The order of evaluation for each substring is as follows:#   1. the substring is replaced with the value specified in the Strings#      section of the inf file.#   2. if the substring is a procedure name, it is replaced with its return#      value.#   3. if the substring is a global variable, it is replaced with its value.## SYNOPSIS# percentEvaluate <value>## PARAMETERS:#   value : a string with possible substrings between % signs## RETURNS:#   A new string with substrings between % signs replaced with their#   evaluated strings.  If a substring between % signs cannot be replaced,#   the original string is returned.### ERRORS: N/A#proc percentEvaluate {value} {    global infString    while {[regexp {%[^%]+%} $value evaluation_subspec] != 0} {        regexp {[^%]+} $evaluation_subspec valueToEvaluate        # check if infString, procedure, or variable exists        set infStringExists [info exists infString($valueToEvaluate)]        set functionExists [info procs $valueToEvaluate]        # allow checking of arrays - check for array variable format        if {[regexp {[^()]+\([^(]+\)} $valueToEvaluate != 0]} {            regexp {[^\(]+} $valueToEvaluate arrayName            global $arrayName        } else {            global $valueToEvaluate        }        set variableExists [info exists $valueToEvaluate]        # do the evaluation        if {$infStringExists == 1} {            regsub {%[^%]+%} $value [subspecSpecialCharReplace $infString($valueToEvaluate)] value        } elseif {[string length $functionExists] > 0} {            regsub {%[^%]+%} $value [subspecSpecialCharReplace [$valueToEvaluate]] value        } elseif {$variableExists == 1} {            regsub {%[^%]+%} $value [subspecSpecialCharReplace [set $valueToEvaluate]] value        } else {            infputs "INF processing: %$valueToEvaluate% is not specified"            infputs "in the Strings section, is not a procedure, and is not a"            infputs "global variable."            return $value        }    }    return $value}############################################################################### nthValueFromCommaDelimitedLine - returns the nth value of a comma delimited#                                  list## For a list of values separated by commas, returns the nth value in the# list.  Whitespace preceding each value is accounted for.  Substrings# for each value in between % signs are replaced by calling the# procedure percentEvaluate.### SYNOPSIS# nthValueFromCommaDelimitedLine <line> <index>## PARAMETERS:#   line : a string of comma delimited values#   index : specifies the nth value to be returned.  The index starts with#           1 (the first value in the list).## RETURNS:#   The nth value specified by <index>.#   "no_value" if the value specified by index does not exist.## ERRORS: N/A#proc nth {line index} {    return [nthValueFromCommaDelimitedLine $line $index]}proc nthValueFromCommaDelimitedLine {line index} {    # count the number of commas.  If the number is less than    # the index-1, the index value does not exist.    set numcommas [regsub -all , $line {} ignore]    if {$numcommas < [expr $index - 1]} {        return no_value    }    set value [lindex [split $line ,] [expr $index - 1]]    # remove prefixing spaces or tabs    regexp "\[^ \t\]+.*" $value value    if {[string length $value] == 0 } {        return no_value    }    # make sure value does not consist of just spaces or tabs    if {[regexp "\[^ \t\]+" $value]==0} {        return no_value    }    # evaluate all strings between percent signs    set value [percentEvaluate $value]    return $value}#############################################################################