install.tcl

好东西,欢迎下在,联系方式E-mail:[e-mail]

    set setupVals(umask) [split [setupUmaskSet [format "%d" 022]] ""]
    setupUmaskSet $setupVals(umask)

    #initialize all to 0
    set setupVals(ur) 0
    set setupVals(uw) 0
    set setupVals(gr) 0
    set setupVals(gw) 0
    set setupVals(or) 0
    set setupVals(ow) 0

    set noRead {7 6 5 4}
    set noWrite {7 6 3 2} 

    set user [lindex $setupVals(umask) 1]
    if {[lsearch $noRead $user] == "-1"}  { set setupVals(ur) 1 }
    if {[lsearch $noWrite $user] == "-1"} { set setupVals(uw) 1 }

    set group [lindex $setupVals(umask) 2]
    if {[lsearch $noRead $group] == "-1"}  { set setupVals(gr) 1 }
    if {[lsearch $noWrite $group] == "-1"} { set setupVals(gw) 1 }

    set other [lindex $setupVals(umask) 3]
    if {[lsearch $noRead $other] == "-1"}  { set setupVals(or) 1 }
    if {[lsearch $noWrite $other] == "-1"} { set setupVals(ow) 1 }
}

##############################################################################
#
# umaskSet - sets new umask value
#
# This routine gets the user file permision request, converts it to a umask
# value then set it for the current process.  A global variable fileMode is 
# also created in 'chmod' flag syntax for later use.
#
# SYNOPSIS
# umaskSet
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc umaskSet {} {
    global setupVals

    set user  [expr 6 - ( $setupVals(ur)*4 + $setupVals(uw)*2 )]
    set group [expr 6 - ( $setupVals(gr)*4 + $setupVals(gw)*2 )]
    set other [expr 6 - ( $setupVals(or)*4 + $setupVals(ow)*2 )]
    setupUmaskSet [format "%d" 0$user$group$other]

    set plus "+"
    set minus "-"
    set setupVals(fileMode) [format "u%sr,u%sw,g%sr,g%sw,o%sr,o%sw" \
	                         [expr $setupVals(ur) == 1 ? \$plus:\$minus] \
                                 [expr $setupVals(uw) == 1 ? \$plus:\$minus] \
	                         [expr $setupVals(gr) == 1 ? \$plus:\$minus] \
                                 [expr $setupVals(gw) == 1 ? \$plus:\$minus] \
	                         [expr $setupVals(or) == 1 ? \$plus:\$minus] \
                                 [expr $setupVals(ow) == 1 ? \$plus:\$minus]]
}

##############################################################################
#
# debug - turns on debug mode
#
# SYNOPSIS
# debug
#
# PARAMETERS: N/A
#
# RETURNS: true if the environment var SETUP_DEBUG exists, otherwise false
#
# ERRORS: N/A
#

proc debug {} {
    global env

    if {[info exists env(SETUP_DEBUG)]} {
        return 1
    } {
        return 0
    }
}

##############################################################################
#
# fileDup - copies a file
#
# This routine copies srcFile to destFile.  The default option flag is 'none' 
# which means doing nothing if destFile exists, update: if srcFile is newer, 
# backup destFile then copies, overwrite: backup then copies.  In case of
# failure, a message will be displayed, and user has a chance to decide next
# action.  All successful copied filename will be logged for later uninstall.
#
# SYNOPSIS
# fileDup <srcFile> <destFile> [option]
#
# PARAMETERS: 
#    <srcFile> : an absolute path filename
#    <destFile> : an absolute path filename
#    [option] : none | update | overwrite
#               
# RETURNS: True or False bases on success or failure.
#
# ERRORS: N/A
#

proc fileDup {sourceFilePath destFilePath {option none}} {
    global ctrlVals setupVals

    if ![file exists $sourceFilePath] {
        if [debug] {
            puts "$sourceFilePath not found"
        }
        return 0
    }

    regsub -all {\\} $destFilePath {/} destFilePathUnixStyle
    regsub -all {\\} [destDirGet] {/} destDir
    regsub "$destDir/" $destFilePathUnixStyle "" relDestFilePathUnix

    switch $option {
        none {
            if [file exists $destFilePath] {return 1}
        }
        update {
            if {[file exists $destFilePath] && 
                [file mtime $sourceFilePath] <= [file mtime $destFilePath]} {
                return 1
            } elseif {[file exists $destFilePath]} {
                backup $relDestFilePathUnix
	    }
        }
        overwrite {
            if {[file exists $destFilePath]} {
                backup $relDestFilePathUnix
	    }
	}
        default {
            puts "fileDup $sourceFilePath $destFilePath $option"
            puts "unknown option: $option"
        }
    }

    set destDir [file dirname $destFilePath]

    if {![file isdirectory $destDir] && [catch {file mkdir $destDir} error]} {
        puts "$error"
        return 0
    }

    if [catch {file copy -force $sourceFilePath $destFilePath} error] {
        set msg [strTableGet 1370_FILE_ACCESS_ERROR $destFilePath $error]

        switch [dialog re_ig_cancel "Setup" $msg question 0] {
            0 {return [fileDup $sourceFilePath $destFilePath $option]}
            1 {
                set msg "\tcannot create $destFilePath: $error"
                lastErrorSet $msg
                uninstLog setup $msg
                return 0
            }
            default {quitCallback}
        }
    }

    if {[info exists setupVals(fileMode)] && [windHostTypeGet] != "x86-win32"} {
        catch {exec chmod $setupVals(fileMode) $destFilePath}
    }

    # logging for later uninstall

    uninstLog file "wind_base\t$relDestFilePathUnix"

    return 1
}

##############################################################################
#
# pageRemove - removes an installation step
#
# This routine removes an element from the pageList which control the flow of
# the setup script.  Once an element is removed from the list, their associate
# functions, pageCreate() and pageProcess() will be skipped.
#
# SYNOPSIS
# pageRemove <pageName>
#
# PARAMETERS: 
#    <pageName> : an element in the pageList
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc pageRemove {page} {
    global ctrlVals

    if {[lsearch $ctrlVals(pageList) $page] == "-1"} {
        if [debug] {puts "cannot find page $page to remove"}
    } {
        set tempList ""

        foreach p $ctrlVals(pageList) {
            if {"$p" != "$page"} {
                lappend tempList $p
            }
        }
        set ctrlVals(pageList) $tempList
    }
}

##############################################################################
#
# bbrdListGet - obtains a list of bitmaps
#
# This routine walks thru all selected products, and extracts the available 
# bitmaps.
#
# SYNOPSIS
# bbrdListGet <extension>
#
# PARAMETERS: 
#    <extension> : bitmap file extension, supported extension are .BMP and .PPM
#
# RETURNS: a list of bitmap filename.
#
# ERRORS: N/A
#

proc bbrdListGet {extension} {
    global ctrlVals

    set retVal ""
    set newList ""

    if {[windHostTypeGet] == "x86-win32"} {
        set zipFile [cdromZipDirGet]\\WIND.000
    } {
        set zipFile [cdromZipDirGet]/WIND.000
    }

    set prodNameList "prologue"
    lappend prodNameList [cdInfoGet selectedProdNameList]
    lappend prodNameList "epilogue"
    set prodNameList [join $prodNameList]

    foreach prodName $prodNameList {
        if ![catch {setupUnzip -o -qq -d [tempDirGet] $zipFile "$prodName/*$extension"} \
            error] {

            set saveDir [pwd]
            cd [tempDirGet]/$prodName

            set bbrdList [glob -nocomplain "*$extension"]

            foreach bbrdFile $bbrdList {
                if {[windHostTypeGet] == "x86-win32"} {
                    lappend newList "[tempDirGet]\\$prodName\\$bbrdFile"
                } {
                    lappend newList "[tempDirGet]/$prodName/$bbrdFile"
                }
            }
            cd $saveDir
        }
    }
    return $newList
}

##############################################################################
#
# execute - executes product pre/postInstall tcl script
#
# This procedure extracts the provided tclFile, if exists, then evaluates it.
#
# SYNOPSIS
# execute <tclFile>
#
# PARAMETERS: 
#    <tclFile> : product preInstall.tcl or postInstall.tcl
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc execute {tclFile} {

    set zipFile [cdromZipDirGet]/WIND.000

    if {[file exists $zipFile]} {
        if ![catch {setupUnzip -o -qq -d [tempDirGet] $zipFile $tclFile} retVal] {
            if ![catch {open [tempDirGet]/$tclFile "r"} fp] {
                set retVal [read $fp]
                close $fp
            
                if [debug] {
                    puts "Evaluating $tclFile"
                    puts "$retVal"
                }

                if [catch {eval $retVal} error] {
                    puts "$error"
                }
            }
        }
    }
}
 
##############################################################################
#
# byteToMbyte - converts bytes to Mbytes
#
# SYNOPSIS
# byteToMbyte <size>
#
# PARAMETERS: 
#    <byte> : number in bytes
#
# RETURNS: number in mega bytes
#
# ERRORS: N/A
#

proc byteToMbyte {size} {
    return [format "%3.1f" [expr $size / 1048576.0]]
}

##############################################################################
#
# objectConstruct - creates objects to store all information about the unlocked
#                   products.
#
# This function must be called prior to the following functions: cdInfoGet/Set
# SYNOPSIS
# objectConstruct
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc objectConstruct {} {
    global productObj partObj featureObj cdObj
    global constructed

    if ![info exists constructed([instKeyGet])] {

        catch {
            unset constructed
            unset productObj 
            unset partObj
            unset featureObj
        }

        set constructed([instKeyGet]) 1
        set productDescList {}

        foreach prodIndex [setupProductIndexListGet] {
    
            set productObj($prodIndex,instFlag) 0
            set productObj($prodIndex,prevInstFlag) 0
            set productObj($prodIndex,partIndexList) {}

            set partIndexList [setupPartIndexListGet $prodIndex]

            foreach partIndex $partIndexList {
    
                set infoList [setupPartInfoGet $partIndex]
                
                set productNum    [lindex $infoList 0]
                set productName   [lindex $infoList 1]
                set productDesc   [lindex $infoList 2] 
                set partName      [lindex $infoList 3]
                set partDesc      [lindex $infoList 4]
                set productIndex  [lindex $infoList 5]
                set defInstFlag   [lindex $infoList 6]
                set totalFile     [lindex $infoList 7]
                set featureDesc   [lindex $infoList 8]
                set featureId     [lindex $infoList 9]
                set size          [lindex $infoList 10]

                # construct CD object

                if ![info exists cdObj(number)] {
                    set cdObj(number) [lindex $infoList 11]
                }

                # construct product objects
    
                set productObj($prodIndex,number) $productNum
                set productObj($prodIndex,name) $productName
                set productObj($prodIndex,desc) $productDesc
                lappend productObj($prodIndex,partIndexList) $partIndex
    
                # construct part objects
    
                set partObj($partIndex,instFlag) $defInstFlag
                set partObj($partIndex,prevInstFlag) $defInstFlag
                set partObj($partIndex,desc) $partDesc
                set partObj($partIndex,featureId) $featureId
                set partObj($partIndex,size) $size
                set partObj($partIndex,totalFile) $totalFile
                set partObj($partIndex,parent) $prodIndex
    
                set featureObj($featureId) $featureDesc