install.tcl

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

# install.tcl - Installation program for Unix/Windows platforms.
#
# Copyright 1984-1997 Wind River Systems, Inc
#
# Modification history:
# ---------------------
# 02s,12aug97,pdn  moved version string to VERSION.TCL
# 02r,04aug97,pdn  merged fixed from qms1_0_x branch.
# 02q,20jun97,pdn  allowed native $(AR), and $(RANLIB) to be defined.
# 02p,13jun97,pdn  changed to use setup APIs as a DLL.
# 02o,19may97,pdn  fixed fileNameAppreviate() to handle the case that regexp
#                  fails to match.
# 02n,02may97,pdn  added comments.
# 02m,08apr97,pdn  fixed fileDup() to handle file permission accordingly
# 02l,28mar97,pdn  added code to support correct uninstall
# 02k,10mar97,pdn  fixed library update routine.
# 02j,08mar97,tcy  undo last mod
# 02i,07mar97,tcy  moved needUpdateWlmd() from INSTTK.TCL to here
# 02h,07mar97,pdn  fixed uninstStart to allow patch uninstallation.
# 02g,05mar97,pdn  sorted the product list.
# 02f,04mar97,pdn  copy ZIP utility to bin directory.
#                  added hook for patch installation.
# 02e,25feb97,pdn  added function byteToMbyte()
# 02d,24feb97,pdn  modified fileDup() to allow update/overwrite.
# 02c,09feb97,pdn  fixed cdInfoGet to return correct selected feature Id list
# 02b,04feb97,pdn  fixed library updating problem.
# 02a,24jan97,pdn  rounded up the product size upto 0.1 MB where needed
# 01z,24jan97,pdn  returned to the calling function when user hit cancel
# 01y,22jan97,pdn  fixed the ar so that console windows in Windows 95 won't show up.
# 01x,21jan97,pdn  fixed fileDup(), and execute().
# 01w,20jan97,pdn  fixed replicated feature id/name, better error hanlding
# 01v,14jan97,pdn  updated uninstBinCopy() to support Windows, fixed indentation
# 01u,07jan97,pdn  updated the pre/post install
#                  implemented billboard cycling from product dir
# 01t,18dec96,sks  changed location of TCL and BITMAP files; renamed
#                  TEXT.TCL to MESSAGES.TCL                   
# 01s,13dec96,pdn  updated postInstall()
# 01r,12dec96,pdn  added productName to the productObj
# 01r,11dec96,pdn  fixed cdInfoGet and productInfoGet to return correct
#                  featureId list
# 01q,09dec96,pdn  added hierachy selection option
# 01p,23nov96,sj   incorporated post and presinstall mechanisms
# 01o,18nov96,sj   caught user removing CDROM when files are being 
#                  copied over and included the check for backuped
#                  files into backup().
# 01m,11nov96,pdn  centralized all strings to TEXT.TCL 
# 01l,08nov96,pdn  backup newer files in the same manner as older files.
# 01k,06nov96,pdn  added retry option for fileDup()
# 01j,05nov96,pdn  fixed the uninstall logging
# 01i,24oct96,pdn  added uninstLog()
# 01h,21oct96,pdn  added pageRemove()
# 01g,18oct96,pdn  updated uninstStart() to use new uninst dir, and added
#                  uninstBinCopy()
# 01f,01oct96,tcy  moved umaskGet(), umaskSet(), getSelection() here  
# 01e,29aug96,pdn  allowed non-tk specific installation
# 01d,27aug96,pdn  handle messages return from zip.
# 01c,02jul96,pdn  added directory creation, and implement lib update.
# 01b,25jun96,pdn  modified the GUI to meet the specification.
# 01a,11jun96,jco  translated to tk from the uitcl/Windows.
#

source [cdromRootDirGet]/RESOURCE/TCL/VERSION.TCL

##############################################################################
#
# fileNameAppreviate - shorten the filename for GUI displaying purpose
#
# This procedure shorten filename if it's longer than 40 chars.  The shorten
# filename will be in the form firstDir/.../lastDir/fileName.  There is no
# warranty that the resulted filename will be any shorter than the original one.
#
# SYNOPSIS
# fileNameAppreviate <fileName>
#
# PARAMETERS: 
#    fileName : a path filename
#
# RETURNS: shorten filename
#
# ERRORS: N/A
#

proc fileNameAppreviate {fileName} {
    set shortName $fileName

    if {[string length $fileName] > 40} {
        if [regexp {(^[^/]+)/.*/([^/]+/[^/]+$)} $fileName junk\
                 firstPart lastPart] {
            set shortName "$firstPart/.../$lastPart"
        }
    } 
    return $shortName
}

##############################################################################
#
# archListPut - save the object filename 
#
# This procedure checks the provided filename for a special pattent.  If 
# matches, the filename will be saved in a global array for later archiving
# step.  The keys of this associated array are the object location, and product
# index.
#
# SYNOPSIS
# archListPut <fileName> <index>
#
# PARAMETERS: 
#    fileName : a path filename
#    index : an index to a current product
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc archListPut {fileName index} {
    global objects

    # toolset and typeset can be a set of strings "|" together
    # "gnu|gnucoff|..."

    set toolset "gnu"
    set typeset "vx"

    if {[regexp "^.*/lib/obj(.*)($toolset)($typeset)(.*)/(.*$)" $fileName \
         junk cpu tool type typex tailFileName] == "1"} {

        set objDir "$index,obj,$cpu,$tool,$type,$typex"

        if [info exists objects($objDir)] {
            if {[lsearch $objects($objDir) $tailFileName] == "-1"} {
                lappend objects($objDir) $tailFileName
            }
        } {
            set objects($objDir) [list $tailFileName]
        }
    }
}

##############################################################################
#
# backup - save the specified file into a zip file. 
#
# This procedure zips the specified file into a zipfile.  If the file is
# previously backed up, nothing will be done.
#
# SYNOPSIS
# backup <fileName>
#
# PARAMETERS: 
#    fileName : a path filename
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc backup {fileName} {
    global setupVals backUpFileArray   

    if ![info exists backUpFileArray($fileName)] { 

        set saveDir [pwd]
        cd [destDirGet]

        # only interested in the existent of the array element, not the content

        set backUpFileArray($fileName) "" 

        if [catch {exec ZIP $setupVals(uninstFile) -g -q -1 $fileName} error] {
            uninstLog setup "\twarning: $fileName : $error"
            if [debug] {puts "warning: $fileName: $error"}
        } {
            uninstLog backup "wind_base\t$fileName"
        }

        cd $saveDir
    }
}

##############################################################################
#
# fileBackupAndRemove - backup and remove
#
# This procedure backups, then removes the specified file.
#
# SYNOPSIS
# fileBackupAndRemove <fileName>
#
# PARAMETERS: 
#    fileName : a path filename
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc fileBackupAndRemove {fileName} {
    backup $fileName
    catch {file delete $fileName}
}

##############################################################################
#
# fileRemove - remove the specified file
#
# This procedure removes the specified file, and if fails to do so, it's then
# popping up a dialog to query for the next action.
#
# SYNOPSIS
# fileRemove <fileName>
#
# PARAMETERS: 
#    fileName : a path filename
#
# RETURNS: 
#    OK     : successful removing <filename>
#    RETRY  : failed to remove the file, and user wants to retry.
#    IGNORE : failed to remove the file, and user wants to ignore it.
#
# ERRORS: N/A
#

proc fileRemove {fileName} {
    global setupVals

    if [catch {file delete $fileName} error] {
        set msg [strTableGet 1370_FILE_ACCESS_ERROR $fileName $error]

        switch [dialog re_ig_cancel "Setup" $msg question 0] {
            0 { return "RETRY" }
            1 {
                set logMsg "\terror: $fileName: $error"
                lastErrorSet $logMsg
                uninstLog setup $logMsg
                return "IGNORE"
            }
            default {quitCallback}
        }
    }
    return "OK"
}

##############################################################################
#
# uninstStart - obtains a zip filename
#
# This procedure obtains a zip filename for use in sub-sequence calls to zip,
# creates $WIND_BASE/.wind/uninst if not exist.  Must be called prior any zip 
# function call.
#
# SYNOPSIS
# uninstStart [type]
#
# PARAMETERS: 
#    [type] : if 'license' is specified, zip filename w/ extension 001 returns.
#
# RETURNS: zip filename.
#
# ERRORS: N/A
#

proc uninstStart {{type Software}} {
    global setupVals

    uninstHomeDirSet [destDirGet]/.wind/uninst

    if ![file isdirectory [uninstHomeDirGet]] {
        file mkdir [uninstHomeDirGet]
    }

    if {"$type" == "license"} {
        set setupVals(uninstFile) "[uninstHomeDirGet]/data.001"
    } {
        set setupVals(uninstFile) \
            "[uninstHomeDirGet]/data.[format "%03d" [expr 1 + \
             [llength [glob -nocomplain [uninstHomeDirGet]/data.*]]]]"
    }
}

##############################################################################
#
# uninstFileClose - close uninstall file descriptions.
#
# This procedure closes uninstall file descriptions if they are still opened.
#
# SYNOPSIS
# uninstFileClose
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc uninstFileClose {} {
    global setupVals

    if {"$setupVals(uninstFileOpen)" == "opened"} {
        close $setupVals(fInstallFile)
        close $setupVals(fInstallInfo)
        close $setupVals(fInstallBackup)
        close $setupVals(fInstallResource)
        puts $setupVals(fSetupLog) ""
        close $setupVals(fSetupLog)
        set setupVals(uninstFileOpen) closed
    }
}

##############################################################################
#
# uninstFileOpen - opens files for recording uninstall info.
#
# This procedure opens disk files for writing the temporary uninstall records.
# These files will be closed by calling uninstFileClose()
#
# SYNOPSIS
# uninstFileOpen
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

set setupVals(uninstFileOpen) ""

proc uninstFileOpen {} {
    global setupVals

    if {"$setupVals(uninstFileOpen)" != "opened"} {
        set setupLog [tempDirGet]/setup.log.tmp
        set uninstFile [tempDirGet]/installFile.tmp
        set uninstResource [tempDirGet]/installResource.tmp
        set uninstBackup [tempDirGet]/installBackup.tmp
        set uninstInfo [tempDirGet]/installInfo.tmp
    
        set setupVals(fSetupLog) [open $setupLog "w"]
        set setupVals(fInstallFile) [open $uninstFile "w"]
        set setupVals(fInstallInfo) [open $uninstInfo "w"]
        set setupVals(fInstallBackup) [open $uninstBackup "w"]
        set setupVals(fInstallResource) [open $uninstResource "w"]
        
        set setupVals(uninstFileOpen) opened
    }
}

##############################################################################
#
# uninstBinCopy - copies uninstall agent
#
# This procedure copies neccessary files from CDROM to the destination 
# directory for the uninstall program to work.  No-op if patch installation
# is detected.
#
# SYNOPSIS
# uninstBinCopy
#
# PARAMETERS:  N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc uninstBinCopy {} {
    global setupVals

    if {[instTypeGet] == "patch"} {
        return

    } elseif {[windHostTypeGet] == "x86-win32"} {
        set winDir [setupWinDirGet]
        set cdBinDir [cdromRootDirGet]\\X86\\WIN32
        set usrBinDir [destDirGet]\\host\\[windHostTypeGet]\\bin
        
        fileDup $cdBinDir\\ZIP.EXE $usrBinDir\\ZIP.EXE update
        fileDup $cdBinDir\\MFC42.DLL $usrBinDir\\MFC42.DLL
        fileDup $cdBinDir\\MSVCRT.DLL $usrBinDir\\MSVCRT.DLL
        fileDup $cdBinDir\\PCTREE32.DLL $usrBinDir\\PCTREE32.DLL
        fileDup $cdBinDir\\TCL.DLL $usrBinDir\\TCL.DLL
        fileDup $cdBinDir\\UITCL.DLL $usrBinDir\\UITCL.DLL
        fileDup $cdBinDir\\UITCLSH.EXE $usrBinDir\\UITCLSH.EXE
        fileDup $cdBinDir\\SETUPTCL.DLL $usrBinDir\\SETUPTCL.DLL update
        fileDup [cdromRootDirGet]\\RESOURCE\\BITMAPS\\UNINST.BMP \
                [uninstHomeDirGet]\\UNINST.BMP update
        fileDup [cdromRootDirGet]\\RESOURCE\\TCL\\UNINST.TCL \
                [uninstHomeDirGet]\\UNINST.TCL update
    } {
        set usrBinDir [destDirGet]/host/[windHostTypeGet]/bin

        fileDup [cdromRootDirGet]/RESOURCE/TCL/UNINST.TCL \
                [uninstHomeDirGet]/UNINST.TCL update

        fileDup [cdromRootDirGet]/RESOURCE/TCL/LIB/TKLIB.TAR \
                [uninstHomeDirGet]/TKLIB.TAR update

        fileDup [cdromRootDirGet]/RESOURCE/BITMAPS/UNINST.PPM \
                [uninstHomeDirGet]/UNINST.PPM update
    
        fileDup [cdromBinDirGet]/INSTTCL2 $usrBinDir/INSTTCL2 update
        fileDup [cdromBinDirGet]/INSTTK2 $usrBinDir/INSTTK2 update
        fileDup [cdromRootDirGet]/UNINST $usrBinDir/UNINST update
        fileDup [cdromBinDirGet]/ZIP $usrBinDir/ZIP update
        fileDup [cdromBinDirGet]/SETUPTCL[string toupper \
                                           [info sharedlibextension]] \
		$usrBinDir/setuptcl[info sharedlibextension] update
    }
}

##############################################################################
#