TCL with threads.

Ofloo · Post by **Ofloo** » Thu Jul 22, 2010 10:07 am

hi, I'm testing an eggdrop compiled with threads, .. and I was wondering how the namespace thing goes, .. or how it worked ..

variables and functions are not reconized, .. if i eval the script waits untill the thread is finished obviously this isn't what it is supposed to do.

basicly variables and functions don't work in this case putserv & $chan.

Code: Select all

package require Thread

set TID1 [thread::create]
set TID2 [thread::create]


proc test_proc {nick host hand chan arg}  {
  global TID1
  thread::send -async $TID1 {
    after 10000
    ::putserv "PRIVMSG $chan:DELAY 10 seconds"
  }
  putserv "PRIVMSG $chan :Sended to thread with after"
}

proc test_proc2 {nick host hand chan arg}  {
  global TID2
  thread::send -async $TID2 {
    ::putserv "PRIVMSG $chan :NO DELAY"
  }
  putserv "PRIVMSG $chan : Sended to thread without after"
}


bind pub -|- !test test_proc
bind pub -|- !test2 test_proc2

Ofloo · Post by **Ofloo** » Thu Jul 22, 2010 11:27 am

an other observation is when i want to load Ttrace

Code: Select all

[14:21:15] #Ofloo# set errorInfo
Currently: couldn't save command result in variable
Currently:     while executing
Currently: "catch {package require Thread} version"
Currently:     (in namespace eval "::ttrace" script line 9)
Currently:     invoked from within
Currently: "namespace eval ttrace {
Currently:
Currently:     # Setup some compatibility wrappers
Currently:     if {[info commands nsv_set] != ""} {
Currently:         variable tvers 0
Currently:         variable mu..."
Currently:     (file "/usr/local/lib/thread2.6.5/ttrace.tcl" line 47)
Currently:     invoked from within
Currently: "source [file join $dir ttrace.tcl]"
Currently:     (procedure "thread_source" line 8)
Currently:     invoked from within
Currently: "thread_source /usr/local/lib/thread2.6.5"
Currently:     ("package ifneeded Ttrace 2.6.5" script)
Currently:     invoked from within
Currently: "package require Ttrace"
.tcl catch {package require Thread} version
Tcl error: couldn't save command result in variable
.tcl catch
Tcl error: wrong # args: should be "catch script ?resultVarName? ?optionVarName?"
.tcl catch {package require Thread} vers   
Tcl: 0
.set version
[14:25:16] #Ofloo# set version
Currently: 1.6.20+RC2 1062003 PRE-RELEASE 1279200246 RC2

the problem is that the Ttrace script is trying to overwrite the version varialbe which makes the bot crash/core

Ofloo · Post by **Ofloo** » Thu Jul 22, 2010 11:51 am

*** Ofloo joined the party line.
.tcl package require Ttrace
Tcl: 2.6.5

Code: Select all

static tcl_strings def_tcl_strings[] = {
  {"botnet-nick",     botnetnick,     HANDLEN,                 0},
  {"userfile",        userfile,       120,           STR_PROTECT},
  {"motd",            motdfile,       120,           STR_PROTECT},
  {"admin",           admin,          120,                     0},
  {"help-path",       helpdir,        120, STR_DIR | STR_PROTECT},
  {"temp-path",       tempdir,        120, STR_DIR | STR_PROTECT},
  {"text-path",       textdir,        120, STR_DIR | STR_PROTECT},
#ifndef STATIC
  {"mod-path",        moddir,         120, STR_DIR | STR_PROTECT},
#endif
  {"notify-newusers", notify_new,     120,                     0},
  {"owner",           owner,          120,           STR_PROTECT},
  {"my-ip",           myip,           120,                     0},
  {"my-hostname",     hostname,       120,                     0},
  {"network",         network,        40,                      0},
  {"whois-fields",    whois_fields,   1024,                    0},
  {"nat-ip",          natip,          120,                     0},
  {"username",        botuser,        10,                      0},
  {"version",         egg_version,    0,                       0},
  {"firewall",        firewall,       120,                     0},
  {"config",          configfile,     0,                       0},
  {"telnet-banner",   bannerfile,     120,           STR_PROTECT},
  {"logfile-suffix",  logfile_suffix, 20,                      0},
  {"timestamp-format",log_ts,         32,                      0},
  {"pidfile",         pid_file,       120,           STR_PROTECT},
  {NULL,              NULL,           0,                       0}
};

change

Code: Select all

{"version",         egg_version,    0,                       0},

into

Code: Select all

{"versions",         egg_versions,    0,                       0},

the variable verion doesn't exist then, however it has new name versions, ..

Ofloo · Post by **Ofloo** » Thu Jul 22, 2010 4:30 pm

i found a solution, however it might not be the simpelest solution.. tried various things today played with it until i got a solution.

if anyone comes up with a better solution do let me know.

Code: Select all

package require Thread

if {![info exists TID_1]} {
  set TID_1 [thread::create {thread::wait}]
}

if {![info exists TID_2]} {
  set TID_2 [thread::create {thread::wait}]
}

tsv::set MASTER thread [thread::id]

proc test_proc {nick host hand chan arg}  {
  set TM [tsv::get MASTER thread]
  after 10000
  thread::send -async $TM [list putserv "PRIVMSG $chan :DELAY 10 seconds"]
}

proc test_proc2 {nick host hand chan arg}  {
  set TM [tsv::get MASTER thread]
  thread::send -async $TM [list putserv "PRIVMSG $chan :NO DELAY"]
}

proc test_proc_pub {nick host hand chan arg}  {
  global TID_1
  thread::send -async $TID_1 [list test_proc $nick $host $hand $chan $arg]
  putserv "PRIVMSG $chan :sending crap to thread 1"
}

proc test_proc2_pub {nick host hand chan arg}  {
  global TID_2
  thread::send -async $TID_2 [list test_proc2 $nick $host $hand $chan $arg]
  putserv "PRIVMSG $chan :sending crap to thread 2"
}


bind pub -|- !test test_proc_pub
bind pub -|- !test2 test_proc2_pub

EDIT: bit more simplified version without Ttrace, also no need to edit tcl.c (version) unless you want to use Ttrace.

pseudo · Post by **pseudo** » Fri Jul 23, 2010 3:45 pm

This is a fault in ttrace.tcl, part of the Thread extension. While it perfectly makes sense for eggdrop to have a global version variable, it's inappropriate and arrogant for a script to abuse such a common name to store a temporary value for one-time use.

We won't change eggdrop's variable name due to compatibility reasons, so users should modify the ttrace.tcl script, which is easier than modifying eggdrop source anyway. We have filed a bug report for Ttrace in the hope that it will get fixed.

Post by **thommey** » Fri Jul 23, 2010 5:08 pm

Tcl's threading model is one interpreter per thread. An interpreter is like starting a fresh tclsh, without loading any extensions. I doesn't know about the "parent"s variables or commands, and so Thread interpreters don't know commands from the eggdrop extension or variables. You have to design your own message-passing ([thread::send -async]) so that the threads ask the main thread to do something eggdropish. Example:

Code: Select all

proc createusefulthread {} {
  set t [thread::create {thread::wait}]
  thread::send $t [list set ::mainthread [thread::id]]
  thread::send $t {
    proc putserv {text} {
      thread::send -async $::mainthread [list putserv $text]
    }
  }
  return $t
}

The returned thread knows how to putserv (by asking the mainthread asynchronously to do it).

Note: I set a variable in the "child" threads called $::mainthread instead of using thread-shared data, because it will always stay the same and will only ever be read, never written or changed. In general, you should consider using thread shared data if this is not the case, of course.

Ofloo · Post by **Ofloo** » Fri Jul 23, 2010 6:01 pm

hey did same thing for tpool

while thread is multi thread it's still a single process if that makes any sense, meaning if the thread::send -async is waiting the next one waits as well

there for tpool you'll notice that after 10000 doesn't have any effect on it while it does on thread for those who want it.

you could say it is more parallel

Code: Select all

namespace eval tpool_test {

  package require Thread

  tsv::set THREAD master [thread::id] 

  if {![info exists pool]} {
    variable pool [tpool::create -minworkers 1 -maxworkers 10 -idletime 120 -initcmd {

      package require Thread

      proc putserv {text {arg {}}}  {
        thread::send -async [tsv::get THREAD master] [concat putserv [list ${text}] ${arg}]
      }

      proc tpool1_proc {nick host hand chan arg}  {
        after 10000
        putserv "PRIVMSG #support :REPLY_TPOOL1:[clock seconds]"
      }

      proc tpool2_proc {nick host hand chan arg}  {
        putserv "PRIVMSG #support :REPLY_TPOOL2:[clock seconds]" -next
      }

    }]
  }

  proc tpool1_proc_pub {nick host hand chan arg}  {
    variable pool
    tpool::post -nowait $pool [list tpool1_proc $nick $host $hand $chan $arg]
    putserv "PRIVMSG $chan :TPOOL1_DELAY:[clock seconds]"
  }

  proc tpool2_proc_pub {nick host hand chan arg}  {
    variable pool
    tpool::post -nowait $pool [list tpool2_proc $nick $host $hand $chan $arg]
    putserv "PRIVMSG $chan :TPOOL2_NODELAY:[clock seconds]"
  }

  bind pub -|- !tpool1 [namespace current]::tpool1_proc_pub
  bind pub -|- !tpool2 [namespace current]::tpool2_proc_pub
}

thommey wrote:Tcl's threading model is one interpreter per thread. An interpreter is like starting a fresh tclsh, without loading any extensions. I doesn't know about the "parent"s variables or commands, and so Thread interpreters don't know commands from the eggdrop extension or variables. You have to design your own message-passing ([thread::send -async]) so that the threads ask the main thread to do something eggdropish. Example:
Code: Select all
proc createusefulthread {} {
  set t [thread::create {thread::wait}]
  thread::send $t [list set ::mainthread [thread::id]]
  thread::send $t {
    proc putserv {text} {
      thread::send -async $::mainthread [list putserv $text]
    }
  }
  return $t
}
The returned thread knows how to putserv (by asking the mainthread asynchronously to do it).

Note: I set a variable in the "child" threads called $::mainthread instead of using thread-shared data, because it will always stay the same and will only ever be read, never written or changed. In general, you should consider using thread shared data if this is not the case, of course.

great i'll give it a shot, one remark to transport variables you better, well better they made a lib to share it so and you never know when you're about to change it, ..so use tsv::set & tsv::get and putserv "text" -next << forgot this one

Code: Select all

proc createusefulthread {} {
  set t [thread::create {thread::wait}]
  tsv::set thread main $t
  thread::send $t {
    proc putserv {text {arg {}}}  {
      thread::send -async [tsv::get thread main] [concat putserv [list ${text}] ${arg}]
    }
  }
  return $t
}

pseudo wrote:This is a fault in ttrace.tcl, part of the Thread extension. While it perfectly makes sense for eggdrop to have a global version variable, it's inappropriate and arrogant for a script to abuse such a common name to store a temporary value for one-time use.

We won't change eggdrop's variable name due to compatibility reasons, so users should modify the ttrace.tcl script, which is easier than modifying eggdrop source anyway. We have filed a bug report for Ttrace in the hope that it will get fixed.

well i posted it to eggdrop cause i wasn't sure if it belonged in eggdrop or ttrace, or tcl but it's great that you posted the problem in the right place, well i wasn't suggesting you change the source merely posted a quick hack to the problem.

Ofloo · Post by **Ofloo** » Sat Jul 24, 2010 7:40 pm

Well started to think what the problem could be about that scope, .. ttrace.tcl and i came up with that they just forgot a piece of code

variable version is missing in the namespace eval

so if you like to fix ttrace.tcl just add "variable version" right after/below, "namespace eval ttrace {" and everything should work.

Code: Select all

--- ttrace.tcl  2010-07-25 01:46:47.000000000 +0200
+++ ttrace.tcl  2010-07-25 01:43:53.000000000 +0200
@@ -46,6 +46,7 @@
 
 namespace eval ttrace {
 
+    variable version
     # Setup some compatibility wrappers
     if {[info commands nsv_set] != ""} {
         variable tvers 0

Ofloo · Post by **Ofloo** » Sun Aug 18, 2013 5:21 pm

for some reason, with current 1.8.x eggdrop and tcl8.6 it that tpool_test sample only works in when i run the eggdrop with -nt for some reason, can anyone make up why?

Also there seems to be a bug in the tpool create, cause when i set -minworkers 1 it seems to block and not create new threads, .. for example if i do tpool::post -nowait it wil not create a new thread it will just wait until the others are finished even if the block the queue, so a new thread doesn't spawn, it will keep the minimum of one thread rather then creating a new one even the max is set to 10, .. so for it to do what i wanted it to do i had to set the minimum to a higher number however i don't see the point on setting max and min if it's not spawning new threads by it self.

Ofloo · Post by **Ofloo** » Tue Aug 27, 2013 6:22 am

an other thing i noticed is that the thread crashes when used after the timeout time, .. the second time first time i noticed it sometimes goes beyond.

Which made me wonder do i need additional things to keep the thread alive?