From: Jeff Hobbs <hobbs@users.sourceforge.net>
Date: Thu, 5 Jul 2001 17:52:45 +0000 (+0000)
Subject: 	* tkcon.tcl (RetrieveFilter, RetrieveAuthentication): added
X-Git-Tag: tkcon-2-4~45
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=840154d497744ed24a7ff1b975a685f9ed3c3a03;p=tkcon

	* tkcon.tcl (RetrieveFilter, RetrieveAuthentication): added
	support for retrieving latest tkcon via a proxy. (Thoyts)
---

diff --git a/ChangeLog b/ChangeLog
index bbc7869..b08f400 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2001-07-05  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* tkcon.tcl (RetrieveFilter, RetrieveAuthentication): added
+	support for retrieving latest tkcon via a proxy. (Thoyts)
+
 2001-07-04  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* tkcon.tcl (tkcon): made tkcon console return whatever result it
diff --git a/tkcon.tcl b/tkcon.tcl
index 12939a4..b4cf9ea 100755
--- a/tkcon.tcl
+++ b/tkcon.tcl
@@ -22,6 +22,25 @@ exec wish "$0" ${1+"$@"}
 ## source bourbon_ware.tcl
 ##
 
+# Proxy support for retrieving the current version of Tkcon.
+#
+# Mon Jun 25 12:19:56 2001 - Pat Thoyts <Pat.Thoyts@bigfoot.com>
+#
+# In your tkcon.cfg or .tkconrc file put your proxy details into the
+# `proxy' member of the `PRIV' array. e.g.:
+#
+#    set ::tkcon::PRIV(proxy) wwwproxy:8080
+#
+# If you want to be prompted for proxy authentication details (eg for
+# an NT proxy server) make the second element of this variable non-nil - eg:
+#
+#    set ::tkcon::PRIV(proxy) {wwwproxy:8080 1}
+#
+# Or you can set the above variable from within tkcon by calling 
+#
+#    tkcon master set ::tkcon:PRIV(proxy) wwwproxy:8080
+#
+
 if {$tcl_version < 8.0} {
     return -code error "tkcon requires at least Tcl/Tk8"
 } else {
@@ -4960,6 +4979,58 @@ proc ::tkcon::SafeWindow {i w option args} {
     return -code $code $msg
 }
 
+proc ::tkcon::RetrieveFilter {host} {
+    variable PRIV
+    set result {}
+    if {[info exists PRIV(proxy)]} {
+	if {![regexp "^(localhost|127\.0\.0\.1)" $host]} {
+	    set result [lrange [split [lindex $PRIV(proxy) 0] :] 0 1]
+	}
+    }
+    return $result
+}
+
+proc ::tkcon::RetrieveAuthentication {} {
+    package require Tk
+    if {[catch {package require base64}]} {
+        if {[catch {package require Trf}]} {
+            error "base64 support not available"
+        } else {
+            set local64 "base64 -mode enc"
+        }
+    } else {
+        set local64 "base64::encode"
+    }
+
+    set dlg [toplevel .auth]
+    wm title $dlg "Authenticating Proxy Configuration"
+    set f1 [frame ${dlg}.f1]
+    set f2 [frame ${dlg}.f2]
+    button $f2.b -text "OK" -command "destroy $dlg"
+    pack $f2.b -side right
+    label $f1.l2 -text "Username"
+    label $f1.l3 -text "Password"
+    entry $f1.e2 -textvariable "[namespace current]::conf_userid"
+    entry $f1.e3 -textvariable "[namespace current]::conf_passwd" -show *
+    grid $f1.l2 -column 0 -row 0 -sticky e
+    grid $f1.l3 -column 0 -row 1 -sticky e
+    grid $f1.e2 -column 1 -row 0 -sticky news
+    grid $f1.e3 -column 1 -row 1 -sticky news
+    grid columnconfigure $f1 1 -weight 1
+    pack $f2 -side bottom -fill x
+    pack $f1 -side top -anchor n -fill both -expand 1
+    tkwait window $dlg
+    set result {}
+    if {[info exists [namespace current]::conf_userid]} {
+	set data [subst $[namespace current]::conf_userid]
+	append data : [subst $[namespace current]::conf_passwd]
+	set data [$local64 $data]
+	set result [list "Proxy-Authorization" "Basic $data"]
+    }
+    unset [namespace current]::conf_passwd
+    return $result
+}
+
 proc ::tkcon::Retrieve {} {
     # A little bit'o'magic to grab the latest tkcon from CVS and
     # save it locally.  It doesn't support proxies though...