[Tcldrop/CVS] tcldrop/modules dcc.tcl

[Philip Moore]

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/11/04 12:22:21

Modified files:
        modules        : dcc.tcl 

Log message:
        Added [bots] Tcl command.

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

Patches:
Index: tcldrop/modules/dcc.tcl
diff -u tcldrop/modules/dcc.tcl:1.11 tcldrop/modules/dcc.tcl:1.12
--- tcldrop/modules/dcc.tcl:1.11        Mon Nov  3 22:17:16 2003
+++ tcldrop/modules/dcc.tcl     Tue Nov  4 12:22:20 2003
@@ -1,6 +1,6 @@
 # dcc.tcl --
 #
-# $Id: dcc.tcl,v 1.11 2003/11/04 03:17:16 fireegl Exp $
+# $Id: dcc.tcl,v 1.12 2003/11/04 17:22:20 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.11 2003/11/04 03:17:16 fireegl Exp $}
+       variable rcsid {$Id: dcc.tcl,v 1.12 2003/11/04 17:22:20 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
+       namespace export dcclist listen putdcc getchan setchan console echo 
strip idx2hand hand2idx link bots islinked
        ::tcldrop::SetDefault open-telnets 1
        ::tcldrop::SetDefault console-autosave 1
        ::tcldrop::SetDefault force-channel 0
@@ -353,14 +353,14 @@
                        # Update their laston info:
                        catch { setlaston $chatinfo(handle) [unixtime] 
partyline }
                }
-               {FORK_BOT} {
+               {BOT_NEW} {
                        if {$line != {}} {
                                # This is when the remote bot is asking what 
our handle is.
                                putidx $idx ${::botnet-nick}
-                               ::tcldrop::idx::ChInfo $idx [list type BOT_NEW 
other {bot_new}]
+                               ::tcldrop::idx::ChInfo $idx [list type BOT_PASS 
other {bot_pass}]
                        }
                }
-               {BOT_NEW} {
+               {BOT_PASS} {
                        # This is when the remote bot is asking what our 
password (or password hash) is.
                        if {[string match -nocase {passreq*} $line]} {
                                putidx $idx [getuser $chatinfo(handle) PASS]
@@ -381,12 +381,16 @@
                }
                {BOT} {
                        # Similar to CHAT above, but this is for bot 
connections.
-                       RAWBOT $chatinfo(handle) [string trim [lindex [split 
$line] 0]] [string trimleft [join [lrange $line 1 end]]]
+                       RAWBOT $chatinfo(handle) $idx [string trim [lindex 
[split $line] 0]] [string trimleft [join [lrange $line 1 end]]]
                }
                {default} { }
        }
 }
 
+proc ::tcldrop::dcc::BOTWrite {idx} {
+       ::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} {
@@ -435,13 +439,31 @@
        set retval
 }
 
-proc ::tcldrop::dcc::RAWBOT {handle cmd arg} {
+proc ::tcldrop::dcc::RAWBOT {handle idx cmd arg} {
                # retval will be the number of binds that were triggered..
                set retval 0
                foreach a [binds rawbot] {
                        foreach {type flags mask count proc} $a {}
                        if {[string equal -nocase $cmd $mask] && [matchattr 
$handle $flags]} {
                                incr retval
+                               if {[catch { $proc $handle $idx $cmd $arg } 
err]} {
+                                       putlog "error in script: $proc: $err"
+                               } elseif {[string equal $err {1}]} {
+                                       # Abort processing further binds if 
they return 1.
+                                       #break
+                               }
+                       }
+               }
+       set retval
+}
+
+proc ::tcldrop::dcc::BOT {handle cmd arg} {
+               # retval will be the number of binds that were triggered..
+               set retval 0
+               foreach a [binds bot] {
+                       foreach {type flags mask count proc} $a {}
+                       if {[string equal -nocase $cmd $mask] && [matchattr 
$handle $flags]} {
+                               incr retval
                                if {[catch { $proc $handle $cmd $arg } err]} {
                                        putlog "error in script: $proc: $err"
                                } elseif {[string equal $err {1}]} {
@@ -453,6 +475,28 @@
        set retval
 }
 
+bind rawbot b z ::tcldrop::dcc::RAWBOTz
+bind rawbot b zapf ::tcldrop::dcc::RAWBOTz
+proc ::tcldrop::dcc::RAWBOTz {handle idx cmd arg} {
+       if {[isbotnetnick [lindex [set arg [split $arg]] 1]]} {
+               set cmd [lindex $arg 2]
+               set arg [join [lrange $arg 3 end]]
+               BOT $handle $cmd $arg
+       }
+}
+
+bind bot - test ::tcldrop::dcc::BOTtest
+proc ::tcldrop::dcc::BOTtest {from cmd text} {
+       putlog "BOTtest: $from $cmd $text"
+}
+
+
+bind rawbot b ping ::tcldrop::dcc::RAWBOTping
+proc ::tcldrop::dcc::RAWBOTping {handle idx cmd arg} { putidx $idx {pong} }
+
+bind rawbot b pi ::tcldrop::dcc::RAWBOTpi
+proc ::tcldrop::dcc::RAWBOTping {handle idx cmd arg} { putidx $idx {po} }
+
 proc ::tcldrop::dcc::putdcc {idx text} { putidx $idx $text }
 
 # Special proc for the console (stdout):
@@ -463,13 +507,10 @@
        if {[countusers] == 0} {
                # FixMe: Since there's no other users,
                #        skip to the part where we ask for the handle they want 
to sign up with.
-               puts stdout "You will be the owner once you set up an 
account... Type 'NEW' here..."
-       }
-       puts stdout "Nickname."
-       if {${::open-telnets}} {
-               # Tell them they can sign-in as a NEW user..
-               puts stdout {(If you are new, enter 'NEW' here.)}
+               puts stdout {You will be the owner once you set up an 
account... Type 'NEW' here...}
        }
+       puts stdout {Nickname.}
+       if {${::open-telnets}} { puts stdout {(If you are new, enter 'NEW' 
here.)} }
 }
 
 # Special proc for the console (stdin):
@@ -528,7 +569,7 @@
        putdcc $idx "There's no help here!  FixMe!"
 }
 
-# bind time - {* * * * *} ::tcldrop::dcc::AutoLinkBots
+bind time - {* * * * *} ::tcldrop::dcc::AutoLinkBots
 proc ::tcldrop::dcc::AutoLinkBots {minute hour day month year} {
        foreach b [userlist b] {
                # FixMe: This should only link bots with +h or +a botflags.
@@ -538,6 +579,14 @@
        }
 }
 
+proc ::tcldrop::dcc::islinked {bot} {
+       if {[hand2idx $bot] != -1} { return 1 } else { return 0 }
+}
+
+proc ::tcldrop::dcc::bots {} {
+       foreach idx [::tcldrop::idx::List {type BOT}] { lappend bots [idx2hand 
$idx] }
+}
+
 proc ::tcldrop::dcc::link {viabot {bot {}}} {
        if {$bot == {}} {
                set bot $viabot
@@ -546,14 +595,10 @@
        set botaddr [getuser $bot BOTADDR]
        set host [lindex $botaddr 0]
        set port [lindex $botaddr 1]
-       global my-ip
-       set fail [catch { connect $host $port -timeout 99 -myaddr ${my-ip} 
-control ::tcldrop::dcc::Read -errors ::tcldrop::dcc::BOTConnectErrors } idx]
+       set fail [catch { connect $host $port -timeout 99 -myaddr ${::my-ip} 
-control ::tcldrop::dcc::Read -writable ::tcldrop::dcc::BOTWrite -errors 
::tcldrop::dcc::BOTConnectErrors } idx]
        if {!$fail} {
                ::tcldrop::idx::ChInfo $idx [list handle $bot remote $host 
hostname $host port $port type FORK_BOT other {conn  bot} timestamp [set 
timestamp [unixtime]]]
                #set TimerID [utimer 99 [list ::tcldrop::dcc::BOTConnectTimeout 
$idx]]
        }
-}
-
-proc ::tcldrop::dcc::BOTWrite {idx} {
-       ::tcldrop::idx::ChInfo $idx [list type BOT_NEW other {bot*}]
+       if {!$fail} { return 1 } else { return 0 }
 }