View previous topic :: View next topic |
Author |
Message |
user

Joined: 18 Mar 2003 Posts: 1452 Location: Norway
|
Posted: Thu Jan 04, 2007 11:50 am Post subject: Emptyness |
|
|
This is probably useless to most people, but if you ever need to rename a proc to "" (nothing), do
An array with a short name like that can save you some typing:
Code: | % array set "" {0 a 1 b}
% list $(0) $(1)
a b |
An element can also have an empty string as its name: Code: | % array set "" {"" exit}
% $() |
And "" is also the name of our beloved global namespace  _________________ Have you ever read "The Manual"? |
|
Back to top |
|
 |
user

Joined: 18 Mar 2003 Posts: 1452 Location: Norway
|
Posted: Fri Jan 05, 2007 1:55 pm Post subject: Callbacks |
|
|
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: | # 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: | 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  _________________ Have you ever read "The Manual"? |
|
Back to top |
|
 |
awyeah Revered One

Joined: 26 Apr 2004 Posts: 1580 Location: Switzerland
|
Posted: Wed May 16, 2007 11:51 pm Post subject: |
|
|
Heres a cool tip for the day!
If suppose you have a reguar expression:
Code: |
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: |
<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.
Quote: |
([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.
================================== |
|
Back to top |
|
 |
Sir_Fz Revered One

Joined: 27 Apr 2003 Posts: 3793 Location: Lebanon
|
Posted: Tue May 22, 2007 3:21 am Post subject: |
|
|
awyeah wrote: | Quote: |
([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. _________________ Follow me on GitHub
- Opposing
Public Tcl scripts |
|
Back to top |
|
 |
awyeah Revered One

Joined: 26 Apr 2004 Posts: 1580 Location: Switzerland
|
Posted: Tue Jul 24, 2007 1:41 am Post subject: |
|
|
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:
Quote: |
(*) 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: |
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:
Quote: |
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
|
_________________ ·awyeah·
==================================
Facebook: jawad@idsia.ch (Jay Dee)
PS: Guys, I don't accept script helps or requests personally anymore.
==================================
Last edited by awyeah on Tue Jul 24, 2007 11:09 am; edited 1 time in total |
|
Back to top |
|
 |
nml375 Revered One
Joined: 04 Aug 2006 Posts: 2854
|
Posted: Tue Jul 24, 2007 9:51 am Post subject: |
|
|
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, idling at #eggdrop@IrcNET |
|
Back to top |
|
 |
awyeah Revered One

Joined: 26 Apr 2004 Posts: 1580 Location: Switzerland
|
Posted: Tue Jul 24, 2007 11:06 am Post subject: |
|
|
Well nothing is secure now adays. 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.  _________________ ·awyeah·
==================================
Facebook: jawad@idsia.ch (Jay Dee)
PS: Guys, I don't accept script helps or requests personally anymore.
================================== |
|
Back to top |
|
 |
nml375 Revered One
Joined: 04 Aug 2006 Posts: 2854
|
Posted: Tue Jul 24, 2007 11:16 am Post subject: |
|
|
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, idling at #eggdrop@IrcNET |
|
Back to top |
|
 |
awyeah Revered One

Joined: 26 Apr 2004 Posts: 1580 Location: Switzerland
|
Posted: Tue Jul 24, 2007 11:26 am Post subject: |
|
|
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  _________________ ·awyeah·
==================================
Facebook: jawad@idsia.ch (Jay Dee)
PS: Guys, I don't accept script helps or requests personally anymore.
================================== |
|
Back to top |
|
 |
nml375 Revered One
Joined: 04 Aug 2006 Posts: 2854
|
Posted: Tue Jul 24, 2007 5:35 pm Post subject: |
|
|
Upon further examination, your code will actually not load any script, as this piece of the code
Code: | 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: | 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, idling at #eggdrop@IrcNET |
|
Back to top |
|
 |
awyeah Revered One

Joined: 26 Apr 2004 Posts: 1580 Location: Switzerland
|
Posted: Fri Aug 10, 2007 8:36 am Post subject: |
|
|
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: |
proc myproc {nick uhost hand chan text} {
putserv "NOTICE @$chan :my_text_here"
}
|
The idea behind something simple as this is:
Quote: |
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.
================================== |
|
Back to top |
|
 |
user

Joined: 18 Mar 2003 Posts: 1452 Location: Norway
|
Posted: Fri Mar 14, 2008 11:10 am Post subject: Sending long messages |
|
|
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: |
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"? |
|
Back to top |
|
 |
TCL_no_TK Owner

Joined: 25 Aug 2006 Posts: 509 Location: England, Yorkshire
|
Posted: Sat Feb 19, 2011 4:25 am Post subject: |
|
|
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: | 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 Code: | % 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: | 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: | % 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
% |
_________________ TCL the misunderstood
Last edited by TCL_no_TK on Sat Feb 19, 2011 3:46 pm; edited 1 time in total |
|
Back to top |
|
 |
nml375 Revered One
Joined: 04 Aug 2006 Posts: 2854
|
Posted: Sat Feb 19, 2011 9:23 am Post subject: |
|
|
TCL_no_TK:
Don't treat strings as lists..
Code: | 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: | 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: | 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: | 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, idling at #eggdrop@IrcNET |
|
Back to top |
|
 |
|
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
|
|