plugins.tcl

Linux下的MSN聊天程序源码

		::plugins::save_config
		return 1
	}


	###############################################################
	# CheckRequirements (required_version)
	#
	# Checks if we satisfy requirements of the plugin (only version now)
	#
	# Arguments
	# required_version - Version of aMSN needed to run the plugin
	#
	# Return
	# 0 - We don't satisfy them
	# 1 - We satisfy them, we can load the plugin.
	#
	proc CheckRequirements { required_version } {
		global version
		plugins_log core "Plugin needs $required_version"
		scan $required_version "%d.%d" r1 r2;
		scan $version "%d.%d" y1 y2;
		if { $r1 > $y1 } {
			return 0
		} elseif { $r2 > $y2 } {
			return 0
		}
		return 1
	}


	###############################################################
	# save_config ()
	#
	# Saves the configuration of loaded plugins and ::plugins::config
	# in plugins.xml.
	#
	# Arguments
	# none
	#
	# Return
	# none
	#
	proc save_config { } {
		global tcl_platform HOME HOME2 version 
		variable loadedplugins

		plugins_log core "save_config: saving plugin config for user [::config::getKey login] in $HOME]\n"
	
		if { [catch {
			if {$tcl_platform(platform) == "unix"} {
				set file_id [open "[file join ${HOME} plugins.xml]" w 00600]
			} else {
				set file_id [open "[file join ${HOME} plugins.xml]" w]
			}
		} res]} {
			return 0
		}

		plugins_log core "save_config: saving plugin config_file. Opening of file returned : $res\n"

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

		#save the loaded plugins
		foreach {plugin} $loadedplugins {
			set namespace [getInfo $plugin plugin_namespace]
			puts $file_id "\t<plugin>"
			puts $file_id "\t\t<name>${plugin}</name>"
			puts $file_id "\t\t<loaded>true</loaded>"
			if {[array exists ::${namespace}::config]==1} {
				plugins_log core "save_config: Saving from $plugin's namespace: $namespace\n"
				foreach var_attribute [array names ::${namespace}::config] {
					#TODO: a better way to do this
					#set var_value $::${namespace}::config(${var_attribute})
					set var_value ::${namespace}::config
					set var_value [lindex [array get $var_value $var_attribute] 1]
					set var_value [::sxml::xmlreplace $var_value]
					puts $file_id "\t\t<entry>"
					puts $file_id "\t\t\t<key>$var_attribute</key>"
					puts $file_id "\t\t\t<value>$var_value</value>"
					puts $file_id "\t\t</entry>"
				}
			}
			puts $file_id "\t</plugin>"
		}
		
		#save the other plugins
		foreach {plugin} [array names ::plugins::config] {
			puts $file_id "\t<plugin>"
			puts $file_id "\t\t<name>${plugin}</name>"
			puts $file_id "\t\t<loaded>false</loaded>"
			foreach {var_attribute var_value} $plugins::config($plugin) {
				set var_value [::sxml::xmlreplace $var_value]
				puts $file_id "\t\t<entry>\n"
				puts $file_id "\t\t\t<key>$var_attribute</key>\n"
				puts $file_id "\t\t\t<value>$var_value</value>\n"
				puts $file_id "\t\t</entry>"
			}
			puts $file_id "\t</plugin>"
			
		}

		puts $file_id "</config>"
		close $file_id

		plugins_log core "save_config: Plugins config saved\n"
	}


	###############################################################
	# load_config ()
	#
	# Loads the configuration of plugins stored in plugin.xml
	#
	# Arguments
	# none
	#
	# Return
	# none
	#
	proc load_config {} {
		global HOME password protocol tcl_platform
		variable loadedplugins
		foreach {plugin} $loadedplugins {
			::plugins::UnLoadPlugin $plugin
		}
		set loadedplugins [list]

		if { [file exists [file join ${HOME} "plugins.xml"]] } {
			plugins_log core "load_config: loading file [file join ${HOME} plugins.xml]\n"
			if { [catch {
				set file_id [::sxml::init [file join ${HOME} "plugins.xml"]]
				::sxml::register_routine $file_id "config:plugin:name" "::plugins::new_plugin_config"
				::sxml::register_routine $file_id "config:plugin:loaded" "::plugins::new_plugin_loaded"
				::sxml::register_routine $file_id "config:plugin:entry" "::plugins::new_plugin_entry_config"
				::sxml::parse $file_id
				::sxml::end $file_id
				plugins_log core "load_config: Config loaded\n"
			} res] } {
				::amsn::errorMsg "[trans corruptconfig [file join ${HOME} "plugins.xml.old"]]"
				file copy [file join ${HOME} "plugins.xml"] [file join ${HOME} "plugins.xml.old"]
			}
		} else {
			status_log "Plugins System: load_config: No plugins.xml]\n" red
		}
	}


	###############################################################
	# new_plugin_config (cstack, cdata, saved_data, cattr saved_attr, args)
	#
	# Raises the information parsed by the sxml component and appends
	# each new plugin from plugin.xml to config
	#
	# Arguments
	# supplied by the sxml component (its only executor)
	#
	# Return
	# none
	#
	proc new_plugin_config {cstack cdata saved_data cattr saved_attr args} {
		variable cur_plugin
		set cur_plugin $cdata
		set ::plugins::config(${cur_plugin}) [list]
		return 0
	}


	###############################################################
	# new_plugin_loaded (cstack, cdata, saved_data, cattr saved_attr, args)
	#
	# Raises the information parsed by the sxml component and appends
	# each new plugin from plugin.xml that was loaded before to
	# $::plugins::loadedplugins
	#
	# Arguments
	# supplied by the sxml component (its only executor)
	#
	# Return
	# none
	#
	proc new_plugin_loaded {cstack cdata saved_data cattr saved_attr args} {
		variable cur_plugin
		variable loadedplugins
		set yes $cdata
		plugins_log core "$cur_plugin has a loaded tag with $yes in it...\n"
		if {$yes == "true"} {
			if {[lsearch $loadedplugins $cur_plugin] == -1 } {
				lappend loadedplugins $cur_plugin
			}
		}
		return 0
	}


	###############################################################
	# new_plugin_entry_config (cstack, cdata, saved_data, cattr saved_attr, args)
	#
	# Raises the information parsed by the sxml component and sets
	# an array in global namespace with the configuration of the plugin.
	#
	# Arguments
	# supplied by the sxml component (its only executor)
	#
	# Return
	# none
	#
	proc new_plugin_entry_config {cstack cdata saved_data cattr saved_attr args} {
		variable cur_plugin
		upvar $saved_data sdata
		lappend ::plugins::config(${cur_plugin}) $sdata(${cstack}:key) $sdata(${cstack}:value);
		return 0
	}


	###############################################################
	# LoadInfoAutoupdate (plugin)
	#
	# Load the XML information of a plugin for autoupdate
	#
	# Arguments
	# The name of the plugin
	#
	# Return
	# 0 if an error occured, 1 else
	#
	proc LoadInfoAutoupdate { plugin } {

		variable plugins
		variable cur_plugin $plugin

		set plugins(${plugin}_lang) ""
		set plugins(${plugin}_file) ""

		set fd [file join [getInfo $plugin plugin_dir] plugininfo.xml]

		if { [file readable $fd] } {
			
			if { [catch {
				set plugin_info [sxml::init $fd]
				sxml::register_routine $plugin_info "plugin" "::plugins::XMLInfoCVS"
				sxml::register_routine $plugin_info "plugin:lang" "::plugins::XMLInfoLang"
				sxml::register_routine $plugin_info "plugin:file" "::plugins::XMLInfoFile"
				sxml::register_routine $plugin_info "plugin:URL" "::plugins::XMLInfoURLplugininfo"
				sxml::parse $plugin_info
				sxml::end $plugin_info
				plugins_log core "PLUGINS INFO READ\n"
			} res] } {
				msg_box "ERROR: PLUGIN $plugin HAS MALFORMED XML PLUGININFO for autoupdate"
				return 0
			}
		}

		return 1

	}


	###############################################################
	# XMLInfoCVS (cstack, cdata, saved_data, cattr saved_attr, args)
	# XMLInfoLang (cstack, cdata, saved_data, cattr saved_attr, args)
	# XMLInfoFile (cstack, cdata, saved_data, cattr saved_attr, args)
	# XMLInfoURL (cstack, cdata, saved_data, cattr saved_attr, args)
	#
	# Raises the information parsed by the sxml component and appends
	# each new plugin to $::plugins::plugins array
	#
	# Arguments
	# supplied by the sxml component (its only executor)
	#
	# Return
	# none
	#
	proc XMLInfoCVS { cstack cdata saved_data cattr saved_attr args } {

		upvar $saved_data sdata
		variable plugins
		variable cur_plugin

		if { ![info exists sdata(${cstack}:cvs_version)] } {
			set cvs_version ""
		} else {
			set cvs_version $sdata(${cstack}:cvs_version)
		}

		set plugins(${cur_plugin}_cvs_version) $cvs_version

		return 0

	}


	proc XMLInfoLang { cstack cdata saved_data cattr saved_attr args } {

		upvar $saved_data sdata
		variable plugins
		variable cur_plugin

		if { ![info exists sdata(${cstack}:langcode)] || ![info exists sdata(${cstack}:version)] } {
			set  langcode ""
			set version ""
		} else {
			set langcode $sdata(${cstack}:langcode)
			set version $sdata(${cstack}:version)
		}

		lappend plugins(${cur_plugin}_lang) [list $langcode $version]

		return 0

	}


	proc XMLInfoFile { cstack cdata saved_data cattr saved_attr args } {

		upvar $saved_data sdata
		variable plugins
		variable cur_plugin

		if { ![info exists sdata(${cstack}:path)] || ![info exists sdata(${cstack}:version)] } {
			set  path ""
			set version ""
		} else {
			set path $sdata(${cstack}:path)
			set version $sdata(${cstack}:version)
		}

		lappend plugins(${cur_plugin}_file) [list $path $version]

		return 0

	}
	
	
	proc XMLInfoURLplugininfo { cstack cdata saved_data cattr saved_attr args } {
	
		upvar $saved_data sdata
		variable plugins
		variable cur_plugin
		
		if { ![info exists sdata(${cstack}:plugininfo)] } {
			set URL_plugininfo ""
		} else {
			set URL_plugininfo $sdata(${cstack}:plugininfo)
		}

		set plugins(${cur_plugin}_URL_plugininfo) $URL_plugininfo

		return 0
		
	}


	###############################################################
	# LoadInfoAutoupdate_Online (plugin)
	#
	# Get the plugininfo.xml on the website, and load it
	#
	# Arguments
	# The name of the plugin
	#
	# Return
	# 0 if an error occured, 1 else
	#
	proc LoadInfoAutoupdate_Online { plugin } {

		global HOME HOME2
		variable plugins
		variable cur_plugin $plugin

		set plugins(${plugin}_lang_online) ""
		set plugins(${plugin}_file_online) ""
		
		set URL [getInfo $plugin URL_plugininfo]
		
		set program_dir [set ::program_dir]

		if { [catch {
			
			# If no URL is given, look at the CVS URL
			if { $URL == "" } {
				
				set token [::http::geturl "${::weburl}/autoupdater/plugins/$plugin/plugininfo.xml" -timeout 120000 -binary 1]
				set content [::http::data $token]
				::http::cleanup $token
				
				if { [string first "<html>" "$content"] == -1 } {
					set plugins(${plugin}_URL_place) 1
				} else {
					set token [::http::geturl "${::weburl}/autoupdater/plugins2/$plugin/plugininfo.xml" -timeout 120000 -binary 1]
					set content [::http::data $token]
					if { [string first "<html>" "$content"] == -1 } {
						set plugins(${plugin}_URL_place) 2
					} else {
						::http::cleanup $token
						return 0
					}
					
				}

				
				# Else, look at the URL given
			} else {
				
				set token [::http::geturl "$URL" -timeout 120000 -binary 1]
				set content [::http::data $token]
				if { [string first "<html>" "$content"] != -1 } {
					::http::cleanup $token
					return 0
				}
				set plugins(${plugin}_URL_place) 3
				
			}
			
			set status [::http::status $token]
			if { $status != "ok" } {
				status_log "Can't get plugininfo.xml for $plugin (place [getInfo $plugin URL_place] - URL $URL): $status (http token: $token)\n" red
				::http::cleanup $token
				return 0
			}
			
			set filename "[file join $HOME2 $plugin.xml]"
			set fid [open $filename w]
			fconfigure $fid -encoding binary
			puts -nonewline $fid "$content"
			close $fid
			::http::cleanup $token
		
			set id [::sxml::init $filename]
			sxml::register_routine $id "plugin" "::plugins::XMLInfoCVS_Online"
			sxml::register_routine $id "plugin:lang" "::plugins::XMLInfoLang_Online"
			sxml::register_routine $id "plugin:file" "::plugins::XMLInfoFile_Online"
			sxml::register_routine $id "plugin:URL" "::plugins::XMLInfoURL_Online"
			sxml::parse $id
			sxml::end $id
			
		} ] } {
			if {[info exists token] } {
				status_log "Can't get online plugininfo.xml for $plugin (place [getInfo $plugin URL_place] - URL $URL)(token: $token)\n" red
				::http::cleanup $token
			}
			return 0
			
		}
		
		return 1

	}


	###############################################################
	# XMLInfoCVS_Online (cstack, cdata, saved_data, cattr saved_attr, args)
	# XMLInfoLang_Online (cstack, cdata, saved_data, cattr saved_attr, args)
	# XMLInfoFile_Online (cstack, cdata, saved_data, cattr saved_attr, args)
	# XMLInfoURL_Online (cstack, cdata, saved_data, cattr saved_attr, args)
	#
	# Raises the information parsed by the sxml component and appends
	# each new plugin to $::plugins::plugins array
	#
	# Arguments
	# supplied by the sxml component (its only executor)
	#
	# Return
	# none
	#
	proc XMLInfoCVS_Online { cstack cdata saved_data cattr saved_attr args } {

		upvar $saved_data sdata
		variable plugins
		variable cur_plugin

		if { ![info exists sdata(${cstack}:amsn_version)] || ![info exists sdata(${cstack}:cvs_version)] } {
			set amsn_version ""
			set cvs_version ""
		} else {
			set amsn_version $sdata(${cstack}:amsn_version)
			set cvs_version $sdata(${cstack}:cvs_version)
		}

		set plugins(${cur_plugin}_amsn_version_online) $amsn_version
		set plugins(${cur_plugin}_cvs_version_online) $cvs_version

		return 0

	}


	proc XMLInfoLang_Online { cstack cdata saved_data cattr saved_attr args } {

		upvar $saved_data sdata
		variable plugins
		variable cur_plugin

		if { ![info exists sdata(${cstack}:langcode)] || ![info exists sdata(${cstack}:version)] } {
			set  langcode ""
			set version ""
		} else {
			set langcode $sdata(${cstack}:langcode)
			set version $sdata(${cstack}:version)
		}

		lappend plugins(${cur_plugin}_lang_online) [list $langcode $version]

		return 0

	}


	proc XMLInfoFile_Online { cstack cdata saved_data cattr saved_attr args } {

		upvar $saved_data sdata
		variable plugins
		variable cur_plugin

		if { ![info exists sdata(${cstack}:path)] || ![info exists sdata(${cstack}:version)] } {
			set  path ""
			set version ""
		} else {
			set path $sdata(${cstack}:path)
			set version $sdata(${cstack}:version)
		}

		lappend plugins(${cur_plugin}_file_online) [list $path $version]

		return 0

	}


	proc XMLInfoURL_Online { cstack cdata saved_data cattr saved_attr args } {

		upvar $saved_data sdata
		variable plugins
		variable cur_plugin
		
		if { ![info exists sdata(${cstack}:main)] } {
			set URL_main ""
		} else {
			set URL_main $sdata(${cstack}:main)
		}

		if { ![info exists sdata(${cstack}:plugininfo)] } {
			set URL_plugininfo ""
		} else {
			set URL_plugininfo $sdata(${cstack}:plugininfo)
		}

		if { ![info exists sdata(${cstack}:lang)] } {
			set URL_lang ""
		} else {
			set URL_lang $sdata(${cstack}:lang)
		}

		if { ![info exists sdata(${cstack}:file)] } {
			set URL_file ""
		} else {
			set URL_file $sdata(${cstack}:file)
		}


		set plugins(${cur_plugin}_URL_main_online) $URL_main