protocol.tcl

Linux下的MSN聊天程序源码

			::MSN::WriteSB ns ADD "BL $userlogin $username"
		}
		#an event to let the GUI know a user is blocked
		after 500 ::Event::fireEvent contactBlocked protocol $userlogin
	}

	proc unblockUser { userlogin username} {
		::MSN::WriteSB ns REM "BL $userlogin"
		if {[::config::getKey protocol] == 11} {
			::MSN::WriteSB ns ADC "AL N=$userlogin"
		} else {
			::MSN::WriteSB ns ADD "AL $userlogin $username"
		}
		#an event to let the GUI know a user is unblocked
		after 500 ::Event::fireEvent contactUnblocked protocol $userlogin
	}

	# Move user from one group to another group
	proc moveUser { passport oldGid newGid {userName ""}} {
		if { $userName == "" } {
			set userName $passport
		}
		if { $oldGid == $newGid } {
			return
		}
		if { [::config::getKey protocol ] == 11 } {
			set contactguid [::abook::getContactData $passport contactguid]
			set atrid [::MSN::WriteSB ns "ADC" "FL C=$contactguid $newGid" "::MSN::MOVHandler $oldGid $contactguid $passport" ]
		} else {
			set atrid [::MSN::WriteSB ns "ADD" "FL $passport [urlencode $userName] $newGid"]
			set rtrid [::MSN::WriteSB ns "REM" "FL $passport $oldGid"]
		}

		#an event to let the GUI know a user is moved between 2 groups
		::Event::fireEvent contactMoved protocol $passport $oldGid $newGid

	}

	#Copy user from one group to another
	proc copyUser { passport newGid {userName ""}} {
		if { $userName == "" } {
			set userName $passport
		}
		if { [::config::getKey protocol ] == 11 } {
			set contactguid [::abook::getContactData $passport contactguid]
			set atrid [::MSN::WriteSB ns "ADC" "FL C=$contactguid $newGid"]
		} else {
			set atrid [::MSN::WriteSB ns "ADD" "FL $passport [urlencode $userName] $newGid"]
		}

		# An event to let the GUI know a user is copied/added to a group
		::Event::fireEvent contactAdded protocol $passport $newGid
	}


	#Add user to our Forward (contact) list
	proc addUser { userlogin {username ""} {gid 0} } {
		set userlogin [string map {" " ""} $userlogin]
		if {[string match "*@*" $userlogin] < 1 } {
			set domain "@hotmail.com"
			set userlogin $userlogin$domain
		}
		if { $username == "" } {
			set username $userlogin
		}
		if { [::config::getKey protocol] == 11 } {
			::MSN::WriteSB ns "ADC" "FL N=$userlogin F=$username" "::MSN::ADCHandler $gid"
		} else {
			::MSN::WriteSB ns "ADD" "FL $userlogin $username $gid" "::MSN::ADDHandler"
		}
	}


	#Handler for the ADD message, to show the ADD messagebox
	proc ADDHandler { item } {
		if { [lindex $item 2] == "FL"} {
			set contact [urldecode [lindex $item 4]]    ;# Email address
			#an event to let the GUI know a user is copied/added to a group
			set newGid [lindex $item 6]
			::Event::fireEvent contactAdded protocol $contact $newGid
			msg_box "[trans contactadded]\n$contact"
		}

		if { [lindex $item 0] == 500 } {
			#Instead of disconnection, transform into error 201
			cmsn_ns_handler [lreplace $item 0 0 201]
			return
		}

		cmsn_ns_handler $item

	}

	#Handler for the ADC message, to show the ADD messagebox, and to move a user to a group if gid != 0
	proc ADCHandler { gid item } {
		if { [lindex $item 2] == "FL"} {
			set contact [urldecode [string range [lindex $item 3] 2 end]]    ;# Email address
			#an event to let the GUI know a user is copied/added to a group
			::abook::setContactData $contact contactguid [string range [lindex $item 5] 2 end]
			::abook::setContactForGuid [string range [lindex $item 5] 2 end] $contact
			::Event::fireEvent contactAdded protocol $contact $gid
			if { $gid != 0 } {
				moveUser $contact 0 $gid
			}
			msg_box "[trans contactadded]\n$contact"
		}

		if { [lindex $item 0] == 500 } {
			#Instead of disconnection, transform into error 201
			cmsn_ns_handler [lreplace $item 0 0 201]
			return
		}

		cmsn_ns_handler $item
	}

	proc MOVHandler { oldGid contactguid passport item } {
			::MSN::GotADCResponse $item
                        if { $oldGid != "0" } {
                                set rtrid [::MSN::WriteSB ns "REM" "FL $contactguid $oldGid"]
                        } else {
                                ::abook::removeContactFromGroup $passport "0"
                        }
	}


	#Delete user (from a given group $grID, or from all groups)
	proc deleteUser { userlogin {grId ""}} {
		if { [::config::getKey protocol] == 11 } {
			if { $grId == "0" } {
				#We remove from every where
				foreach groupID [::abook::getGroups $userlogin] {
					::MSN::WriteSB ns REM "FL [::abook::getContactData $userlogin contactguid $groupID]"
				}
				::MSN::WriteSB ns REM "FL [::abook::getContactData $userlogin contactguid]"
			} else {
				#If it is the last group then delete it from the FL too
				::MSN::WriteSB ns REM "FL [::abook::getContactData $userlogin contactguid] $grId"
				if { [llength [::abook::getGroups $userlogin]] == 1 } {
					::MSN::WriteSB ns REM "FL [::abook::getContactData $userlogin contactguid]"
				}
			}
		} else {
			if { $grId == "" } {
				::MSN::WriteSB ns REM "FL $userlogin"
			} else {
				::MSN::WriteSB ns REM "FL $userlogin $grId"
			}
		}

		#an event to let the GUI know a user is removed from a group / the list
		::Event::fireEvent contactRemoved protocol $userlogin $grId
	}

	##################################################
	#Internal procedures
	##################################################

	#Start the loop that will keep a keepalive (PNG) message every minute
	proc StartPolling {} {

		if {([::config::getKey keepalive] == 1) && ([::config::getKey connectiontype] == "direct")} {
			variable pollstatus 0
			after cancel "::MSN::PollConnection"
			after 60000 "::MSN::PollConnection"
		} else {
			after cancel "::MSN::PollConnection"
		}
	}

	#Stop sending the keepalive message
	proc StopPolling {} {
		after cancel "::MSN::PollConnection"
	}

	#Send a keepalive message
	proc PollConnection {} {
		variable pollstatus
		#Let's try to keep the connection alive... sometimes it gets closed if we
		#don't do send or receive something for a long time
		if { [::MSN::myStatusIs] != "FLN" } {
			::MSN::WriteSBRaw ns "PNG\r\n"
			
			#Reconnect if necessary
			if { $pollstatus > 1 && [::config::getKey reconnect] == 1 } {
				set ::oldstatus [::MSN::myStatusIs]
				::MSN::logout
				::MSN::reconnect "[trans connectionlost]"
			} elseif { $pollstatus > 10 } {
				::MSN::logout
			}
			incr pollstatus

		}
		after 60000 "::MSN::PollConnection"
	}

	if { $initialize_amsn == 1 } {
		variable trid 0
	}

	#Write a string to the given SB, followed by a NewLine character, adding the transfer ID
	proc WriteSB {sbn cmd param {handler ""}} {
		WriteSBNoNL $sbn $cmd "$param\r\n" $handler
	}

	#Write a string to the given SB, with no NewLine, adding the transfer ID
	proc WriteSBNoNL {sbn cmd param {handler ""}} {

		variable trid

		set msgid [incr trid]
		set msgtxt "$cmd $msgid $param"

		WriteSBRaw $sbn $msgtxt

		if {$handler != ""} {
			global list_cmdhnd
			lappend list_cmdhnd [list $trid $handler]
		}

		return $msgid
	}

	proc WriteSBRaw {sbn cmd} {

		if { $sbn == 0 } {
			return
		}
		#Finally, to write, use a wrapper, so it's transparent to use
		#a direct connection, a proxy, or anything
		set proxy [$sbn cget -proxy]
		catch {$proxy write $sbn $cmd} res

		if { $res == 0 } {
			if { $sbn != "ns" } {
				catch {$sbn configure -last_activity [clock seconds] }
			}

			if {$sbn != "ns" } {
				degt_protocol "->$sbn-[$sbn cget -sock] $cmd" sbsend
			} else {
				degt_protocol "->$sbn-[$sbn cget -sock] $cmd" nssend
			}
		} else {
			::MSN::CloseSB $sbn
			degt_protocol "->$sbn FAILED: $cmd" error
		}
	}



	proc SendInk { chatid  file } {

		set maxchars 1202

		set sb [::MSN::SBFor $chatid]
		if { $sb == 0 } {
			return
		}

		set fd [open $file r]
		fconfigure $fd -translation {binary binary}
		set data [read $fd]
		close $fd

		set data [::base64::encode $data]
		set data [string map { "\n" ""} $data]
		set data "base64:$data"
		set chunks [expr {int( [string length $data] / $maxchars) + 1 } ]


		status_log "Ink data : $data\nchunks : $chunks\n"

		for {set i 0 } { $i < $chunks } { incr i } {
			set chunk [string range $data [expr $i * $maxchars] [expr ($i * $maxchars) + $maxchars - 1]]
			set msg ""
			if { $i == 0 } {
				set msg "MIME-Version: 1.0\r\nContent-Type: image/gif\r\n"
				if { $chunks == 1 } {
					set msg "${msg}\r\n$chunk"
				} else { 
					set msgid "[format %X [myRand 4369 65450]][format %X [myRand 4369 65450]]-[format %X [myRand 4369 65450]]-[format %X [myRand 4369 65450]]-[format %X [expr { int([expr {rand() * 1000000}])%65450 } ] + 4369]-[format %X [myRand 4369 65450]][format %X [myRand 4369 65450]][format %X [myRand 4369 65450]]"
					set msg "${msg}Message-ID: \{$msgid\}\r\nChunks: $chunks\r\n\r\n$chunk"
				}
			} else {
				set msg "${msg}Message-ID: \{$msgid\}\r\nChunk: $i\r\n\r\n$chunk"
			}
			set msglen [string length $msg]

			::MSN::WriteSBNoNL $sb "MSG" "N $msglen\r\n$msg"
			
		}
		

	}
	

	########################################################################
	# Check if the old closed preferred SB is still the preferred SB, or
	# close it if not.
	proc CheckKill { sb } {

		#Kill any remaining timers
		after cancel "::MSN::CheckKill $sb"

		if { [catch {$sb cget -name}] } {
			#The SB was destroyed
			return
		}
		if { [$sb cget -stat] != "d" } {
			#The SB is connected again, forget about killing
			return
		} else {

			#Get the chatid
			set chatid [::MSN::ChatFor $sb]

			if { $chatid == 0 } {
				#If SB is not in any chat, we can just kill it
				status_log "Session $sb killed with no chatid associated\n"
				::MSN::KillSB $sb
				return 0
			}

			#If we're the preferred chatid
			if { [::MSN::SBFor $chatid] == $sb } {

				#It's the preferred SB, so keep it for the moment
				set items [expr {[llength [$sb cget -users]] -1}]
				status_log "Session $sb closed, there are [expr {$items+1}] users: [$sb cget -users]\n" blue

				for {set idx $items} {$idx >= 0} {incr idx -1} {
					set user_info [lindex [$sb cget -users] $idx]
					$sb delUser $idx
					amsn::userLeaves [::MSN::ChatFor $sb] [list $user_info] 0
				}

				#Try to kill it again in 5 minutes
				after 300000 "::MSN::CheckKill $sb"

			} else {
				#It's not the preferred SB,so we can safely delete it from the
				#chat and Kill it
				DelSBFor $chatid $sb
				::MSN::KillSB $sb
			}
		}
	}


	#///////////////////////////////////////////////////////////////////////
	# Usually called from anywhere when a problem is found when writing or
	# reading a SB. It closes the sock.
	# For NS connection, call only when an error happens. To manually log out,
	# call ::MSN::logout
	proc CloseSB { sb } {

		status_log "::MSN::CloseSB $sb Called\n" green
		catch {fileevent [$sb cget -sock] readable "" } res
		catch {fileevent [$sb cget -sock] writable "" } res

		set sock [$sb cget -sock]

#		if {$sock != ""} {
#			set proxy [$sb cget -proxy]
#			$proxy finish $sb
#			$proxy destroy
#		}

#		#Append an empty string to the SB buffer. This will cause the
#		#actual SB cleaning, but will allow to process all buffer
#		#before doing the cleaning
#		$sb addData ""
		ClearSB $sb
	}
	#///////////////////////////////////////////////////////////////////////

	########################################################################
	#Called when we find a "" (empty string) in the SB buffer. This means
	#the SB is closed. Proceed to clear everything related to it
	proc ClearSB { sb } {

		status_log "::MSN::ClearSB $sb called\n" green

		set oldstat [$sb cget -stat]
#		$sb configure -data ""
		$sb configure -stat "d"

		if { [string match -nocase "*ns*" $sb] } {
			status_log "clearing sb $sb. oldstat=$oldstat"
			catch {close [$sb cget -sock]}

			$sb configure -sock ""
			set mystatus [::MSN::myStatusIs]

			#If we were not disconnected or authenticating, logout
			if { ("$oldstat" != "d") && ("$oldstat" != "u") } {
				logout
			}

			#If we're not disconnected, connected, or authenticating, then
			#we have a connection error.
			if { ("$oldstat"!="d") && ("$oldstat" !="o") && ("$oldstat" !="u") && ("$oldstat" !="closed")} {
				::config::setKey start_ns_server [::config::getKey default_ns_server]
				set error_msg [ns cget -error_msg]
				#Reconnect if necessary
				if { [::config::getKey reconnect] == 1 } {
					set ::oldstatus $mystatus
					if { $error_msg != "" } {
						::MSN::reconnect "[trans connecterror]: [ns cget -error_msg]"
					} else {
						::MSN::reconnect "[trans connecterror]"
					}
					return
				}

				if { $error_msg != "" } {
					msg_box "[trans connecterror]: [ns cget -error_msg]"
				} else {
					msg_box "[trans connecterror]"
				}
			}

			#If we were connected, we have lost the connection
			if { ("$oldstat"=="o") } {
				::config::setKey start_ns_server [::config::getKey default_ns_server]
				set error_msg [ns cget -error_msg]
				#Reconnect if necessary
				if { [::config::getKey reconnect] == 1 } {
					set ::oldstatus $mystatus
					if { $error_msg != "" } {