# Description: support for http, socks4, and socks5 proxies

package require roxirc 2.0

AddToPrefs proxytype {enum {none http socks4 socks5}} none
AddToPrefs proxyhost string ""
AddToPrefs proxyport {num 1 65535} 8080
AddToPrefs proxyuser string ""
AddToPrefs proxypass string ""

proc Socks5Identify {s host port pass} {
    global prefs
    set err {connection closed}
    if {[eof $s] || [set err [fconfigure $s -error]] != ""} {
        abort $s "Could not connect to SOCKS server: [geterror $err]"
    }
    Echo .0 {[ server ] Connected to SOCKS server} {server default}
    fileevent $s writable {}
    if {$prefs(proxyuser) != ""} {
	puts -nonewline $s "\x05\x02\x00\x02"
    } else {
        puts -nonewline $s "\x05\x01\x00"
    }
    fileevent $s readable [list [namespace current]::Socks5Auth $s $host $port $pass]
}

proc Socks5Auth {s host port pass} {
    set data {connection closed}
    if {[eof $s] || [catch {read $s} data]} {
        abort $s "Disconnected from SOCKS server: [geterror $data]"
    }
    set version ""
    set method "-1"
    binary scan $data "cc" version method
    if {$version != 5} {
        abort $s {SOCKS server does not support SOCKS 5}
    }
    if {$method == 2} {
        global prefs
	if {$prefs(proxyuser) == ""} {
	    abort $s {SOCKS5 server requires authentication, set PROXYUSER and PROXYPASS}
	}
	Echo .0 {[ server ] Authenticating with SOCKS5 server} {server default}
        puts -nonewline $s [binary format cca*ca* 1 [string length $prefs(proxyuser)] $prefs(proxyuser) [string length $prefs(proxypass)] $prefs(proxypass)]
        fileevent $s readable [list [namespace current]::Socks5AuthReply $s $host $port $pass]
    } elseif {$method == 0} {
        puts -nonewline $s [binary format ccccca*S 5 1 0 3 [string length $host] $host $port]
        fileevent $s readable [list [namespace current]::Socks5Done $s $host $port $pass]
    } else {
        abort $s {No acceptable SOCKS5 authentication methods}
    }
}

proc Socks5AuthReply {s host port pass} {
    set data {connection closed}
    if {[eof $s] || [catch {read $s} data]} {
        abort $s "Disconnected from SOCKS server: [geterror $data]"
    }
    set authversion ""
    set status "\x00"
    binary scan $data "cc" authversion status
    if {$authversion != 1} {
        abort $s {SOCKS server does not support user/password authentication}
    }
    if {$status != 0} {
        abort $s {Incorrect username or password}
    }
    Echo .0 {[ server ] SOCKS5 authentication successful} {server default}
    puts -nonewline $s [binary format ccccca*S 5 1 0 3 [string length $host] $host $port]
    fileevent $s readable [list [namespace current]::Socks5Done $s $host $port $pass]
}

proc Socks5Done {s host port pass} {
    set data {connection closed}
    if {[eof $s] || [catch {read $s} data]} {
        abort $s "Disconnected from SOCKS server: [geterror $data]"
    }
    set version ""
    set reply ""
    binary scan $data "cc" version reply
    if {$version != 5} {
        abort $s {SOCKS server does not support SOCKS 5}
    }
    if {$reply != 0} {
        set err unknown
        if {($reply > 0) && ($reply < 9)} {
            set err [lindex {"" "General server failure" "Connection not allowed by ruleset" "Network unreachable" "Host unreachable" "Connection refused" "TTL expired" "Command not supported" "Address type not supported"} $reply]
	}
	abort $s "SOCKS5 error: $err"
    }
    Done $s $host $pass
}

proc Socks4Identify {s host port pass} {
    global prefs
    set err {connection closed}
    if {[eof $s] || [set err [fconfigure $s -error]] != ""} {
        abort $s "Could not connect to SOCKS server: [geterror $err]"
    }
    Echo .0 {[ server ] Connected to SOCKS server} {server default}
    fileevent $s writable {}
    set tmp [split $host .]
    if {[llength $tmp] != 4} {
        close $s
        Echo .0 {[ error ] SOCKS4 requires an IP address} {error default}
        return
    }
    set ip [format %u 0x[format %02X%02X%02X%02X [lindex $tmp 0] [lindex $tmp 1] [lindex $tmp 2] [lindex $tmp 3]]]
    puts -nonewline $s [binary format ccSIa*c 4 1 $port $ip $prefs(proxyuser) 0]
    fileevent $s readable [list [namespace current]::Socks4Done $s $host $port $pass]
}

proc Socks4Done {s host port pass} {
    set data {connection closed}
    if {[eof $s] || [catch {read $s} data]} {
        abort $s "Disconnected from SOCKS server: [geterror $data]"
    }
    set version ""
    set reply ""
    binary scan $data "cc" version reply
    if {[string length $data] != 8 || $version != 0} {
        abort $s {SOCKS server does not support SOCKS 4}
    }
    if {$reply != 90} {
        switch -exact -- $reply {
            91 {set err "request rejected or failed"}
            92 {set err "server cannot connect to identd on the client"}
            93 {set err "client program and identd report different user-ids"}
            default {set err unknown}
        }
        abort $s "SOCKS4 error: $err"
    }
    Done $s $host $pass
}

proc HttpIdentify {s host port pass} {
    global prefs
    set err {connection closed}
    if {[eof $s] || [set err [fconfigure $s -error]] != ""} {
        abort $s "Could not connect to proxy server: [geterror $err]"
    }
    Echo .0 {[ server ] Connected to proxy server} {server default}
    fileevent $s readable [list [namespace current]::HttpDone $s $host $port $pass]
    fileevent $s writable {}
    puts $s "CONNECT $host:$port HTTP/1.0"
    if {$prefs(proxyuser) != ""} {
        set enc [base64encode $prefs(proxyuser):$prefs(proxypass)]
        puts $s "Authorization: Basic $enc"
        puts $s "Proxy-Authorization: Basic $enc"
    }
    puts $s ""
}

proc HttpDone {s host port pass} {
    set data {connection closed}
    if {[eof $s] || [catch {read $s} data]} {
        abort $s "Disconnected from SOCKS server: [geterror $data]"
    }
    if {[regexp {^HTTP/1\.. ([0-9]{3}) (.*?)\r?\n} $data -> code text]} {
        if {$code != "200"} {
            abort $s "Proxy HTTP error: $code ($text)"
        }
    } else {
        abort $s "Invalid response from proxy server"
    }
    Done $s $host $pass
}

proc ProxyConnect {host port pass} {
    global prefs
    if {$prefs(proxyhost) == ""} {
        Echo .0 {[ error ] No proxy server configured, set PROXYTYPE to NONE or set PROXYHOST} {error default}
        return
    }
    Echo .0 "\[ server \] Connecting to $prefs(proxyhost) on port $prefs(proxyport)" {server default}
    if {[catch {socket -async $prefs(proxyhost) $prefs(proxyport)} s]} {
        Echo .0 "\[ error \] Could not connect to proxy server: [geterror $s]" {error default}
        return
    }
    fconfigure $s -translation binary -blocking 0 -buffering none
    switch -exact -- $prefs(proxytype) {
        SOCKS5 {fileevent $s writable [list [namespace current]::Socks5Identify $s $host $port $pass]}
        SOCKS4 {fileevent $s writable [list [namespace current]::Socks4Identify $s $host $port $pass]}
        HTTP   {fileevent $s writable [list [namespace current]::HttpIdentify   $s $host $port $pass]}
    }
}

proc abort {s err} {
    catch {close $s}
    Echo .0 "\[ server \] $err" {server default}
    return -code return
}

proc Done {s host pass} {
    global irc
    if {[info exists irc]} {
        catch {puts $irc "QUIT :changing servers"}
        after 100 [list catch "close $irc"]
        unset irc
    }
    fconfigure $s -translation auto
    fileevent $s readable [list Connecting $host $s]
    fileevent $s writable [list auth $s $pass]
    set ::connecting $host
}

proc opensock {cmd op} {
    global prefs
    if {$prefs(proxytype) != "none"} {
        eval ProxyConnect [lrange $cmd 1 end]
        return -code return
    }
}

proc base64encode {string} {
    set i 0
    foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 + /} {
        set base64_tmp($char) $i
        lappend base64_en $char
        incr i
    }
    set result {}
    set state 0
    binary scan $string c* X
    foreach {x y z} $X {
        append result [lindex $base64_en [expr {($x >>2) & 0x3F}]] 
        if {$y != {}} {
            append result [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]] 
            if {$z != {}} {
                append result [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]]
                append result [lindex $base64_en [expr {($z & 0x3F)}]]
            } else {
                set state 2
                break
            }
        } else {
            set state 1
            break
        }
    }
    if {$state == 1} {
        append result [lindex $base64_en [expr {(($x << 4) & 0x30)}]]== 
    } elseif {$state == 2} {
        append result [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]=  
    }
    return $result
}

proc unload {} {
    trace remove execution ::OpenSock enter [namespace current]::opensock
    RemoveFromPrefs proxytype
    RemoveFromPrefs proxyhost
    RemoveFromPrefs proxyport
    RemoveFromPrefs proxyuser
    RemoveFromPrefs proxypass
}

proc help {window line} {
    Echo $window {[ help ] Variables added by this script: PROXYTYPE PROXYHOST PROXYPORT PROXYUSER PROXYPASS} {help default}
    Echo $window {[ help ] Allows use of HTTP, SOCKS4, AND SOCKS5 proxies} {help default}
    Echo $window {[ help ] To connect to a SOCKS5 proxy set PROXYTYPE to SOCKS5 and set PROXYHOST to the address of your SOCKS5 server} {help default}
    Echo $window {[ help ] If the proxy requires authentication you will need to set PROXYUSER and PROXYPASS as well} {help default}
}

# string map is for a bug fixed sometime between 8.4.1 and 8.4.5
if {[lsearch -exact [string map {\x00 ""} [trace info execution ::OpenSock]] "enter [namespace current]::opensock"] < 0} {
    trace add execution ::OpenSock enter [namespace current]::opensock
}