msnp2p.tcl

Linux下的MSN聊天程序源码

::snit::type P2PMessage {

	option -sessionid
	option -identifier
	option -offset
	option -totalsize
	option -datalength
	option -flag
	option -ackid
	option -ackuid
	option -acksize
	variable headers
	variable body ""

	constructor {args} {
		#TODO: remove me when object is destroyed in the right place
		#DONE (hopefully)
		#after 30000 $self destroy
	}

	#creates a P2PMessage object from a normal Message object
	method createFromMessage { message } {
		#		array set headers [$message getHeaders]
		#		set data [$message getBody]
		#		set idx [string first "\r\n\r\n" $data]
		#		set head [string range $data 0 [expr $idx -1]]
		##		set body [string range $data [expr $idx +4] end]
		set body [$message getBody]
		#		set head [string map {"\r" ""} $head]
		#		set heads [split $head "\n"]
		#		foreach header $heads {
		#			set idx [string first ": " $header]
		#			array set headers [list [string range $header 0 [expr $idx -1]] \
		    #					  [string range $header [expr $idx +2] end]]
		#		}
		binary scan [string range $body 0 48] iiiiiiiiiiii cSid cId cOffset1 cOffset2 cTotalDataSize1 cTotalDataSize2 cMsgSize cFlags cAckId cAckUID cAckSize1 cAckSize2
		set body [string range $body 48 end]
		set options(-sessionid) $cSid
		set options(-identifier) $cId
		set options(-offset) [int2word $cOffset1 $cOffset2]
		set options(-totalsize) [int2word $cTotalDataSize1 $cTotalDataSize2]
		set options(-datalength) $cMsgSize
		set options(-flag) $cFlags
		set options(-ackid) $cAckId
		set options(-ackuid) $cAckUID
		set options(-acksize) [int2word $cAckSize1 $cAckSize2]
	}

	method toString { {humanReadable 0} } {
		set str ""
		foreach { header info } [array get headers] {
			set str "$str$header: $info\r\n"
		}
		set str "$str\r\n\r\n"
		if { $humanReadable } {
			set str "${str}sessionid: $options(-sessionid)\n"
			set str "${str}identifier: $options(-identifier)\n"
			set str "${str}offset: $options(-offset)\n"
			set str "${str}totalsize: $options(-totalsize)\n"
			set str "${str}datalength: $options(-datalength)\n"
			set str "${str}flag: $options(-flag)\n"
			set str "${str}ackid: $options(-ackid)\n"
			set str "${str}ackuid: $options(-ackuid)\n"
			set str "${str}acksize: $options(-acksize)\n"
		} else {
			#TODO
		}
		set str "$str$body"
		return $str
	}


	#	proc ReadData { message chatid } {
	#		variable chunkedData
	#		# Get values from the header
	##		set idx [expr [string first "\r\n\r\n" $data] + 4]
	##		set headend [expr $idx + 48]
	#		set data [$message getBody]
	#
	#	        binary scan [string range $data 0 48] iiiiiiiiiiii cSid cId cOffset1 cOffset2 cTotalDataSize1 cTotalDataSize2 cMsgSize cFlags cAckId cAckUID cAckSize1 cAckSize2
	#
	#	        set cOffset [int2word $cOffset1 $cOffset2]
	#	        set cTotalDataSize [int2word $cTotalDataSize1 $cTotalDataSize2]
	#   	        set cAckSize [int2word $cAckSize1 $cAckSize2]
	#
	#		#status_log "Read header : $cSid $cId $cOffset $cTotalDataSize $cMsgSize $cFlags $cAckId $cAckUID $cAckSize\n" red
	#		#status_log "Sid : $cSid -> " red
	#
	#		if {$cSid == "0" && $cMsgSize != "0" && $cMsgSize != $cTotalDataSize } {
	#
	#			if { ![info exists chunkedData($cId)] } {
	#				set chunkedData($cId) "[string range $data 48 end-4]"
	#			} else {
	#				set chunkedData($cId) "$chunkedData($cId)[string range $data 48 end-4]"
	#			}
	#			#status_log "Data is now : $chunkedData($cId)\n\n";
	#
	#			if { $cTotalDataSize != [string length $chunkedData($cId)] } {
	#				return
	#			} else {
	#				set data $chunkedData($cId)
	#				set headend 0
	#				set cMsgSize $cTotalDataSize
	#			}
	#
	#		}
	#	}








	method getBody { } {
		return $body
	}

	method getHeader { name } {
		return [lindex [array get headers $name] 1]
	}
}

namespace eval ::MSNP2P {
	namespace export loadUserPic SessionList ReadData MakePacket MakeACK MakeSLP


	#Get picture from $user, if cached, or sets image as "loading", and request it
	#using MSNP2P
	proc loadUserPic { chatid user {reload "0"} } {
		#Line below changed from != -1 to == 0 because -1 means 
		#"enabled but imagemagick unavailable"
		if { [::config::getKey getdisppic] == 0 } {
			status_log "Display Pics disabled, exiting loadUserPic\n" red
			return
		} 

		#status_log "::MSNP2P::GetUser: Checking if picture for user $user exists\n" blue

		set msnobj [::abook::getVolatileData $user msnobj]

		#status_log "::MSNP2P::GetUser: MSNOBJ is $msnobj\n" blue

		#set filename [::MSNP2P::GetFilenameFromMSNOBJ $msnobj]
		set filename [::abook::getContactData $user displaypicfile ""]
		status_log "::MSNP2P::GetUser: filename is $filename\n" white

		if { $filename == "" } {
			return
		}

		global HOME
		#Reload 1 means that we force aMSN to reload a new display pic
		#Destroy it before to avoid TkCxImage to redraw animated gif above the good display pic
		#TODO: FIX: I think the next line is incorrect, did you want image delete? (be careful if there are images on the screen)
		destroy user_pic_$user
		if { ![file readable "[file join $HOME displaypic cache ${filename}].png"] || $reload == "1" } {
			status_log "::MSNP2P::GetUser: FILE [file join $HOME displaypic cache ${filename}] doesn't exist!!\n" white
			image create photo user_pic_$user -file [::skin::GetSkinFile "displaypic" "loading.gif"] -format cximage


			#if the small picture (for notifications e.g.) already exists, change it
			if { [ImageExists displaypicture_not_$user] } {
			
				status_log "User DP Changed, recreating small image as it already exist"
				
				#clear it first before overwriting
				displaypicture_not_$user blank
				#if there is no problem copying, it's OK, we resize it if bigger then 50x50
				if {![catch {displaypicture_not_$user copy user_pic_$user}]} {
					if {[image width displaypicture_not_$user] > 50 || [image height displaypicture_not_$user] > 50} {
						::picture::ResizeWithRatio displaypicture_not_$user 50 50
					}
				} else {
					image delete displaypicture_not_$user
				}
			}				
			

			create_dir [file join $HOME displaypic]
			create_dir [file join $HOME displaypic cache]
			::MSNP2P::RequestObject $chatid $user $msnobj
		} else {
			::skin::getDisplayPicture $user 1
		}
	}

	proc loadUserSmiley { chatid user msnobj } {

		set filename [::MSNP2P::GetFilenameFromMSNOBJ $msnobj]

		status_log "Got filename $filename for $chatid with $user and $msnobj\n" red

		if { $filename == "" } {
			return
		}

		image create photo emoticonCustom_std_$filename -width 19 -height 19

		status_log "::MSNP2P::GetUserPic: filename is $filename\n" white


		global HOME
		if { [catch {image create photo emoticonCustom_std_$filename -file "[file join $HOME smileys cache ${filename}].png" -format cximage}] } {
			#We didn't manage to load the smiley (either we haven't it either it's bad) so we ask it
			status_log "::MSNP2P::GetUser: FILE [file join $HOME smileys cache ${filename}] doesn't exist!!\n" white
			image create photo emoticonCustom_std_$filename -width 19 -height 19

			create_dir [file join $HOME smileys]
			create_dir [file join $HOME smileys cache]
			::MSNP2P::RequestObject $chatid $user $msnobj
		}
	}


	proc GetFilenameFromMSNOBJ { msnobj } {
		set sha1d [split $msnobj " "]
		set idx [lsearch $sha1d "SHA1D=*"]
		set sha1d [lindex $sha1d $idx]
		set sha1d [string range $sha1d 7 end-1]
		if { $sha1d == "" } {
			return ""
		}
		#return [::md5::md5 $sha1d]
		binary scan $sha1d h* filename
		return $filename
	}

	proc GetFilenameFromContext { context } {
		global msnobjcontext

		set old_msnobj [::base64::decode $context]
		set msnobj [string range $old_msnobj [string first "<" $old_msnobj] [expr {[string first "/>" $old_msnobj] + 1}]]

		status_log "GetFilenameFromContext : $context == $old_msnobj == $msnobj\n[string first "<" $old_msnobj] - [string first "/>"  $old_msnobj]\n\n" red
		if { [info exists msnobjcontext($msnobj)] } {
			status_log "Found filename\n" red
			return $msnobjcontext($msnobj)
		} else {
			status_log "Couln't find filename for context \n$context\n = $msnobj --- [array get msnobjcontext] --[info exists msnobjcontext($msnobj)] \n" red
			return ""
		}


	}

	#//////////////////////////////////////////////////////////////////////////////
	# SessionList (action sid [varlist])
	# Data Structure for MSNP2P Sessions, contains :
	# 0 - Message Identifier	(msgid)
	# 1 - TotalDataSize		(totalsize) This variable is only used if sending data in split packets
	# 2 - Offset			(offset)
	# 3 - Destination		(dest)
	# 4 - Step to run after ack     (AferAck)   For now can be DATAPREP, SENDDATA
	# 5 - CallID (MSNSLP)		(callid)
	# 6 - File Descriptor		(fd)
	# 7 - Session Type		(type) bicon, emoticon, filetransfer
        # 8 - Filename for transfer     (Filename)
	# 9 - branchid                  (branchid)
	#
	# action can be :
	#	get : This method returns a list with all the array info, 0 if non existent
	#	set : This method sets the variables for the given sessionid, takes a list as argument.
	#	unset : This method removes the given sessionid variables
	#	findid : This method searches all Sessions for one that has the given Identifier, returns session ID or -1 if not found
	#	findcallid : This method searches all Sessions for one that has the given Call-ID, returns session ID or -1 if not found
	proc SessionList { action sid { varlist "" } } {

		switch $action {
			get {
				set ret [getObjOption $sid MsgId] 
				#status_log "getting $sid : [getObjOption $sid MsgId] - $ret" green

				if { $ret != "" } {
					# Session found, return values
					lappend ret [getObjOption $sid TotalSize] 
					lappend ret [getObjOption $sid Offset] 
					lappend ret [getObjOption $sid Destination] 
					lappend ret [getObjOption $sid AfterAck]
					lappend ret [getObjOption $sid CallId] 
					lappend ret [getObjOption $sid Fd]
					lappend ret [getObjOption $sid Type] 
					lappend ret [getObjOption $sid Filename]
					lappend ret [getObjOption $sid branchid]

					#status_log "returning $ret" green
					return $ret
				} else {
					#status_log "Not found" green
					# Session not found, return 0
					return 0
				}
			}

			set {
				#status_log "setting $sid with $varlist" green
				# This overwrites previous vars if they are set to something else than -1
				if { [lindex $varlist 0] != -1 } {
					setObjOption $sid MsgId [lindex $varlist 0]
					setObjOption [lindex $varlist 0] sid $sid
				}
				if { [lindex $varlist 1] != -1 } {
					setObjOption $sid TotalSize [lindex $varlist 1]
				}
				if { [lindex $varlist 2] != -1 } {
					setObjOption $sid Offset [lindex $varlist 2]
				}
				if { [lindex $varlist 3] != -1 } {
					setObjOption $sid Destination [lindex $varlist 3]
				}
				if { [lindex $varlist 4] != -1 } {
					setObjOption $sid AfterAck [lindex $varlist 4]
				}
				if { [lindex $varlist 5] != -1 } {
					setObjOption $sid CallId [lindex $varlist 5]
					setObjOption [lindex $varlist 5] sid $sid
				}
				if { [lindex $varlist 6] != -1 } {
					setObjOption $sid Fd [lindex $varlist 6]
				}
				if { [lindex $varlist 7] != -1 } {
					setObjOption $sid Type [lindex $varlist 7]
				}
				if { [lindex $varlist 8] != -1 } {
				        setObjOption $sid Filename [lindex $varlist 8]
				}
				if { [lindex $varlist 9] != -1 } {
				        setObjOption $sid branchid [lindex $varlist 9]
				}
			}

			unset {
				#status_log "unsetting..." green
				return
			}
			findcallid -
			findid {
				#status_log "Finding $action of $sid, found : [getObjOption $sid sid]" green
				if { [getObjOption $sid sid] != "" } {
					return [getObjOption $sid sid]
				}
			}
		}
	}


	#//////////////////////////////////////////////////////////////////////////////
	# ReadData ( data chatid )
	# This is the handler for all received MSNP2P packets
	# data is the MSNP2P packet
	# chatid will be used to get the SB ?? Ack alvaro if it's better to use chatid or some way to use the dest email
	# For now only manages buddy and emoticon transfer
	# TODO : Error checking on fields (to, from, sizes, etc)
	proc ReadData { message chatid } {
		global HOME
		variable chunkedData

		#		set message [P2PMessage create %AUTO%]
		#		$message createFromMessage $msg

		#status_log "called ReadData with $data\n" red

		# Get values from the header
		#		set idx [expr [string first "\r\n\r\n" $data] + 4]
		#		set headend [expr $idx + 48]
		#		set data [$message getBody]

		#	        binary scan [string range $data 0 48] iiiiiiiiiiii cSid cId cOffset1 cOffset2 cTotalDataSize1 cTotalDataSize2 cMsgSize cFlags cAckId cAckUID cAckSize1 cAckSize2