tcldrop-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Tcldrop/CVS] tcldrop/modules conn.tcl dcc.tcl


From: Philip Moore
Subject: [Tcldrop/CVS] tcldrop/modules conn.tcl dcc.tcl
Date: Mon, 03 Nov 2003 15:19:29 -0500

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/11/03 15:19:28

Modified files:
        modules        : conn.tcl dcc.tcl 

Log message:
        Added the controlsock command, which gives the ability to control
        already connected sockets.  Reworked the dcc.tcl to use it, rather than
        talk to sockets directly.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/conn.tcl.diff?tr1=1.4&tr2=1.5&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/dcc.tcl.diff?tr1=1.9&tr2=1.10&r1=text&r2=text

Patches:
Index: tcldrop/modules/conn.tcl
diff -u tcldrop/modules/conn.tcl:1.4 tcldrop/modules/conn.tcl:1.5
--- tcldrop/modules/conn.tcl:1.4        Wed Jun  4 17:02:38 2003
+++ tcldrop/modules/conn.tcl    Mon Nov  3 15:19:28 2003
@@ -3,7 +3,7 @@
 #              * The connect and control commands, used for all outgoing 
connections.
 #      Depends: idx.
 #
-# $Id: conn.tcl,v 1.4 2003/06/04 21:02:38 fireegl Exp $
+# $Id: conn.tcl,v 1.5 2003/11/03 20:19:28 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -26,6 +26,9 @@
 # Or can be found on IRC (EFNet or FreeNode) as FireEgl.
 #
 
+# connect address port -buffering line -control procname -proxytype https 
-proxyhost address -proxytype socks5 -proxyhost address
+
+
 namespace eval ::tcldrop::conn {
        variable version {0.1}
        package provide tcldrop::conn $version
@@ -34,7 +37,7 @@
        if {![info exists ::my-ip]} { set ::my-ip {} }
        set Defaults(global) [list {async} {1} {buffering} {line} {myaddr} 
${::my-ip} {blocking} {0} {timeout} {237}]
        # Export all the commands that should be available to 3rd-party 
scripters:
-       namespace export connect control config
+       namespace export connect control config controlsock
 }
 
 # This sets defaults for outgoing connections (they can be overridden by 
connect):
@@ -57,7 +60,7 @@
        set proxynum 0
        foreach {o v} $connoptions {
                switch -- $o {
-                       {-proxy} {
+                       {-proxytype} {
                                incr proxynum
                                set options(proxy${proxynum},type) $v
                        }
@@ -101,6 +104,24 @@
        }
 }
 
+proc ::tcldrop::conn::controlsock {sock args} {
+       if {![eof $sock]} {
+               set idx [::tcldrop::idx::Assign]
+               ::tcldrop::idx::Register $idx [list idx $idx timestamp 
[unixtime]]
+               array set options [Config - $args]
+               ::tcldrop::idx::ChInfo $idx [array get options]
+               ::tcldrop::idx::ChInfo $idx [list sock $sock]
+               fconfigure $sock -buffering $options(buffering) -blocking 
$options(blocking)
+               fileevent $sock writable [list ::tcldrop::conn::Write $idx]
+               fileevent $sock readable [list ::tcldrop::conn::Read $idx]
+               ::tcldrop::idx::ChInfo $idx [list connecttimer [utimer 
$options(timeout) [list ::tcldrop::conn::ConnectTimeout $idx]]]
+               return $idx
+       } else {
+               return -code error $sock
+       }
+}
+
+
 # Note that you can tell connect what command to use with the -control option.
 proc ::tcldrop::conn::control {idx command} {
        ::tcldrop::idx::ChInfo $idx [list control $command]
@@ -123,14 +144,12 @@
 }
 
 proc ::tcldrop::conn::Write {idx} {
-       foreach {a d} [::tcldrop::idx::Info $idx] {
-               array set idxinfo $d
-               catch { killutimer $idxinfo(connecttimer) }
-               fileevent $idxinfo(sock) writable {}
-               if {[info exists idxinfo(writable)]} {
-                       $idxinfo(writable) $idx
-               }
+       foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d }
+       catch { killutimer $idxinfo(connecttimer) }
+       catch { fileevent $idxinfo(sock) writable {} }
+       if {[info exists idxinfo(writable)]} {
+               $idxinfo(writable) $idx
        }
 }
 
-proc ::tcldrop::conn::ConnectTimeout {idx} {   killidx $idx }
+proc ::tcldrop::conn::ConnectTimeout {idx} { killidx $idx }
Index: tcldrop/modules/dcc.tcl
diff -u tcldrop/modules/dcc.tcl:1.9 tcldrop/modules/dcc.tcl:1.10
--- tcldrop/modules/dcc.tcl:1.9 Sat Nov  1 21:57:41 2003
+++ tcldrop/modules/dcc.tcl     Mon Nov  3 15:19:28 2003
@@ -1,6 +1,6 @@
 # dcc.tcl --
 #
-# $Id: dcc.tcl,v 1.9 2003/11/02 02:57:41 fireegl Exp $
+# $Id: dcc.tcl,v 1.10 2003/11/03 20:19:28 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -32,7 +32,7 @@
        # Provide the users module:
        variable version {0.2}
        package provide tcldrop::dcc $version
-       variable rcsid {$Id: dcc.tcl,v 1.9 2003/11/02 02:57:41 fireegl Exp $}
+       variable rcsid {$Id: dcc.tcl,v 1.10 2003/11/03 20:19:28 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
@@ -195,6 +195,19 @@
 
 proc ::tcldrop::dcc::idx2hand {idx} { ::tcldrop::idx::GetInfo $idx handle }
 
+proc ::tcldrop::dcc::sock2idx {{sock {*}} args} {
+       if {[lsearch $args {-all}] != -1} {
+               # They want all matching idx's:
+               ::tcldrop::idx::List [list sock $sock]
+       } else {
+               # They just want the first matching idx:
+               # FixMe: Make it return the last active user instead.
+               lindex [::tcldrop::idx::List [list sock $sock]] 0
+       }
+}
+
+proc ::tcldrop::dcc::idx2sock {idx} { ::tcldrop::idx::GetInfo $idx sock }
+
 # Works just like the Eggdrop dcclist command,
 # it shows the current socket connections.
 proc ::tcldrop::dcc::dcclist {{type {}}} { set dcclist [list]
@@ -212,174 +225,144 @@
        foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d }
        if {$status == {ok}} {
                ::tcldrop::idx::ChInfo $idx [list ident $response remote 
address@hidden(hostname)]
-
        } else {
                ::tcldrop::idx::ChInfo $idx [list ident -telnet remote 
address@hidden(hostname)]
        }
 }
 
 proc ::tcldrop::dcc::Connect {sock ip port} {
-       set idx [::tcldrop::idx::Assign]
-       fileevent $sock writable [list ::tcldrop::dcc::Write $sock $idx]
-       fconfigure $sock -buffering line -blocking 0
-       fileevent $sock readable [list ::tcldrop::dcc::Read $sock $idx]
+       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]
-       ::tcldrop::idx::Register $idx [list idx $idx sock $sock handle * ident 
{-telnet} hostname $hostname ip $ip remote address@hidden port $port type 
TELNET_ID other {t-in  waited 1s} timestamp [unixtime]]
+       ::tcldrop::idx::ChInfo $idx [list idx $idx sock $sock handle * ident 
{-telnet} hostname $hostname ip $ip remote address@hidden port $port type 
TELNET_ID other {t-in  waited 1s} timestamp [unixtime]]
        ::ident::ident -sock $sock -command [list ::tcldrop::dcc::Ident $idx]
 }
 
-proc ::tcldrop::dcc::Write {sock idx} {
-       fileevent $sock writable {}
+proc ::tcldrop::dcc::Write {idx} {
        ::tcldrop::idx::ChInfo $idx [list type TELNET_ID other {t-in  waited 
2s} timestamp [unixtime]]
-       if {$sock == {stdout}} {
-               puts {### ENTERING DCC CHAT SIMULATION ###}
-               ::tcldrop::idx::ChInfo $idx [list remote address@hidden
-       }
-       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 $sock "You will be the owner once you set up an account... 
Type 'NEW' here..."
-       }
-       puts $sock "Nickname."
-       if {${::open-telnets}} {
-               # Tell them they can sign-in as a NEW user..
-               puts $sock {(If you are new, enter 'NEW' here.)}
-       }
-}
-
-proc ::tcldrop::dcc::Read {sock idx} {
-       if {![eof $sock]} {
-               # Process every line in the buffer:
-               foreach line [split [string trimright [read $sock] \n] \n] {
-                       foreach {a d} [::tcldrop::idx::Info $idx] { array set 
chatinfo $d }
-                       switch -- $chatinfo(type) {
-                               {TELNET_ID} {
-                                       if {[string equal -nocase {new} $line]} 
{
-                                               # They want to sign-in as a NEW 
user.
-                                               if {${::open-telnets} || 
[countusers] == 0} {
-                                                       # Let them.
-                                                       putidx $idx {Enter the 
handle you would like to use.}
-                                                       ::tcldrop::idx::ChInfo 
$idx [list type TELNET_NEW other {new  waited 2s} timestamp [unixtime]]
-                                               } else {
-                                                       # Denied!
-                                                       putidx $idx {You don't 
have access.  (not accepting 'new' users)}
-                                                       Close $sock $idx 
{Attempt to login as 'NEW' not allowed.}
-                                               }
-                                       } else {
-                                               if {[validuser $line] && 
![passwdok $line -]} {
-                                                       putidx $idx {Password.}
-                                                       ::tcldrop::idx::ChInfo 
$idx [list handle $line type CHAT_PASS other {pass  waited 3s} timestamp 
[unixtime]]
-                                               } else {
-                                                       putidx $idx {You don't 
have access.}
-                                               }
-                                       }
-                               }
-                               {CHAT_PASS} {
-                                       if {[passwdok $chatinfo(handle) $line]} 
{
-                                               ::tcldrop::idx::ChInfo $idx 
[list type CHAT other {chat  flags: ?/0} timestamp [unixtime]]
-                                               putidx $idx {Welcome!}
-                                               # FixMe: Show the MOTD and 
whatnot here.
-                                       }
-                               }
-                               {TELNET_NEW} {
-                                       # Make sure the handle they want isn't 
already taken..
-                                       if {[validuser $line]} {
-                                               putidx $idx {Sorry, that handle 
is taken already.}
-                                               putidx $idx {Try another one 
please: }
-                                       } else {
-                                               putidx $idx {Okay, now choose 
and enter a password: }
-                                               adduser $line 
*!$chatinfo(ident)@$chatinfo(ip)
-                                               ::tcldrop::idx::ChInfo $idx 
[list handle $line type TELNET_PW other {newp  waited 3s} timestamp [unixtime]]
-                                       }
-                               }
-                               {TELNET_PW} {
-                                       if {[string length $line] < 4} {
-                                               putidx $idx {Try to use at 
least 4 characters in your password.}
-                                               putidx $idx {Choose and enter a 
password: }
-                                               ::tcldrop::idx::ChInfo $idx 
[list timestamp [unixtime]]
-                                       } else {
-                                               setuser $chatinfo(handle) pass 
$line
-                                               putidx $idx {Remember that!  
You'll need it next time you log in.}
-                                               putidx $idx "You now have an 
account"
-                                               chattr $chatinfo(handle) 
+pnmofvtxj
-                                               ::tcldrop::idx::ChInfo $idx 
[list type CHAT other {chat  flags: ?/0} timestamp [unixtime]]
-                                               # FixMe: Show the MOTD or 
whatever here.
-                                       }
+       if {[countusers] == 0} { putidx $idx {You will be the owner once you 
set up an account... Type 'NEW' here...} }
+       putidx $idx {Nickname.}
+       if {${::open-telnets}} { putidx $idx {(If you are new, enter 'NEW' 
here.)} }
+}
+
+proc ::tcldrop::dcc::Read {idx line} {
+       foreach {a d} [::tcldrop::idx::Info $idx] { array set chatinfo $d }
+       switch -- $chatinfo(type) {
+               {TELNET_ID} {
+                       if {[string equal -nocase {new} $line]} {
+                               # They want to sign-in as a NEW user.
+                               if {${::open-telnets} || [countusers] == 0} {
+                                       # Let them.
+                                       putidx $idx {Enter the handle you would 
like to use.}
+                                       ::tcldrop::idx::ChInfo $idx [list type 
TELNET_NEW other {new  waited 2s} timestamp [unixtime]]
+                               } else {
+                                       # Denied!
+                                       putidx $idx {You don't have access.  
(not accepting 'new' users)}
+                                       killidx $idx
                                }
-                               {CHAT} {
-                                       # Do the FILT binds:
-                                       # Note, this is different from 
Eggdrop's FILT, because our FILT actually works, but I haven't tested it. =P
-                                       foreach a [binds filt] {
-                                               foreach {type flags mask count 
proc} $a {}
-                                               if {$line == {}} { break }
-                                               if {[string match -nocase $mask 
$line] && [matchattr $chatinfo(handle) $flags]} {
-                                                       if {[catch { set line 
[$proc $idx $line] } err]} {
-                                                               putlog "Error 
in script: $proc: $err"
-                                                               puterrlog 
"$::errorInfo"
-                                                       }
-                                               }
-                                       }
-                                       if {$line == {}} { return }
-                                       # Wouldn't it be neat, if we supported 
other command characters
-                                       # besides the ".", possibly "/" as a 
command character, and use
-                                       # it to simulate an ircII client.  =D
-                                       if {[string index $line 0] == {.}} {
-                                               # Do the DCC binds:
-                                               DCC $chatinfo(handle) $idx $line
-                                       } else {
-                                               # FixMe: CHAT binds get called 
here:
-                                               #CHAT $chatinfo(handle) 
$channel $line
-                                       }
-                                       # Update the info for last idle:
-                                       ::tcldrop::idx::ChInfo $idx [list 
timestamp [unixtime]]
-                                       # Update their laston info:
-                                       catch { setlaston $chatinfo(handle) 
[unixtime] partyline }
-                               }
-                               {BOT_NEW} {
-                                       # This is when the remote bot is asking 
what our handle is.
-                                       global botnet-nick
-                                       putidx $idx ${botnet-nick}
-                                       ::tcldrop::idx::ChInfo $idx [list type 
BOT_PASS other {bot_pass}]
-                               }
-                               {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]
-                                               ::tcldrop::idx::ChInfo $idx 
[list type BOT_HELLO other {bot_hello}]
-                                       } else {
-                                               # Abort since it's not a valid 
responce to our handle.
-                                               Close $sock $idx NON_BOT
-                                       }
+                       } else {
+                               if {[validuser $line] && ![passwdok $line -]} {
+                                       putidx $idx {Password.}
+                                       ::tcldrop::idx::ChInfo $idx [list 
handle $line type CHAT_PASS other {pass  waited 3s} timestamp [unixtime]]
+                               } else {
+                                       putidx $idx {You don't have access.}
                                }
-                               {BOT_HELLO} {
-                                       # This is after we've send our handle 
and password to the remote bot,
-                                       # so now we send our version and 
whatever else needs to be sent to start with.
-                                       if {[string match -nocase {version *} 
$line]} {
-                                               # FixMe: Add proper version 
info here.
-                                               putidx $idx "version "
-                                               ::tcldrop::idx::ChInfo $idx 
[list type BOT other {bot  flags: }]
+                       }
+               }
+               {CHAT_PASS} {
+                       if {[passwdok $chatinfo(handle) $line]} {
+                               ::tcldrop::idx::ChInfo $idx [list type CHAT 
other {chat  flags: ?/0} timestamp [unixtime]]
+                               putidx $idx {Welcome!}
+                               # FixMe: Show the MOTD and whatnot here.
+                       }
+               }
+               {TELNET_NEW} {
+                       # Make sure the handle they want isn't already taken..
+                       if {[validuser $line]} {
+                               putidx $idx {Sorry, that handle is taken 
already.}
+                               putidx $idx {Try another one please: }
+                       } else {
+                               putidx $idx {Okay, now choose and enter a 
password: }
+                               adduser $line *!$chatinfo(ident)@$chatinfo(ip)
+                               ::tcldrop::idx::ChInfo $idx [list handle $line 
type TELNET_PW other {newp  waited 3s} timestamp [unixtime]]
+                       }
+               }
+               {TELNET_PW} {
+                       if {[string length $line] < 4} {
+                               putidx $idx {Try to use at least 4 characters 
in your password.}
+                               putidx $idx {Choose and enter a password: }
+                               ::tcldrop::idx::ChInfo $idx [list timestamp 
[unixtime]]
+                       } else {
+                               setuser $chatinfo(handle) pass $line
+                               putidx $idx {Remember that!  You'll need it 
next time you log in.}
+                               putidx $idx "You now have an account"
+                               chattr $chatinfo(handle) +pnmofvtxj
+                               ::tcldrop::idx::ChInfo $idx [list type CHAT 
other {chat  flags: ?/0} timestamp [unixtime]]
+                               # FixMe: Show the MOTD or whatever here.
+                       }
+               }
+               {CHAT} {
+                       # Do the FILT binds:
+                       # Note, this is different from Eggdrop's FILT, because 
our FILT actually works, but I haven't tested it. =P
+                       foreach a [binds filt] {
+                               foreach {type flags mask count proc} $a {}
+                               if {$line == {}} { break }
+                               if {[string match -nocase $mask $line] && 
[matchattr $chatinfo(handle) $flags]} {
+                                       if {[catch { set line [$proc $idx 
$line] } err]} {
+                                               putlog "Error in script: $proc: 
$err"
+                                               puterrlog "$::errorInfo"
                                        }
                                }
-                               {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]]]
-                               }
-                               {default} { }
                        }
+                       if {$line == {}} { return }
+                       # Wouldn't it be neat, if we supported other command 
characters
+                       # besides the ".", possibly "/" as a command character, 
and use
+                       # it to simulate an ircII client.  =D
+                       if {[string index $line 0] == {.}} {
+                               # Do the DCC binds:
+                               DCC $chatinfo(handle) $idx $line
+                       } else {
+                               # FixMe: CHAT binds get called here:
+                               #CHAT $chatinfo(handle) $channel $line
+                       }
+                       # Update the info for last idle:
+                       ::tcldrop::idx::ChInfo $idx [list timestamp [unixtime]]
+                       # Update their laston info:
+                       catch { setlaston $chatinfo(handle) [unixtime] 
partyline }
                }
-       } else {
-               Close $sock $idx EOF
+               {BOT_NEW} {
+                       # This is when the remote bot is asking what our handle 
is.
+                       global botnet-nick
+                       putidx $idx ${botnet-nick}
+                       ::tcldrop::idx::ChInfo $idx [list type BOT_PASS other 
{bot_pass}]
+               }
+               {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]
+                               ::tcldrop::idx::ChInfo $idx [list type 
BOT_HELLO other {bot_hello}]
+                       } else {
+                               # Abort since it's not a valid responce to our 
handle.
+                               killidx $idx
+                       }
+               }
+               {BOT_HELLO} {
+                       # This is after we've send our handle and password to 
the remote bot,
+                       # so now we send our version and whatever else needs to 
be sent to start with.
+                       if {[string match -nocase {version *} $line]} {
+                               # FixMe: Add proper version info here.
+                               putidx $idx "version "
+                               ::tcldrop::idx::ChInfo $idx [list type BOT 
other {bot  flags: }]
+                       }
+               }
+               {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]]]
+               }
+               {default} { }
        }
 }
 
-proc ::tcldrop::dcc::Close {sock idx {reason {}}} {
-       # FixMe: close the socket and unregister the idx.
-       fileevent $sock readable {}
-       close $sock
-
-}
-
 proc ::tcldrop::dcc::listen {port type {mask {}} {flag {pub}}} {
        switch -- [string tolower $type] {
                {all} - {users} - {bots} {
@@ -448,6 +431,28 @@
 
 proc ::tcldrop::dcc::putdcc {idx text} { putidx $idx $text }
 
+# Special proc for the console (stdout):
+proc ::tcldrop::dcc::ConsoleWrite {idx} {
+       fileevent stdout writable {}
+       ::tcldrop::idx::ChInfo $idx [list remote address@hidden type TELNET_ID 
other {t-in  waited 2s} timestamp [unixtime]]
+       puts {### ENTERING DCC CHAT SIMULATION ###}
+       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.)}
+       }
+}
+
+# Special proc for the console (stdin):
+proc ::tcldrop::dcc::ConsoleRead {idx} {
+       foreach line [split [read -nonewline stdin] \n] { ::tcldrop::dcc::Read 
$idx $line }
+}
+
 # Simulate a telnet/dcc on stdin/stdout:
 bind evnt - start ::tcldrop::dcc::start
 proc ::tcldrop::dcc::start {event} {
@@ -456,8 +461,8 @@
                fconfigure stdout -buffering line -blocking 0
                fconfigure stdin -buffering line -blocking 0
                set idx [::tcldrop::idx::Assign]
-               fileevent stdout writable [list ::tcldrop::dcc::Write stdout 
$idx]
-               fileevent stdin readable [list ::tcldrop::dcc::Read stdin $idx]
+               fileevent stdout writable [list ::tcldrop::dcc::ConsoleWrite 
$idx]
+               fileevent stdin readable [list ::tcldrop::dcc::ConsoleRead $idx]
                # Note: Under the right conditions, this logs the person in 
automatically as the first owner in the $ownerThis logs them in as the first 
owner listed in the $owner setting.
                #if {[set handle [lindex [split $::owner {,}] 0]] == {} || 
![validuser $handle] || ![matchattr $handle n] || [passwdok $handle -]} {
                #       set handle {HQ}




reply via email to

[Prev in Thread] Current Thread [Next in Thread]