msncam.tcl

Linux下的MSN聊天程序源码

			"SEND"
			{
				after 250 "::CAMGUI::GetCamFrame $sid $sock;
					   catch {fileevent $sock writable \"::MSNCAM::WriteToSock $sock\" }"
			}
			"TSP_PAUSED" -
			"PAUSED" 
			{
				set encoder [getObjOption $sock codec]
				if { $encoder != "" } {
					set uid [getObjOption $encoder unique_id]
					if {$uid == "" } {
						set byte1 [myRand 1 255]
						set byte2 [myRand 1 255]
						set byte3 [myRand 1 255]
						set byte4 [myRand 1 255]
						set uid [binary format cccc $byte1 $byte2 $byte3 $byte4]					
						setObjOption $encoder unique_id $uid
					}
				} else {
					set uid 0
				}

				after cancel "catch {fileevent $sock writable \"::MSNCAM::WriteToSock $sock\" }"
				after 4000 "catch {fileevent $sock writable \"::MSNCAM::WriteToSock $sock\" }"
				set data "[binary format ccsssii 24 1 0 0 0 0 0]"
				append data $uid
				set timestamp [ expr { [clock clicks -milliseconds] % 315360000 } ]
				append data "[binary format i $timestamp]"
				status_log "sending paused header"
			}
			"TSP_RECEIVE" 
			{
				puts -nonewline $sock "\xd2\x04\x00\x00"
			}
			"END"
			{
				set chatid [getObjOption $sid chatid]
				status_log "Closing socket $sock because it's in END state\n" red
				catch { close $sock }
				CancelCam $chatid $sid
			}

		}

		if { $data != "" } {
			status_log "Writing Data on socket $sock sending=$sending - server=$server - state=$state : \n$data\n" red
		
			catch { puts -nonewline $sock "$data" }
		}



	}

	proc CloseSocket { sock } {

		set sid [getObjOption $sock sid]

		set MsgId [lindex [::MSNP2P::SessionList get $sid] 0]

		set bheader [binary format ii 0 $MsgId][binword 0][binword 0][binary format iiii 0 4 [expr {int([expr {rand() * 1000000000}])%125000000 + 4}] 0][binword 0]

		puts -nonewline $sock "[binary format i 48]$bheader"
		status_log "Closing socket... \n" red
		catch { close $sock }

	}



	proc CreateInvitationXML { sid } {
		set session [getObjOption $sid session]
		if {$session == "" } {
			set session [myRand 9000 9999]
		}

		setObjOption $sid session $session

		set rid [getObjOption $sid my_rid]
		if { $rid == "" } {
			set rid [myRand 100 199]
		}
		setObjOption $sid my_rid $rid

		set udprid [expr {$rid + 1}]
		set conntype [abook::getDemographicField conntype]
		set listening [abook::getDemographicField listening]

		set producer [getObjOption $sid producer]

		# Here we force the creation of a server and send it in the XML in case we don't detect correctly
		# the firewalled state, in any case, it doesn't bother us if we're firewalled, we'll either connect 
		# as a client or use the reflector

		#if {$listening == "true" } {
			set port [OpenCamPort [config::getKey initialftport] $sid]
			set clientip [::abook::getDemographicField clientip]
			set localip [::abook::getDemographicField localip]
		#} else {
		#	set port ""
		#	set clientip ""
		#	set localip ""
		#}

		if { $producer } {
			set begin_type "<producer>"
			set end_type "</producer>"
		} else {
			set begin_type "<viewer>"
			set end_type "</viewer>"
		}

		set header "<version>2.0</version><rid>$rid</rid><session>$session</session><ctypes>0</ctypes><cpu>730</cpu>"
		set tcp "<tcp><tcpport>$port</tcpport>								<tcplocalport>$port</tcplocalport>								<tcpexternalport>$port</tcpexternalport><tcpipaddress1>$clientip</tcpipaddress1>"
		if { $clientip != $localip} {
			set tcp "${tcp}<tcpipaddress2>$localip</tcpipaddress2></tcp>"
		} else {
			set tcp "${tcp}</tcp>"
		}

		set udp "<udp><udplocalport>$port</udplocalport><udpexternalport>$port</udpexternalport><udpexternalip>$clientip</udpexternalip><a1_port>$port</a1_port><b1_port>$port</b1_port><b2_port>$port</b2_port><b3_port>$port</b3_port><symmetricallocation>0</symmetricallocation><symmetricallocationincrement>0</symmetricallocationincrement><udpinternalipaddress1>$localip</udpinternalipaddress1></udp>"
		set footer "<codec></codec><channelmode>1</channelmode>"

		set xml "${begin_type}${header}${tcp}${footer}${end_type}\r\n\r\n\x00"


		return $xml

	}

	proc ReceivedXML {chatid sid } {
		set producer [getObjOption $sid producer]
		set inviter [getObjOption $sid inviter]

		set xml [getObjOption $sid xml]
		set xml [FromUnicode $xml]
		set xml [string map  { "\r\n\r\n\x00" ""} $xml]
		setObjOption $sid xml $xml

		status_log "Got XML : $xml\n" red

		set list [xml2list $xml]

		if { $producer } {
			set type "viewer"
		
		} else {
			set type "producer"
		}
		set session [GetXmlEntry $list "$type:session"]
		set rid [GetXmlEntry $list "$type:rid"]


		status_log "Found session $session and rid $rid\n" red


		setObjOption $sid session $session
		setObjOption $sid rid $rid


		if { $producer } {
			SendReceivedViewerData $chatid $sid
			ConnectSockets $sid
		} else {
			status_log "::MSNCAM::SendXML $chatid $sid" red
			SendXML $chatid $sid
		}

	}

	proc ConnectSockets { sid } {
		set auth [getObjOption $sid authenticated]
		if { $auth == 1} { return }

		set xml [getObjOption $sid xml]
		set list [xml2list $xml]

		set ip_idx 7
		set ips [getObjOption $sid ips]
		set producer [getObjOption $sid producer]

		if { $ips == "" } {
			set ips [list]
		}


		while { 1 } {
			if { $producer } {
				set type "viewer"
				
			} else {
				set type "producer"
			}

			if { $ip_idx == 7 } {
				set ip [GetXmlEntry $list "$type:tcp:tcpexternalip"]
			} elseif { $ip_idx == 6 } {
				set ip [GetXmlEntry $list "$type:udp:udpexternalip"]
			} elseif {$ip_idx > 0 } {
				set ip [GetXmlEntry $list "$type:tcp:tcpipaddress${ip_idx}"]
			} else {
				break
			}


			if {$ip != "" } {
				foreach port_idx { tcpport tcplocalport tcpexternalport } {
					set port [GetXmlEntry $list "$type:tcp:${port_idx}"]
					if {$port != "" } {
						status_log "Trying to connect to $ip at port $port\n" red
						set socket [connectMsnCam $sid "$ip" $port]
						if { $socket != 0 } {
							lappend ips [list $ip $port $socket]
						}
					}
				}
			}


		    incr ip_idx -1
		}

		setObjOption $sid ips $ips

		foreach connection $ips {
			set sock [lindex $connection 2]

			catch { fconfigure $sock -blocking 0 -buffering none -translation {binary binary} }
			catch { fileevent $sock readable "::MSNCAM::CheckConnected $sid $sock " }
			catch { fileevent $sock writable "::MSNCAM::CheckConnected $sid $sock " }
		}

		after 15000 "::MSNCAM::CheckConnectSuccess $sid"

	}

	proc CheckConnectSuccess { sid } {
		set ips [getObjOption $sid ips]
		set connected_ips [getObjOption $sid connected_ips]
		status_log "we have $ips connecting sockets and $connected_ips connected sockets\n" red
		if { [llength $connected_ips] == 0
		     && [getObjOption $sid canceled] != 1 && [getObjOption $sid reflector] != 1} {
			status_log "No socket was connected\n" red
			after 5000 "::MSNCAM::CreateReflectorSession $sid"
		}
	}
	
	proc CreateReflectorSession { sid } {
		if { [getObjOption $sid producer] && [getObjOption $sid reflector] != 1} {
			status_log "Trying Reflector\n" red 
			setObjOption $sid reflector 1
			if { [catch {::http::geturl [list http://m1reflector.spotlife.net/createSession]  -timeout 3000 -command "::MSNCAM::ReflectorCreateSession $sid" }] } {
				status_log "Unable to connect to the reflector.. canceling\n" red
				::MSNCAM::CancelCam [getObjOption $sid chatid] $sid
			}
		}
		
	}

	proc ReflectorCreateSession { sid token } {

		if { ! [info exists ::webcamsn_loaded] } { ::CAMGUI::ExtensionLoaded }
		if { ! $::webcamsn_loaded } { status_log "Error when trying to load Webcamsn extension" red; return }

		set tmp_data [::http::data $token]
		
		#status_log "createSession url get finished : $tmp_data\n" red
		
		if { $::webcamsn_loaded && [::http::status $token] == "ok" && [::http::ncode $token] == 200 } {
			set tmp_data [string range $tmp_data [expr {[string first "?>" $tmp_data] +2}] end]

			status_log "Got XML : $tmp_data"

			if {[catch {set xml [xml2list  $tmp_data]} res ] } {
				status_log "Error in parsing xml file... $tmp_data  -- $res\n" red
				::MSNCAM::CancelCam [getObjOption $sid chatid] $sid
				::http::cleanup $token
				return
			}
			#status_log "got xml $xml\n" red
			set refl_sid [GetXmlEntry $xml "createsessionresponse:sid"]
			set refl_kid [GetXmlEntry $xml "createsessionresponse:kid"]
			set refl_url [GetXmlEntry $xml "createsessionresponse:createtunnelurl"]

			if {$refl_url == "" } { set refl_url "http://m1reflector14.spotlife.net:9010/createTunnel"}
			if { $refl_sid == "" || $refl_kid == "" } {
				status_log "Was not able to find the sid/kid from the xml..."
				::http::cleanup $token
				return
			}

			set a [::Webcamsn::CreateHashFromKid $refl_kid $refl_sid]
			set refl_url "$refl_url\?sid=$refl_sid\&a=$a"

			status_log "Creating the tunnel with the url : $refl_url\n" red

			if { [catch {::http::geturl [list $refl_url]  -timeout 3000 -command "::MSNCAM::ReflectorCreateTunnel $sid" } res] } {
				status_log "Unable to connect to the reflector.. $res canceling\n" red
				::MSNCAM::CancelCam [getObjOption $sid chatid] $sid
			}
			
			
		} else {
			status_log "Session : Unable to connect to the Reflector: status=[::http::status $token] ncode=[::http::ncode $token]\n" blue
			status_log "tmp_data : $tmp_data\n" blue
			
			::MSNCAM::CancelCam [getObjOption $sid chatid] $sid
		}
		
		::http::cleanup $token
		
	}

	proc ReflectorCreateTunnel {sid token} {
		set tmp_data [ ::http::data $token ]

		status_log "createTunnel  finished : $tmp_data\n" red

		if { [::http::status $token] == "ok" && [::http::ncode $token] == 200 } {
		
			set tmp_data [string range $tmp_data [expr {[string first "?>" $tmp_data] +2}] end]

			if {[catch {set xml [xml2list $tmp_data] } res ] } {
				status_log "Error in parsing xml file... $tmp_data  -- res\n" red
				::MSNCAM::CancelCam [getObjOption $sid chatid] $sid
				::http::cleanup $token
				return
			}
			status_log "Retreiving information from XML" red
			set tid [GetXmlEntry $xml "createtunnelresponse:tid"]
			set url [GetXmlEntry $xml "createtunnelresponse:tunnelserverurl"]

			set refldata "ru=$url&ti=$tid"

			status_log "ReflData is : $refldata\n" red

			if { [catch { SendReflData $sid [getObjOption $sid chatid] $refldata} res] } {
				status_log "ERROR Sending REFLDATA : $res\n" red
			}
			
			status_log "Connecting to the reflector\n" red
			if { [catch { ConnectToReflector $sid $refldata} res] } {
				status_log "ERROR Connecting to reflector : $res\n" red
			}

		
		} else {
			status_log "Tunnel : Unable to connect to the Reflector: status=[::http::status $token] ncode=[::http::ncode $token]\n" blue
			status_log "tmp_data : $tmp_data\n" blue
			
			::MSNCAM::CancelCam [getObjOption $sid chatid] $sid
		}

		::http::cleanup $token
		
	}

	proc CheckConnected { sid socket}  {
		status_log "fileevent CheckConnectd for socket $socket\n"

		fileevent $socket readable ""
		fileevent $socket writable ""

		if { [eof $socket] || [fconfigure $socket -error] != "" } {
			status_log "Socket didn't connect $socket : [eof $socket] || [fconfigure $socket -error]\n" red
			close $socket

			set ips [getObjOption $sid ips]
			setObjOption $sid ips [RemoveSocketFromList $ips $socket]

		} else {
			status_log "Connected on socket $socket : [eof $socket] || [fconfigure $socket -error]\n" red


			set ips [getObjOption $sid ips]
			for {set idx 0} { $idx < [llength $ips] } {incr idx } {
				set connection [lindex $ips $idx]
				set ip [lindex $connection 0]
				set port [lindex $connection 1]
				set sock [lindex $connection 2]

				if {$sock == $socket } {
					break
				}
			}

			set connected_ips [getObjOption $sid connected_ips]
			lappend connected_ips [list $ip $port $socket]
			setObjOption $sid connected_ips $connected_ips

			if { [getObjOption $sid socket] == "" } {
				#setObjOption $sid socket $socket
				fileevent $socket readable "::MSNCAM::ReadFromSock $socket"
				fileevent $socket writable "::MSNCAM::WriteToSock $socket"
			}

			set ips [getObjOption $sid ips]
			setObjOption $sid ips [RemoveSocketFromList $ips $socket]



		}

		after 5000 "::MSNCAM::CheckConnectSuccess $sid"
	}

	proc AuthSuccessfull { sid socket } {
		status_log "Authentification on socket $socket successfull [fileevent $socket readable] - [fileevent $socket writable]\n" red
		CloseUnusedSockets $sid $socket

		setObjOption $sid authenticated 1

		status_log "wtf  : [fileevent $socket readable] - [fileevent $socket writable]\n" red
	}

	proc AuthFailed { sid socket } {
		set list [RemoveSocketFromList [getObjOption $sid connected_ips] $socket]
		setObjOption $sid connected_ips $list

		#setObjOption $sid socket ""

		catch { close $socket }
		status_log "Authentification on socket $socket failed\n" red
		#if {[llength $list] > 0 } {
		#	set element [lindex $list 0]
		#	set socket [lindex $element 2]

		#	setObjOption $sid socket $socket