archive/eggdrop
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source
This commit is contained in:
Stefan Ritter 2011-08-16 10:51:41 +02:00
commit ba46c304bd
45 changed files with 9144 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

78
CONTENTS Normal file
View file

@ -0,0 +1,78 @@
$Id: CONTENTS,v 1.17 2010/01/03 13:27:31 pseudo Exp $
Directory Contents - scripts/
Last revised: August 08, 2004
_____________________________________________________________________
Directory Contents - scripts/
These are the example scripts that come with eggdrop. They're meant to be
useful AND to introduce Tcl to those who haven't dealt with it before. Even
people who program in Tcl may be confused by Eggdrop's implementation at
first, because so many commands were added to interface with the bot.
action.fix.tcl
Gets rid of those ugly /me's people do instead of a .me.
alltools.tcl
Several useful procs for use in scripts.
autobotchk
Tcl script used to crontab your Eggdrop. Type 'scripts/autobotchk' from the
Eggdrop's root directory for help.
botchk
A shell script which can be used for auto-starting the bot via 'cron'.
cmd_resolve.tcl
Adds a dcc command called '.resolve' which can be used to resolve hostnames
or IP addresses via the partyline.
compat.tcl
Maps old Tcl functions to new ones, for lazy people who can't be bothered
updating their scripts.
dccwhois.tcl
Enhances Eggdrop's built-in dcc '.whois' command to allow all
users to '.whois' their own handle.
getops.tcl
A way for bots to get ops from other bots on the botnet (if they're on the
same channel).
klined.tcl
Removes servers from your server list that your bot has been k-lined on, to
prevent admins getting peeved with constant connects from your bot's host.
notes2.tcl
Check your notes on every shared bot of the hub.
ques5.tcl
Makes web pages of who's on each channel, updated periodically (requires
alltools.tcl).
quotepass.tcl
Some servers on the Undernet will make you send 'PASS <numbers>' before
you can connect if you did not return an identd response. This script will
handle sending that for you.
quotepong.tcl
Some EFnet servers require the user to type /quote pong :<cookie>
when identd is broken or disabled. This will send pong :<cookie> to
the server when connecting.
sentinel.tcl (by slennox)
Flood protection script for Eggdrop with integrated BitchX CTCP simulation.
This script is designed to provide strong protection for your bot and
channels against large floodnets and proxy floods.
userinfo.tcl
Cute user info settings things.
weed
Weed out certain undesirables from an Eggdrop userlist. Type 'scripts/weed'
from the Eggdrop's root directory for help.
_____________________________________________________________________
Copyright (C) 2001 - 2010 Eggheads Development Team

26
action.fix.tcl Normal file
View file

@ -0,0 +1,26 @@
# action.fix.tcl
#
# Copyright (C) 2002 - 2010 Eggheads Development Team
#
# Tothwolf 25May1999: cleanup
# Tothwolf 04Oct1999: changed proc names slightly
# poptix 07Dec2001: handle irssi (and some others) "correct" messages for DCC CTCP
#
# $Id: action.fix.tcl,v 1.12 2010/01/03 13:27:31 pseudo Exp $
# Fix for mIRC dcc chat /me's:
bind filt - "\001ACTION *\001" filt:dcc_action
bind filt - "CTCP_MESSAGE \001ACTION *\001" filt:dcc_action2
proc filt:dcc_action {idx text} {
return ".me [string trim [join [lrange [split $text] 1 end]] \001]"
}
proc filt:dcc_action2 {idx text} {
return ".me [string trim [join [lrange [split $text] 2 end]] \001]"
}
# Fix for telnet session /me's:
bind filt - "/me *" filt:telnet_action
proc filt:telnet_action {idx text} {
return ".me [join [lrange [split $text] 1 end]]"
}

441
alltools.tcl Normal file
View file

@ -0,0 +1,441 @@
#
# All-Tools TCL, includes toolbox.tcl, toolkit.tcl and moretools.tcl
# toolbox was originally authored by cmwagner <cmwagner@sodre.net>
# toolkit was originally authored by Robey Pointer
# moretools was originally authored by David Sesno <walker@shell.pcrealm.net>
# modified for 1.3.0 bots by TG
#
# Copyright (C) 1999, 2003 - 2010 Eggheads Development Team
#
# Tothwolf 02May1999: rewritten and updated
# guppy 02May1999: updated even more
# Tothwolf 02May1999: fixed what guppy broke and updated again
# Tothwolf 24/25May1999: more changes
# rtc 20Sep1999: added isnumber, changes
# dw 20Sep1999: use regexp for isnumber checking
# Tothwolf 06Oct1999: optimized completely
# krbb 09Jun2000: added missing return to randstring
# Tothwolf 18Jun2000: added ispermowner
# Sup 02Apr2001: added matchbotattr
# Tothwolf 13Jun2001: updated/modified several commands
# Hanno 28Sep2001: fixed testip
# guppy 03Mar2002: optimized
# Souperman 05Nov2002: added ordnumber
# Tothwolf 27Dec2003: added matchbotattrany, optimized ordnumber,
# more minor changes
#
# $Id: alltools.tcl,v 1.23 2010/01/03 13:27:31 pseudo Exp $
#
########################################
#
# Descriptions of available commands:
#
##
## (toolkit):
##
#
# putmsg <nick/chan> <text>
# send a privmsg to the given nick or channel
#
# putchan <nick/chan> <text>
# send a privmsg to the given nick or channel
# (for compat only, this is the same as 'putmsg' above)
#
# putnotc <nick/chan> <text>
# send a notice to the given nick or channel
#
# putact <nick/chan> <text>
# send an action to the given nick or channel
#
#
##
## (toolbox):
##
#
# strlwr <string>
# string tolower
#
# strupr <string>
# string toupper
#
# strcmp <string1> <string2>
# string compare
#
# stricmp <string1> <string2>
# string compare (case insensitive)
#
# strlen <string>
# string length
#
# stridx <string> <index>
# string index
#
# iscommand <command>
# if the given command exists, return 1
# else return 0
#
# timerexists <command>
# if the given command is scheduled by a timer, return its timer id
# else return empty string
#
# utimerexists <command>
# if the given command is scheduled by a utimer, return its utimer id
# else return empty string
#
# inchain <bot>
# if the given bot is connected to the botnet, return 1
# else return 0
# (for compat only, same as 'islinked')
#
# randstring <length>
# returns a random string of the given length
#
# putdccall <text>
# send the given text to all dcc users
#
# putdccbut <idx> <text>
# send the given text to all dcc users except for the given idx
#
# killdccall
# kill all dcc user connections
#
# killdccbut <idx>
# kill all dcc user connections except for the given idx
#
#
##
## (moretools):
##
#
# iso <nick> <channel>
# if the given nick has +o access on the given channel, return 1
# else return 0
#
# realtime [format]
# 'time' returns the current time in 24 hour format '14:15'
# 'date' returns the current date in the format '21 Dec 1994'
# not specifying any format will return the current time in
# 12 hour format '1:15 am'
#
# testip <ip>
# if the given ip is valid, return 1
# else return 0
#
# number_to_number <number>
# if the given number is between 1 and 15, return its text representation
# else return the number given
#
#
##
## (other commands):
##
#
# isnumber <string>
# if the given string is a valid number, return 1
# else return 0
#
# ispermowner <handle>
# if the given handle is a permanent owner, return 1
# else return 0
#
# matchbotattr <bot> <flags>
# if the given bot has all the given flags, return 1
# else return 0
#
# matchbotattrany <bot> <flags>
# if the given bot has any the given flags, return 1
# else return 0
#
# ordnumber <string>
# if the given string is a number, returns the
# "ordinal" version of that number, i.e. 1 -> "1st",
# 2 -> "2nd", 3 -> "3rd", 4 -> "4th", etc.
# else return <string>
#
########################################
# So scripts can see if allt is loaded.
set alltools_loaded 1
set allt_version 206
# For backward compatibility.
set toolbox_revision 1007
set toolbox_loaded 1
set toolkit_loaded 1
#
# toolbox:
#
proc putmsg {dest text} {
puthelp "PRIVMSG $dest :$text"
}
proc putchan {dest text} {
puthelp "PRIVMSG $dest :$text"
}
proc putnotc {dest text} {
puthelp "NOTICE $dest :$text"
}
proc putact {dest text} {
puthelp "PRIVMSG $dest :\001ACTION $text\001"
}
#
# toolkit:
#
proc strlwr {string} {
string tolower $string
}
proc strupr {string} {
string toupper $string
}
proc strcmp {string1 string2} {
string compare $string1 $string2
}
proc stricmp {string1 string2} {
string compare [string tolower $string1] [string tolower $string2]
}
proc strlen {string} {
string length $string
}
proc stridx {string index} {
string index $string $index
}
proc iscommand {command} {
if {[string compare "" [info commands $command]]} then {
return 1
}
return 0
}
proc timerexists {command} {
foreach i [timers] {
if {![string compare $command [lindex $i 1]]} then {
return [lindex $i 2]
}
}
return
}
proc utimerexists {command} {
foreach i [utimers] {
if {![string compare $command [lindex $i 1]]} then {
return [lindex $i 2]
}
}
return
}
proc inchain {bot} {
islinked $bot
}
proc randstring {length {chars abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789}} {
if {([string compare "" $length]) && \
(![regexp \[^0-9\] $length])} then {
set count [string length $chars]
if {$count} then {
for {set index 0} {$index < $length} {incr index} {
append result [string index $chars [rand $count]]
}
} else {
error "empty character string"
}
} else {
error "invalid random string length"
}
return $result
}
proc putdccall {text} {
foreach i [dcclist CHAT] {
putdcc [lindex $i 0] $text
}
}
proc putdccbut {idx text} {
foreach i [dcclist CHAT] {
set j [lindex $i 0]
if {$j != $idx} then {
putdcc $j $text
}
}
}
proc killdccall {} {
foreach i [dcclist CHAT] {
killdcc [lindex $i 0]
}
}
proc killdccbut {idx} {
foreach i [dcclist CHAT] {
set j [lindex $i 0]
if {$j != $idx} then {
killdcc $j
}
}
}
#
# moretools:
#
proc iso {nick chan} {
matchattr [nick2hand $nick $chan] o|o $chan
}
proc realtime {args} {
switch -exact -- [lindex $args 0] {
time {
return [strftime %H:%M]
}
date {
return [strftime "%d %b %Y"]
}
default {
return [strftime "%I:%M %P"]
}
}
}
proc testip {ip} {
set tmp [split $ip .]
if {[llength $tmp] != 4} then {
return 0
}
set index 0
foreach i $tmp {
if {(([regexp \[^0-9\] $i]) || ([string length $i] > 3) || \
(($index == 3) && (($i > 254) || ($i < 1))) || \
(($index <= 2) && (($i > 255) || ($i < 0))))} then {
return 0
}
incr index
}
return 1
}
proc number_to_number {number} {
switch -exact -- $number {
0 {
return Zero
}
1 {
return One
}
2 {
return Two
}
3 {
return Three
}
4 {
return Four
}
5 {
return Five
}
6 {
return Six
}
7 {
return Seven
}
8 {
return Eight
}
9 {
return Nine
}
10 {
return Ten
}
11 {
return Eleven
}
12 {
return Twelve
}
13 {
return Thirteen
}
14 {
return Fourteen
}
15 {
return Fifteen
}
default {
return $number
}
}
}
#
# other commands:
#
proc isnumber {string} {
if {([string compare "" $string]) && \
(![regexp \[^0-9\] $string])} then {
return 1
}
return 0
}
proc ispermowner {hand} {
global owner
if {([matchattr $hand n]) && \
([lsearch -exact [split [string tolower $owner] ", "] \
[string tolower $hand]] != -1)} then {
return 1
}
return 0
}
proc matchbotattr {bot flags} {
foreach flag [split $flags ""] {
if {[lsearch -exact [split [botattr $bot] ""] $flag] == -1} then {
return 0
}
}
return 1
}
proc matchbotattrany {bot flags} {
foreach flag [split $flags ""] {
if {[string first $flag [botattr $bot]] != -1} then {
return 1
}
}
return 0
}
proc ordnumber {string} {
if {[isnumber $string]} then {
set last [string index $string end]
if {[string index $string [expr [string length $string] - 2]] != 1} then {
if {$last == 1} then {
return ${string}st
} elseif {$last == 2} then {
return ${string}nd
} elseif {$last == 3} then {
return ${string}rd
}
}
return ${string}th
}
return $string
}

377
autobotchk Executable file
View file

@ -0,0 +1,377 @@
#! /bin/sh
# This trick is borrowed from Tothwolf's Wolfpack \
# Check for working 'grep -E' before using 'egrep' \
if echo a | (grep -E '(a|b)') >/dev/null 2>&1; \
then \
egrep="grep -E"; \
else \
egrep=egrep; \
fi; \
# Search for tclsh[0-9].[0-9] in each valid dir in PATH \
for dir in $(echo $PATH | sed 's/:/ /g'); \
do \
if test -d $dir; \
then \
files=$(/bin/ls $dir | $egrep '^tclsh[0-9]\.[0-9]$'); \
if test "$files" != ""; \
then \
versions="${versions:+$versions }$(echo $files | sed 's/tclsh//g')"; \
fi; \
fi; \
done; \
for ver in $versions; \
do \
tmpver=$(echo $ver | sed 's/\.//g'); \
if test "$lasttmpver" != ""; \
then \
if test "$tmpver" -gt "$lasttmpver"; \
then \
lastver=$ver; \
lasttmpver=$tmpver; \
fi; \
else \
lastver=$ver; \
lasttmpver=$tmpver; \
fi; \
done; \
exec tclsh$lastver "$0" ${1+"$@"}
#
# AutoBotchk - An eggdrop utility to autogenerate botchk/crontab entries
#
# Copyright (C) 1999, 2000, 2001, 2002 Jeff Fisher (guppy@eggheads.org)
#
# How to use
# ----------
#
# Most people begin to use AutoBotchk by moving it from the script
# directory to their Eggdrop directory -- this will save you from having to
# use the -dir option.
#
# If you run AutoBotchk without any arguments, it will present you with
# a list of valid ones. Most people run AutoBotchk by doing:
#
# ./autobotchk <config file>
#
# This will setup crontab to check every 10 minutes to see whether or not
# your bot needs to be restarted and it will e-mail if a restart was
# performed. A lot of people turn off crontab e-mail support; however, I do
# not recommend this since you will be unable to see any errors that might
# happen.
#
# Updates
# -------
# 27Sep2001: added new pidfile setting
# 14Nov2001: removed old autobotchk update entries and updated the help
# section a little bit. also made autobotchk move down one
# directory if being run from the scripts directory.
# 15Apr2003: cleaned up a few things, fixed a few bugs, and made a little
# love! j/k
#
# $Id: autobotchk,v 1.12 2008/06/18 10:12:22 tothwolf Exp $
#
if {$argc == 0} {
puts "\nusage: $argv0 <eggdrop config> \[options\]"
puts " -dir (directory to run autobotchk in)"
puts " -noemail (discard crontab e-mails)"
puts " -5 (5 minute checks)"
puts " -10 (10 minute checks)"
puts " -15 (15 minute checks)"
puts " -30 (30 minute checks)"
puts ""
exit
}
fconfigure stdout -buffering none
proc newsplit {text {split " "}} {
upvar $text ours
append ours $split
set index [string first $split $ours]
if {$index == -1} {
set ours ""
return ""
}
set tmp [string trim [string range $ours 0 $index]]
set ours [string trim [string range $ours [expr $index + [string length $split]] end]]
return $tmp
}
puts "\nautobotchk 1.10, (C) 2003 Jeff Fisher (guppy@eggheads.org)"
puts "------------------------------------------------------------\n"
set config [newsplit argv]
set dir [pwd]
set delay 10
set email 1
# If you renamed your eggdrop binary, you should change this variable
set binary "eggdrop"
while {[set opt [newsplit argv]] != ""} {
switch -- $opt {
"-time" -
"-1" { set delay 1 }
"-5" { set delay 5 }
"-10" { set delay 10 }
"-15" { set delay 15 }
"-20" { set delay 20 }
"-30" { set delay 30 }
"-nomail" -
"-noemail" {set email 0}
"-dir" {
set dir [newsplit argv]
if {[string match -* $dir]} {
puts "*** ERROR: you did not supply a directory name"
puts ""
exit
}
if {![file isdirectory $dir]} {
puts "*** ERROR: the directory you supplied is not a directory"
puts ""
exit
}
}
}
}
switch -- $delay {
"30" { set minutes "0,30" }
"20" { set minutes "0,20,40" }
"15" { set minutes "0,15,30,45" }
"5" { set minutes "0,5,10,15,20,25,30,35,40,45,50,55" }
"1" { set minutes "*" }
default { set minutes "0,10,20,30,40,50" }
}
if {[string match "*/scripts" $dir]} {
set dir [string range $dir 0 [expr [string length $dir] - 8]]
}
set dir [string trimright $dir /]
if {![file exists $dir/help] || ![file isdirectory $dir/help]} {
puts "*** ERROR: are you sure you are running from a bot directory?"
puts ""
exit
} elseif {![file exists $dir/$binary]} {
puts "*** ERROR: are you sure you are running from a bot directory?"
puts ""
exit
}
puts -nonewline "Opening '$config' for processing ... "
if {[catch {open $dir/$config r} fd]} {
puts "error:"
puts " $fd\n"
exit
} else {
puts "done"
}
set count 0
puts -nonewline "Scanning the config file "
while {![eof $fd]} {
incr count
if {$count == 100} {
puts -nonewline "."
set count 0
}
set line [gets $fd]
if {[set blarg [newsplit line]] != "set"} {
continue
}
switch -- [set opt [newsplit line]] {
"pidfile" -
"nick" -
"userfile" -
"botnet-nick" {
set $opt [string trim [newsplit line] " \""]
}
}
}
close $fd
if {$count != 0} {
puts -nonewline "."
}
puts " done"
if {![info exists {botnet-nick}] && [info exists nick]} {
puts " Defaulting \$botnet-nick to \"$nick\""
set botnet-nick $nick
}
if {![info exists pidfile]} {
puts " Defaulting \$pidfile to \"pid.${botnet-nick}\""
set pidfile "pid.${botnet-nick}"
}
if {![info exists {botnet-nick}] || ![info exists userfile]} {
puts " *** ERROR: could not find either \$userfile or \$botnet-nick"
puts ""
puts " Are you sure this is a valid eggdrop config file?"
puts ""
exit
}
if {[catch {open $dir/${botnet-nick}.botchk w} fd]} {
puts " *** ERROR: unable to open '${botnet-nick}.botchk' for writing"
puts ""
exit
}
puts $fd "#! /bin/sh
#
# ${botnet-nick}.botchk (generated on [clock format [clock seconds] -format "%B %d, %Y @ %I:%M%p"])
#
# Generated by AutoBotchk 1.10
# Copyright (C) 1999, 2000, 2001, 2002, 2003 Jeff Fisher <guppy@eggheads.org>
#
# change this to the directory you run your bot from:
botdir=\"$dir\"
# change this to the name of your bot's script in that directory:
botscript=\"$binary $config\"
# change this to the nickname of your bot (capitalization COUNTS)
botname=\"${botnet-nick}\"
# change this to the name of your bot's userfile (capitalization COUNTS)
userfile=\"$userfile\"
# change this to the name of your bot's pidfile (capitalization COUNTS)
pidfile=\"$pidfile\"
########## you probably don't need to change anything below here ##########
cd \$botdir
# is there a pid file?
if test -r \$pidfile
then
# there is a pid file -- is it current?
botpid=`cat \$pidfile`
if `kill -CHLD \$botpid >/dev/null 2>&1`
then
# it's still going -- back out quietly
exit 0
fi
echo \"\"
echo \"Stale \$pidfile file, erasing...\"
rm -f \$pidfile
fi
if test -r CANTSTART.\$botname
then
if test -r \$userfile || test -r \$userfile~new || test -r \$userfile~bak
then
echo \"\"
echo \"Userfile found, removing check file 'CANTSTART.\$botname'...\"
rm -f CANTSTART.\$botname
fi
fi
# test if we have run botchk previously and didn't find a userfile
if test ! -f CANTSTART.\$botname
then
echo \"\"
echo \"Couldn't find bot '\$botname' running, reloading...\"
echo \"\"
# check for userfile and reload bot if found
if test -r \$userfile
then
# It's there, load the bot
./\$botscript
exit 0
else
if test -r \$userfile~new
then
# Bot f*@!ed up while saving the userfile last time. Move it over.
echo \"Userfile missing. Using last saved userfile...\"
mv -f \$userfile~new \$userfile
./\$botscript
exit 0
else
if test -r \$userfile~bak
then
# Userfile is missing, use backup userfile.
echo \"Userfile missing. Using backup userfile...\"
cp -f \$userfile~bak \$userfile
./\$botscript
exit 0
else
# Well, nothing to work with...
echo \"No userfile. Could not reload the bot...\"
echo \"no userfile\" > CANTSTART.\$botname
exit 1
fi
fi
fi
fi
exit 0
"
close $fd
puts "Wrote '${botnet-nick}.botchk' successfully ([file size $dir/${botnet-nick}.botchk] bytes)"
if {[catch {exec chmod u+x $dir/${botnet-nick}.botchk} 0]} {
puts " *** ERROR: unable to 'chmod u+x' the output file"
puts ""
exit
}
puts -nonewline "Scanning crontab entries ... "
set tmp ".autobotchk[clock clicks].[pid]"
if {$email} {
set line "$minutes \* \* \* \* $dir/${botnet-nick}.botchk"
} {
set line "$minutes \* \* \* \* $dir/${botnet-nick}.botchk >\/dev\/null 2>&1"
}
if {[catch {exec crontab -l > $tmp} error ]} {
if {![string match "*no*cron*" [string tolower $error]] &&
![string match "*can't open*" [string tolower $error]]} {
catch {file delete -force $tmp} 0
puts "error: unable to get crontab listing"
puts ""
puts $error
puts ""
exit
}
}
set fd [open $tmp r]
while {![eof $fd]} {
set z [gets $fd]
if {[string match "*$dir/${botnet-nick}.botchk*" $z] ||
[string match "*$dir//${botnet-nick}.botchk*" $z]} {
puts "found an existing entry, we're done now"
puts ""
exit
}
}
close $fd
puts "done"
puts -nonewline "Adding the new crontab entry ... "
set fd [open $tmp a]
puts $fd $line
close $fd
if {[catch {exec crontab $tmp} error]} {
puts "error: unable to do 'crontab $tmp'"
puts ""
puts $error
puts ""
exit
} else {
catch {file delete -force $tmp} 0
}
puts "done"
puts ""
puts "Use 'crontab -l' to view all your current crontab entries"
puts " 'crontab -r' to remove all your crontab entries"
puts ""

103
botchk Executable file
View file

@ -0,0 +1,103 @@
#! /bin/sh
#
# botchk
#
# $Id: botchk,v 1.6 2002/02/27 18:21:46 guppy Exp $
#
# This is a script suitable for use in a crontab. It checks to make sure
# your bot is running. YOU NEED A SEPARATE CRON JOB FOR EACH BOT. If your
# bot isn't found, it'll try to start it back up.
#
# You'll need to edit this script for your bot.
#
# To check for your bot every 10 minutes, put the following line in your
# crontab:
# 0,10,20,30,40,50 * * * * /home/mydir/mybot/botchk
# And if you don't want to get email from crontab when it checks you bot,
# put the following in your crontab:
# 0,10,20,30,40,50 * * * * /home/mydir/mybot/botchk >/dev/null 2>&1
#
# change this to the directory you run your bot from (capitalization COUNTS):
botdir="/home/mydir/mybot"
# change this to the name of your bot's config file (capitalization COUNTS):
botscript="mybot"
# change this to the botnet-nick of your bot (capitalization COUNTS):
botname="LamestBot"
# change this to the name of your bot's userfile (capitalization COUNTS):
userfile="LamestBot.user"
# change this to the name of your bot's pidfile (capitalization COUNTS):
pidfile="pid.LamestBot"
########## you probably don't need to change anything below here ##########
cd $botdir
# is there a pid file?
if test -r $pidfile
then
# there is a pid file -- is it current?
botpid=`cat $pidfile`
if `kill -CHLD $botpid >/dev/null 2>&1`
then
# it's still going -- back out quietly
exit 0
fi
echo ""
echo "Stale $pidfile file, erasing..."
rm -f $pidfile
fi
if test -r CANTSTART.$botname
then
if test -r $userfile || test -r $userfile~new || test -r $userfile~bak
then
echo ""
echo "Userfile found, removing check file 'CANTSTART.$botname'..."
rm -f CANTSTART.$botname
fi
fi
# test if we have run botchk previously and didn't find a userfile
if test ! -f CANTSTART.$botname
then
echo ""
echo "Couldn't find bot '$botname' running, reloading..."
echo ""
# check for userfile and reload bot if found
if test -r $userfile
then
# It's there, load the bot
./$botscript
exit 0
else
if test -r $userfile~new
then
# Bot f*@!ed up while saving the userfile last time. Move it over.
echo "Userfile missing. Using last saved userfile..."
mv -f $userfile~new $userfile
./$botscript
exit 0
else
if test -r $userfile~bak
then
# Userfile is missing, use backup userfile.
echo "Userfile missing. Using backup userfile..."
cp -f $userfile~bak $userfile
./$botscript
exit 0
else
# Well, nothing to work with...
echo "No userfile. Could not reload the bot..."
echo "no userfile" > CANTSTART.$botname
exit 1
fi
fi
fi
fi
exit 0

48
cmd_resolve.tcl Normal file
View file

@ -0,0 +1,48 @@
#
# cmd_resolve.tcl
# written by Jeff Fisher (guppy@eggheads.org)
#
# This script adds the commands '.resolve' and '.dns' which can be used to
# lookup hostnames or ip addresses in the partyline without causing the bot
# to block while doing so thanks to the dns module.
#
# updates
# -------
# 15Apr2003: fixed a logging bug and stop using regexp incorrectly
# 05Nov2000: fixed a nasty security hole, .resolve [die] <grin>
# 04Nov2000: first version
#
# $Id: cmd_resolve.tcl,v 1.4 2003/04/16 01:03:04 guppy Exp $
bind dcc -|- resolve resolve_cmd
bind dcc -|- dns resolve_cmd
proc resolve_cmd {hand idx arg} {
global lastbind
if {[scan $arg "%s" hostip] != 1} {
putidx $idx "Usage: $lastbind <host or ip>"
} else {
putidx $idx "Looking up $hostip ..."
set hostip [split $hostip]
dnslookup $hostip resolve_callback $idx $hostip $lastbind
}
return 0
}
proc resolve_callback {ip host status idx hostip cmd} {
if {![valididx $idx]} {
return 0
} elseif {!$status} {
putidx $idx "Unable to resolve $hostip"
} elseif {[string tolower $ip] == [string tolower $hostip]} {
putidx $idx "Resolved $ip to $host"
} else {
putidx $idx "Resolved $host to $ip"
}
putcmdlog "#[idx2hand $idx]# $cmd $hostip"
return 0
}
loadhelp cmd_resolve.help
putlog "Loaded cmd_resolve.tcl successfully."

5
commands.tcl Normal file
View file

@ -0,0 +1,5 @@
#bind pub - np proc_np
proc proc_np {nick host hand chan args} {
# putserv "PRIVMSG $chan :-> supportboard!"
}

138
compat.tcl Normal file
View file

@ -0,0 +1,138 @@
# compat.tcl
# This script just quickly maps old Tcl commands to the new ones.
# Use this if you are too lazy to get off your butt and update your scripts :D
#
# Copyright (C) 2002 - 2010 Eggheads Development Team
#
# Wiktor 31Mar2000: added binds and chnick proc
# Tothwolf 25May1999: cleanup
# Tothwolf 06Oct1999: optimized
# rtc 10Oct1999: added [set|get][dn|up]loads functions
# pseudo 04Oct2009: added putdccraw
# Pixelz 08Apr2010: changed [time] to be compatible with Tcl [time]
#
# $Id: compat.tcl,v 1.19 2010/07/02 21:56:44 pseudo Exp $
proc gethosts {hand} {
getuser $hand HOSTS
}
proc addhost {hand host} {
setuser $hand HOSTS $host
}
proc chpass {hand pass} {
setuser $hand PASS $pass
}
proc chnick {oldnick newnick} {
chhandle $oldnick $newnick
}
# setxtra is no longer relevant
proc getxtra {hand} {
getuser $hand XTRA
}
proc setinfo {hand info} {
setuser $hand INFO $info
}
proc getinfo {hand} {
getuser $hand INFO
}
proc getaddr {hand} {
getuser $hand BOTADDR
}
proc setaddr {hand addr} {
setuser $hand BOTADDR $addr
}
proc getdccdir {hand} {
getuser $hand DCCDIR
}
proc setdccdir {hand dccdir} {
setuser $hand DCCDIR $dccdir
}
proc getcomment {hand} {
getuser $hand COMMENT
}
proc setcomment {hand comment} {
setuser $hand COMMENT $comment
}
proc getemail {hand} {
getuser $hand XTRA email
}
proc setemail {hand email} {
setuser $hand XTRA EMAIL $email
}
proc getchanlaston {hand} {
lindex [getuser $hand LASTON] 1
}
if {![llength [info commands {TCLTIME}]] && [llength [info commands {time}]]} {
rename time TCLTIME
}
proc time {args} {
if {([llength $args] != 0) && [llength [info commands {TCLTIME}]]} {
if {[llength [info commands {uplevel}]]} {
uplevel 1 TCLTIME $args
} else {
eval TCLTIME $args
}
} else {
strftime "%H:%M"
}
}
proc date {} {
strftime "%d %b %Y"
}
proc setdnloads {hand {c 0} {k 0}} {
setuser $hand FSTAT d $c $k
}
proc getdnloads {hand} {
getuser $hand FSTAT d
}
proc setuploads {hand {c 0} {k 0}} {
setuser $hand FSTAT u $c $k
}
proc getuploads {hand} {
getuser $hand FSTAT u
}
proc putdccraw {idx size text} {
if {!$idx} {
putloglev o * "Warning! putdccraw is deprecated. Use putnow instead!"
putnow $text
return -code ok
}
putloglev o * "Warning! putdccraw is deprecated. Use putdcc instead!"
if {![valididx $idx]} {return -code error "invalid idx"}
putdcc $idx $text -raw
}
# as you can see it takes a lot of effort to simulate all the old commands
# and adapting your scripts will take such an effort you better include
# this file forever and a day :D
# Following are some TCL global variables that are obsolete now and have been removed
# but are still defined here so not to break older scripts
set strict-servernames 0

167
dccwhois.tcl Normal file
View file

@ -0,0 +1,167 @@
###############################################################################
##
## dccwhois.tcl - Enhanced '.whois' dcc command for Eggdrop
## Copyright (C) 2009 Tothwolf <tothwolf@techmonkeys.org>
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
##
###############################################################################
##
## $Id: dccwhois.tcl,v 1.1 2009/01/22 03:12:45 tothwolf Exp $
##
###############################################################################
##
## Description:
##
## This script enhances Eggdrop's built-in dcc '.whois' command to allow all
## users to '.whois' their own handle.
##
## Users without the correct flags who attempt to '.whois' other users will
## instead see the message: "You do not have access to whois handles other
## than your own."
##
## To load this script, add a source command to your bot's config file:
##
## source scripts/dccwhois.tcl
##
## This script stores and checks against the flags that are used for
## Eggdrop's built-in dcc '.whois' command at load time. If you wish to use
## flags other than the default "to|o", etc, you should unbind and rebind
## the built-in '.whois' command in your bot's config file before loading
## this script.
##
## Example of how to rebind Eggdrop's built-in '.whois' command:
##
## unbind dcc to|o whois *dcc:whois
## bind dcc to|m whois *dcc:whois
##
## Note: if you modify the default flags for '.whois' you may also wish to
## modify the defaults for '.match'.
##
###############################################################################
##
## This script has no settings and does not require any configuration.
## You should not need to edit anything below.
##
###############################################################################
# This script should not be used with Eggdrop versions 1.6.16 - 1.6.19.
catch {set numversion}
if {([info exists numversion]) &&
($numversion >= 1061600) && ($numversion <= 1061900)} then {
putlog "Error: dccwhois.tcl is not compatible with Eggdrop version [lindex $version 0]. Please upgrade to 1.6.20 or later."
return
}
#
# dcc:whois --
#
# Wrapper proc command for Eggdrop's built-in *dcc:whois
#
# Arguments:
# hand - handle of user who used this command
# idx - dcc idx of user who used this command
# arg - arguments passed to this command
#
# Results:
# Calls Eggdrop's built-in *dcc:whois with the given arguments if user has
# access, otherwise tells the user they don't have access.
#
proc dcc:whois {hand idx arg} {
global dccwhois_flags
set arg [split [string trimright $arg]]
set who [lindex $arg 0]
# Did user gave a handle other than their own?
if {([string compare "" $who]) &&
([string compare [string toupper $hand] [string toupper $who]])} then {
# Get user's current .console channel; check the same way Eggdrop does.
set chan [lindex [console $idx] 0]
# User isn't allowed to '.whois' handles other than their own.
if {![matchattr $hand $dccwhois_flags $chan]} then {
putdcc $idx "You do not have access to whois handles other than your own."
return 0
}
}
# Call built-in whois command.
*dcc:whois $hand $idx $arg
# Return 0 so we don't log command twice.
return 0
}
#
# init_dccwhois --
#
# Initialize dccwhois script-specific code when script is loaded
#
# Arguments:
# (none)
#
# Results:
# Set up command bindings and store command access flags.
#
proc init_dccwhois {} {
global dccwhois_flags
putlog "Loading dccwhois.tcl..."
# Sanity check...
if {[array exists dccwhois_flags]} then {
array unset dccwhois_flags
}
# Search binds for built-in '*dcc:whois' and loop over each bind in list
foreach bind [binds "\\*dcc:whois"] {
# dcc to|o whois 0 *dcc:whois
foreach {type flags name count command} $bind {break}
# We only want to unbind dcc '.whois'
if {[string compare $name "whois"]} then {
continue
}
# Store $flags so we can reuse them later
set dccwhois_flags $flags
# Unbind built-in *dcc:whois
unbind $type $flags $name $command
}
# Make sure $dccwhois_flags exists and isn't empty,
# otherwise set to Eggdrop's default "to|o"
if {(![info exists dccwhois_flags]) ||
(![string compare "" $dccwhois_flags])} then {
set dccwhois_flags "to|o"
}
# Add bind for dcc:whois wrapper proc
bind dcc -|- whois dcc:whois
putlog "Loaded dccwhois.tcl"
return
}
init_dccwhois

104
decision.tcl Normal file
View file

@ -0,0 +1,104 @@
# decision.tcl by lookshe (v 1.1)
#
# todo: little bit better coding style
#
# Changelog:
#
# 1.0
# - first working version
#
# 1.1
# - remember answers for 60 minutes (doesn't work atm)
# mask arguments!
bind pub - \[ proc_decision
proc proc_decision {nick host hand chan arguments} {
global do_dec
if {[info exists do_dec($nick:$chan)]} {
if {$nick == "lookshe"} {
unset do_dec($nick:$chan)
} else {
set act_do_dec $do_dec($nick:$chan)
if {$act_do_dec < 3} {
incr act_do_dec
set do_dec($nick:$chan) $act_do_dec
} else {
putserv "NOTICE $nick :no flooding!"
return 0
}
}
} else {
if {$nick != "lookshe"} {
set do_dec($nick:$chan) 1
timer 10 "unset do_dec($nick:$chan)"
}
}
set allargs $arguments
set arguments [split $arguments]
set count 1
set klammer_count 0
if {([lindex $arguments 0] == "]") || ([string first "]" [lindex $arguments 0]] == 0)} {
incr klammer_count
} else {
return
}
while {$count != [llength $arguments]} {
if {[lindex $arguments $count] == "\["} {
set tmp $count
incr tmp
if {([lindex $arguments $tmp] == "]") || ([string first "]" [lindex $arguments $tmp]] == 0)} {
incr klammer_count
}
}
incr count
}
if {$klammer_count == 1} {
return
}
set count 0
set myrand [rand $klammer_count]
# if {[info exists do_dec($allargs)]} {
# set myrand $do_dec($allargs)
# } else {
# set do_dec($allargs) $myrand
# timer 60 "unset do_dec($allargs)"
# }
set klammer_count 0
if {$myrand == 0} {
set output "\[X"
while {$count != [llength $arguments]} {
set output "$output[lindex $arguments $count] "
incr count
}
} else {
set output "\["
while {$count != [llength $arguments]} {
if {[lindex $arguments $count] == "\["} {
set tmp $count
incr tmp
if {([lindex $arguments $tmp] == "]") || ([string first "]" [lindex $arguments $tmp]] == 0)} {
incr klammer_count
}
}
if {$klammer_count == $myrand} {
if {([lindex $arguments $count] == "]") || ([string first "]" [lindex $arguments $count]] == 0)} {
set output "[string range $output 0 end]X"
} else {
set output "$output "
}
} else {
set output "$output "
}
set output "$output[lindex $arguments $count]"
incr count
}
}
putserv "PRIVMSG $chan :$output"
}
putlog "decision by lookshe loaded"

47
eggdrop-pisg.tcl Normal file
View file

@ -0,0 +1,47 @@
#pisg.tcl v0.15 by HM2K - auto stats script for pisg (perl irc statistics generator)
#based on a script by Arganan
# WARNING - READ THIS
#
# If you use this script, PLEASE read the documentation about the "Silent"
# option. If you get the message "an error occured: Pisg v0.67 - perl irc
# statistics generator" in the channel, you are NOT running silent. Fix it.
set pisgver "0.15"
#Location of pisg execuitable perl script
set pisgexe "/home/eggdrop/eggdrop/pisg/pisg"
#URL of the generated stats
set pisgurl "http://www.thehappy.de/habo/stats"
#channel that the stats are generated for
set pisgchan "#hackerboard"
#Users with these flags can operate this function
set pisgflags "nm"
#How often the stats will be updated in minutes, ie: 30 - stats will be updated every 30 minutes
set pisgtime "1440"
bind pub $pisgflags !stats pub:pisgcmd
proc pub:pisgcmd {nick host hand chan arg} {
global pisgexe pisgurl pisgchan
append out "PRIVMSG $pisgchan :" ; if {[catch {exec $pisgexe} error]} { append out "$pisgexe an error occured: [string totitle $error]" } else { append out "Stats Updated: $pisgurl" }
# puthelp $out
}
proc pisgcmd_timer {} {
global pisgexe pisgurl pisgchan pisgtime
append out "PRIVMSG $pisgchan :" ; if {[catch {exec $pisgexe} error]} { append out "$pisgexe an error occured: [string totitle $error]" } else { append out "Stats Updated: $pisgurl" }
# puthelp $out
timer $pisgtime pisgcmd_timer
}
if {![info exists {pisgset}]} {
set pisgset 1
timer 2 pisgcmd_timer
}
putlog "pisg.tcl $pisgver loaded"

91
file.pl Normal file
View file

@ -0,0 +1,91 @@
#!/usr/bin/perl
#use strict;
#use warnings;
use Web::Scraper;
use URI;
use HTML::Entities;
use Encode;
use URI::Escape;
use LWP::UserAgent;
my $type = $ARGV[0];
my $file = $ARGV[1];
my $skipFile = $ARGV[2];
if ($length !~ /.{0,6}/) {
exit 0;
}
binmode(STDOUT, ":utf8");
if ($type !~ /^\./) {
$type =~ s/^/./;
}
my $found = 0;
if ($skipFile !~ /X/i)
{
open (in,"<$file")||die $!;
while (<in>) {
($ext = $_) =~ s/ .*\n//;
($des = $_) =~ s/^$ext (.*)\n/$1/;
if ($type =~ /^$ext$/) {
print "$ext is \"$des\"\n";
$found = 1;
}
}
close in;
}
$type =~ s/^\.//;
if ($found == 0) {
$found = 0;
#my $wikiurl = "http://filext.com/file-extension/$ARGV[0]";
#my $scrapp = scraper {
# process '//table/tr/td', 'chars[]' => 'TEXT';
#};
my $wikiurl = "http://www.file-extensions.org/search/?searchstring=$ARGV[0]";
my $scrapp = scraper {
process '//table/tr/td', 'chars[]' => 'TEXT';
process '//div//p', 'results[]' => 'TEXT';
process '//div[@id="heading"]/h2', 'text[]' => 'TEXT';
};
my $url = URI->new($wikiurl);
my $blubb = $scrapp->scrape($url);
my $list = $blubb->{'chars'};
my $res = $blubb->{'results'};
my $text = $blubb->{'text'};
my $morethanone = 0;
for ($i=0; $i <= $#$res; $i++) {
if ($$res[$i] =~ /Database contains .* records./i) {
$morethanone = 1;
}
}
if ($morethanone =~/1/) {
for ($i = 3; $i <= $#$list; $i++) {
if ($$list[$i] =~ /^.$type.+/i) {
last;
}
if ($$list[$i] !~ /^.$type$/i) {
print ".$type is $$list[$i]\n";
$found = 1;
}
}
} else {
print ".$type is $$text[0]\n";
$found = 1;
}
#for ($i = 0; $i <= $#$list; $i++) {
# if ($$list[$i] =~ /^Extension: $type$/i) {
# print ".$type is $$list[$i+4]\n";
# $found = 1;
# }
#}
if ($found == 0) {
print ".$type not in database\n";
}
}

15
file.tcl Normal file
View file

@ -0,0 +1,15 @@
bind pub - !filetype proc_file
proc proc_file {nick host hand chan arg} {
set arg [string trim $arg]
if {$arg == ""} {
return 0
}
set output [split "[exec perl /home/eggdrop/eggdrop/scripts/file.pl $arg /home/eggdrop/eggdrop/scripts/fileextensions.txt X]" "\n"]
foreach out $output {
putserv "PRIVMSG $chan :$out"
}
}
putlog "filetype by lookshe loaded"

2334
fileextensions.txt Normal file
View file

File diff suppressed because it is too large Load diff

40
firstseen.pl Normal file
View file

@ -0,0 +1,40 @@
#!/usr/bin/perl
if ($#ARGV ne 2){
print "not enough arguments\n";
exit 1;
}
my $chan=$ARGV[1];
my $folder=$ARGV[0];
my $nick=$ARGV[2];
my @files;
push @files, `ls $folder/$chan.* | sort`;
foreach $file (@files) {
my $date="irgendwas";
my $line;
open(file, $file) or die("Could not open file $file");
foreach $line (<file>) {
if ($line =~ m/^\[[0-9]{2}:[0-9]{2}(:[0-]{2})?\] (Action: )?<?$nick>? /i) {
if ($date =~ /^irgendwas$/) {
print "$nick belongs to inventory\n";
exit 0;
} else {
($time=$line)=~s/(.*)([0-9]{2}:[0-9]{2}(:[0-9]{2})?)(.*)\n/$3/;
print "$nick was first seen on $date at $time\n";
exit 0;
}
}
if ($line =~ m/^\[00:00(:00)?\] --- /){
($date=$line)=~s/^\[00:00(:00)?\] --- (.*)\n/$2/;
}
}
}
print "I do not remember $nick\n";

17
firstseen.tcl Normal file
View file

@ -0,0 +1,17 @@
# lastseen by xeno
bind pub - !firstseen firstseen
proc firstseen {nick host hand chan arg} {
set arg [string trim $arg]
if {$arg == ""} {
return 0
}
set output [split "[exec perl /home/eggdrop/eggdrop/scripts/firstseen.pl logs [string trimleft $chan #] $arg]" "\n"]
foreach out $output {
putserv "PRIVMSG $chan :$out";
}
}
putlog "firstseen by lookshe loaded"

371
getops.tcl Normal file
View file

@ -0,0 +1,371 @@
# Getops 2.3b
# $Id: getops.tcl,v 1.18 2003/03/26 00:19:30 wcc Exp $
# This script is used for bots to request and give ops to each other.
# For this to work, you'll need:
# - Bots must be linked in a botnet
# - Every bot that should be ops on your channels must load this script
# - Add all bots you wanna op with this one using the .+bot nick address
# command. The "nick" should be exactly the botnet-nick of the other bot
# - Add the hostmasks that uniquely identify this bot on IRC
# - Add a global or channel +o flag on all bots to be opped
# - Do exactly the same on all other bots
# The security of this relies on the fact that the bot which wants to have
# ops must be 1) linked to the current botnet (which requires a password),
# 2) have an entry with +o on the bot that he wants ops from and 3) must match
# the hostmask that is stored on each bots userfile (so it is good to keep the
# hostmasks up-to-date).
# -----------------------------------------------------------------------------
# 2.3c by PPSlim <ppslim@ntlworld.com>
# - Small fix on timer hanlding.
# Not list formatted, allowing command parsing of channel name
# 2.3b by gregul <unknown>
# - small fix in getbot
# 2.3a by guppy <guppy@eggheads.org>
# - fix for bind need
# 2.3 by guppy <guppy@eggheads.org>
# - minor cleanup to use some 1.6 tcl functions
# - use bind need over need-op, need-invite, etc ...
# 2.2g by poptix <poptix@poptix.net>
# - Fabian's 2.2e broke the script, fixed.
# 2.2f by Eule <eule@berlin.snafu.de>
# - removed key work-around added in 2.2d as eggdrop now handles this
# correctly.
# 2.2e by Fabian <fknittel@gmx.de>
# - added support for !channels (so-called ID-channels), using chandname2name
# functions. This makes it eggdrop 1.5+ specific.
# 2.2d by brainsick <brnsck@mail.earthlink.net>
# - Undernet now handles keys differently. It no longer gives the key on a
# join, but instead gives it on an op, but eggdrop doesn't check for this.
# getops-2.2d should now handle this correctly. (This should be the final
# fix to the key problems.)
# 2.2c by Progfou (Jean Christophe ANDRE <progfou@rumiko.info.unicaen.fr>)
# - changed "Requested" to "Requesting" as it was a little confusing
# - corrected the "I am not on chan..." problem with key request
# (thanks to Kram |FL| and Gael for reporting it)
# - removed more unnecessary check
# 2.2b by Progfou (Jean Christophe ANDRE <progfou@rumiko.info.unicaen.fr>)
# - removed global +o in unknown bot test
# - removed unnecessary checks due to previous unknown bot test
# 2.2a by Progfou (Jean Christophe ANDRE <progfou@rumiko.info.unicaen.fr>)
# - removed Polish language!
# 2.2 by Cron (Arkadiusz Miskiewicz <misiek@zsz2.starachowice.pl>)
# - works good (tested on eggdrop 1.3.11)
# - asks from unknown (and bots without +bo) are ignored
# - all messages in Polish language
# - better response from script to users
# - fixed several bugs
# 2.1 by Ernst
# - asks for ops right after joining the channel: no wait anymore
# - sets "need-op/need-invite/etc" config right after joining dynamic channels
# - fixed "You aren't +o" being replied when other bot isn't even on channel
# - better response from bots, in case something went wrong
# (for example if bot is not recognized (hostmask) when asking for ops)
# - removed several no-more-used variables
# - added the information and description above
# 2.0.1 by beldin (1.3.x ONLY version)
# - actually, iso needed to be modded for 1.3 :P, and validchan is builtin
# and I'll tidy a couple of functions up to
# 2.0 by DarkDruid
# - It'll work with dynamic channels(dan is a dork for making it not..)
# - It will also only ask one bot at a time for ops so there won't be any more
# annoying mode floods, and it's more secure that way
# - I also took that annoying wallop and resynch stuff out :P
# - And I guess this will with with 1.3.x too
# Previously by The_O, dtM.
# Original incarnation by poptix (poptix@poptix.net)
# -----------------------------------------------------------------------------
# [0/1] do you want GetOps to notice when some unknown (unauthorized) bot
# sends request to your bot
set go_bot_unknown 1
# [0/1] do you want your bot to request to be unbanned if it becomes banned?
set go_bot_unban 1
# [0/1] do you want GetOps to notice the channel if there are no ops?
set go_cycle 0
# set this to the notice txt for the above (go_cycle)
set go_cycle_msg "Please part the channel so the bots can cycle!"
# -----------------------------------------------------------------------------
set bns ""
proc gain_entrance {what chan} {
global botnick botname go_bot_unban go_cycle go_cycle_msg bns
switch -exact $what {
"limit" {
foreach bs [lbots] {
putbot $bs "gop limit $chan $botnick"
putlog "GetOps: Requesting limit raise from $bs on $chan."
}
}
"invite" {
foreach bs [lbots] {
putbot $bs "gop invite $chan $botnick"
putlog "GetOps: Requesting invite from $bs for $chan."
}
}
"unban" {
if {$go_bot_unban} {
foreach bs [lbots] {
putbot $bs "gop unban $chan $botname"
putlog "GetOps: Requesting unban on $chan from $bs."
}
}
}
"key" {
foreach bs [lbots] {
putbot $bs "gop key $chan $botnick"
putlog "GetOps: Requesting key on $chan from $bs."
}
}
"op" {
if {[hasops $chan]} {
set bot [getbot $chan]
if {$bot == ""} {
set bns ""
set bot [getbot $chan]
}
lappend bns "$bot"
if {$bot != ""} {
putbot $bot "gop op $chan $botnick"
putlog "GetOps: Requesting ops from $bot on $chan"
}
} {
if {$go_cycle} {
putserv "NOTICE [chandname2name $chan] :$go_cycle_msg"
}
}
}
}
}
proc hasops {chan} {
foreach user [chanlist $chan] {
if {[isop $user $chan]} {
return 1
}
}
return 0
}
proc getbot {chan} {
global bns
foreach bn [bots] {
if {[lsearch $bns $bn] < 0} {
if {[matchattr $bn o|o $chan]} {
set nick [hand2nick $bn $chan]
if {[onchan $nick $chan] && [isop $nick $chan]} {
return $bn
break
}
}
}
}
}
proc botnet_request {bot com args} {
global go_bot_unban go_bot_unknown
set args [lindex $args 0]
set subcom [lindex $args 0]
set chan [string tolower [lindex $args 1]]
if {![validchan $chan]} {
putbot $bot "gop_resp I don't monitor $chan."
return 0
}
# Please note, 'chandname2name' will cause an error if it is not a valid channel
# Thus, we make sure $chan is a valid channel -before- using it. -poptix
set idchan [chandname2name $chan]
set nick [lindex $args 2]
if {$subcom != "takekey" && ![botonchan $chan]} {
putbot $bot "gop_resp I am not on $chan."
return 0
}
if {![matchattr $bot b]} {
if { $go_bot_unknown == 1} {
putlog "GetOps: Request ($subcom) from $bot - unknown bot (IGNORED)"
}
return 0
}
switch -exact $subcom {
"op" {
if {![onchan $nick $chan]} {
putbot $bot "gop_resp You are not on $chan for me."
return 1
}
set bothand [finduser $nick![getchanhost $nick $chan]]
if {$bothand == "*"} {
putlog "GetOps: $bot requested ops on $chan. Ident not recognized: $nick![getchanhost $nick $chan]."
putbot $bot "gop_resp I don't recognize you on IRC (your ident: $nick![getchanhost $nick $chan])"
return 1
}
if {[string tolower $bothand] == [string tolower $nick]} {
putlog "GetOps: $bot requested ops on $chan."
} {
putlog "GetOps: $bot requested ops as $nick on $chan."
}
if {[iso $nick $chan] && [matchattr $bothand b]} {
if {[botisop $chan]} {
if {![isop $nick $chan]} {
putlog "GetOps: $nick asked for op on $chan."
putbot $bot "gop_resp Opped $nick on $chan."
pushmode $chan +o $nick
}
} {
putbot $bot "gop_resp I am not +o on $chan."
}
} {
putbot $bot "gop_resp You aren't +o in my userlist for $chan, sorry."
}
return 1
}
"unban" {
if {$go_bot_unban} {
putlog "GetOps: $bot requested that I unban him on $chan."
foreach ban [chanbans $chan] {
if {[string compare $nick $ban]} {
set bug_1 [lindex $ban 0]
pushmode $chan -b $bug_1
}
}
return 1
} {
putlog "GetOps: Refused request to unban $bot ($nick) on $chan."
putbot $bot "gop_resp Sorry, not accepting unban requests."
}
}
"invite" {
putlog "GetOps: $bot asked for an invite to $chan."
putserv "invite $nick $idchan"
return 1
}
"limit" {
putlog "GetOps: $bot asked for a limit raise on $chan."
pushmode $chan +l [expr [llength [chanlist $chan]] + 1]
return 1
}
"key" {
putlog "GetOps: $bot requested the key on $chan."
if {[string match *k* [lindex [getchanmode $chan] 0]]} {
putbot $bot "gop takekey $chan [lindex [getchanmode $chan] 1]"
} {
putbot $bot "gop_resp There isn't a key on $chan!"
}
return 1
}
"takekey" {
putlog "GetOps: $bot gave me the key to $chan! ($nick)"
foreach channel [string tolower [channels]] {
if {$chan == $channel} {
if {$idchan != ""} {
putserv "JOIN $idchan $nick"
} else {
putserv "JOIN $channel $nick"
}
return 1
}
}
}
default {
putlog "GetOps: ALERT! $bot sent fake 'gop' message! ($subcom)"
}
}
}
proc gop_resp {bot com msg} {
putlog "GetOps: MSG from $bot: $msg"
return 1
}
proc lbots {} {
set unf ""
foreach users [userlist b] {
foreach bs [bots] {
if {$users == $bs} {
lappend unf $users
}
}
}
return $unf
}
# Returns list of bots in the botnet and +o in my userfile on that channel
proc lobots { channel } {
set unf ""
foreach users [userlist b] {
if {![matchattr $users o|o $channel]} { continue }
foreach bs [bots] {
if {$users == $bs} { lappend unf $users }
}
}
return $unf
}
proc iso {nick chan} {
return [matchattr [nick2hand $nick $chan] o|o $chan]
}
proc gop_need {chan type} {
# Use bind need over setting need-op, need-invite, etc ...
gain_entrance $type $chan
}
bind need - * gop_need
bind bot - gop botnet_request
bind bot - gop_resp gop_resp
bind join - * gop_join
proc requestop { chan } {
global botnick
set chan [string tolower $chan]
foreach thisbot [lobots $chan] {
# Send request to all, because the bot does not have the channel info yet
putbot $thisbot "gop op $chan $botnick"
lappend askedbot $thisbot
}
if {[info exist askedbot]} {
regsub -all " " $askedbot ", " askedbot
putlog "GetOps: Requested Ops from $askedbot on $chan."
} {
putlog "GetOps: No bots to ask for ops on $chan."
}
return 0
}
proc gop_join { nick uhost hand chan } {
if {[isbotnick $nick]} {
utimer 3 [list requestop $chan]
}
return 0
}
set getops_loaded 1
putlog "GetOps v2.3c loaded."

73
google.tcl Normal file
View file

@ -0,0 +1,73 @@
#google.tcl v0.3 - Returns the value of the "I feel lucky" function on google for websites and images via triggers
#based on scripts by aNa|0Gue
set google(ver) "0.3"
#Simulate a browser, ie: Mozilla
set google(agent) "MSIE 6.0"
#google search trigger
set google(g_cmd) "!google"
#google uk search trigger
set google(guk_cmd) "!googleuk"
#google image search trigger
set google(gi_cmd) "!image"
#google prefix
set google(prefix) "* Google:"
package require http
bind pub - $google(g_cmd) pub:google
#bind pub - $google(guk_cmd) pub:googleuk
#bind pub - $google(gi_cmd) pub:image
proc pub:google { nick uhost handle channel arg } {
}
proc google:go { url arg } {
global google
regsub -all " " $arg "+" query
set lookup "$url$query"
set token [http::config -useragent $google(agent)]
set token [http::geturl $lookup]
puts stderr ""
upvar #0 $token state
set max 0
foreach {name value} $state(meta) {
if {[regexp -nocase ^location$ $name]} {
set newurl [string trim $value]
regsub -all "btnI=&" $url "" url
return "$newurl More: $url$query"
}
}
}
proc pub:google { nick uhost handle channel arg } {
global google
if {[llength $arg]==0} { putserv "NOTICE $nick :Usage: $google(g_cmd) <string>" }
set url "http://www.google.de/search?btnI=&q="
set output [google:go $url $arg]
putserv "PRIVMSG $channel :$nick, $google(prefix) $output"
}
proc pub:googleuk { nick uhost handle channel arg } {
global google
if {[llength $arg]==0} { putserv "NOTICE $nick :Usage: $google(guk_cmd) <string>" }
set url "http://www.google.co.uk/search?btnI=&q="
set output [google:go $url $arg]
putserv "PRIVMSG $channel :$nick, $google(prefix) $output"
}
proc pub:image { nick uhost handle channel arg } {
global google
if {[llength $arg]==0} { putserv "NOTICE $nick :Usage: $google(gi_cmd) <string>" }
set url "http://images.google.com/images?btnI=&q="
set output [google:go $url $arg]
putserv "PRIVMSG $channel :$nick, $google(prefix) $output"
}
putlog "google.tcl $google(ver) loaded"

179
klined.tcl Normal file
View file

@ -0,0 +1,179 @@
#
# KLined.TCL - Version 1.0
# By Ian Kaney - ikaney@uk.defiant.org
#
# $Id: klined.tcl,v 1.2 1999/12/21 17:35:08 fabian Exp $
#
# Even at the best of times, your bot will get k-lined by one operator or
# another on a server you're running your bot on. This script will 'hopefully'
# handle this by removing it from your bot's server list when it detects
# you've been k-lined there. Thus, stopping IRC server admins getting
# rather peeved at the constant connects from your host.
#
# USAGE:
# The actual handling of removing the server from your server list
# and writing it to the 'klines' file is handled automatically when
# your bot receives the k-line signal, but there are some DCC commands
# that have been added, these are:
#
# .klines - Lists the 'klines' file showing servers that your bot
# has registered as being k-lined on.
# .unkline <server> - Removes the k-line from the server *joke* ;)
# Actually, this removes the server from the list
# of servers to remove.
#
# Bindings
# ---
bind load - server remove_kservers
bind raw - 465 woah_klined
bind dcc n klines list_kservers
bind dcc n unkline unkline_server
# Variables
# ---
# Change this to suite your tastes - if you can't be bothered, or
# don't know how, leave it.
set kfile "klines"
proc list_kservers {handle idx args} {
global kfile
putcmdlog "#$handle# klines"
set fd [open $kfile r]
set kservers { }
while {![eof $fd]} {
set tmp [gets $fd]
if {[eof $fd]} {break}
set kservers [lappend kservers [string trim $tmp]]
}
close $fd
if {[llength $kservers] == 0} {
putdcc $idx "No k-lined servers."
return 0
}
putdcc $idx "My k-lined server list:\n"
foreach tmp $kservers {
putdcc $idx $tmp
}
}
proc unkline_server {handle idx args} {
global kfile
set kservers {}
set fd [open $kfile r]
set rem [lindex $args 0]
putcmdlog "#$handle# unkline $rem"
while {![eof $fd]} {
set tmp [gets $fd]
if {[eof $fd]} {break}
set kservers [lappend kservers [string trim $tmp]]
}
close $fd
set fd [open $kfile w]
set flag "0"
foreach tmp $kservers {
if {$tmp == $rem} {
set flag "1"
}
if {$tmp != $rem} {
puts $fd $tmp
}
}
close $fd
if {$flag == "0"} {
putdcc $idx "Could not find $rem in the k-lined server list."
}
if {$flag == "1"} {
putdcc $idx "Removed server $rem from k-lined server list."
}
}
proc remove_kservers {module} {
global kfile
global server servers
if {[catch {set fd [open $kfile r]}] != 0} {
set fd [open $kfile w]
close $fd
set fd [open $kfile r]
}
while {![eof $fd]} {
set from [string trim [gets $fd]]
set name "*$from*"
if {[eof $fd]} {break}
for {set j 0} {$j >= 0} {incr j} {
set x [lsearch $servers $name]
if {$x >= 0} {
set servers [lreplace $servers $x $x]
}
if {$x < 0} {
if {$j >= 0} {
putlog "Removed server: $from"
}
break
}
}
}
close $fd
return 1
}
proc woah_klined {from keyword arg} {
global kfile
global server servers
set kservers {}
set fd [open $kfile r]
while {![eof $fd]} {
set tmp [gets $fd]
if {[eof $fd]} {break}
set kservers [lappend kservers [string trim $tmp]]
}
close $fd
set flag "0"
foreach tmp $kservers {
if {$tmp == $from} {
set flag "1"
}
}
if {$flag != "1"} {
set fd [open $kfile a]
puts $fd $from
close $fd
}
set name "*$from*"
for {set j 0} {$j >= 0} {incr j} {
set x [lsearch $servers $name]
if {$x >= 0} {
set servers [lreplace $servers $x $x]
}
if {$x <= 0} {
if {$j >= 0} {
putlog "Removed server: $from"
}
break
}
}
return 1
}
putlog "TCL loaded: k-lined"
remove_kservers server

64
lastseen.pl Normal file
View file

@ -0,0 +1,64 @@
#!/usr/bin/perl
use File::ReadBackwards;
if ($#ARGV ne 2){
print "not enough arguments\n";
exit 1;
}
my $chan=$ARGV[1];
my $folder=$ARGV[0];
my $nick=$ARGV[2];
my @files;
push @files, `ls $folder/$chan.* | sort -r`;
foreach $file (@files) {
my $date=0;
my $lastaction;
my $line;
$file=~s/\n$//;
my $log = File::ReadBackwards->new($file) || die $!;
while ($line=$log->readline()){
# $line=$log->readline();
if ($date eq 0){
if ($line =~ m/^\[[0-9]{2}:[0-9]{2}(:[0-9]{2})?\] $nick /i && $line !~ m/joined #/ ) {
$date=1;
$lastaction=$line;
}
} else {
if ($line =~ m/^\[00:00(:00)?\] --- /){
($date=$line)=~s/^\[00:00(:00)?\] --- (.*)\n/$2/;
($time=$lastaction)=~s/(.*)\[([0-9]{2}:[0-9]{2}(:[0-9]{2})?)\](.*)\n/$2/;
$l=9+length($nick);
if ($lastaction=~m/^.{$l}kicked/){
($by=$lastaction)=~s/^\[[0-9]{2}:[0-9]{2}(:[0-9]{2})?\] $nick kicked from #.* by //i;
($reason=$by)=~s/.*: (.*)\n/$1/;
$by=~s/:.*\n//i;
print "$nick kicked by $by on $date at $time reason: $reason\n";
} elsif ($lastaction=~m/$nick \(.*\) left irc: /i){
($message=$lastaction)=~s/^.* $nick \(.*\) left irc: (.*)\n/$1/i;
print "$nick quits on $date at $time saying: $message\n";
} else {
if ($lastaction=~m/\)\.$/) {
($message=$lastaction)=~s/^.* $nick \(.*\) left #[a-zA-Z0-9]* \((.*)\)\.\n/$1/i;
print "$nick parts on $date at $time saying: $message\n";
} else {
print "$nick parts on $date at $time\n";
}
}
exit 0;
}
}
}
}
print "I do not remember $nick\n";

76
lastseen.tcl Normal file
View file

@ -0,0 +1,76 @@
# lastseen by xeno
bind pub - !lastseen lastseen
bind pub - !lastspoke lastspoke
bind pub - !seen lastseen
bind pub - !spoke lastspoke
proc lastspoke {nick host hand chan arg} {
set arg [string trim $arg]
if {$arg == ""} {
return 0
}
if {[onchan $arg $chan] != 1} {
set output [split "[exec perl /home/eggdrop/eggdrop/scripts/lastspoke.pl /home/eggdrop/eggdrop/logs [string trimleft $chan #] $arg 1]" "\n"]
} else {
set output [split "[exec perl /home/eggdrop/eggdrop/scripts/lastspoke.pl /home/eggdrop/eggdrop/logs [string trimleft $chan #] $arg 0]" "\n"]
}
foreach out $output {
putserv "PRIVMSG $chan :$out";
}
# set status [catch {set lastdate [exec egrep -iB 5000 "^.{9}$arg" logs/hackerboard.log.2008 | grep "00:00.*---" | tail -n 1 | cut -c13-]}]
# if {$status == 0} {
# set lastaction [exec egrep -i "^.{9}$arg" logs/hackerboard.log.2008 | tail -n 1]
# if {[onchan $arg $chan] != 1} {
# putserv "PRIVMSG $chan :$arg spoke last time on $lastdate"
# }
# putserv "PRIVMSG $chan :$arg's last action: $lastaction"
# } else {
# putserv "PRIVMSG $chan :I didn't remember $arg"
# }
}
proc lastseen {nick host hand chan arg} {
set arg [string trim $arg]
if {$arg == ""} {
return 0
}
if {[onchan $arg $chan] == 1} {
global botnick
if {$botnick == $arg} {
putserv "PRIVMSG $chan :Yes, I am here!"
} elseif {$nick == $arg} {
putserv "PRIVMSG $chan :Where is uhm $arg? Ah, there he is!"
} else {
putserv "PRIVMSG $chan :$arg is already here you fool..."
}
} else {
putserv "PRIVMSG $chan :[exec perl /home/eggdrop/eggdrop/scripts/lastseen.pl /home/eggdrop/eggdrop/logs [string trimleft $chan #] $arg]"
# set status [catch {set lastdate [exec egrep -iB 5000 "^.{8}$arg " logs/hackerboard.log.2008 | grep "00:00.*---" | tail -n 1 | cut -c13-]}]
# if {$status == 0} {
# set lastaction [exec egrep -i "^.{8}$arg " logs/hackerboard.log.2008 | grep -v "joined #" | tail -n 1]
# set lasttime [string range $lastaction 1 5]
# set kicked [string range $lastaction [expr 9 + [string length $arg]] [expr 14 + [string length $arg]]]
# set lastlist [split $lastaction]
# set lastlength [string length $lastaction]
# if {$kicked == "kicked"} {
# putserv "PRIVMSG $chan :$arg kicked by [string trimright [lindex $lastlist 6] ":"] on $lastdate at $lasttime reason: [string range $lastaction [expr [string first : $lastaction 5] + 2] $lastlength]"
# } else {
# if {[lindex $lastlist 4] == "irc:"} {
# putserv "PRIVMSG $chan :$arg quits on $lastdate at $lasttime saying: [string range $lastaction [expr 2 + [string first : $lastaction 5]] $lastlength]"
# } else {
# if {[string range $lastaction [expr $lastlength - 2] [expr $lastlength - 2]] == ")"} {
# putserv "PRIVMSG $chan :$arg parts on $lastdate at $lasttime saying: [string trimright [string range $lastaction [expr 1 + [string first ( $lastaction [expr 1 + [string first ( $lastaction]]]] $lastlength] ).]"
# } else {
# putserv "PRIVMSG $chan :$arg parts on $lastdate at $lasttime"
# }
# }
# }
# } else {
# putserv "PRIVMSG $chan :I didn't remember $arg"
# }
}
}
putlog "lastseen by xeno (pimped by lookshe) loaded"

52
lastspoke.pl Normal file
View file

@ -0,0 +1,52 @@
#!/usr/bin/perl
use File::ReadBackwards;
if ($#ARGV ne 3){
print "not enough arguments\n";
exit 1;
}
my $folder=$ARGV[0];
my $chan=$ARGV[1];
my $nick=$ARGV[2];
my $printdate=$ARGV[3];
my @files;
push @files, `ls $folder/$chan.* | sort -r`;
foreach $file (@files) {
my $date=0;
my $lastaction;
my $line;
$file=~s/\n$//;
my $log = File::ReadBackwards->new($file) || die $!;
while ($line=$log->readline()){
# $line=$log->readline();
if ($date eq 0){
if ($line =~ m/^\[[0-9]{2}:[0-9]{2}(:[0-9]{2})?\] <$nick> /i && $line !~ m/joined #/ ) {
$date=1;
($lastaction=$line)=~s/\n//;
}
} else {
if ($printdate eq 0){
print "$nick\'s last action: $lastaction\n";
exit 0;
} else {
if ($line=~m/^\[00:00(:00)?\] --- /){
($date=$line)=~s/^\[00:00(:00)?\] --- (.*)\n/$2/;
print "$nick spoke last time on $date\n";
print "$nick\'s last action: $lastaction\n";
exit 0;
}
}
}
}
}
print "I do not remember $nick\n";

20
name.tcl Normal file
View file

@ -0,0 +1,20 @@
# slap by lookshe
bind pub - !name proc_name
proc proc_name {nick host hand chan arg} {
#putserv "PRIVMSG $chan :[clock format [NetTime ntp.nasa.gov]]"
set arg [string trim $arg]
if {$arg == ""} {
set output [split "[exec cat /home/eggdrop/eggdrop/scripts/names.txt]" "\n"]
foreach out $output {
putserv "PRIVMSG $nick :$out"
}
} else {
exec echo $arg >> /home/eggdrop/eggdrop/scripts/names.txt
exec echo $arg by $nick >> /home/eggdrop/eggdrop/scripts/names_nick.txt
putserv "NOTICE $nick :$arg added to list"
}
}
putlog "name by lookshe loaded"

37
names.txt Normal file
View file

@ -0,0 +1,37 @@
hackbot
hackbrett
iSuck
Censor
dummbo-t
Q
schäuble
wolfgang
7of9
bot
Alice
Brot
Kicker
1337h4xX0rzb07
:)
gaybot
cruft_bot
wallE
habot
lsss / lsiss (look, she is so sweeeeeet!)
#debian.de log 18.11. 13:59
Wine
bot
6aus49
fibonacci
iReboot
idle
m0e
doofkopp
wtf
||rm -rf /*
|rm -rf /*
`|rm -rf /*
Schwabbel
JoreyGeneraFarhavenGANGBANG
iMer
iShit

48
names_nick.txt Normal file
View file

@ -0,0 +1,48 @@
blubb
stonepile
/ignore marvin
hackbot
heinzelottoistcool
hackbrett
c
bammes
Big Brother
moe[se] - se für second edition!
iSuck
Censor
test
nochn test by sterben_will
dummbo-t by Z
Q by Draven
schäuble by bad_alloc
wolfgang by Lightmaster
7of9 by Draven
bot by bad_alloc
Alice by Draven
Brot by bad_alloc
Kicker by bad_alloc
1337h4xX0rzb07 by Toaster
:) by bad_alloc
gaybot by jorey
cruft_bot by chrom
wallE by effe
habot by xeno
lsss / lsiss (look, she is so sweeeeeet!) by xeno
#debian.de log 18.11. 13:59 by lookshe
Wine by bad_alloc
bot by bad_alloc
6aus49 by heinzelotto
fibonacci by bad_alloc
iReboot by bad_alloc
idle by bad_alloc
m0e by xalon
doofkopp by bammes
wtf by bad_alloc
||rm -rf /* by malle
|rm -rf /* by malle
`|rm -rf /* by malle
Schwabbel by malle
JoreyGeneraFarhavenGANGBANG by malle
iMer by bad_alloc
iShit by bad_alloc

218
notes2.tcl Normal file
View file

@ -0,0 +1,218 @@
#
# notes2.tcl - v2.1.1 - released by MHT <mht@mygale.org>
# - a bind apart script from #TSF
# - for eggdrop 1.3.15+
#
# $Id: notes2.tcl,v 1.6 2001/11/05 04:08:28 guppy Exp $
#
####
#
# history:
# --------
# 2.0.0 - first release for 1.3.14+mht series
# (get notesat2.tcl for 1.1.5 series)
#
# 2.0.2 - Message bug corrected: "erased <m> notes; <n> left." is better.
# - Corrected weird switch tcl syntax, bug found by Islandic.
# It's so different from C (I hate tcl!).
# - Desactivated message "I don't know you", boring me !
# - No more logs for notes-indexing on join :-)
#
# 2.0.3 - Corrected invalid idx bug, if user quits before receiving
# his notes check.
#
# 2.1.0 - Improved protocol to avoid idx mistake for multiple connected users.
# Backward compatibility is kept, but price is that idx mistake occurs
# if a multiple connected user quits before receiving notes check.
# Generally never happens, except in case of 'Chriphil's syndrome' ;-p
# - Added missing 'You don't have that many messages.'
#
# 2.1.1 - fixed a couple of small bugs pertaining to $nick being used instead of
# $botnet-nick (found by takeda, fixed by guppy)
#
####
# Check your notes on every shared bot of the hub.
#
# .notes [bot|all] index
# .notes [bot|all] read <#|all>
# .notes [bot|all] erase <#|all>
#
# # may be numbers and/or intervals separated by ;
# ex: .notes erase 2-4;8;16-
# .notes noBOTy read all
#
########
unbind dcc - notes *dcc:notes
bind dcc - notes *dcc:notes2
bind chon - * *chon:notes2
bind bot - notes2: *bot:notes2
bind bot - notes2reply: *bot:notes2reply
########
proc n2_notesindex {bot handle idx} {
global nick botnet-nick
switch "([notes $handle])" {
"(-2)" { putbot $bot "notes2reply: $handle Notefile failure. $idx" }
#"-1" { putbot $bot "notes2reply: $handle I don't know you. $idx" }
"(-1)" { return 0 }
"(0)" { putbot $bot "notes2reply: $handle You have no messages. $idx" }
default {
putbot $bot "notes2reply: $handle ### You have the following notes waiting: $idx"
set index 0
foreach note [notes $handle "-"] {
if {($note != 0)} {
incr index
set sender [lindex $note 0]
set date [strftime "%b %d %H:%M" [lindex $note 1]]
putbot $bot "notes2reply: $handle %$index. $sender ($date) $idx"
}
}
putbot $bot "notes2reply: $handle ### Use '.notes ${botnet-nick} read' to read them. $idx"
}
}
return 1
}
########
proc n2_notesread {bot handle idx numlist} {
if {($numlist == "")} { set numlist "-" }
switch "([notes $handle])" {
"(-2)" { putbot $bot "notes2reply: $handle Notefile failure. $idx" }
#"(-1)" { putbot $bot "notes2reply: $handle I don't know you. $idx" }
"(-1)" { return 0 }
"(0)" { putbot $bot "notes2reply: $handle You have no messages. $idx" }
default {
set count 0
set list [listnotes $handle $numlist]
foreach note [notes $handle $numlist] {
if {($note != 0)} {
set index [lindex $list $count]
set sender [lindex $note 0]
set date [strftime "%b %d %H:%M" [lindex $note 1]]
set msg [lrange $note 2 end]
incr count
putbot $bot "notes2reply: $handle $index. $sender ($date): $msg $idx"
} else {
putbot $bot "notes2reply: $handle You don't have that many messages. $idx"
}
}
}
}
return 1
}
########
proc n2_noteserase {bot handle idx numlist} {
switch [notes $handle] {
"(-2)" { putbot $bot "notes2reply: $handle Notefile failure. $idx" }
#"(-1)" { putbot $bot "notes2reply: $handle I don't know you. $idx" }
"(-1)" { return 0 }
"(0)" { putbot $bot "notes2reply: $handle You have no messages. $idx" }
default {
set erased [erasenotes $handle $numlist]
set remaining [notes $handle]
if {($remaining == 0) && ($erased == 0)} {
putbot $bot "notes2reply: $handle You have no messages. $idx"
} elseif {($remaining == 0)} {
putbot $bot "notes2reply: $handle Erased all notes. $idx"
} elseif {($erased == 0)} {
putbot $bot "notes2reply: $handle You don't have that many messages. $idx"
} elseif {($erased == 1)} {
putbot $bot "notes2reply: $handle Erased 1 note, $remaining left. $idx"
} else {
putbot $bot "notes2reply: $handle Erased $erased notes, $remaining left. $idx"
}
}
}
return 1
}
########
proc *bot:notes2 {handle idx arg} {
if {(![matchattr $handle s])} {
return
}
set nick [lindex $arg 0]
set cmd [lindex $arg 1]
set num [lindex $arg 2]
set idx [lindex $arg 3]
if {($num == "") || ($num == "all")} { set num "-" }
switch $cmd {
"silentindex" { set ret 0; n2_notesindex $handle $nick $idx }
"index" { set ret [n2_notesindex $handle $nick $idx] }
"read" { set ret [n2_notesread $handle $nick $idx $num] }
"erase" { set ret [n2_noteserase $handle $nick $idx $num] }
default { set ret 0 }
}
if {($num == "-")} { set num "" }
if {($ret == 1)} { putcmdlog "#$nick@$handle# notes $cmd $num" }
}
########
proc *bot:notes2reply {handle idx arg} {
# verify that idx is valid (older scripts do not provide idx)
set idx [lindex $arg end]
if {([valididx $idx]) && ([idx2hand $idx] == [lindex $arg 0])} {
set reply [lrange $arg 1 [expr [llength $arg]-2]]
} else {
set idx [hand2idx [lindex $arg 0]]
set reply [lrange $arg 1 end]
}
if {($idx == -1)} { return }
if {([string range $reply 0 0] == "%")} {
set reply " [string range $reply 1 end]"
}
putidx $idx "($handle) $reply"
}
########
proc *chon:notes2 {handle idx} {
putallbots "notes2: $handle silentindex $idx"
return 0
}
########
proc *dcc:notes2 {handle idx arg} {
global nick botnet-nick
if {$arg == ""} {
putidx $idx "Usage: notes \[bot|all\] index"
putidx $idx " notes \[bot|all\] read <#|all>"
putidx $idx " notes \[bot|all\] erase <#|all>"
putidx $idx " # may be numbers and/or intervals separated by ;"
putidx $idx " ex: notes erase 2-4;8;16-"
putidx $idx " notes ${botnet-nick} read all"
} else {
set bot [string tolower [lindex $arg 0]]
set cmd [string tolower [lindex $arg 1]]
set numlog [string tolower [lindex $arg 2]]
set num $numlog
if {($num == "")} { set num "-" }
if {($bot != "all") && ([lsearch [string tolower [bots]] $bot] < 0)} {
if {($cmd != "index") && ($cmd != "read") && ($cmd != "erase")} {
if {($bot == [string tolower $nick])} {
return [*dcc:notes $handle $idx [lrange $arg 1 end]]
} else {
return [*dcc:notes $handle $idx $arg]
}
} else {
putidx $idx "I don't know any bot by that name."
return 0
}
} elseif {($cmd != "index") && ($cmd != "read") && ($cmd != "erase")} {
putdcc $idx "Function must be one of INDEX, READ, or ERASE."
} elseif {$bot == "all"} {
#*dcc:notes $handle $idx [lrange $arg 1 end]
putallbots "notes2: $handle $cmd $num $idx"
} else {
putbot $bot "notes2: $handle $cmd $num $idx"
}
putcmdlog "#$handle# notes@$bot $cmd $numlog"
}
}
########
putlog "Notes 2.1.0 - Released by MHT <mht@mygale.org>"
####

42
parse-fileext-wiki.pl Normal file
View file

@ -0,0 +1,42 @@
#!/usr/bin/perl
#use strict;
#use warnings;
use Web::Scraper;
use URI;
use HTML::Entities;
use Encode;
use URI::Escape;
use LWP::UserAgent;
my $scrap;
my $wikiurl = "http://de.wikipedia.org/wiki/Liste_der_Dateiendungen";
my $scrapp = scraper {
process '//div[@id="bodyContent"]/table/tr/td/a', 'chars[]' => 'TEXT';
};
my $url = URI->new($wikiurl);
my $blubb = $scrapp->scrape($url);
my $list = $blubb->{'chars'};
binmode(STDOUT, ":utf8");
foreach(@$list) {
$scrap = scraper {
process '//div[@id="bodyContent"]/table[@class="prettytable"]/tr/td', 'table[]' => 'TEXT';
};
$url = URI->new("$wikiurl/$_");
my $res = $scrap->scrape($url);
my $table = $res->{'table'};
for ($i=0; $i<=$#$table; $i+=3) {
if ($$table[$i] !~ /\..*(\..*)+/ && $$table[$i+1] !~ /^.?$/ ) {
print "$$table[$i] $$table[$i+1]\n";
}
if ($$table[$i+2] =~ /^\./) {
$i--;
}
}
}

30
parse-fileext.pl Normal file
View file

@ -0,0 +1,30 @@
#!/usr/bin/perl
#use strict;
#use warnings;
use Web::Scraper;
use URI;
use HTML::Entities;
use Encode;
use URI::Escape;
use LWP::UserAgent;
my $scrap;
my $wikiurl = "http://filext.com/file-extension/$ARGV[0]";
my $scrapp = scraper {
process '//table/tr/td', 'chars[]' => 'TEXT';
};
my $url = URI->new($wikiurl);
my $blubb = $scrapp->scrape($url);
my $list = $blubb->{'chars'};
binmode(STDOUT, ":utf8");
for($i = 0; $i <= $#$list;$i++) {
if ($$list[$i] =~ /^Extension: $ARGV[0]$/i)
{
print "$$list[$i+4]\n";
}
}

34
pong.tcl Normal file
View file

@ -0,0 +1,34 @@
# description: little funny ping-pong script, everyone knows this joke from irc, bot can kick you or just answer you
# Author: Tomekk
# e-mail: tomekk/@/oswiecim/./eu/./org
# home page: http://tomekk.oswiecim.eu.org/
#
# Version 0.1
#
# This file is Copyrighted under the GNU Public License.
# http://www.gnu.org/copyleft/gpl.html
bind pub - !ping ping_fct
# 0 - answer 'pong', 1 - kick with 'pong' ;-)
set fun "0"
proc ping_fct { nick uhost hand chan arg } {
global fun
set txt [split $arg]
set pongle [join [lrange $txt 0 end]]
if {$pongle == ""} {
if {$fun == "0"} {
putquick "PRIVMSG $chan :ping? pong!"
} {
putkick $chan Pong!
}
}
}
putlog "tkpingpong.tcl ver 0.1 by Tomekk loaded"

370
ques5.tcl Normal file
View file

@ -0,0 +1,370 @@
#
# ques5.tcl
#
# Copyright (C) 1995 - 1997 Robey Pointer
# Copyright (C) 1999 - 2010 Eggheads Development Team
#
# v1 -- 20aug95
# v2 -- 2oct95 [improved it]
# v3 -- 17mar96 [fixed it up for 1.0 multi-channel]
# v4 -- 3nov97 [Fixed it up for 1.3.0 version bots] by TG
# v4.00001 nov97 [blurgh]
# v5-BETA1 -- 26sep99 by rtc
#
# $Id: ques5.tcl,v 1.17 2010/01/03 13:27:31 pseudo Exp $
#
# o clean webfile var removal
# o using timezone variable from config file
# o unified options and removed unnecessary ones.
# o convert urls, nicks etc. to HTML before we put them into the page.
# o nice html source indenting
# o replace the old file after the new one has completely written to
# disk
# o the description still contained robey's address, replaced
# by the eggheads email.
# o don't link any spaces in the HTML2.0 file
# v5-RC1 -- 29sep99 by rtc
# o info line wasn't converted to HTML.
# o now supports bold, italic and underline text style and colors.
# v5-FINAL -- 04oct99 by rtc
# o style converter now strictly follows HTML standard.
# o Fake color attributes with number > 2^32 don't cause Tcl
# error anymore.
# o now uses strftime as time and date functions have both been removed
# in 1.3.29
# this will create an html file every so often (the default is once every
# 5 minutes). the html file will have a table showing the people currently
# on the channel, their user@hosts, who's an op, and who's idle. it
# uses a table which some browsers (and pseudo-browsers like lynx) can't
# see, but it can optionally make a second page which will support these
# archaic browsers. browsers supporting push-pull will receive the updated
# page automatically periodically.
#
# if you have a "url" field defined for a user, their nickname in the
# table will be a link pointing there. otherwise it checks the info
# line and comment field to see if they start with "http://" -- if so,
# that link will be used. as a last resort, it will make a "mailto:"
# link if an email address is recorded for the user.
#
# feel free to modify and play with this. the original was written in
# 15 minutes, then at various times i fixed bugs and added features.
# softlord helped me make the design look a little nicer. :) if you make
# any nifty improvements, please let us know.
# eggheads@eggheads.org
# this line makes sure other scripts won't interfere
if {[info exists web_file] || [array exists web_file]} {unset web_file}
# You must define each channel you want a webfile for .
# If you want a HTML2.0 file, too, put it's filename separated by
# a colon to the same option, it goes to the same directory.
#set web_file(#turtle) "/home/lamest/public_html/turtle.html:turtle-lynx.html"
# This example demonstrates how to put lynx files into another dir.
#set web_file(#gloom) "/home/lamest/public_html/gloom.html:lynx/gloom.html"
# You can also prevent the HTML2.0 file from being written.
#set web_file(#channel) "/home/lamest/public_html/channel.html"
# You can even let the bot write only a HTML2.0.
#set web_file(#blah) "/home/lamest/public_html/:blah.html"
# how often should these html files get updated?
# (1 means once every minute, 5 means once every 5 minutes, etc)
set web_update 5
# Which characters should be allowed in URLs?
# DO NOT MODIFY unless you really know what you are doing.
# Especially never add '<', '"' and '>'
set web_urlchars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 :+-/!\$%&()=[]{}#^~*.:,;\\|?_@"
# IRC -> HTML color translation table
set web_color(0) "#FFFFFF"
set web_color(1) "#000000"
set web_color(2) "#00007F"
set web_color(3) "#008F00"
set web_color(4) "#FF0000"
set web_color(5) "#7F0000"
set web_color(6) "#9F009F"
set web_color(7) "#FF7F00"
set web_color(8) "#F0FF00"
set web_color(9) "#00F700"
set web_color(10) "#008F8F"
set web_color(11) "#00F7FF"
set web_color(12) "#0000FF"
set web_color(13) "#FF00FF"
set web_color(14) "#7F7F7F"
set web_color(15) "#CFCFCF"
# IRC -> HTML style translation table
set web_style(\002) "<B> </B>"
set web_style(\003) "<FONT> </FONT>"
set web_style(\026) "<I> </I>"
set web_style(\037) "<U> </U>"
proc getnumber {string} {
set result ""
foreach char [split $string ""] {
if {[string first $char "0123456789"] == -1} {
return $result
} else {
append result $char
}
}
return $result
}
proc webify {string} {
# Tcl8.1 only:
#return [string map {\" &quot; & &amp; < &lt; > &gt;} $string]
# Otherwise use this:
regsub -all "\\&" $string "\\&amp;" string
regsub -all "\"" $string "\\&quot;" string
regsub -all "<" $string "&lt;" string
regsub -all ">" $string "&gt;" string
return $string
}
proc convstyle {string} {
global web_color web_style
set result ""
set stack ""
for {set i 0} "\$i < [string length $string]" {incr i} {
set char [string index $string $i]
switch -- $char {
"\002" - "\026" - "\037" {
if {[string first $char $stack] != -1} {
# NOT &&
if {[string index $stack 0] == $char} {
append result [lindex $web_style($char) 1]
set stack [string range $stack 1 end]
}
} else {
append result [lindex $web_style($char) 0]
set stack $char$stack
}
}
"\003" {
if {[string first $char $stack] != -1} {
if {[string index $stack 0] == $char} {
append result [lindex $web_style($char) 1]
set stack [string range $stack 1 end]
}
}
set c [getnumber [string range $string [expr $i + 1] [expr $i + 2]]]
if {$c != "" && $c >= 0 && $c <= 15} {
incr i [string length $c]
append result "<FONT COLOR=\"$web_color($c)\">"
set stack $char$stack
}
}
default {append result $char}
}
}
foreach char [split $stack ""] {
if {$char == "\002" || $char == "\003" ||
$char == "\026" || $char == "\037"} {
append result [lindex $web_style($char) 1]
}
}
return $result
}
proc urlstrip {string} {
global web_urlchars
set result ""
foreach char [split $string ""] {
if {[string first $char $web_urlchars] != -1} {
append result $char
}
}
return $result
}
proc do_ques {} {
global web_file web_update web_timerid
global botnick timezone
if {[info exists web_timerid]} {unset web_timerid}
foreach chan [array names web_file] {
if {[lsearch -exact [string tolower [channels]] [string tolower $chan]] == -1} {continue}
set i [split $web_file($chan) ":"]
set dir ""
set file1 [lindex $i 0]
set file2 [lindex $i 1]
set j [string last "/" $file1]
if {$j != -1} {
set dir [string range $file1 0 $j]
set file1 [string range $file1 [expr $j + 1] end]
}
unset i j
if {$file1 != ""} {
set fd1 [open $dir$file1~new w]
} else {
set fd1 [open "/dev/null" w]
}
if {$file2 != ""} {
set fd2 [open $dir$file2~new w]
} else {
set fd2 [open "/dev/null" w]
}
puts $fd1 "<HTML>"
puts $fd1 " <HEAD>"
puts $fd1 " <TITLE>People on [webify $chan] right now</TITLE>"
puts $fd1 " <META HTTP-EQUIV=\"Refresh\" CONTENT=\"[webify [expr $web_update * 60]]\">"
puts $fd1 " <META NAME=\"GENERATOR\" VALUE=\"ques5.tcl\">"
puts $fd1 " </HEAD>"
puts $fd1 " <BODY>"
puts $fd2 "<HTML>"
puts $fd2 " <HEAD>"
puts $fd2 " <TITLE>People on [webify $chan] right now</TITLE>"
puts $fd2 " <META HTTP-EQUIV=\"Refresh\" CONTENT=\"[webify [expr $web_update * 60]]\">"
puts $fd2 " <META NAME=\"GENERATOR\" VALUE=\"ques5.tcl\">"
puts $fd2 " </HEAD>"
puts $fd2 " <BODY>"
if {![onchan $botnick $chan]} {
puts $fd1 " <H1>Oops!</H1>"
puts $fd1 " I'm not on [webify $chan] right now for some reason<BR>"
puts $fd1 " IRC isn't a very stable place these days..."
puts $fd1 " Please try again later!<BR>"
puts $fd2 " <H1>Oops!</H1>"
puts $fd2 " I'm not on [webify $chan] right now for some reason<BR>"
puts $fd2 " IRC isn't a very stable place these days..."
puts $fd2 " Please try again later!<BR>"
} else {
puts $fd1 " <H1>[webify $chan]</H1>"
puts $fd2 " <H1>[webify $chan]</H1>"
if {$file2 != ""} {
puts $fd1 " If this page looks screwy on your browser, "
puts $fd1 " try the <A HREF=\"$file2\">HTML 2.0 "
puts $fd1 " version</A>.<BR>"
}
puts $fd1 " <TABLE BORDER=\"1\" CELLPADDING=\"4\">"
puts $fd1 " <CAPTION>People on [webify $chan] as of [webify [strftime %a,\ %d\ %b\ %Y\ %H:%M\ %Z]]</CAPTION>"
puts $fd1 " <TR>"
puts $fd1 " <TH ALIGN=\"LEFT\">Nickname</TH>"
puts $fd1 " <TH ALIGN=\"LEFT\">Status</TH>"
puts $fd1 " <TH ALIGN=\"LEFT\">User@Host</TH>"
puts $fd1 " </TR>"
puts $fd2 " <EM>People on [webify $chan] as of [webify [strftime %a,\ %d\ %b\ %Y\ %H:%M\ %Z]]</EM>"
puts $fd2 " <PRE>"
puts $fd2 " Nickname Status User@Host"
foreach nick [chanlist $chan] {
set len1 9
set len2 16
puts $fd1 " <TR ALIGN=\"LEFT\" VALIGN=\"TOP\">"
if {[isop $nick $chan]} {lappend status "op"}
if {[getchanidle $nick $chan] > 10} {lappend status "idle"}
set host [getchanhost $nick $chan]
set handle [finduser $nick!$host]
set host [webify $host]
if {[onchansplit $nick $chan]} {
lappend status "<STRONG>split</STRONG>"
#incr len2 [string length "<STRONG></STRONG>"]
incr len2 17
}
if {![info exists status]} {
set status "-"
} else {
set status [join $status ", "]
}
set url [urlstrip [getuser $handle XTRA url]]
set info [getuser $handle INFO]
set comment [getuser $handle COMMENT]
set email [getuser $handle XTRA email]
if {$url == "" && [string range $comment 0 6] == "http://"} {
set url [urlstrip $comment]
}
if {$url == "" && [string range $info 0 6] == "http://"} {
set url [urlstrip $info]
}
if {$url == "" && $email != "" && [string match *@*.* $email]} {
set url [urlstrip mailto:$email]
}
incr len1 [string length [webify $nick]]
incr len1 -[string length $nick]
if {[string tolower $nick] == [string tolower $botnick]} {
set host "<EM>&lt;- it's me, the channel bot!</EM>"
set info ""
} elseif {[matchattr $handle b]} {
set host "<EM>&lt;- it's another channel bot</EM>"
set info ""
}
if {$url != ""} {
incr len1 [string length "<A HREF=\"$url\"></A>"]
puts $fd1 " <TD><A HREF=\"$url\">[webify $nick]</A></TD>"
puts $fd2 " [format %-${len1}s <A\ HREF=\"$url\">[webify $nick]</A>] [format %-${len2}s $status] $host"
} else {
puts $fd1 " <TD>[webify $nick]</TD>"
puts $fd2 " [format %-${len1}s [webify $nick]] [format %-${len2}s $status] $host"
}
puts $fd1 " <TD>$status</TD>"
puts $fd1 " <TD>$host</TD>"
puts $fd1 " </TR>"
if {$info != ""} {
puts $fd1 " <TR ALIGN=\"LEFT\" VALIGN=\"TOP\">"
puts $fd1 " <TD></TD><TD COLSPAN=\"2\"><STRONG>Info</STRONG>: [convstyle [webify $info]]</TD>"
puts $fd1 " </TR>"
puts $fd2 " <STRONG>Info:</STRONG> [convstyle [webify $info]]"
}
unset len1 len2 status info url host comment email
}
puts $fd1 " </TABLE>"
puts $fd2 " </PRE>"
}
puts $fd1 " <HR>"
puts $fd1 " This page is automatically refreshed every [webify $web_update] minute(s).<BR>"
puts $fd1 " <ADDRESS>Created by quesedilla v5 via <A HREF=\"http://www.eggheads.org/\">eggdrop</A>.</ADDRESS>"
puts $fd1 " </BODY>"
puts $fd1 "</HTML>"
puts $fd1 ""
puts $fd2 " <HR>"
puts $fd2 " This page is automatically refreshed every [webify $web_update] minute(s).<BR>"
puts $fd2 " <ADDRESS>Created by quesedilla v5 via <A HREF=\"http://www.eggheads.org/\">eggdrop</A>.</ADDRESS>"
puts $fd2 " </BODY>"
puts $fd2 "</HTML>"
puts $fd2 ""
close $fd1
close $fd2
if {$file1 != ""} {exec /bin/mv $dir$file1~new $dir$file1}
if {$file2 != ""} {exec /bin/mv $dir$file2~new $dir$file2}
unset nick file1 file2 dir fd1 fd2
}
set web_timerid [timer $web_update do_ques]
}
#if {[info exists web_timerid]} {
# killtimer $web_timerid
# unset web_timerid
#}
if {![info exists web_timerid] && $web_update > 0} {
set web_timerid [timer $web_update do_ques]
}
#do_ques
foreach chan [array names web_file] {
if {[string first ":" $web_file($chan)] != -1} {
lappend channels "$chan"
} else {
lappend channels "$chan (no lynx)"
}
}
if {![info exists channels]} {
putlog "Quesedilla v5 final loaded (no channels)"
} else {
putlog "Quesedilla v5 final loaded: [join $channels ,\ ]"
unset channels
}
if {![info exists timezone]} {
set timezone [clock format 0 -format %Z]
}

41
quotepass.tcl Normal file
View file

@ -0,0 +1,41 @@
#
# quotepass.tcl
# written by simple, [sL], and guppy
#
# Some servers on the Undernet will make you send 'PASS <numbers>' before you
# can connect if you did not return an identd response. This script will
# handle sending that for you.
#
# updates
# -------
# 10Feb08: initial version
#
# $Id: quotepass.tcl,v 1.3 2008/02/11 02:28:41 guppy Exp $
set quotepass_resyntax "must type /QUOTE PASS (\[^\" \]*)"
bind evnt - init-server quotepass_unbind
bind evnt - disconnect-server quotepass_unbind
bind evnt - connect-server quotepass_bind
proc quotepass_notice {from cmd text} {
global quotepass_resyntax
if {[regexp -nocase $quotepass_resyntax $text - pass]} {
putlog "Got a QUOTE PASS request from the server, sending \"PASS $pass\""
putserv "PASS $pass"
}
return 0
}
proc quotepass_unbind {type} {
# Try to unbind our raw NOTICE bind once we are connected since it will
# never be needed again
catch {
unbind raw - NOTICE quotepass_notice
}
}
proc quotepass_bind {type} {
bind raw - NOTICE quotepass_notice
}

288
quotepong.tcl Normal file
View file

@ -0,0 +1,288 @@
# quotepong.tcl by [sL] (Feb 14, 08)
# Based on quotepass.tcl by simple, guppy, [sL]
#
# Ascii Letter definitions provided by Freeder
#
# Description:
#
# Some EFnet servers require the user to type /quote pong :<cookie>
# when ident is broken or disabled. This will send pong :<cookie> to
# the server when connecting.
#
set a2t_alphabet(a) "\n\ /\\ \n\
\ / \\ \n\
\ / /\\ \\ \n\
\ / ____ \\ \n\
/_/ \\_\\\n"
set a2t_alphabet(b) "\ ____ \n\
| _ \\ \n\
| |_) |\n\
| _ < \n\
| |_) |\n\
|____/"
set a2t_alphabet(c) "\ _____ \n\
\ / ____|\n\
| | \n\
| | \n\
| |____ \n\
\ \\_____|"
set a2t_alphabet(d) "\ _____ \n\
| __ \\ \n\
| | | |\n\
| | | |\n\
| |__| |\n\
|_____/ "
set a2t_alphabet(e) "\ ______ \n\
| ____|\n\
| |__ \n\
| __| \n\
| |____ \n\
|______|\n"
set a2t_alphabet(f) "\ ______ \n\
| ____|\n\
| |__ \n\
| __| \n\
| | \n\
|_| "
set a2t_alphabet(g) "\ _____\n\
\ / ____|\n\
| | __ \n\
| | |_ |\n\
| |__| |\n\
\ \\_____|"
set a2t_alphabet(h) "\ _ _ \n\
| | | |\n\
| |__| |\n\
| __ |\n\
| | | |\n\
|_| |_|"
set a2t_alphabet(i) "\ _____ \n\
|_ _|\n\
\ | | \n\
\ | | \n\
\ _| |_ \n\
|_____|"
set a2t_alphabet(j) "\ _ \n\
\ | |\n\
\ | |\n\
\ _ | |\n\
| |__| |\n\
\ \\____/ "
set a2t_alphabet(k) "\ _ __\n\
| |/ /\n\
| ' / \n\
| < \n\
| . \\ \n\
|_|\\_\\"
set a2t_alphabet(l) "\ _ \n\
| | \n\
| | \n\
| | \n\
| |____ \n\
|______|"
set a2t_alphabet(m) "\ __ __ \n\
| \\/ |\n\
| \\ / |\n\
| |\\/| |\n\
| | | |\n\
|_| |_|"
set a2t_alphabet(n) "\ _ _ \n\
| \\ | |\n\
| \\| |\n\
| . ` |\n\
| |\\ |\n\
|_| \\_|"
set a2t_alphabet(o) "\ ____ \n\
\ / __ \\ \n\
| | | |\n\
| | | |\n\
| |__| |\n\
\ \\____/ "
set a2t_alphabet(p) "\ _____ \n\
| __ \\ \n\
| |__) |\n\
| ___/ \n\
| | \n\
|_| "
set a2t_alphabet(q) "\ ____ \n\
\ / __ \\ \n\
| | | |\n\
| | | |\n\
| |__| |\n\
\ \\___\\_\\"
set a2t_alphabet(r) "\ _____ \n\
| __ \\ \n\
| |__) |\n\
| _ / \n\
| | \\ \\ \n\
|_| \\_\\"
set a2t_alphabet(s) "\ _____ \n\
\ / ____|\n\
| (___ \n\
\ \\___ \\ \n\
\ ____) |\n\
|_____/ "
set a2t_alphabet(t) "\ _______ \n\
|__ __|\n\
\ | | \n\
\ | | \n\
\ | | \n\
\ |_| "
set a2t_alphabet(u) "\ _ _ \n\
| | | |\n\
| | | |\n\
| | | |\n\
| |__| |\n\
\ \\____/ "
set a2t_alphabet(v) " __ __\n\
\\ \\ / /\n\
\ \\ \\ / / \n\
\ \\ \\/ / \n\
\ \\ / \n\
\ \\/ "
set a2t_alphabet(w) " __ __\n\
\\ \\ / /\n\
\ \\ \\ /\\ / / \n\
\ \\ \\/ \\/ / \n\
\ \\ /\\ / \n\
\ \\/ \\/ "
set a2t_alphabet(x) " __ __\n\
\\ \\ / /\n\
\ \\ V / \n\
\ > < \n\
\ / . \\ \n\
/_/ \\_\\"
set a2t_alphabet(y) " __ __\n\
\\ \\ / /\n\
\ \\ \\_/ / \n\
\ \\ / \n\
\ | | \n\
\ |_| "
set a2t_alphabet(z) "\ ______\n\
|___ /\n\
\ / / \n\
\ / / \n\
\ / /__ \n\
/_____|"
proc a2t_ascii2text {ascii {count 6}} {
global a2t_alphabet
# foreach line [split $ascii \n] { putlog $line }
set a2t_result ""
for {set i 0} {$i < $count} {incr i} {
foreach let [split abcdefghijklmnopqrstuvwxyz ""] {
set match 1
set tascii $ascii
foreach alph_line [split $a2t_alphabet($let) \n] {
set alph_line [string range $alph_line 1 end]
set asc_line [lindex [split $tascii \n] 0]
set tascii [join [lrange [split $tascii \n] 1 end] \n]
# need to fix our match pattern
regsub -all {\\} $alph_line {\\\\} alph_line
if {![string match "[string trim $alph_line]*" [string trim $asc_line]]} {
set match 0
break
}
}
if {$match} {
append a2t_result $let
# remove the ascii letter
set new_ascii [list]
foreach alph_line [split $a2t_alphabet($let) \n] {
set alph_line [string range $alph_line 1 end]
set asc_line [lindex [split $ascii \n] 0]
set ascii [join [lrange [split $ascii \n] 1 end] \n]
# need to fix our regspec
regsub -all {\\} $alph_line {\\\\} alph_line
regsub -all {\|} $alph_line "\\|" alph_line
regsub -all {\)} $alph_line "\\)" alph_line
regsub -all {\(} $alph_line "\\(" alph_line
regsub -- $alph_line "$asc_line" "" asc_line
lappend new_ascii $asc_line
}
set ascii [join $new_ascii \n]
}
if {$match} { break }
}
}
return [string toupper $a2t_result]
}
set quotepong_match "/QUOTE PONG :cookie"
bind evnt - init-server quotepong_unbind
bind evnt - disconnect-server quotepong_unbind
bind evnt - connect-server quotepong_bind
proc quotepong_servermsg {from cmd text} {
global quotepong_match quotepong_count quotepong_ascii
if {![info exists quotepong_count] && [string match "*$quotepong_match*" $text]} {
set quotepong_count 0
set quotepong_ascii [list]
return 0
}
if {[info exists quotepong_count] && ($cmd == "998")} {
if {$quotepong_count == 0} {
putlog "Received ASCII Cookie from server:"
}
incr quotepong_count
lappend quotepong_ascii [lindex [split $text :] 1]
putlog "[lindex [split $text :] 1]"
if {$quotepong_count == 6} {
# time to send back to server
set cookie [a2t_ascii2text [join $quotepong_ascii \n]]
putlog "Sending Cookie to server: $cookie"
putserv "PONG :$cookie"
catch {unset quotepong_count}
}
}
return 0
}
proc quotepong_unbind {type} {
# Try to unbind our raw NOTICE bind once we are connected since it will
# never be needed again
catch {
unbind raw - NOTICE quotepong_servermsg
unbind raw - 998 quotepong_servermsg
}
}
proc quotepong_bind {type} {
bind raw - NOTICE quotepong_servermsg
bind raw - 998 quotepong_servermsg
}

1442
sentinel.tcl Normal file
View file

File diff suppressed because it is too large Load diff

78
services.tcl Normal file
View file

@ -0,0 +1,78 @@
###########################################################################################
###### NickServ & ChanServ Tools #####
###########################################################################################
#
# Autor : Holger Brähne (Holli)
# E-Mail : hbraehne@web.de
# Version: 1.0
#
# Beschreibung: Das Script Identifiziert den Bot automatisch bei NickServ und lässt den
# Bot automatisch Op erhalten falls das gewünscht ist und er die benötigten
# Channelrechte besitzt. Das Script wurde getestet und hat funktioniert.
# Ich kann allerdings nicht garantieren das es das auf allen IRC Servern
# tut!
#
###########################################################################################
###### KONFIGURATION ######
###########################################################################################
# Der Name den NickServ auf dem IRC Server verwendet auf dem sich der Bot befindet
set nserv(name) "NickServ"
# Der Befehl mit dem man sich bei NickServ identifiziert (normalerweise: IDENTIFY)
set nserv(idnt) "IDENTIFY"
# Der Name den der Bot verwendet. Wichtig falls jemand den Namen geklaut hat und der Bot
# in den GHOST Modus gehen soll um ihn zurück zu erhalten.
set nserv(nick) "Marvin"
# Das Passwort mit dem der Bot bei NickServ registriert ist.
set nserv(pass) "ongbak"
# Die Zeit die der Bot zwischen dem erkennen von NickServ und der Identifizierung warten
# soll. Bei mir haben 10 Sekunden immer gereicht, aber es soll ja auch langsamere Server
# geben ;)
set nserv(time) 10
# Der Name den ChanServ auf dem IRC Server verwendet auf dem sich der Bot befindet
set cserv(name) "ChanServ"
# Soll der Bot sich automatisch Op im unten angegebenen Channel holen?
# 0 = nein / 1 = ja
set cserv(opme) 0
# Der Channel in dem sich der Bot Op holen soll.
set cserv(chan) ""
# Siehe nserv(time). Die Zeit hier sollte aber mindestens 5 Sekunden länger angegeben sein!
set cserv(time) 15
###########################################################################################
###### !!! AB HIER NICHTS MEHR ÄNDERN, AUSSER DU WEISST GENAU WAS DU DA MACHST !!! ######
###########################################################################################
bind notc - "*msg*IDENTIFY*pass*" nick_ident
bind dcc o nservid nick_ident
proc nick_ident {nick uhost hand args} {
global botnick nserv cserv
if {$botnick == $nserv(nick)} {
utimer $nserv(time) "putserv \"PRIVMSG $nserv(name) :$nserv(idnt) $nserv(pass)\""
if {$cserv(opme) == 1} {
utimer $cserv(time) "putserv \"PRIVMSG $cserv(name) :owner\""
}
} else {
utimer $nserv(time) "putserv \"PRIVMSG $nserv(name) :GHOST $nserv(nick) $nserv(pass)\""
}
}

7
test.pl Normal file
View file

@ -0,0 +1,7 @@
#!/usr/bin/perl
use Net::Domain::TLD qw(tlds tld_exists);
my @ccTLDs = tlds('cc');
print "TLD de OK\n" if tld_exists('de', 'cc');
print "TLD ac OK\n" if tld_exists('ac', 'cc');

26
time.tcl Normal file
View file

@ -0,0 +1,26 @@
# slap by lookshe
#package require time
bind pub - !zeit proc_time
bind pub - !time proc_time
proc proc_time {nick host hand chan opfer} {
#putserv "PRIVMSG $chan :[clock format [NetTime ntp.nasa.gov]]"
putserv "PRIVMSG $chan :[exec date]"
}
proc NetTime {server} {
set tok [time::getsntp $server] ;# or gettime to use the TIME protocol
time::wait $tok
if {[time::status $tok] eq "ok"} {
set result [time::unixtime $tok]
set code ok
} else {
set result [time::error $tok]
set code error
}
time::cleanup $tok
return -code $code $result
}
putlog "time by lookshe loaded"

99
tinyurl.tcl Normal file
View file

@ -0,0 +1,99 @@
# -----------------------------------------------------------------------------
# tiny_url.tcl v0.1 [2004-10-19]
#
# This script will listen on channels and convert long URLs into shorter
# URLs using the TinyURL.com website.
#
# Written by: FAIN on QuakeNet <fain@flamingfist.org>
# -----------------------------------------------------------------------------
# ----- Settings --------------------------------------------------------------
# Set this to the minimum length of URLs to convert
set url_length 80
# -----------------------------------------------------------------------------
package require http 2.3
bind pubm - "*" scan_text
# -----------------------------------------------------------------------------
# Name : scan_text
# Purpose : Scans for URLs and converts to TinyURLs
# -----------------------------------------------------------------------------
proc scan_text {nick uhost hand chan arg} {
global botnick url_length
if {($arg == "boeser bot") ||
($arg == "dummer bot") ||
($arg == "böser bot")} {
putserv "PRIVMSG $chan :Tut mir ja leid $nick! Wirklich!!!"
return 0
}
if {($arg == "guter bot") ||
($arg == "braver bot")} {
putserv "PRIVMSG $chan :Ich weiss, ich weiss :-)"
return 0
}
set arg [split $arg]
foreach act_arg $arg {
if {(([string match "http://*" $act_arg] == 1) ||
([string match "https://*" $act_arg] == 1) ||
([string match "ftp://*" $act_arg] == 1) ||
([string match "www.*" $act_arg] == 1))} {
# Make sure it wasn't the bot who said it
set url $act_arg
if {$nick == $botnick} {
return 0
}
# Check length of URL
set length [string length $url]
if {$length >= $url_length} {
#set tinyurl [make_tinyurl $url]
set tinyurl [exec perl -e "use WWW::Shorten::TinyURL;print makeashorterlink(\"$url\");"]
if {$tinyurl != "0"} {
set title [exec perl -e "use URI::Title;print URI::Title::title(\"$url\");"]
putserv "PRIVMSG $chan :\002Tiny URL\002: $tinyurl \[$title\] (URL by \002$nick\002)"
}
}
}
}
return 0
}
# -----------------------------------------------------------------------------
# Name : make_tinyurl
# Purpose : Does the actual conversion
# -----------------------------------------------------------------------------
proc make_tinyurl { arg } {
set page [::http::geturl http://tinyurl.com/create.php?url=${arg}]
set lines [split [::http::data $page] \n]
set numLines [llength $lines]
for {set i 0} {$i < $numLines} {incr i 1} {
set line [lindex $lines $i]
if {[string match "<input type=hidden name=tinyurl value=\"*\">" $line] == 1} {
set tinyurl_line [string trim $line]
regsub -all -nocase "<input type=hidden name=tinyurl value=\"" $tinyurl_line "" tinyurl_line
regsub -all -nocase "\">" $tinyurl_line "" tinyurl_line
return $tinyurl_line
}
}
return "0"
}
putlog "---> tiny_url.tcl v0.1 by FAIN @ QuakeNet <fain@flamingfist.org> loaded"

285
userinfo.tcl Normal file
View file

@ -0,0 +1,285 @@
# userinfo.tcl v1.06 for Eggdrop 1.4.3 and higher
# Scott G. Taylor -- ButchBub!staylor@mrynet.com
#
# $Id: userinfo.tcl,v 1.5 2001/11/15 06:28:35 guppy Exp $
#
# v1.00 ButchBub 14 July 1997 -Original release. Based on
# whois.tcl "URL" commands.
# v1.01 Beldin 11 November 1997 -1.3 only version
# v1.02 Kirk 19 June 1998 -extremely small fixes
# v1.03 guppy 17 March 1999 -small fixes again
# v1.04 Ernst 15 June 1999 -fix for egg 1.3.x + TCL 8.0
# v1.05 Dude 14 July 1999 -small cosmetic/typo fixes
# -$lastbind bug work around fix
# -added userinfo_loaded var
# -fixed bug in dcc_chuserinfo proc
# -unbinds removed user fields
# -dcc .showfields command added
# -deletes removed userinfo fields
# from the whois-fields list.
# v1.06 guppy 19 March 2000 -removed lastbind workaround since
# lastbind is fixed in eggdrop1.4.3
# v1.07 TaKeDa 20 August 2001 -now script works also on bots,
# which didn't have server module loaded
# -added new fields PHONE & ICQ
#
# TO USE: o Set the desired userinfo field keywords to the
# `userinfo-fields' line below where indicated.
# o Load this script on a 1.1.6 or later Eggdrop bot.
# o Begin having users save the desired information. If you
# choose to add the default "IRL" field, they just use
# the IRC command: /MSG <botnick> irl Joe Blow.
# o See the new information now appear with the whois command.
#
# This script enhances the `whois' output utilizing the `whois-fields'
# option of eggdrop 1.1-grant and later versions. It adds the functionality
# of whois.tcl used in pre-1.1-grant versions.
#
# The fields desired to be maintained in the userfile `xtra' information
# should be put in `userinfo-fields'. This is different than the Eggdrop
# configuration variable `whois-fields' in that this script will add the
# commands to change these fields. It will also add these desired fields
# to the `whois-fields' itself, so do not define them there as well. The
# fields added in `userinfo-fields' will be converted to upper case for
# aesthetics in the `whois' command output.
#
# The commands that will be added to the running eggdrop are:
# (<info> will be the respective userfile field added in `userinfo-fields')
#
# TYPE COMMAND USAGE
# ====== ============== ========================================
# msg <info> To change your <info> via /MSG.
# dcc .<info> To change your <info> via DCC.
# dcc .ch<info> To change someone else's <info> via DCC.
#
# Currently supported fields and commands:
#
# FIELD USAGE
# ===== =====================
# URL WWW page URL
# IRL In Real Life name
# BF Boyfriend
# GF Girlfriend
# DOB Birthday (Date Of Birth)
# EMAIL Email address
# PHONE Phone number
# ICQ ICQ number
################################
# Set your desired fields here #
################################
set userinfo-fields "URL BF GF IRL EMAIL DOB PHONE ICQ"
# This script's identification
set userinfover "Userinfo TCL v1.07"
# This script is NOT for pre-1.4.3 versions.
catch { set numversion }
if {![info exists numversion] || ($numversion < 1040300)} {
putlog "*** Can't load $userinfover -- At least Eggdrop v1.4.3 required"
return 0
}
# Make sure we don't bail because whois and/or userinfo-fields aren't set.
if { ![info exists whois-fields]} { set whois-fields "" }
if { ![info exists userinfo-fields]} { set userinfo-fields "" }
# Add only the userinfo-fields not already in the whois-fields list.
foreach field [string tolower ${userinfo-fields}] {
if { [lsearch -exact [string tolower ${whois-fields}] $field] == -1 } { append whois-fields " " [string toupper $field] }
}
# If olduserinfo-fields doesn't exist, create it.
if { ![info exists olduserinfo-fields] } { set olduserinfo-fields ${userinfo-fields} }
# Delete only the userinfo-fields that have been removed but are still
# listed in the whois-fields list.
foreach field [string tolower ${olduserinfo-fields}] {
if { [lsearch -exact [string tolower ${whois-fields}] $field] >= 0 && [lsearch -exact [string tolower ${userinfo-fields}] $field] == -1 } {
set fieldtmp [lsearch -exact [string tolower ${whois-fields}] $field]
set whois-fields [lreplace ${whois-fields} $fieldtmp $fieldtmp]
}
}
# If olduserinfo-fields don't equal userinfo-fields, lets run through the
# old list of user fields and compare them with the current list. this way
# any fields that have been removed that were originally in the list will
# have their msg/dcc commands unbinded so you don't have to do a restart.
if {[info commands putserv] == ""} {
set isservermod 0
} else {
set isservermod 1
}
if { [string tolower ${olduserinfo-fields}] != [string tolower ${userinfo-fields}] } {
foreach field [string tolower ${olduserinfo-fields}] {
if { [lsearch -exact [string tolower ${userinfo-fields}] $field] == -1 } {
if $isservermod {unbind msg - $field msg_setuserinfo}
unbind dcc - $field dcc_setuserinfo
unbind dcc m ch$field dcc_chuserinfo
}
}
set olduserinfo-fields ${userinfo-fields}
}
# Run through the list of user info fields and bind their commands
if { ${userinfo-fields} != "" } {
foreach field [string tolower ${userinfo-fields}] {
if $isservermod {bind msg - $field msg_setuserinfo}
bind dcc - $field dcc_setuserinfo
bind dcc m ch$field dcc_chuserinfo
}
}
# This is the `/msg <info>' procedure
if $isservermod {
proc msg_setuserinfo {nick uhost hand arg} {
global lastbind quiet-reject userinfo-fields
set userinfo [string toupper $lastbind]
set arg [cleanarg $arg]
set ignore 1
foreach channel [channels] {
if {[onchan $nick $channel]} {
set ignore 0
}
}
if {$ignore} {
return 0
}
if {$hand != "*"} {
if {$arg != ""} {
if {[string tolower $arg] == "none"} {
putserv "NOTICE $nick :Removed your $userinfo line."
setuser $hand XTRA $userinfo ""
} {
putserv "NOTICE $nick :Now: $arg"
setuser $hand XTRA $userinfo "[string range $arg 0 159]"
}
} {
if {[getuser $hand XTRA $userinfo] == ""} {
putserv "NOTICE $nick :You have no $userinfo set."
} {
putserv "NOTICE $nick :Currently: [getuser $hand XTRA $userinfo]"
}
}
} else {
if {${quiet-reject} != 1} {
putserv "NOTICE $nick :You must be a registered user to use this feature."
}
}
putcmdlog "($nick!$uhost) !$hand! $userinfo $arg"
return 0
}
#checking for server module
}
# This is the dcc '.<info>' procedure.
proc dcc_setuserinfo {hand idx arg} {
global lastbind userinfo-fields
set userinfo [string toupper $lastbind]
set arg [cleanarg $arg]
if {$arg != ""} {
if {[string tolower $arg] == "none"} {
putdcc $idx "Removed your $userinfo line."
setuser $hand XTRA $userinfo ""
} {
putdcc $idx "Now: $arg"
setuser $hand XTRA $userinfo "[string range $arg 0 159]"
}
} {
if {[getuser $hand XTRA $userinfo] == ""} {
putdcc $idx "You have no $userinfo set."
} {
putdcc $idx "Currently: [getuser $hand XTRA $userinfo]"
}
}
putcmdlog "#$hand# [string tolower $userinfo] $arg"
return 0
}
# This is the DCC `.ch<info>' procedure
proc dcc_chuserinfo {hand idx arg} {
global lastbind userinfo-fields
set userinfo [string toupper [string range $lastbind 2 end]]
set arg [cleanarg $arg]
if { $arg == "" } {
putdcc $idx "syntax: .ch[string tolower $userinfo] <who> \[<[string tolower $userinfo]>|NONE\]"
return 0
}
set who [lindex [split $arg] 0]
if {![validuser $who]} {
putdcc $idx "$who is not a valid user."
return 0
}
if {[llength [split $arg]] == 1} {
set info ""
} {
set info [lrange [split $arg] 1 end]
}
if {$info != ""} {
if {[string tolower $info] == "none"} {
putdcc $idx "Removed $who's $userinfo line."
setuser $who XTRA $userinfo ""
putcmdlog "$userinfo for $who removed by $hand"
} {
putdcc $idx "Now: $info"
setuser $who XTRA $userinfo "$info"
putcmdlog "$userinfo for $who set to \"$info\" by $hand"
}
} {
if {[getuser $who XTRA $userinfo] == ""} {
putdcc $idx "$who has no $userinfo set."
} {
putdcc $idx "Currently: [getuser $who XTRA $userinfo]"
}
}
return 0
}
bind dcc m showfields showfields
proc showfields {hand idx arg} {
global userinfo-fields
if { ${userinfo-fields} == "" } {
putdcc $idx "Their is no user info fields set."
return 0
}
putdcc $idx "Currently: [string toupper ${userinfo-fields}]"
putcmdlog "#$hand# showfields"
return 0
}
proc cleanarg {arg} {
set response ""
for {set i 0} {$i < [string length $arg]} {incr i} {
set char [string index $arg $i]
if {($char != "\12") && ($char != "\15")} {
append response $char
}
}
return $response
}
# Set userinfo_loaded variable to indicate that the script was successfully
# loaded. this can be used in scripts that make use of the userinfo tcl.
set userinfo_loaded 1
# Announce that we've loaded the script.
putlog "$userinfover loaded (${userinfo-fields})."
putlog "use '.help userinfo' for commands."

593
weed Executable file
View file

@ -0,0 +1,593 @@
#! /bin/sh
# This trick is borrowed from Tothwolf's Wolfpack \
# Check for working 'grep -E' before using 'egrep' \
if echo a | (grep -E '(a|b)') >/dev/null 2>&1; \
then \
egrep="grep -E"; \
else \
egrep=egrep; \
fi; \
# Search for tclsh[0-9].[0-9] in each valid dir in PATH \
for dir in $(echo $PATH | sed 's/:/ /g'); \
do \
if test -d $dir; \
then \
files=$(/bin/ls $dir | $egrep '^tclsh[0-9]\.[0-9]$'); \
if test "$files" != ""; \
then \
versions="${versions:+$versions }$(echo $files | sed 's/tclsh//g')"; \
fi; \
fi; \
done; \
for ver in $versions; \
do \
tmpver=$(echo $ver | sed 's/\.//g'); \
if test "$lasttmpver" != ""; \
then \
if test "$tmpver" -gt "$lasttmpver"; \
then \
lastver=$ver; \
lasttmpver=$tmpver; \
fi; \
else \
lastver=$ver; \
lasttmpver=$tmpver; \
fi; \
done; \
exec tclsh$lastver "$0" ${1+"$@"}
#
# $Id: weed,v 1.9 2008/06/18 10:12:22 tothwolf Exp $
#
# weed out certain undesirables from an eggdrop userlist
# try just typing 'tclsh weed' to find out the options
# Robey Pointer, November 1994
#
# <cmwagner@gate.net>:
# I did a few bug fixes to the original weed script, things changed...
#
# when specifying other weed options they would unset the User() field and
# a maxlast weed would try and weed again and cause the script to stop due
# to User() being already unset (array nonexistant)
#
# when loadUserFile encountered an xtra field it would try and use the $info
# variable, which was supposed to be $xtra (something overlooked when the
# line was cut and pasted -- I hate it when that happens)
#
# changed the formatting of the saved weed file to match more closely to
# eggdrop 0.9tp (so this may cause incompatibilities), but when a hostmask
# field exactly matched 40 characters it would save it with no spaces after
# it and eggdrop would reject the user record. I know I could have easily
# changed one character, but I couldn't help myself. <grin>
# 5 march 1996
#
# <robey, 23jul1996>:
# upgrade for v2 userfiles
# <bruce s, 04sep1996>:
# fixed xtra field from getting truncated
# <robey, 20sep1996>:
# stopped it from mangling channel ban lists
# <Ec|ipse & dtM, 10jun1997>:
# upgrade for v3 userfiles
# <Ec|ipse 18jun1997>:
# added an option to remove users from unwanted channels
# <Ec|ipse 28oct1997>:
# upgrade for v4 userfiles, with v3 converter
# <Ernst 8mar1998>:
# fixed bug "list element in braces followed by X instead of space"
# (the use of "lrange" where you aren't sure if it's a list is bad)
# fixed --CONSOLE item not being included, creating "user" --CONSOLE
# <Ernst 1apr1998>:
# two more improper occurrences of "lrange" removed
# <rtc 20sep1999>:
# removed ancient way of determining the current time.
# <Tothwolf 21oct1999>:
# [clock] isn't in all versions of Tcl...
# <guppy 12Apr2001>:
# borrowed code from Tothwolf's Wolfpack to find tclsh better
#
set exempt {*ban *ignore}
set exemptops 0 ; set exemptmasters 0 ; set exemptfriends 0
set exemptparty 0 ; set exemptfile 0 ; set exemptchanm 0
set exemptbotm 0 ; set exemptchann 0 ; set exemptchanf 0
set exemptchano 0
set maxlast 0 ; set maxban 0 ; set maxignore 0
set weedops 0 ; set weedmasters 0 ; set weednopw 0
set stripops 0 ; set stripmasters 0 ; set weedlurkers 0
set chanrem {}
set convert 0
if {![string compare "" [info commands clock]]} then {
set fd [open "/tmp/egg.timer." w]
close $fd
set CURRENT [file atime "/tmp/egg.timer."]
exec rm -f /tmp/egg.timer.
} else {
set CURRENT [clock seconds]
}
if {$argc < 1} {
puts stdout "\nUsage: weed <userfile> \[options\]"
puts stdout " (weeds out users from an eggdrop userlist)"
puts stdout "Output goes to <userfile>.weed"
puts stdout "Possible options:"
puts stdout " -<nick> exempt this user from weeding"
puts stdout " ^o ^m ^f exempt ops or masters or friends"
puts stdout " ^co ^cm ^cf exempt chanops or chanmasters or chanfriends"
puts stdout " ^cn exempt chanowner"
puts stdout " ^p ^x exempt party-line or file-area users"
puts stdout " ^b exempt botnet master"
puts stdout " +<days> weed: haven't been seen in N days"
puts stdout " :n weed: haven't EVER been seen"
puts stdout " :o :m weed: ops or masters with no password set"
puts stdout " :a weed: anyone with no password set"
puts stdout " o m unop/unmaster: ops or masters with no pass."
puts stdout " b<days> weed: bans not used in N days"
puts stdout " i<days> weed: ignores created over N days ago"
puts stdout " =<chan> weed: channels no longer supported"
puts stdout " c convert v3 eggdrop userfile"
puts stdout ""
exit
}
puts stdout "\nWEED 18jun97, robey\n"
set filename [lindex $argv 0]
for {set i 1} {$i < $argc} {incr i} {
set carg [lindex $argv $i]
if {$carg == ":n"} {
set weedlurkers 1
} elseif {$carg == ":o"} {
set weedops 1 ; set stripops 0 ; set weednopw 0
} elseif {$carg == ":m"} {
set weedmasters 1 ; set stripmasters 0 ; set weednopw 0
} elseif {$carg == ":a"} {
set weednopw 1 ; set weedops 0 ; set weedmasters 0
set stripops 0 ; set stripmasters 0
} elseif {$carg == "o"} {
set stripops 1 ; set weedops 0 ; set weednopw 0
} elseif {$carg == "m"} {
set stripmasters 1 ; set weedmasters 0 ; set weednopw 0
} elseif {$carg == "^m"} {
set exemptmasters 1
} elseif {$carg == "^o"} {
set exemptops 1
} elseif {$carg == "^f"} {
set exemptfriends 1
} elseif {$carg == "^p"} {
set exemptparty 1
} elseif {$carg == "^x"} {
set exemptfile 1
} elseif {$carg == "^cf"} {
set exemptchanf 1
} elseif {$carg == "^cm"} {
set exemptchanm 1
} elseif {$carg == "^cn"} {
set exemptchann 1
} elseif {$carg == "^b"} {
set exemptbotm 1
} elseif {$carg == "^co"} {
set exemptchano 1
} elseif {$carg == "c"} {
set convert 1
} elseif {[string index $carg 0] == "-"} {
lappend exempt [string range $carg 1 end]
} elseif {[string index $carg 0] == "+"} {
set maxlast [expr 60*60*24* [string range $carg 1 end]]
} elseif {[string index $carg 0] == "b"} {
set maxban [expr 60*60*24* [string range $carg 1 end]]
} elseif {[string index $carg 0] == "i"} {
set maxignore [expr 60*60*24* [string range $carg 1 end]]
} elseif {[string index $carg 0] == "="} {
lappend chanrem [string tolower [string range $carg 1 end]]
} else {
puts stderr "UNKNOWN OPTION: '$carg'\n"
exit
}
}
if {(!$weedlurkers) && (!$weedops) && (!$weedmasters) && (!$weednopw) &&
(!$stripops) && (!$stripmasters) && ($maxlast == 0) && ($convert == 0) &&
($maxban == 0) && ($maxignore == 0) && ($chanrem == {})} {
puts stderr "PROBLEM: You didn't specify anything to weed out.\n"
exit
}
set weeding { } ; set strip { } ; set exempting { }
if {$weedlurkers} { lappend weeding "lurkers" }
if {$weedops} { lappend weeding "pwdless-ops" }
if {$weedmasters} { lappend weeding "pwdless-masters" }
if {$weednopw} { lappend weeding "pwdless-users" }
if {$chanrem != {}} { lappend weeding "unwanted-channel" }
if {$maxlast > 0} { lappend weeding ">[expr $maxlast /(60*60*24)]-days" }
if {$maxban > 0} { lappend weeding "bans>[expr $maxban /(60*60*24)]-days" }
if {$maxignore > 0} { lappend weeding "ign>[expr $maxignore /(60*60*24)]-days" }
if {$weeding != { }} { puts stdout "Weeding:$weeding" }
if {$stripops} { lappend strip "pwdless-ops" }
if {$stripmasters} { lappend strip "pwdless-masters" }
if {$strip != { }} { puts stdout "Stripping:$strip" }
if {$exemptops} { lappend exempting "(ops)" }
if {$exemptmasters} { lappend exempting "(masters)" }
if {$exemptfriends} { lappend exempting "(friends)" }
if {$exemptparty} { lappend exempting "(party-line)" }
if {$exemptfile} { lappend exempting "(file-area)" }
if {$exemptchann} { lappend exempting "(channel-owners)" }
if {$exemptchanm} { lappend exempting "(channel-masters)" }
if {$exemptchano} { lappend exempting "(channel-ops)" }
if {$exemptchanf} { lappend exempting "(channel-friends)" }
if {$exemptbotm} { lappend exempting "(botnet masters)" }
if {[llength $exempt]>2} { lappend exempting "[lrange $exempt 2 end]" }
if {$exempting != { }} { puts stdout "Exempt:$exempting" }
puts stdout "\nReading $filename ..."
proc convertUserFile {fname} {
global User Hostmask Channel Botflag LastOn BotAddr Xtra convert
puts stdout "\nRunning Converter on $fname"
set oldhandle {}
if {[catch {set fd [open $fname r]}] != 0} { return 0 }
set line [string trim [gets $fd]]
if {[string range $line 1 2] == "3v"} {
set convert 1
} elseif {[string range $line 1 2] == "4v"} {
return 0
}
while {![eof $fd]} {
set line [string trim [gets $fd]]
if {([string index $line 0] != "#") && ([string length $line] > 0)} {
scan $line "%s" handle
if {$handle == "-"} {
# hostmask
set hmList [split [string range $line 2 end] ,]
for {set i 0} {$i < [llength $hmList]} {incr i} {
lappend Hostmask($oldhandle) [string trim [lindex $hmList $i]]
}
} elseif {$handle == "!"} {
# channel
set chList [string trim [string range $line 1 end]]
lappend Channel($oldhandle) "[lrange $chList 0 1] [string trim [lindex $chList end] 0123456789]"
} elseif {$handle == "*"} {
# dccdir
set dccdir [string trim [string range $line 2 end]]
set User($oldhandle) [lreplace $User($oldhandle) 2 2 $dccdir]
} elseif {$handle == "+"} {
# email
set email [string trim [string range $line 2 end]]
set User($oldhandle) [lreplace $User($oldhandle) 3 3 $email]
} elseif {$handle == "="} {
# comment
set comment [string trim [string range $line 2 end]]
set User($oldhandle) [lreplace $User($oldhandle) 4 4 $comment]
} elseif {$handle == ":"} {
# user info line / bot addresses
if {[lsearch [split [lindex $User($oldhandle) 0] ""] b] == -1} {
set info [string trim [string range $line 1 end]]
set User($oldhandle) [lreplace $User($oldhandle) 5 5 $info]
} else {
set BotAddr($oldhandle) [string trim [string range $line 1 end]]
}
} elseif {$handle == "."} {
# xtra field start
if {![info exists xtraList($oldhandle)]} {
set xtraList($oldhandle) [string trim [string range $line 1 end]]
} {
set xtraList($oldhandle) "$xtraList($oldhandle) [string trim [string range $line 1 end]]"
}
} elseif {$handle == "!!"} {
# laston
set LastOn($oldhandle) [lindex $line 1]
} else {
# finish up xtra field first
if {[info exists xtraList($oldhandle)]} {
for {set i 0} {$i < [llength $xtraList($oldhandle)]} {incr i} {
lappend Xtra($oldhandle) [string trim [lindex $xtraList($oldhandle) $i] \{]
}
}
# begin of new user
scan $line "%s %s %s %s" handle pass attr ts
if {$convert == 1 && $attr != ""} {
regsub -all {B} $attr {t} attr
set botflags "s h a l r" ; set Botflag($handle) ""
set nattr [split [string trim $attr 0123456789] ""] ; set attr ""
foreach flag $botflags {
if {[lsearch -exact $nattr $flag] != -1} {append Botflag($handle) $flag}
}
foreach flag $nattr {
if {[lsearch -exact $botflags $flag] == -1} {append attr $flag}
}
}
set User($handle) [list $attr $pass {} {} {} {}]
set Hostmask($handle) {}
set Channel($handle) {}
set oldhandle $handle
}
}
}
return 1
}
proc loadUserFile {fname} {
global User Hostmask Channel Botflag LastOn BotAddr Xtra
set oldhandle {}
if {[catch {set fd [open $fname r]}] != 0} { return 0 }
set line [string trim [gets $fd]]
if {[string range $line 1 2] != "4v"} {
if {[string range $line 1 2] == "3v"} {
convertUserFile $fname
return 1
} else {
puts stderr "Unknown userfile version! (not v4)\n"
exit
}
}
while {![eof $fd]} {
set line [string trim [gets $fd]]
if {([string index $line 0] != "#") && ([string length $line] > 0)} {
scan $line "%s" handle
if {$handle == "--HOSTS"} {
# hostmask
set hmList [lindex $line 1]
lappend Hostmask($oldhandle) [string trim $hmList]
} elseif {$handle == "-"} {
# hostmask
set hmList [join [lrange $line 1 end]]
lappend Hostmask($oldhandle) [string trim $hmList]
} elseif {$handle == "!"} {
# channel
set chList [string trim [string range $line 1 end]]
lappend Channel($oldhandle) $chList
} elseif {$handle == "--BOTADDR"} {
# botaddr
set BotAddr($oldhandle) [lindex $line 1]
} elseif {$handle == "--PASS"} {
# pass
set pass [string trim [string range $line [expr [string first " " $line] + 1] end]]
set User($oldhandle) [lreplace $User($oldhandle) 1 1 $pass]
} elseif {$handle == "--DCCDIR"} {
# dccdir
set first [string first " " $line]
if {$first != -1} {
set dccdir [string trim [string range $line [expr $first + 1] end]]
} {
set dccdir ""
}
set User($oldhandle) [lreplace $User($oldhandle) 2 2 $dccdir]
} elseif {$handle == "--COMMENT"} {
# comment
set first [string first " " $line]
if {$first != -1} {
set comment [string trim [string range $line [expr $first + 1] end]]
} {
set comment ""
}
set User($oldhandle) [lreplace $User($oldhandle) 4 4 $comment]
} elseif {$handle == "--INFO"} {
# user info line
set first [string first " " $line]
if {$first != -1} {
set info [string trim [string range $line [expr $first + 1] end]]
} {
set info ""
}
set User($oldhandle) [lreplace $User($oldhandle) 5 5 $info]
} elseif {$handle == "--CONSOLE"} {
# console
set first [string first " " $line]
if {$first != -1} {
set console [string trim [string range $line [expr $first + 1] end]]
} {
set console ""
}
set User($oldhandle) [lreplace $User($oldhandle) 6 6 $console]
} elseif {$handle == "--XTRA"} {
# xtra field
set first [string first " " $line]
if {$first != -1} {
set xtraList [string trim [string range $line [expr $first + 1] end]]
} {
set xtraList ""
}
lappend Xtra($oldhandle) $xtraList
} elseif {$handle == "--LASTON"} {
# laston
set LastOn($oldhandle) [lindex $line 1]
} elseif {$handle == "--BOTFL"} {
# botflags
set Botflag($oldhandle) [string trim [string range $line 1 end]]
} else {
# begin of new user
scan $line "%s %s %s" handle dash attr
set User($handle) [list $attr {} {} {} {} {} {}]
set Hostmask($handle) {}
set Channel($handle) {}
set oldhandle $handle
}
}
}
return 1
}
proc saveUserFile fname {
global User Hostmask Channel Botflag LastOn BotAddr Xtra
if {[catch {set fd [open $fname w]}] != 0} { return 0 }
puts $fd "#4v: weed! now go away."
foreach i [array names User] {
set hmask "none"
set hmloop 0 ; set chloop 0 ; set loloop 0 ; set xloop 0 ; set aloop 0
if {[lindex $User($i) 1] == "bans"} {set plug "bans"} {set plug "-"}
set attr [lindex $User($i) 0]
set ts [lindex $User($i) 2]
puts $fd [format "%-9s %-20s %-24s" $i $plug $attr]
for {} {$hmloop < [llength $Hostmask($i)]} {incr hmloop} {
if {[string index $i 0] == "*" || [string range $i 0 1] == "::"} {
set hmask [lindex $Hostmask($i) $hmloop]
regsub -all {~} $hmask { } hmask
puts $fd "- $hmask"
} else {
puts $fd "--HOSTS [lindex $Hostmask($i) $hmloop]"
}
}
if {[info exists BotAddr($i)]} {
puts $fd "--BOTADDR [lindex $BotAddr($i) 0]"
}
if {[info exists Xtra($i)]} {
for {} {$xloop < [llength $Xtra($i)]} {incr xloop} {
puts $fd "--XTRA [lindex $Xtra($i) $xloop]"
}
}
if {[info exists Channel($i)]} {
for {} {$chloop < [llength $Channel($i)]} {incr chloop} {
puts $fd "! [lindex $Channel($i) $chloop]"
}
}
if {[info exists Botflag($i)]} {
if {$Botflag($i) != ""} { puts $fd "--BOTFL [lindex $Botflag($i) 0]" }
}
if {[string index $i 0] == "*" || [string range $i 0 1] == "::"} {
set User($i) [lreplace $User($i) 1 1 {}]
}
if {[lindex $User($i) 1] != {}} { puts $fd "--PASS [lindex $User($i) 1]" }
if {[lindex $User($i) 2] != {}} { puts $fd "--DCCDIR [lindex $User($i) 2]" }
if {[lindex $User($i) 3] != {}} { puts $fd "--XTRA EMAIL [lindex $User($i) 3]" }
if {[lindex $User($i) 4] != {}} { puts $fd "--COMMENT [lindex $User($i) 4]" }
if {[lindex $User($i) 5] != {}} { puts $fd "--INFO [lindex $User($i) 5]" }
if {[lindex $User($i) 6] != {}} { puts $fd "--CONSOLE [lindex $User($i) 6]" }
if {[info exists LastOn($i)]} {
puts $fd "--LASTON [lindex $LastOn($i) 0]"
}
}
close $fd
return 1
}
if {![loadUserFile $filename]} {
puts stdout "* Couldn't load userfile!\n"
exit
}
if {$convert == 0} {
puts stdout "Loaded. Weeding..."
puts stdout "(pwd = no pass, -o/-m = removed op/master, lrk = never seen, exp = expired)"
puts stdout "(uwc = unwanted channel)\n"
} else {
puts stdout "Loaded. Converting..."
}
set total 0
set weeded 0
foreach i [array names User] {
incr total
set attr [lindex $User($i) 0]
set chanattr [lindex [lindex $Channel($i) 0] 2]
if {([lsearch -exact $exempt $i] == -1) &&
([string range $i 0 1] != "::") &&
([string range $i 0 1] != "--") &&
(([string first o $attr] == -1) || (!$exemptops)) &&
(([string first m $attr] == -1) || (!$exemptmasters)) &&
(([string first f $attr] == -1) || (!$exemptfriends)) &&
(([string first p $attr] == -1) || (!$exemptparty)) &&
(([string first x $attr] == -1) || (!$exemptfile)) &&
(([string first t $attr] == -1) || (!$exemptbotm)) &&
(([string first f $chanattr] == -1) || (!$exemptchanf)) &&
(([string first m $chanattr] == -1) || (!$exemptchanm)) &&
(([string first n $chanattr] == -1) || (!$exemptchann)) &&
(([string first o $chanattr] == -1) || (!$exemptchano))} {
set pass [lindex $User($i) 1]
if {[info exists LastOn($i)]} { set ts [lindex $LastOn($i) 0] } { set ts 0 }
if {([string compare $pass "-"] == 0) && ([string first b $attr] == -1)} {
if {$weednopw == 1} {
unset User($i) ; incr weeded
puts -nonewline stdout "[format "pwd: %-10s " $i]"
} elseif {([string first o $attr] != -1) && ($weedops == 1)} {
unset User($i) ; incr weeded
puts -nonewline stdout "[format "pwd: %-10s " $i]"
} elseif {([string first m $attr] != -1) && ($weedmasters == 1)} {
unset User($i) ; incr weeded
puts -nonewline stdout "[format "pwd: %-10s " $i]"
}
if {([string first o $attr] != -1) && ($stripops == 1)} {
set nattr {}
for {set x 0} {$x < [string length $attr]} {incr x} {
if {[string index $attr $x] != "o"} {
set nattr [format "%s%s" $nattr [string index $attr $x]]
}
}
if {$nattr == {}} { set nattr "-" }
set User($i) [lreplace $User($i) 0 0 $nattr]
puts -nonewline stdout "[format " -o: %-10s " $i]"
}
if {([string first m $attr] != -1) && ($stripmasters == 1)} {
set nattr {}
for {set x 0} {$x < [string length $attr]} {incr x} {
if {[string index $attr $x] != "m"} {
set nattr [format "%s%s" $nattr [string index $attr $x]]
}
}
if {$nattr == {}} { set nattr "-" }
set User($i) [lreplace $User($i) 0 0 $nattr]
puts -nonewline stdout "[format " -m: %-10s " $i]"
}
}
if {($ts==0) && ($weedlurkers==1) && ([string first b $attr] == -1) && [info exists User($i)]} {
unset User($i) ; incr weeded
puts -nonewline stdout "[format "lrk: %-10s " $i]"
}
if {($ts > 0) && ($maxlast > 0) && ($CURRENT-$ts > $maxlast && [info exists User($i)])} {
unset User($i) ; incr weeded
puts -nonewline stdout "[format "exp: %-10s " $i]"
}
if {$chanrem != {} && [info exists Channel($i)]} {
foreach unchan $chanrem {
set id [lsearch [string tolower $Channel($i)] *$unchan*]
if {$id != -1} {
set Channel($i) [lreplace $Channel($i) $id $id] ; incr weeded
puts -nonewline stdout "[format "uwc: %-10s " $i]"
}
}
}
}
flush stdout
}
if {$weeded == 0 && $convert == 0} { puts -nonewline stdout "uNF... Nothing to weed!" }
puts stdout "\n"
foreach i [array names User] {
if {([string range $i 0 1] == "::") || ($i == "*ban")} {
for {set j 0} {$j < [llength $Hostmask($i)]} {incr j} {
set ban [split [lindex $Hostmask($i) $j] :]
if {[string range [lindex $ban 2] 0 0] == "+"} {
set lastused [lindex $ban 3]
if {($maxban > 0) && ($CURRENT-$lastused > $maxban)} {
if {$i == "*ban"} {
puts stdout "Expired ban: [lindex $ban 0]"
} {
puts stdout "Expired ban on [string range $i 2 end]: [lindex $ban 0]"
}
set Hostmask($i) [lreplace $Hostmask($i) $j $j]
incr j -1
}
}
}
}
if {$i == "*ignore"} {
for {set j 0} {$j < [llength $Hostmask($i)]} {incr j} {
set ign [split [lindex $Hostmask($i) $j] :]
set lastused [lindex $ign 3]
if {($maxignore > 0) && ($CURRENT-$lastused > $maxignore)} {
puts stdout "Expired ignore: [lindex $ign 0]"
set Hostmask($i) [lreplace $Hostmask($i) $j $j]
incr j -1
}
}
}
}
puts stdout "\nFinished scan."
puts stdout "Original total ($total), new total ([expr $total-$weeded]), zapped ($weeded)"
if {![saveUserFile $filename.weed]} {
puts stdout "* uNF... Couldn't save new userfile!\n"
exit
}
puts stdout "Wrote $filename.weed"

232
whoisd.tcl Normal file
View file

@ -0,0 +1,232 @@
# whoisd.tcl -- 1.1
#
# The whois command checks if a given domain is available or taken.
# The tld command returns which country sponsors the given tld.
# This script uses live servers so it is never outdated, unlike other scripts.
#
# I have tried a lot of existing domain whois scripts, none of them did what I wanted.
# So I decided to write my own, based on a similar script I wrote for mIRC.
#
# It is purposly made to be simple so it did not require much maintenance.
#
# Copyright (c) 2010 HM2K
#
# Name: domain whois and tld country code lookup (!whois and !tld)
# Author: HM2K <irc@hm2k.org>
# License: http://www.freebsd.org/copyright/freebsd-license.html
# Link: http://www.hm2k.com/projects/eggtcl
# Tags: whois, lookup, domains, tld, country
# Updated: 29-Jul-2010
#
###Usage
# !whois is the default public channel trigger for the whois function
# .whoisd is the default dcc command trigger the whois function
# !tld is the default public channel trigger for the tld function
# .tld is the default dcc trigger for the tld function
#
###Example
# > !whois hm2k.com
# <Bot> whois: hm2k.com is taken!
# > !whois example-lame-domain.com
# <Bot> whois: example-lame-domain.com is available!
# > !tld uk
# <Bot> whois: Country for uk is United Kingdom
#
###Credits
# Thanks #eggtcl @ EFnet for some pointers
#
###Revisions
# 1.1 - iana changed their whois response; the whole script was revamped
# 1.0.3 - better documentation; fixed trigger; fixed timeouts; fixed available match
# 1.0.2 - further imrovements were made
# 1.0.1 - first public release
### Settings
set whoisd(cmd_dcc_domain) "whoisd"; #the dcc command - eg: whoisd <domain>
set whoisd(cmd_dcc_tld) "tld"; #the dcc tld command - eg: tld <tld>
set whoisd(cmd_pub_domain) "!whois"; #the pub command - eg: !whoisd <domain>
set whoisd(cmd_pub_tld) "!tld"; #the pub tld command - eg: !tld <tld>
set whoisd(data_country) "";#place holder for country data
set whoisd(data_type) "domain"; #default data type
set whoisd(debug) 1; #turn debug on or off
set whoisd(error_connect) "Error: Connection to %s:%s failed."; #Connection failed
set whoisd(error_connect_lost) "Error: Connection to server has been lost.";
set whoisd(error_invalid) "Error: Invalid %s."; #Invalid domain/tld error
set whoisd(flag) "-|-"; #flag required to use the script
set whoisd(nomatch_domain) "No match|not found|Invalid query|does not exist|no data found|status: avail|domain is available|(null)|no entries found|not registered|no objects found|domain name is not|Status:.*AVAILABLE"; #Replies from Whois Servers that match as "Available"... #TODO: split into new lines, join again later
set whoisd(nomatch_tld) "This query returned 0 objects."; #Error returned for invalid tld
set whoisd(notice_connect) "Connecting to... %s:%s (%s)"; #Connecting notice
set whoisd(output_country) "Country for %s is %s";
set whoisd(output_found) "%s is available!";
set whoisd(output_nomatch) "%s is taken!";
set whoisd(output_timeout) "Connection to %s:%s timed out within %s seconds.";
set whoisd(port) 43; #The default whois server port - should not change
set whoisd(prefix) "whois:"; #prefix on output
set whoisd(regex_country) {address.*?:\s*(.+)$};
set whoisd(regex_server) {whois.*?:\s*(.+)$};
set whoisd(regex_valid_domain) {^([a-zA-Z0-9]([a-zA-Z0-9\-]{0,61}[a-zA-Z0-9])?\.)+[a-zA-Z]{2,6}$}; #Regular expression used for validating domains
set whoisd(regex_valid_tld) {^\.?[a-z]+$};
set whoisd(rplmode) 1; #reply mode (1:chan privmsg, 2:chan notice, 3:nick privmsg, 4:nick notice)
set whoisd(server) "whois.iana.org"; #The main whois server - should not change
set whoisd(timeout) 15; #server timeout in seconds - servers are quick, keep low
set whoisd(usage) "Usage: %s <%s>"; #Usage
set whoisd(ver) "1.1"; # version
### Package Definition
package require eggdrop 1.6; #see http://geteggdrop.com/
package require Tcl 8.2.3; #see http://tinyurl.com/6kvu2n
### Binds
bind dcc $whoisd(flag) $whoisd(cmd_dcc_domain) whoisd:dcc_domain;
bind pub $whoisd(flag) $whoisd(cmd_pub_domain) whoisd:pub_domain;
bind dcc $whoisd(flag) $whoisd(cmd_dcc_tld) whoisd:dcc_tld;
bind pub $whoisd(flag) $whoisd(cmd_pub_tld) whoisd:pub_tld;
### Procedures
proc whoisd:validate {cmd word} {
if {[string compare $word ""] == 0} {
return [format $::whoisd(usage) $cmd $::whoisd(data_type)];
}
if {![regexp $::whoisd(regex_valid) $word]} {
return [format $::whoisd(error_invalid) $::whoisd(data_type)];
}
return;
}
proc whoisd:dcc_domain {hand idx text} {
set ::whoisd(data_type) "domain";
set ::whoisd(cmd_dcc) $::whoisd(cmd_dcc_domain);
set ::whoisd(regex_valid) $::whoisd(regex_valid_domain);
return [whoisd:dcc $hand $idx $text];
}
proc whoisd:pub_domain {nick uhost hand chan text} {
set ::whoisd(data_type) "domain";
set ::whoisd(cmd_pub) $::whoisd(cmd_pub_domain);
set ::whoisd(regex_valid) $::whoisd(regex_valid_domain);
return [whoisd:pub $nick $uhost $hand $chan $text];
}
proc whoisd:dcc_tld {hand idx text} {
set ::whoisd(data_type) "tld";
set ::whoisd(cmd_dcc) $::whoisd(cmd_dcc_tld);
set ::whoisd(regex_valid) $::whoisd(regex_valid_tld);
return [whoisd:dcc $hand $idx $text];
}
proc whoisd:pub_tld {nick uhost hand chan text} {
set ::whoisd(data_type) "tld";
set ::whoisd(cmd_pub) $::whoisd(cmd_pub_tld);
set ::whoisd(regex_valid) $::whoisd(regex_valid_tld);
return [whoisd:pub $nick $uhost $hand $chan $text];
}
proc whoisd:dcc {hand idx text} {
set word [lrange [split $text] 0 0];
if {[set invalid [whoisd:validate ".$::whoisd(cmd_dcc)" $word]] != ""} {
whoisd:out 0 $idx {} $invalid;
return;
}
whoisd:connect 0 $idx {} $::whoisd(server) $::whoisd(port) $word;
}
proc whoisd:pub {nick uhost hand chan text} {
set word [lrange [split $text] 0 0];
if {[set invalid [whoisd:validate $::whoisd(cmd_pub) $word]] != ""} {
whoisd:out 4 {} $nick $invalid;
return;
}
whoisd:connect $::whoisd(rplmode) $chan $nick $::whoisd(server) $::whoisd(port) $word;
}
proc whoisd:out {type dest nick text} {
if {[string length [string trim $text]] < 1} { return; }
switch -- $type {
"0" { putdcc $dest "$::whoisd(prefix) $text"; }
"1" { putserv "PRIVMSG $dest :$::whoisd(prefix) $text"; }
"2" { putserv "NOTICE $dest :$::whoisd(prefix) $text"; }
"3" { putserv "PRIVMSG $nick :$::whoisd(prefix) $text"; }
"4" { putserv "NOTICE $nick :$::whoisd(prefix) $text"; }
"5" { putlog "$::whoisd(prefix) $text"; }
}
}
proc whoisd:connect {type dest nick server port word} {
putlog [format $::whoisd(notice_connect) $server $port $word];
if {[catch {socket -async $server $port} sock]} {
whoisd:out $type $dest $nick [format $::whoisd(error_connect) $server $port];
return;
}
#TODO: too long; must be split
fileevent $sock writable [list whoisd:write $type $dest $nick $word $sock $server $port [utimer $::whoisd(timeout) [list whoisd:timeout $type $dest $nick $server $port $sock $word]]];
}
proc whoisd:write {type dest nick word sock server port timerid} {
if {[set error [fconfigure $sock -error]] != ""} {
whoisd:out $type $dest $nick [format $::whoisd(error_connect) $server $port];
whoisd:die $sock $timerid;
return;
}
set word [string trim $word .];
if {$server == $::whoisd(server)} {
set lookup [lrange [split $word "."] end end];
} else {
set lookup $word;
}
puts $sock "$lookup\n";
flush $sock;
fconfigure $sock -blocking 0;
fileevent $sock readable [list whoisd:read $type $dest $nick $word $sock $server $port $timerid];
fileevent $sock writable {};
}
proc whoisd:read {type dest nick word sock server port timerid} {
while {![set error [catch {gets $sock output} read]] && $read > 0} {
if {!$type} { whoisd:out $type $dest $nick $output; }
if {$server == $::whoisd(server)} {
if {[regexp $::whoisd(nomatch_tld) $output]} {
set output [format $::whoisd(error_invalid) "tld"];
whoisd:out $type $dest $nick $output;
whoisd:die $sock $timerid;
}
if {$::whoisd(data_type) == "tld"} {
if {[regexp $::whoisd(regex_country) $output -> country]} {
set ::whoisd(data_country) $country;
}
} elseif {[regexp -nocase -- $::whoisd(regex_server) $output -> server]} {
whoisd:connect $type $dest $nick $server $port $word;
whoisd:die $sock $timerid;
}
} else {
if {[regexp -nocase -- $::whoisd(nomatch_domain) $output]} {
set output [format $::whoisd(output_found) $word];
whoisd:out $type $dest $nick $output;
whoisd:die $sock $timerid;
}
}
if {$error} {
whoisd:out $type $dest $nick $::whoisd(error_connect_lost);
whoisd:die $sock $timerid;
}
}
}
proc whoisd:die {sock timerid} {
catch { killutimer $timerid }
catch { close $sock }
}
proc whoisd:timeout {type dest nick server port sock word} {
catch { close $sock }
if {$server != $::whoisd(server)} {
set output [format $::whoisd(output_nomatch) $word];
whoisd:out $type $dest $nick $output;
return;
} elseif {$::whoisd(data_country) != ""} {
set output [format $::whoisd(output_country) $word $::whoisd(data_country)];
} else {
set output [format $::whoisd(output_timeout) $server $port $::whoisd(timeout)];
}
whoisd:out $type $dest $nick $output;
}
### Loaded
putlog "whoisd.tcl $whoisd(ver) loaded";
#EOF

155
whoisd.tcl_old Normal file
View file

@ -0,0 +1,155 @@
#whoisd.tcl v1.0.2 by HM2K - domain whois and tld country lookup !whois and !tld
### Description:
## I have tried a lot of existing domain whois scripts, none of them did what I wanted.
## So I decided to write my own, based on a similar script I wrote for mIRC.
##
### Usage:
## The whois command (!whoisd) offers the ability to check if domain is available or taken.
## The tld command (!tld) offers the ability to see which country owns an entered tld.
## The tld command is similar to the !country commands, however the tld uses live servers so is never outdated.
## The commands can also be triggered inside DCC, where all full domain whois records are displayed.
##
### Credits:
## thanks to #eggtcl @ EFnet for some pointers
##
set whoisdver "1.0.2"
#the dcc command - eg: whoisd <domain>
#set whoisd(cmd_dcc) "whoisd"
#the pub command - eg: !whoisd <domain>
#set whoisd(cmd_pub) "!whoisd"
#the dcc tld command - eg: tld <tld>
#set whoisd(cmd_tlddcc) "tld"
#the pub tld command - eg: !tld <tld>
set whoisd(cmd_tldpub) "!tld"
#flag required to use the script
set whoisd(flag) "-|-"
#The main whois server - should not change
set whoisd(server) "whois.iana.org"
#The default whois server port - should not change
set whoisd(port) "43"
#server timeout - servers are quick, keep low
set whoisd(timeout) "5"
#reply mode
#0 - Private message to the channel
#1 - Notice to the channel
#2 - Private message to the nick
#3 - Notice to the nick
set whoisd(rplmode) "0"
#prefix on output
set whoisd(prefix) "whois:"
#set whoisd(prefix) "\002$::whoisd(prefix)\002"
if {![string match 1.6.* $version]} { putlog "\002WARNING:\002 This script is intended to run on eggdrop 1.6.x or later." }
if {[info tclversion] < 8.2} { putlog "\002WARNING:\002 This script is intended to run on Tcl Version 8.2 or later." }
#bind dcc $whoisd(flag) $whoisd(cmd_dcc) whoisd:dcc
#bind pub $whoisd(flag) $whoisd(cmd_pub) whoisd:pub
#bind dcc $whoisd(flag) $whoisd(cmd_tlddcc) whoisd:tlddcc
bind pub $whoisd(flag) $whoisd(cmd_tldpub) whoisd:tldpub
#proc whoisd:dcc {hand idx text} {
# if {[string compare [set word [lrange [split $text] 0 0]] ""] == 0} { putdcc $idx "$::whoisd(prefix) Usage: .$::whoisd(cmd_dcc) <domain>" ; return }
# if {![regexp {^([a-zA-Z0-9]([a-zA-Z0-9\-]{0,61}[a-zA-Z0-9])?\.)+[a-zA-Z]{2,6}$} $word]} { putdcc $idx "$::whoisd(prefix) Error: Invalid Domain." ; return }
# whoisd:connect 0 $idx {} $::whoisd(server) $::whoisd(port) $word
#}
#proc whoisd:pub {nick uhost hand chan text} {
# if {[string compare [set word [lrange [split $text] 0 0]] ""] == 0} { putserv "NOTICE $nick :$::whoisd(prefix) Usage: $::whoisd(cmd_pub) <domain>" ; return }
# if {![regexp {^([a-zA-Z0-9]([a-zA-Z0-9\-]{0,61}[a-zA-Z0-9])?\.)+[a-zA-Z]{2,6}$} $word]} { putserv "NOTICE $nick :$::whoisd(prefix) Error: Invalid Domain." ; return }
# whoisd:connect 1 $chan $nick $::whoisd(server) $::whoisd(port) $word
#}
#proc whoisd:tlddcc {hand idx text} {
# if {[string compare [set word [lrange [split $text] 0 0]] ""] == 0} { putdcc $idx "$::whoisd(prefix) Usage: .$::whoisd(cmd_tlddcc) <tld>" ; return }
# if {[string index $word 0] != "."} { putdcc $idx "$::whoisd(prefix) Error: Invalid TLD." ; return }
# whoisd:connect 0 $idx {} $::whoisd(server) $::whoisd(port) $word
#}
proc whoisd:tldpub {nick uhost hand chan text} {
if {[string compare [set word [lrange [split $text] 0 0]] ""] == 0} { putserv "NOTICE $nick :$::whoisd(prefix) Usage: $::whoisd(cmd_tldpub) <tld>" ; return }
if {[string index $word 0] != "."} { set word ".$word" }
whoisd:connect 1 $chan $nick $::whoisd(server) $::whoisd(port) $word
}
proc whoisd:out {type dest nick text} {
if {[string length [string trim $text]] < 1} { return }
if {!$type} { putdcc $dest "$::whoisd(prefix) $text" ; return }
switch -- $::whoisd(rplmode) {
"0" { putserv "PRIVMSG $dest :$::whoisd(prefix) $text" }
"1" { putserv "NOTICE $dest :$::whoisd(prefix) $text" }
"2" { putserv "PRIVMSG $nick :$::whoisd(prefix) $text" }
"3" { putserv "NOTICE $nick :$::whoisd(prefix) $text" }
}
}
proc whoisd:connect {type dest nick server port word} {
if {[catch {socket -async $server $port} sock]} { whoisd:out $type $dest $nick "Error: Connection to $server:$port failed." ; return }
fileevent $sock writable [list whoisd:write $type $dest $nick $word $sock $server $port [utimer $::whoisd(timeout) [list whoisd:timeout $type $dest $nick $server $port $sock $word]]]
}
proc whoisd:write {type dest nick word sock server port timerid} {
if {[set error [fconfigure $sock -error]] != ""} {
whoisd:out $type $dest $nick "Connection to $::whoisd(server) failed."
whoisd:die $sock $timerid
return
}
set lookup $word
if {$server == $::whoisd(server)} { set lookup [lrange [split $word "."] end end] }
puts $sock "$lookup\n"
flush $sock
fconfigure $sock -blocking 0
fileevent $sock readable [list whoisd:read $type $dest $nick $word $sock $server $port $timerid]
fileevent $sock writable {}
}
proc whoisd:read {type dest nick word sock server port timerid} {
while {![set error [catch {gets $sock output} read]] && $read > 0} {
if {$server == $::whoisd(server)} {
if {[regexp {(not found)} $output]} {
set output "Error: Invalid TLD."
whoisd:out $type $dest $nick $output
whoisd:die { $sock $timerid }
}
if {[string index $word 0] == "." || ![string match *.* $word]} {
if {[regexp {Country: (.*)$} $output -> country]} {
whoisd:out $type $dest $nick "$word is $country"
whoisd:die { $sock $timerid }
}
}
if {[regexp {Whois Server \(port (.*?)\): (.*)$} $output -> port server]} {
whoisd:connect $type $dest $nick $server $port $word
whoisd:die { $sock $timerid }
}
if {[regexp {URL for registration services: (.*)$} $output -> url]} {
#do nothing atm
}
} else {
if {[regexp -nocase {No match|not found|Invalid query|does not exist|no data found|status: avail|domain is available|(null)|no entries found|not registered|no objects found|domain name is not} $output]} {
whoisd:out $type $dest $nick "$word is available!"
whoisd:die $sock $timerid
}
}
if {!$type} { whoisd:out $type $dest $nick $output }
if {$error} {
whoisd:out $type $dest $nick "Error: Connection to server has been lost."
whoisd:die $sock $timerid
}
}
}
proc whoisd:die {sock timerid} {
catch { close $sock }
catch { killutimer $timerid }
}
proc whoisd:timeout {type dest nick server port sock word} {
catch { close $sock }
#whoisd:out $type $dest $nick "Connection to $server:$port timed out."
if {$server != $::whoisd(server)} { whoisd:out $type $dest $nick "$word is taken!" }
}
putlog "whoisd.tcl $whoisdver loaded"

100
wiki.pl Normal file
View file

@ -0,0 +1,100 @@
#!/usr/bin/perl
#use strict;
#use warnings;
use Web::Scraper;
use URI;
use HTML::Entities;
use Encode;
use URI::Escape;
use LWP::UserAgent;
my $scrap;
my $lang = $ARGV[1];
if (!$lang) {
$lang = "de";
}
my $wikiurl = "http://$lang.wikipedia.org/wiki/Special:Search?search=$ARGV[0]&go=Go";
my $ua = new LWP::UserAgent;
my $req = HTTP::Request->new('GET', $wikiurl);
my $res = $ua->request($req);
my $url = $res->request->uri;
my $origurl = $url;
$url =~ s/.*\/wiki\///;
binmode(STDOUT, ":utf8");
if ($url !~ m/Special:Search/) {
#artikel
$scrap = scraper {
process '//div[@id="bodyContent"]/p', 'text[]' => 'TEXT';
process '//img', 'img[]' => '@src';
process '//div[@id="bodyContent"]/ul/li', 'list[]' => 'TEXT';
process '//table/tr/td', 'table[]' => 'TEXT';
};
$url = URI->new($wikiurl);
my $res = $scrap->scrape($url);
my $text = $res->{'text'};
my $img = $res->{'img'};
my $list = $res->{'list'};
my $table = $res->{'table'};
my $isDis = 0;
if ($$table[1] !~ m/$ARGV[0]/i && $#$table == 1) {
foreach (@$img) {
#print "$_\n";
# if ($_ =~ m/^http:\/\/upload\.wikimedia\.org\/wikipedia\/commons\/thumb\/.*\/.*\/Disambig/) {
if ($_ =~ m/Disambig/) {
$isDis = 1;
last;
}
}
}
if (!$isDis) {
$text = decode_entities($$text[0]);
$text =~ s/\([^\(\)]*\)||\[[^\[\]]*\]//g;
$text =~ s/\([^\(\)]*\)||\[[^\[\]]*\]//g;
$text =~ s/\([^\(\)]*\)||\[[^\[\]]*\]//g;
$text =~ s/\([^\(\)]*\)||\[[^\[\]]*\]//g;
$text =~ s/\s+/ /g;
$text =~ s/\s([,.\?!])/$1/g;
if ($text =~ m/.{448}.*/) {
$text =~ s/^(.{448}).*$/$1/;
$text =~ s/^(.*[\.!\?])[^\.!\?]*$/$1 (...)/;
}
print $text, "\n";
} else {
for ($count = 0; $count < 3 && $count <= $#$list; $count++) {
print "$$list[$count]\n";
}
print "For more see $origurl\n";
}
} else {
#kein artikel
$scrap = scraper {
process '//div[@class="searchresult"]', 'text[]' => 'TEXT';
process '//ul[@class="mw-search-results"]/li/div/a', 'href[]' => '@href';
};
$url = URI->new($wikiurl);
my $res = $scrap->scrape($url);
if (keys(%$res)) {
my $text = $res->{'text'};
my $href = $res->{'href'};
my $result = "";
for ($count = 0; $count < 5 && $count <= $#$text; $count++) {
$result = ($result?"$result || ":"").$$href[$count], "\n";
}
print "$result\n";
} else {
print "No matches with $ARGV[0]\n";
}
}

3
wiki.pl.down Normal file
View file

@ -0,0 +1,3 @@
#!/usr/bin/perl
print "wikipedia down!\n";

50
wiki.tcl Normal file
View file

@ -0,0 +1,50 @@
# lastseen by xeno
bind pub - !wiki wiki
bind pub - !ewiki ewiki
#bind pub - !say say
bind pub - !google say
proc say {nick host hand chan arg} {
# putserv "PRIVMSG $chan :$arg";
# putserv "PRIVMSG $chan :das hier ist [string trimleft $chan #]";
}
proc wiki {nick host hand chan arg} {
global do_wiki
if {[info exists do_wiki($nick:$chan)]} {
putserv "NOTICE $nick :no flooding!"
return 0;
}
set do_wiki($nick:$chan) 1
timer 1 "unset do_wiki($nick:$chan)"
set arg [string trim $arg]
if {$arg == ""} {
return 0
}
set output [split "[exec perl /home/eggdrop/eggdrop/scripts/wiki.pl \"$arg\" de]" "\n"]
foreach out $output {
putserv "PRIVMSG $chan :$out";
}
}
proc ewiki {nick host hand chan arg} {
global do_wiki
if {[info exists do_wiki($nick:$chan)]} {
return 0;
}
set do_wiki($nick:$chan) 1
timer 1 "unset do_wiki($nick:$chan)"
set arg [string trim $arg]
if {$arg == ""} {
return 0
}
set output [split "[exec perl /home/eggdrop/eggdrop/scripts/wiki.pl $arg en]" "\n"]
foreach out $output {
putserv "PRIVMSG $chan :$out";
}
}
putlog "wiki by lookshe loaded"

100
wiki2.pl Normal file
View file

@ -0,0 +1,100 @@
#!/usr/bin/perl
#use strict;
#use warnings;
use Web::Scraper;
use URI;
use HTML::Entities;
use Encode;
use URI::Escape;
use LWP::UserAgent;
my $scrap;
my $lang = $ARGV[1];
if (!$lang) {
$lang = "de";
}
my $wikiurl = "http://$lang.wikipedia.org/wiki/Special:Search?search=$ARGV[0]&go=Go";
my $ua = new LWP::UserAgent;
my $req = HTTP::Request->new('GET', $wikiurl);
my $res = $ua->request($req);
my $url = $res->request->uri;
my $origurl = $url;
$url =~ s/.*\/wiki\///;
binmode(STDOUT, ":utf8");
if ($url !~ m/Special:Search/) {
#artikel
$scrap = scraper {
process '//div[@id="bodyContent"]/p', 'text[]' => 'TEXT';
process '//img', 'img[]' => '@src';
process '//div[@id="bodyContent"]/ul/li', 'list[]' => 'TEXT';
process '//table/tr/td', 'table[]' => 'TEXT';
};
$url = URI->new($wikiurl);
my $res = $scrap->scrape($url);
my $text = $res->{'text'};
my $img = $res->{'img'};
my $list = $res->{'list'};
my $table = $res->{'table'};
my $isDis = 0;
if ($$table[1] !~ m/$ARGV[0]/i && $#$table == 1) {
foreach (@$img) {
#print "$_\n";
if ($_ =~ m/Disambig/) {
$isDis = 1;
last;
}
}
}
if (!$isDis) {
$text = decode_entities($$text[0]);
$text =~ s/\([^\(\)]*\)||\[[^\[\]]*\]//g;
$text =~ s/\([^\(\)]*\)||\[[^\[\]]*\]//g;
$text =~ s/\([^\(\)]*\)||\[[^\[\]]*\]//g;
$text =~ s/\([^\(\)]*\)||\[[^\[\]]*\]//g;
$text =~ s/\s+/ /g;
$text =~ s/\s([,.\?!])/$1/g;
if ($text =~ m/.{448}.*/) {
$text =~ s/^(.{448}).*$/$1/;
$text =~ s/^(.*[\.!\?])[^\.!\?]*$/$1 (...)/;
}
print $text, "\n";
} else {
for ($count = 0; $count < 3 && $count <= $#$list; $count++) {
print "$$list[$count]\n";
}
print "For more see $origurl\n";
}
} else {
#kein artikel
$scrap = scraper {
process '//div[@class="searchresult"]', 'text[]' => 'TEXT';
process '//ul[@class="mw-search-results"]/li/a', 'href[]' => '@href';
};
$url = URI->new($wikiurl);
my $res = $scrap->scrape($url);
if (keys(%$res)) {
my $text = $res->{'text'};
my $href = $res->{'href'};
my $result = "";
for ($count = 0; $count < 5 && $count <= $#$text; $count++) {
$result = ($result?"$result || ":"").$$href[$count], "\n";
}
print "$result\n";
} else {
print "No matches with $ARGV[0]\n";
}
}