config.tcl

Linux下的MSN聊天程序源码

	}

	proc getGlobalKey {key {default ""}} {
		if { [info exists ::gconfig($key)] } {
			return [set ::gconfig($key)]
		} else {
			return $default
		}
	}

	proc getGlobalVar {key} {
		return "::gconfig($key)"
	}

	proc getGlobalKeys {} {
		return [array names ::gconfig]
	}

	proc getGlobalAll {} {
		return [array get ::gconfig]
	}

	proc setGlobalKey {key value} {
		set ::gconfig($key) $value
	}

	proc setGlobalAll {values} {
		array set ::gconfig $values
	}

	proc NewGConfigEntry  {cstack cdata saved_data cattr saved_attr args} {
		global gconfig
		upvar $saved_data sdata

		set gconfig($sdata(${cstack}:attribute)) $sdata(${cstack}:value)

		return 0

	}


	proc loadGlobal {} {
		global gconfig HOME2 HOME

		globalDefaults

		if { [info exists HOME2] } {
			set config_file [file join ${HOME2} "gconfig.xml"]
		} else {
			set config_file [file join ${HOME} "gconfig.xml"]
		}

		if { [file exists $config_file] } {

			if { [catch {
				set file_id [sxml::init $config_file]

				sxml::register_routine $file_id "config:entry" "::config::NewGConfigEntry"
				set val [sxml::parse $file_id]
				sxml::end $file_id
			} res] } {
				::amsn::errorMsg "[trans corruptconfig ${config_file}.old]"
				file copy "$config_file" "$config_file.old"
			}
		}
	}

	proc saveGlobal {} {
		global tcl_platform HOME2 version

		if { [catch {
				if {$tcl_platform(platform) == "unix"} {
					set file_id [open "[file join ${HOME2} gconfig.xml]" w 00600]
				} else {
					set file_id [open "[file join ${HOME2} gconfig.xml]" w]
				}
			} res]} {
			return 0
		}

		puts $file_id  "<?xml version=\"1.0\"?>\n\n<config>"
		::config::setGlobalKey last_client_version $version

		foreach var_attribute [getGlobalKeys] {
			set var_value [::config::getGlobalKey $var_attribute]
			#set var_value ::$gconfig($var_attribute)
			set var_value [::sxml::xmlreplace $var_value]
			puts $file_id "   <entry>\n      <attribute>$var_attribute</attribute>\n      <value>$var_value</value>\n   </entry>"
		}

		puts $file_id "</config>"

		close $file_id

	}

}

proc save_config {} {
	global tcl_platform HOME HOME2 version password custom_emotions
	
	#saving the plugins
	::plugins::save_config

	status_log "save_config: saving config for user [::config::getKey login] in $HOME]\n" black

	if { [catch {
		if {$tcl_platform(platform) == "unix"} {
			set file_id [open "[file join ${HOME} config.xml]" w 00600]
		} else {
			set file_id [open "[file join ${HOME} config.xml]" w]
		}
	} res]} {
		return 0
	}
	fconfigure $file_id -encoding utf-8

	status_log "save_config: saving config_file. Opening of file returned : $res\n"
	set loginback [::config::getKey login]
	set passback $password

	# using default, make sure to reset config(login)
	if { $HOME == $HOME2 } {
		::config::setKey login ""
		set password ""
	}

	#Start of config file
	puts $file_id  "<?xml version=\"1.0\"?>\n\n<config>"

	#Save all keys except special ones
	foreach var_attribute [::config::getKeys] {
		set var_value [::config::getKey $var_attribute]
		if { "$var_attribute" != "remotepassword" } {
			set var_value [::sxml::xmlreplace $var_value]
			puts $file_id "   <entry>\n      <attribute>$var_attribute</attribute>\n      <value>$var_value</value>\n   </entry>"
		}
	}

	#Save encripted password
	if { ([::config::getKey save_password]) && ($password != "")} {
		set key [string range "${loginback}dummykey" 0 7]
		binary scan [::des::encrypt $key "${password}\n"] h* encpass
		puts $file_id "   <entry>\n      <attribute>encpassword</attribute>\n      <value>$encpass</value>\n   </entry>"
	}

	#Save encripted remote password
	set key [string range "${loginback}dummykey" 0 7]
	binary scan [::des::encrypt $key "[::config::getKey remotepassword]\n"] h* encpass
	puts $file_id "   <entry>\n      <attribute>remotepassword</attribute>\n      <value>$encpass</value>\n   </entry>\n"

	#Save custom emoticons
	foreach name [array names custom_emotions] {
		puts $file_id "   <emoticon>"
		array set emotion $custom_emotions($name)
		foreach attribute [array names emotion] {
			set value [::sxml::xmlreplace $emotion($attribute)]
			set attribute [::sxml::xmlreplace $attribute]
			#set var_attribute [::sxml::xmlreplace [string map [list "${custom}_" ""] $attribute ]]
			#set var_value [::sxml::xmlreplace $emotions($attribute)]
			puts $file_id "      <$attribute>$value</$attribute>"
		}
		puts $file_id "   </emoticon>\n"
	}

	#End of config file
	puts $file_id "</config>"

	close $file_id

	::config::setKey login $loginback
	set password $passback

	status_log "save_config: Config saved\n" black


}

proc new_config_entry  {cstack cdata saved_data cattr saved_attr args} {
    upvar $saved_data sdata

    ::config::setKey $sdata(${cstack}:attribute) $sdata(${cstack}:value)

    return 0

}

proc load_config {} {
	global HOME password protocol tcl_platform

	#Create custom smileys folder
	create_dir "[file join ${HOME} smileys]"

	set user_login [::config::getKey login]
	status_log "load_config: Started. HOME=$HOME, config(login)=$user_login\n"

	#Set default values
	::config::configDefaults

	if { [file exists [file join ${HOME} "config.xml"]] } {

		status_log "load_config: loading file [file join ${HOME} config.xml]\n" blue

		if { [catch {
			set file_id [sxml::init [file join ${HOME} "config.xml"]]

			sxml::register_routine $file_id "config:entry" "new_config_entry"
			sxml::register_routine $file_id "config:emoticon" "::smiley::newCustomEmoticonXML"
			set val [sxml::parse $file_id]
			sxml::end $file_id
			status_log "load_config: Config loaded\n" green
			if { [winfo exists .smile_selector]} { destroy .smile_selector }

		} res] } {
			::amsn::errorMsg "[trans corruptconfig [file join ${HOME} "config.xml.old"]]"
			status_log "Error when parsing confog.xml : $res"
			file copy -force [file join ${HOME} "config.xml"] [file join ${HOME} "config.xml.old"]
			::sxml::end $file_id
			::config::configDefaults
			file delete [file join ${HOME} "config.xml"]
		}

		#Force the change of the default background color and other specific Mac things
		if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
			set bgcolormac [::config::getKey backgroundcolor]
			if { $bgcolormac=="#D8D8E0" } {
				::config::setKey backgroundcolor #ECECEC
			}
			#Force the change of new window to be raised, not iconified (not supported on TkAqua)
			::config::setKey newmsgwinstate 0
			#Force the change to not start amsn on tray if someone choosed that in advanced preferences
			::config::setKey startontray 0
			# Force the change of the default sound command
			# For Mac OS X users who used aMSN 0.95 at the beggining
			if {[::config::getKey soundcommand] == "./sndplay" } {
				::config::setKey soundcommand "./utils/macosx/sndplay \$sound"
			}
		}
	}
	#Force to change the path to the new path of plwav.exe
	if {$tcl_platform(platform) == "windows"} {
		if {[::config::getKey soundcommand] == "utils/plwav.exe \$sound"} {
			::config::setKey soundcommand "utils/windows/plwav.exe \$sound"
		}
	}
	#Sometimes, if there is a bugreport when opening a new window, the size of the window savez will be 1x1
	if {[::config::getKey winchatsize]=="1x1"} {
		::config::setKey winchatsize "350x320"
	}
	if {[::config::getKey wincontainersize]=="1x1"} {
		::config::setKey wincontainersize "350x320"
	}

	#Get the encripted password
	if {[::config::getKey encpassword]!=""} {
		set key [string range "[::config::getKey login]dummykey" 0 7]
		set password [::config::getKey encpassword]
		catch {set encpass [binary format h* [::config::getKey encpassword]]}
		catch {set password [::des::decrypt $key $encpass]}
		#puts "Password length is: [string first "\n" $password]\n"
		set password [string range $password 0 [expr { [string first "\n" $password] -1 }]]
		#puts "Password is: $password\nHi\n"
		::config::unsetKey encpassword
	}

	#Get the encrypted remote password
	if {[::config::getKey remotepassword]!=""} {
		set key [string range "[::config::getKey login]dummykey" 0 7]
		catch {set encpass [binary format h* [::config::getKey remotepassword]]}
		catch {::config::setKey remotepassword [::des::decrypt $key $encpass]}
		#puts "Password length is: [string first "\n" [::config::getKey remotepassword]]\n"
		::config::setKey remotepassword [string range [::config::getKey remotepassword] 0 [expr { [string first "\n" [::config::getKey remotepassword]] -1 }]]
		#puts "Password is: [::config::getKey remotepassword]\nHi\n"
	}

	::config::setKey clientid 0
	::config::setKey protocol 11
	::MSN::setClientCap msnc4
	::MSN::setClientCap inkgif
	::MSN::setClientCap multip

	# Load up the personal states
	LoadStateList
	if { [winfo exists .my_menu] } {CreateStatesMenu .my_menu}
	if { [::config::getKey login] == "" } {
		status_log "load_config: Empty login !!! FIXING\n" red
		::config::setKey login $user_login
	}

	if { [::config::getKey enableremote] } {
		init_remote_DS
	}

	#set the banner for this user when switching users
	global initialize_amsn
	if { $initialize_amsn != 1 } {
		resetBanner
	}

	#load Snack when being used
	if { [::config::getKey usesnack] } {
		if {![catch {package require snack}]} {
			snack::audio playLatency 750
		} else {
			::config::setKey usesnack 0
			save_config
			#msg_box [trans snackfailed]
		}
	}

	::plugins::LoadPlugins

	create_dir "[::config::getKey receiveddir]"
}


#///////////////////////////////////////////////////////////////////////////////
# LoadLoginList ()
# Loads the list of logins/profiles from the profiles file in the HOME dir
# sets up the first user in list as config(login)
proc LoadLoginList {{trigger 0}} {
	global HOME HOME2

	#puts stdout "called loadloginlist\n"
	status_log "LoadLoginList: starting\n" blue

	if { $trigger != 0 } {
		status_log "LoadLoginList: getting profiles\n" blue
	} else {
		set HOME2 $HOME
	}


	if {([file readable "[file join ${HOME} profiles]"] != 0) && ([file isfile "[file join ${HOME} profiles]"] != 0)} {
		set HOMEE $HOME
	} elseif {([file readable "[file join ${HOME2} profiles]"] != 0) && ([file isfile "[file join ${HOME2} profiles]"] != 0)} {
		set HOMEE $HOME2
	} else {
		return 1
	}

	status_log "LoadLoginList: HOME=$HOME, HOME2=$HOME2, HOMEE=$HOMEE\n" blue


	set file_id [open "[file join ${HOMEE} profiles]" r]
	gets $file_id tmp_data
	if {$tmp_data != "amsn_profiles_version 1"} {	;# config version not supported!
		#msg_box [trans wrongprofileversion $HOME]
		close $file_id

		set OLDHOME $HOME

		status_log "LoadLoginList: Recreating profiles file\n" blue

		if { [catch {set file_id [open "[file join ${HOMEE} profiles]" w]}]} {
			return -1
		}

		puts $file_id "amsn_profiles_version 1"
		#Recreate profiles file
		if { [catch {set folders [glob -directory ${HOMEE} -tails -types d *]}] } {
			return -1
		}
		foreach folder $folders {
			if {[file readable [file join ${HOMEE} $folder config.xml]]} {
				set HOME [file join $HOMEE $folder]
				load_config
				set login [::config::getKey login]
				if {$login != "" } {
					puts $file_id "$login 0"
				}
			}
		}