protocol.tcl

Linux下的MSN聊天程序源码

		::MSN::logout
		cmsn_draw_offline

	}


	proc connect { {passwd ""}} {

		#Cancel any pending reconnect
		after cancel ::MSN::connect


		if { [ns cget -stat] != "d" } {
			return
		}

		set username [::config::getKey login]

		if { $passwd == "" } {
			global password
			set passwd [set password]
		}

		ns configure -stat "d" -sock "" \
			-server [split [::config::getKey start_ns_server] ":"]

		#Setup the conection
		setup_connection ns
		#Call the pre authentication
		set proxy [ns cget -proxy]
		if { [$proxy authInit] < 0 } {
			return -1
		}

		cmsn_ns_connect $username $passwd

  	 }


	proc logout {} {

		::abook::lastSeen

		::log::eventlogout

		::MSN::WriteSBRaw ns "OUT\r\n";

		set proxy [ns cget -proxy]
		$proxy finish ns
		ns configure -stat "d"

		CloseSB ns

		global automessage

		ns configure -server [split [::config::getKey start_ns_server] ":"]

		setMyStatus FLN
		status_log "Loging out\n"

		if {[::config::getKey enablebanner] && [::config::getKey adverts]} {
			adv_pause
		}

		::groups::Disable

		StopPolling

		::abook::saveToDisk

		global list_BLP emailBList

		::MSN::clearList AL
		::MSN::clearList BL
		::MSN::clearList FL
		::MSN::clearList RL

		set list_BLP -1
		if { [info exists emailBList] } {
			unset emailBList
		}

		::abook::unsetConsistent

		#Try to update Preferences
		catch {InitPref 1}

		set automessage "-1"

		cmsn_draw_offline

		#an event to let the GUI know we are actually logged out now
		::Event::fireEvent loggedOut protocol

		#Set all CW users as offline
		foreach user_name [::abook::getAllContacts] {
			::abook::setVolatileData $user_name state "FLN"
		}

		foreach chat_id [::ChatWindow::getAllChatIds] {
			::ChatWindow::TopUpdate $chat_id
		}

		#Alert dock of status change
		#      send_dock "FLN"
		send_dock "STATUS" "FLN"
	}

	#TODO: delete when MSNP11 is used, REA is not used anymore
	#Callback procedure called when a REA (screen name change) message is received
	proc GotREAResponse { recv } {


		if { [string tolower [lindex $recv 3]] == [string tolower [::config::getKey login]] } {
			#This is our own nick change
			::abook::setPersonal MFN [urldecode [lindex $recv 4]]
			send_dock STATUS [::MSN::myStatusIs]
			cmsn_draw_online 1 1
			#an event used by guicontactlist to know when we changed our nick
			::Event::fireEvent myNickChange protocol
		} else {
			#This is another one nick change
			::abook::setContactData [lindex $recv 3] nick [urldecode [lindex $recv 4]]
			#an event used by guicontactlist to know when a contact changed nick
			::Event::fireEvent contactNickChange protocol [lindex $recv 3]
		}

	}

	#Callback procedure called when a UUX (PSM change) message is received
	proc GotUUXResponse { recv } {

		cmsn_draw_online 1 1
		#an event used by guicontactlist to know when we changed our nick
		::Event::fireEvent myNickChange protocol

	}

	#Callback procedure called when a ADC message is received
	proc GotADCResponse { recv } {
		set username ""
		set nickname ""
		set contactguid ""
		set curr_list ""
		set groups "0"
		#We skip ADC TrID
		foreach information [lrange $recv 2 end] {
			set key [string toupper [string range $information 0 1]]
			if { $key == "N=" } {
				set username [string range $information 2 end]
			} elseif { $key == "F=" } {
				set nickname [urldecode [string range $information 2 end]]
			} elseif { $key == "C=" } {
				set contactguid [string range $information 2 end]
			} elseif { $curr_list == "" } {
				#We didn't get the list names yet
				set curr_list $information
			} elseif { $groups == "0" } {
				#We didn't get the group list yet
				set groups $information
			}
		}
		if { $curr_list == "RL" && [lsearch [::abook::getLists $username] "PL"] == -1 && [lsearch [::abook::getLists $username] "AL"] == -1 && [lsearch [::abook::getLists $username] "BL"] == -1 } {
			newcontact $username $nickname
		} elseif { $curr_list == "RL" && ( [lsearch [::abook::getLists $username] "AL"] != -1 || [lsearch [::abook::getLists $username] "BL"] != -1 ) } {
			#Contact already in Allow List or Block List, so the notification window is useless, just silently remove from the PL:
			::MSN::WriteSB ns "REM" "PL $username"
		}
		if { $curr_list == "FL" } {
			status_log "Addition to FL"
			if { $username == "" } {
				#The server doesn't give the username so it gives the GUID
				set username [::abook::getContactForGuid $contactguid]
			} else {
				#It's a new contact so we save its guid and its nick
				::abook::setContactData $username contactguid $contactguid
				::abook::setContactForGuid $contactguid $username
				::abook::setContactData $username nick $nickname
			}
			status_log "$username was in groups [::abook::getGroups $username]"
			if {[::abook::getGroups $username] != "" && $groups == 0} {
				status_log "do nothing since a contact can't be in no group AND in a group"
			} else {
				::abook::addContactToGroup $username $groups
			}
			status_log "$username is in groups [::abook::getGroups $username]"
		}
		::abook::addContactToList $username $curr_list
		::MSN::addToList $curr_list $username

		::MSN::contactListChanged

		cmsn_draw_online 1 2

		set contactlist_loaded 1
		::abook::setConsistent
		::abook::saveToDisk
		
	}

	proc GotREMResponse { recv } {
		set list_sort [string toupper [lindex $recv 2]]

		if { [lindex $recv 2] == "FL" } {
			set userguid [lindex $recv 3]
			set user [::abook::getContactForGuid $userguid]
			if { [lindex $recv 4] == "" } {
				#Remove from all groups!!
				foreach group [::abook::getGroups $user] {
					::abook::removeContactFromGroup $user $group
				}
			} else {
				#Remove fromonly one group
				::abook::removeContactFromGroup $user [lindex $recv 4]
			}
	
			if { [llength [::abook::getGroups $user]] == 0 } {
				status_log "cmsn_listdel: Contact [lindex $recv 4] is in no groups, removing!!\n" blue
				::MSN::deleteFromList FL $user
				::abook::removeContactFromList $user FL
				#The GUID is invalid if the contact is removed from the FL list
				::abook::setContactForGuid $userguid ""
				::abook::setContactData $user contactguid ""
			}
		} else {
			set user [lindex $recv 3]
			::MSN::deleteFromList $list_sort $user
			::abook::removeContactFromList $user $list_sort
		}
	
	
		cmsn_draw_online 1 2
		global contactlist_loaded
		set contactlist_loaded 1
	}

	#Handler when we're setting our nick, so we check if the nick is allowed or not
	proc badNickCheck { userlogin newname recv } {

		switch [lindex $recv 0] {
			PRP {
				ns handlePRPResponse $recv
			}
			REA {
				GotREAResponse $recv
			}
			209 {
				#Try again urlencoding any character
				status_log "Nick $newname not allowed, try to avoid filtering (badNickCheck)\n" red
				set name [urlencode_all $newname]
				::MSN::WriteSB ns "REA" "$userlogin $name"
			}
			default {
			}
		}
	}

	#Change a users nickname
	proc changeName { userlogin newname { nourlencode 0 } } {

		if { $userlogin == "" } {
			return
		}

		if { $nourlencode } {
			set name $newname
		} else {
			set name [urlencode $newname]
		}

		if { [::config::getKey protocol] == 11 } {
			::MSN::WriteSB ns "PRP" "MFN $name" "ns handlePRPResponse $name"
		} else {

			if { [::config::getKey allowbadwords] == 1 } {
				#If we're allowing banned words in nicks, try to set usual nick. It it fails,
				#we will try again urlencoding every character, to avoid censure
				::MSN::WriteSB ns "REA" "$userlogin $name" \
					"::MSN::badNickCheck $userlogin [list $name]"
			} else {
				::MSN::WriteSB ns "REA" "$userlogin $name"
			}
		}
	}

	#Change a users personal message
	proc changePSM { newpsm { forcechange 0 } } {
		#TODO: encode XML etc
		if { [::config::getKey protocol] == 11 } {
			if { [::abook::getPersonal PSM] != $newpsm || $forcechange } {
				set currentMedia [::abook::getPersonal currentMedia]
				set currentMedia [::sxml::xmlreplace $currentMedia]
				set currentMedia [encoding convertto utf-8 $currentMedia]
				::abook::setPersonal PSM $newpsm
				set newpsm [::sxml::xmlreplace $newpsm]
				set newpsm [encoding convertto utf-8 $newpsm]
				
				set psm "<Data><PSM>$newpsm</PSM><CurrentMedia>$currentMedia</CurrentMedia></Data>"
				::MSN::WriteSBNoNL ns "UUX" "[string length $psm]\r\n$psm"
				save_config
#				::Event::fireEvent myPSMChange protocol $userlogin
			}
		} else {
			#Do nothing
		}
	}

	#changes the current media in the personal message
	#type: can be one of: Music, Games or Office
	#enabled: 0 or 1
	#format: A formatter string ala .Net; For example: {0} - {1}
	#args: list with the other things, first will match {0} in format	
	proc changeCurrentMedia { type enabled format args } {
		set psm [::abook::getPersonal PSM]
		set psm [::sxml::xmlreplace $psm]
		if {$enabled == 1} {
			set currentMedia "aMSN\\0$type\\01\\0$format\\0[join $args \\0]\\0"
		} else {
			set currentMedia ""
		}
		::abook::setPersonal currentMedia $currentMedia
		set currentMedia [::sxml::xmlreplace $currentMedia]
		set currentMedia [encoding convertto utf-8 $currentMedia]
		set str "<Data><PSM>$psm</PSM><CurrentMedia>$currentMedia</CurrentMedia></Data>"
		::MSN::WriteSBNoNL ns "UUX" "[string length $str]\r\n$str"
	}

	#Procedure called to change our status
	proc changeStatus {new_status} {
		global autostatuschange

#		set clientid 805306412
		if {[::config::getKey displaypic] == "" } {
			::config::setKey displaypic nopic.gif
		}
		if { [::config::getKey displaypic] != "nopic.gif" } {
			::MSN::WriteSB ns "CHG" "$new_status [::config::getKey clientid] [urlencode [create_msnobj [::config::getKey login] 3 [::skin::GetSkinFile displaypic [::config::getKey displaypic]]]]"
		} else {
			::MSN::WriteSB ns "CHG" "$new_status [::config::getKey clientid]"
		}

		#Reset automatic status change to 0
		set autostatuschange 0
	}

	# set a capability of the client
	# possiblities for cap are:
	# mobile Mobile Device
	# inkgif receive Ink as gif
	# inkisf receive Ink as ISF
	# webcam Webcam
	# multip Multi-Packeting
	# paging Paging
	# drctpg Direct-Paging
	# webmsn WebMessenger
	# direct DirectIM
	# winks  Winks
	# msnc1  This is the value for MSNC1 (MSN Msgr 6.0)
	# msnc2  This is the value for MSNC2 (MSN Msgr 6.1)
	# msnc3  This is the value for MSNC3 (MSN Msgr 6.2)
	# msnc4  This is the value for MSNC4 (MSN Msgr 7.0)
	# msnc5  This is the value for MSNC5 (MSN Msgr 7.5)
	#
	#switch==1 means turn on, 0 means turn off 
	proc setClientCap { cap { switch 1 } } {
		set clientid [::config::getKey clientid 0]

		if $switch {
			switch $cap {
				mobile { set clientid [expr {$clientid | 1} ] }
				inkgif { set clientid [expr {$clientid | 4} ] }
				inkisf { set clientid [expr {$clientid | 8} ] }
				webcam { set clientid [expr {$clientid | 16} ] }
				multip { set clientid [expr {$clientid | 32} ] }
				paging { set clientid [expr {$clientid | 64} ] }
				drctpg { set clientid [expr {$clientid | 128} ] }
				webmsn { set clientid [expr {$clientid | 512} ] }
				direct { set clientid [expr {$clientid | 16384} ] }
				winks { set clientid [expr {$clientid | 32768} ] }
				msnc1 { set clientid [expr {$clientid | 268435456} ] }
				msnc2 { set clientid [expr {$clientid | 536870912} ] }
				msnc3 { set clientid [expr {$clientid | 805306368} ] }
				msnc4 { set clientid [expr {$clientid | 1073741824} ] }
				msnc5 { set clientid [expr {$clientid | 1342177280} ] }
			}
		} else {
			switch $cap {
				mobile { set clientid [expr {$clientid & -2} ] }
				inkgif { set clientid [expr {$clientid & -5} ] }
				inkisf { set clientid [expr {$clientid & -9} ] }
				webcam { set clientid [expr {$clientid & -17} ] }
				multip { set clientid [expr {$clientid & -33} ] }
				paging { set clientid [expr {$clientid & -65} ] }
				drctpg { set clientid [expr {$clientid & -129} ] }
				webmsn { set clientid [expr {$clientid & -513} ] }
				direct { set clientid [expr {$clientid & -16385} ] }
				winks { set clientid [expr {$clientid & -32769} ] }
				msnc1 { set clientid [expr {$clientid & -268435457} ] }
				msnc2 { set clientid [expr {$clientid & -536870913} ] }
				msnc3 { set clientid [expr {$clientid & -805306369} ] }
				msnc4 { set clientid [expr {$clientid & -1073741825} ] }
				msnc5 { set clientid [expr {$clientid & -1342177281} ] }
			}
		}
		::config::setKey clientid $clientid
		return $clientid
	}

	proc myStatusIs {} {
		variable myStatus
		return $myStatus
	}

	proc setMyStatus { status } {
		variable myStatus
		set myStatus $status
	}

	proc userIsBlocked {userlogin} {
		set lists [::abook::getLists $userlogin]
		if { [lsearch $lists BL] != -1} {
			return 1
		}
		return 0

	}

	proc blockUser { userlogin username} {
		::MSN::WriteSB ns REM "AL $userlogin"
		if {[::config::getKey protocol] == 11} {
			::MSN::WriteSB ns ADC "BL N=$userlogin"
		} else {