protocol.tcl

Linux下的MSN聊天程序源码

         set packet2 [expr {($packet2 + 0x100) % 0x100}]
         set packet3 [expr {($packet3 + 0x100) % 0x100}]
         set packetsize [expr {$packet2 + ($packet3<<8)}]

         set firstbyte [read $sockid 1]
         catch {puts -nonewline $fileid $firstbyte}

         fconfigure $sockid -blocking 0

         set recvbytes [tell $fileid]
         #::amsn::fileTransferProgress r $cookie $recvbytes $filesize


      } else {
         #A full packet didn't come the previous reading, read the rest
         set thedata [read $sockid $packetrest]
         catch {puts -nonewline $fileid $thedata}
         set recvbytes [tell $fileid]
      }

      if { $recvbytes >= $filesize} {
         #::amsn::fileTransferProgress r $cookie $recvbytes $filesize
         catch {puts $sockid "BYE 16777989\r"}
         status_log "File received\n"
	 ::amsn::FTProgress fr $cookie [lindex $filedata($cookie) 0] $recvbytes $filesize
         FinishedFT $cookie

      } else {
         fileevent $sockid readable "::MSNFT::ReceivePacket $sockid $fileid $filesize $cookie"

      }

   }


   ###################################
   #All about sending files
   ###################################

	proc supportsNewFT { clientid } {

		set msnc1 268435456
		set msnc2 536870912
		set msnc3 805306368
		set msnc4 1073741824
		set msnc5 1342177280

		if { ($clientid & $msnc1) == $msnc1 || \
			($clientid & $msnc2) == $msnc2 || \
			($clientid & $msnc3) == $msnc3 || \
			($clientid & $msnc4) == $msnc4 || \
			($clientid & $msnc5) == $msnc5 } {
			return 1
		}

		return 0

	}

   proc sendFTInvitation { chatid filename filesize ipaddr cookie} {
      #Invitation to filetransfer, initial message
      variable filedata

      if {[supportsNewFT [::abook::getContactData $chatid clientid]]} {
      	#::MSN6FT::SendFT $chatid $filename $filesize
	set sid [::MSN6FT::SendFT $chatid $filename $filesize]
	setObjOption $cookie msn6ftsid $sid
       	return 0
      }


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

      status_log "sentFTInvitation: filename (not converted to utf-8) is [file tail $filename]\n" blue
      status_log "sentFTInvitation: filename (converted to utf-8) is [encoding convertto utf-8 [file tail $filename]]\n" blue

      set msg "MIME-Version: 1.0\r\nContent-Type: text/x-msmsgsinvite; charset=UTF-8\r\n\r\n"
      set msg "${msg}Application-Name: File Transfer\r\n"
      set msg "${msg}Application-GUID: {5D3E02AB-6190-11d3-BBBB-00C04F795683}\r\n"
      set msg "${msg}Invitation-Command: INVITE\r\n"
      set msg "${msg}Invitation-Cookie: $cookie\r\n"
      set msg "${msg}Application-File: [file tail $filename]\r\n"
      set msg "${msg}Application-FileSize: $filesize\r\n\r\n"
      set msg [encoding convertto utf-8 $msg]
      set msg_len [string length $msg]

      ::MSN::WriteSBNoNL $sbn "MSG" "U $msg_len\r\n$msg"

      status_log "sentFTInvitation: Invitation to $filename sent: $msg\n" red

      #Change to allow multiple filetransfer
      #set filedata($cookie) [list $sbn "$filename" $filesize $cookie $ipaddr]
      set filedata($cookie) [list "$filename" $filesize $chatid [::MSN::usersInChat $chatid] "send" $ipaddr]
      after 300000 "::MSNFT::DeleteFT $cookie"

   }

    proc cancelFTInvitation { chatid cookie } {
	set sid [getObjOption $cookie msn6ftsid]
	if { $sid != "" } {
		::MSN6FT::CancelFT $chatid $sid
	} else {
	    rejectFT $chatid $cookie
	}
    }

   proc rejectedFT {chatid who cookie} {
      variable filedata

      if {![info exists filedata($cookie)]} {
         return
      }

      SendMessageFIFO [list ::amsn::rejectedFT $chatid $who [getFilename $cookie] ] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"

   }


   proc SendFile { cookie oldcookie} {
      #File transfer accepted by remote, send final ACK
      variable filedata

      status_log "Here in sendfile\n" red
      if {![info exists filedata($cookie)]} {
        return
      }

      status_log "File transfer ok, begin\n"

      set sbn [::MSN::SBFor [lindex $filedata($cookie) 2]]

      if { $sbn == 0 } {
         cancelFT $cookie
         return
      }

      #Invitation accepted, send IP and Port to connect to
      #option: possibility to enter IP address (firewalled connections)
      set ipaddr [lindex $filedata($cookie) 5]
      #if error ::AMSN::Error ...

		if {![string is digit [::config::getKey initialftport]] || [string length [::config::getKey initialftport]] == 0} {
			::config::setKey initialftport 6891
		}

      set port [::config::getKey initialftport]


      #Random authcookie
      set authcookie [expr {[clock clicks] % (65536 * 4)}]

      while {[catch {set sockid [socket -server "::MSNFT::AcceptConnection $cookie $authcookie" $port]} res]} {
         incr port
      }

      #TODO: More than one transfer? Don't create one listening socket for every person, just one for all,
      # but that makes the authcookie thing difficult...
      lappend filedata($oldcookie) $sockid
      after 300000 "catch {close $sockid}"

      set msg "MIME-Version: 1.0\r\nContent-Type: text/x-msmsgsinvite; charset=UTF-8\r\n\r\n"
      set msg "${msg}Invitation-Command: ACCEPT\r\n"
      set msg "${msg}Invitation-Cookie: $oldcookie\r\n"
      set msg "${msg}IP-Address: $ipaddr\r\n"
      set msg "${msg}Port: $port\r\n"
      set msg "${msg}AuthCookie: $authcookie\r\n"
      set msg "${msg}Launch-Application: FALSE\r\n"
      set msg "${msg}Request-Data: IP-Address:\r\n\r\n"
      set msg [encoding convertto utf-8 $msg]

      set msg_len [string length $msg]
      ::MSN::WriteSBNoNL $sbn "MSG" "U $msg_len\r\n$msg"

      ::amsn::FTProgress w $cookie [lindex $filedata($cookie) 0] $port

      status_log "Listening on port $port for incoming connections...\n" red

   }


   proc AcceptConnection {cookie authcookie sockid hostaddr hostport} {


      variable filedata

      if {![info exists filedata($cookie)]} {
        status_log "AcceptConnection: Ignoring file transfer, filedata($cookie) doesn't exists, cancelled\n" red
        return
      }

      lappend filedata($cookie) $sockid

      status_log "::MSNFT::AcceptConnection have connection from $hostaddr : $hostport\n" white

      fconfigure $sockid -blocking 0 -buffering none -translation {binary binary}
      fileevent $sockid readable "::MSNFT::FTSendNegotiation $sockid $cookie 0 $authcookie"

      ::amsn::FTProgress i $cookie [lindex $filedata($cookie) 0]

   }

   proc FTSendNegotiation { sockid cookie state {authcookie ""}} {
      variable filedata

      #puts "Here2 state=$state cookie=$cookie sockid=$sockid"

      if {![info exists filedata($cookie)]} {
        status_log "ConnectedMSNFTP: Ignoring file transfer, filedata($cookie) doesn't exists, cancelled\n" red
        return
      }


      if { [eof $sockid] } {
         status_log "FTSendNegotiation:: EOF\n" white
	 set filename [lindex $filedata($cookie) 0]
	 cancelFT $cookie
	 ::amsn::FTProgress l $cookie $filename
	 return
      }

      gets $sockid tmpdata
      status_log "FTNegotiation: I RECEIVE: $tmpdata\n"

      if { $tmpdata == "" } {

         update idletasks
         return
      }

      switch $state {
      	0 {
           if { [regexp "^VER\ ?\[0-9\]* MSNFTP" $tmpdata] } {
              catch {fileevent $sockid readable "::MSNFT::FTSendNegotiation $sockid $cookie 1 $authcookie"}
	      catch {puts $sockid "VER MSNFTP\r"}

              status_log "FTSendNegotiation: I SEND: VER MSNFTP\r\n"

	   } else {
	      status_log "FT failed in state 0\n" red
	      cancelFT $cookie
	   }

	}
      	1 {

           if {[string range $tmpdata 0 2] == "USR"} {
              set filename [lindex $filedata($cookie) 0]
              set filesize [lindex $filedata($cookie) 1]

	      #Comprobar authcookie y nombre de usuario

	      catch {fileevent $sockid readable "::MSNFT::FTSendNegotiation $sockid $cookie 2"}
	      catch {puts $sockid "FIL $filesize\r"}
	      status_log "SENT: FIL $filesize\n"


	   } else {
	      status_log "FT failed in state 1\n" red
	      cancelFT $cookie

	   }

	}
      	2 {

           if {[string range $tmpdata 0 2] == "TFR"} {
              set filename [lindex $filedata($cookie) 0]
              set filesize [lindex $filedata($cookie) 1]

              #Send the file
              #TODO, what if not exists?
              if {[catch {set fileid [open $filename r]} res]} {
	         return 0;
	      }
	      lappend filedata($cookie) $fileid

              fconfigure $fileid -translation {binary binary} -blocking 1
              status_log "Sending file $filename size $filesize\n"

              fconfigure $sockid -blocking 0 -buffering full -buffersize 16384
	      fileevent $sockid writable "::MSNFT::SendPacket $sockid $fileid $filesize $cookie"
              fileevent $sockid readable "::MSNFT::MonitorTransfer $sockid $cookie"


	   } else {
	      status_log "FT failed in state 2\n" red
	      cancelFT $cookie

	   }

	}
	default {
	   status_log "FTNegotiation: Unknown state!!!\n" white
	   cancelFT $cookie
	}
      }
   }


   proc SendPacket { sockid fileid filesize cookie } {
      variable filedata

#      puts "cookie=$cookie"
      if {![info exists filedata($cookie)]} {
        status_log "ConnectedMSNFTP: Ignoring file transfer, filedata($cookie) doesn't exists, cancelled\n" red
        return
      }

      #Send a packet for the file transfer
      fileevent $sockid writable ""

      set sentbytes [tell $fileid]

      set packetsize [expr {$filesize-$sentbytes}]
      if {$packetsize > 2045} {
         set packetsize 2045
      }


      if {$packetsize>0} {
         set data [read $fileid $packetsize]

         set byte1 [expr {$packetsize & 0xFF}]
         set byte2 [expr {$packetsize >> 8}]

	  catch {puts -nonewline $sockid "\0[format %c $byte1][format %c $byte2]$data" ; flush $sockid }
         set sentbytes [expr {$sentbytes + $packetsize}]
	 ::amsn::FTProgress s $cookie [lindex $filedata($cookie) 0] $sentbytes $filesize
         fileevent $sockid writable "::MSNFT::SendPacket $sockid $fileid $filesize $cookie"

      }


   }

   proc MonitorTransfer { sockid cookie} {

      #puts "Monitortransfer"
      variable filedata

      if {![info exists filedata($cookie)]} {
        status_log "::MSNFT::MonitorTransfer:  Ignoring file transfer, filedata($cookie) doesn't exists, cancelled\n" red
        return
      }

      if { [eof $sockid] } {
         status_log "MonitorTransfer EOF\n" white
	 cancelFT $cookie
	 return
      }

      fileevent $sockid readable ""

      #Monitor messages from the receiving host in a file transfer
      catch {fconfigure $sockid -blocking 1}
      if {[catch {gets $sockid datos} res]} {
         status_log "::MSNFT::MonitorTransfer: Transfer failed: $res\n"
	 cancelFT $cookie
         return
      }

      status_log "Got from remote side: $datos\n"
      if {[string range $datos 0 2] == "CCL"} {
         status_log "::MSNFT::MonitorTransfer: Connection cancelled\n"
	 cancelFT $cookie
         return
      }

      if {[string range $datos 0 2] == "BYE"} {
         status_log "::MSNFT::MonitorTransfer: Connection finished\n"
         ::amsn::FTProgress fs $cookie [lindex $filedata($cookie) 0]
	 FinishedFT $cookie
         return
      }

      cancelFT $cookie


   }


}

namespace eval ::MSN {

   #TODO: Export missing procedures (the one whose starts with lowercase)
   namespace export changeName logout changeStatus connect blockUser \
   unblockUser addUser deleteUser login myStatusIs \
   cancelReceiving cancelSending moveUser

	if { $initialize_amsn == 1 } {
		#Forward list
		variable list_FL [list]
		#Reverse List
		variable list_RL [list]
		#Accept List
		variable list_AL [list]
		#Block list
		variable list_BL [list]
		#Pending list (MSNP11)
		variable list_PL [list]

		variable myStatus FLN
		#Double array containing:
		# CODE NAME COLOR ONLINE/OFFLINE  SMALLIMAGE BIGIMAGE
		variable list_states {
			{NLN online #0000A0 online online bonline}
			{IDL noactivity #008000 online away baway}
			{BRB rightback #008080 online away baway}
			{PHN onphone #008080 online busy bbusy}
			{BSY busy #800000 online busy bbusy}
			{AWY away #008000 online away baway}
			{LUN gonelunch #008000 online away baway}
			{HDN appearoff #404040 offline offline boffline}
			{FLN offline #404040 offline offline boffline}
		}
	}


	proc reconnect { error_msg } {
		cmsn_draw_reconnect $error_msg
		after 5000 ::MSN::connect

	}

	proc cancelReconnect { } {

		after cancel ::MSN::connect
		catch { unset ::oldstatus }