Posted to tcl by Army at Sat Oct 24 19:07:32 GMT 2026view raw

  1. # antiflood.tcl - Eggdrop script (Eggdrop 1.9+ for UTF-8, bot must be IRCop)
  2. # Add to eggdrop.conf: source scripts/antiflood.tcl
  3. # Also: .+chan #shqiperia .+chan #shoqeria .+chan #opers
  4. # Commands (in #opers): .sh add nick/ip | .sh rem nick/ip | .sh list
  5. # .f on | .f off | .f list | .f help (list/help answer in Albanian)
  6. # .f add 3:1 / .f del 3:1 -> rule: 3 similar lines in 1 second (count:seconds)
  7. # .f add 50 / .f del 50 -> only check texts with at least 50 characters
  8. # .f add shuntime 5 / 10 / 15 -> shun time in minutes (default 5); .f del shuntime -> back to 5
  9. # .f emoji on/off -> on: emoji-only text is not shunned; off: it is checked too
  10. # (trailing emoji after a text are always ignored when comparing, so text+emoji flood is shunned)
  11.  
  12. # UTF-8: Eggdrop 1.9+ is already UTF-8 -> keep utf8conv 0.
  13. # Eggdrop 1.8 passes raw bytes -> set utf8conv 1 and the script decodes input / encodes output itself.
  14. array set fl {
  15. utf8conv 0 opers #opers sim 0.80 minlen 8 deflen 8 emojiex 1
  16. shunmin 5 defshun 5 emojishun 60 irccloudshun 60 on 1 oper_user botoper oper_pass operpass
  17. }
  18. set fl(chans) {#shqiperia #shoqeria}
  19. set fl(hist) {}
  20. set fl(alerts) {} ;# notice batches: dicts {norm text chans items ts}
  21. set fl(known) {} ;# flood texts remembered until 00:00 UTC: {norm text ts}
  22. set fl(day) [clock format [clock seconds] -format %Y-%m-%d -gmt 1]
  23. set fl(rules) {{2 1}} ;# {lines seconds}: 2 similar lines in 1 second
  24. set fl(shuns) {}
  25.  
  26. proc fl:put {line} {
  27. global fl
  28. if {$fl(utf8conv)} {set line [encoding convertto utf-8 $line]}
  29. putserv $line
  30. }
  31. proc fl:in {s} {
  32. global fl
  33. if {$fl(utf8conv)} {return [encoding convertfrom utf-8 $s]}
  34. return $s
  35. }
  36. proc fl:say {m} {global fl; fl:put "PRIVMSG $fl(opers) :$m"}
  37. proc fl:hms {{t ""}} {if {$t eq ""} {set t [clock seconds]}; clock format $t -format %H:%M:%S}
  38. proc fl:nop {ip} {}
  39. proc fl:isip {x} {expr {[regexp {^[0-9.]+$} $x] || [regexp {^[0-9a-fA-F:]*:[0-9a-fA-F:]*$} $x]}}
  40.  
  41. # emoji helpers (Eggdrop 1.9+ UTF-8)
  42. proc fl:isemo {n} {
  43. expr {$n <= 32 || ($n >= 0xD800 && $n <= 0xDFFF) || ($n >= 0x1F000 && $n <= 0x1FAFF)
  44. || ($n >= 0xE0020 && $n <= 0xE007F) || ($n >= 0x2190 && $n <= 0x21FF)
  45. || ($n >= 0x2300 && $n <= 0x23FF) || ($n >= 0x2600 && $n <= 0x27BF)
  46. || ($n >= 0x2B00 && $n <= 0x2BFF) || $n == 0xFE0F || $n == 0x200D || $n == 0x20E3}
  47. }
  48. proc fl:nocodes {text} {
  49. regsub -all {\u0003[0-9]{0,2}(,[0-9]{1,2})?|[\u0002\u000f\u0016\u001d\u001e\u001f]} $text "" text
  50. return $text
  51. }
  52. proc fl:nozw {text} { ;# remove invisible chars (zero-width, soft hyphen, BOM...)
  53. regsub -all {[\u00ad\u180e\u200b\u200c\u200e\u200f\u2060-\u2064\ufeff]} $text "" text
  54. return $text
  55. }
  56. proc fl:fold {text} { ;# fullwidth ASCII (U+FF01-FF5E) -> plain ASCII, then lower case
  57. set out ""
  58. foreach c [split $text ""] {
  59. scan $c %c n
  60. if {$n >= 0xFF01 && $n <= 0xFF5E} {set c [format %c [expr {$n - 0xFEE0}]]}
  61. append out $c
  62. }
  63. return [string tolower $out]
  64. }
  65. # text for matching: no IRC colors, no invisible chars, no trailing emoji/spaces, folded
  66. proc fl:norm {text} {
  67. set text [fl:nozw [fl:nocodes $text]]
  68. set i [expr {[string length $text] - 1}]
  69. while {$i >= 0} {
  70. scan [string index $text $i] %c n
  71. if {![fl:isemo $n]} break
  72. incr i -1
  73. }
  74. fl:fold [string range $text 0 $i]
  75. }
  76.  
  77. # at 00:00 UTC delete all remembered texts
  78. proc fl:utcreset {} {
  79. global fl
  80. set today [clock format [clock seconds] -format %Y-%m-%d -gmt 1]
  81. if {$today ne $fl(day)} {set fl(day) $today; set fl(known) {}}
  82. }
  83.  
  84. # similarity 0..1 (Levenshtein ratio)
  85. proc fl:sim {a b} {
  86. set a [string tolower $a]; set b [string tolower $b]
  87. set la [string length $a]; set lb [string length $b]
  88. if {$la == 0 || $lb == 0} {return 0.0}
  89. set prev {}
  90. for {set j 0} {$j <= $lb} {incr j} {lappend prev $j}
  91. for {set i 1} {$i <= $la} {incr i} {
  92. set cur [list $i]; set ca [string index $a [expr {$i-1}]]
  93. for {set j 1} {$j <= $lb} {incr j} {
  94. set cost [expr {$ca eq [string index $b [expr {$j-1}]] ? 0 : 1}]
  95. lappend cur [expr {min([lindex $prev $j]+1, [lindex $cur [expr {$j-1}]]+1, [lindex $prev [expr {$j-1}]]+$cost)}]
  96. }
  97. set prev $cur
  98. }
  99. expr {1.0 - double([lindex $prev $lb]) / max($la, $lb)}
  100. }
  101.  
  102. # is norm >= 80% similar to a text remembered today?
  103. proc fl:hit {norm} {
  104. global fl
  105. set lb [string length $norm]
  106. foreach k $fl(known) {
  107. set a [lindex $k 0]
  108. set la [string length $a]
  109. set mx [expr {max($la, $lb, 1)}]
  110. if {double(abs($la - $lb)) / $mx > 1.0 - $fl(sim)} continue ;# too different in length
  111. if {[fl:sim $a $norm] >= $fl(sim)} {return 1}
  112. }
  113. return 0
  114. }
  115.  
  116. # run "fn ip" once the IP of nick is known (WHOIS as IRCop)
  117. proc fl:withip {nick fn} {
  118. global fl
  119. set k [string tolower $nick]
  120. if {[info exists fl(ip,$k)]} {{*}$fn $fl(ip,$k)} else {
  121. set fl(pend,$k) $fn
  122. fl:put "WHOIS $nick"
  123. }
  124. }
  125.  
  126. bind raw - 311 fl:r311
  127. proc fl:r311 {from key text} { ;# WHOIS: nick ident host * :realname
  128. global fl
  129. set w [split [fl:in $text]]
  130. set fl(ident,[string tolower [lindex $w 1]]) [lindex $w 2]
  131. return 0
  132. }
  133.  
  134. bind raw - 378 fl:r378
  135. proc fl:r378 {from key text} {
  136. global fl
  137. set text [fl:in $text]
  138. set w [split $text]
  139. set k [string tolower [lindex $w 1]]
  140. set fl(ip,$k) [lindex $w end]
  141. set fl(host,$k) [lindex [split [lindex $w end-1] @] end] ;# real host from "*@host ip"
  142. if {[info exists fl(pend,$k)]} {
  143. set fn $fl(pend,$k); unset fl(pend,$k)
  144. {*}$fn $fl(ip,$k)
  145. }
  146. return 1
  147. }
  148.  
  149. bind sign - * fl:sign
  150. proc fl:sign {nick uhost hand chan reason} {
  151. global fl; set nick [fl:in $nick]; foreach v {ip ident host} {catch {unset fl($v,[string tolower $nick])}}
  152. }
  153.  
  154. # does the text end with emoji (after some real text)?
  155. proc fl:tailemoji {text} {
  156. set t [fl:nozw [fl:nocodes $text]]
  157. set i [expr {[string length $t] - 1}]
  158. while {$i >= 0} {
  159. scan [string index $t $i] %c n
  160. if {![fl:isemo $n]} break
  161. incr i -1
  162. }
  163. set head [string range $t 0 $i]
  164. set tail [string range $t [expr {$i + 1}] end]
  165. expr {[string trim $head] ne "" && [string trim $tail] ne ""}
  166. }
  167.  
  168. # IRCCloud user (real host *.irccloud.com, ident uid123456) -> returns the ident, else ""
  169. proc fl:irccloud {nick} {
  170. global fl
  171. set k [string tolower $nick]
  172. if {![info exists fl(host,$k)] || ![info exists fl(ident,$k)]} {return ""}
  173. set u [string trimleft $fl(ident,$k) ~]
  174. if {[string match -nocase *irccloud.com $fl(host,$k)] && [regexp -nocase {^[us]id[0-9]+$} $u]} {return $u}
  175. return ""
  176. }
  177.  
  178. proc fl:shun {nick text chans emo ip} {
  179. global fl
  180. set id [fl:irccloud $nick] ;# shared IRCCloud IP -> shun the ident instead
  181. set mask [expr {$id ne "" ? "$id@*" : "*@$ip"}]
  182. fl:issue $nick $ip $mask $text $chans $emo [expr {$id ne ""}]
  183. }
  184.  
  185. proc fl:issue {nick ip mask text chans emo irc} {
  186. global fl
  187. foreach s $fl(shuns) {
  188. if {[lindex $s 5] eq $mask} { ;# already shunned (e.g. another nick with the same IP): no new SHUN, nick still reported
  189. if {[llength $chans]} {fl:queue $nick $chans $text [lindex $s 6] [lindex $s 7]}
  190. fl:say "[fl:hms] Flood : $nick - $ip - $text"
  191. return
  192. }
  193. }
  194. set mins $fl(shunmin); set why {}
  195. if {$emo} { ;# emoji at the end of the flood text -> 1 hour
  196. if {$fl(emojishun) > $mins} {set mins $fl(emojishun)}
  197. lappend why "emoji në fund të tekstit"
  198. }
  199. if {$irc} { ;# IRCCloud ident shun -> 1 hour
  200. if {$fl(irccloudshun) > $mins} {set mins $fl(irccloudshun)}
  201. lappend why "IRCCloud: shun mbi $mask"
  202. }
  203. fl:put "SHUN +$mask ${mins}m :Flood"
  204. lappend fl(shuns) [list [clock seconds] $nick $ip $text [expr {[clock seconds] + $mins*60}] $mask $mins $why]
  205. if {[llength $chans]} {fl:queue $nick $chans $text $mins $why} ;# notice is collected, then sent once
  206. fl:say "[fl:hms] Flood : $nick - $ip - $text"
  207. }
  208.  
  209. # ---- notices: nicks of the same flood text are collected for ~3 s and announced in ONE notice ----
  210. proc fl:similar {a b} {
  211. global fl
  212. set la [string length $a]; set lb [string length $b]
  213. set mx [expr {max($la, $lb, 1)}]
  214. if {double(abs($la - $lb)) / $mx > 1.0 - $fl(sim)} {return 0}
  215. expr {[fl:sim $a $b] >= $fl(sim)}
  216. }
  217. proc fl:queue {nick chans text mins why} {
  218. global fl
  219. set n [fl:norm $text]
  220. if {$n eq ""} {set n $text}
  221. set i 0
  222. foreach b $fl(alerts) {
  223. if {[fl:similar [dict get $b norm] $n]} { ;# same flood text -> same notice
  224. set items [dict get $b items]
  225. if {![dict exists $items $nick]} {dict set items $nick [list $mins $why]}
  226. dict set b items $items
  227. set cl [dict get $b chans]
  228. foreach c $chans {if {[lsearch -exact $cl $c] < 0} {lappend cl $c}}
  229. dict set b chans $cl
  230. set fl(alerts) [lreplace $fl(alerts) $i $i $b]
  231. return
  232. }
  233. incr i
  234. }
  235. lappend fl(alerts) [dict create norm $n text $text chans $chans items [dict create $nick [list $mins $why]] ts [clock milliseconds]]
  236. utimer 3 fl:flush
  237. }
  238. proc fl:flush {} {
  239. global fl
  240. set now [clock milliseconds]; set keep {}
  241. foreach b $fl(alerts) {
  242. if {$now - [dict get $b ts] >= 2800} {fl:sendalert $b} else {lappend keep $b}
  243. }
  244. set fl(alerts) $keep
  245. }
  246. proc fl:sendalert {b} {
  247. set items [dict get $b items]
  248. set nicks [dict keys $items]
  249. set chans [join [dict get $b chans] { }]
  250. if {[llength $nicks] == 1} { ;# single nick
  251. lassign [dict get $items [lindex $nicks 0]] mins why
  252. set extra ""
  253. if {[llength $why]} {set extra " - shun $mins min ([join $why {, }])"}
  254. fl:say "  FLOOD   Nick [lindex $nicks 0] sapo beri flood perseritje ne dhomat $chans$extra"
  255. return
  256. }
  257. set text [dict get $b text]
  258. if {[string length $text] > 100} {set text "[string range $text 0 99]&"}
  259. fl:say "  FLOOD   Nick [join [lrange $nicks 0 9] { }] sapo bene flood perseritje ne dhomat $chans : $text"
  260. for {set i 10} {$i < [llength $nicks]} {incr i 10} {
  261. fl:say "  FLOOD   (vazhdim) Nick [join [lrange $nicks $i [expr {$i + 9}]] { }]"
  262. }
  263. set notes {}
  264. dict for {n v} $items {
  265. lassign $v mins why
  266. if {[llength $why]} {lappend notes "$n: $mins min ([join $why {, }])"}
  267. }
  268. if {[llength $notes]} {fl:say "Shun: [string range [join $notes {; }] 0 349]"}
  269. }
  270.  
  271. proc fl:trigger {msgs} {
  272. global fl
  273. fl:utcreset
  274. foreach m $msgs { ;# remember the flood text for today
  275. if {![fl:hit [lindex $m 4]]} {lappend fl(known) [list [lindex $m 4] [lindex $m 3] [clock seconds]]}
  276. }
  277. if {[llength $fl(known)] > 200} {set fl(known) [lrange $fl(known) end-199 end]}
  278. set nicks {}
  279. foreach m $msgs {
  280. if {[lsearch -exact $nicks [lindex $m 1]] < 0} {lappend nicks [lindex $m 1]}
  281. }
  282. foreach n $nicks {
  283. set chans {}; set text ""; set emo 0
  284. foreach m $msgs {
  285. if {[lindex $m 1] eq $n} {
  286. if {[lsearch -exact $chans [lindex $m 2]] < 0} {lappend chans [lindex $m 2]}
  287. set text [lindex $m 3]
  288. if {[fl:tailemoji $text]} {set emo 1} ;# flood text ends with emoji -> longer shun
  289. }
  290. }
  291. fl:withip $n [list fl:shun $n $text $chans $emo]
  292. }
  293. set new {}
  294. foreach h $fl(hist) {if {[lsearch -exact $msgs $h] < 0} {lappend new $h}}
  295. set fl(hist) $new
  296. }
  297.  
  298. bind pubm - "* *" fl:pubm
  299. proc fl:pubm {nick uhost hand chan text} {
  300. global fl
  301. if {!$fl(on) || ![llength $fl(rules)] || [lsearch -nocase $fl(chans) $chan] < 0} return
  302. set nick [fl:in $nick]; set text [fl:in $text]
  303. set fl(ident,[string tolower $nick]) [lindex [split $uhost @] 0] ;# remember the ident (uid123456)
  304. set norm [fl:norm $text] ;# trailing emoji are ignored when comparing texts
  305. if {$norm eq ""} { ;# emoji-only text
  306. if {$fl(emojiex) && [string trim [fl:nozw [fl:nocodes $text]]] ne ""} return ;# .f emoji on -> exempt
  307. set norm [fl:nocodes $text] ;# .f emoji off -> checked like normal text
  308. }
  309. if {[string length $norm] < $fl(minlen)} return
  310. fl:utcreset
  311. if {[fl:hit $norm]} { ;# text flooded earlier today -> shun at once
  312. fl:withip $nick [list fl:shun $nick $text [list $chan] [fl:tailemoji $text]]
  313. return
  314. }
  315. set now [clock milliseconds]
  316. set keep 1
  317. foreach r $fl(rules) {if {[lindex $r 1] > $keep} {set keep [lindex $r 1]}}
  318. set new {}
  319. foreach h $fl(hist) {if {$now - [lindex $h 0] <= $keep*1000} {lappend new $h}}
  320. lappend new [list $now $nick $chan $text $norm]
  321. set fl(hist) $new
  322. set k [string tolower $nick]
  323. if {![info exists fl(ip,$k)] && ![info exists fl(pend,$k)]} {fl:withip $nick fl:nop}
  324. foreach r $fl(rules) { ;# e.g. {2 1} = 2 similar lines in 1 second
  325. lassign $r cnt secs
  326. set similar {}
  327. foreach h $fl(hist) {
  328. if {$now - [lindex $h 0] <= $secs*1000 && [fl:sim [lindex $h 4] $norm] >= $fl(sim)} {lappend similar $h}
  329. }
  330. if {[llength $similar] >= $cnt} {fl:trigger $similar; return} ;# same nick or multi nick
  331. }
  332. }
  333.  
  334. bind pub - .sh fl:sh
  335. proc fl:sh {nick uhost hand chan text} {
  336. global fl
  337. set text [fl:in $text]
  338. if {[string tolower $chan] ne [string tolower $fl(opers)]} return
  339. lassign [split [string trim $text]] sub arg
  340. switch -nocase -- $sub {
  341. list {
  342. if {![llength $fl(shuns)]} {fl:say "Shun list empty"}
  343. foreach s $fl(shuns) {
  344. fl:say "[fl:hms [lindex $s 0]] Flood : [lindex $s 1] - [lindex $s 2] - [lindex $s 3]"
  345. }
  346. }
  347. add {
  348. if {$arg eq ""} return
  349. if {[regexp -nocase {^([us]id[0-9]+)(@\*)?$} $arg -> idn]} {fl:issue $arg - "$idn@*" manual {} 0 1; return} ;# .sh add uid123456
  350. if {[fl:isip $arg]} {fl:shun $arg manual {} 0 $arg} else {fl:withip $arg [list fl:shun $arg manual {} 0]}
  351. }
  352. rem {
  353. if {$arg eq ""} return
  354. set mask ""
  355. if {[regexp -nocase {^([us]id[0-9]+)(@\*)?$} $arg -> idn]} {set mask "$idn@*"} else {
  356. foreach s $fl(shuns) {
  357. if {[string equal -nocase [lindex $s 1] $arg] || [lindex $s 2] eq $arg} {set mask [lindex $s 5]}
  358. }
  359. if {$mask eq "" && [fl:isip $arg]} {set mask "*@$arg"}
  360. if {$mask eq "" && [info exists fl(ip,[string tolower $arg])]} {set mask "*@$fl(ip,[string tolower $arg])"}
  361. }
  362. if {$mask eq ""} {fl:say "Nuk u gjet $arg"; return}
  363. fl:put "SHUN -$mask"
  364. set new {}
  365. foreach s $fl(shuns) {if {[lindex $s 5] ne $mask} {lappend new $s}}
  366. set fl(shuns) $new
  367. fl:say "Shun removed: $arg ($mask)"
  368. }
  369. }
  370. }
  371.  
  372. set fl(helptext) {
  373. == ANTI-FLOOD - KOMANDAT (përdoren vetëm në #opers) ==
  374. Si punon: roboti krahason tekstet me Levenshtein (ngjashmëri 80%). Nëse një nick ose disa nick, me IP të njëjtë ose të ndryshme, dërgojnë tekste të njëjta ose të ngjashme shpejt, IP-ja shun-ohet dhe njoftohet #opers.
  375. Kujtesa: tekstet e flood-it ruhen deri në 00:00 UTC; kushdo që e dërgon prapë një tekst të ngjashëm (80%) shun-ohet menjëherë, edhe me një mesazh të vetëm. Në 00:00 UTC të gjitha tekstet e ruajtura fshihen.
  376. Shumë nick: nëse disa nick (me IP të njëjtë ose të ndryshme) dërgojnë të njëjtin tekst brenda pak sekondash, njoftimi në #opers liston të gjithë nick-et dhe tekstin e flood-it në një mesazh (pret rreth 3 sek për t'i mbledhur); secili nick shun-ohet menjëherë dhe veç e veç.
  377. .f on / .f off - ndez ose fik mbrojtjen anti-flood. Shërben që ta ndalosh robotin përkohësisht pa e mbyllur.
  378. .f list - shfaq cilësimet aktuale (rregullat, gjatësia, koha e shun-it, emoji) me shpjegim.
  379. .f help - shfaq këtë ndihmë me të gjitha komandat.
  380. .f add 3:1 / .f del 3:1 - shton ose heq një rregull rreshta:sekonda. 3:1 = 3 rreshta të ngjashëm brenda 1 sekonde. Shërben për të kapur flood të shpejtë; mund të kesh disa rregulla (p.sh. 2:1 dhe 3:5).
  381. .f add 50 / .f del 50 - vendos gjatësinë minimale të tekstit në karaktere (p.sh. 50, 100, 300); tekstet më të shkurtra nuk kontrollohen. .f del e kthen në 8. Shërben që fjalët e shkurtra ("po", "mirë") të mos shun-ohen gabimisht.
  382. .f add shuntime 10 / .f del shuntime - vendos sa minuta zgjat shun-i (1-1440, p.sh. 5, 10, 15). .f del e kthen në 5 min.
  383. .f emoji on / .f emoji off - on: mesazhet vetëm me emoji nuk shun-ohen; off: kontrollohen si tekst normal. Emoji në fund të tekstit injorohen gjithmonë, prandaj tekst + emoji flood shun-ohet.
  384. Emoji në fund: nëse teksti i flood-it mbaron me emoji (p.sh. "tekst 😂"), shun-i zgjat 60 min në vend të kohës normale (nëse koha normale është më e gjatë, përdoret ajo).
  385. IRCCloud: nëse përdoruesi vjen nga irccloud.com (ident uid123456), IP-ja është e përbashkët me shumë përdorues, prandaj shun-i vihet mbi ident-in (uid123456@*) për 60 min. Mund ta përdorësh edhe me dorë: .sh add uid123456 / .sh rem uid123456.
  386. .sh list - lista e shun-eve aktive, një rresht për nick: ora Flood : Nick - IP - teksti.
  387. .sh add nick/ip - shun manual për një nick ose IP (përdor kohën e shun-it aktuale).
  388. .sh rem nick/ip - heq shun-in e një nicku ose IP-je para kohe.
  389. }
  390.  
  391. proc fl:help {} {
  392. global fl
  393. foreach l [split $fl(helptext) "\n"] {if {$l ne ""} {fl:say $l}}
  394. }
  395.  
  396. proc fl:status {} {
  397. global fl
  398. set rs [join [lmap r $fl(rules) {join $r :}] { }]
  399. if {$rs eq ""} {set rs "asnjë"}
  400. fl:say "Statusi: [expr {$fl(on) ? {NDEZUR} : {FIKUR}}] - mbrojtja anti-flood (.f on / .f off)"
  401. fl:say "Dhomat e kontrolluara: $fl(chans)"
  402. fl:say "Ngjashmëria: [expr {int($fl(sim)*100)}]% (Levenshtein) - tekstet me kaq ngjashmëri ose më shumë llogariten të njëjta"
  403. fl:say "Rregullat (rreshta:sekonda): $rs - p.sh. 2:1 = 2 rreshta të ngjashëm brenda 1 sekonde (.f add/del 3:1)"
  404. fl:say "Gjatësia minimale e tekstit: $fl(minlen) karaktere - tekstet më të shkurtra nuk kontrollohen (.f add/del 50)"
  405. fl:say "Koha e shun-it: $fl(shunmin) min - sa zgjat bllokimi i IP-së (.f add/del shuntime 10)"
  406. fl:say "Shun-i për flood me emoji në fund të tekstit: 60 min (vlerë fikse) - zakonisht përdoret nga ata që shtojnë emoji për të shmangur zbulimin"
  407. fl:say "Shun-i për IRCCloud: 60 min mbi ident-in (uid123456@*), jo mbi IP-në e përbashkët të IRCCloud"
  408. fl:say "Emoji: [expr {$fl(emojiex) ? {ON} : {OFF}}] - ON: mesazhet vetëm me emoji nuk shun-ohen; OFF: kontrollohen (.f emoji on/off)"
  409. fl:say "Tekste të ruajtura: [llength $fl(known)] - tekstet e flood-it mbahen deri në 00:00 UTC dhe fshihen automatikisht"
  410. fl:say "Shkruaj .f help për shpjegimin e të gjitha komandave."
  411. }
  412.  
  413. bind pub - .f fl:f
  414. proc fl:f {nick uhost hand chan text} {
  415. global fl
  416. set text [fl:in $text]
  417. if {[string tolower $chan] ne [string tolower $fl(opers)]} return
  418. lassign [split [string trim $text]] sub arg arg2
  419. switch -nocase -- $sub {
  420. on {set fl(on) 1; fl:say "Anti-flood ON"}
  421. off {set fl(on) 0; fl:say "Anti-flood OFF"}
  422. emoji {
  423. if {$arg eq "on" || $arg eq "off"} {
  424. set fl(emojiex) [expr {$arg eq "on"}]
  425. fl:say "Emoji-only text: [expr {$fl(emojiex) ? {exempt (ON)} : {checked (OFF)}}]"
  426. }
  427. }
  428. add - del {
  429. set add [string equal -nocase $sub add]
  430. if {[string equal -nocase $arg shuntime]} { ;# .f add shuntime 5 / 10 / 15 (minutes)
  431. if {$add} {
  432. if {![regexp {^[0-9]{1,4}$} $arg2]} {fl:say "Format: .f add shuntime minutes (1-1440)"; return}
  433. scan $arg2 %d n
  434. if {$n < 1 || $n > 1440} {fl:say "Format: .f add shuntime minutes (1-1440)"; return}
  435. set fl(shunmin) $n
  436. fl:say "Shun time: $n min"
  437. } else { ;# .f del shuntime -> back to default
  438. set fl(shunmin) $fl(defshun)
  439. fl:say "Shun time reset: $fl(defshun) min"
  440. }
  441. return
  442. }
  443. if {[regexp {^\d+:\d+$} $arg]} { ;# rate rule count:seconds
  444. scan $arg %d:%d c s
  445. if {$c < 2 || $s < 1} {fl:say "Format: .f add count:seconds (count>=2, seconds>=1)"; return}
  446. set i [lsearch -exact $fl(rules) [list $c $s]]
  447. if {$add} {
  448. if {$i < 0} {lappend fl(rules) [list $c $s]}
  449. fl:say "Rule added: $c lines / ${s}s"
  450. } elseif {$i >= 0} {
  451. set fl(rules) [lreplace $fl(rules) $i $i]; fl:say "Rule removed: $c:$s"
  452. } else {fl:say "Rule $arg not found"}
  453. } elseif {[regexp {^\d+$} $arg]} { ;# min text length
  454. scan $arg %d n
  455. if {$add} {set fl(minlen) $n; fl:say "Min text length: $n chars"} \
  456. elseif {$fl(minlen) == $n} {set fl(minlen) $fl(deflen); fl:say "Min text length reset: $fl(deflen) chars"} \
  457. else {fl:say "Length $n not set"}
  458. }
  459. }
  460. help {fl:help}
  461. list {fl:status}
  462. }
  463. }
  464.  
  465. # forget expired shuns (the server removes the shun itself after 10m)
  466. bind time - "* * * * *" fl:expire
  467. proc fl:expire {args} {
  468. global fl
  469. fl:utcreset
  470. set now [clock seconds]; set new {}
  471. foreach s $fl(shuns) {if {$now < [lindex $s 4]} {lappend new $s}}
  472. set fl(shuns) $new
  473. }
  474.  
  475. # become IRCop on connect
  476. bind evnt - init-server fl:oper
  477. proc fl:oper {type} {global fl; fl:put "OPER $fl(oper_user) $fl(oper_pass)"}
  478.  
  479. putlog "antiflood.tcl loaded"
  480.  

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week