Version 28 of autoproxy

Updated 2011-02-15 18:58:03 by AKgnome

The autoproxy package, part of Tcllib, attempts to automate the use of HTTP proxy servers in Tcl HTTP client code, notably in the http package. It tries to initialize the web access settings from system standard locations and can be configured to negotiate authentication with the proxy if required.


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 second draft.

To use this:

  package require autoproxy
  autoproxy::init
  autoproxy::configure -basic -user luser -pass sEkRet
  set tok [http::geturl http://somewhere.onthe.net/tcl/autoproxy]
  http::data $tok
  http::cleanup $tok

I've incorporated Pat Thoyts' code in a project, and it works like a charm. The only small issue being that ProxyOverride apparently does not always exist (according to one problem report I received). - jcw

11dec02 jcw - Another problem is that ProxyEnable may exist, but not be a valid boolean.

PT 21Jan03: Wow - This is included in the kitten starkit! This has motivated me to revisit this code, tidy it up, and turn it into a proper package. I've also taken on board Anders comments from below - although the real point of the autoproxy package is to try to pick up the proxy and user settings automatically.

Should this end up in tcllib?


Automagic proxy authorization header by Anders Ramdahl

The filter is easily changed to automagically add a proxy authorization header when needed. Remember to set autoproxy::user and autoproxy::password before the first http::geturl call.

 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 _state
     array set h $_state(-headers)
     set h(Proxy-Authorization) [concat Base [base64::encode $user:$password]]
     set _state(-headers) [array get h]

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

This will fail if autoproxy::user or autoproxy::password is not set. I should probably add a catch statement somewhere.


 # 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 set up a suitable filter procedure for the
 # Tcl http package and arrange for automatic use of the proxy.
 #
 # Example:
 #   package require autoproxy
 #   autoproxy::init
 #   autoproxy::configure basic; # enter values in dialog
 #   set tok [http::geturl http://wiki.tcl.tk/]
 #   http::data $tok
 #
 # There is a skeleton for supporting Digest or NTLM authorisation but
 # this is not currently supported. I can't find a proxy to test Digest
 # on and we don't yet have a Tcl implementation for NTLM.
 #
 # @(#)$Id: 2879,v 1.19 2005-03-18 07:00:23 jcw Exp $

 namespace eval autoproxy {
     variable rcsid {$Id: 2879,v 1.19 2005-03-18 07:00:23 jcw Exp $}
     variable version 1.1
     variable options

     if {! [info exists options]} {
         array set options {
             proxy_host ""
             proxy_port 80
             no_proxy   {}
             basic      {}
             digest     {}
             ntlm       {}
         }
     }

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

 # -------------------------------------------------------------------------
 # Description:
 #   Obtain configuration options for the server.
 #
 proc autoproxy::cget {option} {
     variable options
     switch -glob -- $option] {
         -ho* -
         -proxy_h* {set options(proxy_host)}
         -po* -
         -proxy_p* {set options(proxy_port)}
         -no* { set options(no_proxy) }
         -b*  { set options(basic) }
         -d*  { set options(digest) }
         -nt* { set options(ntlm) }
         default {
             set err [join [lsort [array names options]] ", -"]
             return -code error "bad option \"[lindex $args 0]\":\
                        must be one of -$options"
         }
     }
 }

 # -------------------------------------------------------------------------
 # Description:
 #  Configure the autoproxy package settings.
 #  You may only configure one type of authorisation at a time as once we hit
 #  -basic, -digest or -ntlm - all further args are passed to the protocol
 #  specific script.
 #
 #  Of course, most of the point of this package is to fill as many of these
 #  fields as possible automatically. You should call autoproxy::init to
 #  do automatic configuration and then call this method to refine the details.
 #
 proc autoproxy::configure {args} {
     variable options

     if {[llength $args] == 0} {
         foreach {opt value} [array get options] {
             lappend r -$opt $value
         }
         return $r
     }

     while {[string match "-*" [lindex $args 0]]} {
         switch -glob -- [lindex $args 0] {
             -ho* -
             -proxy_h* {set options(proxy_host) [Pop args 1]}
             -po* -
             -proxy_p* {set options(proxy_port) [Pop args 1]}
             -no* { set options(no_proxy) [Pop args 1] }
             -b*  { Pop args; configure:basic $args ; break }
             -d*  { Pop args; configure:digest $args ; break }
             -nt* { Pop args; configure:ntlm $args ; break }
             --   { Pop args; break }
             default {
                 set err [join [lsort [array names options]] ", -"]
                 return -code error "bad option \"[lindex $args 0]\":\
                        must be one of -$options"
             }
         }
         Pop args
     }
 }

 # -------------------------------------------------------------------------
 # Description:
 #  Initialize the http proxy information from the environment or the
 #  registry (Win32)
 #
 #  This procedure will load the http package and re-writes the
 #  http::geturl method to add in the authorization header.
 #
 #  A better solution will be to arrange for the http package to request the
 #  authorization key on receiving an authorization request.
 #
 proc autoproxy::init {} {
     package require uri
     global tcl_platform
     global env
     variable winregkey
     variable options
     set 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 {
         if {$tcl_platform(platform) == "windows"} {
             package require registry 1.0
             array set reg {ProxyEnable 0 ProxyServer "" ProxyOverride {}}
             catch {
                 set reg(ProxyEnable) [registry get $winregkey "ProxyEnable"]
                 set reg(ProxyServer) [registry get $winregkey "ProxyServer"]
                 set reg(ProxyOverride) [registry get $winregkey "ProxyOverride"]
             }
             if {![string is bool $reg(ProxyEnable)]} {
                 set reg(ProxyEnable) 0
             }
             if {$reg(ProxyEnable)} {
                 set httpproxy $reg(ProxyServer)
                 set no_proxy  $reg(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]

         # configure ourselves
         configure -proxy_host $proxy(host) \
             -proxy_port $proxy(port) \
             -no_proxy $no_proxy

         # setup and configure the http package
         package require http 2.0
         http::config -proxyfilter [namespace origin filter]
     }
     return $httpproxy
 }

 # -------------------------------------------------------------------------
 # Description:
 #  Pop the nth element off a list. Used in options processing.
 proc autoproxy::Pop {varname {nth 0}} {
     upvar $varname args
     set r [lindex $args $nth]
     set args [lreplace $args $nth $nth]
     return $r
 }

 # -------------------------------------------------------------------------

 # Description:
 #  Implement support for the Basic authentication scheme (RFC 2617).
 # Options:
 #  -user userid  - pass in the user ID (May require Windows NT domain
 #                  as DOMAIN\\username)
 #  -password pwd - pass in the user's password.
 #
 proc autoproxy::configure:basic {arglist} {
     variable options
     array set opts {user {} passwd {}}
     foreach {opt value} $arglist {
         switch -glob -- $opt {
             -u* { set opts(user) $value }
             -p* { set opts(passwd) $value }
             default {
                 return -code error "invalid option \"$opt\": must be one of\
                      -username or -password"
             }
         }
     }

     # If nothing was provided, assume they want an interactive prompt.
     if {$opts(user) == {} || $opts(passwd) == {}} {
         package require BWidget
         set r [PasswdDlg .d -logintext $opts(user) -passwdtext $opts(passwd)]
         set opts(user) [lindex $r 0]
         set opts(passwd) [lindex $r 1]
     }

     # Note: we only store the 'encoded' password. Avoid keeping plaintext.
     package require base64
     set options(basic) [list "Proxy-Authorization" \
                             [concat "Basic" \
                                  [base64::encode $opts(user):$opts(passwd)]]]
 }

 # -------------------------------------------------------------------------

 # Description:
 #  Implement support for the Digest authentication scheme (RFC nnnn).
 # Options:
 #  -user userid  - pass in the user ID (May require Windows NT domain
 #                  as DOMAIN\\username)
 #  -password pwd - pass in the user's password.
 #  -realm domain - the authorization realm
 #
 proc autoproxy::configure:digest {arglist} {
     variable options
     array set opts {user {} passwd {} realm {}}
     foreach {opt value} $arglist {
         switch -glob -- $opt {
             -u* { set opts(user)   $value }
             -p* { set opts(passwd) $value }
             -r* { set opts(realm)  $value }
             default {
                 return -code error "invalid option \"$opt\": must be one of\
                      -username, -realm or -password"
             }
         }
     }

     # If nothing was provided, assume they want an interactive prompt.
     if {$opts(user) == {} || $opts(passwd) == {}} {
         package require BWidget
         set r [PasswdDlg .d -title "Realm $opts(realm)" \
                    -logintext $opts(user) \
                    -passwdtext $opts(passwd)]
         set opts(user) [lindex $r 0]
         set opts(passwd) [lindex $r 1]
     }

     # Note: we only store the MD5 checksum of the password.
     package require md5
     set A1 [md5::md5 "$opts(user):$opts(realm):$opts(passwd)"]
     set options(digest) [list $opts(user) $opts(realm) $A1]
     return
 }

 # -------------------------------------------------------------------------
 # Description:
 #  Suport Microsoft's NTLM scheme
 #  Not done as yet.
 #
 proc autoproxy::configure:ntlm {arglist} {
     variable options
     return -code error "NTLM authorization is not available"
 }

 # -------------------------------------------------------------------------
 # Description:
 #  An http package proxy filter. This attempts to work out is a request
 #  should go via the configured proxy using a glob comparison against the
 #  no_proxy list items. A typical no_proxy list might be
 #   [list localhost *.my.domain.com 127.0.0.1]
 #
 # If we are going to use the proxy - then insert the proxy authorization
 # header.
 #
 proc autoproxy::filter {host} {
     variable options

     if {$options(proxy_host) == {}} {
         return {}
     }

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

     # Add authorization header to the request (by Anders Ramdahl)
     upvar state State
     if {$options(basic) != {}} {
         set State(-headers) [concat $options(basic) $State(-headers)]
     } elseif {$options(digest) != {}} {
         # FIX ME there is more to Digest than this
         #set State(-headers) [linsert $State(-headers) 0 $options(digest)]
     }

     return [list $options(proxy_host) $options(proxy_port)]
 }

 # -------------------------------------------------------------------------

 package provide autoproxy $autoproxy::version

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

2003-11-17 Michael Heca

Register key ProxyServer can hold list of proxy separated by semicolon and prefixed by protocol=.

                    if { [string first ";" $reg(ProxyServer)] == -1 } {
                        set httpproxy $reg(ProxyServer)
                    } else {
                        foreach tmp [split $reg(ProxyServer) ";"] {
                            if { [string match "http=*" $tmp] } {
                                set httpproxy [string range $tmp 5 end]
                                break
                            }
                        }
                        unset tmp
                    }

2005-02-08 Steve Blinkhorn

Proxy allocation on Windows, particularly inside large corporate intranets, turns out to be a rather more complex affair than autoproxy currently caters for. Explicit naming of proxies in the registry is one way of course. But increasingly I am coming across the use of proxy allocation scripts. These are in JavaScript, and may either be explicitly given as a URL as the value of AutoProxyURL in the Internet Settings section of the registry, or have to be discovered using the wpad protocol [L1 ]. All versions of Win32 since '95 appear to have wininet.dll as a means of discovery using the wpad protocol, and jsproxy.dll for interrogating the JavaScript to discover the appropriate proxy for a given URL. I am currently working with a dll caller (Yet another dll caller) extension to try to wrestle this one to the ground, but can only test inside organizations I currently have access to, for obvious reasons.

If there are people out there whose Internet options in IE are normally set to use a script or to automatically discover a proxy server, they are probably working inside such an intranet. I would be happy to share my code with them for testing purposes for the greater good of the community. In particular, some intranets seem to be set up to (and Norton's security software seems to default to) trap attempts to interrogate DNS, and perhaps even automatically shut down programs that do so without explicit authorization, which makes use of one variety of wpad interrogation inherently problematic. It strikes me that this is a barrier to the penetration of Tcl/Tk web-enabled applications that it may be possible to overcome soon.


Category Package, a subset of Tcllib Category Internet