📄 install.tcl
字号:
$PRINT_TYPE $PROD $VER $OS]
return 0
}
-1 {
set LINE "Directory $CHECK_PATH does not exist."
puts $FP $LINE
set LINE "()error $PRINT_TYPE could not be installed properly\n"
puts $FP $LINE
}
-2 {
set LINE "File $PROD.lst was not found in $CHECK_PATH"
puts $FP $LINE
set LINE "()error $PRINT_TYPE could not be installed properly\n"
puts $FP $LINE
}
-3 {
set LINE "Failed to open $PROD.lst in $CHECK_PATH"
puts $FP $LINE
set LINE "()error $PRINT_TYPE could not be installed properly\n"
puts $FP $LINE
}
default {
foreach {FILE_NAME NMATCH FILE_SIZE SUMATCH FILE_SUM COPYF} $LST_RESULT {
if {[string compare $COPYF "no "] == 0} continue
if {[string compare $NMATCH "yes"] == 0} {
set LINE "checksum for file $FILE_NAME does not match"
puts $FP $LINE
} else {
set LINE "file $FILE_NAME does not exist"
puts $FP $LINE
}
}
set LINE "()error $PRINT_TYPE could not be installed properly\n"
puts $FP $LINE
}
}
close $FP
tku_popup_file $TMP_PATH start "-width 100"
file delete -force $TMP_PATH
return 1
} else {
set LINE1 "$PRINT_TYPE $PROD/$VER/$OS doesn't exist on DAT \n"
set LINE2 "Please use \"List\" Button to list available $TYPE"
tku_popup_message error ok [concat $LINE1 $LINE2]
return 1
}
}
##################################################################
proc vpi.check_empty_disk_path { PATH } {
set PATH [string trim $PATH]
if { [string length $PATH] == 0 } {
tku_popup_message error ok \
"Disk Path must contain a valid path\
\nto a new or existing directory into which \
\nthe products/beans will be retrieved."
return 1
}
return 0
}
##################################################################
proc vpi.install_cb { WB } {
global VPIG
switch -- $VPIG(INSTALL_STATE) {
{0} {
set VPIG(PRODUCT_PATH) \
[file join [vpi.get_dir] \
$VPIG(NAME) $VPIG(NAME_VERSION) $VPIG(NAME_OS)]
set INSTALL_PATH \
[file join $VPIG(PRODUCT_PATH) $VPIG(NAME).ins]
if { ! [tclu_is_path_file $INSTALL_PATH] } {
tku_popup_message error ok \
[format "No installation file:\n%s" $INSTALL_PATH]
return
}
pack forget $VPIG(WPLUGIN_EMPTY)
catch {destroy $VPIG(WPLUGIN_FRAME)}
frame $VPIG(WPLUGIN_FRAME) -bd 1 -bg [c_dblue]
pack $VPIG(WPLUGIN_FRAME) -expand 1 -side top -fill both
tclu_log_message "Loading Installation Plug-in"
tclu_log_message \
" $VPIG(NAME) / $VPIG(NAME_VERSION) / $VPIG(NAME_OS)"
##########################
vpi.source_plugin $INSTALL_PATH
##########################
$WB configure -text "重新安装"
set VPIG(INSTALL_STATE) 1
}
{1} {
destroy $VPIG(WPLUGIN_FRAME)
pack $VPIG(WPLUGIN_EMPTY) -fill both -expand 1
$WB configure -text "开始安装"
set VPIG(INSTALL_STATE) 0
tclu_log_message "Unloading Installation Plug-in"
. configure -cursor left_ptr
}
default { bgerror "Switch error install.tcl (7)"}
}
}
#................................................................#
proc vpi.source_plugin {INSTALL_PATH} {
global VPIG
source $INSTALL_PATH
}
##################################################################
proc vpi.show_f_control {W} {
global VPIG
set BFONT [tbr14]
button $W.b_help \
-highlightbackground [c_dblue] \
-text "帮助" \
-bg [c_aqua] -bd 1 -font $BFONT \
-command {vpi.cb_b_help}
button $W.b_showlog \
-text "日志记录" \
-highlightbackground [c_dblue] \
-bg [c_aqua] -bd 1 -font $BFONT \
-command {vpi.cb_b_showlog}
button $W.b_quit \
-text "退出" \
-highlightbackground [c_dblue] \
-bg [c_aqua] -bd 1 -font $BFONT \
-command {vpi.cb_b_quit}
pack $W.b_help \
$W.b_showlog \
$W.b_quit \
-side left -expand 1
}
#................................................................#
proc vpi.cb_b_help {} {
global VPIG
set PATH [file join $VPIG(INSTALL_PATH) install.hlp]
tku_popup_file $PATH start "-height 40"
}
#................................................................#
proc vpi.cb_b_showlog {} {
global VPIG
tku_popup_file $VPIG(LOG_PATH) end
}
#................................................................#
proc vpi.cb_b_quit {} {
global VPIG
set CHOICE yes
set CHOICE [tku_popup_message warning yesno "Really Quit ?"]
if { $CHOICE == "yes" } {
tclu_log_message "End Session." "underline"
vpi.save_user_defaults $VPIG(DEFAULTS_PATH)
destroy .
exit
}
}
################ PATH CREATION ROUTINES #######################
proc vpi.get_dir {} {
global VPIG
set DIR [string tolower [vpi.get_dir_type]]
switch -- $VPIG(SOURCE) {
CDROM { return [file join $VPIG(CDROM_PATH) $DIR] }
DISK { return [file join $VPIG(DISK_PATH) $DIR] }
default { bgerror "Switch error install.tcl (8)" }
}
}
proc vpi.get_dir_type {} {
global VPIG
switch -- $VPIG(SOURCE) {
CDROM { return $VPIG(PRODUCTS_OR_BEANS) }
FTP { return $VPIG(PRODUCTS_OR_BEANS) }
DAT { return "products" }
DISK { return $VPIG(PRODUCTS_OR_BEANS) }
default { bgerror "Switch error install.tcl (9)" }
}
}
################ POPUP LIST #########################
proc vpi.popup_list {UP_OPTIONS FIELD} {
global VPIG
global VPIG_WL
upvar $UP_OPTIONS OPTIONS
set VPIG_WL .w_popup_list
if { [array size OPTIONS] == 0 } {
tku_popup_message warning ok \
"No options are available"
return
}
if {[winfo exists $VPIG_WL]} {
destroy $VPIG_WL
}
toplevel $VPIG_WL
switch -- $FIELD {
0 {set WNAME "List of Names" ; set LWIDTH 100 }
1 {set WNAME "List of Versions" ; set LWIDTH 20 }
2 {set WNAME "List of Operating Systems" ; set LWIDTH 20 }
3 {set WNAME "FTP Servers" ; set LWIDTH 60 }
4 {set WNAME "DAT Devices" ; set LWIDTH 40 }
default { bgerror "Switch error install.tcl (11)" }
}
wm title $VPIG_WL "$WNAME"
set WFL $VPIG_WL.f_list
frame $WFL -bg [c_yellow]
scrollbar $WFL.sb -command "$WFL.list yview" -bg [c_yellow]
listbox $WFL.list -yscroll "$WFL.sb set" \
-width $LWIDTH -bg [c_yellow] -font [cbr14]
pack $WFL.sb -side right -fill y
pack $WFL.list -side left -expand 1 -fill both
bind $WFL.list <Double-1> [list vpi.cb_popup_list $FIELD 1 1]
set WFB $VPIG_WL.f_buttons
frame $WFB -bg [c_yellow]
button $WFB.ok -text OK -bg [c_aqua] \
-highlightbackground [c_dblue] \
-command [list vpi.cb_popup_list $FIELD 1 1]
button $WFB.apply -text Apply -bg [c_aqua]\
-highlightbackground [c_dblue] \
-command [list vpi.cb_popup_list $FIELD 1 0]
button $WFB.cancel -text Cancel -bg [c_aqua]\
-highlightbackground [c_dblue] \
-command [list vpi.cb_popup_list $FIELD 0 1]
pack $WFB.ok $WFB.apply $WFB.cancel -side left -expand true
for {set I 0} {$I < [array size OPTIONS] } {incr I} {
$WFL.list insert end $OPTIONS($I)
}
pack $WFL $WFB -fill x
tku_center_on_window . $VPIG_WL
wm deiconify $VPIG_WL
}
#................................................................#
proc vpi.cb_popup_list {FIELD SET CLOSE} {
global VPIG
set NO_SEL [catch {selection get} SEL]
if {$NO_SEL} {set SET 0}
if {$SET} {
set NAME [lindex $SEL 0]
switch -- $FIELD {
0 {set VPIG(NAME) $NAME}
1 {set VPIG(NAME_VERSION) $NAME}
2 {set VPIG(NAME_OS) $NAME}
3 {set VPIG(FTP_SERVER) $NAME}
4 {set VPIG(DAT_DEVICE) $NAME}
default { bgerror "Switch error install.tcl (12)" }
}
}
if {$CLOSE} {
wm withdraw .w_popup_list
}
}
proc vpi.get_ftp_source_dir {} {
global VPIG
set FTP_SERVER [string trim $VPIG(FTP_SERVER)]
set SOURCE ""
foreach {SERVER TITLE DIR} $VPIG(FTP_LOCATIONS) {
if { [string compare $FTP_SERVER $SERVER] == 0 } {
set SOURCE $DIR
break
}
}
if { $SOURCE == "" } {
set INDEX [string first "/" $FTP_SERVER]
if {$INDEX == -1} {
tku_popup_message error ok \
"Server must have the form of \
ftp.domain.com/directory\n"
return
} else {
set LEN [string length $FTP_SERVER]
incr LEN -1
set VPIG(FTP_SERVER) $FTP_SERVER
set SOURCE [string range $FTP_SERVER $INDEX $LEN]
}
}
return $SOURCE
}
##################################################################
#
# This procedure will perform an FTP command specified by ACTION.
# The command is always executed in background by executing the
# tcl script ftp.tcl.
#
# UP_RESPONSE - Will return the response from the ftp.tcl script.
# ACTION - list or get
# SOURCE_PATH - Directory to list or source file to get
# EXPECTED_SIZE - The size of the file to get. If non-zero, a progress
# in % will be displayed.
# DEST_PATH - Only for get command - the desitnation file to create
#
#
proc vpi.ftp_command \
{ UP_RESPONSE ACTION SOURCE_PATH {EXPECTED_SIZE 0} {DEST_PATH ""} } {
global VPIG
upvar $UP_RESPONSE RESPONSE
set MESSAGE "FTP: [string toupper $ACTION] $SOURCE_PATH"
set RESPONSE_PATH [tclu_get_tmp_name vpi_ftp_response]
set FTP_LOG_PATH [tclu_get_tmp_name vpi_ftp_log]
if { $EXPECTED_SIZE > 0 } {
set PROGRESS_PATH [tclu_get_tmp_name vpi_ftp_progress]
} else {
set PROGRESS_PATH ""
}
set INDEX [string first "/" $VPIG(FTP_SERVER)]
if {$INDEX != -1} {
incr INDEX -1
set REAL_SERVER [string range $VPIG(FTP_SERVER) 0 $INDEX]
} else {
set REAL_SERVER $VPIG(FTP_SERVER)
}
set COMMAND [format "%s %s %s %s %s %s %s %s %s %s %s" \
[info nameofexecutable] \
[file join $VPIG(INSTALL_PATH) ftp.tcl] \
$RESPONSE_PATH $FTP_LOG_PATH $REAL_SERVER $ACTION \
$SOURCE_PATH $DEST_PATH $EXPECTED_SIZE \
$PROGRESS_PATH $VPIG(OS) ]
set STATUS [tku_long_command $COMMAND \
$MESSAGE \
$VPIG(WMESSAGE) \
ignore $PROGRESS_PATH ""]
switch -- $STATUS {
"ok" {
if [catch {open $RESPONSE_PATH} FP] {
tku_popup_message error ok \
"FTP command failure.\
\nPlease press 'show log' for details."
catch {file delete $FTP_LOG_PATH}
return 1
} else {
gets $FP RESPONSE
close $FP
file delete $RESPONSE_PATH
if { $RESPONSE == "@ERROR@" } {
tku_popup_message error ok \
[format "%s operation failed for path:\n%s" \
$ACTION $SOURCE_PATH] $FTP_LOG_PATH
catch {file delete $FTP_LOG_PATH}
return 1
} else {
catch {file delete $FTP_LOG_PATH}
return 0
}
}
}
"cancel" {
catch {file delete $RESPONSE_PATH}
catch {file delete $FTP_LOG_PATH}
return -1
}
"error" {
catch {file delete $RESPONSE_PATH}
tku_popup_message error ok \
[format "%s operation failed for path:\n%s" \
$ACTION $SOURCE_PATH] $FTP_LOG_PATH
catch {file delete $FTP_LOG_PATH}
return 1
}
default { bgerror "Switch error install.tcl (13)" }
}
catch {file delete $FTP_LOG_PATH}
}
##################################################################
#
# This procedure fills the paths to useful UNIX commands in the
# global variable VPIG according to the operating system on which
# the script is running on.
#
# The commands are:
# cat
# chmod
# cp
# dd
# tar
#
proc vpi.set_unix_commands {} {
global VPIG
set COMMANDS [list CAT CHMOD CP DD TAR WHOAMI]
switch -- $VPIG(OS) {
aix {
set VPIG(CAT) "/bin/cat"
set VPIG(CHMOD) "/bin/chmod"
set VPIG(CP) "/bin/cp"
set VPIG(DD) "/bin/dd"
set VPIG(TAR) "/bin/tar"
set VPIG(WHOAMI) "/bin/whoami"
}
hp10 {
set VPIG(CAT) "/bin/cat"
set VPIG(CHMOD) "/bin/chmod"
set VPIG(CP) "/bin/cp"
set VPIG(DD) "/bin/dd"
set VPIG(TAR) "/bin/tar"
set VPIG(WHOAMI) "/bin/whoami"
}
nt {
set VPIG(CAT) [file join $VPIG(TOOLS_PATH) cat.exe]
set VPIG(CHMOD) [file join $VPIG(TOOLS_PATH) chmod.exe]
set VPIG(CP) [file join $VPIG(TOOLS_PATH) cp.exe]
set VPIG(DD) [file join $VPIG(TOOLS_PATH) dd.exe]
set VPIG(TAR) [file join $VPIG(TOOLS_PATH) tar.exe]
# No need on NT
set VPIG(WHOAMI) ""
}
solaris {
set VPIG(CAT) "/bin/cat"
set VPIG(CHMOD) "/bin/chmod"
set VPIG(CP) "/bin/cp"
set VPIG(DD) "/bin/dd"
set VPIG(TAR) "/bin/tar"
set VPIG(WHOAMI) "/usr/ucb/whoami"
}
linux {
set VPIG(CAT) "/bin/cat"
set VPIG(CHMOD) "/bin/chmod"
set VPIG(CP) "/bin/cp"
set VPIG(DD) "/bin/dd"
set VPIG(TAR) "/bin/tar"
set VPIG(WHOAMI) "/usr/bin/whoami"
}
default {
puts "Illegal operating system: $VPIG(OS)"
exit 1
}
}
foreach COMMAND $COMMANDS {
if { $VPIG($COMMAND) == "" } {
continue
}
if { ! [file exists $VPIG($COMMAND)] } {
puts "The command $VPIG($COMMAND) does not exist."
puts "Please remedy and rerun."
exit 1
}
if { ! [file executable $VPIG($COMMAND)] } {
puts "The command $VPIG($COMMAND) is not an executable file."
puts "Please remedy and rerun."
exit 1
}
}
tclu_set_commands \
$VPIG(CAT) $VPIG(CHMOD) $VPIG(CP) $VPIG(DD) $VPIG(TAR) $VPIG(WHOAMI)
}
################ PATH CREATION ROUTINES #######################
set VPIG(TOOLS_PATH) [lindex $argv 0]
set VPIG(INSTALL_PATH) [file join [pwd] install]
set VPIG(OS) [string tolower [file tail $VPIG(TOOLS_PATH)]]
#if { $VPIG(OS) == "nt" } {
# console show
#}
puts "Pro-Installer Version $VPIG(VERSION)"
source [file join $VPIG(INSTALL_PATH) tclu.tcl]
source [file join $VPIG(INSTALL_PATH) tku.tcl]
source [file join $VPIG(INSTALL_PATH) plugin.tcl]
vpi.main
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -