This is the new home of the egghelp.org community forum.
All data has been migrated (including user logins/passwords) to a new phpBB version.


For more information, see this announcement post. Click the X in the top right-corner of this box to dismiss this message.

"Tip of the day"

Issues often discussed about Tcl scripting. Check before posting a scripting question.
User avatar
user
 
Posts: 1452
Joined: Tue Mar 18, 2003 9:58 pm
Location: Norway

Emptyness

Post by user »

This is probably useless to most people, but if you ever need to rename a proc to "" (nothing), do

Code: Select all

rename theProc ::
An array with a short name like that can save you some typing:

Code: Select all

% array set "" {0 a 1 b}
% list $(0) $(1)
a b
An element can also have an empty string as its name:

Code: Select all

% array set "" {"" exit}
% $()
And "" is also the name of our beloved global namespace :)
Have you ever read "The Manual"?
User avatar
user
 
Posts: 1452
Joined: Tue Mar 18, 2003 9:58 pm
Location: Norway

Callbacks

Post by user »

The "proc" part of a bind is actually treated like a piece of tcl code, which means you have to make sure it's a valid list.
When the bind is invoked, the arguments are appended to your code before the whole thing is evaluated.
(like 'eval $yourCode $argsFromBind') This allows you to not only have a proc name in your bind, but also add your own argument(s).

Code: Select all

# A test proc (with a stupid name) that logs all arguments passed to it: 
<user> .tcl proc \{ args {putlog "args: $args"} 
<bot> Tcl: 

# Trying to invoke it the wrong way: 
<user> .tcl bind dcc n demo \{ 
<bot> Tcl: demo 
<user> .demo 
<bot> [16:54] Tcl error [{]: missing close-brace 

# The right way: 
<user> .tcl bind dcc n demo [list \{] 
<bot> Tcl: demo 
<user> .demo 
<bot> [16:54] args: user 8 {} 

# Adding an argument: 
<user> .tcl bind dcc n demo [list \{ newFirstArg] 
<bot> Tcl: demo 
<user> .demo 
<bot> [16:54] args: newFirstArg user 8 {}
Note: after, utimer, timer, fileevent, socket -server, and other commands that have callbacks behave in the same way.
An exception to this rule is the dns module's 'dnslookup' command. You can make dnslookup behave like it should using the following code (execute it after loading the dns module):

Code: Select all

if {![llength [info procs dnslookup]]&&[llength [info commands dnslookup]]} {
	rename dnslookup __dnslookup 
	proc dnslookup {addr code} {eval [list __dnslookup $addr __dnslookedup] $code}
	proc __dnslookedup {0 1 2 args} {uplevel #0 [concat $args [list $0 $1 $2]]}
}
...but you probably shouldn't as it will make it incompatible with existing scripts :P
Have you ever read "The Manual"?
User avatar
awyeah
Revered One
Posts: 1580
Joined: Mon Apr 26, 2004 2:37 am
Location: Switzerland
Contact:

Post by awyeah »

Heres a cool tip for the day!

If suppose you have a reguar expression:

Code: Select all

regexp {aaa|bbb|ccc|ddd|eee|fff|ggg|hhh|iii|jjj|kkk} $string
#this becomes annoyling long and not efficient enough

#a smaller way of accomplishing the exact same this is:
regexp {([a-z])\1\1+} $string

#even the + is redudant in my oppinion as for what I tested, so:
regexp {([a-z])\1\1} $string
Here is a test example to prove it works correctly:

Code: Select all

<awyeah> .tcl regexp {([a-z])\1\1} "baxcd"
<adapter> Tcl: 0

<awyeah> .tcl regexp {([a-z])\1\1} "baxxcd"
<adapter> Tcl: 0

<awyeah> .tcl regexp {([a-z])\1\1} "baxxxxcd"
<adapter> Tcl: 1

<awyeah> .tcl regexp {([a-z])\1\1} "baxxxcd"
<adapter> Tcl: 1

<awyeah> .tcl regexp {([a-z])\1\1} "baxxxxxcd"
<adapter> Tcl: 1

#for the + sign
<awyeah> .tcl regexp {([a-z])\1\1+} "baxxcd"
<adapter> Tcl: 0

<awyeah> .tcl regexp {([a-z])\1\1+} "baxxxcd"
<adapter> Tcl: 1

<awyeah> .tcl regexp {([a-z])\1\1+} "baxxxxcd"
<adapter> Tcl: 1
Every \1 is an increment for the no. of times u wana match the character.
([a-z])\1 <=-- Means that letter is present 2 times or more
([a-z])\1\1 <=-- Means that letter is present 3 times or more
and so on...
·­awyeah·

==================================
Facebook: jawad@idsia.ch (Jay Dee)
PS: Guys, I don't accept script helps or requests personally anymore.
==================================
User avatar
Sir_Fz
Revered One
Posts: 3793
Joined: Sun Apr 27, 2003 3:10 pm
Location: Lebanon
Contact:

Post by Sir_Fz »

awyeah wrote:
([a-z])\1 <=-- Means that letter is present 2 times or more
([a-z])\1\1 <=-- Means that letter is present 3 times or more
and so on...
Actually ([a-z])\1 means any alphabet repeated exactly 2 consecutive times and not 2 or more. If you add a + (which means 1 or more) then you can consider ([a-z])\1+ as any alphabet repeated exactly 2 times once or more (i.e. aa, aaaa, aaaaaa). If you're wondering why it matches 'aaa' for example, that's because 'a' is repeated 2 consecutive times at least once.
User avatar
awyeah
Revered One
Posts: 1580
Joined: Mon Apr 26, 2004 2:37 am
Location: Switzerland
Contact:

Post by awyeah »

Heres a Safe load script (errors in script wont crash the bot). It loads tcl scripts into the bot. If errors are found in that tcl, they are reported and the script is not loaded, if there are no errors it displays a message.

Explanation:
(*) When an error is found the bot gives you an error and doesn't load the script.

(*) When no error is found in the script a message similar to the one below will be displayed:

Script: tcldebug.tcl - Size: 3 kb - Status: OK

Source code:

Code: Select all

set lflags "n"
set lscriptsdir "scripts/"
set ltrigger "!"

bind pub $lflags ${ltrigger}load load:file

proc load:file {nick host hand chan text} {
    global lscriptsdir ltrigger
    set file [lindex [split $text] 0]
    if {$file == ""} {
        putserv "PRIVMSG $nick :-(Load)- ${ltrigger}load <scriptname.tcl> -(Info)-"
        return 0
    } elseif {![file exists [file join $lscriptsdir $file]]} {
        putserv "PRIVMSG $nick :-(Load)- Sorry $file doesn't exist -(Info)-"
        return 0
    } else {
        set kbsize [expr {[file size [file join $lscriptsdir/$file]] / 1024.0}]
        if {[catch {uplevel {source [file join $lscriptsdir $file]}} error]} {
            putserv "PRIVMSG $nick :-(Load)- Script: $file Size: $kbsize kb Status: Error -(Info)-"
            putserv "PRIVMSG $nick :-(Load)- $error -(Info)-"
        } else {
            putserv "PRIVMSG $nick :-(Load)- Script: $file - Size: $kbsize kb - Status: OK -(Info)-"
        }
    }
}
Usage:
You need to set the lscriptsdir to your own dir
You can also change the lflags to whatever you want

Example: your trigger is "!"

!load tcldebug.tcl
Last edited by awyeah on Tue Jul 24, 2007 11:09 am, edited 1 time in total.
·­awyeah·

==================================
Facebook: jawad@idsia.ch (Jay Dee)
PS: Guys, I don't accept script helps or requests personally anymore.
==================================
n
nml375
Revered One
Posts: 2860
Joined: Fri Aug 04, 2006 2:09 pm

Post by nml375 »

Actually, this would be a very insecure script, as it allows people to load arbitrary scripts using a public interface and no password verification or such (yes, flags are checked, but simply relying on proper hostmasks is a really bad idea, especially for a publically released script).
This is especially bad since you could load virtually any file present on the hosted system, not only the ones within lscriptsdir.
NML_375
User avatar
awyeah
Revered One
Posts: 1580
Joined: Mon Apr 26, 2004 2:37 am
Location: Switzerland
Contact:

Post by awyeah »

Well nothing is secure now adays. :P There are backdoors everywhere.

Obviously you can add checks for a specific nick!ident@some.host.com in the proc along with the flags, to make it more secure and yes a password would also be a good idea.. even then if you are not satisfied you can use a dcc trigger rather than using pub, or msgm if you're the only one who knows about the script.

I'm afraid nml375 but thats about it as secure as it gets on an eggdrop. Only a fool would give an "n" flag randomly to people like they give +f and so.

So based on today's conclusion:
Give the "n" flag to only people you really really trust and who know how to use those triggers associated with the bot owner flag. :D
·­awyeah·

==================================
Facebook: jawad@idsia.ch (Jay Dee)
PS: Guys, I don't accept script helps or requests personally anymore.
==================================
n
nml375
Revered One
Posts: 2860
Joined: Fri Aug 04, 2006 2:09 pm

Post by nml375 »

Actually, if you ask me, don't provide such functionality to public interfaces.

Hardcoding hostmasks into the script really does'nt improve anything. Remember that not all eggdrop users (who might've been thinking of using your script) might be able to use "personal hosts", but rather might have to rely on dhcp-assigned addresses.

Allowing ppl to load arbitrary scripts is a very, very bad idea. Assuming you run your eggdrop on a commercial shell, anyone else on that shell could place a malicious script on the system, and, if the hostmasks are'nt restrictive enough use this loader to load the script in question...
NML_375
User avatar
awyeah
Revered One
Posts: 1580
Joined: Mon Apr 26, 2004 2:37 am
Location: Switzerland
Contact:

Post by awyeah »

nml375 wrote:Allowing ppl to load arbitrary scripts is a very, very bad idea. Assuming you run your eggdrop on a commercial shell, anyone else on that shell could place a malicious script on the system, and, if the hostmasks are'nt restrictive enough use this loader to load the script in question...
Well that's a risk I guess they would have to take. Actually I made it for scripters, I myself sometimes miss a brace or two when I write a new script with long procs, so atleast the bot wouldn't crash and I can fix the script and then load it back into the bot. Farewell I'm off to sleep then. Gnite :D
·­awyeah·

==================================
Facebook: jawad@idsia.ch (Jay Dee)
PS: Guys, I don't accept script helps or requests personally anymore.
==================================
n
nml375
Revered One
Posts: 2860
Joined: Fri Aug 04, 2006 2:09 pm

Post by nml375 »

Upon further examination, your code will actually not load any script, as this piece of the code

Code: Select all

source [file join $lscriptsdir $file]
would be executed at global level, where file (hopefully) is not defined at all.
Proper fix would be this change:

Code: Select all

if {[catch {uplevel {source [file join $lscriptsdir $file]}} error]} {
### Change to:
if {[catch {uplevel "source [file join $lscriptsdir $file]"} error]} {
This would however allow the possible injection of malicious code using [], thus not even requiring shell access, would it not be that the "file exists" test would most likely fail prior to executing that line of code.

I would still suggest removing the possibility of loading scripts outside lscriptsdir, as this would limit the ability of loading unauthorized scripts.
NML_375
User avatar
awyeah
Revered One
Posts: 1580
Joined: Mon Apr 26, 2004 2:37 am
Location: Switzerland
Contact:

Post by awyeah »

Here is what someone asked me after scratching their head for a few days at it, because he couldn't figure it out, a very simple thing.

If you want the bot to send an OPNOTICE to the channel and you have a normal proc:

Code: Select all

proc myproc {nick uhost hand chan text} {
 putserv "NOTICE @$chan :my_text_here"
}
The idea behind something simple as this is:
People generally use the command /ONOTICE on clients such as mIRC to send opnotices, but with the eggdrop its a bit different.

=> Use a normal NOTICE followed by a "@" infront of your channel name, e.g. @#mychan to send an opnotice (send a notice to all channel ops) with your eggdrop.
*** Note: You can even use /notice @#channel with mIRC and it will work just fine.
·­awyeah·

==================================
Facebook: jawad@idsia.ch (Jay Dee)
PS: Guys, I don't accept script helps or requests personally anymore.
==================================
User avatar
user
&nbsp;
Posts: 1452
Joined: Tue Mar 18, 2003 9:58 pm
Location: Norway

Sending long messages

Post by user »

The maximum length of a single PRIVMSG is limited by a buffer allocated by the ircd for clients receiving your message. The size of this buffer is most commonly 512 bytes. Some of the space is eaten up by things that are required by the irc protocol, so to know the actual maximum length of the contents of a message, you need to subtract the length of this protocol crap. (:bot!user@host PRIVMSG target :\r\n)

Here's some code to chop long messages into suitable pieces and send the pieces as separate messages:

Code: Select all

proc msg {dest data} {
	set len [expr {512-[string len ":$::botname PRIVMSG $dest :\r\n"]}]
	foreach line [wordwrap $data $len] {
		puthelp "PRIVMSG $dest :$line"
	}
}
# wordwrap proc that accepts multiline data
# (empty lines will be stripped because there's no way to relay them via irc)
proc wordwrap {data len} {
	set out {}
	foreach line [split [string trim $data] \n] {
		set curr {}
		set i 0
		foreach word [split [string trim $line]] {
			if {[incr i [string len $word]]>$len} {
				lappend out [join $curr]
				set curr [list $word]
				set i [string len $word]
			} {
				lappend curr $word
			}
			incr i
		}
		if {[llength $curr]} {
			lappend out [join $curr]
		}
	}
	set out
}
(For this code to work, $botname must match what your bot looks like to other clients on irc, which is not always the case on networks hiding client hosts - if you're on such a network, you will have to adjust the $::botname part of the calculation)
Have you ever read "The Manual"?
User avatar
TCL_no_TK
Owner
Posts: 509
Joined: Fri Aug 25, 2006 7:05 pm
Location: England, Yorkshire

Post by TCL_no_TK »

This is losely based of my take on http://wiki.tcl.tk/1774 needed a way to limit the words in a long line of text, so came up with this, its really easy to include in other scripts/snipplets :) hope someone finds it useful
EDIT (works for me):

Code: Select all

proc makenice {tmp size} {
  set mx [llength $tmp]
  set current 0
  set total 0
   foreach t $tmp {
    set total [expr {$total+1}]
    if {($mx > $total)} {
     lappend out "$t"
     set current [expr {$current+1}]
      if {($current == $size)} {
        puts "$out"
        set current 0
        set out [list]
      }
    } else {
     lappend out [join [lrange [split $tmp] [expr {$total-1}] $mx]]
      puts "$out"
    }
   }
}
And i tested it this time :P

Code: Select all

% llength $mylist
17
% makenice $mylist 6
line1 line2 line3 line4 line5 line6
line7 line8 line9 line10 line11 line12
line13 line14 line15 line16 line17
%
This is the old code (leaving it here so post below makes sense)

Code: Select all

proc makenice {text size} {
  set mx [llength $text]
  set current 0
  set zap $size
  set total 0
  set sent 0
  set tidy [expr {$mx / $zap}]
   foreach t $text {
    if {($total != $mx)} {
     set total [expr {$total+1}]
    } else {
     break
    }
    if {($sent == $tidy)} {
     set out [join [lrange [split $text] $total $mx]]
     puts "$out"
     break
    }
     if {($current == $zap)} {
      puts "$out"
       set sent [expr {$sent+1}]
       set current 0
       set out [list]
     } else {
      lappend out "$t"
       set current [expr {$current+1}]
     }
   }
}
Example:

Code: Select all

% makenice "[lrepeat 17 "bunny-rabbits"]" "6"
bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits
bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits
bunny-rabbits bunny-rabbits
%
Last edited by TCL_no_TK on Sat Feb 19, 2011 3:46 pm, edited 1 time in total.
n
nml375
Revered One
Posts: 2860
Joined: Fri Aug 04, 2006 2:09 pm

Post by nml375 »

TCL_no_TK:
Don't treat strings as lists..

Code: Select all

llength $text
...
foreach t $text {
Also, rather then using expr all the time, use the incr command to increase the value of a variable:

Code: Select all

set total [expr {$total+1}] => incr total
This does not make any sense; you're inside a foreach-loop, and you say $mx is the length of the list your are iterating through.. Thus the loop would have completed before this conditional becomes true:

Code: Select all

if {($total != $mx)} {
     set total [expr {$total+1}]
    } else {
     break
    }
Also, your example seems to be missing 3 items, you create 17 instances of "bunny-rabbits", but I only count 14 returned.

I'd rewrite that code somewhat like this:

Code: Select all

proc makenice {text size} {
  set items [split $text]
  set length [llength $items]
  incr size -1
  for {set i 0} {$i <$length} {incr i} {
    puts [join [lrange $items $i [incr i $size]]]
  }
}
NML_375
Post Reply