inf.tcl

Berkeley DB 4.6.21VxWorks CD.NC.tar.gz

# inf.tcl - Setup routines to process inf files.  
#
# Copyright 1998 Wind River Systems, Inc
#
# Modification history
# --------------------
# 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               
}

#############################################################################
#
# checkPossibleRegRootNames - checks that the Registry root name is valid. 
#
# Checks that <reg_root_string> is a valid value for the Windows registry.  
# If a valid abbreviation, returns the full registry root name.  The