01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

#!/usr/bin/env tclsh8.6
# portscan.tcl

package require Tcl 8.6

# Helper function 1 (uplevel executes in callers stack - just code grouping)
proc portscan_getfeedback {} {
    uplevel 1 {
        lassign [yield] s port state
        incr myconns -1
        while {$state eq "timeout" && $port in $notimeoutports} {
            lassign [yield] s port state
        }
    }
}
# Helper function 2 (uplevel executes in callers stack - just code grouping)
proc portscan_assignstate {} {
    uplevel 1 {
        if {$state eq "open"} {
            lappend notimeoutports $port
            if {[fconfigure $s -error] eq ""} {
                lappend openports $port
            }
        }
        catch {close $s}
    }
}
# Here's the real thing.
# Syntax: portscan IP [list PORT1 PORT2 ..] MAXCONNECTIONS TIMEOUT_IN_MS CALLBACKPROC ARGUMENTS FOR CALLBACK
# ** The callback will automatically get a list of open ports as last argument! **
# Ex: portscan 127.0.0.1 {80 8080 3128 22 21 23 119} 3 5000 puts
# This MUST be called *in/from* a coroutine
proc portscan {ip ports conns timeout callback args} {
    set myconns 0
    set openports [list]
    set notimeoutports [list]
    foreach port $ports {
        set s [socket -async $ip $port]
        fileevent $s writable [list [info coroutine] [list $s $port open]]
        after $timeout catch [list [list [info coroutine] [list $s $port timeout]]]
        incr myconns
        if {$myconns < $conns} {
            continue
        } else {
            portscan_getfeedback
            portscan_assignstate
        }
    }
    while {$myconns} {
        portscan_getfeedback
        portscan_assignstate
    }
    $callback {*}$args $openports
}
proc testscan {ip ports conns timeout} {
    coroutine simplescan portscan $ip $ports $conns $timeout [info coroutine]
    set openports [yield]
    puts "Open ports: $openports"
    exit 0
}
if {[llength $argv] != 4} {
    puts "Syntax: $argv0 <ip> <port1,port2,..> <connections> <timeout in ms>"
    puts "Ex: $argv0 127.0.0.1 80,3128,8080,22,23 2 2500"
    exit 1
}
lassign $argv ip ports conns timeout
coroutine testscan_1 testscan $ip [split $ports ,] $conns $timeout
vwait forever

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

proc Int2Hex {data} {
    if {![string is digit -strict $data]} {return -1}
    set str "0123456789abcdefghijklmnopqrstuvwxyz"; set text ""
    set i [expr {$data & 15}]; set r [expr {$data / 16}]
    set text [string index $str $i]
    while {$r>0} {
        set i [expr {$r & 15}]; set r [expr {$r / 16}]
        set text "[string index $str $i]$text"
    }
    return $text
}

proc conv {text} {
    foreach ch [split $text ""] {
        if {[scan $ch %c]<27} {
            set text [string map [list $ch [format %c [expr {[scan $ch %c]+64}]]] $text]
        }
    }
    return $text
}

proc puthex {data {saddr 0}} {
    set pos 0; set sw 0; set hex(0) ""; set hex(1) ""; set text(0) ""; set text(1) "";
    while {[string length $data]>0} {
        set spos [string range "0000[Int2Hex $pos]" end-3 end]
        if {$saddr!=0} {
            set stpos [string range "0000[Int2Hex [expr {$pos+$saddr}]]" end-3 end]
        } {set stpos ""}
        if {[string length $data]<8} {
            set text($sw) $data
            incr pos [string length $data]
            binary scan $data H* hex($sw)
            set data ""
        } {
            incr pos 8
            binary scan $data H16 hex($sw)
            set text($sw) [string range $data 0 7]
            set data [string range $data 8 end]
        }
        set sw [expr {$sw^1}]
        if {[string length $data]<8} {
            set text($sw) $data
            incr pos [string length $data]
            binary scan $data H* hex($sw)
            set data ""
        } {
            incr pos 8
            binary scan $data H16 hex($sw)
            set text($sw) [string range $data 0 7]
            set data [string range $data 8 end]
        }
        set sw [expr {$sw^1}]
        set txt(0) ""; foreach {ch0 ch1} [split $hex(0) ""] {append txt(0) "$ch0$ch1 "}; append txt(0) "                        "; set txt(0) [string range $txt(0) 0 22]
        set txt(1) ""; foreach {ch0 ch1} [split $hex(1) ""] {append txt(1) "$ch0$ch1 "}; append txt(1) "                        "; set txt(1) [string range $txt(1) 0 22]
        set text(0) [string range "[conv $text(0)]        " 0 7]
        set text(1) [string range "[conv $text(1)]        " 0 7]
        if {$stpos!=""} {
            putcmdlog "0x$stpos | 0x$spos | $txt(0) | $txt(1) | $text(0) | $text(1)"
        } {
            putcmdlog "0x$spos | $txt(0) | $txt(1) | $text(0) | $text(1)"
        }
        set hex(0) ""; set hex(1) ""; set text(0) ""; set text(1) "";
    }
}

01
02
03
04
05
06
07
08
09
10

if {![info exists ::errortracer]} { set ::errortracer 1; trace add variable ::errorInfo write redirecterror }
proc redirecterror {n1 n2 op} {
    set ::olddblvalue ${::double-help}
    set ::double-help 0
    foreach line [split $::errorInfo \n] {
        puthelp "PRIVMSG #debug :$line"
    }
    set ::double-help $::olddblvalue
}

001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202

--- nagelfar.tcl    2009-07-19 19:18:25.421025665 +0200
+++ nagelfar.tcl    2009-10-27 13:36:48.181154390 +0100
@@ -24,10 +24,10 @@
 # $Revision: 424 $
 #----------------------------------------------------------------------
 # the next line restarts using tclsh \
-exec tclsh "$0" "$@"
+exec tclsh8.5 "$0" "$@"
 
 set debug 0
-package require Tcl 8.4
+package require Tcl 8.5
 
 package provide app-nagelfar 1.0
 set version "Version 1.1.9 2008-09-05"
@@ -132,9 +132,19 @@
     }
 }
 
+proc Text2Html {data} {
+   string map {\& \&amp; \< \&lt; \> \&gt; \" \&quot;} $data
+}
+
 # Standard error message.
 # severity : How severe a message is E/W/N for Error/Warning/Note
 proc errorMsg {severity msg i} {
+    if {$::Prefs(html)} {
+      set msg [Text2Html $msg]
+      if {$msg == "Expr without braces"} { append msg " (see <a href=\"http://tclhelp.net/unb/194\" target=\"_tclforum\">http://tclhelp.net/unb/194</a>)" }
+    }
+    if {[string match debug* $msg]} { return 0 }
+
     if {[info exists ::Nagelfar(currentMessage)] && \
             $::Nagelfar(currentMessage) != ""} {
         lappend ::Nagelfar(messages) [list $::Nagelfar(currentMessageLine) \
@@ -157,7 +167,15 @@
         set pre "$::currentFile: "
     }
     set line [calcLineNo $i]
+
+    switch -exact -- $severity {
+        E { set color "#DD0000"; set severity "ERROR" }
+        W { set color "#FFAA00"; set severity "WARNING" }
+        N { set color "#66BB00"; set severity "NOTICE" }
+    }
     set pre "${pre}Line [format %3d $line]: $severity "
+    if {$::Prefs(html)} { set pre "<a href=#$::Prefs(prefix)$line>Line [format %3d $line]</a>: <font color=$color><strong>$severity</strong></font>: " }
+
     set ::Nagelfar(indent) [string repeat " " [string length $pre]]
     set ::Nagelfar(currentMessage) $pre$msg
     set ::Nagelfar(currentMessageLine) $line
@@ -180,6 +198,27 @@
     set ::Nagelfar(commentbrace) {}
 }
 
+proc sortmsgs {msg1 msg2} {
+  if {$msg1 == $msg2} { return 0 }
+  set htmlmask "href=#$::Prefs(prefix)(\\d+)>"
+  set normmask "Line\\s+(\\d+):"
+  if {![info exists ::sortRE]} {
+    if {$::Prefs(html)} { set ::sortRE $htmlmask } else { set ::sortRE $normmask }
+    # cache
+    regexp -- $::sortRE ""
+  } 
+  regexp -- $::sortRE $msg1 -> line1
+#puts "Matching '$re' against '$msg1' -> [info exists line1]"
+  regexp -- $::sortRE $msg2 -> line2
+#puts "Matching '$re' against '$msg2' -> [info exists line2]"
+  if {![info exists line1] || ![info exists line2]} {
+     puts stderr "Could not sort messages! Wrong format! (html: $::Prefs(html))"; return -1
+  }
+  if {$line1 > $line2} { return 1 } else { return -1 }
+  return 0
+}
+
+
 # Called after a file has been parsed, to flush messages
 proc flushMsg {} {
     if {[info exists ::Nagelfar(currentMessage)] && \
@@ -187,7 +226,8 @@
         lappend ::Nagelfar(messages) [list $::Nagelfar(currentMessageLine) \
                 $::Nagelfar(currentMessage)]
     }
-    set msgs [lsort -integer -index 0 $::Nagelfar(messages)]
+#    set msgs [lsort -integer -index 0 $::Nagelfar(messages)]
+    set msgs [lsort -unique -increasing -command sortmsgs $::Nagelfar(messages)]
     foreach msg $msgs {
         set text [lindex $msg 1]
         set print 1
@@ -385,6 +425,7 @@
             if {$i == -1} {
                 # This should never happen since no incomplete lines should
                 # reach this function.
+#         puts "Unable to parse this line. Missing ' ' before '\{' perhaps? (Line [expr {$index + $i}])"
                 decho "Internal error: Did not find close char in scanWord.\
                         Line [calcLineNo $index]."
                 return $len
@@ -1591,6 +1632,7 @@
     # If the command contains substitutions we can not determine
     # which command it is, so we skip it, unless the type is known
     # to be an object.
+
     if {($cmdws & 1) == 0} {
         if {[string match "_obj,*" $cmdtype]} {
             set cmd $cmdtype
@@ -1630,6 +1672,7 @@
     # have their own special check implemented here.
     # Any command that can be checked by checkCommand should
     # be in the syntax database.
+
     switch -glob -- $cmd {
     proc {
         if {$argc != 3} {
@@ -1651,11 +1694,22 @@
         parseProc $argv $indices
             set noConstantCheck 1
     }
-    .* { # FIXA, check code in any -command.
-             # Even widget commands should be checked.
-         # Maybe in checkOptions ?
-        return
-    }
+        bind { # eggdrop bind!
+            if {$argc != 3 && $argc != 4} { WA; return }
+            foreach {type flags keyw cmd} $argv { break }
+            switch -exact -- [string tolower $type] {
+                load - unld - evnt - disc { set argnum 1 }
+                link - nkch - filt - need - wall - chon - choff { set argnum 2 }
+                sent - rcvd - note - act - bcst - chat - raw - bot - fil - away - dcc { set argnum 3 }
+                msg - msgm - splt - rejn - chpt - join { set argnum 4 }
+                flud - time - nick - notc - sign - topc - lost - tout - pub - pubm - part { set argnum 5 }
+                mode - ctcp - ctcr - chjn - kick { set argnum 6 }
+                default { errorMsg W "Unknown bind type: $type" $index; return }
+            }
+            set appendstr [string repeat " bla" $argnum]
+            append cmd $appendstr
+            parseBody $cmd [lindex $indices 3] knownVars
+       }
     global {
         foreach var $argv ws $wordstatus {
         if {$ws & 1} {
@@ -2348,9 +2402,9 @@
                     if {$tmp != $closeBrace} {
                         # Only do this if there is a free open brace
                         if {[regexp "\{\n" $tryline]} {
-                            errorMsg N "Close brace not aligned with line\
-                                    [calcLineNo $index] ($tmp $closeBrace)" \
-                                    $closeBraceIx
+#                            errorMsg N "Close brace not aligned with line\
+#                                    [calcLineNo $index] ($tmp $closeBrace)" \
+#                                    $closeBraceIx
                         }
                     }
                 }
@@ -3626,6 +3680,7 @@
 
 # Make next "E" error visible
 proc seeNextError {} {
+
     set w $::Nagelfar(resultWin)
     set lineNo [lindex [split [$w index insert] .] 0]
 
@@ -4716,6 +4771,8 @@
         editor internal
         extensions {.tcl .test .adp .tk}
         exitcode 0
+        html 0
+        prefix ""
     }
 
     # Do not load anything during test
@@ -4834,6 +4891,8 @@
  -encoding <enc>   : Read script with this encoding.
  -filter <p>       : Any message that matches the glob pattern is suppressed.
  -severity <level> : Set severity level filter to N/W/E (default N).
+ -html             : Generate html-output.
+ -prefix <pref>    : Prefix for line anchors (html output)
  -novar            : Disable variable checking.
  -WexprN           : Sets expression warning level to N.
    2 (def)         = Warn about any unbraced expression.
@@ -5042,6 +5101,13 @@
                     exit
                 }
             }
+            -html {
+                set ::Prefs(html) 1
+            }
+            -prefix {
+                incr i
+                set ::Prefs(prefix) [lindex $argv $i]
+            }
          -tab {
                 incr i
                 set arg [lindex $argv $i]
@@ -5112,6 +5178,7 @@
     }
 
     doCheck
+
     #_dumplogme
     #if {[array size _stats] > 0} {
     #    array set _apa [array get _stats]

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

set webdir "/home/public_www/tcl/"
set website "http://shell7.powershells.de/~tcl/"
bind msg - paste paste
proc paste {n u h t} {
    global paste
    set paste($n) ""
    putserv "PRIVMSG $n :Ok, now you may paste your script. Use\"endpaste\" if you're finished."
    return 1
}
bind msgm - * pasteapp
proc pasteapp {n u h t} {
    global paste
    if {![info exists paste($n)]} { return 0 }
    if {$t == "paste" || $t == "endpaste"} { return 0 }
    lappend paste($n) $t
}
bind msg - endpaste endpaste
proc endpaste {n u h t} {
    global paste webdir website
    if {![info exists paste($n)]} {
        putserv "PRIVMSG $n :\"endpaste\" without \"paste\". Ignoring."
        return 1
    }
    if {$paste($n) == ""} {
        putserv "PRIVMSG $n :No text stored. Please retry."
        return 1
    }
    regsub -nocase -- {[^a-zA-Z0-9|-]} $n {} n2
    set fs [open [file join $webdir $n2.html] w]
    puts $fs "<html><head><title>Paste on [clock format [clock seconds]] from $n</title></head><body>"
    set cnt 1
    foreach line $paste($n) {
        regsub -all {\t} $line {\&nbsp;\&nbsp;\&nbsp;\&nbsp;} line
        puts $fs "$cnt[str {&nbsp;} [expr {4 - [string length $cnt]}]]&nbsp;$line<br>"
        incr cnt
    }
    puts $fs "</body></html>"
    close $fs
    unset paste($n)
    putserv "PRIVMSG $n :$website$n2.html generated."
}
proc str {str tms} {
    set res ""
    for {set i 1} {$i <= $tms} {incr i} {
        append res $str
    }
    return $res
}

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

set webdir "/home/public_www/tcl/"
set website "http://shell7.powershells.de/~tcl/"
bind msg - paste paste
proc paste {n u h t} {
    if {[info commands coro_paste_$n] == ""} {
        coroutine coro_paste_$n paste_template $n; # create the coroutine from the template
    } else {
        coro_paste_$n $t; # continue the existing coroutine for this user
    }
}
proc paste_template {n} {
    global webdir website
    putserv "PRIVMSG $n :Ok, now you may paste your script. Use\"endpaste\" if you're finished."
    regsub -nocase -- {[^a-zA-Z0-9|-]} $n {} n2
    set fs [open [file join $webdir $n2.html] w]
    puts $fs "<html><head><title>Paste on [clock format [clock seconds]] from $n</title></head><body>"
    set linenr 0
    # the yield here pauses and waits, returns the argument with which the coroutine is continued
    while {[set text [yield]] != "endpaste"} {
        regsub -all {\t} $text {\&nbsp;\&nbsp;\&nbsp;\&nbsp;} text
        puts $fs "$linenr[str {&nbsp;} [expr {4 - [string length $linenr]}]]&nbsp;$text<br>"
        incr linenr
    }
    puts $fs "</body></html>"
    close $fs
    putserv "PRIVMSG $n :$website$n2.html generated."
}

proc str {str tms} {
    set res ""
    for {set i 1} {$i <= $tms} {incr i} {
        append res $str
    }
    return $res
}

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

package require Tcl 8.6

bind raw - 354 who_info
bind raw - 315 end_of_who
bind pub - !auth who_pubcmd

proc who_pubcmd {nick host hand chan text} {
    if {$text == ""} {
        putserv "PRIVMSG $chan :Please specify a nickname"
        return 0
    }
    set text [lindex [split $text] 0]
    if {[info commands lookupwho_$text] ne ""} {
        putserv "PRIVMSG $chan :Sorry, already resolving the auth for that nickname, wait"
        return 0
    }
    coroutine lookupwho_$text lookupwho $text $chan
    return 0
}
proc lookupwho {nick chan} {
    putserv "WHO $nick n%na"
    set auth [yield]
    if {$auth eq ""} {
        putserv "PRIVMSG $chan :$nick is not on the network."
    } elseif {$auth eq "0"} {
        putserv "PRIVMSG $chan :$nick is not authed."
    } else {
        putserv "PRIVMSG $chan :$nick is authed as $auth"
    }

}
# ANSWER from server: End of /who - we got reply already?
proc end_of_who {from keyword text} {
    set targetnick [lindex [split $text] 1]
    if {[info commands lookupwho_$targetnick] ne ""} {
        lookupwho_$targetnick ""
        return 1
    }
    return 0
}

proc who_info {from keyword text} {
    if {[llength [set text [split $text]]] != 3} {
        return 0
    }
    set targetnick [lindex $text 1]
    set auth [lindex $text 2]
    if {[info commands lookupwho_$targetnick] ne ""} {
        lookupwho_$targetnick $auth
        return 1
        # return 1: Eggdrop will not parse it, so you can use a format you like
    }
    return 0
}

01
02
03
04
05
06
07
08
09
10
11
12
13
14

proc readdata {cid} {
    if {[gets $cid data] < 0} {
        puts "Socket closed by remote host."; close $cid; return
    }
    puts "Incoming data: $data"
    if {[lindex [split $data] 0] == "PING"} {
        puts $cid "PONG [lindex [split $data] 1]"
    }
}
set sid [socket irc.quakenet.org 6667]
fconfigure $sid -buffering line
fileevent $sid readable "readdata $sid"
puts $sid "NICK hauth"
puts $sid "USER hauth * * :hauth"

01
02
03
04
05
06
07
08
09
10
11
12
13
14

set listenport 8749
socket -server accept_connection $listenport
proc accept_connection {cid ip port} {
    puts "Incoming Connection from $ip:$port"
    fconfigure $cid -buffering line
    fileevent $cid readable "readdata $cid"
}
proc readdata {cid} {
    if {[gets $cid data] < 0} {
        puts "Socket closed by remote host."; close $cid; return
    }
    puts "Incoming data: $data"
}

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79

proc safesay {dest text {queue putserv} {action PRIVMSG}} {
    set action [string toupper $action]
    set hardlimit 510
    set prefix ":$::botname PRIVMSG $dest :"
    incr hardlimit -[string length $prefix]
    set softlimit $hardlimit
    incr softlimit -100
    if {[lsearch -exact {putserv puthelp putquick} $queue] == -1} {
        error "bad queue \"$queue\": must be putserv, puthelp or putquick"
    }
    if {[lsearch -exact {PRIVMSG NOTICE} $action] == -1} {
        error "bad action \"$action\": must be PRIVMSG or NOTICE"
    }
    set temp [list]
    set ::text65 $text
    while {[string length [join $::text65]]} {
        $queue "$action $dest :[getoneline ::text65 $softlimit $hardlimit]"
    }
}
proc lowest {list} {
    foreach e $list {
        if {![info exists min]} { set min $e; continue }
        if {$e < $min && $e != -1} { set min $e }
    }
    return $min
}
proc getoneline {varname softlimit hardlimit} {
    set $varname [split [set $varname]]; set textnew [set $varname]
    set temp [list]; set tempnew [list]
    # temp contains the text to send
    if {[string length [lindex [set $varname] 0]] >= $hardlimit} {
        set temp "[string range [set $varname] 0 [expr $hardlimit - 2]]-"
        set $varname [string range [set $varname] [expr $hardlimit - 1] end]
        return $temp
    }
    while {[string length [join $tempnew]] < $softlimit && [string length [set $varname]]} {
        # as long as we're shorter than $softlimit, append
        set $varname $textnew
        set temp $tempnew
        # $tempnew and $textnew are set in the next iteration. they're set delayed 1 cycle to catch the text _before_ we exceed the limit
        # so we clearly stay lower then the limit here
        lappend tempnew [lindex [set $varname] 0]
        set textnew [lrange [set $varname] 1 end]
    }
    # we're longer than $softlimit and are trying to finish the sentence by finding punctuations
    set s1pos [lsearch -glob [set $varname] *.]
    set s2pos [lsearch -glob [set $varname] *\\?]
    set s3pos [lsearch -glob [set $varname] *,]
    set s4pos [lsearch -glob [set $varname] *!]
    set lowest [lowest [list $s1pos $s2pos $s3pos $s4pos]]
    set tempnew $temp; set textnew [set $varname]
    if {$lowest != -1} {
        while {$lowest > -1 && [string length [set $varname]]} {
            set tempnew [concat $temp [lrange [set $varname] 0 $lowest]]; incr lowest
            set textnew [lrange [set $varname] $lowest end]
            set s1pos [lsearch -glob $textnew *.]
            set s2pos [lsearch -glob $textnew *\\?]
            set s3pos [lsearch -glob $textnew *,]
            set s4pos [lsearch -glob $textnew *!]
            set lowest [lowest [list $s1pos $s2pos $s3pos $s4pos]]
            if {[string length [join $tempnew]] < $hardlimit} {
                set temp $tempnew
                set $varname $textnew
            } else { break }
        }
        return [join $temp]
    }
    # no punctuations :(
    set textnew [set $varname]; set tempnew $temp
    while {[string length [join $tempnew]] < $hardlimit  && [string length [set $varname]]} {
        # shorter than $softlimit, append words
        set $varname $textnew
        set temp $tempnew
        # $tempnew and $textnew set delayed as above
        lappend tempnew [lindex [set $varname] 0]
        set textnew [lrange [set $varname] 1 end]
    }
    return [join $temp]
}

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22

bind pubm - * triggercheck
proc triggercheck {nick host hand chan text} {
    set word1 [lindex [split $text] 0]
    set cmd [lindex [split $text] 1]
    set rest [join [lrange [split $text] 2 end]]
    if {![isbotnick $word1]} { return }
    switch -exact -- [string tolower $cmd] {
        "op" {
            if {![matchattr $hand o|o $chan]} { putserv "PRIVMSG $chan :No access"; return }
            if {![onchan $rest $chan]} { putserv "PRIVMSG $chan :$rest is not here"; return }
            putserv "MODE $chan +o $rest"
        }
        "voice" {
            if {![matchattr $hand o|o $chan]} { putserv "PRIVMSG $chan :No access"; return }
            if {![onchan $rest $chan]} { putserv "PRIVMSG $chan :$rest is not here"; return }
            putserv "MODE $chan +v $rest"
        }
        default {
            putserv "PRIVMSG $chan :Unknown command: $cmd"
        }
    }
}

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16

bind pub - !dns dns
proc dns {nick host hand chan text} {
    set query $text
    dnslookup $query dns_callback $chan $nick $query
}
proc dns_callback {ip addr state chan nick query} {
    if {!$state} {
        putserv "PRIVMSG $chan :\002$nick\002, failed to look up \002$query\002"
        return
    }
    if {$query == $ip} {
        putserv "PRIVMSG $chan :\002$nick\002 $ip->$addr"
    } else {
        putserv "PRIVMSG $chan :\002$nick\002 $addr->$ip"
    }
}

01
02
03
04
05
06
07
08
09
10

# Returns a random line out of $file (error if it doesnt exist)
proc randline {file} {
    set fs [open $file r]
    set data [read $fs]
    close $fs
    # Now we have the complete content of $file stored in $data
    set data [split $data \n]
    # Now it's a list of lines, and we use eggdrop's "rand" function to get a random element from it (and return it)
    return [lindex $data [rand [llength $data]]]
}

1
2
3
4
5
6
7
8

proc getchanlimit {chan} {
    set chanmode [lindex [split [getchanmode $chan]] 0]
    if {[string first l $chanmode] == -1} { return 0 }
    if {[string first k $chanmode] == -1 || [string first k $chanmode] > [string first l $chanmode]} {
        return [lindex [split $chanmode] 1]
    }
    return [lindex [split $chanmode] 2]
}

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15

set greetmsgs {
    "Hi, how are you?"
    "Hi $nick!"
    "Hello $nick, welcome to $chan"
    "]]] WELCOME to $chan!!!11111 ^^ ^^ [[["
    "Hi [$nick], you have to pay 20$ to enter here"
}

bind join - * greet
proc greet {nick host hand chan} {
    set greetmsg [lindex $::greetmsgs [rand [llength $::greetmsgs]]]
    set greetmsg [subst -nocommands $greetmsg]
    putserv "PRIVMSG $nick :$greetmsg"
}

01
02
03
04
05
06
07
08
09
10
11

bind pub - !lagcheck lagcheck
proc lagcheck {n u h c t} {
    set ::laganswer([set ticks [clock clicks -milliseconds]]) $c
    putserv "$ticks"
}
bind raw - 421 laganswer
proc laganswer {f k t} {
    if {[info exists ::laganswer([set ticks [lindex [split $t] 1]])]} {
        putserv "PRIVMSG $::laganswer($ticks) :Lag: [expr {[clock clicks -milliseconds] - $ticks}] ms"
    }
}