/[tcldrop]/tcldrop/modules/dcc.tcl
ViewVC logotype

Diff of /tcldrop/modules/dcc.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by fireegl, Sun Nov 2 02:57:41 2003 UTC revision 1.10 by fireegl, Mon Nov 3 20:19:28 2003 UTC
# Line 195  proc ::tcldrop::dcc::hand2idx {{handle { Line 195  proc ::tcldrop::dcc::hand2idx {{handle {
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]
# Line 212  proc ::tcldrop::dcc::Ident {idx id statu Line 225  proc ::tcldrop::dcc::Ident {idx id statu
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} {
# Line 448  proc ::tcldrop::dcc::RAWBOT {handle cmd Line 431  proc ::tcldrop::dcc::RAWBOT {handle cmd
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} {
# Line 456  proc ::tcldrop::dcc::start {event} { Line 461  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}

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26