Inspired by some work I did some time ago, where I wanted to be sure what a certain internet connection would do, and made a small proxy server for simple http requests, I thought I'd put it up here, maybe some people can have fun with it.
The POST section doesn't work (probably not at all) I'm looking into it, because I wanted to record data going to some form I want to fill with tcl, probably not too nice practice, but then again, why not.
################################ proxy.tcl ####################################
proc proxysocket {{port 3000}} {
global serversock
set serversock [socket -server proxyservsetevent $port]
}
proc proxyservsetevent {s i p} {
fconfigure $s -encoding binary
fconfigure $s -translation binary
fconfigure $s -blocking 0
fileevent $s readable "proxyservfirstevent $s"
}
proc proxyservfirstevent {s} {
global in
gets $s in
set l1 [split [lindex [split $in \n] 0] " "]
set command [lindex $l1 0]
set url [lindex $l1 1]
set proto [lindex $l1 2]
#puts $url
puts $in
puts "url=$url"
if {$url == "http://test"} {puts $s "Test !"; close $s; return}
switch $command {
GET {
set hh [http::geturl $url -command "proxyfeedpage $s" ]
fileevent $s readable "proxyservnextevent $s"
}
POST {
set hh [http::geturl $url -command "proxyfeedpage $s" -querychannel $s ]
# fileevent $s readable "proxyservnextevent $s"
}
}
}
proc proxyservnextevent {s} {
gets $s in
# ignored for now
}
proc proxygeturl {s h} {
}
proc proxyfeedpage {s h} {
puts $s [http::data $h]
flush $s
proxyclosepage $s $h
}
proc proxyclosepage {s h} {
http::cleanup $h
close $s
}
proc proxyinit {} {
package require http
proxysocket 3000
}
console show
# Use this to start the nano proxyserver:
proxyinitYou should adjust your browser to proxy address localhost with port 3000 to get data from the web over this proxy. Normal pages with pictures are fine, the url's are listed on the console.
Of course you could run the proxy on another machine than you use to surf.
When making this page, I got to the edit page via the above proxy, and had to switch back to direct link to do the 'save' operation...
By valli
The probable reason for this failing for post requests is . It is said not to use gets on binary IO stream. It is recommended to use read.
Refer to Working with binary data for more details.
I am not sure, this is just my reasoning
DKF: Not really. As long as the channel is in binary mode (set using fconfigure $chan -translation binary of course) then gets will be quite happy. Of course, it's not really a meaningful operation on a binary channel, but it won't throw data away (I think; not 100% sure about the handling of the "last line"). But using a bounded non-blocking read is the right thing to do anyway. (If only you could use fcopy it would be even easier.)
.. ah, but we now have chan copy!
aspect Here's a simplified version of the above that works with POST. Instead of using http, we just extract the hostname and port from the first line of the request and then link the two sockets. It's not terribly robust and naturally won't work with any other protocols, but it sufficed for creating this page :-).
Note that fcopy/chan copy aren't useful here as we need to bi-directionally link the sockets -- we don't know if the server will send before the client is finished or vice versa. Technically we could assume this for HTTP/1.0 (once the client sends CRLFCRLF it is done), but in theory this proxy //might// support 1.1.
#!/usr/bin/tclsh
#
switch [llength $argv] {
0 {
lassign {0.0.0.0 8080} host port
}
1 {
lassign [list 0.0.0.0 $argv] host port
}
2 {
lassign $argv host port
}
}
set listenport [expr {[llength $argv] ? [lindex $argv 1] : 8080}]
proc relay {from to} {
if {[eof $from]} {
close $from
close $to
} else {
puts -nonewline $to [read $from]
}
}
proc accept {clientsock clienthost clientport} {
puts "Connection fom $clienthost:$clientport"
set request [gets $clientsock]
set dest [lindex $request 1]
puts "Request from $clienthost:$clientport -> $request"
regexp {^([^:]+)://([^:/]+)(?::([0-9]+))?} $dest -> scheme host port
if {$port == ""} {set port 80}
set serversock [socket $host $port]
puts $serversock $request
fconfigure $clientsock -blocking 0 -buffering none -translation binary
fconfigure $serversock -blocking 0 -buffering none -translation binary
fileevent $clientsock readable [list relay $clientsock $serversock]
fileevent $serversock readable [list relay $serversock $clientsock]
}
socket -server accept -myaddr $host $port
puts "Proxy started on $host:$port"
vwait foreverExercises for the reader: extend to support the CONNECT method (for HTTPS queries) and FTP.
A word of warning: when Firefox connects to a proxy, it keeps the connection alive and may use it to send GET requests intended for different hosts. If it does, this proxy will connect to server A and then forward it an HTTP request for server B.
You can prevent this in Firefox by going to about:config, searching for network.http.proxy.keep-alive, and setting it to false.