Brian's Blog

#### Readme / Help #############################################################
################################################################################
## This script is ripped from KuNgFoO’s ib.tcl v3.19 (infobot) script. ##
## ##
## Script that can calculate just about anything ##
## ##
## Usage: ##
## To have the .calc[ulate] commands available on a channel you need to set ##
## the channel flag +calculator from the console/partyline . ##
## “.chanset #channel +calculator´´ ##
## ##
## Channel Commands (available only if channel is +convert): ##
## .calc[ulate] ##
## Example: ##
## “.calc 15*20+3´´ ##
################################################################################

#### Changelog #################################################################
################################################################################
## v1.0.1 ##
## * Minor code cleanup ##
## ##
## v1.0.0 ##
## + Initial release. ##
## * Changed the default trigger “botname, calc[ulate]´´ to “.calc[ulate]´´ ##
## + Added the possibility to control which channels could use the commands ##
## with the channel flag “+/-calculator´´ ##
################################################################################

bind pub – .calc pub_calc
bind pub – .calculate pub_calc
bind msg – calc msg_calc
bind msg – calculate msg_calc

setudef flag calculator

# You shouldn’t change these, however you may add additional variables
# These are used via %varname in the ‘calculate’ command
# Example: Mybot, calculate %pi / 2
set calc_const(pi) 3.14159265358979323846 ; # PI
set calc_const(e) 2.7182818284590452354 ; # E
set calc_const(n) 6.0221367e23 ; # Avogadro’s number [1/mol]
set calc_const(R) 8.314510 ; # Universal gas constant [J/(mol*K)]
set calc_const(k) 1.380658e-23 ; # Boltzmann’s constant [J/K]
set calc_const(G) 6.67259e-11 ; # Universal gravitational constant [N*m^2/kg^2]
set calc_const(h) 6.62606891e-34 ; # Planck’s constant [J*s]
set calc_const(c) 2.99792458e8 ; # Speed of light [m/s]

# No more editing required

proc xrange {xr xr1 xr2} {
return [join [lrange [split $xr] $xr1 $xr2]]
}

proc xindex {xr xr1} {
return [join [lrange [split $xr] $xr1 $xr1]]
}

proc calc_fixdata {arg output} {
global botnick
if {[string index $output 0] != “#”} {
regsub -all -nocase {$output’s} $arg “your” arg
}
regsub -all -nocase {$botnick’s} $arg “my” arg
return $arg
}

proc calc_msg {targets arg} {
foreach target $targets { puthelp “PRIVMSG $target :[calc_fixdata $arg $target]” }
}

proc calc_fixtopic {arg} {
regsub -all {[\\\{\}\[\]\”]} $arg {} arg ; # Bad characters
regsub -all {(\s)+} $arg {\1} arg ; # Double whitespace
regsub -all {^\s*|\s*$} $arg {} arg ; # Whitespace at ends
return $arg
}

# Begin ‘calc’ code
proc calc_fixexpr {exp} {
global calc_const
set exp [calc_fixtopic $exp]
foreach i [array names calc_const] {
regsub -all “\%$i” $exp $calc_const($i) exp
}
return $exp
}
# End ‘calc’ code

# Begin Public binds code
proc msg_calc {nick uhost hand arg} {
global botnick
pub_calc $nick $uhost $hand “” $arg
}

proc pub_calc {nick uhost hand chan arg} {
global botnick calc_flag
if {(![isbotnick $nick]) && (![matchattr $hand +b])} {
if {(![string match "$chan" ""]) && (![channel get $chan calculator])} {
return 0 ; # If command comes from a channel, and that channel doesn’t have +calculator then ignore
}
set isuser [expr {[matchattr $hand - $chan] || [matchattr $hand -]}] ; # Note that $chan might be “”, so we must handle both cases
if {([validchan $chan]) && ($isuser)} {
set output1 $chan ; # The bot sends the text to the channel for users
} else {
set output1 $nick ; # Non-users get privmsg’d
}
if {[set i [string last ">" $arg]] == -1} {
set output2 $output1 ; # By default, output2 (~stdout~) goes to output1 (~stderr~)
} else {
# Output has been redirected
if {(!$isuser) || ([set output2 [string trim [string range $arg [expr $i + 1] end] ” “]] == “”)} {
set output2 $output1 ; # Error (User doesn’t have access, or output was “”), so we go back to the default
}
set arg [string trim [string range $arg 0 [expr $i - 1]] ” “]
}
set remainder [xrange $arg 0 end]

if {$remainder == “”} {
calc_msg $output1 “error parsing sentence”
} elseif {[catch {expr [calc_fixexpr $remainder]} output]} {
calc_msg $output1 “error calculating ‘$remainder’ ($output)”
} else {
calc_msg $output2 “$remainder = $output”
}
}
}
# End Public binds code

# Init stuff
if {[catch {package require Tcl 8.2} error]} {
putlog “error TCL v8.2 or higher is required to run this script”
return 0
}

putlog “*** LOADED: calc.tcl”

#### Readme / Help #############################################################
################################################################################
## This script is ripped from KuNgFoO’s ib.tcl v3.19 (infobot) script. ##
## ##
## The script converts between a number of various units, for more speficic ##
## information on which untis you should please refer to the source of this ##
## script. ##
## ##
## Usage: ##
## To have the .conv[ert] commands available on a channel you need to set ##
## the channel flag +convert from the console/partyline . ##
## “.chanset #channel +convert´´ ##
## ##
## Channel Commands (available only if channel is +convert): ##
## .conv[ert] to ##
## Example: ##
## “.conv 20 C to F´´ ##
## Converts 20 degrees Celcius to it’s Fahrenheit equivilant. ##
################################################################################

#### Changelog #################################################################
################################################################################
## v1.0.1 ##
## * Minor code cleanup ##
## ##
## v1.0.0 ##
## + Initial release. ##
## * Changed the default trigger “botname, conv[ert]´´ to “.con[vert]´´ ##
## + Added the possibility to control which channels could use the commands ##
## with the channel flag “+/-convert´´ ##
################################################################################

bind pub – .conv pub_conv
bind pub – .convert pub_conv
bind msg – conv msg_conv
bind msg – convert msg_conv

# Set the name of the channelflag used to tell whether the convert command is
# enabled or not for that specific channel.
set conv_channel_flag “convert”

setudef flag $conv_channel_flag

# Set the next line as the exec command to run the ‘units’ command from the shell
# Note: Not all systems will have this installed
# Set to “” to disable
set conv_units_exec “units -v”

# Conversion formulas – each array is for its own dimension (length, volume, etc).
# Each unit is converted to a standard type by multiplying the value by the factors
# below. It is then converted from the standard type to any other unit by
# dividing the factors. The standard unit used must be the same for everything in
# each dimension, and can be anything as long as they are the same. I used the root
# metric units for most things (meters, liters, grams, etc).
# Note: All strings are matched as regular expressions
# * Prefix with (?c) for units that should be case sensitive
# * Prefix with (.*?) for metric units
# * Append (?:s) for units with an optional plural ending, etc
# * Only use multiplication and division in the formulas, no addition or subtraction
# * It’s a very good idea to have all the formulas return values in decimal form
# (“1″ doesn’t matter, though)
# Syntax:
# name abbreviation factor
set conv_unit(length) {
(.*?)meter(?:s)? (.*?)m 1
inch(?:es)? in {2.54 / 100}
foot|feet ft {2.54 / 100 * 12}
mile(?:s)? mi {2.54 / 100 * 12 * 5280}
}
set conv_unit(volume) {
(.*?)liter(?:s)? (.*?)L 1
pint(?:s)? pt {3.785 / 8}
quart(?:s)? qt {3.785 / 4}
gallon(?:s)? gal 3.785
}
set conv_unit(weight) {
(.*?)gram(?:s)? (.*?)g 1
ounce(?:s)? oz 28.35
pound(?:s)? lbs 453.59
ton(?:s)? T {453.59 * 2000}
}
set conv_unit(work) {
(.*?)joule(?:s)? (.*?)J 1
(.*?)watt-?second(?:s)? (.*?)w-?s 1
(.*?)watt-?hour(?:s)? (.*?)w-?hrs 3600.0
britishthermalunit(?:s)? btu 1055.056
calorie(?:s)? cal 4.1868
foot-?pound(?:s)? ft-?lbs 1.356
electron-?volt(?:s)? eV 1.6021917E-19
}
set conv_unit(power) {
(.*?)watt(?:s)? (.*?)w 1
volt-?amp(?:s)? va 1
horsepower hp 746
}
set conv_unit(time) {
(.*?)second(?:s)? (.*?)s(?:ec(?:s)?)? 1
minute(?:s)? min(?:s)? 60.0
hour(?:s)? h(?:r(?:s)?)? {60.0 * 60}
day(?:s)? {} {60.0 * 60 * 24}
week(?:s)? wk(?:s)? {60.0 * 60 * 24 * 7}
year(?:s)? yr(?:s)? {60.0 * 60 * 24 * 365}
decade(?:s)? {} {60.0 * 60 * 24 * 365 * 10}
century|centuries {} {60.0 * 60 * 24 * 365 * 100}
}
set conv_unit(binary) {
option metric 2
(.*?)byte(?:s)? (.*?)b 1
(.*?)bit(?:s)? {} {1.0 / 8}
}

# Misc conversion formulas – these are types that cannot
# be converted by regular multiplication/division of factors.
# The principle is the same as the formulas above, however
# the arrays are broken down into *_from and *_to variables.
# Note: $value is used as the value being converted.
set conv_misc_from(num) {
option metric 0
integer|int {} {[scan $value "%d"]}
long {} {[scan $value "%u"]}
decimal|dec|float|double {} {[scan $value "%f"]}
octal|oct {} {[scan $value "%o"]}
hexadecimal|hex {} {[scan $value "%x"]}
binary|bin {} {[bin2int $value]}
ip {} {[ip2long $value]}
rgb {} {[rgb2int $value]}
}
set conv_misc_to(num) {
option metric 0
integer|int {} {[format "%d" [conv_int $value]]}
long {} {[format "%u" [conv_int $value]]}
decimal|dec|float|double {} {[format "%f" $value]}
octal|oct {} {[format "%o" [conv_int $value]]}
hexadecimal|hex {} {[format "%X" [conv_int $value]]}
binary|bin {} {[int2bin [conv_int $value]]}
ip {} {[long2ip [conv_int $value]]}
rgb {} {[int2rgb [conv_int $value]]}
}
set conv_misc_from(temperature) {
option metric 0
fahrenheit F {($value – 32) * 5 / 9.0}
kelvin K {$value – 273.15}
celsius|centigrade C {$value}
}
set conv_misc_to(temperature) {
option metric 0
fahrenheit F {(9 / 5.0 * $value) + 32}
kelvin K {$value + 273.15}
celsius|centigrade C {$value}
}

# Conversion strings to specificially ignore (that conflict with expr)
set conv_ignore {
e abs acos asin
atan atan2 ceil
cos cosh double
exp floor fmod
hypot int log
log10 pow rand
round sin sinh
sqrt srand tan
tanh
}

# Metric conversion factors
# Note: Abbreviations are case sensitive here
# Syntax:
# mame abbreviation factor
set conv_metric {
Yotta Y 24
Zetta Z 21
Exa E 18
Peta P 15
Tera T 12
Giga G 9
Mega M 6
Kilo k 3
Hecto h 2
Deca dk 1

Deci d -1
Centi c -2
Milli m -3
Micro µ -6
Nano n -9
Pico p -12
Femto f -15
Atto a -18
Zepto z -21
Yocto y -24
}

proc xrange {xr xr1 xr2} {
return [join [lrange [split $xr] $xr1 $xr2]]
}

proc anymatch {string1 string2} {
foreach string $string2 {
if {[lsearch -exact [string tolower $string1] [string tolower $string]] != -1} {
return 1
}
}
return 0
}

proc conv_fixtopic {arg} {
regsub -all {[\\\{\}\[\]\”]} $arg {} arg ; # Bad characters
regsub -all {(\s)+} $arg {\1} arg ; # Double whitespace
regsub -all {^\s*|\s*$} $arg {} arg ; # Whitespace at ends
return $arg
}

proc conv_fixdata {arg output} {
global botnick
if {[string index $output 0] != “#”} {
regsub -all -nocase {$output’s} $arg “your” arg
}
regsub -all -nocase {$botnick’s} $arg “my” arg
return $arg
}

proc conv_msg {targets arg} {
foreach target $targets {
puthelp “PRIVMSG $target :[conv_fixdata $arg $target]“
}
}

proc conv_fixexpr {exp} {
global ib_const
set exp [conv_fixtopic $exp]
foreach i [array names ib_const] {
regsub -all “\%$i” $exp $ib_const($i) exp
}
return $exp
}

# Begin conversion code
proc int2bin {int} {
return [format "%s.%s.%s.%s" \
[byte2bin [expr ($int >> 24) & 0xff]] \
[byte2bin [expr ($int >> 16) & 0xff]] \
[byte2bin [expr ($int >> & 0xff]] \
[byte2bin [expr $int & 0xff]]]
}

proc byte2bin {byte} {
set result “”
for {set i 0} {$i < 8} {incr i} {
append result [expr ($byte & 128) >> 7]
set byte [expr $byte << 1]
}
return $result
}

proc bin2int {bin} {
set result 0
for {set i 0} {$i < [string length $bin]} {incr i} {
if {([set digit [string index $bin $i]] == 0) || ($digit == 1)} {
set result [expr $result << 1 | $digit]
} elseif {$digit == “.”} {
#ignore
} else {
set result “”
}
}
return $result
}

proc ip2long {ip} {
if {[scan $ip "%d.%d.%d.%d" a b c d] == 4} {
foreach i “$a $b $c $d” {
if {($i > 255) || ($i < 0)} {
return “”
}
}
set long [expr $a << 24 | $b << 16 | $c << 8 | $d]
if {$long < 0} {
set long [expr pow(2, 32) + $long]
}
return $long
} else {
return “”
}
}

proc long2ip {long} {
return [format "%d.%d.%d.%d" \
[expr ($long >> 24) & 0xff] \
[expr ($long >> 16) & 0xff] \
[expr ($long >> & 0xff] \
[expr $long & 0xff]]
}

proc rgb2int {rgb} {
if {[scan $rgb "%d.%d.%d" red green blue] == 3} { return [expr $red << 16 | $green << 8 | $blue << 0] } \
else { return “” }
}

proc int2rgb {long} {
return [format "%d.%d.%d" \
[expr ($long >> 16) & 0xff] \
[expr ($long >> & 0xff] \
[expr $long & 0xff]]
}

# expr’s abs() and int() can’t handle large unsigned integers,
# these functions are just to get around this
proc conv_int {value} {
return [lindex [split $value "."] 0]
}

proc conv_abs {value} {
return [string trimleft $value "-"]
}

proc conv_absint {value} {
return [conv_int [conv_abs $value]]
}

proc conv_units {value type1 type2} {
global conv_units_exec
regsub -all {‘} [conv_fixtopic $type1] {} type1
regsub -all {‘} [conv_fixtopic $type2] {} type2
if {[catch {exec bash -c "$conv_units_exec '$value $type1' '$type2'"} output]} {
error $output
}
foreach line [split $output \n] {
if {[regexp -- {^\s*([^=]+=.+)$} $line tmp result]} {
return $result
}
}
error “unknown response from units command”
}

proc conv_scan {var_formula var_unit index} {
global conv_ignore conv_unit
upvar 1 $var_formula formula $var_unit unit
set string {([a-z]+(-[a-z]+)?)}
if {[regexp -nocase -start $index -- $string $formula a unit]} {
if {[lsearch -exact $conv_ignore $unit] != -1} {
# Ignore this unit and search for the next unit
regexp -nocase -start $index -indices $string — $formula a index
return [conv_scan "formula" "unit" [expr [lindex $index 1] + 1]]
} else {
# Found unit, return ok
return 1
}
}
# No more units found
return 0
}

# $var will be either unit, misc_from, or misc_to
proc conv {value unit var lists} {
global conv_$var
upvar 1 list uplist
if {![info exists uplist]} {
set uplist “”
}
set type [expr {($var == "unit") || ($var == "misc_from") ? "*" : "/"}]
# First we check full names, then abbreviations
foreach method {name abbv} {
foreach list $lists {
# Default options
set option_absint 0
set option_metric 1
foreach {name abbv formula} [set conv_$var\($list)] {
if {$name == “option”} {
set option_$abbv $formula
} elseif {[regexp -nocase -- "^([set $method])\$” $unit a b prefix]} {
set uplist $list
if {([catch {expr $formula} value]) || ($value == “”)} {
error “evaluating expression for ‘$unit’”
}
if {$option_absint} {
set value [conv_absint $value]
}
if {($option_metric) && ($prefix != “”) && ([catch {expr [conv_metric $prefix $method $option_metric] $type $value} value])} {
error “evaluating metric conversion for ‘$unit’”
}
return $value
}
}
}
}
error “unknown conversion type ‘$unit’”
}

# $method will be either “name” or “abbv”
# $option will be either 1 or 2
proc conv_metric {prefix method option} {
global conv_metric
foreach {name abbv factor} $conv_metric {
if {(($method == “name”) && ([string equal -nocase $name $prefix])) || (($method == “abbv”) && ([string equal $abbv $prefix]))} {
if {$option == 1} {
return [expr pow(10, $factor)] ; # Regular metric
} elseif {$option == 2} {
return [expr pow(2, ($factor / 3 * 10))] ; # Binary conversion
}
}
}
error “unknown metric prefix”
}
# End conversion code

# Begin Public binds code
proc msg_conv {nick uhost hand arg} {
global botnick
pub_conv $nick $uhost $hand “” $arg
}

proc pub_conv {nick uhost hand chan arg} {
global botnick value global conv_channel_flag
global conv_units_exec conv_unit conv_misc_from conv_misc_to
if {(![isbotnick $nick]) && (![matchattr $hand +b])} {
if {(![string match "$chan" ""]) && (![channel get $chan $conv_channel_flag])} {
return 0 ; # If command comes from a channel, and that channel doesn’t have +convert then ignore
}
set isuser [expr {[matchattr $hand - $chan] || [matchattr $hand -]}] ; # Note that $chan might be “”, so we must handle both cases
if {([validchan $chan]) && ($isuser)} {
set output1 $chan ; # The bot sends the text to the channel for users
} else {
set output1 $nick ; # Non-users get privmsg’d
}
if {[set i [string last ">" $arg]] == -1} {
set output2 $output1 ; # By default, output2 (~stdout~) goes to output1 (~stderr~)
} else {
# Output has been redirected
if {(!$isuser) || ([set output2 [string trim [string range $arg [expr $i + 1] end] ” “]] == “”)} {
set output2 $output1 ; # Error (User doesn’t have access, or output was “”), so we go back to the default
}
set arg [string trim [string range $arg 0 [expr $i - 1]] ” “]
}
set remainder [xrange $arg 0 end]
if {(([scan $remainder "%s from %s to %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
(([scan $remainder "%s from %s %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
(([scan $remainder "%s %s to %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
(([scan $remainder "%s %s %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
((([info exists value]) && ([unset value] == “”)) || 1) && \
(([scan $remainder "from %s to %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
(([scan $remainder "from %s %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
(([scan $remainder "%s to %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
(([scan $remainder "%s %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}]))} {
conv_msg $output1 “error parsing sentence”
} else {
if {![info exists value]} {
set value 1
}
if {![catch {conv $value $type1 "misc_from" [array names conv_misc_from]} type1_value]} {
if {[catch {conv $type1_value $type2 "misc_to" $list} type2_value]} {
conv_msg $output1 “error $type2_value”
} else {
conv_msg $output2 “$value $type1 = $type2_value $type2″
}
} elseif {($conv_units_exec != “”) && (![catch {conv_units $value $type1 $type2} output])} {
conv_msg $output2 $output
} else {
set type1_formula $type1
set type2_formula $type2
set found 0
while 1 {
if {[conv_scan "type1_formula" "type1_unit" 0]} {
if {![conv_scan "type2_formula" "type2_unit" 0]} {
conv_msg $output1 “error unmatched type ‘$type1_unit’”
} elseif {[catch {conv 1 $type1_unit "unit" [array names conv_unit]} type1_value]} {
conv_msg $output1 “error $type1_value”
} elseif {![regsub -nocase $type1_unit $type1_formula $type1_value type1_formula]} {
conv_msg $output1 “error decompiling expression ‘$type1_unit’”
} elseif {[catch {conv 1 $type2_unit "unit" $list} type2_value]} {
conv_msg $output1 “error $type2_value”
} elseif {![regsub -nocase $type2_unit $type2_formula $type2_value type2_formula]} {
conv_msg $output1 “error decompiling expression ‘$type2_unit’”
} else {
incr found
continue
}
} elseif {[conv_scan "type2_formula" "type2_unit" 0]} {
conv_msg $output1 “error unmatched type ‘$type2_unit’”
} else {
break
} ; # At the end, so stop
return ; # We got an error somewhere, bail out
}
if {!$found} {
conv_msg $output1 “error no conversion types found”
} elseif {[catch {expr [conv_fixexpr "($value) * ($type1_formula) / ($type2_formula)"]} value2]} {
conv_msg $output1 “error evaluating expression”
} else {
conv_msg $output2 “$value $type1 = $value2 $type2″
}
}
}
}
}
# End Public binds code

# Init stuff
if {[catch {package require Tcl 8.3} error]} {
putlog “error TCL v8.3 or higher is required to run this script”
return 0
}

putlog “*** LOADED: convert.tcl”

#### Readme / Help #############################################################
################################################################################
## This script is ripped from KuNgFoO’s ib.tcl v3.19 (infobot) script. ##
################################################################################

#### Changelog #################################################################
################################################################################
## v1.0.0 ##
## + Initial release. ##
## + Added the possibility to control which channels could use the commands ##
## with a channel flag. ##
## * Applied a dirty hack to solve a minor redirection bug, which caused all ##
## add/append/remove commands that contained a > to break the script. ##
################################################################################

# Set next line as the directory where the database files are
# located (no other files should be in the same dir)
set faq_dir “data/”

# Set the next line as the default database to save changes to
set faq_database “FooBot.dat”

# What should the channel flag be, to enable the FAQ for that channel?
set faq_channel_flag “faq”

# The default value should be ok for the next two:
# Set the next line as the format to display time in (without timezone)
set faq_format_notz “%H:%M:%S – %A, %B %d, %Y”

# Set the next line as the format to display time in (with timezone)
set faq_format “$faq_format_notz %Z”

# Set the next line as the maxinum number of matches to
# return on searches
set faq_max 5

# Set the next line as the maxinum number of lines to
# return publicly
set faq_max_lines 3

# Set the next line as the flag required to add/remove
# questions and etc
set faq_flag “+f”

# Set the next line as how often to save changes to the database
# (in minutes)
set faq_time 10

proc xrange {xr xr1 xr2} {
return [join [lrange [split $xr] $xr1 $xr2]]
}

proc xindex {xr xr1} {
return [join [lrange [split $xr] $xr1 $xr1]]
}

proc validnum {num} {
return [expr [scan $num "%f%s" a b] == 1]
}

proc anymatch {string1 string2} {
foreach string $string2 {
if {[lsearch -exact [string tolower $string1] [string tolower $string]] != -1} {
return 1
}
}
return 0
}

proc parseurl {url} {
foreach var {protocol user pass server port path cgiargs anchor} { upvar 1 $var $var }
if {[regexp {(([^:]+)://)?(([^:]+):([^@]+)@)?([^:/\?#]+)(:([0-9]+))?(/([^\?#]+))?(\?([^#]+))?(#(.*))?} $url a b protocol c user pass server d port e path f cgiargs g anchor]} {
if {$protocol == “”} {
set protocol “http”
}
if {![validnum $port]} {
set port 80
}
return 1
} else {
return 0
}
}

# Begin Database code
proc faq_fixtopic {arg} {
regsub -all {[\\\{\}\[\]\”]} $arg {} arg ; # Bad characters
regsub -all {(\s)+} $arg {\1} arg ; # Double whitespace
regsub -all {^\s*|\s*$} $arg {} arg ; # Whitespace at ends
return $arg
}

proc faq_fixdb {arg} {
global faq_databases
if {[set i [lsearch -exact [string tolower $faq_databases] [string tolower $arg]]] == -1} {
return “error no such database ‘$arg’ loaded”
} else {
return [lindex $faq_databases $i]
}
}

proc faq_fixdata {arg output} {
global botnick
if {[string index $output 0] != “#”} {
regsub -all -nocase {$output’s} $arg “your” arg
}
regsub -all -nocase {$botnick’s} $arg “my” arg
return $arg
}

proc faq_msg {targets arg} {
foreach target $targets {
puthelp “PRIVMSG $target :[faq_fixdata $arg $target]“
}
}

proc faq_check {} {
global faq_dir
if {![file exists $faq_dir]} {
return “error $faq_dir does not exist”
} elseif {![file isdirectory $faq_dir]} {
return “error $faq_dir is not a directory”
} elseif {![file readable $faq_dir]} {
return “error $faq_dir is unreadable”
} elseif {![file writable $faq_dir]} {
return “error $faq_dir is unwritable”
}
return “”
}

proc faq_loadall {output1 output2} {
global faq_dir faq_databases
# Unset current databases first
faq_unloadall
if {[set error [faq_check]] != “”} {
if {$output1 == “”} {
putlog $error
} else {
faq_msg $output1 $error
}
} else {
foreach file [glob -nocomplain [file join $faq_dir *]] {
if {[file isfile $file]} {
if {[xindex [set output [faq_load [file tail $file]]] 0] == “error”} {
if {$output1 == “”} {
putlog $output
} else {
faq_msg $output1 $output
}
} else {
if {$output2 == “”} {
putlog $output
} else {
faq_msg $output2 $output
}
}
}
}
}
}

proc faq_load {database} {
global faq_dir faq_databases faq_data_$database
set file [file join $faq_dir $database]
faq_unload $database
if {([string match *..* $database]) || ([string index $database 0] == “/”)} {
return “error invalid database name ‘$database’”
} elseif {![file exists $file]} {
return “error database ‘$database’ does not exist”
} elseif {![file isfile $file]} {
return “error database ‘$database’ is not a valid file”
} elseif {[catch {open $file r} fileid]} {
return “error could not read database ‘$database’”
} else {
if {[catch {array set faq_data_$database [read $fileid]}]} {
return “error could not parse database ‘$database’”
}
close $fileid
lappend faq_databases $database
return “read database ‘$database’”
}
}

proc faq_unloadall {} {
global faq_databases
if {[info exists faq_databases]} {
foreach database $faq_databases {
faq_unload $database
}
}
set faq_databases “”
}

proc faq_unload {database} {
global faq_databases faq_data_$database
if {[array exists faq_data_$database]} {
array unset faq_data_$database
}
if {[set i [lsearch -exact $faq_databases $database]] != -1} {
set faq_databases [lreplace $faq_databases $i $i]
}
}

proc faq_saveall {output1 output2} {
global faq_databases faq_save
set error 0
if {[set output [faq_check]] != “”} {
if {$output1 == “”} {
putlog $error
} else {
faq_msg $output1 $output
}
set error 1
} else {
foreach database $faq_databases {
if {[xindex [set output [faq_save $database]] 0] == “error”} {
if {$output1 == “”} {
putlog $output
} else {
faq_msg $output1 $output
}
set error 1
} else {
if {$output2 == “”} {
putlog $output
} else {
faq_msg $output2 $output
}
}
}
}
set faq_save $error
}

proc faq_save {database} {
global faq_dir faq_databases faq_data_$database
if {[catch {open [file join $faq_dir $database] w} fileid]} {
return “error could not write database ‘database’”
} else {
puts $fileid [array get faq_data_$database]
close $fileid
return “wrote database ‘$database’”
}
}

proc faq_needsave {} {
global faq_save
set faq_save 1
}

proc time_faq {} {
global faq_time faq_save
if {$faq_save} {
faq_saveall “” “”
}
if {![string match *time_faq* [timers]]} {
timer $faq_time time_faq
}
}

proc faq_topics {arg} {
set topics “”
set arg [string trimright $arg "?! "]
set length [llength $arg]
for {set l $length} {$l > 0} {incr l -1} {
for {set i [expr $length - $l]} {$i >= 0} {incr i -1} {
if {[lsearch -exact [string tolower $topics] [string tolower [set topic [lrange $arg $i [expr $i + $l - 1]]]]] == -1} {
lappend topics $topic
}
}
}
return $topics
}

# {“topic 1″ “topic 2″ …} -> faq_find -> {“database” “first topic found”}
# note: databases are not checked for validity
proc faq_find {topics} {
global faq_databases
foreach topic $topics {
set topic [faq_fixtopic $topic]
foreach database $faq_databases {
if {[xindex [set topic2 [faq_exists $topic $database 1]] 0] != “error”} {
return [list $database $topic2]
}
}
}
}

# “*topic string*” -> faq_find2 -> { {“database” “topic found 1″} {“database” “topic found 2″} … }
proc faq_find2 {topic} {
global faq_databases
set topic [faq_fixtopic $topic]
set topics “”
foreach database $faq_databases {
global faq_data_$database
# [array names faq_data_$database -glob *topic*] would be really nice here, but it has no -nocase option!
foreach topic2 [array names faq_data_$database] {
if {[string match -nocase *$topic* $topic2]} {
lappend topics [list $database $topic2]
}
}
}
return $topics
}

proc faq_parsetopic {arg var1 var2} {
global $var1 $var2
set i [string first "=" $arg]
set $var1 [string trim [string range $arg 0 [expr $i - 1]] ” “]
set $var2 [string trim [string range $arg [expr $i + 1] end] ” “]
for {set i 1} {$i <= 2} {incr i} {
if {[string match "topic*" [set topic_var [set var$i]]]} {
# if this is a topic, we look for a database too
set database_var “database[string range $topic_var 5 end]“
if {[xindex [set error [faq_parsedb [set $topic_var] $topic_var $database_var]] 0] == “error”} {
return $error
} ; # we got an error parsing the db
}
}
if {([set $var1] == “”) || ([set $var2] == “”) || ($i == -1)} {
return “error parsing sentence”
}
}

proc faq_parsedb {arg var1 var2} {
global faq_database $var1 $var2
if {[set i [string last "|" $arg]] != -1} {
set $var1 [string trim [string range $arg 0 [expr $i - 1]] ” “]
set $var2 [string trim [string range $arg [expr $i + 1] end] ” “]
} else {
if {[set tmp [faq_find [list $arg]]] != “”} {
set $var2 [lindex $tmp 0] ; # we go with the db that this topic is already stored in
} else {
set $var2 $faq_database ; # we go w/ default db
}
}
if {([set $var1 [faq_fixtopic [set $var1]]] == “”) || ([set $var2] == “”)} {
return “error parsing sentence”
}
return [set $var2 [faq_fixdb [set $var2]]] ; # this may return an error
}

# type = 0, returns 1/0 ; type = 1, returns proper case (or error), for use with existing topics ;
# type = 2, returns proper case (or original topic), for use with creating new topics
proc faq_exists {topic database type} {
global faq_data_$database
if {[set i [lsearch [string tolower [array names faq_data_$database]] [string tolower $topic]]] != -1} {
if {$type == 0} {
return 1
} else {
return [lindex [array names faq_data_$database] $i]
}
} else {
if {$type == 0} {
return 0
} elseif {$type == 1} {
return “error topic ‘$topic’ does not exist in database ‘$database’”
} else {
return $topic
}
}
}

proc faq_write {topic database type arg host} {
global faq_data_$database
set topic [faq_exists $topic $database 2]
if {$type == “w”} {
set faq_data_${database}($topic) [list $arg]
} elseif {$type == “a”} {
lappend faq_data_${database}($topic) $arg
}
lappend faq_data_${database}($topic) “#WHOSET $host [clock seconds]“
}

proc faq_read {topic database} {
global faq_data_$database
if {[xindex [set database [faq_fixdb $database]] 0] == “error”} {
return $database
} elseif {[xindex [set topic [faq_exists $topic $database 1]] 0] == “error”} {
return $topic
} else {
return [set faq_data_${database}($topic)]
}
}

proc faq_copy {topic1 database1 topic2 database2} {
global faq_data_$database1 faq_data_$database2
if {[faq_exists $topic2 $database2 0]} {
return “error topic ‘$topic2′ already exists in database ‘$database2′”
} elseif {[xindex [set output [faq_read $topic1 $database1]] 0] == “error”} {
return $output
} else {
set faq_data_${database2}($topic2) $output
}
}

proc faq_remove {topic database} {
global faq_data_$database
if {[xindex [set topic [faq_exists $topic $database 1]] 0] == “error”} {
return $topic
} else {
unset faq_data_${database}($topic)
}
}

proc faq_disp {arg database output1 output2 depth num option nick} {
global faq_max_lines
if {$depth >= 3} {
faq_msg $output1 “error recursion too deep”
return -1
}
set found 0
if {$database != “”} {
set list [list [list $database $arg]] ; # we have an exact topic/db to display
} else {
set list [list [faq_find [faq_topics $arg]]]; # find topic/db (s)
}
# note: the $list vars above needed to be padded with { } – hence the [list] ’s
foreach tmp $list {
if {$tmp == “”} {
continue
}
if {!$depth} {
set num 0
}
if {[xindex [set output [faq_read [set topic [lindex $tmp 1]] [set database [lindex $tmp 0]]]] 0] == “error”} {
faq_msg $output1 $output
} else {
foreach line $output {
if {($line == “”) || ([xindex $line 0] == “#WHOSET”)} {
#ignore
} elseif {[xindex $line 0] == “#LINK”} {
if {[set temp [faq_disp [lindex $line 1] [lindex $line 2] $output1 $output2 [expr $depth + 1] $num 0 $nick]] > 0} {
incr num $temp
}
} elseif {[xindex $line 0] == “.”} {
faq_msg $output2 [xrange $line 1 end]
incr num
} elseif {!$num} {
faq_msg $output2 “$topic – $line”
incr num
} else {
faq_msg $output2 “… $line”
incr num
}
}
if {!$num} {
faq_msg $output1 “error ‘$topic’ exists, but is empty”
} elseif {(![string equal -nocase $output2 $output1]) && (!$depth)} {
faq_msg $output2 “(sent by $output1)”
faq_msg $output1 “sent ‘$topic’ to $output2″
}
incr found
}
}
if {!$found} {
if {$depth > 0} {
faq_msg $output1 “error invalid link to ‘$arg’”
}
}
return $num
}
# End Database code

# Begin ‘calc’ code
proc faq_fixexpr {exp} {
global faq_const
set exp [faq_fixtopic $exp]
foreach i [array names faq_const] {
regsub -all “\%$i” $exp $faq_const($i) exp
}
return $exp
}
# End ‘calc’ code

# expr’s abs() and int() can’t handle large unsigned integers,
# these functions are just to get around this
proc faq_int {value} {
return [lindex [split $value "."] 0]
}

proc faq_abs {value} {
return [string trimleft $value "-"]
}

proc faq_absint {value} {
return [faq_int [faq_abs $value]]
}

# Begin Public binds code
proc msg_faq {nick uhost hand arg} {
pub_faq $nick $uhost $hand “” $arg
}

proc pub_faq {nick uhost hand chan arg} {
global botnick faq_dir faq_format faq_max faq_flag faq_database faq_databases faq_channel_flag
global topic topic1 topic2 database database1 database2 value
if {(![isbotnick $nick]) && (![matchattr $hand +b]) && ((($chan != “”) && ([channel get $chan $faq_channel_flag])) || ($chan == “”))} {
if {[string match -nocase $botnick* $arg]} {
set arg [xrange $arg 1 end] ; # Only answer channel messages that begin with the bot’s nick
} elseif {$chan == “”} {
# Answer all privmsgs
} else {
return ; # Msg isn’t for us, bail out
}

set isuser [expr {[matchattr $hand $faq_flag|$faq_flag $chan] || [matchattr $hand $faq_flag]}] ; # Note that $chan might be “”, so we must handle both cases
if {([validchan $chan]) && ($isuser)} {
set output1 $chan ; # The bot sends the text to the channel for users
} else {
set output1 $nick ; # Non-users get privmsg’d
}

set output2 $output1 ; # By default, output2 (~stdout~) goes to output1 (~stderr~)

if {([lsearch -exact [split "shutup stop sh database db set learn add unset forget delete del remove rem rm erase append addon link join copy cp move mv rename ren"] [string tolower [xindex $arg 0]]] == -1) && ([set i [string last ">" $arg]] != -1)} {
# Output has been redirected
if {(!$isuser) || ([set output2 [string trim [string range $arg [expr $i + 1] end] ” “]] == “”)} {
set output2 $output1 ; # Error (User doesn’t have access, or output was “”), so we go back to the default
}
set arg [string trim [string range $arg 0 [expr $i - 1]] ” “]
}

set command [string tolower [xindex $arg 0]]
set remainder [xrange $arg 1 end]
switch — $command {
“shutup” – “stop” – “sh” {
if {$isuser} {
if {[clearqueue help]} {
faq_msg $output2 “OK, sorry”
} else {
faq_msg $output2 “But I’m not saying anything!”
}
}
}
“database” – “db” {
if {$isuser} {
switch — [string tolower [xindex $remainder 0]] {
“reload” {
faq_loadall $output1 $output2
}
“save” {
faq_saveall $output1 $output2
}
“list” {
set i 1
faq_msg $output2 “Loaded database(s):”
foreach database $faq_databases {
global faq_data_$database
faq_msg $output2 [format "%s %-15s %s" $i. $database #[array size faq_data_$database]]
incr i
}
faq_msg $output2 “end”
}
default {
faq_msg $output1 “error must be one of ‘reload’, ’save’ , or ‘list’”
}
}
}
}
“set” – “learn” – “add” {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic value]] 0] == “error”) || \
([xindex [set error [faq_write $topic $database "w" $value $nick!$uhost]] 0] == “error”)} {
faq_msg $output1 $error
} else {
faq_msg $output2 “Set ‘$topic’ in database ‘$database’”
faq_needsave
}
}
}
“unset” – “forget” – “delete” – “del” – “remove” – “rem” – “rm” – “erase” {
if {$isuser} {
if {([xindex [set error [faq_parsetopic "$remainder = null" topic value]] 0] == “error”) || \
([xindex [set error [faq_remove $topic $database]] 0] == “error”)} {
faq_msg $output1 $error
} else {
faq_msg $output2 “Unset ‘$topic’ in database ‘$database’”
faq_needsave
}
}
}
“append” – “addon” {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic value]] 0] == “error”) || \
([xindex [set error [faq_write $topic $database "a" $value $nick!$uhost]] 0] == “error”)} {
faq_msg $output1 $error
} else {
faq_msg $output2 “Appended to ‘$topic’ in database ‘$database’”
faq_needsave
}
}
}
“link” – “join” {
if {$isuser} {
if {[xindex [set error [faq_parsetopic $remainder topic1 topic2]] 0] == “error”} {
faq_msg $output1 $error
} elseif {[xindex [set topic2 [faq_exists $topic2 $database2 1]] 0] == “error”} {
faq_msg $output1 $topic2 ; # check if 2nd topic exists, get proper casing too (so $topic2 not $error is used)
} elseif {[xindex [set error [faq_write $topic1 $database1 "a" [list #LINK $topic2 $database2] $nick!$uhost]] 0] == “error”} {
faq_msg $output1 $error
} else {
faq_msg $output2 “Linked ‘$topic1′ ($database1) to ‘$topic2′ ($database2)”
faq_needsave
}
}
}
“copy” – “cp” {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic1 topic2]] 0] == “error”) || \
([xindex [set error [faq_copy $topic1 $database1 $topic2 $database2]] 0] == “error”)} {
faq_msg $output1 $error
} else {
faq_msg $output2 “Copied ‘$topic1′ ($database1) to ‘$topic2′ ($database2)”
faq_needsave
}
}
}
“move” – “mv” – “rename” – “ren” {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic1 topic2]] 0] == “error”) || \
([xindex [set error [faq_copy $topic1 $database1 $topic2 $database2]] 0] == “error”) || \
([xindex [set error [faq_remove $topic1 $database1]] 0] == “error”)} {
faq_msg $output1 $error
} else {
faq_msg $output2 “Renamed ‘$topic1′ ($database1) to ‘$topic2′ ($database2)”
faq_needsave
}
}
}
“list” – “find” – “search” – “locate” {
set topics [faq_find2 $remainder]
switch — [set found [llength $topics]] {
0 {
faq_msg $output1 “Found no matches to ‘$remainder’”
}
1 {
faq_disp [join $topics] “” $output1 $output2 0 0 0 $nick
}
default {
faq_msg $output2 “Found $found matches to ‘$remainder’”
set i 1
foreach topic $topics {
faq_msg $output2 “$i. [lindex $topic 1]“
if {$i >= $faq_max} {
break
}
incr i
}
faq_msg $output2 “end”
}
}
}
“whoset” {
if {[xindex [set error [faq_parsetopic "$remainder = null" topic value]] 0] == “error”} {
faq_msg $output1 $error
} elseif {[xindex [set output [faq_read $topic $database]] 0] == “error”} {
faq_msg $output1 $output
} else {
set found 0
foreach line $output {
if {[xindex $line 0] == “#WHOSET”} {
if {!$found} {
faq_msg $output2 “‘$topic’ (database $database) set by [xindex $line 1] on [clock format [xindex $line 2] -format $faq_format]”
incr found
} else {
faq_msg $output2 “… modified by [xindex $line 1] on [clock format [xindex $line 2] -format $faq_format]”
}
}
}
if {!$found} {
faq_msg $output1 “error could not find who set topic ‘$topic’”
}
}
}
default {
faq_disp $arg “” $output1 $output2 0 0 1 $nick
}
}
}
}
# End Public binds code

# Init stuff
if {[catch {package require Tcl 8.3} error]} {
putlog “error TCL v8.3 or higher is required to run this script”
return 0
}
putlog “*** LOADED: faq.tcl”

bind pubm – * pub_faq
bind msgm – * msg_faq
setudef flag $faq_channel_flag

if {![info exists faq_load]} {
faq_loadall “” “”
set faq_load 1
}
if {![info exists faq_save]} {
set faq_save 0
}
if {![string match *time_faq* [timers]]} {
timer $faq_time time_faq
}

#### Readme / Help #############################################################
################################################################################
## This is a slightly modified version of KuNgFoO’s nslookup.tcl v0.5 script. ##
## ##
## Script that can do nslookups. ##
## ##
## Usage: ##
## To have the .dns command available on a channel you need to set the ##
## channel flag +nslookups from the console/partyline . ##
## “.chanset #channel +nslookups´´ ##
## ##
## Channel Commands (available only if channel is +nslookups): ##
## .dns [ host|ip|nick[ host|ip|nick][ ...]] ##
## Example: ##
## “.dns www.eggfaq.com´´ ##
################################################################################

#### Changelog #################################################################
################################################################################
## v1.0.1 ##
## * Minor code cleanup ##
## ##
## v1.0.0 ##
## + Initial release. ##
## + Added the possibility to control which channels could use the commands ##
## with the channel flag “+/-nslookup´´ ##
################################################################################

# Set then next line as the command you want to initate the nslookup
set nslookup_command “.dns”

# Set the flagname used for enabling the channel command
set nslookup_channel_flag “nslookup”

# Set the next line as the flag required to use the command
set nslookup_flag “-”

# Set the next line as the exec command to run
# (Only if you’re running an older eggdrop or not using the nslookup module)
set nslookup_exec “nslookup -silent”

bind pub $nslookup_flag|$nslookup_flag $nslookup_command pub_nslookup

proc pub_nslookup {nick uhost hand chan arg} {
global nslookup_command nslookup_exec botnick nslookup_channel_flag
if {([channel get $chan $nslookup_channel_flag]) && (![matchattr $hand b]) && ($nick != $botnick)} {
if {$arg == “”} {
putserv “PRIVMSG $chan :Usage: $nslookup_command \[host/ip/nick #2\] …”
} else {
foreach addr [set addrs [split $arg {,;| }]] {
if {$addr == “”} {
continue ; # ignore
}
if {[set tmp [getchanhost $addr]] != “”} {
set addr [lindex [split $tmp @] end]
}
if {![regexp {^[a-zA-Z0-9\.\-]*$} $addr]} {
putserv “PRIVMSG $chan :Error: Hostname ‘$addr’ contains illegal characters” ; # vulnerability
} elseif {[string index $addr 0] == “-”} {
putserv “PRIVMSG $chan :Error: Hostnames cannot begin with a – character ($addr)” ; # vulnerability
} elseif {[info commands dnslookup] != “”} {
dnslookup $addr return_nslookup $chan $addr
} elseif {[catch {exec bash -c "$nslookup_exec '$addr'"} output]} {
putserv “PRIVMSG $chan :Could not resolve $addr”
} else {
foreach line [split $output \n] {
if {[lindex $line 0] == “Name:”} {
set host [lrange $line 1 end]
} elseif {([lindex $line 0] == “Address:”) || ([lindex $line 0] == “Addresses:”)} {
set ip [lrange $line 1 end]
}
}
if {([info exists host]) && ([info exists ip])} {
return_nslookup $ip $host 1 $chan $addr
} else {
return_nslookup “” “” 0 $chan $addr
}
}
}
}
}
}

proc return_nslookup {ip host status chan addr} {
if {$status} {
if {[string match *$ip* $addr]} {
putserv “PRIVMSG $chan :$ip -> $host”
} else {
putserv “PRIVMSG $chan :$host -> $ip”
}
} else {
putserv “PRIVMSG $chan :Could not resolve $addr”
}
}

setudef flag $nslookup_channel_flag
putlog “*** LOADED: nslookup.tcl”