[...]
Tunnelling solutions commonly used outside the Tcl world include SSH port forwarding, Zebedee, Stunnel [L1 ], ...
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.
It's complete but needs polishing up with command line arg handling etc. Edit to script to suit for now:
# tlsconn.tcl - Copyright (C) 2003 Pat Thoyts <[email protected]> # # Test sampler to check the usage for opening a SSL link through a # HTTP proxy server. # # $Id: 4096,v 1.3 2003-07-21 08:00:19 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 {} } 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)] \ && [info exists ::env(http_proxy_pass)]} { set opts(proxyAuth) "Proxy-Authorization: Basic\ [base64::encode $env(http_proxy_user):$::env(http_proxy_pass)]" } } puts stderr "<< [array get opts] >>" } } proc tlspipe::Accept {chan clientAddr clientPort} { variable opts variable uid puts stderr "connect from $clientAddr:$clientPort" if {$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 $state(url)] if {$URL(port) == {}} { set URL(port) 443 } set state(sock) [::tls::socket $URL(host) $URL(port)] set state(status) "ssl" } if {$state(status) == "ssl"} { puts stderr "piping" set state(client) $chan 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] || [eof $target]} { close $source close $target Finish $token "connection closed" if {[info exists state(error)]} { puts stderr $state(error) } } fcopy $source $target } 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: [http::config -useragent]" puts $state(sock) "Proxy-Connection: keep-alive" if {$opts(proxyAuth) != {}} { puts $state(sock) $opts(proxyAuth) } puts $state(sock) "" } return } proc tlspipe::Finish {token {err {}}} { variable $token upvar 0 $token state 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)] puts stderr "CONNECT: << $block >>" # 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\)" } } } proc tlspipe::Main {args} { # Create a server socket variable 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 | ]