[Theo Verelst] 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: proxyinit ====== ---- You 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 forever ====== Exercises for the reader: extend to support the CONNECT method (for HTTPS queries) and FTP. <>Networking