[Top][All Lists]
[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}
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Tcldrop/CVS] tcldrop/modules conn.tcl dcc.tcl,
Philip Moore <=