26 |
# Or can be found on IRC (EFNet or FreeNode) as FireEgl. |
# Or can be found on IRC (EFNet or FreeNode) as FireEgl. |
27 |
# |
# |
28 |
|
|
29 |
|
# connect address port -buffering line -control procname -proxytype https -proxyhost address -proxytype socks5 -proxyhost address |
30 |
|
|
31 |
|
|
32 |
namespace eval ::tcldrop::conn { |
namespace eval ::tcldrop::conn { |
33 |
variable version {0.1} |
variable version {0.1} |
34 |
package provide tcldrop::conn $version |
package provide tcldrop::conn $version |
37 |
if {![info exists ::my-ip]} { set ::my-ip {} } |
if {![info exists ::my-ip]} { set ::my-ip {} } |
38 |
set Defaults(global) [list {async} {1} {buffering} {line} {myaddr} ${::my-ip} {blocking} {0} {timeout} {237}] |
set Defaults(global) [list {async} {1} {buffering} {line} {myaddr} ${::my-ip} {blocking} {0} {timeout} {237}] |
39 |
# Export all the commands that should be available to 3rd-party scripters: |
# Export all the commands that should be available to 3rd-party scripters: |
40 |
namespace export connect control config |
namespace export connect control config controlsock |
41 |
} |
} |
42 |
|
|
43 |
# This sets defaults for outgoing connections (they can be overridden by connect): |
# This sets defaults for outgoing connections (they can be overridden by connect): |
60 |
set proxynum 0 |
set proxynum 0 |
61 |
foreach {o v} $connoptions { |
foreach {o v} $connoptions { |
62 |
switch -- $o { |
switch -- $o { |
63 |
{-proxy} { |
{-proxytype} { |
64 |
incr proxynum |
incr proxynum |
65 |
set options(proxy${proxynum},type) $v |
set options(proxy${proxynum},type) $v |
66 |
} |
} |
104 |
} |
} |
105 |
} |
} |
106 |
|
|
107 |
|
proc ::tcldrop::conn::controlsock {sock args} { |
108 |
|
if {![eof $sock]} { |
109 |
|
set idx [::tcldrop::idx::Assign] |
110 |
|
::tcldrop::idx::Register $idx [list idx $idx timestamp [unixtime]] |
111 |
|
array set options [Config - $args] |
112 |
|
::tcldrop::idx::ChInfo $idx [array get options] |
113 |
|
::tcldrop::idx::ChInfo $idx [list sock $sock] |
114 |
|
fconfigure $sock -buffering $options(buffering) -blocking $options(blocking) |
115 |
|
fileevent $sock writable [list ::tcldrop::conn::Write $idx] |
116 |
|
fileevent $sock readable [list ::tcldrop::conn::Read $idx] |
117 |
|
::tcldrop::idx::ChInfo $idx [list connecttimer [utimer $options(timeout) [list ::tcldrop::conn::ConnectTimeout $idx]]] |
118 |
|
return $idx |
119 |
|
} else { |
120 |
|
return -code error $sock |
121 |
|
} |
122 |
|
} |
123 |
|
|
124 |
|
|
125 |
# Note that you can tell connect what command to use with the -control option. |
# Note that you can tell connect what command to use with the -control option. |
126 |
proc ::tcldrop::conn::control {idx command} { |
proc ::tcldrop::conn::control {idx command} { |
127 |
::tcldrop::idx::ChInfo $idx [list control $command] |
::tcldrop::idx::ChInfo $idx [list control $command] |
144 |
} |
} |
145 |
|
|
146 |
proc ::tcldrop::conn::Write {idx} { |
proc ::tcldrop::conn::Write {idx} { |
147 |
foreach {a d} [::tcldrop::idx::Info $idx] { |
foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d } |
148 |
array set idxinfo $d |
catch { killutimer $idxinfo(connecttimer) } |
149 |
catch { killutimer $idxinfo(connecttimer) } |
catch { fileevent $idxinfo(sock) writable {} } |
150 |
fileevent $idxinfo(sock) writable {} |
if {[info exists idxinfo(writable)]} { |
151 |
if {[info exists idxinfo(writable)]} { |
$idxinfo(writable) $idx |
|
$idxinfo(writable) $idx |
|
|
} |
|
152 |
} |
} |
153 |
} |
} |
154 |
|
|
155 |
proc ::tcldrop::conn::ConnectTimeout {idx} { killidx $idx } |
proc ::tcldrop::conn::ConnectTimeout {idx} { killidx $idx } |