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

Diff of /tcldrop/modules/dcc.tcl

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

revision 1.13 by fireegl, Tue Nov 4 19:34:08 2003 UTC revision 1.14 by fireegl, Mon Nov 10 05:01:24 2003 UTC
# Line 35  namespace eval ::tcldrop::dcc { Line 35  namespace eval ::tcldrop::dcc {
35          variable rcsid {$Id$}          variable rcsid {$Id$}
36          #checkmodule console          #checkmodule console
37          # Export all the commands that should be available to 3rd-party scripters:          # Export all the commands that should be available to 3rd-party scripters:
38          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
39          ::tcldrop::SetDefault open-telnets 1          ::tcldrop::SetDefault open-telnets 1
40          ::tcldrop::SetDefault console-autosave 1          ::tcldrop::SetDefault console-autosave 1
41          ::tcldrop::SetDefault force-channel 0          ::tcldrop::SetDefault force-channel 0
# Line 230  proc ::tcldrop::dcc::Ident {idx id statu Line 230  proc ::tcldrop::dcc::Ident {idx id statu
230          }          }
231  }  }
232    
233  proc ::tcldrop::dcc::Connect {sock ip port} {  proc ::tcldrop::dcc::Connect {options sock ip port} {
234          set idx [controlsock $sock -control ::tcldrop::dcc::Read -writable ::tcldrop::dcc::Write]          set idx [controlsock $sock -control ::tcldrop::dcc::Read -writable ::tcldrop::dcc::Write]
235          # FixMe: The type may not sposta be called TELNET_ID yet, need to find out:          # FixMe: The type may not sposta be called TELNET_ID yet, need to find out:
236          set hostname [lindex [fconfigure $sock -peername] 1]          set hostname [lindex [fconfigure $sock -peername] 1]
# Line 391  proc ::tcldrop::dcc::BOTWrite {idx} { Line 391  proc ::tcldrop::dcc::BOTWrite {idx} {
391          ::tcldrop::idx::ChInfo $idx [list type BOT_NEW other {bot*} timestamp [unixtime]]          ::tcldrop::idx::ChInfo $idx [list type BOT_NEW other {bot*} timestamp [unixtime]]
392  }  }
393    
394  proc ::tcldrop::dcc::listen {port type {mask {}} {flag {pub}}} {  proc ::tcldrop::dcc::listen {port type args} {
395          switch -- [string tolower $type] {          foreach {a d} [::tcldrop::idx::Info] {
396                  {all} - {users} - {bots} {                  array set idxinfo $d
397                          foreach {a d} [::tcldrop::idx::Info] {                  if {[info exists idxinfo(port)] && [string equal $port $idxinfo(port)]} {
398                                  array set idxinfo $d                          if {[string equal -nocase {off} $type]} {
399                                  if {[string equal $port $idxinfo(port)]} {                                  catch { close $idxinfo(sock) }
                                         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  
400                          } else {                          } else {
401                                  error "error while trying to listen on port: $sock"                                  putlog "already listening on port $port"
402                          }                          }
403                            return $port
404                    }
405            }
406            switch -- [set type [string tolower $type]] {
407                    {all} - {users} - {bots} {
408                            array set options [list type $type mask [lindex $args 0] proc {} flag {}]
409                    }
410                    {script} {
411                            array set options [list type $type mask {} proc [lindex $args 0] flag [lindex $args 1]]
412                  }                  }
                 {script} { }  
413                  {off} { }                  {off} { }
414                  {default} { }                  {default} { }
415          }          }
416            # FixMe: If $args contains -ssl (or similar) then use the tls package's ::tls::socket to create the listening socket.
417            if {![catch { socket -server [list ::tcldrop::dcc::Connect [array get options]] $port } sock]} {
418                    set idx [::tcldrop::idx::Assign]
419                    fconfigure $sock -buffering line -blocking 0
420                    ::tcldrop::idx::Register $idx [list idx $idx sock $sock handle ($type) remote {*} hostname * port $port type TELNET other "lstn  $port" timestamp [unixtime]]
421                    putlog "Listening at telnet port $port ($type)"
422                    return $port
423            } else {
424                    error "error while trying to listen on port: $sock"
425            }
426  }  }
427    
428  proc ::tcldrop::dcc::DCC {handle idx arg} {  proc ::tcldrop::dcc::DCC {handle idx arg} {
# Line 579  proc ::tcldrop::dcc::AutoLinkBots {minut Line 587  proc ::tcldrop::dcc::AutoLinkBots {minut
587          }          }
588  }  }
589    
590    # FixMe: This is wrong, except for directly connected bots:
591    # Note: To fix this we'll hafta to keep track of the bottree.
592  proc ::tcldrop::dcc::islinked {bot} {  proc ::tcldrop::dcc::islinked {bot} {
593          if {[hand2idx $bot] != -1} { return 1 } else { return 0 }          if {[hand2idx $bot] != -1} { return 1 } else { return 0 }
594  }  }
595    
596    # FixMe: This is wrong, except for directly connected bots:
597    # Note: To fix this we'll hafta to keep track of the bottree.
598  proc ::tcldrop::dcc::bots {} {  proc ::tcldrop::dcc::bots {} {
599          foreach idx [::tcldrop::idx::List {type BOT}] { lappend bots [idx2hand $idx] }          foreach idx [::tcldrop::idx::List {type BOT}] { lappend bots [idx2hand $idx] }
600  }  }
601    
602    # FixMe: This is wrong, except for directly connected bots:
603    # Note: To fix this we'll hafta to keep track of the bottree.
604  proc ::tcldrop::dcc::putbot {bot message} {  proc ::tcldrop::dcc::putbot {bot message} {
605          if {[set idx [hand2idx $bot]] != -1} {          if {[set idx [hand2idx $bot]] != -1} {
606                  putidx $idx "z ${::botnet-nick} $bot $message"                  putidx $idx "z ${::botnet-nick} $bot $message"
# Line 596  proc ::tcldrop::dcc::putbot {bot message Line 610  proc ::tcldrop::dcc::putbot {bot message
610          }          }
611  }  }
612    
613    # FixMe: This is wrong, except for directly connected bots:
614    # Note: To fix this we'll hafta to keep track of the bottree.
615  proc ::tcldrop::dcc::putallbots {message} {  proc ::tcldrop::dcc::putallbots {message} {
616          foreach idx [::tcldrop::idx::List {type BOT}] {          foreach idx [::tcldrop::idx::List {type BOT}] {
617                  putidx $idx "z ${::botnet-nick} [idx2hand $idx] $message"                  putidx $idx "z ${::botnet-nick} [idx2hand $idx] $message"

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

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