bwscript20.tcl100666 0 0 75607 7566071326 6650 # Advanced bad word script v2.0 # # Authors: SprudL , Demian # Initially For Eggdrop 1.6.3 & TCL 8.3 # Tested with most subsequent versions (up to 1.6.12) # ############################################################ # # HISTORY: # 5/2001 v0.9: Initial release by Sprudl and Demian # 9/2002 v2.0: Update by Demian # # Consisting of: * Exempts are added now (.badword addexempt and delexempt). # * Bantime can be 0 (only a kick). # * .badword search is added. # * .badword view is added. # ############################################################ ####CONFIGURATION # Lists loaded at startup set bw_initLists "general.abw" # Channel where script is active set bw_chans {#donna} # Kick chanops? set bw_kickOpped 0 # For consulting BW lists & stats set bw_lowAccessFlags "o|omn" # For editing BW database set bw_highAccessFlags "Bmn" # Path to BW files set bw_dbPath "scripts/bwdb/" # End of configuration section ########################################################### # Binds for checking badwords bind pubm - * badwcheck bind join - * badjcheck bind nick - * badncheck bind CTCP - ACTION badacheck # Binds for commands bind dcc - badword bw_dcccommand bind msg - badword bw_msgcommand proc badwcheck {nick host handle chan text} { parseText $nick $host $chan $text "w" } proc badacheck {nick uhost hand chan keyword text} { parseText $nick $uhost $chan $text "w" } proc badjcheck {nick host handle chan} { parseText $nick $host $chan $nick "n" } proc badncheck {nick host handle chan newnick} { parseText $nick $host $chan $newnick "n" } proc parseText {nick uhost chan text src} { # Checks text for badwords global bw_kickOpped bw_badwords botnick bw_chans botnick if {[string match $src "n"]} { set nick $text } if {!$bw_kickOpped && [isop $nick $chan]} { return 0 } if {[lsearch -exact $bw_chans $chan] < 0} { return 0 } if {[isbotnick $nick] || ![botisop $chan]} { return 0 } set words [split [stripControlCodes $text]] array set bwfound {} foreach word $words { putloglev 4 * "ABW: Word: $word" foreach bword $bw_badwords { global $bword if {![string compare [set ${bword}(type)] "b"] || ![string compare [set ${bword}(type)] $src]} { if {[string match [string tolower [set ${bword}(pattern)]] [string tolower $word]]} { foreach exempt [set ${bword}(exempts)] { if {[string match [string tolower $exempt] [string tolower $word]]} { return 0 } } putloglev 5 * "ABW: match found --> Pattern: [set ${bword}(pattern)] -- Word: $word" array set bwfound [array get ${bword}] } } } } if {[array size bwfound]} { set bantime $bwfound(bantime) if { $bantime > 0 } { if {[string match $src "n"]} { newchanban $chan $bwfound(pattern)!*@*.* $botnick "$bwfound(reason) (NICKBAN)" $bantime } else { set banmask "*!$uhost" newchanban $chan $banmask $botnick $bwfound(reason) $bantime } } putkick $chan $nick $bwfound(reason) } return 0 } proc bw_dcccommand {handle idx text} { # Takes care of commands via DCC set outputList [bw_parseCommand $handle $text] foreach elem $outputList { putdcc $idx "$elem" } return 1 } proc bw_msgcommand {nick host handle text} { # Takes care of commands via msg global bw_chans set password [lindex $text 0] set arguments [lrange $text 1 end] if {[passwdok $handle $password]} { set outputList [bw_parseCommand $handle $arguments] foreach elem $outputList { puthelp "PRIVMSG $nick :$elem" } } else { puthelp "PRIVMSG $nick :Password Error." } return 0 } proc bw_parseCommand {handle text} { # Parses commands and calls appropriate command handler # Returns results or error code to calling wrapper function set command [string tolower [lindex $text 0]] set arguments [split [lrange $text 1 end]] # Needs some re-thinking #putcmdlog "#$handle# $command $arguments" if {[highAccess $handle]} { switch -exact $command { add { return [bw_addWord $arguments] } delete { return [bw_deleteWord $arguments] } modify { return [bw_modifyWord $arguments] } load { return [bw_loadList $arguments] } save { return [bw_saveList $arguments] } unload { return [bw_unloadList $arguments] } unloadall { return [bw_unloadAllLists] } clear { return [bw_clearList $arguments] } loaded { return [bw_listLoadedFiles] } addexempt { return [bw_addExempt $arguments] } delexempt { return [bw_deleteExempt $arguments] } } } if {[lowAccess $handle]} { switch -exact $command { patterns { return [bw_showPatterns $arguments] } view { return [bw_viewWord $arguments] } stats { return [bw_showStats $arguments] } search { return [bw_search $arguments] } help { return [bw_help $arguments $handle] } } } } proc bw_addWord {arguments} { # Add 1 pattern to BW list # Syntax .badword add pattern type minutes reason file global bw_delimiter bw_lists bw_badwords bw_dbPath bw_types set arglength [llength $arguments] set pattern [lindex $arguments 0] set type [lindex $arguments 1] set minutes [lindex $arguments 2] set reason [lrange $arguments 3 [expr ($arglength-2)]] set file [lindex $arguments end] set outputList {} if {[llength $arguments] < 5 } { return {"Not enough parameters"}} if {[string first $type $bw_types] < 0} { return [lappend outputList "Unknown type $type"] } if {![string is integer $minutes]} { return {"Bantime has to be an integer"}} if { $minutes < 0 } { return {"Bantime has to be positive.."} } set temp [checkFile ${bw_dbPath}$file] if { $temp != 1 } { return [lappend outputList $temp] } # add badword to current memory, if list loaded set badword "${pattern}${bw_delimiter}${type}${bw_delimiter}${minutes}${bw_delimiter}${reason}${bw_delimiter}" foreach list $bw_lists { if {[string match [string tolower $list] [string tolower $file]]} { set bw_badwords [concat $bw_badwords [createBWArrays [list $badword] $file]] } } # write badword to file appendFile "$bw_dbPath$file" [list $badword] return {"Badword added."} } proc bw_addExempt {arguments} { # Add 1 exempt to a bad word # Syntax .badword addexempt exempt word file global bw_delimiter bw_lists bw_badwords bw_dbPath bw_types set arglength [llength $arguments] set exempt [lindex $arguments 0] set exempts {} set pattern [lindex $arguments 1] set file [lindex $arguments end] set outputList {} if {[llength $arguments] < 3 } { return {"Not enough parameters"}} if {[llength $arguments] > 3 } { return {"Too many parameters"}} set temp [checkFile ${bw_dbPath}$file] if { $temp != 1 } { return [lappend outputList $temp] } # add exempt in file set fileContentList [readFile ${bw_dbPath}$file] set patternlist {} set patternIndex -1 foreach elem $fileContentList { set elemPattern [lindex [split $elem $bw_delimiter] 0] set patternlist [lappend patternlist $elemPattern] if {[string match $pattern $elemPattern]} { set patternIndex [lsearch $patternlist $pattern] } } if {$patternIndex >= 0} { set type [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 1] set minutes [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 2] set reason [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 3] set exempts [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 4] set exempts [lappend exempts $exempt] set badword "${pattern}${bw_delimiter}${type}${bw_delimiter}${minutes}${bw_delimiter}${reason}${bw_delimiter}${exempts}" set fileContentList [lreplace $fileContentList $patternIndex $patternIndex $badword] writeFile "$bw_dbPath$file" $fileContentList } else { return {"Bad word not in list."} } # add exempt in memory, if necessary. foreach list $bw_lists { if [string match [string tolower $file] [string tolower $list]] { set patternlist "" foreach elemnt $bw_badwords { global $elemnt set patternlist [lappend patternlist [set ${elemnt}(pattern)]] } set badwordLoc [lsearch -exact $patternlist $pattern] if {$badwordLoc >= 0} { set bword [lindex $bw_badwords $badwordLoc] if {[string match [set ${bword}(file)] $file]} { set ${bword}(exempts) $exempts } } } } return {"Exempt added."} } proc bw_deleteExempt {arguments} { global bw_delimiter bw_lists bw_badwords bw_dbPath bw_types set arglength [llength $arguments] set exempt [lindex $arguments 0] set exempts {} set pattern [lindex $arguments 1] set file [lindex $arguments end] set outputList {} if {[llength $arguments] < 3 } { return {"Not enough parameters"}} if {[llength $arguments] > 3 } { return {"Too many parameters"}} set temp [checkFile ${bw_dbPath}$file] if { $temp != 1 } { return [lappend outputList $temp] } # add exempt in file set fileContentList [readFile ${bw_dbPath}$file] set patternlist {} set patternIndex -1 foreach elem $fileContentList { set elemPattern [lindex [split $elem $bw_delimiter] 0] set patternlist [lappend patternlist $elemPattern] if {[string match $pattern $elemPattern]} { set patternIndex [lsearch $patternlist $pattern] } } if {$patternIndex >= 0} { set type [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 1] set minutes [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 2] set reason [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 3] set exempts [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 4] set exemptFound [lsearch $exempts $exempt] if {$exemptFound<0} { return {"Exempt not found."} } set exempts [lreplace $exempts $exemptFound $exemptFound] set badword "${pattern}${bw_delimiter}${type}${bw_delimiter}${minutes}${bw_delimiter}${reason}${bw_delimiter}${exempts}" set fileContentList [lreplace $fileContentList $patternIndex $patternIndex $badword] writeFile "$bw_dbPath$file" $fileContentList } else { return {"Bad word not in list."} } # delete exempt in memory, if necessary. foreach list $bw_lists { if [string match [string tolower $file] [string tolower $list]] { set patternlist "" foreach elemnt $bw_badwords { global $elemnt set patternlist [lappend patternlist [set ${elemnt}(pattern)]] } set badwordLoc [lsearch -exact $patternlist $pattern] if {$badwordLoc >= 0} { set bword [lindex $bw_badwords $badwordLoc] if {[string match [set ${bword}(file)] $file]} { set ${bword}(exempts) $exempts } } } } return {"Exempt removed."} } proc bw_viewWord {arguments} { # View information about a bad word. File does not have to be loaded. # Syntax .badword view pattern file global bw_dbPath bw_delimiter bw_badwords set pattern [lindex $arguments 0] set file [lindex $arguments 1] set outputList {} ## Search in memory if {[string match $file ""]} { foreach element $bw_badwords { global $element if {[string match [set ${element}(pattern)] $pattern]} { set type [set ${element}(type)] set minutes [set ${element}(bantime)] set reason [set ${element}(reason)] set exempts [set ${element}(exempts)] set bwfile [set ${element}(file)] set outputList [lappend outputList "Badword Information for: $pattern"] set outputList [lappend outputList " Type: $type"] set outputList [lappend outputList " Bantime: $minutes minutes"] set outputList [lappend outputList " Kickreason: $reason"] set outputList [lappend outputList " Exempts: $exempts"] set outputList [lappend outputList " File: $bwfile"] return $outputList } } return {"Pattern not found in current memory."} } else { ## Search in file set fileContentList [readFile ${bw_dbPath}$file] set patternIndex -1 foreach elem $fileContentList { set elemPattern [lindex [split $elem $bw_delimiter] 0] set patternlist [lappend patternlist $elemPattern] if {[string match $pattern $elemPattern]} { set patternIndex [lsearch $patternlist $pattern] } } if {$patternIndex >= 0} { set type [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 1] set minutes [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 2] set reason [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 3] set exempts [lindex [split [lindex $fileContentList $patternIndex] $bw_delimiter] 4] set outputList [lappend outputList "Badword Information for: $pattern"] set outputList [lappend outputList " Type: $type"] set outputList [lappend outputList " Bantime: $minutes minutes"] set outputList [lappend outputList " Kickreason: $reason"] set outputList [lappend outputList " Exempts: $exempts"] return $outputList } else { return {"Badword not found in that list."}} } } proc bw_deleteWord {arguments} { # Delete word from BW list. File does not have to be loaded! # Syntax .badword delete pattern file global bw_dbPath bw_lists bw_badwords bw_delimiter bw_types set pattern [lindex $arguments 0] set file [lindex $arguments 1] set outputList {} if {[llength $arguments] < 2 } { return {"Not enough arguments"} } if {[llength $arguments] > 2 } { return {"Too many arguments"} } set temp [checkFile ${bw_dbPath}$file] if { $temp != 1 } { return [lappend outputList $temp]} set fileContentList [readFile ${bw_dbPath}$file] set patternlist {} foreach elem $fileContentList { set elemPattern [lindex [split $elem $bw_delimiter] 0] lappend patternlist $elemPattern } # delete word from file set patternIndex [lsearch -exact $patternlist $pattern] if {$patternIndex >= 0} { set fileContentList [lreplace $fileContentList $patternIndex $patternIndex] writeFile "$bw_dbPath$file" $fileContentList } else { return {"Bad word not in list."} } # delete word from list in memory, if necessary foreach list $bw_lists { if [string match [string tolower $file] [string tolower $list]] { set patternlist {} foreach element $bw_badwords { global $element set patternlist [lappend patternlist [set ${element}(pattern)]] } set badwordLoc [lsearch -exact $patternlist $pattern] if {$badwordLoc >= 0} { set badword [lindex $bw_badwords $badwordLoc] if {[string match [set ${badword}(file)] $file]} { set bw_badwords [lreplace $bw_badwords $badwordLoc $badwordLoc] unset ${badword} } else { return {"Word in another list"} } } else { return {"Word not found ?!! Impossible."} } } } return {"Bad word removed."} } proc bw_modifyWord {arguments} { # Modify word from BW list. File does not have to be loaded! # Syntax .badword modify pattern file newpattern newtype newminutes newreason global bw_dbPath bw_lists bw_badwords bw_delimiter bw_types set pattern [string tolower [lindex $arguments 0]] set file [lindex $arguments 1] set newpattern [lindex $arguments 2] set newtype [lindex $arguments 3] set newminutes [lindex $arguments 4] set newreason [lrange $arguments 5 end] set outputList {} if {[llength $arguments] < 6 } { return {"Not enough parameters"} } if {[string first $newtype $bw_types] < 0} { return [lappend outputList "Unknown type $newtype"] } if {![string is integer $newminutes]} { return {"Bantime has to be an integer"} } if { $newminutes < 0 } { return {"Bantime has to be positive.."} } set temp [checkFile ${bw_dbPath}$file] if {$temp != 1} { return [lappend outputList $temp] } set newBadword "${newpattern}${bw_delimiter}${newtype}${bw_delimiter}${newminutes}${bw_delimiter}${newreason}" set fileContentList [readFile ${bw_dbPath}$file] set patternlist {} foreach elem $fileContentList { set elemPattern [lindex [split $elem $bw_delimiter] 0] set patternlist [lappend patternlist $elemPattern] } # modify word from file set patternIndex [lsearch -exact $patternlist $pattern] if {$patternIndex >= 0} { set fileContentList [lreplace $fileContentList $patternIndex $patternIndex $newBadword] writeFile "$bw_dbPath$file" $fileContentList } else { return {"Bad word not in list."} } # delete word from list in memory, if necessary foreach list $bw_lists { if [string match [string tolower $file] [string tolower $list]] { set patternlist "" foreach element $bw_badwords { global $element set patternlist [lappend patternlist [set ${element}(pattern)]] } set badwordLoc [lsearch -exact $patternlist $pattern] if {$badwordLoc >= 0} { set badword [lindex $bw_badwords $badwordLoc] if {[string match [set ${badword}(file)] $file]} { set ${badword}(pattern) $newpattern set ${badword}(type) $newtype set ${badword}(minutes) $newminutes set ${badword}(reason) $newreason } else { return {"Word in another list."} } } else { return {"Word not found ?!! Impossible."} } } } return {"Bad word modified."} } proc bw_search {arguments} { global bw_badwords set pattern [lindex $arguments 0] if {[llength $arguments] < 1} { return {"Not enough parameters."} } if {[llength $arguments] > 1 } { return {"Too many arguments"} } set patternList {} set outputList {} foreach element $bw_badwords { global $element if {[string match [string tolower $pattern] [string tolower [set ${element}(pattern)]]]} { set patternList [lappend patternList [set ${element}(pattern)]] } } if {![llength $patternList]} { return {"No matches found."} } else { set outputList [lappend outputList "The following patterns were found:"] set outputList [lappend outputList $patternList] return $outputList } } proc bw_loadList {arguments} { # Load file with patterns # Syntax: .badword load filename set outputList {} if {[llength $arguments] < 1 } { return {"Not enough arguments"} } if {[llength $arguments] > 1 } { return {"Too many arguments"} } return [lappend outputList [expandWordList $arguments]] } proc bw_saveList {arguments} { # Save current list to file # Syntax: .badword save filename [new] global bw_dbPath bw_badwords bw_lists bw_delimiter set outputList {} if {[llength $arguments]<1} { return {"Not enough arguments"} } if {[llength $arguments] > 2 } { return {"Too many arguments"} } set file [lindex $arguments 0] set fqFile "$bw_dbPath$file" set new 0 if {[string compare [string tolower [lindex arguments 1]] "new"] || [lsearch -exact $bw_lists $file]<0} { set new 1 } set tempList {} foreach bword $bw_badwords { global $bword set str "[set ${bword}(pattern)]$bw_delimiter[set ${bword}(type)]$bw_delimiter[set ${bword}(bantime)]$bw_delimiter[set ${bword}(reason)]" lappend tempList $str } if {$new} { writeFile $fqFile $tempList } else { appendFile $fqFile $tempList } return [lappend outputList "List saved to $file"] } proc bw_unloadList {arguments} { # Unload list from memory # Syntax: .badword unload filename set outputList {} if {[llength $arguments] < 1} { return {"Not enough parameters."} } if {[llength $arguments] > 1} { return {"Too many parameters."}} set file $arguments global bw_badwords bw_lists set i [lsearch -exact $bw_lists $file] if {$i<0} { return {"File not loaded"} } set bw_lists [lreplace $bw_lists $i $i] foreach bword $bw_badwords { global $bword set i [lsearch -exact $bw_badwords $bword] if {![string compare $file [set ${bword}(file)]]} { set bw_badwords [lreplace $bw_badwords $i $i] unset ${bword} } } return [lappend outputList "Patterns from $file unloaded"] } proc bw_unloadAllLists {} { # Clear patterns from memory global bw_badwords bw_lists set outputList {} if {[llength $bw_lists]<1} { return {"No lists loaded"} } foreach bword $bw_badwords { global $bword unset ${bword} } set bw_badwords {} set bw_lists {} return {"All patterns cleared"} } proc bw_listLoadedFiles {} { # Returns list of BW files in $bw_dbPath global bw_lists set outputList {} if {[llength $bw_lists]<1} { return {"No lists loaded"} } else { return [lappend outputList "Files loaded: $bw_lists"] } } proc bw_showPatterns {args} { # Returns formatted list of patterns global bw_badwords set patternList "" set outputList "" if {[llength $bw_badwords]<1} { return {"No patterns loaded"} } else { foreach badword $bw_badwords { global $badword set patternList [lappend patternList [set ${badword}(pattern)]] } for { set i 0 } { $i < [llength $patternList] } { incr i 15 } { lappend outputList [lrange $patternList $i [expr ($i + 14)]] } return $outputList } } proc bw_help {arguments handle} { set outputList "" if {[llength $arguments]>1} { return [lappend outputList "Not enough parameters"] } if [highAccess $handle] { switch -exact $arguments { add { lappend outputList "SYNTAX: badword add " lappend outputList "USE: Adding a badword to a list (which doesn't have to be loaded)" lappend outputList " must be w/n/b (word/nick/both)" lappend outputList " must be an existing file." lappend outputList "Bantime = 0 means the bot will not ban, only kick." return $outputList } delete { lappend outputList "SYNTAX: badword delete " lappend outputList "USE: Deleting a badword from a list (which doesn't have to be loaded)" return $outputList } modify { lappend outputList "SYNTAX: badword modify " lappend outputList "USE: Modifying a bad word in a list (which doesn't have to be loaded)" lappend outputList " must be w/n/b (word/nick/both)" lappend outputList "Bantime = 0 means the bot will not ban, only kick." return $outputList } load { lappend outputList "SYNTAX: badword load " lappend outputList "USE: Adding a badword-list to the currently loaded badwords." return $outputList } unload { lappend outputList "SYNTAX: badword unload " lappend outputList "USE: Removing a badword-list from the currently loaded badwords." return $outputList } unloadall { lappend outputList "SYNTAX: badword unloadall" lappend outputList "USE: Removing all loaded lists from the currently loaded badwords (empties it)" return $outputList } loaded { lappend outputList "SYNTAX: badword loaded" lappend outputList "USE: Showing the currently loaded listnames." return $outputList } save { lappend outputList "SYNTAX: badword save \[new\]" lappend outputList "USE: Saving the currently loaded badwords to " lappend outputList "\[new\] must be added when you want the badwords written to a new file," lappend outputList "or to overwrite a currently existing file." lappend outputList "When it is omitted the bad words will be added to if it exists," lappend outputList "or written to a new file, if it doesn't." return $outputList } addexempt { lappend outputList "SYNTAX: badword addexempt " lappend outputList "USE: Adding an exempt to in ." return $outputList } delexempt { lappend outputList "SYNTAX: badword delexempt " lappend outputList "USE: Removing an exempt from in ." return $outputList } } } if [lowAccess $handle] { switch -exact $arguments { "" { lappend outputList "Available commands:" if [highAccess $handle] { lappend outputList "add - delete - modify - load - unload - unloadall - loaded - save" lappend outputList "addexempt - delexempt" } lappend outputList "patterns - view - search" lappend outputList "Use 'badword help command' for help on each of these." return $outputList } patterns { lappend outputList "SYNTAX: badword patterns" lappend outputList "USE: Shows a list of all currently loaded badwords." return $outputList } view { lappend outputList "SYNTAX: badword view ()" lappend outputList "USE: Shows information about in ." lappend outputList " is optional, if omitted the search is done in the currently loaded memory." return $outputList } search { lappend outputList "SYNTAX: badword search " lappend outputList "USE: Searches if is currently a loaded badword." lappend outputList " can contain wildcards." return $outputList } } } return [lappend outputList "No help available on that."] } proc bw_showStats {args} { # Return stats return "bw_showstats" } proc lowAccess {handle} { global bw_chans bw_highAccessFlags bw_lowAccessFlags set found 0 foreach chan $bw_chans { if {[matchattr $handle $bw_highAccessFlags $chan] || [matchattr $handle $bw_lowAccessFlags $chan]} { set found 1 } } return $found } proc highAccess {handle} { global bw_chans bw_highAccessFlags set found 0 foreach chan $bw_chans { if {[matchattr $handle $bw_highAccessFlags $chan]} { set found 1 } } return $found } proc expandWordList {file} { # Load extra file global bw_badwords bw_lists bw_dbPath set fqFile "$bw_dbPath$file" if {[lsearch -exact $bw_lists $file]>-1} { return "File already loaded" } set temp [checkFile $fqFile] if { $temp != 1 } { return $temp } # list with arraynames set bw_wordlist [readFile "$fqFile"] set tempList [createBWArrays $bw_wordlist $file] set bw_badwords [concat $bw_badwords $tempList] lappend bw_lists $file return "Loaded file $file" } proc createBWArrays {unmodlist file} { # Creates the arrays, returns a list of array names global bw_badwords bw_delimiter # list to be returned set arrayNamesList "" # Set first number for new patterns set crrntNr 0 if {[llength $bw_badwords]} { set crrntNr [expr [lindex [split [lindex $bw_badwords end] ","] 1] + 1] } foreach rawUnmod $unmodlist { set badwordunmod [split $rawUnmod $bw_delimiter] global badword,${crrntNr} set badword,${crrntNr}(pattern) [lindex $badwordunmod 0] set badword,${crrntNr}(type) [lindex $badwordunmod 1] set badword,${crrntNr}(bantime) [lindex $badwordunmod 2] set badword,${crrntNr}(reason) [lindex $badwordunmod 3] set badword,${crrntNr}(exempts) [lindex $badwordunmod 4] set badword,${crrntNr}(file) $file # add it to the list set arrayNamesList [lappend arrayNamesList badword,$crrntNr] incr crrntNr } return $arrayNamesList } proc readFile {filename} { # Read file to list, each line is a list element (strings) set lines {} set FH [open $filename r] set g [gets $FH] while {![eof $FH]} { lappend lines $g set g [gets $FH] } close $FH return $lines } proc writeFile {filename inputList} { # Write list to file, each element on a seperate line # Overwrites the original file set FH [open $filename w] foreach elem $inputList { puts $FH $elem } close $FH } proc appendFile {filename inputList} { # Append lines to a file, each list element on a seperate line set FH [open $filename a+] foreach elem $inputList { puts $FH $elem } close $FH } proc checkFile {filename} { # Checks if file is accessible if {![file exists $filename]} { return "File does not exist." } if {![file readable $filename]} { return "File unreadable." } if {![file isfile $filename]} { return "File is not a normal file." } return 1 } proc stripControlCodes {str} { # Remove all control codes from a string # Color: \003; Underline: \037; Bold: \002; Reverse: \026; Plain: \017 set res $str regsub -all -- {\003(\d){0,2}(,){0,1}(\d){0,2}} $res {} res regsub -all -- {\037} $res {} res regsub -all -- {\002} $res {} res regsub -all -- {\026} $res {} res regsub -all -- {\017} $res {} res return $res } proc checkChans {} { global bw_chans set errorChans {} foreach chan $bw_chans { if {[lsearch [channels] $chan] <0} { set bw_chans [lreplace $bw_chans [lsearch $bw_chans $chan] [lsearch $bw_chans $chan]] set errorChans [lappend errorChans $chan] } } if {[llength $errorChans]} { putlog "ABW: These ABW-channels were removed because I don't monitor them: $errorChans" } } ################################################################# # Field delimiter in BW files set bw_delimiter "|" # Flags used for type-check (for Inputcontrol) set bw_types "wnb" # Initialisation set bw_badwords {} set bw_lists {} foreach list $bw_initLists { expandWordList $list } unset bw_initLists #the delay is to give the bot the chance to join the monitor-channels. utimer 10 checkChans putlog "Advanced bad word script v2.0 (By Demian and Sprudl) loaded." bwscript20.txt100666 0 0 1655 7566073270 6655 ** Advanced Bad Word Script ** (Also) Supporting: - Multiple lists can be loaded and unloaded. - Each badword can have its own reason, pattern, bantime, type and exempts. - Complete control through DCC and MSG is implemented (remove, add, change, search, test, view, .. a bad word). - Masters have more commands at their service than chanops. - Once loaded, use .badword help on the partyline or /msg botnick badword password help to get an overview of the possibilities. - It has been tested with the latest version of Eggdrop and TCL and it has also worked with older versions (down to 1.4.6 I believe. Lower not tested.) - It was written for use on large channels (where it is tested) and proven very effective there. The many possibilities may be unnecessary when you have a small channel. Mail demian@pandora.be if you need assistance or have found bugs to report (I would appreciate that). Demian^^. 16/11/2002