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>

diff --git a/bin/sockspy.tcl b/bin/sockspy.tcl
index 4ef19e4efda2873d4507ff659a4556fa11fd9d51..f094b78b21001aa9496aa2ba6845fa7d3e9ce101 100644 (file)
--- 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