[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
   * -target url - the tunnel's remote endpoint eg: https://max.tclers.tk:443
   * -local interface:port - the port to run this tunnel on eg: localhost:8081

 # 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.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
 }

----

See also [tls], [tunnel]

[[[Category Internet] | ]]