PT 20-Jul-2003: I've been working a little with SSL links through our authenticating proxy server. The current http package needs a bit of help to get this working. To illustrate here is a script that provides a SSL pipe through such a proxy.
If you need to provide authentication, then this script supports Basic authentication. You'll need to set the http_proxy environment variable to your proxy (eg: http://myproxy:80/ ) and the http_proxy_user to your local user is (in a NT domain thats DOMAIN\username) and set http_proxy_pass to your password.
You can also specify hosts and ports in the command line.
# tlspipe.tcl - Copyright (C) 2003 Pat Thoyts <[email protected]> # # Test sampler to check the usage for opening a SSL link through an # authenticating HTTP proxy server. # # $Id: 9411,v 1.1 2003-07-22 08:00:41 jcw Exp $ package require tls 1.4; # http://tls.sf.net/ package require http 2; # http://tcl.sf.net/ package require uri 1; # http://tcllib.sf.net/ package require base64; # http://tcllib.sf.net/ namespace eval tlspipe { variable uid if {![info exists uid]} {set uid 0} variable opts if {![info exists opts]} { array set opts { targetUrl https://rucus.zanet.net:443 serverAddr 127.0.0.1 serverPort 6667 proxyHost {} proxyPort {} proxyAuth {} proxyUser {} proxyPass {} buffering none } if {[info exists ::env(http_proxy)]} { if {![catch {array set URL [uri::split $::env(http_proxy)]}]} { set opts(proxyHost) $URL(host) set opts(proxyPort) $URL(port) unset URL } if {[info exists ::env(http_proxy_user)]} { set opts(proxyUser) $::env(http_proxy_user) } if {[info exists ::env(http_proxy_pass)]} { set opts(proxyPass) $::env(http_proxy_pass) } } set opts(userAgent) "Mozilla/4.0\ ([string totitle $::tcl_platform(platform)];\ $::tcl_platform(os)) http/[package provide http]\ tlspipe/1.0" } } proc tlspipe::Accept {chan clientAddr clientPort} { variable opts variable uid puts stderr "connect from $clientAddr:$clientPort" if {$opts(proxyHost) != {}} { puts stderr "connected via $opts(proxyHost)" set tok [Open $opts(targetUrl)] upvar 0 $tok state puts stderr "waiting for tls connect" Wait $tok } else { puts stderr "direct connection" set tok [namespace current]::[incr uid] variable $tok upvar 0 $tok state array set URL [uri::split $opts(targetUrl)] if {$URL(port) == {}} { set URL(port) 443 } set state(sock) [::tls::socket $URL(host) $URL(port)] set state(status) "ssl" } set state(connectTime) [clock seconds] puts stderr "status: $state(status)" #if {$state(status) == "ssl"} {} puts stderr "piping" if {[info exists state(after)]} { after cancel $state(after) unset state(after) } set state(client) $chan fconfigure $state(client) \ -blocking 0 -buffering $opts(buffering) -translation binary fconfigure $state(sock) \ -blocking 0 -buffering $opts(buffering) -translation binary fileevent $chan readable \ [list [namespace origin Fcopy] $tok $chan $state(sock)] fileevent $state(sock) readable \ [list [namespace origin Fcopy] $tok $state(sock) $chan] return } proc tlspipe::Fcopy {token source target} { upvar 0 $token state if {[eof $source]} { set status 1 } else { set status [catch { set data [read $source] puts -nonewline $target $data puts stderr "$source->$target [string length $data] bytes {$data}" } msg] } if {$status != 0} { puts stderr "closing sockets" close $source catch {close $target} Finish $token "connection closed" if {[info exists state(error)]} { puts stderr $state(error) } } return } proc tlspipe::Open {url} { variable uid variable opts set tok [namespace current]::[incr uid] variable $tok upvar 0 $tok state set state(sock) [socket $opts(proxyHost) $opts(proxyPort)] fconfigure $state(sock) -blocking 0 -buffering line set state(after) [after 30000 \ [list [namespace origin Finish] $tok timeout]] set state(url) $url set state(status) unconnected set state(body) {} fileevent $state(sock) writable [list [namespace origin Connect] $tok] fileevent $state(sock) readable [list [namespace origin Link] $tok] return $tok } # At this point we have an open HTTP connection to the proxy server. # We now ask it to make a connection for us. proc tlspipe::Connect {token} { variable $token variable opts upvar 0 $token state if {[eof $state(sock)]} { Finish $token "error during connect" } else { set state(status) connect fileevent $state(sock) writable {} array set URL [uri::split $state(url)] if {$URL(port) == {}} { set URL(port) 443 } puts $state(sock) "CONNECT $URL(host):$URL(port) HTTP/1.1" puts $state(sock) "Host: $URL(host)" puts $state(sock) "User-Agent: $opts(userAgent)" puts $state(sock) "Proxy-Connection: keep-alive" puts $state(sock) "Connection: keep-alive" if {$opts(proxyUser) != {} && $opts(proxyPass) != {}} { set auth "Proxy-Authorization: Basic\ [base64::encode $opts(proxyUser):$opts(proxyPass)]" puts $state(sock) $auth } puts $state(sock) "" } return } proc tlspipe::Finish {token {err {}}} { variable opts variable $token upvar 0 $token state set state(disconnectTime) [clock seconds] puts stderr "duration: [expr {$state(disconnectTime) - $state(connectTime)}]s" catch {close $state(sock)} catch {after cancel $state(after)} if {$err != {}} { set state(error) $err set state(status) error } else { set state(ok) } return } proc tlspipe::Link {token} { variable $token upvar 0 $token state if {[eof $state(sock)]} { Finish $token "connection closed" return } switch -exact -- $state(status) { connect { # At this point our proxy has opened up a link to the # remote site. Lets read the result. # FIX ME: we should check for failure here. set block [read $state(sock)] set reply [split [lindex [split $block \n] 0] " "] puts stderr "CONNECT: << $block >>" if {![string match "2*" [lindex $reply 1]]} { puts stderr "CONNECT failed." } # Now we upgrade the link to SSL. ::tls::import $state(sock) set state(status) ssl # Now we are talking through the proxy to the remote site. fileevent $state(sock) readable {} } } return } proc tlspipe::Wait {token} { variable $token upvar 0 $token state # watch it: we have to wait on the real name of this variable if {[info exists $state(status)]} { while {$state(status) == "unconnected" \ || $state(status) == "connect"} { vwait "$token\(status\)" } } } # ------------------------------------------------------------------------- # Description: # Pop the nth element off a list. Used in options processing. # proc ::tlspipe::Pop {varname {nth 0}} { upvar $varname args set r [lindex $args $nth] set args [lreplace $args $nth $nth] return $r } proc ::tlspipe::Main {args} { # Create a server socket variable opts # Process the command line arguments while {[string match -* [set option [lindex $args 0]]]} { switch -exact -- $option { -proxy { # eg: -proxy http://wwwcache:8080 array set URL [uri::split [Pop args 1]] if {$URL(port) == {}} { set URL(port) 80 } set opts(proxyHost) $URL(host) set opts(proxyPort) $URL(port) } -target { # eg: -target https://max.tclers.tk:443 set opts(targetUrl) [Pop args 1] } -local { # eg: -local 127.0.0.1:8080 foreach {if port} [split [Pop args 1] :] {} if {$if != {}} { set opts(serverAddr) $if } if {$port != {}} { set opts(serverPort) $port } } -buffering { set opts(buffering) [Pop args 1] } -- { Pop args ; break } default { return -code error "invalid option \"$option\":\ must be one of -buffering, -proxy, -target or -local" } } Pop args } puts stderr "Config: [array get opts]" set server [socket -server [namespace origin Accept] \ -myaddr $opts(serverAddr) $opts(serverPort)] puts stderr "listening on [fconfigure $server -sockname]" vwait ::forever } if {!$::tcl_interactive} { eval [list ::tlspipe::Main] $argv }
[Category Internet | ]