195 |
|
|
196 |
proc ::tcldrop::dcc::idx2hand {idx} { ::tcldrop::idx::GetInfo $idx handle } |
proc ::tcldrop::dcc::idx2hand {idx} { ::tcldrop::idx::GetInfo $idx handle } |
197 |
|
|
198 |
|
proc ::tcldrop::dcc::sock2idx {{sock {*}} args} { |
199 |
|
if {[lsearch $args {-all}] != -1} { |
200 |
|
# They want all matching idx's: |
201 |
|
::tcldrop::idx::List [list sock $sock] |
202 |
|
} else { |
203 |
|
# They just want the first matching idx: |
204 |
|
# FixMe: Make it return the last active user instead. |
205 |
|
lindex [::tcldrop::idx::List [list sock $sock]] 0 |
206 |
|
} |
207 |
|
} |
208 |
|
|
209 |
|
proc ::tcldrop::dcc::idx2sock {idx} { ::tcldrop::idx::GetInfo $idx sock } |
210 |
|
|
211 |
# Works just like the Eggdrop dcclist command, |
# Works just like the Eggdrop dcclist command, |
212 |
# it shows the current socket connections. |
# it shows the current socket connections. |
213 |
proc ::tcldrop::dcc::dcclist {{type {}}} { set dcclist [list] |
proc ::tcldrop::dcc::dcclist {{type {}}} { set dcclist [list] |
225 |
foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d } |
foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d } |
226 |
if {$status == {ok}} { |
if {$status == {ok}} { |
227 |
::tcldrop::idx::ChInfo $idx [list ident $response remote $response@$idxinfo(hostname)] |
::tcldrop::idx::ChInfo $idx [list ident $response remote $response@$idxinfo(hostname)] |
|
|
|
228 |
} else { |
} else { |
229 |
::tcldrop::idx::ChInfo $idx [list ident -telnet remote -telnet@$idxinfo(hostname)] |
::tcldrop::idx::ChInfo $idx [list ident -telnet remote -telnet@$idxinfo(hostname)] |
230 |
} |
} |
231 |
} |
} |
232 |
|
|
233 |
proc ::tcldrop::dcc::Connect {sock ip port} { |
proc ::tcldrop::dcc::Connect {sock ip port} { |
234 |
set idx [::tcldrop::idx::Assign] |
set idx [controlsock $sock -control ::tcldrop::dcc::Read -writable ::tcldrop::dcc::Write] |
|
fileevent $sock writable [list ::tcldrop::dcc::Write $sock $idx] |
|
|
fconfigure $sock -buffering line -blocking 0 |
|
|
fileevent $sock readable [list ::tcldrop::dcc::Read $sock $idx] |
|
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] |
237 |
::tcldrop::idx::Register $idx [list idx $idx sock $sock handle * ident {-telnet} hostname $hostname ip $ip remote -telnet@$hostname 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 -telnet@$hostname port $port type TELNET_ID other {t-in waited 1s} timestamp [unixtime]] |
238 |
::ident::ident -sock $sock -command [list ::tcldrop::dcc::Ident $idx] |
::ident::ident -sock $sock -command [list ::tcldrop::dcc::Ident $idx] |
239 |
} |
} |
240 |
|
|
241 |
proc ::tcldrop::dcc::Write {sock idx} { |
proc ::tcldrop::dcc::Write {idx} { |
|
fileevent $sock writable {} |
|
242 |
::tcldrop::idx::ChInfo $idx [list type TELNET_ID other {t-in waited 2s} timestamp [unixtime]] |
::tcldrop::idx::ChInfo $idx [list type TELNET_ID other {t-in waited 2s} timestamp [unixtime]] |
243 |
if {$sock == {stdout}} { |
if {[countusers] == 0} { putidx $idx {You will be the owner once you set up an account... Type 'NEW' here...} } |
244 |
puts {### ENTERING DCC CHAT SIMULATION ###} |
putidx $idx {Nickname.} |
245 |
::tcldrop::idx::ChInfo $idx [list remote User@Console] |
if {${::open-telnets}} { putidx $idx {(If you are new, enter 'NEW' here.)} } |
|
} |
|
|
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.)} |
|
|
} |
|
246 |
} |
} |
247 |
|
|
248 |
proc ::tcldrop::dcc::Read {sock idx} { |
proc ::tcldrop::dcc::Read {idx line} { |
249 |
if {![eof $sock]} { |
foreach {a d} [::tcldrop::idx::Info $idx] { array set chatinfo $d } |
250 |
# Process every line in the buffer: |
switch -- $chatinfo(type) { |
251 |
foreach line [split [string trimright [read $sock] \n] \n] { |
{TELNET_ID} { |
252 |
foreach {a d} [::tcldrop::idx::Info $idx] { array set chatinfo $d } |
if {[string equal -nocase {new} $line]} { |
253 |
switch -- $chatinfo(type) { |
# They want to sign-in as a NEW user. |
254 |
{TELNET_ID} { |
if {${::open-telnets} || [countusers] == 0} { |
255 |
if {[string equal -nocase {new} $line]} { |
# Let them. |
256 |
# They want to sign-in as a NEW user. |
putidx $idx {Enter the handle you would like to use.} |
257 |
if {${::open-telnets} || [countusers] == 0} { |
::tcldrop::idx::ChInfo $idx [list type TELNET_NEW other {new waited 2s} timestamp [unixtime]] |
258 |
# Let them. |
} else { |
259 |
putidx $idx {Enter the handle you would like to use.} |
# Denied! |
260 |
::tcldrop::idx::ChInfo $idx [list type TELNET_NEW other {new waited 2s} timestamp [unixtime]] |
putidx $idx {You don't have access. (not accepting 'new' users)} |
261 |
} else { |
killidx $idx |
|
# 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. |
|
|
} |
|
|
} |
|
|
{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 } |
|
262 |
} |
} |
263 |
{BOT_NEW} { |
} else { |
264 |
# This is when the remote bot is asking what our handle is. |
if {[validuser $line] && ![passwdok $line -]} { |
265 |
global botnet-nick |
putidx $idx {Password.} |
266 |
putidx $idx ${botnet-nick} |
::tcldrop::idx::ChInfo $idx [list handle $line type CHAT_PASS other {pass waited 3s} timestamp [unixtime]] |
267 |
::tcldrop::idx::ChInfo $idx [list type BOT_PASS other {bot_pass}] |
} else { |
268 |
} |
putidx $idx {You don't have access.} |
|
{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 |
|
|
} |
|
269 |
} |
} |
270 |
{BOT_HELLO} { |
} |
271 |
# This is after we've send our handle and password to the remote bot, |
} |
272 |
# so now we send our version and whatever else needs to be sent to start with. |
{CHAT_PASS} { |
273 |
if {[string match -nocase {version *} $line]} { |
if {[passwdok $chatinfo(handle) $line]} { |
274 |
# FixMe: Add proper version info here. |
::tcldrop::idx::ChInfo $idx [list type CHAT other {chat flags: ?/0} timestamp [unixtime]] |
275 |
putidx $idx "version " |
putidx $idx {Welcome!} |
276 |
::tcldrop::idx::ChInfo $idx [list type BOT other {bot flags: }] |
# FixMe: Show the MOTD and whatnot here. |
277 |
|
} |
278 |
|
} |
279 |
|
{TELNET_NEW} { |
280 |
|
# Make sure the handle they want isn't already taken.. |
281 |
|
if {[validuser $line]} { |
282 |
|
putidx $idx {Sorry, that handle is taken already.} |
283 |
|
putidx $idx {Try another one please: } |
284 |
|
} else { |
285 |
|
putidx $idx {Okay, now choose and enter a password: } |
286 |
|
adduser $line *!$chatinfo(ident)@$chatinfo(ip) |
287 |
|
::tcldrop::idx::ChInfo $idx [list handle $line type TELNET_PW other {newp waited 3s} timestamp [unixtime]] |
288 |
|
} |
289 |
|
} |
290 |
|
{TELNET_PW} { |
291 |
|
if {[string length $line] < 4} { |
292 |
|
putidx $idx {Try to use at least 4 characters in your password.} |
293 |
|
putidx $idx {Choose and enter a password: } |
294 |
|
::tcldrop::idx::ChInfo $idx [list timestamp [unixtime]] |
295 |
|
} else { |
296 |
|
setuser $chatinfo(handle) pass $line |
297 |
|
putidx $idx {Remember that! You'll need it next time you log in.} |
298 |
|
putidx $idx "You now have an account" |
299 |
|
chattr $chatinfo(handle) +pnmofvtxj |
300 |
|
::tcldrop::idx::ChInfo $idx [list type CHAT other {chat flags: ?/0} timestamp [unixtime]] |
301 |
|
# FixMe: Show the MOTD or whatever here. |
302 |
|
} |
303 |
|
} |
304 |
|
{CHAT} { |
305 |
|
# Do the FILT binds: |
306 |
|
# Note, this is different from Eggdrop's FILT, because our FILT actually works, but I haven't tested it. =P |
307 |
|
foreach a [binds filt] { |
308 |
|
foreach {type flags mask count proc} $a {} |
309 |
|
if {$line == {}} { break } |
310 |
|
if {[string match -nocase $mask $line] && [matchattr $chatinfo(handle) $flags]} { |
311 |
|
if {[catch { set line [$proc $idx $line] } err]} { |
312 |
|
putlog "Error in script: $proc: $err" |
313 |
|
puterrlog "$::errorInfo" |
314 |
} |
} |
315 |
} |
} |
|
{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} { } |
|
316 |
} |
} |
317 |
|
if {$line == {}} { return } |
318 |
|
# Wouldn't it be neat, if we supported other command characters |
319 |
|
# besides the ".", possibly "/" as a command character, and use |
320 |
|
# it to simulate an ircII client. =D |
321 |
|
if {[string index $line 0] == {.}} { |
322 |
|
# Do the DCC binds: |
323 |
|
DCC $chatinfo(handle) $idx $line |
324 |
|
} else { |
325 |
|
# FixMe: CHAT binds get called here: |
326 |
|
#CHAT $chatinfo(handle) $channel $line |
327 |
|
} |
328 |
|
# Update the info for last idle: |
329 |
|
::tcldrop::idx::ChInfo $idx [list timestamp [unixtime]] |
330 |
|
# Update their laston info: |
331 |
|
catch { setlaston $chatinfo(handle) [unixtime] partyline } |
332 |
} |
} |
333 |
} else { |
{BOT_NEW} { |
334 |
Close $sock $idx EOF |
# This is when the remote bot is asking what our handle is. |
335 |
|
global botnet-nick |
336 |
|
putidx $idx ${botnet-nick} |
337 |
|
::tcldrop::idx::ChInfo $idx [list type BOT_PASS other {bot_pass}] |
338 |
|
} |
339 |
|
{BOT_PASS} { |
340 |
|
# This is when the remote bot is asking what our password (or password hash) is. |
341 |
|
if {[string match -nocase {passreq*} $line]} { |
342 |
|
putidx $idx [getuser $chatinfo(handle) PASS] |
343 |
|
::tcldrop::idx::ChInfo $idx [list type BOT_HELLO other {bot_hello}] |
344 |
|
} else { |
345 |
|
# Abort since it's not a valid responce to our handle. |
346 |
|
killidx $idx |
347 |
|
} |
348 |
|
} |
349 |
|
{BOT_HELLO} { |
350 |
|
# This is after we've send our handle and password to the remote bot, |
351 |
|
# so now we send our version and whatever else needs to be sent to start with. |
352 |
|
if {[string match -nocase {version *} $line]} { |
353 |
|
# FixMe: Add proper version info here. |
354 |
|
putidx $idx "version " |
355 |
|
::tcldrop::idx::ChInfo $idx [list type BOT other {bot flags: }] |
356 |
|
} |
357 |
|
} |
358 |
|
{BOT} { |
359 |
|
# Similar to CHAT above, but this is for bot connections. |
360 |
|
RAWBOT $chatinfo(handle) [string trim [lindex [split $line] 0]] [string trimleft [join [lrange $line 1 end]]] |
361 |
|
} |
362 |
|
{default} { } |
363 |
} |
} |
364 |
} |
} |
365 |
|
|
|
proc ::tcldrop::dcc::Close {sock idx {reason {}}} { |
|
|
# FixMe: close the socket and unregister the idx. |
|
|
fileevent $sock readable {} |
|
|
close $sock |
|
|
|
|
|
} |
|
|
|
|
366 |
proc ::tcldrop::dcc::listen {port type {mask {}} {flag {pub}}} { |
proc ::tcldrop::dcc::listen {port type {mask {}} {flag {pub}}} { |
367 |
switch -- [string tolower $type] { |
switch -- [string tolower $type] { |
368 |
{all} - {users} - {bots} { |
{all} - {users} - {bots} { |
431 |
|
|
432 |
proc ::tcldrop::dcc::putdcc {idx text} { putidx $idx $text } |
proc ::tcldrop::dcc::putdcc {idx text} { putidx $idx $text } |
433 |
|
|
434 |
|
# Special proc for the console (stdout): |
435 |
|
proc ::tcldrop::dcc::ConsoleWrite {idx} { |
436 |
|
fileevent stdout writable {} |
437 |
|
::tcldrop::idx::ChInfo $idx [list remote User@Console type TELNET_ID other {t-in waited 2s} timestamp [unixtime]] |
438 |
|
puts {### ENTERING DCC CHAT SIMULATION ###} |
439 |
|
if {[countusers] == 0} { |
440 |
|
# FixMe: Since there's no other users, |
441 |
|
# skip to the part where we ask for the handle they want to sign up with. |
442 |
|
puts stdout "You will be the owner once you set up an account... Type 'NEW' here..." |
443 |
|
} |
444 |
|
puts stdout "Nickname." |
445 |
|
if {${::open-telnets}} { |
446 |
|
# Tell them they can sign-in as a NEW user.. |
447 |
|
puts stdout {(If you are new, enter 'NEW' here.)} |
448 |
|
} |
449 |
|
} |
450 |
|
|
451 |
|
# Special proc for the console (stdin): |
452 |
|
proc ::tcldrop::dcc::ConsoleRead {idx} { |
453 |
|
foreach line [split [read -nonewline stdin] \n] { ::tcldrop::dcc::Read $idx $line } |
454 |
|
} |
455 |
|
|
456 |
# Simulate a telnet/dcc on stdin/stdout: |
# Simulate a telnet/dcc on stdin/stdout: |
457 |
bind evnt - start ::tcldrop::dcc::start |
bind evnt - start ::tcldrop::dcc::start |
458 |
proc ::tcldrop::dcc::start {event} { |
proc ::tcldrop::dcc::start {event} { |
461 |
fconfigure stdout -buffering line -blocking 0 |
fconfigure stdout -buffering line -blocking 0 |
462 |
fconfigure stdin -buffering line -blocking 0 |
fconfigure stdin -buffering line -blocking 0 |
463 |
set idx [::tcldrop::idx::Assign] |
set idx [::tcldrop::idx::Assign] |
464 |
fileevent stdout writable [list ::tcldrop::dcc::Write stdout $idx] |
fileevent stdout writable [list ::tcldrop::dcc::ConsoleWrite $idx] |
465 |
fileevent stdin readable [list ::tcldrop::dcc::Read stdin $idx] |
fileevent stdin readable [list ::tcldrop::dcc::ConsoleRead $idx] |
466 |
# 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. |
# 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. |
467 |
#if {[set handle [lindex [split $::owner {,}] 0]] == {} || ![validuser $handle] || ![matchattr $handle n] || [passwdok $handle -]} { |
#if {[set handle [lindex [split $::owner {,}] 0]] == {} || ![validuser $handle] || ![matchattr $handle n] || [passwdok $handle -]} { |
468 |
# set handle {HQ} |
# set handle {HQ} |