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 |
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] |
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} { |
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" |
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" |