From 0155dc5a0fd2e9eab83d1e86422db45e937ee226 Mon Sep 17 00:00:00 2001
From: Pat Thoyts <patthoyts@users.sourceforge.net>
Date: Fri, 27 Nov 2009 15:34:50 +0000
Subject: [PATCH] Change the parsing of proxy requests to avoid list
 shimmering. This patch splits the first line into a method and uri without
 using list which might affect the quoting on the data. Also tidied up the
 error handling on the ProxyConnect function.

Signed-off-by: Pat Thoyts <patthoyts@users.sourceforge.net>
---
 bin/sockspy.tcl | 40 ++++++++++++++++++++++------------------
 1 file changed, 22 insertions(+), 18 deletions(-)

diff --git a/bin/sockspy.tcl b/bin/sockspy.tcl
index 4ef19e4..f094b78 100644
--- a/bin/sockspy.tcl
+++ b/bin/sockspy.tcl
@@ -578,17 +578,23 @@ proc sockReadable {fromSock toSock who} {
     if {[string length $data] == 0} {
 	close $fromSock
 	catch { close $toSock }
-	insertData meta "----- closed connection -----"
+	INFO "----- closed connection $fromSock \[eof\] -----"
 	INFO "waiting for new connection..." 
 	return
     }
-    if {$toSock == ""} {			;# Not connected yet
-	ProxyConnect $fromSock $data		;# Do proxy forwarding
+    if {$toSock == ""} {			;# Make proxy connection
+	if {[catch {ProxyConnect $fromSock $data} err]} {
+            INFO $err
+            close $fromSock
+            INFO "----- closed connection $fromSock -----"
+            INFO "waiting for new connection..." 
+            return 0
+        }
     } else {
 	catch { puts -nonewline $toSock $data } ;# Forward if we have a socket
     }
     insertData $who $data
-    update
+    update idletasks
 }
 ##+##########################################################################
 # 
@@ -598,35 +604,33 @@ proc sockReadable {fromSock toSock who} {
 # to forward to.
 # 
 proc ProxyConnect {fromSock data} {
-    set line1 [lindex [split $data \r] 0]
-    set bad [regexp -nocase {(http:[^ ]+)} $line1 => uri]
+    set line1 [string range $data 0 [string first "\n" $data]]
+    set line1 [string trimright $line1 "\r\n"]
+    INFO "proxy request \"$line1\"" meta2
+    set bad [regexp {^([^ ]+) +([^ ]+)} $line1 -> method uri]
     if {$bad == 0} {
-	INFO "ERROR: cannot extract URI from '$line1'"
-	close $fromSock
-	insertData meta "----- closed connection -----"
-	insertData meta "waiting for new connection..." 
+	return -code error "failed to parse a uri from '$line1'"
     }
     set state(uri) $uri				;# For debugging
     array set URI [::uri::split $uri]
+    if {$URI(scheme) != "http"} {
+        return -code error "cannot proxy the '$URI(scheme)' protocol"
+    }
     if {$URI(port) == ""} { set URI(port) 80 }
     set bad [catch {set sockServ [socket $URI(host) $URI(port)]} reason]
     if {$bad} {
-	set msg "cannot connect to $URI(host):$URI(port) => $reason"
-	INFO $msg
-	close $fromSock
-	ERROR $msg
-	insertData meta "----- closed connection -----"
-	insertData meta "waiting for new connection..." 
-	return
+	return -code error "cannot connect to $URI(host):$URI(port) => $reason"
     }
-    INFO "fowarding to $URI(host):$URI(port)" meta2
+    INFO "fowarding $method request to $URI(host):$URI(port)" meta2
     fileevent $fromSock readable \
 	[list sockReadable $fromSock $sockServ client]
     fconfigure $sockServ -blocking 0 -buffering none -translation binary
     fileevent $sockServ readable \
 	[list sockReadable $sockServ $fromSock server]
     puts -nonewline $sockServ $data
+    return
 }
+
 ##+##########################################################################
 # 
 # clntConnect -- Called when we get a new client connection
-- 
2.23.0