From 120958f81097c36ae05d3ce41d472b44e739a97a Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Sat, 19 Jul 2008 23:21:13 +0100 Subject: [PATCH] lib updates: updates some lib/ stuff from their respective cvs repos Loaded in the socks files from coccinella's autosocks package and made use of jabber over tor using these. --- lib/autosocks/pkgIndex.tcl | 2 + lib/autosocks/socks4.tcl | 229 +++++++++ lib/autosocks/socks5.tcl | 938 +++++++++++++++++++++++++++++++++++++ lib/irc/picoirc.tcl | 21 +- lib/irc/pkgIndex.tcl | 4 +- lib/tdom/pkgIndex.tcl | 1 + lib/tooltip/pkgIndex.tcl | 2 +- lib/tooltip/tooltip.tcl | 6 +- 8 files changed, 1193 insertions(+), 10 deletions(-) create mode 100644 lib/autosocks/socks4.tcl create mode 100644 lib/autosocks/socks5.tcl diff --git a/lib/autosocks/pkgIndex.tcl b/lib/autosocks/pkgIndex.tcl index 9893df4..9e994f1 100644 --- a/lib/autosocks/pkgIndex.tcl +++ b/lib/autosocks/pkgIndex.tcl @@ -1,2 +1,4 @@ if {![package vsatisfies [package provide Tcl] 8.4]} {return} package ifneeded autosocks 0.1 [list source [file join $dir autosocks.tcl]] +package ifneeded socks4 0.1 [list source [file join $dir socks4.tcl]] +package ifneeded socks5 0.1 [list source [file join $dir socks5.tcl]] \ No newline at end of file diff --git a/lib/autosocks/socks4.tcl b/lib/autosocks/socks4.tcl new file mode 100644 index 0000000..3f88983 --- /dev/null +++ b/lib/autosocks/socks4.tcl @@ -0,0 +1,229 @@ +# socks4.tcl --- +# +# Package for using the SOCKS4a method for connecting TCP sockets. +# Only client side. +# +# (c) 2007 Mats Bengtsson +# +# This source file is distributed under the BSD license. +# +# $Id: socks4.tcl,v 1.7 2007/01/17 08:54:55 matben Exp $ + +package provide socks4 0.1 + +namespace eval socks4 { + + variable const + array set const { + ver \x04 + cmd_connect \x01 + cmd_bind \x02 + rsp_granted \x5a + rsp_failure \x5b + rsp_errconnect \x5c + rsp_erruserid \x5d + } + + # Practical when mapping errors to error codes. + variable iconst + array set iconst { + \x04 ver + \x01 cmd_connect + \x02 cmd_bind + \x5a rsp_granted + \x5b rsp_failure + \x5c rsp_errconnect + \x5c rsp_erruserid + } +} + +# socks4::init -- +# +# Negotiates with a SOCKS server. +# +# Arguments: +# sock: an open socket token to the SOCKS server +# addr: the peer address, not SOCKS server +# port: the peer's port number +# args: +# -command tclProc {token status} +# -username userid +# -timeout millisecs +# +# Results: +# token if -command, else ?. + +proc socks4::init {sock addr port args} { + variable const + + set token [namespace current]::$sock + variable $token + upvar 0 $token state + + array set state { + -command "" + -timeout 60000 + -username "" + async 0 + bnd_addr "" + bnd_port "" + trigger 0 + } + array set state [list \ + addr $addr \ + port $port \ + sock $sock] + array set state $args + + if {[string length $state(-command)]} { + set state(async) 1 + } + + # Network byte-ordered port (2 binary-bytes, short) + set bport [binary format S $port] + + # This corresponds to IP address 0.0.0.x, with x nonzero. + set bip \x00\x00\x00\x01 + + set bdata "$const(ver)$const(cmd_connect)$bport$bip" + append bdata "$state(-username)\x00$addr\x00" + fconfigure $sock -translation {binary binary} -blocking 0 + fileevent $sock writable {} + if {[catch { + puts -nonewline $sock $bdata + flush $sock + } err]} { + return -code error network-failure + } + + # Setup timeout timer. !async remains! + set state(timeoutid) \ + [after $state(-timeout) [namespace current]::timeout $token] + + if {$state(async)} { + fileevent $sock readable \ + [list [namespace current]::response $token] + return $token + } else { + + # We should not return from this proc until finished! + fileevent $sock readable \ + [list [namespace current]::readable $token] + vwait $token\(trigger) + return [response $token] + } +} + +proc socks4::response {token} { + variable $token + upvar 0 $token state + variable const + variable iconst + + puts "socks4::response" + + set sock $state(sock) + fileevent $sock readable {} + + # Read and parse status. + if {[catch {read $sock 2} data] || [eof $sock]} { + finish $token network-failure + return + } + binary scan $data cc null status + if {![string equal $null \x00]} { + finish $token err_version + return + } + if {![string equal $status $const(rsp_granted)]} { + if {[info exists iconst($status)]} { + finish $token $iconst($status) + } else { + finish $token error + } + return + } + + # Read and parse port (2 bytes) and ip (4 bytes). + if {[catch {read $sock 6} data] || [eof $sock]} { + finish $token network-failure + return + } + binary scan $data ccccS i0 i1 i2 i3 port + set addr "" + foreach n [list $i0 $i1 $i2 $i3] { + # Translate to unsigned! + append addr [expr ( $n + 0x100 ) % 0x100] + if {$n <= 2} { + append addr . + } + } + # Translate to unsigned! + set port [expr ( $port + 0x10000 ) % 0x10000] + set state(bnd_port) $port + set state(bnd_addr) $addr + + return [finish $token] +} + +proc socks4::readable {token} { + variable $token + upvar 0 $token state + puts "socks4::readable" + incr state(trigger) +} + +proc socks4::timeout {token} { + finish $token timeout +} + +proc socks4::getipandport {token} { + variable $token + upvar 0 $token state + return [list $state(bnd_addr) $state(bnd_port)] +} + +proc socks4::free {token} { + variable $token + upvar 0 $token state + catch {after cancel $state(timeoutid)} + unset -nocomplain state +} + +proc socks4::finish {token {errormsg ""}} { + global errorInfo errorCode + variable $token + upvar 0 $token state + + puts "socks4::finish token=$token, errormsg=$errormsg" + parray state + + catch {after cancel $state(timeoutid)} + + # In case of error we do the cleanup. + if {$state(async)} { + if {[string length $errormsg]} { + catch {close $state(sock)} + uplevel #0 $state(-command) [list $token $errormsg] + free $token + } else { + uplevel #0 $state(-command) [list $token ok] + } + } else { + if {[string length $errormsg]} { + catch {close $state(sock)} + free $token + return -code error $errormsg + } else { + return + } + } +} + +# Test +if {0} { + set s [socket 127.0.0.1 3000] + set t [socks4::init $s google.com 80 -username mats] + socks4::free $t +} + diff --git a/lib/autosocks/socks5.tcl b/lib/autosocks/socks5.tcl new file mode 100644 index 0000000..6af6e25 --- /dev/null +++ b/lib/autosocks/socks5.tcl @@ -0,0 +1,938 @@ +# socks5.tcl --- +# +# Package for using the SOCKS5 method for connecting TCP sockets. +# Some code plus idee from Kerem 'Waster_' HADIMLI. +# Made from RFC 1928. +# +# (C) 2000 Kerem 'Waster_' HADIMLI (minor parts) +# (c) 2003-2007 Mats Bengtsson +# +# This source file is distributed under the BSD license. +# +# $Id: socks5.tcl,v 1.20 2007/07/19 06:28:11 matben Exp $ +# +# TODO: GSSAPI authentication which is a MUST is missing. +# Only CMD CONNECT implemented. +# Do not report English text in callback but rather error keys like +# rsp_notallowed etc. Client done, server to go. + +package provide socks5 0.1 + +namespace eval socks5 { + + # Constants: + # ver: Socks version + # nomatchingmethod: No matching methods + # cmd_connect: Connect command + # rsv: Reserved + # atyp_*: Address type + # auth_*: Authorication version + variable const + array set const { + ver \x05 + auth_no \x00 + auth_gssapi \x01 + auth_userpass \x02 + nomatchingmethod \xFF + cmd_connect \x01 + cmd_bind \x02 + rsv \x00 + atyp_ipv4 \x01 + atyp_domainname \x03 + atyp_ipv6 \x04 + rsp_succeeded \x00 + rsp_failure \x01 + rsp_notallowed \x02 + rsp_netunreachable \x03 + rsp_hostunreachable \x04 + rsp_refused \x05 + rsp_expired \x06 + rsp_cmdunsupported \x07 + rsp_addrunsupported \x08 + } + + # Practical when mapping errors to error codes. + variable iconst + array set iconst { + \x00 rsp_succeeded + \x01 rsp_failure + \x02 rsp_notallowed + \x03 rsp_netunreachable + \x04 rsp_hostunreachable + \x05 rsp_refused + \x06 rsp_expired + \x07 rsp_cmdunsupported + \x08 rsp_addrunsupported + } + + variable ipv4_num_re {([0-9]{1,3}\.){3}[0-9]{1,3}} + variable ipv6_num_re {([0-9a-fA-F]{4}:){7}[0-9a-fA-F]{4}} + + variable msg + array set msg { + 1 "General SOCKS server failure" + 2 "Connection not allowed by ruleset" + 3 "Network unreachable" + 4 "Host unreachable" + 5 "Connection refused" + 6 "TTL expired" + 7 "Command not supported" + 8 "Address type not supported" + } + + variable debug 0 + variable uid 0 +} + +# socks5::init -- +# +# Negotiates with a SOCKS server. +# +# Arguments: +# sock: an open socket token to the SOCKS server +# addr: the peer address, not SOCKS server +# port: the peer's port number +# args: +# -command tclProc {token status} +# -username username +# -password password +# -timeout millisecs +# +# Results: +# token if -command, else ?. + +proc socks5::init {sock addr port args} { + variable msg + variable const + variable uid + + debug 2 "socks5::init $addr $port $args" + + # Initialize the state variable, an array. We'll return the + # name of this array as the token for the transaction. + + set token [namespace current]::[incr uid] + variable $token + upvar 0 $token state + + array set state { + -password "" + -timeout 60000 + -username "" + async 0 + auth 0 + bnd_addr "" + bnd_port "" + state "" + status "" + trigger 0 + } + array set state [list \ + addr $addr \ + port $port \ + sock $sock] + array set state $args + + if {[string length $state(-username)] || \ + [string length $state(-password)]} { + set state(auth) 1 + } + if {[info exists state(-command)] && [string length $state(-command)]} { + set state(async) 1 + } + if {$state(auth)} { + set methods "$const(auth_no)$const(auth_userpass)" + } else { + set methods "$const(auth_no)" + } + set nmethods [binary format c [string length $methods]] + + fconfigure $sock -translation {binary binary} -blocking 0 + fileevent $sock writable {} + debug 2 "\tsend: ver nmethods methods" + if {[catch { + puts -nonewline $sock "$const(ver)$nmethods$methods" + flush $sock + } err]} { + return -code error network-failure + } + + # Setup timeout timer. !async remains! + set state(timeoutid) \ + [after $state(-timeout) [namespace current]::timeout $token] + + if {$state(async)} { + fileevent $sock readable \ + [list [namespace current]::response_method $token] + return $token + } else { + + # We should not return from this proc until finished! + fileevent $sock readable \ + [list [namespace current]::readable $token] + vwait $token\(trigger) + return [response_method $token] + } +} + +proc socks5::response_method {token} { + variable $token + variable const + upvar 0 $token state + + debug 2 "socks5::response_method" + + set sock $state(sock) + + if {[catch {read $sock 2} data] || [eof $sock]} { + finish $token network-failure + return + } + set serv_ver "" + set method $const(nomatchingmethod) + binary scan $data cc serv_ver smethod + debug 2 "\tserv_ver=$serv_ver, smethod=$smethod" + + if {![string equal $serv_ver 5]} { + finish $token err_version + return + } + + if {[string equal $smethod 0]} { + + # Now, request address and port. + request $token + } elseif {[string equal $smethod 2]} { + + # User/Pass authorization required + if {$state(auth) == 0} { + finish $token err_authorization_required + return + } + + # Username & Password length (binary 1 byte) + set ulen [binary format c [string length $state(-username)]] + set plen [binary format c [string length $state(-password)]] + + debug 2 "\tsend: auth_userpass ulen -username plen -password" + if {[catch { + puts -nonewline $sock \ + "$const(auth_userpass)$ulen$state(-username)$plen$state(-password)" + flush $sock + } err]} { + finish $token network-failure + return + } + + if {$state(async)} { + fileevent $sock readable \ + [list [namespace current]::response_auth $token] + return + } else { + + # We should not return from this proc until finished! + fileevent $sock readable [list [namespace current]::readable $token] + vwait $token\(trigger) + return [response_auth $token] + } + } else { + finish $token err_unsupported_method + return + } +} + +proc socks5::response_auth {token} { + variable $token + upvar 0 $token state + + debug 2 "socks5::response_auth" + + set sock $state(sock) + + if {[catch {read $sock 2} data] || [eof $sock]} { + finish $token network-failure + return + } + set auth_ver "" + set status \x00 + binary scan $data cc auth_ver status + debug 2 "\tauth_ver=$auth_ver, status=$status" + + if {![string equal $auth_ver 1]} { + finish $token err_authentication_unsupported + return + } + if {![string equal $status 0]} { + finish $token err_authorization + return + } + + # Now, request address and port. + return [request $token] +} + +proc socks5::request {token} { + variable $token + variable const + variable ipv4_num_re + variable ipv6_num_re + upvar 0 $token state + + debug 2 "socks5::request" + + set sock $state(sock) + + # Network byte-ordered port (2 binary-bytes, short) + set bport [binary format S $state(port)] + + # Figure out type of address given to us. + if {[regexp $ipv4_num_re $state(addr)]} { + debug 2 "\tipv4" + + # IPv4 numerical address. + set atyp_addr_port $const(atyp_ipv4) + foreach i [split $state(addr) .] { + append atyp_addr_port [binary format c $i] + } + append atyp_addr_port $bport + } elseif {[regexp $ipv6_num_re $state(addr)]} { + # todo + } else { + debug 2 "\tdomainname" + + # Domain name. + # Domain length (binary 1 byte) + set dlen [binary format c [string length $state(addr)]] + set atyp_addr_port \ + "$const(atyp_domainname)$dlen$state(addr)$bport" + } + + # We send request for connect + debug 2 "\tsend: ver cmd_connect rsv atyp_domainname dlen addr port" + set aconst "$const(ver)$const(cmd_connect)$const(rsv)" + if {[catch { + puts -nonewline $sock "$aconst$atyp_addr_port" + flush $sock + } err]} { + finish $token network-failure + return + } + + if {$state(async)} { + fileevent $sock readable \ + [list [namespace current]::response $token] + return + } else { + + # We should not return from this proc until finished! + fileevent $sock readable \ + [list [namespace current]::readable $token] + vwait $token\(trigger) + return [response $token] + } +} + +proc socks5::response {token} { + variable $token + upvar 0 $token state + variable iconst + + debug 2 "socks5::response" + + set sock $state(sock) + fileevent $sock readable {} + + # Start by reading ver+cmd+rsv. + if {[catch {read $sock 3} data] || [eof $sock]} { + finish $token network-failure + return + } + set serv_ver "" + set rep "" + binary scan $data ccc serv_ver rep rsv + + if {![string equal $serv_ver 5]} { + finish $token err_version + return + } + if {$rep == 0} { + # OK + } elseif {[info exists iconst($rep)]} { + finish $token $iconst($rep) + return + } else { + finish $token err_unknown + return + } + + # Now parse the variable length atyp+addr+host. + if {[catch {parse_atyp_addr $token addr port} err]} { + finish $token $err + return + } + + # Store in our state array. + set state(bnd_addr) $addr + set state(bnd_port) $port + + # And finally let the client know that the bytestream is set up. + return [finish $token] +} + +proc socks5::parse_atyp_addr {token addrVar portVar} { + variable $token + variable const + upvar 0 $token state + upvar $addrVar addr + upvar $portVar port + + debug 2 "socks5::parse_atyp_addr" + + set sock $state(sock) + + # Start by reading atyp. + if {[catch {read $sock 1} data] || [eof $sock]} { + return -code error network-failure + } + set atyp "" + binary scan $data c atyp + debug 2 "\tatyp=$atyp" + + # Treat the three address types in order. + switch -- $atyp { + 1 { + if {[catch {read $sock 6} data] || [eof $sock]} { + return -code error network-failure + } + binary scan $data ccccS i0 i1 i2 i3 port + set addr "" + foreach n [list $i0 $i1 $i2 $i3] { + # Translate to unsigned! + append addr [expr ( $n + 0x100 ) % 0x100] + if {$n <= 2} { + append addr . + } + } + # Translate to unsigned! + set port [expr ( $port + 0x10000 ) % 0x10000] + } + 3 { + if {[catch {read $sock 1} data] || [eof $sock]} { + return -code error network-failure + } + binary scan $data c len + debug 2 "\tlen=$len" + set len [expr ( $len + 0x100 ) % 0x100] + if {[catch {read $sock $len} data] || [eof $sock]} { + return -code error network-failure + } + set addr $data + debug 2 "\taddr=$addr" + if {[catch {read $sock 2} data] || [eof $sock]} { + return -code error network-failure + } + binary scan $data S port + # Translate to unsigned! + set port [expr ( $port + 0x10000 ) % 0x10000] + debug 2 "\tport=$port" + } + 4 { + # todo + } + default { + return -code error err_unknown_address_type + } + } +} + +proc socks5::finish {token {errormsg ""}} { + global errorInfo errorCode + variable $token + upvar 0 $token state + + debug 2 "socks5::finish errormsg=$errormsg" + catch {after cancel $state(timeoutid)} + + # In case of error we do the cleanup. + if {$state(async)} { + if {[string length $errormsg]} { + catch {close $state(sock)} + uplevel #0 $state(-command) [list $token $errormsg] + free $token + } else { + uplevel #0 $state(-command) [list $token ok] + } + } else { + if {[string length $errormsg]} { + catch {close $state(sock)} + free $token + return -code error $errormsg + } else { + return + } + } +} + +proc socks5::getipandport {token} { + variable $token + upvar 0 $token state + return [list $state(bnd_addr) $state(bnd_port)] +} + +proc socks5::timeout {token} { + finish $token timeout +} + +proc socks5::free {token} { + variable $token + upvar 0 $token state + unset -nocomplain state +} + +# socks5::serverinit -- +# +# The SOCKS5 server. Negotiates with a SOCKS5 client. +# Sets up bytestreams between client and DST. +# +# Arguments: +# sock: socket connected to the servers socket +# ip: ip address +# port: it's port number +# command: tclProc for callabcks {token type args} +# args: +# -blocksize bytes +# -bytestream boolean +# -opendstsocket boolean +# -timeout millisecs +# +# Results: +# token. + +proc socks5::serverinit {sock ip port command args} { + variable msg + variable const + variable uid + + debug 2 "socks5::serverinit" + + # Initialize the state variable, an array. We'll return the + # name of this array as the token for the transaction. + + set token [namespace current]::[incr uid] + variable $token + upvar 0 $token state + + array set state { + -blocksize 8192 + -bytestream 1 + -opendstsocket 1 + -timeout 60000 + auth 0 + state "" + status "" + } + array set state [list \ + command $command \ + sock $sock] + array set state $args + + fconfigure $sock -translation {binary binary} -blocking 0 + fileevent $sock writable {} + + # Start by reading the method stuff. + if {[catch {read $sock 2} data] || [eof $sock]} { + serv_finish $token network-failure + return + } + set ver "" + set method $const(nomatchingmethod) + binary scan $data cc ver nmethods + set nmethods [expr ( $nmethods + 0x100 ) % 0x100] + debug 2 "\tver=$ver, nmethods=$nmethods" + + # Error checking. Must have either noauth or userpasswdauth. + if {![string equal $ver 5]} { + serv_finish $token "Socks server isn't version 5!" + return + } + for {set i 0} {$i < $nmethods} {incr i} { + if {[catch {read $sock 1} data] || [eof $sock]} { + serv_finish $token network-failure + return + } + binary scan $data c method + set method [expr ( $method + 0x100 ) % 0x100] + debug 2 "\tmethod=$method" + if {[string equal $method 0]} { + set noauthmethod 1 + } elseif {[string equal $method 2]} { + set userpasswdmethod 1 + } + } + set isok 1 + if {[info exists userpasswdmethod]} { + set ans "$const(ver)$const(auth_userpass)" + set state(auth) 1 + } elseif {[info exists noauthmethod]} { + set ans "$const(ver)$const(auth_no)" + } else { + set ans "$const(ver)$const(nomatchingmethod)" + set isok 0 + } + + debug 2 "\tsend: ver method" + if {[catch { + puts -nonewline $sock $ans + flush $sock + } err]} { + serv_finish $token $err + return + } + if {!$isok} { + serv_finish $token "Unrecognized method requested by client" + return + } + + if {$state(auth)} { + fileevent $sock readable \ + [list [namespace current]::serv_auth $token] + } else { + fileevent $sock readable \ + [list [namespace current]::serv_request $token] + } + return $token +} + +proc socks5::serv_auth {token} { + variable $token + variable const + upvar 0 $token state + + debug 2 "socks5::serv_auth" + + set sock $state(sock) + fileevent $sock readable {} + + if {[catch {read $sock 2} data] || [eof $sock]} { + serv_finish $token network-failure + return + } + set auth_ver "" + set method $const(nomatchingmethod) + binary scan $data cc auth_ver ulen + set ulen [expr ( $ulen + 0x100 ) % 0x100] + debug 2 "\tauth_ver=$auth_ver, ulen=$ulen" + if {![string equal $auth_ver 2]} { + serv_finish $token "Wrong authorization method" + return + } + if {[catch {read $sock $ulen} data] || [eof $sock]} { + return -code error network-failure + } + set state(username) $data + debug 2 "\tusername=$data" + if {[catch {read $sock 1} data] || [eof $sock]} { + serv_finish $token network-failure + return + } + binary scan $data c plen + set plen [expr ( $plen + 0x100 ) % 0x100] + debug 2 "\tplen=$plen" + if {[catch {read $sock $plen} data] || [eof $sock]} { + serv_finish $token network-failure + return + } + set state(password) $data + debug 2 "\tpassword=$data" + + set ans [uplevel #0 $state(command) [list $token authorize \ + -username $state(username) -password $state(password)]] + if {!$ans} { + catch { + puts -nonewline $state(sock) "\x00\x01" + } + serv_finish $token notauthorized + return + } + + # Write auth response. + if {[catch { + puts -nonewline $sock "\x01\x00" + flush $sock + } err]} { + serv_finish $token $err + return + } + fileevent $sock readable \ + [list [namespace current]::serv_request $token] +} + +proc socks5::serv_request {token} { + variable $token + variable const + variable msg + variable ipv4_num_re + variable ipv6_num_re + upvar 0 $token state + + debug 2 "socks5::serv_request" + + set sock $state(sock) + + # Start by reading ver+cmd+rsv. + if {[catch {read $sock 3} data] || [eof $sock]} { + serv_finish $token network-failure + return + } + set ver "" + set cmd "" + set rsv "" + binary scan $data ccc ver cmd rsv + debug 2 "\tver=$ver, cmd=$cmd, rsv=$rsv" + + if {![string equal $ver 5]} { + serv_finish $token "Socks server isn't version 5!" + return + } + if {![string equal $cmd 1]} { + serv_finish $token "Unsuported CMD, must be CONNECT" + return + } + + # Now parse the variable length atyp+addr+host. + if {[catch {parse_atyp_addr $token addr port} err]} { + serv_finish $token $err + return + } + + # Store in our state array. + set state(dst_addr) $addr + set state(dst_port) $port + + # Init the SOCKS connection to dst if wanted. Else??? + if {$state(-opendstsocket)} { + if {[catch {socket -async $addr $port} sock_dst]} { + serv_finish $token network-failure + return + } + set state(sock_dst) $sock_dst + + # Setup timeout timer. + set state(timeoutid) \ + [after $state(-timeout) [namespace current]::serv_timeout $token] + fileevent $sock_dst writable \ + [list [namespace current]::serv_dst_connect $token] + } else { + + # ??? + uplevel #0 $state(command) [list $token reply] + } +} + +proc socks5::serv_dst_connect {token} { + variable $token + upvar 0 $token state + + debug 2 "socks5::serv_dst_connect" + fileevent $state(sock_dst) writable {} + after cancel $state(timeoutid) + + set sock_dst $state(sock_dst) + if {[eof $sock_dst]} { + serv_finish $token network-failure + return + } + + if {[catch { + fconfigure $sock_dst -translation {binary binary} -blocking 0 + foreach {bnd_ip bnd_addr bnd_port} [fconfigure $sock_dst -sockname] \ + break + } err]} { + debug 2 "\tfconfigure failed: $err" + serv_finish $token network-failure + return + } + array set state [list bnd_ip $bnd_ip bnd_addr $bnd_addr bnd_port $bnd_port] + serv_reply $token +} + +proc socks5::serv_reply {token} { + variable $token + variable const + upvar 0 $token state + + debug 2 "socks5:serv_reply" + set sock $state(sock) + set bnd_addr $state(bnd_addr) + set bnd_port $state(bnd_port) + debug 2 "\tbnd_addr=$bnd_addr, bnd_port=$bnd_port" + + set aconst "$const(ver)$const(rsp_succeeded)$const(rsv)" + + # Domain length (binary 1 byte) + set dlen [binary format c [string length $bnd_addr]] + + # Network byte-ordered port (2 binary-bytes, short) + set bport [binary format S $bnd_port] + set atyp_addr_port \ + "$const(atyp_domainname)$dlen$bnd_addr$bport" + + # We send SOCKS server's reply to client. + debug 2 "\tsend: ver rep rsv atyp_domainname dlen bnd_addr bnd_port" + if {[catch { + puts -nonewline $sock "$aconst$atyp_addr_port" + flush $sock + } err]} { + serv_finish $token $err + return + } + + # New we are ready to stream data if wanted. + if {$state(-bytestream)} { + establish_bytestreams $token + } else { + # ??? + serv_finish $token + } +} + +proc socks5::establish_bytestreams {token} { + variable $token + upvar 0 $token state + + debug 2 "socks5::establish_bytestreams" + set sock $state(sock) + set sock_dst $state(sock_dst) + + # Forward client stream to dst. + fileevent $sock readable \ + [list [namespace current]::read_stream $token $sock $sock_dst] + + # Forward dst stream to client. + fileevent $sock_dst readable \ + [list [namespace current]::read_stream $token $sock_dst $sock] +} + +proc socks5::read_stream {token in out} { + variable $token + upvar 0 $token state + + set primary [string equal $state(sock) $in] + debug 3 "::socks5::read_stream primary=$primary: in=$in, out=$out" + + # If any of client (sock) or dst (sock_dst) closes down we shall + # close down everthing. + # Only client or dst can determine if a close down is premature. + + if {[catch {eof $in} iseof] || $iseof} { + serv_finish $token + } elseif {[catch {eof $out} iseof] || $iseof} { + serv_finish $token + } elseif {[catch {read $in} data]} { + serv_finish $token network-failure + } else { + + # We could wait here (in the event loop) for channel to be writable + # to avoid any blocking... + # BUT, this would keep $data in memory for a while which is a bad idee. + if {0} { + fileevent $out writable \ + [list [namespace current]::stream_writeable $token $primary] + vwait $token\(writetrigger${primary}) + } + if {[catch {puts -nonewline $out $data; flush $out}]} { + serv_finish $token network-failure + } + } +} + +proc socks5::stream_writeable {token primary} { + variable $token + upvar 0 $token state + + incr state(writetrigger${primary}) +} + +proc socks5::serv_finish {token {errormsg ""}} { + variable $token + upvar 0 $token state + + debug 2 "socks5::serv_finish" + if {$state(-bytestream)} { + catch {close $state(sock)} + catch {close $state(sock_dst)} + } + if {[string length $errormsg]} { + uplevel #0 $state(command) [list $token $errormsg] + } else { + uplevel #0 $state(command) [list $token ok] + } + unset state +} + +# Just a trigger for vwait. + +proc socks5::readable {token} { + variable $token + upvar 0 $token state + + incr state(trigger) +} + +proc socks5::serv_timeout {token} { + variable $token + upvar 0 $token state + + serv_finish $token timeout +} + +proc socks5::debug {num str} { + variable debug + if {$num <= $debug} { + puts $str + } +} + +# Test code... + +if {0} { + + # Server + proc serv_cmd {token status} { + puts "server: token=$token, status=$status" + switch -- $status { + ok { + + } + authorize { + # Here we should check that the username and password is ok. + return 1 + } + default { + puts "error $status" + } + } + } + proc server_connect {sock ip port} { + fileevent $sock readable \ + [list socks5::serverinit $sock $ip $port serv_cmd] + } + socket -server server_connect 1080 + + # Client + proc cb {token status} { + global s + puts "client: token=$token, status=$status" + if {$status eq "ok"} { + fconfigure $s -buffering none + } + } + proc dump {} { + puts "dump:" + } + set s [socket 127.0.0.1 1080] + socks5::init $s localhost 3344 -command cb + #socks5::init $s localhost 3344 -command cb -username xxx -password yyy +} + +#------------------------------------------------------------------------------- diff --git a/lib/irc/picoirc.tcl b/lib/irc/picoirc.tcl index 75c1d05..e0f33b5 100644 --- a/lib/irc/picoirc.tcl +++ b/lib/irc/picoirc.tcl @@ -14,10 +14,10 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- # -# $Id: picoirc.tcl,v 1.3 2007/10/24 10:38:57 patthoyts Exp $ +# $Id: picoirc.tcl,v 1.4 2008/06/24 22:06:56 patthoyts Exp $ namespace eval ::picoirc { - variable version 0.5 + variable version 0.5.1 variable uid; if {![info exists uid]} { set uid 0 } variable defaults { server "irc.freenode.net" @@ -138,16 +138,27 @@ proc ::picoirc::Read {context} { switch -- $ctcp { ACTION { set type ACTION ; set msg $data } VERSION { - send $context "PRIVMSG $nick :\001VERSION [Version $context]\001" + send $context "NOTICE $nick :\001VERSION [Version $context]\001" return } + PING { + send $context "NOTICE $nick :\001PING [lindex $data 0]\001" + return + } + TIME { + set time [clock format [clock seconds] \ + -format {%a %b %d %H:%M:%S %Y %Z}] + send $context "NOTICE $nick :\001TIME $time\001" + return + } default { - send $context "PRIVMSG $nick :\001ERRMSG $msg : unknown query" + set err [string map [list \001 ""] $msg] + send $context "NOTICE $nick :\001ERRMSG $err : unknown query\001" return } } } - if {[lsearch -exact {azbridge ijchain} $nick] != -1} { + if {[lsearch -exact {ijchain wubchain} $nick] != -1} { if {$type eq "ACTION"} { regexp {(\S+) (.+)} $msg -> nick msg } else { diff --git a/lib/irc/pkgIndex.tcl b/lib/irc/pkgIndex.tcl index 117eb32..3c4586b 100644 --- a/lib/irc/pkgIndex.tcl +++ b/lib/irc/pkgIndex.tcl @@ -1,8 +1,8 @@ # pkgIndex.tcl -*- tcl -*- -# $Id: pkgIndex.tcl,v 1.8 2007/10/19 21:17:13 patthoyts Exp $ +# $Id: pkgIndex.tcl,v 1.9 2008/06/24 22:06:56 patthoyts Exp $ if { ![package vsatisfies [package provide Tcl] 8.3] } { # PRAGMA: returnok return } package ifneeded irc 0.6 [list source [file join $dir irc.tcl]] -package ifneeded picoirc 0.5 [list source [file join $dir picoirc.tcl]] +package ifneeded picoirc 0.5.1 [list source [file join $dir picoirc.tcl]] diff --git a/lib/tdom/pkgIndex.tcl b/lib/tdom/pkgIndex.tcl index 5e92b90..7be3a0e 100644 --- a/lib/tdom/pkgIndex.tcl +++ b/lib/tdom/pkgIndex.tcl @@ -1,6 +1,7 @@ # Only relevant on Windows-x86 if {[string compare $::tcl_platform(platform) "windows"]} { return } if {[string compare $::tcl_platform(machine) "intel"]} { return } +return package ifneeded tdom 0.8.3 \ "load [list [file join $dir win32-ix86 tdom083.dll]];\ source [list [file join $dir tdom.tcl]]" diff --git a/lib/tooltip/pkgIndex.tcl b/lib/tooltip/pkgIndex.tcl index 1f40cc2..d007900 100644 --- a/lib/tooltip/pkgIndex.tcl +++ b/lib/tooltip/pkgIndex.tcl @@ -1,4 +1,4 @@ # -*- tcl -*- -package ifneeded tooltip 1.4.1 [list source [file join $dir tooltip.tcl]] +package ifneeded tooltip 1.4.2 [list source [file join $dir tooltip.tcl]] package ifneeded tipstack 1.0 [list source [file join $dir tipstack.tcl]] diff --git a/lib/tooltip/tooltip.tcl b/lib/tooltip/tooltip.tcl index dedf3b2..4f5b88c 100644 --- a/lib/tooltip/tooltip.tcl +++ b/lib/tooltip/tooltip.tcl @@ -7,13 +7,13 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tooltip.tcl,v 1.12 2008/03/12 20:41:05 hobbs Exp $ +# RCS: @(#) $Id: tooltip.tcl,v 1.13 2008/07/14 22:53:02 hobbs Exp $ # # Initiated: 28 October 1996 package require Tk 8.4 -package provide tooltip 1.4.1 +package provide tooltip 1.4.2 package require msgcat #------------------------------------------------------------------------ @@ -390,6 +390,7 @@ proc ::tooltip::itemTip {w args} { } proc ::tooltip::enableCanvas {w args} { + if {[string match *itemTip* [$w bind all ]]} { return } $w bind all +[namespace code [list itemTip $w]] $w bind all +[namespace code [list hide 1]] ; # fade ok $w bind all +[namespace code hide] @@ -407,6 +408,7 @@ proc ::tooltip::tagTip {w tag} { } proc ::tooltip::enableTag {w tag} { + if {[string match *tagTip* [$w tag bind $tag]]} { return } $w tag bind $tag +[namespace code [list tagTip $w $tag]] $w tag bind $tag +[namespace code [list hide 1]] ; # fade ok $w tag bind $tag +[namespace code hide] -- 2.23.0