/[tcldrop]/tcldrop/modules/conn.tcl
ViewVC logotype

Diff of /tcldrop/modules/conn.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by fireegl, Tue May 27 15:32:08 2003 UTC revision 1.4 by fireegl, Wed Jun 4 21:02:38 2003 UTC
# Line 1  Line 1 
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}
# Line 57  proc ::tcldrop::conn::Config {{type {-}} Line 54  proc ::tcldrop::conn::Config {{type {-}}
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:
# Line 78  proc ::tcldrop::conn::connect {address p Line 84  proc ::tcldrop::conn::connect {address p
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
# Line 95  proc ::tcldrop::conn::connect {address p Line 101  proc ::tcldrop::conn::connect {address p
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  }  }
# Line 104  proc ::tcldrop::conn::control {idx comma Line 109  proc ::tcldrop::conn::control {idx comma
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  }  }
# Line 123  proc ::tcldrop::conn::Read {idx} { Line 125  proc ::tcldrop::conn::Read {idx} {
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  
 }  

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26