1 |
# conn.tcl -- |
# conn.tcl -- |
2 |
|
# Provides: |
3 |
|
# * The connect and control commands, used for all outgoing connections. |
4 |
|
# Depends: idx. |
5 |
# |
# |
6 |
# $Id$ |
# $Id$ |
7 |
# |
# |
8 |
# Copyright (C) 2003 FireEgl (Philip Moore) <FireEgl@Tcldrop.Tk> |
# Copyright (C) 2003 FireEgl (Philip Moore) <FireEgl@Tcldrop.Tk> |
9 |
# |
# |
10 |
# This program is free software; you can redistribute it and/or |
# This program is free software; you can redistribute it and/or |
11 |
# modify it under the terms of the GNU General Public License |
# modify it under the terms of the GNU General Public License |
12 |
# as published by the Free Software Foundation; either version 2 |
# as published by the Free Software Foundation; either version 2 |
13 |
# of the License, or (at your option) any later version. |
# of the License, or (at your option) any later version. |
14 |
# |
# |
15 |
# This program is distributed in the hope that it will be useful, |
# This program is distributed in the hope that it will be useful, |
16 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
17 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
18 |
# GNU General Public License for more details. |
# GNU General Public License for more details. |
19 |
# |
# |
20 |
# You should have received a copy of the GNU General Public License |
# You should have received a copy of the GNU General Public License |
21 |
# along with this program (see gpl.txt); if not, write to the |
# along with this program (see gpl.txt); if not, write to the |
22 |
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
23 |
# Or visit http://www.GNU.Org/licenses/gpl.html |
# Or visit http://www.GNU.Org/licenses/gpl.html |
24 |
# |
# |
25 |
# The author of this project can be reached at FireEgl@Tcldrop.Tk |
# The author of this project can be reached at FireEgl@Tcldrop.Tk |
26 |
# Or can be found on IRC (EFNet or FreeNode) as FireEgl. |
# Or can be found on IRC (EFNet or FreeNode) as FireEgl. |
27 |
# |
# |
|
# conn module for Tcldrop. |
|
|
# Depends on: idx. |
|
|
# |
|
|
# Provides the connect and control commands. |
|
|
# (connect is used for all outgoing connections) |
|
|
# |
|
28 |
|
|
29 |
namespace eval ::tcldrop::conn { |
namespace eval ::tcldrop::conn { |
30 |
variable version {0.1} |
variable version {0.1} |
54 |
# the previously saved defaults for $type: |
# the previously saved defaults for $type: |
55 |
if {[info exists Defaults($type)]} { array set options $Defaults($type) } |
if {[info exists Defaults($type)]} { array set options $Defaults($type) } |
56 |
# Finally override those with the ones provided in $connoptions: |
# Finally override those with the ones provided in $connoptions: |
57 |
foreach o $connoptions { |
set proxynum 0 |
58 |
switch -glob -- $o { |
foreach {o v} $connoptions { |
59 |
{-noasync} { set options(async) 0 } |
switch -- $o { |
60 |
{-*} { set options([set opt [string range $o 1 end]]) 1 } |
{-proxy} { |
61 |
{default} { set options($opt) $o } |
incr proxynum |
62 |
|
set options(proxy${proxynum},type) $v |
63 |
|
} |
64 |
|
{default} { |
65 |
|
if {$proxynum} { |
66 |
|
lappend options(proxy${proxynum},args) $o $v |
67 |
|
} else { |
68 |
|
set options([string range $o 1 end]) $v |
69 |
|
} |
70 |
|
} |
71 |
} |
} |
72 |
} |
} |
73 |
# Store the new defaults for $type: |
# Store the new defaults for $type: |
84 |
::tcldrop::idx::ChInfo $idx [array get options] |
::tcldrop::idx::ChInfo $idx [array get options] |
85 |
if {$options(async)} { set async {-async} } else { set async {} } |
if {$options(async)} { set async {-async} } else { set async {} } |
86 |
if {[info exists options(myaddr)] && $options(myaddr) != {}} { |
if {[info exists options(myaddr)] && $options(myaddr) != {}} { |
87 |
set fail [catch { eval socket $async {-myaddr} {$options(myaddr)} {$address} {$port} } sock] |
set fail [catch { eval {socket} $async {-myaddr} {$options(myaddr)} {$address} {$port} } sock] |
88 |
} else { |
} else { |
89 |
set fail [catch { eval socket $async {$address} {$port} } sock] |
set fail [catch { eval {socket} $async {$address} {$port} } sock] |
90 |
} |
} |
91 |
if {!$fail} { |
if {!$fail} { |
92 |
::tcldrop::idx::ChInfo $idx [list sock $sock] |
::tcldrop::idx::ChInfo $idx [list sock $sock] |
93 |
fconfigure $sock -buffering $options(buffering) -blocking $options(blocking) |
fconfigure $sock -buffering $options(buffering) -blocking $options(blocking) |
94 |
fileevent $sock writable [list ::tcldrop::conn::Write $idx] |
fileevent $sock writable [list ::tcldrop::conn::Write $idx] |
95 |
fileevent $sock readable [list ::tcldrop::conn::Read $idx] |
fileevent $sock readable [list ::tcldrop::conn::Read $idx] |
96 |
utimer $options(timeout) [list ::tcldrop::conn::ConnectTimeout $idx] |
::tcldrop::idx::ChInfo $idx [list connecttimer [utimer $options(timeout) [list ::tcldrop::conn::ConnectTimeout $idx]]] |
97 |
return $idx |
return $idx |
98 |
} else { |
} else { |
99 |
killidx $idx |
killidx $idx |
101 |
} |
} |
102 |
} |
} |
103 |
|
|
104 |
# This command is no longer really necessary, as you can |
# Note that you can tell connect what command to use with the -control option. |
|
# tell connect what command to use with the -control option. |
|
105 |
proc ::tcldrop::conn::control {idx command} { |
proc ::tcldrop::conn::control {idx command} { |
106 |
::tcldrop::idx::ChInfo $idx [list control $command] |
::tcldrop::idx::ChInfo $idx [list control $command] |
107 |
} |
} |
109 |
proc ::tcldrop::conn::Read {idx} { |
proc ::tcldrop::conn::Read {idx} { |
110 |
foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d } |
foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d } |
111 |
if {![info exists idxinfo(control)]} { return } |
if {![info exists idxinfo(control)]} { return } |
|
# Note, We need to add a new command "getidx" and use it instead of "read" here. |
|
|
# "getidx" and "putidx" should both go through the connection filter (for things like SSL I guess), if one exists. |
|
|
# Note, we also need to be aware of the buffering setting, and not always read a line at a time. |
|
112 |
# For speed, we read in all available lines (This is absolutely necessary when running inside an Eggdrop, because Eggdrop's event loops are 1 second apart.): |
# For speed, we read in all available lines (This is absolutely necessary when running inside an Eggdrop, because Eggdrop's event loops are 1 second apart.): |
113 |
if {![catch { read $idxinfo(sock) } lines]} { |
if {![catch { read -nonewline $idxinfo(sock) } lines]} { |
114 |
foreach line [split [string trimright $lines \n] \n] { |
foreach line [split $lines \n] { |
115 |
$idxinfo(control) $idx $line |
$idxinfo(control) $idx $line |
116 |
} |
} |
117 |
} else { |
} else { |
118 |
# Send "" to the control proc and kill the sock/idx. |
# Send {} to the control proc and kill the sock/idx. |
119 |
# Note, A check on valididx (from the control proc) is one way to tell wether or not an EOF has actually been received. |
# Note, A check on valididx (from the control proc) is one way to tell wether or not an EOF has actually been received. |
120 |
$idxinfo(control) $idx "" |
$idxinfo(control) $idx {} |
121 |
killidx $idx |
killidx $idx |
122 |
} |
} |
123 |
} |
} |
125 |
proc ::tcldrop::conn::Write {idx} { |
proc ::tcldrop::conn::Write {idx} { |
126 |
foreach {a d} [::tcldrop::idx::Info $idx] { |
foreach {a d} [::tcldrop::idx::Info $idx] { |
127 |
array set idxinfo $d |
array set idxinfo $d |
128 |
|
catch { killutimer $idxinfo(connecttimer) } |
129 |
fileevent $idxinfo(sock) writable {} |
fileevent $idxinfo(sock) writable {} |
|
# FixMe: Set a variable here so that ConnectTimeout can look for it and know the connection was successful. |
|
130 |
if {[info exists idxinfo(writable)]} { |
if {[info exists idxinfo(writable)]} { |
131 |
$idxinfo(writable) $idx |
$idxinfo(writable) $idx |
132 |
} |
} |
133 |
} |
} |
134 |
} |
} |
135 |
|
|
136 |
proc ::tcldrop::conn::ConnectTimeout {idx} { |
proc ::tcldrop::conn::ConnectTimeout {idx} { killidx $idx } |
|
# FixMe: See last FixMe. |
|
|
#killidx $idx |
|
|
} |
|