[Tcldrop/CVS] tcldrop/modules dcc.tcl

[Philip Moore]

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/11/10 00:01:24

Modified files:
        modules        : dcc.tcl 

Log message:
        Reworked the ::tcldrop::dcc::listen proc.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/dcc.tcl.diff?tr1=1.13&tr2=1.14&r1=text&r2=text

Patches:
Index: tcldrop/modules/dcc.tcl
diff -u tcldrop/modules/dcc.tcl:1.13 tcldrop/modules/dcc.tcl:1.14
--- tcldrop/modules/dcc.tcl:1.13        Tue Nov  4 14:34:08 2003
+++ tcldrop/modules/dcc.tcl     Mon Nov 10 00:01:24 2003
@@ -1,6 +1,6 @@
 # dcc.tcl --
 #
-# $Id: dcc.tcl,v 1.13 2003/11/04 19:34:08 fireegl Exp $
+# $Id: dcc.tcl,v 1.14 2003/11/10 05:01:24 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -32,10 +32,10 @@
        # Provide the users module:
        variable version {0.2}
        package provide tcldrop::dcc $version
-       variable rcsid {$Id: dcc.tcl,v 1.13 2003/11/04 19:34:08 fireegl Exp $}
+       variable rcsid {$Id: dcc.tcl,v 1.14 2003/11/10 05:01:24 fireegl Exp $}
        #checkmodule console
        # Export all the commands that should be available to 3rd-party 
scripters:
-       namespace export dcclist listen putdcc getchan setchan console echo 
strip idx2hand hand2idx link bots islinked putbot putallbots
+       namespace export dcclist listen putdcc getchan setchan console echo 
strip idx2hand hand2idx link bots islinked putbot putallbots sock2idx idx2sock
        ::tcldrop::SetDefault open-telnets 1
        ::tcldrop::SetDefault console-autosave 1
        ::tcldrop::SetDefault force-channel 0
@@ -230,7 +230,7 @@
        }
 }
 
-proc ::tcldrop::dcc::Connect {sock ip port} {
+proc ::tcldrop::dcc::Connect {options sock ip port} {
        set idx [controlsock $sock -control ::tcldrop::dcc::Read -writable 
::tcldrop::dcc::Write]
        # FixMe: The type may not sposta be called TELNET_ID yet, need to find 
out:
        set hostname [lindex [fconfigure $sock -peername] 1]
@@ -391,30 +391,38 @@
        ::tcldrop::idx::ChInfo $idx [list type BOT_NEW other {bot*} timestamp 
[unixtime]]
 }
 
-proc ::tcldrop::dcc::listen {port type {mask {}} {flag {pub}}} {
-       switch -- [string tolower $type] {
-               {all} - {users} - {bots} {
-                       foreach {a d} [::tcldrop::idx::Info] {
-                               array set idxinfo $d
-                               if {[string equal $port $idxinfo(port)]} {
-                                       putlog "already listening on port $port"
-                                       return $port
-                               }
-                       }
-                       if {![catch { socket -server ::tcldrop::dcc::Connect 
$port } sock]} {
-                               set idx [::tcldrop::idx::Assign]
-                               fconfigure $sock -buffering line -blocking 0
-                               ::tcldrop::idx::Register $idx [list idx $idx 
sock $sock handle ($type) remote {*} hostname * port $port type TELNET other 
"lstn  $port" timestamp [unixtime]]
-                               putlog "Listening at telnet port $port ($type)"
-                               return $port
+proc ::tcldrop::dcc::listen {port type args} {
+       foreach {a d} [::tcldrop::idx::Info] {
+               array set idxinfo $d
+               if {[info exists idxinfo(port)] && [string equal $port 
$idxinfo(port)]} {
+                       if {[string equal -nocase {off} $type]} {
+                               catch { close $idxinfo(sock) }
                        } else {
-                               error "error while trying to listen on port: 
$sock"
+                               putlog "already listening on port $port"
                        }
+                       return $port
+               }
+       }
+       switch -- [set type [string tolower $type]] {
+               {all} - {users} - {bots} {
+                       array set options [list type $type mask [lindex $args 
0] proc {} flag {}]
+               }
+               {script} {
+                       array set options [list type $type mask {} proc [lindex 
$args 0] flag [lindex $args 1]]
                }
-               {script} { }
                {off} { }
                {default} { }
        }
+       # FixMe: If $args contains -ssl (or similar) then use the tls package's 
::tls::socket to create the listening socket.
+       if {![catch { socket -server [list ::tcldrop::dcc::Connect [array get 
options]] $port } sock]} {
+               set idx [::tcldrop::idx::Assign]
+               fconfigure $sock -buffering line -blocking 0
+               ::tcldrop::idx::Register $idx [list idx $idx sock $sock handle 
($type) remote {*} hostname * port $port type TELNET other "lstn  $port" 
timestamp [unixtime]]
+               putlog "Listening at telnet port $port ($type)"
+               return $port
+       } else {
+               error "error while trying to listen on port: $sock"
+       }
 }
 
 proc ::tcldrop::dcc::DCC {handle idx arg} {
@@ -579,14 +587,20 @@
        }
 }
 
+# FixMe: This is wrong, except for directly connected bots:
+# Note: To fix this we'll hafta to keep track of the bottree.
 proc ::tcldrop::dcc::islinked {bot} {
        if {[hand2idx $bot] != -1} { return 1 } else { return 0 }
 }
 
+# FixMe: This is wrong, except for directly connected bots:
+# Note: To fix this we'll hafta to keep track of the bottree.
 proc ::tcldrop::dcc::bots {} {
        foreach idx [::tcldrop::idx::List {type BOT}] { lappend bots [idx2hand 
$idx] }
 }
 
+# FixMe: This is wrong, except for directly connected bots:
+# Note: To fix this we'll hafta to keep track of the bottree.
 proc ::tcldrop::dcc::putbot {bot message} {
        if {[set idx [hand2idx $bot]] != -1} {
                putidx $idx "z ${::botnet-nick} $bot $message"
@@ -596,6 +610,8 @@
        }
 }
 
+# FixMe: This is wrong, except for directly connected bots:
+# Note: To fix this we'll hafta to keep track of the bottree.
 proc ::tcldrop::dcc::putallbots {message} {
        foreach idx [::tcldrop::idx::List {type BOT}] {
                putidx $idx "z ${::botnet-nick} [idx2hand $idx] $message"