install.tcl

genesis 2000 v9.1软件下载

 switch -- $VPIG(SOURCE) {
   CDROM { vpi.show_f_action_cdrom $W }
   FTP   { vpi.show_f_action_ftp   $W }
   DAT   { vpi.show_f_action_dat   $W }
   DISK  { vpi.show_f_action_disk  $W }
   default { bgerror "Switch error install.tcl (4)"}
 }
}

#................................................................#
proc vpi.show_f_action_cdrom {W} {
  global VPIG 
  set WF $W.f_buttons
  frame $WF -bg $VPIG(C_BG)
  pack $WF -fill x

  button $WF.info  -text "信息..." -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command vpi.info_cb
  button $WF.install       -text "开始安装" -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command [list vpi.install_cb $WF.install]
  pack $WF.info $WF.install -side left -expand 1
}

#................................................................#
proc vpi.show_f_action_ftp {W} {
  global VPIG 
  set WF $W.f_buttons
  frame $WF -bg $VPIG(C_BG)
  pack $WF -fill x

  button $WF.info  -text "Info..." -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command vpi.info_cb
  button $WF.retrieve      -text "Retrieve" -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command [list vpi.retrieve_cb]
  pack $WF.info $WF.retrieve -side left -expand 1
}

#................................................................#
proc vpi.show_f_action_dat {W} {
  global VPIG 
  set WF $W.f_buttons
  frame $WF -bg $VPIG(C_BG)
  pack $WF -fill x

  button $WF.info  -text "Info..." -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command vpi.info_cb
  button $WF.retrieve      -text "Retrieve" -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command [list vpi.retrieve_cb]
  pack $WF.info $WF.retrieve -side left -expand 1
}

#................................................................#
proc vpi.show_f_action_disk {W} {
  global VPIG
  set WF $W.f_buttons
  frame $WF -bg $VPIG(C_BG)
  pack $WF -fill x

  button $WF.info  -text "Info" -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command vpi.info_cb
  button $WF.install -text "开始安装" -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command [list vpi.install_cb $WF.install]
  pack $WF.info $WF.install -side left -expand 1
}


##################################################################
proc vpi.info_cb {} {
  global VPIG 

  
   switch -- $VPIG(SOURCE) {
     CDROM { vpi.show_info_cdrom }
     FTP   { vpi.show_info_ftp }
     DAT   { vpi.show_info_dat }       
     DISK  { vpi.show_info_disk }
     default { bgerror "Switch error install.tcl (5)"}
   }
}

#................................................................#
proc vpi.show_info_ftp {} {
  global VPIG 
     
  set SOURCE [vpi.get_ftp_source_dir]
  if { $SOURCE == "" } return
  set TYPE   $VPIG(PRODUCTS_OR_BEANS) 
  set NAME   $VPIG(NAME)
  set VER    $VPIG(NAME_VERSION)
  set OS     $VPIG(NAME_OS)
  set FNAME  $VPIG(NAME).doc

  set DOC_PATH "$SOURCE/$TYPE/$NAME/$VER/$OS/$VPIG(NAME).doc"
  set DEST_PATH [tclu_get_tmp_name $NAME.doc]
  
  set STATUS [vpi.ftp_command DUMMY get $DOC_PATH 0 $DEST_PATH]
  if {$STATUS != 0} {
     return
  }
  tku_popup_file $DEST_PATH start
  tclu_del_tmp_files
  
}

#................................................................#
proc vpi.show_info_cdrom {} {
  global VPIG 
  
  set DOC_PATH \
      [file join [vpi.get_dir] \
	  $VPIG(NAME) $VPIG(NAME_VERSION) $VPIG(NAME_OS) $VPIG(NAME).doc]
  tku_popup_file $DOC_PATH start
}

#................................................................#
proc vpi.show_info_dat {} {

  global VPIG 
  
  set CHOICE [tku_popup_message question [list ok cancel] \
		  "The info operation from a DAT Device\
  	        \n might take up to 5 minutes. \
                \n Please confirm ..."]
  
  if { [string compare $CHOICE "cancel"] == 0 } {
    return 
  }
  
  set PROD $VPIG(NAME)
  set VER  $VPIG(NAME_VERSION)
  set OS   $VPIG(NAME_OS)
  set DAT_DEVICE $VPIG(DAT_DEVICE)
  if { [catch { cd [tclu_get_tmp_dir] } RESPONSE ] } {
    tku_popup_message ok error $RESPONSE
    return 
  }

  set INFO_FILE [file join $PROD $VER $OS $PROD.doc]
  set STOP_FILE [format "end_%s_%s_%s" $PROD $VER $OS]
  file delete -force $STOP_FILE
  set TAR $VPIG(TAR)
  set COMMAND "$TAR xf $DAT_DEVICE $INFO_FILE $STOP_FILE"
  set TITLE "Getting info file for $PROD/$VER/$OS"
  set STATUS [tku_long_command $COMMAND $TITLE $VPIG(WMESSAGE) ignore "" $STOP_FILE]		 
  
  if { $STATUS != "ok" } {
    return    
  }  

  set INFO_FILE [file join [tclu_get_tmp_dir] $INFO_FILE]
  if { [file exists $INFO_FILE] } {
    tku_popup_file $INFO_FILE start
    file delete -force [file join [tclu_get_tmp_dir] $PROD]
  } else {
    tku_popup_message warning ok "No info file was founf for $PROD $VER $OS"
  }
    
}

#................................................................#
proc vpi.show_info_disk {} {
  global VPIG 
     
  set DOC_PATH \
     [file join [vpi.get_dir] \
      $VPIG(NAME) $VPIG(NAME_VERSION) $VPIG(NAME_OS) $VPIG(NAME).doc]
     tku_popup_file $DOC_PATH start
}

##################################################################
proc vpi.retrieve_cb {} {
  global VPIG 

   switch -- $VPIG(SOURCE) {
     FTP   { set STATUS [vpi.retrieve_ftp] }
     DAT   { set STATUS [vpi.retrieve_dat] }
     default { bgerror "Switch error install.tcl (6)"}
   }
   tclu_del_tmp_files 
   if { $STATUS == 0 } {
      tku_popup_message info ok \
        "To install the retrieved product/bean,\
       \nplease switch the source to 'DISK' and\
       \nclick on 'Load Installation Plug-in'"
   }
}
#................................................................#

proc vpi.retrieve_ftp {} {
  global VPIG 

  set SOURCE [vpi.get_ftp_source_dir]
  if { $SOURCE == "" } {
     return 1
   }
  set TYPE      $VPIG(PRODUCTS_OR_BEANS) 
  set NAME      $VPIG(NAME)
  set VER       $VPIG(NAME_VERSION)
  set OS        $VPIG(NAME_OS)
  set FNAME     $VPIG(NAME).lst
  set SNAME     $VPIG(NAME).sum
  set DISK_PATH $VPIG(DISK_PATH)
  set TGZ_IS_OK 0
  set UP_TO_DATE 1
  set ERROR 0
     
  set STATUS [vpi.check_empty_disk_path $DISK_PATH]
  if { $STATUS != 0 } {
    return  1
  }
  if [tclu_mkdir $DISK_PATH 1] {
     return 1
  }

  set DISK_PATH [file join $DISK_PATH $TYPE]
  if [tclu_mkdir $DISK_PATH 1] {
     return 1
  }

  set DISK_PATH [file join $DISK_PATH $NAME]
  if [tclu_mkdir $DISK_PATH 1] {
     return 1
  }

  set DISK_PATH [file join $DISK_PATH $VER]
  if [tclu_mkdir $DISK_PATH 1] {
     return 1
  }
  set DISK_PATH [file join $DISK_PATH $OS]
  if [tclu_mkdir $DISK_PATH 1] {
     return 1
  }

  set TTL_PATH  "$SOURCE/$TYPE/$NAME/$NAME.ttl"
  set DEST_TTL  [file join $VPIG(DISK_PATH) $TYPE $NAME $NAME.ttl] 
    
  set STATUS [vpi.ftp_command DUMMY get $TTL_PATH 0 $DEST_TTL]
  if {$STATUS < 0} {
    return 1
  }
  # don't check error status, since the ttl file isn't essential
  # for proper installation
  
  set LST_PATH  "$SOURCE/$TYPE/$NAME/$VER/$OS"
  set DEST_PATH [tclu_get_tmp_name $NAME.lst]
  set DEST_SUM  [tclu_get_tmp_name $NAME.sum] 
  
  set STATUS [vpi.ftp_command DUMMY get "$LST_PATH/$SNAME" 0 $DEST_SUM]
  if {$STATUS != 0} {
    return 1
  }
  
  # here, we will see if the data file ("xxx.tgz") exists in the target
  # directory, and if it does, we'll see if its sum matches.
  if {! [catch {open $DEST_SUM r} TFP]} {
    gets $TFP LINE
    close $TFP
    scan $LINE "%s%s%s" FILE_NAME TGZ_SIZE TGZ_SUM 
    set TGZ_FILE [file join $DISK_PATH $FILE_NAME]
    if { [file exists $TGZ_FILE] } {
      set CUR_SUM [tclu_get_checksum $TGZ_FILE]
      set CUR_SIZE [file size $TGZ_FILE]
      if {($CUR_SUM == $TGZ_SUM) && ($CUR_SIZE == $TGZ_SIZE)} {
	set TGZ_IS_OK 1 
      }
    }
  }
  #
  #  Retrieve the .lst file for comparing all current files
  #
  set STATUS [vpi.ftp_command DUMMY get "$LST_PATH/$FNAME" 0 $DEST_PATH]
  if {$STATUS != 0} {
     return 1
  }
  if {! $TGZ_IS_OK} {
    set IGNORE_FILES ""
  } else {
    set IGNORE_FILES "$NAME.tgz.p*"
  }
  set LST_STATUS [tclu_check_lst_file $DISK_PATH $DEST_PATH \
                  $IGNORE_FILES LST_RESULT]
  set FILE_COUNT 0     
  set TPATH [tclu_get_tmp_name "ftp_list"]
  if {[catch {open $TPATH w} FP]} {
    tku_popup_message error ok [format "Cannot open file\n%s" $TPATH]
    return 1
  }
  set NEED_COPY_ANYTHING 0
  puts $FP "               Files On FTP Versus Local Files:\n" 
  puts $FP \
    "File Name-----------Name Match---File Size---Sum Match---Should Copy\n" 
  foreach {FILE_NAME NMATCH FILE_SIZE SUMATCH FILE_SUM COPYF} $LST_RESULT {
    set CUR_CHECK_FILE [file join $DISK_PATH $FILE_NAME]
    set FILE_NAMES($FILE_COUNT) $FILE_NAME
    set FILE_SIZES($FILE_COUNT) $FILE_SIZE
    if { [string compare $COPYF  "yes" ] == 0 } {
      set FILE_COPY($FILE_COUNT) 1
      set NEED_COPY_ANYTHING 1
    } else {
      set FILE_COPY($FILE_COUNT) 0
    }
    set FILE_SUMS($FILE_COUNT)  $FILE_SUM
    
    set OLINE [format "%-20s    %s           %-10d %s           %s" \
		   $FILE_NAME $NMATCH $FILE_SIZE $SUMATCH $COPYF]  
    puts $FP $OLINE 
    incr FILE_COUNT
    if { [string match "*.tgz.p*" $FILE_NAME] } {
      lappend FILES_TO_APPEND [file join $DISK_PATH $FILE_NAME]
    }
  }
  close $FP
  incr FILE_COUNT 
  if { $NEED_COPY_ANYTHING } {
    set CHOICE [tku_popup_message question okcancel \
                "Some files need to be retrieved from FTP.\
  	       \nPlease Check and Confirm:" $TPATH]
    if { [string compare $CHOICE "cancel"] == 0 } {
      tku_popup_message warning ok "Retrieve was stopped by user"
      return  1
    }
  }

  set TPATH [tclu_get_tmp_name "ftp_result_list"]
  if {[catch {open $TPATH w} FP]} {
    tku_popup_message error ok [format "Cannot open file\n%s" $TPATH]
    return 1
  }
  
  set PARTS_RETRIEVED_OK 1
  puts $FP "File Name                 Size               Status\n"
  for {set IND 0} {$IND < $FILE_COUNT-1} {incr IND} {
    if { $LST_STATUS == 0 } break
    if {$FILE_COPY($IND) == 0} continue
    set DEST_PATH [file join $DISK_PATH $FILE_NAMES($IND)]
    set SOURCE_PATH "$LST_PATH/$FILE_NAMES($IND)"
    set STATUS [vpi.ftp_command NAME_LIST get $SOURCE_PATH \
                $FILE_SIZES($IND) $DEST_PATH]
    if {$STATUS < 0} {
      return 1
    }
    set UP_TO_DATE 0
    if { $STATUS != 0 } {
      set OLINE [format "%-20s     Failed to Retrieve" $FILE_NAMES($IND)] 
      set PARTS_RETRIEVED_OK 0
    } else {
      set CUR_SUM [tclu_get_checksum $DEST_PATH]
      if {[string compare $CUR_SUM $FILE_SUMS($IND)] == 0} {
	set OLINE [format "%-20s     %-10d        Retrieved OK" \
		       $FILE_NAMES($IND) $FILE_SIZES($IND)]
	
      } else {
	set OLINE [format "%-20s     %-10d        Checksum Does not match" \
		       $FILE_NAMES($IND) $FILE_SIZES($IND)]
        set PARTS_RETRIEVED_OK 0
      }
    }
    puts $FP $OLINE
  }
  if { ! $PARTS_RETRIEVED_OK } {
    close $FP
    set CHOICE [tku_popup_message error ok \
                "Rerieval errors:" $TPATH] 
    return 1
  } else {
     close $FP
     catch { file delete $TPATH }
  }
  if {! $TGZ_IS_OK} {
    # should take cat from tools directory 
    set APPEND_FILES [file join $DISK_PATH $NAME.tgz.p*]
    set ACT_FILES [lsort $FILES_TO_APPEND]
    set CAT $VPIG(CAT)
    set COMMAND [format "%s %s | %s bs=1000000 of=%s" \
		     $CAT \
		     $ACT_FILES \
		     $VPIG(DD)  \
		     $TGZ_FILE]
    set TITLE "Appending retrieved files ..."
    set STATUS [tku_long_command $COMMAND $TITLE $VPIG(WMESSAGE) \
	 	    ignore ""]
    if { $STATUS != "ok" } {
      tku_popup_message error ok \
         [format "%s/n%s"                     \
         "Failed to append retrieved files."  \
	 "Check log file for errors"]
      return  1
    }
    set UP_TO_DATE 0
  
    set SIZE [file size $TGZ_FILE]
    set SUM  [tclu_get_checksum $TGZ_FILE]
  
    if { ($SIZE == $TGZ_SIZE) && ($SUM == $TGZ_SUM) } {
      set TGZ_IS_OK 1
    }
  }
    
  if {$TGZ_IS_OK} {
    set P_WILD [file join $DISK_PATH $NAME.tgz.p*]
    set P_PATHS [glob -nocomplain $P_WILD]
    foreach P_PATH $P_PATHS {
       catch { file delete $P_PATH } 
    }
  }
  switch -- $TYPE {
     products { set TYPE_NAME Product } 
     beans    { set TYPE_NAME Bean } 
  }
  if { $UP_TO_DATE } {
    tku_popup_message info ok \
      [format "%s %s/%s/%s\nis up to date" \
       $TYPE_NAME $NAME $VER $OS]
  } else {
    tku_popup_message info ok \
      [format "%s %s/%s/%s\nwas retrieved successfully"\
       $TYPE_NAME $NAME $VER $OS]
  }
  return 0
}


#................................................................#
proc vpi.retrieve_dat {} {
  global VPIG
  
  set PROD $VPIG(NAME)
  set VER  $VPIG(NAME_VERSION)
  set OS   $VPIG(NAME_OS)
  set PATH $VPIG(DISK_PATH)
  set TYPE $VPIG(PRODUCTS_OR_BEANS)

  if { [string compare $TYPE "products"] == 0 } {
    set PRINT_TYPE "product"
  } else {
    set PRINT_TYPE "bean"
  }

  set STATUS [vpi.check_empty_disk_path $PATH]
  if { $STATUS != 0 } {
    return  1
  }
  
  if { ! [tclu_is_path_dir $PATH] } {
    if [tclu_mkdir $PATH 1] {
      tku_popup_message error ok "Can't create $PATH, Please check"    
      return 1
    }
  }

  set PATH [file join $PATH $TYPE]
  if [tclu_mkdir $PATH 1] {
    tku_popup_message error ok "Can't create $PATH, Please check"    
    return 1
  }

  
  
  set STOP_NAME [format "end_%s_%s_%s" $PROD $VER $OS] 
  cd $PATH
  set DAT_DEVICE $VPIG(DAT_DEVICE)
  set TAR $VPIG(TAR)
  set COMMAND "$TAR xf $DAT_DEVICE $PROD/$PROD.ttl $PROD/$VER/$OS $STOP_NAME"
  set TITLE "Extracting $PROD from DAT..."
  set STOP_FILE [file join $PATH $STOP_NAME]
  set STATUS [tku_long_command $COMMAND \
		  $TITLE   \
		  $VPIG(WMESSAGE)  \
		  abort \
		  "" \
		  $STOP_FILE]		 
  
  if { $STATUS != "ok" } {
    tku_popup_message error ok "Error retrieving $PROD from DAT"    
    return 1   
  }
  
  if { [file exists [file join $PATH $PROD]] } {
    set CHECK_PATH [file join $PATH $PROD $VER $OS]
    set LST_PATH [file join $CHECK_PATH $PROD.lst]
    set LST_STATUS [tclu_check_lst_file $CHECK_PATH $LST_PATH "*.lst" LST_RESULT 1]

    set TMP_PATH [tclu_get_tmp_name "check_list"]
    if {[catch {open $TMP_PATH w} FP]} {
      tku_popup_message error ok [format "Cannot open file\n%s" $TMP_PATH]
      return 1
    }
    
    set LINE "$PROD Version $VER for $OS check results:"
    puts $FP $LINE
    puts $FP "()underline                                              \n"
    switch -- $LST_STATUS {
      0  {
	tku_popup_message info ok \
	    [format "%s %s/%s/%s\nwas retrieved and checked successfully"\