proxy.tcl

Linux下的MSN聊天程序源码

# proxy.tcl --
#
#	This file defines various procedures which implement a
#	Proxy access system. Code originally by Dave Mifsud,
#	converted to namespace and improved by D. Emilio Grimaldo T.
#	SOCKS5 support (integration) is experimental!!!
#
# RCS: @(#) $Id: proxy.tcl 6757 2006-05-29 20:18:59Z kakaroto $

package provide Proxy 0.1
package require http

# This should be converted to a proper package, to use with package require
source socks.tcl	;# SOCKS5 proxy support

#the framework for connections. You create an instance of this object only,
#never the other proxy objects directly

proc globalGotNexusReply { proxy token {total 0} {current 0} } {
	if {![catch {$proxy cget -name}]} {
		$proxy GotNexusReply $token $total $current
	} else {
		::http::cleanup $token
	}
}

proc globalGotAuthReply { proxy str token } {
	if {![catch {$proxy cget -name}]} {
		$proxy GotAuthReply $str $token
	} else {
		::http::cleanup $token
	}
}

proc globalWrite { proxy name {msg ""} } {
	if {![catch {$proxy cget -name}]} {
		$proxy write $name $msg
	}
}

#The only way to get HTTP proxy + SSL to work...
#http://wiki.tcl.tk/2627
#helped by patthoyts autoproxy!
proc secureSocket { args } {
	set phost [::http::config -proxyhost]
	set pport [::http::config -proxyport]
	upvar host thost
	upvar port tport

	# if a proxy has been configured
	if {[string length $phost] && [string length $pport]} {
		#TODO: make async: set socket [socket -async $phost $pport]
		# create the socket to the proxy
		set socket [socket -async $phost $pport]
		fconfigure $socket -buffering line -translation crlf
		puts $socket "CONNECT $thost:$tport HTTP/1.0"
        	puts $socket "Host: $thost"
	        puts $socket "User-Agent: [http::config -useragent]"
		puts $socket "Content-Length: 0"
	        puts $socket "Proxy-Connection: Keep-Alive"
	        puts $socket "Connection: Keep-Alive"
		puts $socket "Pragma: no-cache"
		if { [::config::getKey proxyauthenticate] } {
			set proxy_user [::config::getKey proxyuser]
			set proxy_pass [::config::getKey proxypass]
			puts $socket "Proxy-Authorization: Basic [base64::encode ${proxy_user}:${proxy_pass}]"
		}
		puts $socket ""
		#flush $socket

		set reply ""
		while {[gets $socket r] > 0} {
			lappend reply $r
		}

		set result [lindex $reply 0]
		set code [lindex [split $result { }] 1]

		# be sure there's a valid response code
		# We use a regexp because of some (or maybe only one) proxy returning "HTTP/1.0