Tcl Library Source Code

[section {TLS Security Considerations}]
[include tls-security-text.inc]

[para] This package uses the [package TLS] package to handle the
security for [const https] urls and other socket connections.

[para] Policy decisions like the set of protocols to support and what
ciphers to use are not the responsibility of [package TLS], nor of
this package itself however.

Such decisions are the responsibility of whichever application is
using the package, and are likely influenced by the set of servers
the application will talk to as well.

[para] For example, in light of the recent
[uri http://googleonlinesecurity.blogspot.co.uk/2014/10/this-poodle-bites-exploiting-ssl-30.html \
{POODLE attack}] discovered by Google many servers will disable support
for the SSLv3 protocol.

To handle this change the applications using [package TLS] must be
patched, and not this package, nor [package TLS] itself.

Such a patch may be as simple as generally activating [const tls1]
support, as shown in the example below.

[example {
    package require tls
    tls::init -tls1 1 ;# forcibly activate support for the TLS1 protocol

    ... your own application code ...
}]

[section {TLS Security Considerations}]

[para][emph Note] This section only applies if TLS support is provided
by the [package TLS] package.

It does not apply when [package autoproxy] was configured to use some
other package which can provide the same (i.e [package twapi]), via
the [option -tls_package] configuration option.

[include ../common-text/tls-security-text.inc]

[vset VERSION 1.7]
[manpage_begin autoproxy n [vset VERSION]]
[see_also http(n)]
[keywords authentication]
[keywords http]
[keywords proxy]
[moddesc   {HTTP protocol helper modules}]
[titledesc {Automatic HTTP proxy usage and authentication}]
[category  Networking]
[require Tcl 8.5]
[require http [opt 2.0]]
[require autoproxy [opt [vset VERSION]]]
[description]
[para]

This package attempts to automate the use of HTTP proxy servers in Tcl
HTTP client code. It tries to initialize the web access settings from

variable may be set up. Either a plain host:port or more commonly a
URL and sometimes the URL may contain authentication parameters or
these may be requested from the user or provided via http_proxy_user
and http_proxy_pass. This package attempts to deal with all these
schemes. It will do it's best to get the required parameters from the
environment or registry and if it fails can be reconfigured.

[include autoproxy-tls-security-notes.inc]

[section "COMMANDS"]

[list_begin definitions]

[call [cmd ::autoproxy::init]]

[call [cmd ::autoproxy::tls_connect] [arg args]]

Connect to a secure socket through a proxy. HTTP proxy servers permit
the use of the CONNECT HTTP command to open a link through the proxy
to the target machine. This function hides the details. For use with
the http package see [cmd tls_socket].
[para]
The [arg args] list may contain any of the options
supported by the specific TLS package that is in use but
must end with the host and port as the last two items.

[call [cmd ::autoproxy::tunnel_connect] [arg args]]

Connect to a target host throught a proxy. This uses the same CONNECT
HTTP command as the [cmd tls_connect] but does not promote the link
security once the connection is established.
[para]
The [arg args] list may contain any of the options
supported by the specific TLS package that is in use but
must end with the host and port as the last two items.

[para]
Note that many proxy servers will permit CONNECT calls to a limited
set of ports - typically only port 443 (the secure HTTP port).

[call [cmd ::autoproxy::tls_socket] [arg args]]

This function is to be used to register a proxy-aware secure socket

[opt_def -basic]
Following options are for configuring the Basic authentication
scheme parameters. See [sectref "Basic Authentication"].
To unset the proxy authentication information retained from a previous
call of this function either "--" or no additional parameters can be
supplied. This will remove the existing authentication information.

[opt_def -tls_package packagename]
This option may be used to configure the Tcl package to use for
TLS support. Valid package names are [const tls] (default)
and [const twapi].

[list_end]

[section "Basic Authentication"]

Basic is the simplest and most commonly use HTTP proxy authentication
scheme. It is described in (1 section 11) and also in (2). It offers

#   set tok [http::geturl http://wiki.tcl.tk/]
#   http::data $tok
#
# To support https add:
#   package require tls
#   http::register https 443 ::autoproxy::tls_socket

package require Tcl 8.5 ;# ni/in operators
package require http;                   # tcl
package require uri;                    # tcllib
package require base64;                 # tcllib

namespace eval ::autoproxy {
    variable options

    if {! [info exists options]} {
        array set options {
            proxy_host ""
            proxy_port 80
            no_proxy   {}
            basic      {}
            authProc   {}
            tls_package tls
        }
    }

    variable uid
    if {![info exists uid]} { set uid 0 }

    variable winregkey

        -host -
        -proxy_h* { set options(proxy_host) }
        -port -
        -proxy_p* { set options(proxy_port) }
        -no*      { set options(no_proxy) }
        -basic    { set options(basic) }
        -authProc { set options(authProc) }
        -tls_package { set options(tls_package) }
        default {
            set err [join [lsort [array names options]] ", -"]
            return -code error "bad option \"$option\":\
                       must be one of -$err"
        }
    }
}

            -host -
            -proxy_h* { set options(proxy_host) [Pop args 1]}
            -port -
            -proxy_p* { set options(proxy_port) [Pop args 1]}
            -no*      { set options(no_proxy) [Pop args 1] }
            -basic    { Pop args; configure:basic $args ; break }
            -authProc { set options(authProc) [Pop args 1] }
            -tls_package {
                set tls_package [Pop args 1]
                if {$tls_package ni {tls twapi}} {
                    error "Invalid TLS package option '$tls_package'. Must be 'tls' or 'twapi'"
                }
                set options(tls_package) $tls_package
            }
            --        { Pop args; break }
            default {
                set opts [join [lsort [array names options]] ", -"]
                return -code error "bad option \"$option\":\
                       must be one of -$opts"
            }
        }

#	provided your proxy will permit CONNECT attempts to ports
#	other than port 443 (many will not).
#	This command defers to 'tunnel_connect' to link to the target
#	host and then upgrades the link to SSL/TLS
#
proc ::autoproxy::tls_connect {args} {
    variable options
    set peersubject [lindex $args end-1]
    if {[string length $options(proxy_host)] > 0} {
        set s [eval [linsert $args 0 tunnel_connect]]
        fconfigure $s -blocking 1 -buffering none -translation binary
        if {[string equal "-async" [lindex $args end-2]]} {
            if {$options(tls_package) eq "twapi"} {
                set s [eval [linsert [lrange $args 0 end-3] 0 ::twapi::starttls $s -peersubject $peersubject]]
            } else {
                eval [linsert [lrange $args 0 end-3] 0 ::tls::import $s]
            }
        } else {
            if {$options(tls_package) eq "twapi"} {
                set s [eval [linsert [lrange $args 0 end-2] 0 ::twapi::starttls $s -peersubject $peersubject]]
            } else {
                eval [linsert [lrange $args 0 end-2] 0 ::tls::import $s]
            }
        }
    } else {
        if {$options(tls_package) eq "twapi"} {
            set s [eval [linsert $args 0 ::twapi::tls_socket]]
        } else {
            set s [eval [linsert $args 0 ::tls::socket]]
        }
    }
    return $s
}

# autoproxy::tunnel_connect --
#
#	Create a connection to a remote machine through a proxy

    set args [lrange $args 0 end-2]
    lappend args $uhost $uport

    set s [eval [linsert $args 0 tls_connect]]

    # record the tls connection status in the http state array.
    upvar state state

    if {$options(tls_package) eq "twapi"} {
        # With twapi::tls_socket, state may not be available on
        # an async connect until negotiation is completed.
        set state(tls_status) ""
        set security_context [fconfigure $s -context]
        if {$security_context ne ""} {
            set cert [twapi::sspi_remote_cert $security_context]
            set cert_info [twapi::cert_info $cert]
            twapi::cert_release $cert
            dict set state(tls_status) issuer [dict get $cert_info -issuer]
            dict set state(tls_status) subject [dict get $cert_info -subject]
            dict set state(tls_status) notBefore [dict get $cert_info -start]
            dict set state(tls_status) notAfter [dict get $cert_info -end]
            # Note: binary encode hex was not available in older Tcl, use twapi::hex
            dict set state(tls_status) serial [twapi::hex [dict get $cert_info -serialnumber]]
            # TBD - dict set state(tls_status) cipher
            # TBD - dict set state(tls_status) sbits
        }
    } else {
        tls::handshake $s
        set state(tls_status) [tls::status $s]
    }

    return $s
}

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

package provide autoproxy 1.7

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

source [file join \
            [file dirname [file dirname [file join [pwd] [info script]]]] \
            devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.0

# Constraints depending on package availability
tcltest::testConstraint have_tls   [expr {![catch {package require tls}]}]
tcltest::testConstraint have_twapi [expr {![catch {package require twapi}]}]

puts "- have_tls   = [expr {![catch {package require tls}]}]"
puts "- have_twapi = [expr {![catch {package require twapi}]}]"

# uri and base64

testing {
    useLocal autoproxy.tcl autoproxy
}

# May need to change these to your proxy
set proxy_host 147.135.210.114
set proxy_port 54566

# Clear the autoproxy package state for each test
proc packageReset {} {
    array set ::autoproxy::options {
        authProc "" basic "" no_proxy "" proxy_host "" proxy_port ""
        tls_package tls
    }
}

test autoproxy-1.0.0 "autoproxy::init standard" -setup {
    packageReset
} -body {
    autoproxy::init http://localhost:13128 "hosta,hostb"

test autoproxy-1.2.3 "autoproxy::configure -basic reset (2)" -setup {
    packageReset
    autoproxy::configure -basic -user test -password secret -realm tcllib
} -body {
    autoproxy::configure -basic
    autoproxy::cget -basic
} -result {}

test autoproxy-1.2.4.0 "autoproxy::configure -tls_package tls" -setup {
    packageReset
} -body {
    autoproxy::configure -tls_package tls
    autoproxy::cget -tls_package
} -result tls

test autoproxy-1.2.4.1 "autoproxy::configure -tls_package twapi" -setup {
    packageReset
} -body {
    autoproxy::configure -tls_package twapi
    autoproxy::cget -tls_package
} -result twapi

test autoproxy-1.2.4.2 "autoproxy::configure -tls_package dummy" -setup {
    packageReset
} -body {
    autoproxy::configure -tls_package dummy
} -result "Invalid TLS package option 'dummy'. Must be 'tls' or 'twapi'" -returnCodes error

test autoproxy-2.0.0 "autoproxy::tls_socket (tls) with proxy" -constraints {
    have_tls
} -setup {
    packageReset
    package require http
    autoproxy::configure -proxy_host $proxy_host -proxy_port $proxy_port
} -body {
    http::register https 443 autoproxy::tls_socket
    set tok [http::geturl https://www.example.com]
    http::status $tok
} -cleanup {
    http::cleanup $tok
} -result ok

test autoproxy-2.0.1 "autoproxy::tls_socket (twapi) with proxy" -constraints {
    have_twapi
} -setup {
    packageReset
    package require http
    autoproxy::configure -proxy_host $proxy_host -proxy_port $proxy_port -tls_package twapi
} -body {
    http::register https 443 autoproxy::tls_socket
    set tok [http::geturl https://www.example.com]
    http::status $tok
} -cleanup {
    http::cleanup $tok
} -result ok

test autoproxy-2.1.0 "autoproxy::tls_socket (tls) without proxy" -constraints {
    have_tls
} -setup {
    packageReset
    package require http
    autoproxy::configure -proxy_host "" -proxy_port $proxy_port
} -body {
    http::register https 443 autoproxy::tls_socket
    set tok [http::geturl https://www.example.com]
    http::status $tok
} -cleanup {
    http::cleanup $tok
} -result ok

test autoproxy-2.1.1 "autoproxy::tls_socket (twapi) without proxy" -constraints {
    have_twapi
} -setup {
    packageReset
    package require http
    autoproxy::configure -proxy_host "" -proxy_port $proxy_port -tls_package twapi
} -body {
    http::register https 443 autoproxy::tls_socket
    set tok [http::geturl https://www.example.com]
    http::status $tok
} -cleanup {
    http::cleanup $tok
} -result ok

testsuiteCleanup

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

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded autoproxy 1.7 [list source [file join $dir autoproxy.tcl]]