Version 1 of autoproxy

Updated 2002-02-27 15:17:50

Supporting proxies with the http package is tedious and error prone and has to be done for each application in turn. I've done a few of these and finally decided this can be done by an external package.

Here is the first draft. I'll add in the handling for proxy authentication soon.

To use this:

  package require http
  package require autoproxy
  autoproxy::init

---

 # autoproxy.tcl - Copyright (C) 2002 Pat Thoyts <[email protected]>
 #
 # On Unix an emerging standard for identifying the local HTTP proxy server
 # seems to be to use the environment variable http_proxy or ftp_proxy and
 # no_proxy to list those domains to be excluded from proxying.
 #
 # On Windows we can retrieve the Internet Settings values from the registry
 # to obtain pretty much the same information.
 #
 # With this information we can setup a suitable filter procedure for the 
 # Tcl http package and arrange for automatic use of the proxy.
 #
 # @(#)$Id: 2879,v 1.2 2002-06-21 04:29:26 jcw Exp $

 namespace eval autoproxy {
     variable proxy
     variable no_proxy {}

     array set proxy {host "" port 80}

     variable winregkey
     set winregkey [join {
         HKEY_CURRENT_USER
         Software Microsoft Windows
         CurrentVersion "Internet Settings"
     } \\]
 }

 proc autoproxy::init {} {
     package require uri
     global tcl_platform
     global env
     variable winregkey
     variable proxy
     variable no_proxy
     set httpproxy {}

     # Look for environment variables.
     if {[info exists env(http_proxy)]} {
         set httpproxy $env(http_proxy)
         set no_proxy $env(no_proxy)
     } else {
         puts "a"
         if {$tcl_platform(platform) == "windows"} {
             puts "b"
             package require registry 1.0

             if {[registry get $winregkey "ProxyEnable"]} {
                 set httpproxy [registry get $winregkey "ProxyServer"]
                 set no_proxy [registry get $winregkey "ProxyOverride"]
             }
         }
     }

     # If we found something ...
     if {$httpproxy != {}} {
         # The http_proxy is supposed to be a URL - lets make sure.
         if {![regexp {\w://.*} $httpproxy]} {
             set httpproxy "http://$httpproxy"
         }

         # decompose the string.
         array set proxy [uri::split $httpproxy]

         # turn the no_proxy value into a tcl list
         set no_proxy [string map {; " " , " "} $no_proxy]

         # setup the http package
         package require http
         http::config -proxyfilter [namespace origin filter]
     }
 }

 proc autoproxy::filter {host} {
     variable proxy
     variable no_proxy

     if {$proxy(host) == {}} {
         return {}
     }

     foreach domain $no_proxy {
         if {[string match $domain $host]} {
             return {}
         }
     }
     return [list $proxy(host) $proxy(port)]
 }

 package provide autoproxy 1.0

 #
 # Local variables:
 #   mode: tcl
 #   indent-tabs-mode: nil
 # End:

---

The filter can be changed to automagically add a proxy authorization header. Just remember to set autoproxy::user and autouser::password before the first http::geturl command.

 proc autoproxy::filter {host} {
     variable user
     variable password
     variable proxy
     variable no_proxy

     if {$proxy(host) == {}} {
         return {}
     }

     foreach domain $no_proxy {
         if {[string match $domain $host]} {
             return {}
         }
     }

     # add proxy authorization header
     upvar state _stat
     array set s $_stat(-headers)
     set s(Proxy-Authorization) [concat Base [base64::encode  $user:$password]]
     set _stat(-headers) [array get s]

     return [list $proxy(host) $proxy(port)]
 }

---

Category Package