source: trollforge/lenny/proxycheck.tcl @ 198

#!/usr/local/bin/tclsh

package require http

set p_ip ""
set p_hd ""

proc p_close {channel} {

        puts $channel ""
        close $channel
}

proc p_read {channel} {

        global p_hd

        append p_hd [read $channel]
}

proc p_accept {channel clientaddr clientport} {

        global p_ip p_hd
        
        set p_ip $clientaddr
        set p_hd ""
        
        fconfigure $channel -blocking false -buffering none
        fileevent $channel readable "p_read $channel"
        after 9000 "p_close $channel"
}

proc p_check {host port} {

        global p_ip p_hd

        set p_ip ""
        set p_hd ""

        set schannel [socket -server p_accept 9900]
        
        ::http::config -proxyhost $host -proxyport $port
        
        set query [::http::formatQuery \
                sid 10 \
                pid 20 \
        ]

        catch {
        
                set q [::http::geturl "http://mondogrigio.cjb.net:9900/" \
                        -query $query \
                        -timeout 10000 \
                ]
                
                ::http::cleanup $q
        }
        
        after 10000
        
        ::http::config -proxyhost "" -proxyport ""
        close $schannel

        puts "Proxy ip: $p_ip"
        puts ----
        puts $p_hd
        puts ----
}

set q [::http::geturl "http://www.proxy4free.com/page3.html"]
set p [::http::data $q]
::http::cleanup $q

regsub -all {<[^>]*>} $p {} p

while {
        [
                regexp -indices \
                {([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)[^0-9]+([0-9]+)} \
                $p m hosti porti \
        ]
} {

        set host [string range $p {expand}$hosti]
        set port [string range $p {expand}$porti]

        puts "Test: $host $port"
        puts ----
        
        p_check $host $port

        set p [string range $p [expr [lindex $m 1] + 1] end]
}