[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.
   * -proxy url - your local web proxy url eg: http://wwwcache:8080
   * -local interface:port - the port to run this tunnel on eg: localhost:8081
   * -target url - the tunnel's remote endpoint eg: http://max.tclers.tk:443
If the target is actually using SSL then you should
specify a scheme of ''https''. If it is just unencrypted on a SSL port number
then give the scheme as ''http''.
----
[PT] 11-Aug-2003:  As a useful example
using this tunnel, we can now access the [SourceForge] CVS from behind our
restrictive firewalls. Sourceforge provides a pair of servers designed to help
people behind firewalls access CVS using either pserver or ssh. These are
''cvs-pserver.sourceforge.net'' and ''cvs-ssh.sourceforge.net''.  Now to access
these services from behind our authenticating proxy needs a proxy aware tunnel
like the one below.  If we first setup our authentication environment -- the
variables ''http_proxy'', ''http_proxy_user'' and ''http_proxy_pass'' need to be setup
properly (if you don't have to provide authentication then you can just set the
''http_proxy'' variable). Then fire up the tunnel:
   tclsh tlspipe.tcl -proxy http://webproxy:80 -local localhost:22 -target http://cvs-ssh.sourceforge.net:443
Now we have a tunnel the will connect our
local ssh port to the one at sourceforge through the web proxy. Don't believe
me? Then (assuming you have CVS_RSH=ssh) do
 cvs -d:ext:yoursfuserid@localhost:/cvsroot/tcl co -c
If you are a windows user,
then I imagine you've been using PuTTY so set CVS_RSH=plink, PLINK_PROTOCOL=ssh
and then do
 plink -ssh sfuserid@localhost id
and answer 'y' at the prompt so
that you have logged the SF server key id. Now you too can use the above cvs
commands.  Note that if you already have a CVS checkout that was done using a
normal internet connection (for instance, done on a laptop  from home) then
using cvs -d as above will not change the recorded repository location for any
currently checked out directories. So once you get back home you can use cvs
update as before. Any newly created directories will record the -d options
though and you may need to edit the CVS/Root file for those directories.  If you
are trying to use '''pserver''' access then the following might help:
 tclsh tlspipe.tcl -target http://cvs-pserver.sourceforge.net:443 \
    -local localhost:2401 > log 2>&1 &
 cvs -d:pserver:anonymous@localhost:/cvsroot/tcl login
 ...etc...
----
 # tlspipe.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
 #
 # Test sampler to check the usage for opening a SSL link through an
 # authenticating HTTP proxy server.
 #
 # $Id: 9411,v 1.14 2005-05-17 06:00:20 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    http://max.tclers.tk:443
             serverAddr   127.0.0.1
             serverPort   8080
             proxyHost    {}
             proxyPort    {}
             proxyAuth    {}
             proxyUser    {}
             proxyPass    {}
             buffering    none
             translation  binary
         }
         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"
     }
 
     variable NonPrinting
     if {![info exists NonPrinting]} {
         for {set n 0} {$n < 256} {incr n} {
             if {$n < 32 || $n > 127} {
                 append NonPrinting [format "\\x%x . " $n]
             }
         }
     }
 
 }
 
 proc tlspipe::Log {msg} {
     puts stderr $msg
 }
 
 proc tlspipe::Accept {chan clientAddr clientPort} {
     variable opts
     variable uid
     Log "connect from $clientAddr:$clientPort"
     if {$opts(proxyHost) != {}} {
         Log "connected via $opts(proxyHost)"
         set tok [Open $opts(targetUrl)]
         upvar 0 $tok state
         Log "waiting for tls connect"
         Wait $tok
     } else {
         Log "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) [expr {$URL(scheme) == "https" ? 443 : 80}]
         }
 
         set state(sock) [socket $URL(host) $URL(port)]
         if {$URL(scheme) == "https"} {
             ::tls::import $state(sock)
         }
         fconfigure $state(sock) \
             -buffering $opts(buffering) -translation $opts(translation)
         set state(status) "ssl"
     }
     set state(connectTime) [clock seconds]
     Log "tunnel $tok created"
     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 $opts(translation)
     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
     variable NonPrinting
 
     if {[eof $source]} {
         set msg "eof on $source"
         set status 1
     } else {
         set status [catch {
             set data [read $source]
             puts -nonewline $target $data
             set pdata [string map $NonPrinting $data]
             Log "$source->$target [string length $data] bytes {$pdata}"
         } msg]
     }
 
     if {$status != 0} {
         close $source
         catch {close $target}
         Finish $token $msg
         if {[info exists state(error)]} {
             Log $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 -translation crlf
     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) [expr {$URL(scheme) == "https" ? 443 : 80}]
         }
 
         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]
     Log "shutdown $token  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 opts
     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] " "]
             Log "CONNECT: << $block >>"
 
             if {![string match "2*" [lindex $reply 1]]} {
                 Log "CONNECT failed."
             }
 
             # Configure the channel for the tunnel comms.
             fconfigure $state(sock) \
                 -buffering $opts(buffering) \
                 -translation $opts(translation)
 
             array set URL [uri::split $state(url)]
             if {$URL(scheme) == "https"} {
                 # Now we upgrade the link to SSL.
                 if {[catch {::tls::import $state(sock)} msg]} {
                     Log "connect error: $msg"
                 }
             }
 
             # Now we are talking through the proxy to the remote site.
             fileevent $state(sock) readable {}
 
             # Signal our SSL connection
             set state(status) ssl
         }
     }
     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"} {
             Log "waiting: status currently $state(status)"
             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]
             }
             -translation {
                 set opts(translation) [Pop args 1]
             }
             --   { Pop args ; break }
             default {
                 return -code error "invalid option \"$option\":\
                        must be one of -buffering, -proxy, -target or -local"
             }
         }
         Pop args
     }
 
     Log "Config: [array get opts]"
     set server [socket -server [namespace origin Accept] \
                     -myaddr $opts(serverAddr) $opts(serverPort)]
     Log "listening on [fconfigure $server -sockname]"
 
     vwait ::forever
 
     close $server
 }
 
 if {!$::tcl_interactive} {
     eval [list ::tlspipe::Main] $argv
 }
----
See also [tls], [tunnel]

[[ [Category Internet] | [Category Security] ]]